AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

multithread

Ein Thema von question · begonnen am 5. Okt 2013 · letzter Beitrag vom 7. Okt 2013
 
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
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 07:32 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz