How to create a window using a custom Delphi class without using VCL?

Question

I am trying to write a simple block containing the TMainWindow class to improve my knowledge of the native Windows API.

I would like to use this class as follows:

 var MainWindow: TMainWindow; begin MainWindow := TMainWindow.Create; try MainWindow.ShowModal; finally MainWindow.Free; end; end. 

I have an almost working prototype, but I can not find the problem, here is the code that I have written so far:

 unit NT.Window; interface uses Windows, Messages, Classes, SysUtils; type PObject = ^TObject; TMainWindow = class(TObject) private FChild : HWND; { Optional child window } FHandle : HWND; procedure WMCreate (var Msg: TWMCreate); message WM_CREATE; procedure WMDestroy (var Msg: TWMDestroy); message WM_DESTROY; procedure WMNcCreate (var Msg: TWMNCCreate); message WM_NCCREATE; procedure WMPaint (var Msg: TWMPaint); message WM_PAINT; procedure WMPrintClient (var Msg: TWMPrintClient); message WM_PRINTCLIENT; procedure WMSize (var Msg: TWMSize); message WM_SIZE; procedure PaintContent(const APaintStruct: TPaintStruct); function HandleMessage(var Msg: TMessage): Integer; public constructor Create; procedure DefaultHandler(var Message); override; function ShowModal: Boolean; end; implementation var WindowByHwnd: TStringList; function PointerToStr(APointer: Pointer): string; begin Result := IntToStr(NativeInt(APointer)); end; function StrToPointerDef(AString: string; ADefault: Pointer): Pointer; begin Result := Pointer(StrToIntDef(AString, Integer(ADefault))); end; function GetWindowByHwnd(hwnd: HWND): TMainWindow; begin Result := TMainWindow(StrToPointerDef(WindowByHwnd.Values[IntToStr(hwnd)], nil)); end; procedure StoreWindowByHwnd(hwnd: HWND; AWindow: TMainWindow); begin AWindow.FHandle := hwnd; WindowByHwnd.Add(IntToStr(hwnd) + '=' + PointerToStr(Pointer(AWindow))); end; function WndProc(hwnd: HWND; uiMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; var Msg : TMessage; Window : TMainWindow; begin Msg.Msg := uiMsg; Msg.WParam := wParam; Msg.LParam := lParam; Msg.Result := 0; if uiMsg = WM_NCCREATE then begin StoreWindowByHwnd(hwnd, TMainWindow(TWMNCCreate(Msg).CreateStruct.lpCreateParams)) end; Window := GetWindowByHwnd(hwnd); if Window = nil then begin Result := DefWindowProc(hwnd, Msg.Msg, Msg.WParam, Msg.LParam); end else begin Result := Window.HandleMessage(Msg); end; end; { TMainWindow } constructor TMainWindow.Create; var wc: WNDCLASS; begin inherited Create; wc.style := 0; wc.lpfnWndProc := @WndProc; wc.cbClsExtra := 0; wc.cbWndExtra := 0; wc.hInstance := HInstance; wc.hIcon := 0; wc.hCursor := LoadCursor(0, IDC_ARROW); wc.hbrBackground := HBRUSH(COLOR_WINDOW + 1); wc.lpszMenuName := nil; wc.lpszClassName := 'Scratch'; if Windows.RegisterClass(wc) = 0 then begin raise Exception.Create('RegisterClass failed: ' + SysErrorMessage(GetLastError)); end; if CreateWindow( 'Scratch', { Class Name } 'Scratch', { Title } WS_OVERLAPPEDWINDOW, { Style } Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), { Position } Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), { Size } 0, { Parent } 0, { No menu } HInstance, { Instance } @Self { No special parameters } ) = 0 then begin raise Exception.Create('CreateWindow failed: ' + SysErrorMessage(GetLastError)); end; end; procedure TMainWindow.DefaultHandler(var Message); var Msg: TMessage; begin Msg := TMessage(Message); Msg.Result := DefWindowProc(FHandle, Msg.Msg, Msg.WParam, Msg.LParam); end; function TMainWindow.HandleMessage(var Msg: TMessage): Integer; begin // Dispatch(Msg); case Msg.Msg of WM_CREATE : WMCreate( TWMCreate(Msg)); WM_DESTROY : WMDestroy( TWMDestroy(Msg)); WM_NCCREATE : WMNcCreate( TWMNCCreate(Msg)); WM_PAINT : WMPaint( TWMPaint(Msg)); WM_PRINTCLIENT : WMPrintClient(TWMPrintClient(Msg)); WM_SIZE : WMSize( TWMSize(Msg)); else // DefaultHandler(Msg); Msg.Result := DefWindowProc(FHandle, Msg.Msg, Msg.WParam, Msg.LParam); end; Result := Msg.Result; end; procedure TMainWindow.PaintContent(const APaintStruct: TPaintStruct); begin end; function TMainWindow.ShowModal: Boolean; var msg_ : MSG; begin ShowWindow(FHandle, CmdShow); while GetMessage(msg_, 0, 0, 0) do begin TranslateMessage(msg_); DispatchMessage(msg_); end; Result := True; end; procedure TMainWindow.WMCreate(var Msg: TWMCreate); begin Msg.Result := 0; end; procedure TMainWindow.WMDestroy(var Msg: TWMDestroy); begin PostQuitMessage(0); end; procedure TMainWindow.WMNcCreate(var Msg: TWMNCCreate); begin Msg.Result := Ord(True); end; procedure TMainWindow.WMPaint(var Msg: TWMPaint); var ps: PAINTSTRUCT; begin BeginPaint(FHandle, ps); PaintContent(ps); EndPaint(FHandle, ps); end; procedure TMainWindow.WMPrintClient(var Msg: TWMPrintClient); var ps: PAINTSTRUCT; begin ps.hdc := Msg.DC; GetClientRect(FHandle, ps.rcPaint); PaintContent(ps); end; procedure TMainWindow.WMSize(var Msg: TWMSize); begin if FChild <> 0 then begin MoveWindow(FChild, 0, 0, Msg.Width, Msg.Height, True); end; end; initialization WindowByHwnd := TStringList.Create; finalization WindowByHwnd.Free; end. 

