Ver Mensaje Individual
  #4  
Antiguo 01-07-2003
Avatar de delphi.com.ar
delphi.com.ar delphi.com.ar is offline
Federico Firenze
 
Registrado: may 2003
Ubicación: Buenos Aires, Argentina *
Posts: 5.935
Reputación: 27
delphi.com.ar Va por buen camino
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!
__________________
delphi.com.ar

Dedique el tiempo suficiente para formular su pregunta si pretende que alguien dedique su tiempo en contestarla.
Responder Con Cita