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;

Nincsenek megjegyzések:

Megjegyzés küldése