Pure API Window

Pure API Window

 

代码

program APIWindow;

uses
SysUtils,
Windows,
Messages;

const
WinClassName = ' MingClass ' ;
StrOut = ' Ming TextOut ' ;

function MyWinProc(
hWindow: HWND;
aMessage: UINT;
WParam: WPARAM;
LParam: LPARAM): LRESULT; stdcall ; export ;
var
dc: HDC;
ps: TPaintStruct;
rect: TRect;
begin
MyWinProc : = 0 ;
case aMessage of
WM_PAINT:
begin
dc : = BeginPaint(hWindow,ps);
GetClientRect(hWindow,rect);
DrawText(dc,StrOut,Length(StrOut),rect,DT_SINGLELINE or DT_CENTER or DT_VCENTER);
// TextOut(dc, 0 , 0 ,StrOut,Length(StrOut));
EndPaint(hWindow,ps);
end ;
WM_LBUTTONDOWN:
begin
dc : = GetDC(hWindow); // GetDC( 0 );
TextOut(dc, 0 , 0 , ' Left Button Down ' ,Length( ' Left Button Down ' ));
ReleaseDC(hWindow,dc);
// ReleaseDC( 0 ,dc);
end ;
WM_CLOSE:
if ID_YES = MessageBox( 0 , ' Are you sure exit ? ' , ' Propmt info ' ,MB_YESNO) then
begin
DestroyWindow(hWindow);
end ;
WM_DESTROY:
begin
PostQuitMessage( 0 );
end ;
else
Result : = DefWindowProc(hWindow,aMessage,WParam,LParam);
end ;
end ;

function WinRegister: Boolean;
var
wndClass: TWndClass;
hInstance: Cardinal;
begin
hInstance : = GetModuleHandle( 0 );
//
wndClass.style : = CS_VREDRAW or CS_HREDRAW;
wndClass.lpfnWndProc : = TFNWndProc(@MyWinProc); // Callback function
wndClass.cbClsExtra : = 0 ;
wndClass.cbWndExtra : = 0 ;
wndClass.hInstance : = hInstance; // Same as System.MainInstance;
wndClass.hIcon : = LoadIcon( 0 ,IDI_INFORMATION);
wndClass.hCursor : = LoadCursor( 0 ,IDC_CROSS);
wndClass.hbrBackground : = HBRUSH(GetStockObject(BLACK_BRUSH));
wndClass.lpszMenuName : = nil ;
wndClass.lpszClassName : = WinClassName;
//
Result : = Windows.RegisterClass(wndClass) <> 0 ;
end ;

function WinCreate: HWND;
var
hWindow: HWND;
hInstance: Cardinal;
begin
hInstance : = GetModuleHandle( 0 );
hWindow : = CreateWindow(
WinClassName
, ' Pure Api Window '
,WS_OVERLAPPEDWINDOW or WS_SIZEBOX or WS_MAXIMIZEBOX
,cw_UseDefault
,cw_UseDefault
, 600
, 400
, 0
, 0
,hInstance // System.MainInstance
, nil );
if hWindow <> 0 then
begin
ShowWindow(hWindow,SW_SHOWNORMAL);
UpdateWindow(hWindow);
end ;
Result : = hWindow;
end ;

var
aMsg: TMsg;
hWindow: HWND;
begin
if not WinRegister then
begin
MessageBox( 0 , ' Register class failed ' , nil , 0 );
exit;
end ;
//
hWindow : = WinCreate;
if hWindow = 0 then
begin
MessageBox( 0 , ' Create window failed ' , nil , 0 );
exit;
end ;
//
while (GetMessage(aMsg, 0 , 0 , 0 )) do
begin
TranslateMessage(aMsg);
DispatchMessage(aMsg);
end ;
Halt(aMsg.wParam);
end .

A new one

代码

program aWindow;

uses
Windows,
Messages;

{ $R *.RES }

var
wClass: TWndClass;
msg: TMsg;

function WindowProc(hWnd,msg,wParam,lParam:Integer):integer; stdcall ;
begin
if msg = WM_DESTROY then PostQuitMessage( 0 );
Result : = DefWindowProc(hWnd,msg,wParam,lParam);
end ;

begin
wClass.lpszClassName : = ' MingClass ' ;
wClass.lpfnWndProc : = @WindowProc;
wClass.hInstance : = HInstance;
wClass.hbrBackground : = 1 ;
RegisterClass(wClass);
CreateWindowEx( 0 ,wClass.lpszClassName, ' Ming Caption ' ,WS_OVERLAPPEDWINDOW or WS_VISIBLE,
100 , 100 , 340 , 220 , 0 , 0 ,HInstance, nil );
while GetMessage(msg, 0 , 0 , 0 ) do
begin
TranslateMessage(msg);
DispatchMessage(msg);
end ;
end .

 

 

转载于:https://www.cnblogs.com/Jekhn/archive/2010/12/27/1918055.html