|
Шаблон класса для работы с потоком (WThread, Thread)
#38411716
Ссылка:
Ссылка на сообщение:
Ссылка с названием темы:
Ссылка на профиль пользователя:
|
Участник
Откуда: Санкт-Петербург
Сообщения: 26 163
|
|
Собственно, сам шаблон с небольшими комментариями именно в тех местах, которые нужны на обывательском уровне, чтобы только добавить свой код.
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
unit WThread;
interface
uses
Classes,
Windows,
Messages,
SysUtils;
type
TWThread = class;
// событие на получение строки из потока
TWThreadReceiveString = procedure(Sender: TWThread; const Text: string) of object;
// событие на получение числа из потока
TWThreadReceiveInt = procedure(Sender: TWThread; const Int: Integer) of object;
// событие на получение строки и числа из потока
TWThreadReceiveStringWord = procedure(Sender: TWThread; const Text: string; const Wrd: Word) of object;
// событие на получение двух чисел из потока
TWThreadReceiveIntWord = procedure(Sender: TWThread; const Int: Integer; const Wrd: Word) of object;
TWThread = class(TThread)
private
FToolWindow: THandle;
hCloseEvent: THandle;
FOnThreadReceviceString: TWThreadReceiveString;
FOnThreadReceiveInt: TWThreadReceiveInt;
FOnThreadReceiveStringWord: TWThreadReceiveStringWord;
FOnThreadReceiveIntWord: TWThreadReceiveIntWord;
protected
procedure WWindowProc(var Msg: TMessage);
procedure SendString(const Text: string);
procedure SendInteger(const Int: Integer);
procedure SendStringWord(const Text: string; const Wrd: Word);
procedure SendIntegerWord(const Int: Integer; const Wrd: Word);
procedure DoThreadReceiveString(const Text: string);
procedure Execute; override; // шаблон процедуры
public
constructor Create(CreateSuspended: Boolean); virtual;
destructor Destroy; override;
// отправка любого сообщения в поток
function SendMessageToThread(AMsg: UInt; wParam: WPARAM; lParam: LPARAM): BOOL;
// отправка строки в поток
function SendStringToThread(const Text: string): boolean;
// остановка потока по феншую
function StopThread: boolean;
// события на получение данных из потока
property OnThreadReceviceString: TWThreadReceiveString read FOnThreadReceviceString write FOnThreadReceviceString;
property OnThreadReceiveInt: TWThreadReceiveInt read FOnThreadReceiveInt write FOnThreadReceiveInt;
property OnThreadReceiveStringWord: TWThreadReceiveStringWord read FOnThreadReceiveStringWord write FOnThreadReceiveStringWord;
property OnThreadReceiveIntWord: TWThreadReceiveIntWord read FOnThreadReceiveIntWord write FOnThreadReceiveIntWord;
end;
implementation
const
WM_BASE = WM_USER + $100;
WM_STRING = WM_BASE + 1;
WM_INT = WM_BASE + 2;
WM_STRING_WORD = WM_BASE + 3;
WM_INT_WORD = WM_BASE + 4;
WM_MAX = WM_INT_WORD;
{ TWThread }
constructor TWThread.Create(CreateSuspended: Boolean);
begin
inherited;
FToolWindow := AllocateHWnd(WWindowProc);
hCloseEvent := CreateEvent(nil, true, false, nil);
end;
destructor TWThread.Destroy;
begin
CloseHandle(hCloseEvent);
DeallocateHWnd(FToolWindow);
inherited;
end;
procedure TWThread.DoThreadReceiveString(const Text: string);
begin
if Assigned(FOnThreadReceviceString) then
FOnThreadReceviceString(Self, Text);
end;
function TWThread.SendMessageToThread(AMsg: UInt; wParam: WPARAM; lParam: LPARAM): BOOL;
begin
result := PostThreadMessage(ThreadID, AMsg, wParam, lParam);
end;
function TWThread.SendStringToThread(const Text: string): boolean;
var buf: LPARAM;
begin
buf := 0;
String(Buf) := Text;
result := PostThreadMessage(ThreadID, WM_STRING, 0, buf);
end;
procedure TWThread.Execute;
var
HandlesToWaitFor: array [0 .. 0] of THandle;
dwHandleSignaled: DWORD;
msg: TMsg;
str: string;
label
EndOfThread;
begin
// следующая строка должна быть всегда первой в процедуре, т.к. запускает очередь сообщений для потока
PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE);
HandlesToWaitFor[0] := hCloseEvent;
// SleepEx не нужен, если подготовительный код до цикла while будет достаточно долго выполняться
// уточняется опытным путем, иначе очередь сообщений потока не успеет запуститься и сообщения могут улететь в пустоту
SleepEx(20, false);
// тестовый пример vvv
SendString('WThread started');
// тестовый пример ^^^
while not Terminated do begin
if not PeekMessage(msg, 0, WM_BASE, WM_MAX, PM_REMOVE) then begin
dwHandleSignaled := MsgWaitForMultipleObjects(1, HandlesToWaitFor, false, INFINITE, QS_ALLINPUT);
case dwHandleSignaled of
WAIT_OBJECT_0: begin // выставлено событие остановки потока
Terminate;
goto EndOfThread;
end;
WAIT_OBJECT_0 + 1: begin // получено сообщение
Continue;
end;
end;
end;
if msg.hwnd <> 0 then begin
TranslateMessage(msg);
DispatchMessage(msg);
Continue;
end;
case msg.message of
WM_QUIT, WM_CLOSE, WM_DESTROY: begin // оконные сообщения тоже получаем
Terminate;
goto EndOfThread;
end;
WM_STRING: begin
LPARAM(str) := msg.lParam;
// что-нибудь делаем со строкой. например, отправляем обратно
// тестовый пример vvv
SendString(Format('received: %s', [str]));
// тестовый пример ^^^
str := ''; // "отпускаем" строку после работы с ней
end;
WM_INT: begin
// здесь получаем число в msg.lparam;
end;
end;
end;
EndOfThread:
// все что создали в начале процедуры, здесь удаляем
end;
procedure TWThread.SendInteger(const Int: Integer);
begin
if FToolWindow <> 0 then
PostMessage(FToolWindow, WM_INT, 0, Int);
end;
procedure TWThread.SendIntegerWord(const Int: Integer; const Wrd: Word);
begin
if FToolWindow <> 0 then
PostMessage(FToolWindow, WM_INT_WORD, Wrd, Int);
end;
procedure TWThread.SendString(const Text: string);
var buf: LParam;
begin
buf := 0;
String(buf) := Text;
if FToolWindow <> 0 then
PostMessage(FToolWindow, WM_STRING, 0, buf);
end;
procedure TWThread.SendStringWord(const Text: string; const Wrd: Word);
var buf: LParam;
begin
buf := 0;
String(buf) := Text;
if FToolWindow <> 0 then
PostMessage(FToolWindow, WM_STRING, Wrd, buf);
end;
function TWThread.StopThread: boolean;
begin
SetEvent(hCloseEvent);
SleepEx(1, false);
result := WaitForSingleObject(Handle, 10000) <> WAIT_TIMEOUT;
end;
procedure TWThread.WWindowProc(var Msg: TMessage);
var str: String;
begin
case Msg.Msg of
WM_STRING: begin
LPARAM(str) := Msg.LParam;
DoThreadReceiveString(str);
Msg.Result := 1;
end;
WM_INT: begin
if Assigned(FOnThreadReceiveInt) then
FOnThreadReceiveInt(Self, Msg.LParam);
Msg.Result := 1;
end;
WM_STRING_WORD: begin
LPARAM(str) := Msg.LParam;
if Assigned(FOnThreadReceiveStringWord) then
FOnThreadReceiveStringWord(Self, str, Msg.WParam);
Msg.Result := 1;
end;
WM_INT_WORD: begin
if Assigned(FOnThreadReceiveIntWord) then
FOnThreadReceiveIntWord(Self, Msg.LParam, Msg.WParam);
Msg.Result := 1;
end;
else
Msg.Result := DefWindowProc(FToolWindow, Msg.Msg, Msg.wParam, Msg.lParam);
end;
end;
end.
Тестовый проект. Форма состоит из мemo, и двух кнопок: одна запускает/останавливает поток, другая отправляет строку в поток.
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
unit ThreadTestMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, WThread;
type
TfrmWThreadTest = class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
FThread: TWThread;
procedure ReceiveString(Sender: TWThread; const Text: string);
procedure StartThread;
procedure StopThread;
public
end;
var
frmWThreadTest: TfrmWThreadTest;
implementation
{$R *.dfm}
procedure TfrmWThreadTest.Button1Click(Sender: TObject);
begin
if Assigned(FThread) then
StopThread
else
StartThread;
end;
procedure TfrmWThreadTest.Button2Click(Sender: TObject);
var s: string;
begin
if Assigned(FThread) and InputQuery('Input', 'Enter text', s) then begin
Memo1.Lines.Add(Format('-> %s', [s]));
FThread.SendStringToThread(s);
end;
end;
procedure TfrmWThreadTest.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(FThread) then
StopThread;
end;
procedure TfrmWThreadTest.FormCreate(Sender: TObject);
begin
Memo1.Lines.Clear;
end;
procedure TfrmWThreadTest.ReceiveString(Sender: TWThread; const Text: string);
begin
Memo1.Lines.Add(Format('<- %s', [Text]));
end;
procedure TfrmWThreadTest.StartThread;
begin
if not Assigned(FThread) then begin
FThread := TWThread.Create(true);
FThread.OnThreadReceviceString := ReceiveString;
FThread.Start;
end;
end;
procedure TfrmWThreadTest.StopThread;
begin
if Assigned(FThread) then begin
if not FThread.StopThread then
MessageDlg('You dont kill me!', mtError, [mbOk], 0);
FThread.Free;
FThread := nil;
end;
end;
end.
Тестирование было с ReportMemoryLeaksOnShutdown := true; что показало, что память не теряется при многочисленных отправках строк. Delphi XE2.
Вопросы, предложения? :)
Репозитарий на гитхабе: https://github.com/wadman/wthread/ |
|
|
