program PMyWindowClass;
uses
Windows,
Messages,
SysUtils;
type
TMyWindow = class(TObject)
private
{ Private declarations }
WindowClass: WndClass;
hWindow: HWnd;
AMessage: TMsg;
FAppName : String;
FWndProc : TFNWndProc;
function WinRegister : Boolean; virtual;
procedure CreateMyWindow;
public
{ Public declarations }
constructor Create;
destructor Destroy; override;
procedure WinCreate; virtual;
procedure MyRun;
property ApplicationName : String read FAppName write FAppName;
property WindowProcedure : TFNWndProc read FWndProc write FWndProc;
end;
const
AppName = 'MyClassDemo';
var
myWindow : TMyWindow;
{ TMyWindow }
constructor TMyWindow.Create;
begin
end;
destructor TMyWindow.Destroy;
begin
inherited;
end;
procedure TMyWindow.CreateMyWindow;
begin
hWindow := CreateWindow(AppName, '面向对象方式设计窗口应用程序的范例',
ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
cw_UseDefault, cw_UseDefault, 0, 0, system.MainInstance, nil);
if hWindow <> 0 then begin
ShowWindow(hWindow, CmdShow);
ShowWindow(hWindow, SW_SHOW);
UpdateWindow(hWindow);
end;
end;
procedure TMyWindow.WinCreate;
begin
if WinRegister then
begin
CreateMyWindow;
end;
end;
function TMyWindow.WinRegister : Boolean;
begin
WindowClass.Style := cs_hRedraw or cs_vRedraw;
WindowClass.lpfnWndProc := FWndProc;
WindowClass.cbClsExtra := 0;
WindowClass.cbWndExtra := 0;
WindowClass.hInstance := system.MainInstance;
WindowClass.hIcon := LoadIcon(0, idi_Application);
WindowClass.hCursor := LoadCursor(0, idc_Arrow);
WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH);
WindowClass.lpszMenuName := nil;
WindowClass.lpszClassName := PChar(FAppName);
Result := RegisterClass(WindowClass) <> 0;
end;
//
//Window Message Handling Procedure
//
function WindowProc(Window: HWnd; AMessage: UINT; WParam : WPARAM;
LParam: LPARAM): LRESULT; stdcall; export;
var
dc : hdc;
ps : TPaintStruct;
r : TRect;
begin
WindowProc := 0;
case AMessage of
WM_PAINT :
begin
dc := BeginPaint(Window,ps);
GetClientRect(Window,r);
DrawText(dc,'使用TMyWindow类封装的Windows程序。这导致了使用面向对象方式设计窗口应用程序',-1,r,
DT_SINGLELINE or DT_CENTER or DT_VCENTER);
EndPaint(Window,ps);
Exit;
end;
wm_Destroy:
begin
PostQuitMessage(0);
Exit;
end;
end;
WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
end;
procedure TMyWindow.MyRun;
begin
while GetMessage(AMessage, 0, 0, 0) do begin
TranslateMessage(AMessage);
DispatchMessage(AMessage);
end;
Halt(AMessage.wParam);
end;
begin
myWindow := TMyWindow.Create;
myWindow.ApplicationName := AppName;
myWindow.WindowProcedure := TFNWndProc(@WindowProc);
myWindow.WinCreate;
try
myWindow.MyRun;
finally
FreeAndNil(myWindow);
end;
end.
http://blog.csdn.net/diligentcatrich/article/details/8072649