如何在不使用VCL的情况下使用自定义Delphi类创建窗口?
我正在尝试编写一个包含类TMainWindow的简单单元,以提高我对本机
Windows API的了解.
我想像这样使用这个类: var MainWindow: TMainWindow; begin MainWindow := TMainWindow.Create; try MainWindow.ShowModal; finally MainWindow.Free; end; end. 我有一个几乎工作的原型,但我找不到问题,这是我到目前为止编写的代码: 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),{ 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.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.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) 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,Msg.Width,Msg.Height,True); end; end; initialization WindowByHwnd := TStringList.Create; finalization WindowByHwnd.Free; end. 该代码部分基于Raymond Chen的临时程序: 我正在使用TStringList在WndProc函数中查找TMainWindow的实例,这是非常低效的,但应该可以工作. 当我在HandleMessage函数中使用Dispatch时,程序按原样崩溃并崩溃. 为什么在离开构造函数后或在Dispatch调用中的修改版本中它会立即崩溃? 解决方法
你这样调用CreateWindow:
CreateWindow( 'Scratch',{ Class Name } 'Scratch',{ Title } WS_OVERLAPPEDWINDOW,{ Style } Integer(CW_USEDEFAULT),{ Position } Integer(CW_USEDEFAULT),{ Size } 0,{ Parent } 0,{ No menu } HInstance,{ Instance } @Self { No special parameters } ) 除了对最终参数的错误评论外,该值也是错误的.表达式@Self是指向本地Self变量的指针.指向局部变量的指针.这一定很糟糕.你以为你正在传递一个指向正在创建的对象的指针,但这是由Self的值直接给出的.除掉 @. 有一些更直接的方法可以将对象引用与窗口句柄相关联,而不是将句柄和对字符串的引用都转换为进行name = value查找. >对于初学者,你可以使用一个类型安全的关联容器,比如 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,IntPtr(AWindow)); end; 由于您使用的是“额外窗口字节”,因此您需要确保窗口类的后代不会尝试将相同的空间用于其他内容.您希望为后代提供某种机制来“注册”他们想要的空间,将所有后代的请求相加,并将总数放在cbWndExtra字段中.然后让后代在他们保留的插槽中加载和存储数据. 选择一个不太可能被后代类使用的属性名称.>最后,您可以执行VCL所做的工作,即为每个对象分配一个新的“存根”窗口过程.它有一个模板程序跳转到常规窗口程序的地址;它为新存根分配内存,使用当前对象引用填充模板,然后在调用RegisterClassEx时使用该存根指针. (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |