paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-01 15:30:43 +02:00
Code Issues Packages Projects Releases Wiki Activity

* PM samples

Browse Source
This commit is contained in:
Tomas Hajny 1999-08-10 14:33:51 +00:00
parent 796eb74580
commit b52543426b
2 changed files with 74 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
rtl/os2/tests/PMDEMO1.PP
View File

@ -1,11 +1,13 @@
{****************************************************************************
$Id$
Copyright (c) 1993,94 by Florian Kl„mpfl
****************************************************************************}
{ Demonstrationsprogramm zu FPKPascal unter OS/2 }
{ traditionelles Hello world-Porgamm (PM-Version) }
{ Sample program for FPC under OS/2 }
{ Classic Hello world in PM version }
program pmdemo1;
@ -23,11 +25,11 @@ program pmdemo1;
FCF_MINBUTTON+FCF_MAXBUTTON+FCF_SHELLPOSITION+
FCF_TASKLIST+FCF_MENU;
function clientwndproc(window : cardinal;msg : longint;mp1,mp2 : cardinal) :
cardinal;export;
function clientwndproc(window : cardinal;msg : longint;mp1,mp2 : pointer) :
pointer;export;
const
text = 'Hello world by OS/2 and FPKPascal';
text = 'Hello world by OS/2 and FPC';
var
ps : cardinal;
@ -36,7 +38,7 @@ program pmdemo1;
begin
{clientwndproc:=nil; }
case msg of
{WM_CREATE : DosBeep(200,500);}
{ WM_CREATE : DosBeep(200,500);}
WM_PAINT : begin
ps:=WinBeginPaint(window,0,nil);
WinQueryWindowRect(window,@rcl);
@ -47,21 +49,21 @@ program pmdemo1;
{101 : DosBeep(4500,1000);}
109 : WinPostMsg(0,WM_QUIT,nil,nil);
201 : WinMessageBox(cardinal(1),cardinal(1),
'HelloPM von FPKPascal',
'HelloPM from FPC',
'šber',0,MB_ICONEXCLAMATION+MB_MOVEABLE);
end;
else
clientwndproc:=WinDefWindowProc(window,msg,mp1,mp2);
clientwndproc:=WinDefWindowProc(window,msg,mp1,mp2);
end;
end;
begin
ab:=WinInitialize(0);
mq:=WinCreateMsgQueue(ab,0);
WinRegisterClass(ab,'HELLOPM',@clientwndproc,4,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)<>0) do
while WinGetMsg(ab,@msg,0,0,0) do
WinDispatchMsg(ab,@msg);
WinDestroyWindow(frame);
WinDestroyMsgQueue(mq);
@ -69,7 +71,10 @@ program pmdemo1;
end.
{
$Log$
Revision 1.1 1999-06-02 16:01:35 hajny
Revision 1.2 1999-08-10 14:33:51 hajny
* PM samples
Revision 1.1 1999/06/02 16:01:35 hajny
* changes by Ramon Bosque
}

58
rtl/os2/tests/basicpm.pas Normal file
View File

@ -0,0 +1,58 @@
program BasicPM;
uses
Os2Def, PMWin;
function ClientWindowProc (Window, Msg: cardinal; MP1, MP2: pointer): pointer;
cdecl; export;
var
Li: longint;
Ps: cardinal;
R: TRectL;
P: TPointL;
Rgn: cardinal;
begin
ClientWindowProc := nil;
case Msg of
wm_Paint: begin
PS := WinBeginPaint(Window, 0, nil);
{ GpiErase(PS);}
WinEndPaint(PS);
end;
else ClientWindowProc := WinDefWindowProc (Window, Msg, MP1, MP2);
end;
end;
const
idClientWindow = 11000;
WinFlags: cardinal = fcf_TitleBar + fcf_SysMenu + fcf_SizeBorder +
fcf_MinMax + fcf_TaskList + fcf_NoByteAlign;
ClassName = 'MYVIEW';
var
Anchor, MsgQue: cardinal;
Message: TQMsg;
Frame, Client: cardinal;
begin
Anchor := WinInitialize(0);
{ It might be beneficial to set the second parameter of the following }
{ call to something large, such as 1000. The OS/2 documentation does }
{ not recommend this, however } MsgQue := WinCreateMsgQueue(Anchor, 0);
if MsgQue = 0 then Halt (254);
WinRegisterClass (Anchor, ClassName, proc (ClientWindowProc), cs_SizeRedraw,
SizeOf (pointer));
Frame := WinCreateStdWindow (hwnd_Desktop, 0, WinFlags, ClassName,
'BASIC', 0, 0, idClientWindow, Client);
if (Frame <> 0) then
begin
WinSetWindowPos (Frame, 0, 0, WinQuerySysValue (hwnd_Desktop,
sv_CyScreen) - 200, 200, 200, swp_Move + swp_Size + swp_Activate +
swp_Show);
while WinGetMsg (Anchor, Message, 0, 0, 0) do
WinDispatchMsg (Anchor, Message);
WinDestroyWindow (Frame);
end;
WinDestroyMsgQueue (MsgQue);
WinTerminate (Anchor);
end.