Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   OOP (https://www.clubdelphi.com/foros/forumdisplay.php?f=5)
-   -   Hilos.... TThreads... Uff... (https://www.clubdelphi.com/foros/showthread.php?t=1877)

craven 01-07-2003 21:02:38
Hilos.... TThreads... Uff...
 
Hola amigos, a ver si podeis echarme una manilla con esto. Vereis, he diseñado un objeto que, a grosso modo, tiene la siguiente estructura.

TMiObjeto = class
private
proceso : TThread ;
...
...
public
...
procedure funciona ;
...
end ;

Me gustaria que cuando se ejecute el procedimiento FUNCIONA, se cree la hebra PROCESO y se ejecute el código que ésta contiene, pero no se cómo hacerlo. A ver si podeis ayudarme. Gracias de antemano. Un saludo.

delphi.com.ar 01-07-2003 21:16:51
Hola craven, te cuento que en la ayuda de TThread tienes un ejemplo que hace algo muy similar a lo que tu pides, la única gran diferencia es que la clase ancestro es un TForm y es un poco mas complejo el código porque hay 4 threads.

Saludos!

craven 01-07-2003 21:29:05
Hola .... Pero, ¿donde esta exactamente el ejemplo? Gracias.

delphi.com.ar 01-07-2003 21:46:39
Ok... no lo encuentro en la ayuda de Delphi 7, pero te paso lo que está en la del 5

Código:
unit Pg1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, Pg2;

const
  WM_ThreadDoneMsg = WM_User + 8;

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    ProgressBar2: TProgressBar;
    Button1: TButton;
    Button2: TButton;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Label1: TLabel;

    Label2: TLabel;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure FormDestroy(Sender: TObject);

  private
    { Private declarations }
    MyThread1 : TMyThread; // thread number 1
    MyThread2 : TMyThread; // thread number 2
    Thread1Active : boolean; // used to test if thread 1 is active
    Thread2Active : boolean; // used to test if thread 2 is active
    procedure ThreadDone(var AMessage : TMessage); message WM_ThreadDoneMsg; // Message to be sent back from thread when its done
  public
    { Public declarations }

  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject); // Create Thread 1
{ The thread will destroy iteself when it is done executing because FreeOnTerminate is set to true.
The first paramter is the priority, and the second is the progressbar to update.
}
begin
  if (MyThread1 = nil) or (Thread1Active = false) then // make sure its not already running

  begin
    MyThread1 := TMyThread.CreateIt(TrackBar1.Position, ProgressBar1);
    Thread1Active := true;
  end
  else
    ShowMessage('Thread still executing');
end;

procedure TForm1.Button2Click(Sender: TObject); // Create Thread 2
begin
  if (MyThread2 = nil) or (Thread2Active = false) then  // make sure its not already running
  begin
    MyThread2 := TMyThread.CreateIt(TrackBar2.Position, ProgressBar2);

    Thread2Active := true;
  end
  else
    ShowMessage('Thread still executing');
end;

procedure TForm1.Button3Click(Sender: TObject); // Terminate Thread 1
begin
  if (MyThread1 <> nil) and (Thread1Active = true) then  // check to see if it is running
    MyThread1.Terminate
  else
  ShowMessage('Thread not started');
end;

procedure TForm1.Button4Click(Sender: TObject); // Terminate Thread 2

begin
  if (MyThread2 <> nil) and (Thread2Active = true) then  // check to see if it is running
    MyThread2.Terminate
  else
    ShowMessage('Thread not started');
end;

procedure TForm1.ThreadDone(var AMessage: TMessage); // keep track of when and which thread is done executing
begin
  if ((MyThread1 <> nil) and (MyThread1.ThreadID = cardinal(AMessage.WParam))) then

  begin
      Thread1Active := false;
  end;
  if ((MyThread2 <> nil) and (MyThread2.ThreadID = cardinal(AMessage.WParam))) then
  begin
      Thread2Active := false;
  end;
end;


procedure TForm1.FormCreate(Sender: TObject); // initialize to zero
begin
  Thread1Active := false;
  Thread2Active := false;
end;


procedure TForm1.TrackBar1Change(Sender: TObject); // set Thread 1 Priority

begin
  if (MyThread1 <> nil) and (Thread1Active = true) then
    MyThread1.priority := TThreadPriority(TrackBar1.Position);
end;

procedure TForm1.TrackBar2Change(Sender: TObject); // set Thread 2 Priority
begin
  if (MyThread2 <> nil) and (Thread2Active = true) then
    MyThread2.priority := TThreadPriority(TrackBar2.Position);
end;


procedure TForm1.FormDestroy(Sender: TObject); // Terminate any threads still running

begin
  if (MyThread1 <> nil) and (Thread1Active = true) then
  begin
    MyThread1.Terminate;
    MyThread1.WaitFor;  // wait for it to terminate
  end;
  if (MyThread2 <> nil) and (Thread2Active = true) then
  begin
    MyThread2.Terminate;
    MyThread2.WaitFor;
  end;
end;

end.
Código:
object Form1: TForm1
  Left = 516
  Top = 256
  Width = 712
  Height = 507
  Caption = 'TThread, TTrackBar, TProgressBar'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Bevel1: TBevel
    Left = 32
    Top = 8
    Width = 513
    Height = 169
  end
  object Bevel2: TBevel
    Left = 32
    Top = 200
    Width = 513
    Height = 169
  end
  object Label1: TLabel
    Left = 256
    Top = 104
    Width = 34
    Height = 13
    Caption = 'Priority:'
  end
  object Label2: TLabel
    Left = 248
    Top = 296
    Width = 34
    Height = 13
    Caption = 'Priority:'
  end
  object ProgressBar1: TProgressBar
    Left = 64
    Top = 32
    Width = 393
    Height = 25
    Min = 0
    Max = 100
    Step = 1
    TabOrder = 0
  end
  object ProgressBar2: TProgressBar
    Left = 64
    Top = 224
    Width = 401
    Height = 25
    Min = 0
    Max = 100
    TabOrder = 1
  end
  object Button1: TButton
    Left = 72
    Top = 80
    Width = 105
    Height = 25
    Caption = 'Create Thread'
    TabOrder = 2
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 72
    Top = 272
    Width = 105
    Height = 25
    Caption = 'Create Thread'
    TabOrder = 3
    OnClick = Button2Click
  end
  object TrackBar1: TTrackBar
    Left = 296
    Top = 104
    Width = 193
    Height = 33
    Max = 6
    Orientation = trHorizontal
    Frequency = 1
    Position = 3
    SelEnd = 0
    SelStart = 0
    TabOrder = 4
    TickMarks = tmBottomRight
    TickStyle = tsAuto
    OnChange = TrackBar1Change
  end
  object TrackBar2: TTrackBar
    Left = 288
    Top = 296
    Width = 193
    Height = 45
    Max = 6
    Orientation = trHorizontal
    Frequency = 1
    Position = 3
    SelEnd = 0
    SelStart = 0
    TabOrder = 5
    TickMarks = tmBottomRight
    TickStyle = tsAuto
    OnChange = TrackBar2Change
  end
  object Button3: TButton
    Left = 72
    Top = 128
    Width = 105
    Height = 25
    Caption = 'Terminate Thread'
    TabOrder = 6
    OnClick = Button3Click
  end
  object Button4: TButton
    Left = 72
    Top = 320
    Width = 105
    Height = 25
    Caption = 'Terminate Thread'
    TabOrder = 7
    OnClick = Button4Click
  end
end
Saludos!

marto 02-07-2003 01:00:04
Hola,

Trabajar con treads no es algo precisamente sencillo. En grupo albor publican una revista llamada Sintesi sobre programación y en especial Deplhi muy recomendable (y gratuita) en español. No recuerdo qué números eran, pero se publicaron una serie de artículos sobre el uso de TThreads tanto sobre Windows como Linux muy interesantes

shaktale 02-07-2003 08:37:12
Aqui (Martin Harvey's web pages) tienes un tuturial sobre el tema.


La franja horaria es GMT +2. Ahora son las 22:09:23.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi