mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 08:29:29 +02:00
+ Initial revision
This commit is contained in:
parent
93d4d1f228
commit
3a46ae8390
118
install/demo/win32/hello.pp
Normal file
118
install/demo/win32/hello.pp
Normal file
@ -0,0 +1,118 @@
|
||||
{
|
||||
$Id$
|
||||
Copyright (c) 1996 by Charlie Calvert
|
||||
Modifications by Florian Klaempfl
|
||||
|
||||
Standard Windows API application written in Object Pascal.
|
||||
No VCL code included. This is all done on the Windows API
|
||||
level.
|
||||
}
|
||||
|
||||
{$APPTYPE GUI}
|
||||
{$MODE DELPHI}
|
||||
program Window1;
|
||||
|
||||
uses
|
||||
Strings, Windows;
|
||||
|
||||
const
|
||||
AppName = 'Window1';
|
||||
|
||||
function WindowProc(Window: HWnd; AMessage, WParam,
|
||||
LParam: Longint): Longint; stdcall; export;
|
||||
|
||||
var
|
||||
dc : hdc;
|
||||
ps : paintstruct;
|
||||
r : rect;
|
||||
|
||||
begin
|
||||
WindowProc := 0;
|
||||
|
||||
case AMessage of
|
||||
wm_paint:
|
||||
begin
|
||||
dc:=BeginPaint(Window,@ps);
|
||||
GetClientRect(Window,@r);
|
||||
DrawText(dc,'Hello world by Free Pascal',-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;
|
||||
|
||||
{ Register the Window Class }
|
||||
function WinRegister: Boolean;
|
||||
var
|
||||
WindowClass: WndClass;
|
||||
begin
|
||||
WindowClass.Style := cs_hRedraw or cs_vRedraw;
|
||||
WindowClass.lpfnWndProc := WndProc(@WindowProc);
|
||||
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 := AppName;
|
||||
|
||||
Result := RegisterClass(WindowClass) <> 0;
|
||||
end;
|
||||
|
||||
{ Create the Window Class }
|
||||
function WinCreate: HWnd;
|
||||
var
|
||||
hWindow: HWnd;
|
||||
begin
|
||||
hWindow := CreateWindow(AppName, 'Hello world program',
|
||||
ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
|
||||
cw_UseDefault, cw_UseDefault, 0, 0, system.MainInstance, nil);
|
||||
|
||||
if hWindow <> 0 then begin
|
||||
ShowWindow(hWindow, CmdShow);
|
||||
UpdateWindow(hWindow);
|
||||
end;
|
||||
|
||||
Result := hWindow;
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
AMessage: Msg;
|
||||
i : byte;
|
||||
hWindow: HWnd;
|
||||
exename : pchar;
|
||||
|
||||
begin
|
||||
if not WinRegister then begin
|
||||
MessageBox(0, 'Register failed', nil, mb_Ok);
|
||||
Exit;
|
||||
end;
|
||||
hWindow := WinCreate;
|
||||
if longint(hWindow) = 0 then begin
|
||||
MessageBox(0, 'WinCreate failed', nil, mb_Ok);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
while GetMessage(@AMessage, 0, 0, 0) do begin
|
||||
TranslateMessage(AMessage);
|
||||
DispatchMessage(AMessage);
|
||||
end;
|
||||
Halt(AMessage.wParam);
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-10-27 15:22:35 florian
|
||||
+ Initial revision
|
||||
|
||||
}
|
Loading…
Reference in New Issue
Block a user