how to let the TThread to keep working in background and showing me the result in a Listbox?

烈酒焚心 提交于 2019-12-23 02:43:50

问题


I have to develop a program to keep watching values in databases based on a Select statement given by me

the watched values can be changed at anytime and my program must sense the changes based on a result of the select statement which is given by me

i want to watch the select result by using TThread because my system is also has another features and the user need to work on it not only to watch values.

how to do it using TThread in Delphi XE2

am using VCL...no .Net

Regards.


回答1:


[Edit]

Improved answer, now thread runs continuously and "keep watching values".

Let's build a sample.

First, Create new VCL app. Drop on the form one TListBox and two TButton component. You need to write button click handlers and add one private method. Entire unit should look like this:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Unit2;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    FCollector: TCollector;
    procedure OnCollect(S: TStrings);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Assigned(FCollector) then Exit;
  FCollector := TCollector.Create;
  FCollector.OnCollect := Self.OnCollect;
  FCollector.Start;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if not Assigned(FCollector) then Exit;
  FCollector.Terminate;
  FCollector := nil;
end;

procedure TForm1.OnCollect(S: TStrings);
begin
  ListBox1.Items.AddStrings(S);
end;

end.

Next we should add our thread, select from menu: File -> New unit and replace with code:

unit Unit2;

interface

uses
  System.Classes;

type

  TCollectEvent = procedure (S: TStrings) of object;

  TCollector = class(TThread)
  private
    { Private declarations }
    FTick: THandle;
    FItems: TStrings;
    FOnCollect: TCollectEvent;
    FInterval: Integer;
  protected
    procedure Execute; override;
    procedure DoCollect;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Terminate;
    property Interval: Integer read FInterval write FInterval;
    property OnCollect: TCollectEvent read FOnCollect write FOnCollect;
  end;

implementation

uses Windows, SysUtils;

{ TCollector }

constructor TCollector.Create;
begin
  inherited Create(True);
  FreeOnTerminate := True;
  FInterval := 1000;
  FTick := CreateEvent(nil, True, False, nil);
end;

destructor TCollector.Destroy;
begin
  CloseHandle(FTick);
  inherited;
end;

procedure TCollector.DoCollect;
begin
  FOnCollect(FItems);
end;

procedure TCollector.Terminate;
begin
  inherited;
  SetEvent(FTick);
end;

procedure TCollector.Execute;
begin
  while not Terminated do
  begin
    if WaitForSingleObject(FTick, FInterval) = WAIT_TIMEOUT then
    begin
      FItems := TStringList.Create;
      try
        // Collect here items
        FItems.Add('Item ' + IntToStr(Random(100)));
        Synchronize(DoCollect);
      finally
        FItems.Free;
      end;
    end;
  end;
end;

end.

Now, when you press Button1, you will receive from thread Items in your combo. Pressing Button2 thread stops executing.

You should take in account:

  1. Set Interval to watch values, default is 1000ms, see interval property;

  2. All your code (include DB access components) inside Execute and related to it should be thread-save.



来源:https://stackoverflow.com/questions/11396234/how-to-let-the-tthread-to-keep-working-in-background-and-showing-me-the-result-i

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!