development/compilers/freepascal/rtl/os2/tests/pmdemo1.pp

   1 {****************************************************************************
   2
   3     $Id$
   4
   5                    Copyright (c) 1999-2000 by Florian Klaempfl
   6
   7  ****************************************************************************}
   8
   9 { Sample program for FPC under OS/2 }
  10 { Classic Hello world in PM version }
  11
  12 {$R pmdemo1.res}
  13
  14 (* PMDEMO1.RES has to be compiled from PMDEMO1.RC using "rc -r PMDEMO1.RC". *)
  15
  16 program pmdemo1;
  17
  18   uses
  19      os2def,pmwin;
  20
  21   var
  22      frame,client : cardinal;
  23      ab : cardinal;
  24      mq : cardinal;
  25      msg : QMSG;
  26
  27   const
  28      frameflags : longint = FCF_TITLEBAR+FCF_SYSMENU+FCF_SIZEBORDER+
  29                             FCF_MINBUTTON+FCF_MAXBUTTON+FCF_SHELLPOSITION+
  30                             FCF_TASKLIST+FCF_MENU;
  31
  32   function clientwndproc(window : cardinal;msg : longint;mp1,mp2 : pointer) :
  33     pointer; cdecl; export;
  34
  35     const
  36        text = 'Hello world by OS/2 and FPC';
  37
  38     var
  39        ps : cardinal;
  40        rcl : RECTL;
  41
  42     begin
  43        {clientwndproc:=nil;      }
  44        case msg of
  45 {         WM_CREATE : DosBeep(200,500);}
  46           WM_PAINT : begin
  47                         ps:=WinBeginPaint(window,0,nil);
  48                         WinQueryWindowRect(window,@rcl);
  49                         WinDrawText(ps,-1,text,@rcl,0,7,$8500);
  50                         WinEndPaint(ps);
  51                      end;
  52           WM_COMMAND : case lo(longint(mp1)) of
  53                           {101 : DosBeep(4500,1000);}
  54                           109 : WinPostMsg(0,WM_QUIT,nil,nil);
  55                           201 : WinMessageBox(cardinal(1),cardinal(1),
  56                              'HelloPM from FPC',
  57                              'About',0,MB_ICONEXCLAMATION+MB_MOVEABLE);
  58                        end;
  59        else
  60           clientwndproc:=WinDefWindowProc(window,msg,mp1,mp2);
  61        end;
  62     end;
  63
  64  begin
  65     ab:=WinInitialize(0);
  66     mq:=WinCreateMsgQueue(ab,0);
  67     WinRegisterClass(ab,'HELLOPM',proc(@clientwndproc),4,0);
  68     frame:=WinCreateStdWindow(cardinal(1),WS_VISIBLE,@frameflags,'HELLOPM',
  69       'PMDemo 1',WS_VISIBLE,0,1,@client);
  70     while WinGetMsg(ab,@msg,0,0,0) do
  71       WinDispatchMsg(ab,@msg);
  72     WinDestroyWindow(frame);
  73     WinDestroyMsgQueue(mq);
  74     WinTerminate(ab);
  75  end.
  76 {
  77   $Log$
  78   Revision 1.1  2002/02/19 08:26:08  sasu
  79   Initial revision
  80
  81   Revision 1.1  2000/07/13 06:31:08  michael
  82   + Initial import
  83
  84   Revision 1.1  2000/07/09 10:37:50  peter
  85     * renamed to lowercase names
  86
  87   Revision 1.6  2000/07/09 07:49:34  hajny
  88     * $R used now
  89
  90   Revision 1.5  2000/06/18 18:37:17  hajny
  91    * cdecl added
  92
  93   Revision 1.4  2000/01/07 16:41:50  daniel
  94     * copyright 2000
  95
  96   Revision 1.3  2000/01/07 16:32:34  daniel
  97     * copyright 2000 added
  98
  99   Revision 1.2  1999/08/10 14:33:51  hajny
 100     * PM samples
 101
 102   Revision 1.1  1999/06/02 16:01:35  hajny
 103     * changes by Ramon Bosque
 104
 105 }