The code is partially based on the scratch program by Raymond Chen: http://blogs.msdn.com/b/oldnewthing/archive/2003/07/23/54576.aspx

I use TStringList to search for an instance of TMainWindow in the WndProc function, which is pretty inefficient but should work.

The program crashes as is, and also crashes when using Dispatch in HandleMessage .

Why does it crash immediately after exiting the constructor or a modified version in a Dispatch call?

Answer 1

You call CreateWindow as follows:

 CreateWindow( 'Scratch', { Class Name } 'Scratch', { Title } WS_OVERLAPPEDWINDOW, { Style } Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), { Position } Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), { Size } 0, { Parent } 0, { No menu } HInstance, { Instance } @Self { No special parameters } ) 

In addition to commenting that the last parameter is incorrect, the value is incorrect. The @Self expression is a pointer to a local variable Self . Pointer to a local variable. It will definitely work out. You thought you were passing a pointer to the object to be created, but this is the direct value of Self . Remove @ .

---

There are several simpler ways to associate an object reference with a window handle instead of converting both the handle and the string reference and performing a name search =.

• For starters, you can use a type-safe associative container, such as TDictionary<HWnd, TMainWindow> . This will at least save you all string conversions.

• You can link the object reference directly to the window handle using SetWindowLongPtr and GetWindowLongPtr . You can change your code as follows:

   constructor TMainWindow.Create; // ... wc.cbWndExtra := SizeOf(Self); function GetWindowByHwnd(hwnd: HWnd): TMainWindow; begin Result := TMainWindow(GetWindowLongPtr(hwnd, 0)); end; procedure StoreWindowByHwnd(hwnd: HWND; AWindow: TMainWindow); begin AWindow.FHandle := hwnd; SetWindowLongPtr(hwnd, 0, IntPtr(AWindow)); end; 

  Since you are using "extra window bytes", you need to make sure that the descendants of your window class are not trying to use the same space for something else. You want to provide some kind of mechanism for descendants to “register” that they want spaces, add all descendant requests, and put the total in the cbWndExtra field. Then have a way for posterity to load and store data in the slots that they reserved.

• You can use window properties . Save the reference to the object in the value of the SetProp property in the SetProp message and delete it with RemoveProp in the wm_NCDestroy message.

  Select a property name that is not likely to be used by child classes.

• Finally, you can do what VCL does, namely, to highlight a new windowed window procedure for each object. It has a template procedure that goes into the address of a regular window procedure; it allocates memory for the new stub, populates the template with the current object reference, and then uses that stub pointer when it calls RegisterClassEx .