mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-06 10:52:49 +02:00
84 lines
2.3 KiB
ObjectPascal
84 lines
2.3 KiB
ObjectPascal
{****************************************************************************
|
|
|
|
$Id$
|
|
|
|
Copyright (c) 1999-2000 by Florian Klaempfl
|
|
|
|
****************************************************************************}
|
|
|
|
{ Sample program for FPC under OS/2 }
|
|
{ Classic Hello world in PM version }
|
|
|
|
{$APPTYPE GUI}
|
|
|
|
{$R pmdemo1.res}
|
|
|
|
(* PMDEMO1.RES has to be compiled from PMDEMO1.RC using "rc -r PMDEMO1.RC". *)
|
|
|
|
program pmdemo1;
|
|
|
|
uses
|
|
os2def,pmwin;
|
|
|
|
var
|
|
frame,client : cardinal;
|
|
ab : cardinal;
|
|
mq : cardinal;
|
|
msg : QMSG;
|
|
|
|
const
|
|
frameflags : longint = FCF_TITLEBAR+FCF_SYSMENU+FCF_SIZEBORDER+
|
|
FCF_MINBUTTON+FCF_MAXBUTTON+FCF_SHELLPOSITION+
|
|
FCF_TASKLIST+FCF_MENU;
|
|
|
|
function clientwndproc(window : cardinal;msg : longint;mp1,mp2 : pointer) :
|
|
pointer; cdecl; export;
|
|
|
|
const
|
|
text = 'Hello world by OS/2 and FPC';
|
|
|
|
var
|
|
ps : cardinal;
|
|
rcl : RECTL;
|
|
|
|
begin
|
|
{clientwndproc:=nil; }
|
|
case msg of
|
|
{ WM_CREATE : DosBeep(200,500);}
|
|
WM_PAINT : begin
|
|
ps:=WinBeginPaint(window,0,nil);
|
|
WinQueryWindowRect(window,@rcl);
|
|
WinDrawText(ps,-1,text,@rcl,0,7,$8500);
|
|
WinEndPaint(ps);
|
|
end;
|
|
WM_COMMAND : case lo(longint(mp1)) of
|
|
{101 : DosBeep(4500,1000);}
|
|
109 : WinPostMsg(0,WM_QUIT,nil,nil);
|
|
201 : WinMessageBox(cardinal(1),cardinal(1),
|
|
'HelloPM from FPC',
|
|
'About',0,MB_ICONEXCLAMATION+MB_MOVEABLE);
|
|
end;
|
|
else
|
|
clientwndproc:=WinDefWindowProc(window,msg,mp1,mp2);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
ab:=WinInitialize(0);
|
|
mq:=WinCreateMsgQueue(ab,0);
|
|
WinRegisterClass(ab,'HELLOPM',proc(@clientwndproc),4,0);
|
|
frame:=WinCreateStdWindow(cardinal(1),WS_VISIBLE,@frameflags,'HELLOPM',
|
|
'PMDemo 1',WS_VISIBLE,0,1,@client);
|
|
while WinGetMsg(ab,@msg,0,0,0) do
|
|
WinDispatchMsg(ab,@msg);
|
|
WinDestroyWindow(frame);
|
|
WinDestroyMsgQueue(mq);
|
|
WinTerminate(ab);
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.2 2002-09-07 15:06:35 peter
|
|
* old logs removed and tabs fixed
|
|
|
|
}
|