2006. december 26., kedd
Create and free a window handle inside a TThread object
Problem/Question/Abstract:
I have a (separate) thread that spends most of its time waiting for (synchronisation) events, and when an event occurs it performs some processing which involves user-specific (Delphi) event handling. In these event handlers I would now like to be able to create objects that uses Windows messages, such as TTimers or some other own-developed components we have, and that these objects should be able to generate (Delphi) events as they normally would (although executed in my separate thread, of course).
Answer:
I usually use messages within threads and works fine, I attach 2 procedures that allows you to create/ free a window handle inside a TThread object and to use the standard Delphi way to handle messages. The function are:
CreateWindowHandle(AObject: TObject): integer;
FreeWindowHandle(AHandle: integer);
You should use them in the following way:
{ ... }
type
TMyThread = class(TThread)
private
hwnd: integer;
protected
procedure handler1(var message: TMessage); message WM_USER; {or any other message}
end;
constructor Create { ... }
begin
{ ... }
hwnd := CreateWindowHandle(Self);
{ ... }
end;
destructor Destroy { ... }
begin
{ ... }
freewindowhandle(hwnd);
{ ... }
end;
var
ObjectWindowClass: TWndClass = (style: 0; lpfnWndProc: @windows.DefWindowProc;
cbClsExtra: 0; cbWndExtra: 0; hInstance: 0; hIcon: 0;
hCursor: 0; hbrBackground: 0; lpszMenuName: nil;
lpszClassName: 'ObjectWindowClass@wbuwbvubvy');
function ObjectWindowProc(HWnd, Msg, wParam, lParam: integer): integer; stdcall;
var
m: TMessage;
begin
m.Msg := uint(msg);
m.wParam := wParam;
m.lParam := lParam;
TObject(GetWindowLong(hwnd, GWL_USERDATA)).Dispatch(m);
result := m.Result;
end;
function CreateWindowHandle(AObject: TObject): integer;
var
TempClass: TWndClass;
ClReg: Boolean;
hwnd: integer;
begin
{register the window class (if not already registered) }
ObjectWindowClass.hInstance := HInstance;
ClReg := GetClassInfo(HInstance, ObjectWindowClass.lpszClassName, TempClass);
if (not ClReg) or (TempClass.lpfnWndProc <> @windows.DefWindowProc) then
begin
if ClReg then
Windows.UnregisterClass(ObjectWindowClass.lpszClassName, HInstance);
Windows.RegisterClass(ObjectWindowClass);
end;
{create the window}
HWnd := CreateWindow(ObjectWindowClass.lpszClassName, '', 0, 0, 0, 0, 0, 0, 0,
HInstance, nil);
{subclass the window}
SetWindowLong(HWnd, GWL_USERDATA, integer(AObject));
SetWindowLong(HWnd, GWL_WNDPROC, integer(@ObjectWindowProc));
Result := HWnd;
end;
procedure FreeWindowHandle(AHandle: integer);
begin
SetWindowLong(AHandle, GWL_WNDPROC, integer(@windows.DefWindowProc));
DestroyWindow(AHandle);
end;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése