diff --git a/rtl/os2/tests/PMDEMO1.PP b/rtl/os2/tests/PMDEMO1.PP index b111a0355c..6b0eb40dcd 100644 --- a/rtl/os2/tests/PMDEMO1.PP +++ b/rtl/os2/tests/PMDEMO1.PP @@ -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 } diff --git a/rtl/os2/tests/basicpm.pas b/rtl/os2/tests/basicpm.pas new file mode 100644 index 0000000000..de4b497d64 --- /dev/null +++ b/rtl/os2/tests/basicpm.pas @@ -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.