线程定时执行事件

 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, WinInet;

type
  TTimeThread = class(TThread)
  private
    FInterval: Cardinal;
    FTimeEvent: TNotifyEvent;
    FActive: Boolean;
    procedure SetActive(AData: Boolean);
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean);
    property Interval: Cardinal  read FInterval write FInterval;
    property TimeEvent: TNotifyEvent read FTimeEvent write FTimeEvent;
    property Active: Boolean read FActive write SetActive;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    Memo1: TMemo;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure AddDate(Sender: TObject);
    procedure ShowFtPMsg(const AFtpRecord: TFtpRecord);
    { Public declarations }
  end;

var
  Form1: TForm1;
  I: Integer;
  Test: TTimeThread;

implementation

{$R *.dfm}

procedure TForm1.AddDate(Sender: TObject);
begin
  Form1.Memo1.Lines.Add(IntToStr(I));
  Inc(I);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Test := TTimeThread.Create(True);
  Test.Interval := 2000;
  Test.TimeEvent := AddDate;

end;

{ TTimeThread }

constructor TTimeThread.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
  FreeOnTerminate := True;
end;

procedure TTimeThread.Execute;
begin
  inherited;
  while (not Terminated) and FActive do
  begin
    Sleep(FInterval);
    if Assigned(TimeEvent) then
      TimeEvent(Self);
  end;
end;

procedure TTimeThread.SetActive(AData: Boolean);
var
  IsLay: Boolean;
  ExitCode: Cardinal;
begin
  if FActive = AData then
    Exit
  else
  begin
    IsLay := GetExitCodeThread(Handle, ExitCode);
    if ExitCode = STILL_ACTIVE then
    begin
    FActive := AData;
      if AData then
        Resume
      else
        Suspend;
    end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Test.Active := False;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Test.Active := True;
end;


procedure TForm1.ShowFtPMsg(const AFtpRecord: TFtpRecord);
begin
  Memo1.Lines.Clear;
  Memo1.Lines.Add('useId = '+ AFtpRecord.UserId);
  Memo1.Lines.Add('PassWord = '+ AFtpRecord.PassWord);
  Memo1.Lines.Add('Url = '+ AFtpRecord.FtpUrl);
  Memo1.Lines.Add('Port = '+ IntToStr(AFtpRecord.Port));
  Memo1.Lines.Add('Dir = '+ AFtpRecord.Dir);
  Memo1.Lines.Add('ExeName = '+ AFtpRecord.ExeName);
end;

end.