1,183
社区成员
发帖
与我相关
我的任务
分享
program Project1;
uses
Forms,
Windows,
SysUtils,
Messages,
Dialogs;
type
TMyForm = class(TObject)
private
winclass:WNDCLASSA;
hwindow:HWND;
Amsg:TMsg;
FAppName:string;
FWndproc:TFNAPCProc;
function winregister():Boolean;
procedure CreateMyWindow;
public
constructor Create;
destructor Destroy;override;
procedure WinCreate;
procedure MyRun;
procedure CreateButton(x,y:Integer;className,windowName:string);
property ApplicationName : string read FAppName write FAppName;
property MyProcedure : TFNAPCProc read FWndproc write FWndproc;
end;
const
AppName = 'Myclass';
var
Mywindow:TMyForm;
{ TMyForm }
constructor TMyForm.Create;
begin
end;
procedure TMyForm.CreateButton(x,y:Integer;className,windowName:string);
var
hMyButton:HWND;
begin
hMyButton:=CreateWindow(PAnsiChar(className),PAnsiChar(windowName),WS_VISIBLE or WS_Child or BS_Bitmap,
x,y,65,24,hwindow,0,system.MainInstance,nil);
ShowWindow(hMyButton,CmdShow);
ShowWindow(hMyButton,SW_SHOWNORMAL);
UpdateWindow(hMyButton);
end;
procedure TMyForm.CreateMyWindow;
begin
hwindow := CreateWindowEx(WS_EX_CLIENTEDGE,PAnsiChar(FAppName),AppName,WS_OVERLAPPEDWINDOW,100,
100,600,400,0,0,SYSTEM.MainInstance,nil);
// hwindow := CreateWindow(AppName,'创建窗口',WS_OVERLAPPED,CW_USEDEFAULT,
// CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,0,0,SYSTEM.MainInstance,nil);
if hwindow <> 0 then
begin
ShowWindow(hwindow,CmdShow);
ShowWindow(hwindow,SW_SHOWNORMAL);
UpdateWindow(hwindow);
CreateButton(75,175,'BUTTON','Mybutton1');
CreateButton(75,275,'BUTTON','Mybutton2');
end;
end;
destructor TMyForm.Destroy;
begin
inherited;
end;
procedure TMyForm.MyRun;
begin
while GetMessage(Amsg,0,0,0) do
begin
TranslateMessage(Amsg);
DispatchMessage(Amsg);
end;
Halt(Amsg.wParam);
end;
procedure TMyForm.WinCreate;
begin
if winregister then
begin
CreateMyWindow;
end;
end;
function TMyForm.winregister: Boolean;
begin
winclass.style := CS_HREDRAW or CS_VREDRAW;
winclass.lpfnWndProc := FWndproc;
winclass.cbClsExtra := 0;
winclass.cbWndExtra := 0;
winclass.hInstance := System.MainInstance;
winclass.hIcon := LoadIcon(0,IDI_APPLICATION);
winclass.hCursor := LoadCursor(0,IDC_ARROW);
winclass.hbrBackground := GetStockObject(WHITE_BRUSH);
winclass.lpszMenuName := nil;
winclass.lpszClassName := PChar(FAppName);
Result := RegisterClass(winclass)<> 0;
end;
function WindowProc(hwnd:HWND;umsg:UINT;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;export;
var
dc:HDC;
ps:TPaintStruct;
r:TRect;
Curxy:TPoint;
begin
WindowProc := 0 ;
case umsg of
WM_PAINT:
begin
dc := BeginPaint(hwnd,ps);
GetClientRect(hwnd,r);
DrawText(dc,'哈哈哈',-1,r,DT_SINGLELINE or DT_CENTER or DT_VCENTER);
EndPaint(hwnd,ps);
Exit;
end;
WM_DESTROY:
begin
PostQuitMessage(0);
Exit;
end;
WM_COMMAND:
begin
if GetCursorPos(Curxy) then
if Curxy.Y < 350 then
begin
ShowMessage('按钮1按下了');
end
else
begin
ShowMessage('按钮2按下了');
end;
end;
end;
WindowProc := DefWindowProc(hwnd,umsg,wParam,lParam);
end;
begin
Mywindow := TMyForm.Create;
Mywindow.ApplicationName := AppName;
Mywindow.FWndproc := TFNAPCProc(@WindowProc);
Mywindow.WinCreate;
try
Mywindow.MyRun;
// Mywindow.CreateButton;
finally
FreeAndNil(Mywindow);
end;
end.