Fórum Treads no Delphi #157629

Se ainda estiver precisando me avisa que eu sei como fazer. Não estou respondendo agora porque você pode não mais precisar, mas se ainda precisar me avisa.

Ainda estou precisando sim cara ...

se vc puder me ajudar

[]s

Esse exemplo que eu vou te passar faz o seguinte: Tem um Label que fica sendo incrementado de um em um até X (20000 no meu exemplo) sem interrupção alguma, daí você altera conforme a sua necessidade.

Vou comentar todo o código faloWWW.

----------------------------
Essa é a Unit do Thread:
----------------------------

unit Unit2;

interface

uses
Classes, StdCtrls, SysUtils;

type
TContador = class(TThread)
private
FCaixa: TLabel;
{ Private declarations }
protected
procedure Execute; override;
procedure Incrementa;
procedure Soma;
public
constructor Create(Caixa: TLabel); // Só pra fazer Caixa ficar visível em todo o código
end;

implementation

{ TContador }

constructor TContador.Create(Caixa: TLabel);
begin
FCaixa := Caixa;
FreeOnTerminate := True;

inherited Create(False); // Esse parâmetro indica se a execução do Thread será suspensa logo ao criá-lo. Caso você queira criá-lo e iniciá-lo em outra outra use no formulário principal: Contador.Resume;
end;

procedure TContador.Execute;
begin
Incrementa; // Aqui você chama a procedure que ficará analisando a disponibilidade dos servidores
{ Place thread code here }
end;

procedure TContador.Incrementa;
Var
i: Integer;
begin
for i := 0 to 20000 do // No meu exemplo eu usei FOR mas você pode deixar aqui uma outra condição de parada (flag) ou até mesmo um laço infinito sem problemas
begin
Synchronize(Soma); // Aqui você chama a procedure que faz uma verificação de disponibilidade e o laço se encarregará de repetí-lo

if Terminated then
Exit;
end;
end;

procedure TContador.Soma;
begin
FCaixa.Caption := IntToStr(StrToInt(FCaixa.Caption) + 1);
end;

end.


-----------------------
Formulário Principal
-----------------------

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Unit2, Buttons, Mask;

type
TForm1 = class(TForm)
LblContador: TLabel;
BitBtn1: TBitBtn;
MaskEdit1: TMaskEdit;
BitBtn2: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.BitBtn1Click(Sender: TObject);
Var
Contador: TContador;
begin
Contador := TContador.Create(LblContador);
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
Application.Minimize;
end;

end.