{$APPTYPE GUI}
{$MODE DELPHI}
program Win32_Source08;
uses windows;
{$r source08_resource.rc}
const
AppName = 'Win32/ FPC - Source 08';
MenuName = '10';
var
active : BOOLEAN;
Amsg : MSG;
hWindow : hwnd;
dcWindow : hdc;
ps : paintstruct;
r : rect;
// Try, Throw, Catch mechanism. Simple proc to display given errors. //
procedure ThrowError(pcErrorMessage : pChar);
begin
MessageBox(0, pcErrorMessage, 'Error', MB_OK);
Halt(0);
end;
// WinProc to handle Windows messages. //
function WindowProc(hEventWindow : hwnd; Umsg : DWORD; wParam : WPARAM;
lParam : LPARAM) : LRESULT;stdcall;
begin
Result := 0;
case (Umsg) of
WM_ACTIVATE : begin
active := true;
end;
WM_DESTROY : begin
active := false;
PostQuitMessage(0);
Exit;
end;
WM_KEYDOWN : begin
active := false;
end;
WM_PAINT : begin
dcWindow := BeginPaint(hWindow ,@ps);
GetClientRect(hWindow, @r);
SetBKMode(dcWindow, TRANSPARENT);
SetTextColor(dcWindow, RGB(0,0,0));
DrawText(dcWindow, 'Note the Windows menu up there.', -1, @r,
DT_SINGLELINE or DT_CENTER or DT_VCENTER);
EndPaint(hWindow, ps);
end;
WM_COMMAND : begin
case (LOWORD(wParam)) of
11 :
begin // message 1
MessageBox(0, 'This is message 1.', 'Message', MB_OK);
end;
12 :
begin // message 2
MessageBox(0, 'This is message 2.', 'Message', MB_OK);
end;
19 :
begin // exit application
active := false;
end;
21 :
begin // about
MessageBox(0, 'This is a simple example to show you how menus work.', 'About', MB_OK);
end;
end; // case
end; // wm_command
else
Result := DefWindowProc(hEventWindow, Umsg, wParam, lParam);
end;
end;
// Register the Window Class //
procedure RegisterWindow();
var
WinClass: WndClassEx;
begin
WinClass.cbSize := Sizeof(WndClassEx);
WinClass.Style := cs_hRedraw OR cs_vRedraw;
WinClass.lpfnWndProc := WndProc(@WindowProc);
WinClass.cbClsExtra := 0;
WinClass.cbWndExtra := 0;
WinClass.hInstance := system.MainInstance;
WinClass.hIcon := LoadIcon(system.MainInstance, makeintresource(1));
WinClass.hCursor := LoadCursor(0, idc_Arrow);
WinClass.hbrBackground := GetStockObject(LTGRAY_BRUSH);
WinClass.lpszMenuName := MenuName;
WinClass.lpszClassName := 'WindowClass';
WinClass.hIconSm := LoadIcon(system.MainInstance, makeintresource(1));
if RegisterClassEx(WinClass) = 0 then ThrowError('Registering the Windows Class failed!');
end;
// Create the window. Throw error if this fails. //
procedure CreateWindow();
begin
hWindow := CreateWindowEx(WS_EX_TOPMOST, 'WindowClass', AppName,WS_CAPTION OR WS_POPUPWINDOW OR WS_VISIBLE,
0, 0, 640, 480,0, 0,system.MainInstance,NIL);
if hWindow <> 0 then
begin
ShowWindow(hWindow, CmdShow);
ShowWindow(hWindow, SW_SHOW);
UpdateWindow(hWindow);
end
else ThrowError('Window could not be created');
end;
// Destroy the window. //
procedure KillWindow();
begin
DestroyWindow(hWindow);
end;
// Main. //
begin
active := false;
RegisterWindow();
CreateWindow();
// Main loop. //
repeat
if PeekMessage(@Amsg,0,0,0,0) = TRUE then
begin // if message waiting then get it
GetMessage(@Amsg,0,0,0);
TranslateMessage(Amsg);
DispatchMessage(Amsg);
end;
// -------- enter main loop code here -------- //
until active = false;
KillWindow();
end.