Thema: multithread

Einzelnen Beitrag anzeigen

Namenloser

Registriert seit: 7. Jun 2006
Ort: Karlsruhe
3.724 Beiträge
 
FreePascal / Lazarus
 
#4

AW: multithread

  Alt 5. Okt 2013, 23:19
Is this simple enough?
Delphi-Quellcode:
unit Unit1;

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;

type

  { TMathThread }

  TMathThread = class(TThread)
  protected
    FValue: extended;
    FLabel: TLabel;
    procedure UpdateGUI;
  public
    constructor Create(OutputLabel: TLabel);
  end;

  { TAddThread }

  TAddThread = class(TMathThread)
    procedure Execute; override;
  end;

  { TMulThread }

  TMulThread = class(TMathThread)
    procedure Execute; override;
  end;

  { TSubThread }

  TSubThread = class(TMathThread)
    procedure Execute; override;
  end;

  { TfrmMain }

  TfrmMain = class(TForm)
    btnAdd: TButton;
    btnMul: TButton;
    btnSub: TButton;
    lblAdd: TLabel;
    lblMul: TLabel;
    lblSub: TLabel;
    procedure btnMulClick(Sender: TObject);
    procedure btnSubClick(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private declarations }
    FAddThread, FMulThread, FSubThread: TMathThread;
  public
    { public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{ TfrmMain }

procedure TfrmMain.btnAddClick(Sender: TObject);
begin
  FAddThread.Resume;
end;

procedure TfrmMain.btnMulClick(Sender: TObject);
begin
  FMulThread.Resume;
end;

procedure TfrmMain.btnSubClick(Sender: TObject);
begin
  FSubThread.Resume;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FAddThread := TAddThread.Create(lblAdd);
  FMulThread := TMulThread.Create(lblMul);
  FSubThread := TSubThread.Create(lblSub);
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  // TThread.Free calls TThread.Terminate internally and waits for the thread
  // to end
  FAddThread.Free;
  FMulThread.Free;
  FSubThread.Free;
end;

{$IFDEF FPC}
  {$R *.lfm}
{$ELSE}
  {$R *.dfm}
{$ENDIF}

{ TMathThread }

procedure TMathThread.UpdateGUI;
begin
  FLabel.Caption := FloatToStr(FValue);
end;

constructor TMathThread.Create(OutputLabel: TLabel);
begin
  // Create Suspended
  inherited Create(True);

  FLabel := OutputLabel;
  FValue := 1.0;
end;

{ TSubThread }

procedure TSubThread.Execute;
begin
  while not Terminated do
  begin
    FValue := FValue - 1;
    sleep(100);
    Synchronize(UpdateGUI);
  end;
end;

{ TMulThread }

procedure TMulThread.Execute;
begin
  while not Terminated do
  begin
    FValue := FValue * 1.01;
    sleep(100);
    Synchronize(UpdateGUI);
  end;
end;

{ TAddThread }

procedure TAddThread.Execute;
begin
  while not Terminated do
  begin
    FValue := FValue + 1;
    sleep(100);
    Synchronize(UpdateGUI);
  end;
end;

end.
(Sorry, I had to write this under Lazarus, as my Delphi installation now freezes on startup for some reason... I hope it compiles)


Edit:
I just noticed, the dfm file might be helpful...
Delphi-Quellcode:
object frmMain: TfrmMain
  Left = 408
  Height = 429
  Top = 261
  Width = 618
  Caption = 'frmMain'
  ClientHeight = 429
  ClientWidth = 618
  OnCreate = FormCreate
  object lblAdd: TLabel
    Left = 232
    Height = 16
    Top = 112
    Width = 36
    Caption = 'Start Add Thread'
    ParentColor = False
  end
  object lblSub: TLabel
    Left = 232
    Height = 16
    Top = 200
    Width = 34
    Caption = 'lblSub'
    ParentColor = False
  end
  object lblMul: TLabel
    Left = 232
    Height = 16
    Top = 158
    Width = 35
    Caption = 'Start Mul Thread'
    ParentColor = False
  end
  object btnAdd: TButton
    Left = 80
    Height = 25
    Top = 104
    Width = 131
    Caption = 'btnAdd'
    OnClick = btnAddClick
    TabOrder = 0
  end
  object btnMul: TButton
    Left = 80
    Height = 25
    Top = 151
    Width = 128
    Caption = 'btnMul'
    OnClick = btnMulClick
    TabOrder = 1
  end
  object btnSub: TButton
    Left = 80
    Height = 25
    Top = 190
    Width = 128
    Caption = 'Start Sub Thread'
    OnClick = btnSubClick
    TabOrder = 2
  end
end

Geändert von Namenloser ( 5. Okt 2013 um 23:33 Uhr)
  Mit Zitat antworten Zitat