program generic;
{ generic template program used to incorporate examples of the "Windows API }
{ bible }
{$R generic.res }
uses WinTypes, WinProcs, Resources, WinWrite;
const
AppName = 'Generic';
{-----------------------------------------------------------------------------}
function ChildProc (Wnd : hWnd;
Msg : word;
wParam : Word;
lParam : LongInt) : LongInt; export;
{ procedure for Child window. Note that CHILD windows are never active! }
begin
{ simply let the default window procedure take care of everything }
case msg of
WM_MOUSEMOVE:
begin
SendMessage (GetParent (Wnd), msg, wparam, lParam);
end;
end;
ChildProc := DefWindowProc (Wnd, Msg, wParam, lParam);
end;
function InitChildClass (ChildClass : PChar) : Bool;
{ registers the Child's window class }
var
cls : TWndClass;
begin
if not GetClassInfo (hInstance, ChildClass, cls) then
begin
with cls do begin
style := cs_VRedraw or cs_HRedraw;
lpfnWndProc := @ChildProc;
cbClsExtra := 0;
cbWndExtra := 0;
hInstance := system.hInstance; { qualify instance! }
hIcon := LoadIcon (0, idi_Application);
hCursor := LoadCursor (0, idc_Cross);
hbrBackground := COLOR_WINDOW + 1;
lpszMenuName := nil; { cannot have menu! }
lpszClassName := ChildClass;
end; { with }
InitChildClass := RegisterClass (cls);
end
else InitChildClass := True;
end;
{-----------------------------------------------------------------------------}
function WndProc (Wnd : hWnd;
Msg : word;
wParam : Word;
lParam : LongInt) : LongInt; export;
{ procedure for main window }
const
Text_1 : hWnd = 0;
Text_2 : hWnd = 0;
ChildWnd : hWnd = 0;
const
ChildClass = 'ChildWindow';
var
dc : HDC;
point : TPOINT;
PointWnd : hWnd; { window that contains the point }
WindowText : array [0..255] of Char;
begin
WndProc := 0; { default function result }
case Msg of
WM_CREATE:
begin
Text_1 := CreateWindow ('STATIC',
'Static Text Window 1',
WS_CHILD or WS_VISIBLE or BS_PUSHBUTTON,
10,
40,
140,
20,
Wnd,
100, { Child ID ! not a menu }
hInstance,
nil);
if Text_1 = 0 then halt (255);
Text_2 := CreateWindow ('STATIC',
'Static Text Window 2',
WS_CHILD or WS_VISIBLE,
10,
60,
140,
20,
Wnd,
101, { Child ID }
hInstance,
nil);
if Text_2 = 0 then halt (255);
if not InitChildClass (ChildClass) then halt (255); { register it }
ChildWnd := CreateWindow (ChildClass,
'ChildWindow',
WS_CHILD or WS_VISIBLE or
WS_BORDER or WS_CAPTION or WS_CLIPSIBLINGS,
70,
70,
240,
340,
Wnd, { parent window }
102,
hInstance,
nil);
exit;
end;
WM_MOUSEMOVE:
begin
point := MAKEPOINT(lParam);
PointWnd := ChildWindowFromPoint (Wnd, point);
if PointWnd <> 0
then GetWindowText (PointWnd, WindowText, sizeof (WindowText))
else lstrcpy (WindowText,'<<none>>'#0);
dc := GetDC (Wnd);
Write (WW, 'Mouse Coordinates are: ', 'X: ', point.x:5,
'Y: ', point.y:5);
TextOut (dc, 400, 0, WWRetZ, WWRetL);
ReleaseDC (Wnd, dc);
dc := GetDC (Wnd);
Write (WW, 'Child Window Text: ', WindowText);
TextOut (dc, 0, 0, WWRetZ, WWRetL);
ReleaseDC (Wnd, dc);
{ do the same thing but using WindowFromPoint instead }
PointWnd := WindowFromPoint (point);
if PointWnd <> 0
then GetWindowText (PointWnd, WindowText, sizeof (WindowText))
else lstrcpy (WindowText,'<<none>>'#0);
dc := GetDC (Wnd);
Write (WW, 'WindowFromPoint says: ', WindowText);
TextOut (dc, 0, 20, WWRetZ, WWRetL);
ReleaseDC (Wnd, dc);
exit;
end;
WM_COMMAND :
begin
case wParam of
IDM_QUIT :
begin
DestroyWindow (Wnd);
exit;
end;
end;
end;
WM_DESTROY :
begin
PostQuitMessage (0); { send WM_QUIT msg }
exit;
end;
end; { case }
WndProc := DefWindowProc (Wnd, Msg, wParam, lParam);
end;
function InitAppClass: Bool;
{ registers the application's window classes }
var
cls : TWndClass;
begin
if not GetClassInfo (hInstance, AppName, cls) then
begin
with cls do begin
style := cs_VRedraw or cs_HRedraw;
lpfnWndProc := @WndProc;
cbClsExtra := 0;
cbWndExtra := 0;
hInstance := system.hInstance; { qualify instance! }
hIcon := LoadIcon (0, idi_Application);
hCursor := LoadCursor (0, idc_Arrow);
hbrBackground := COLOR_WINDOW + 1;
lpszMenuName := AppName;
lpszClassName := AppName;
end; { with }
InitAppClass := RegisterClass (cls);
end
else InitAppClass := True;
end;
Function WinMain : integer;
{ application entry point }
var
Wnd : hWnd;
Msg : TMsg;
begin
if not InitAppClass then Halt (255); { register application's class }
{ Create the main application window }
Wnd := CreateWindow (AppName, { class name }
AppName, { window caption text }
ws_OverlappedWindow or { window style }
ws_clipchildren,
cw_UseDefault, { x pos on screen }
cw_UseDefault, { y pos on screen }
cw_UseDefault, { window width }
cw_UseDefault, { window height }
0, { parent window handle }
0, { menu handle 0 = use class }
hInstance, { instance handle }
Nil); { parameter sent to WM_CREATE }
if Wnd = 0 then halt; { could not create the window }
{ the call to showwindow is not needed if ws_visible is specified in create }
{ window call. However, it should still be done so that the window is dis- }
{ played according to the cmdShow parameter }
ShowWindow (Wnd, cmdShow); { make the window visible }
UpdateWindow (Wnd); { send 1st WM_PAINT message }
while GetMessage (Msg, 0, 0, 0) do { wait for message }
begin
TranslateMessage (Msg); { key conversions }
DispatchMessage (Msg); { send to window procedure }
end;
WinMain := msg.wParam; { terminate with return code }
end;
begin
WinMain;
end.
Recent
