* PM samples

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
 
 }

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.