home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 25 / nopv25.iso / 040A / TMTP100O.ZIP / EXAMPLES / OS2 / SKELETON / SKELETON.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-26  |  2.9 KB  |  104 lines

  1. { $r skeleton.res}              {$r-}
  2.  
  3. uses Os2Types, os2pmApi, About;
  4.  
  5. type
  6.   FnWp = function conv arg_cdecl (hWnd: HWnd; Msg: ULong; Mp1,Mp2: MParam): MResult;
  7.  
  8. {$i skeleton.inc}      
  9. {$r skeleton.res} { $r-}
  10.  
  11. type PMSkeleton = object
  12.                      hab:           hab;
  13.                      hmq:           hmq;
  14.                      flFrameFlags:  ulong;
  15.                      szClientClass: pchar;
  16.                      hWndFrame:     hwnd;
  17.                      hWndClient:    hwnd;
  18.                      qmsg:          qmsg;
  19.                      szTitle:       array [0..64] of char;
  20.                      --pragma Calling_Convention(CallConv.C);
  21.                      ClientWndProc: FnWp; { function (hWnd: hWnd; msg: ulong; mp1: mparam; mp2: mparam): mresult;}
  22.                      --pragma Calling_Convention();
  23.  
  24.                      constructor Init (flags: ULONG; ClientClass: Pchar; Id: ulong; Cproc: FnWp);
  25.                      procedure   MainLoop; virtual;
  26.                      destructor  Done; virtual;
  27.  
  28.                   end;
  29.  
  30. constructor PMSkeleton.Init (flags: ULONG; ClientClass: Pchar; Id: ulong; Cproc: FnWp);
  31. begin
  32.     flFrameFlags := flags;
  33.     hab := WinInitialize (0);
  34.     hmq := WinCreateMsgQueue (hab, 0);
  35.     if hmq = 0 then Halt (1001);
  36.     szClientClass := ClientClass;
  37.     ClientWndProc := Cproc;
  38.  
  39.     WinRegisterClass (hab, szClientClass, @ClientWndProc, 0, 0);
  40.     WinLoadString (hab, 0, Id, sizeof(szTitle), szTitle);
  41.  
  42.     hWndFrame := WinCreateStdWindow (HWND_DESKTOP, WS_VISIBLE,
  43.         flFrameFlags, szClientClass, szTitle, 0, 0, Id, hWndClient);
  44. end;
  45.  
  46. procedure PMSkeleton.MainLoop;
  47. begin
  48.     while WinGetMsg (hab, qmsg, 0, 0, 0) <> 0 do
  49.         WinDispatchMsg (hab, qmsg);
  50. end;
  51.  
  52. destructor PMSkeleton.Done;
  53. begin
  54.     WinDestroyWindow (hWndFrame);
  55.     WinDestroyMsgQueue (hmq);
  56.     WinTerminate (hab);
  57.     { return (0); }
  58. end;
  59.  
  60. var Appl: PMSkeleton;
  61.  
  62. function ClientWndProc conv arg_cdecl (hWnd: hWnd; msg: ulong; mp1, mp2: mparam): mresult;
  63.  
  64.    var vhps: hps;
  65.        bHandled: boolean;
  66.        mReturn: mresult;
  67. begin
  68.     bHandled := TRUE;
  69.     mReturn  := 0;
  70.  
  71.     case msg of
  72.        WM_PAINT:
  73.           begin
  74.              vhps := WinBeginPaint (hWnd,0, prectl(0));
  75.              WinEndPaint (vhps);
  76.           end;
  77.  
  78.        WM_ERASEBACKGROUND:
  79.           mReturn := 1;
  80.  
  81.        WM_COMMAND:
  82.           if mp1 = IDM_ABOUT then
  83.                  DisplayAbout (hWnd, Appl.szTitle);
  84.        else
  85.           bHandled := FALSE;
  86.     end;
  87.  
  88.     if not bHandled then
  89.         mReturn := WinDefWindowProc (hWnd, msg, mp1, mp2);
  90.  
  91.     result := mReturn;
  92. end;
  93.  
  94. begin
  95.   Appl.Init (FCF_TITLEBAR + FCF_SYSMENU + FCF_SIZEBORDER +
  96.              FCF_MINMAX   + FCF_SHELLPOSITION + FCF_TASKLIST +
  97.              FCF_ICON     + FCF_MENU, 'Client',
  98.              Id_appname,
  99.              ClientWndProc
  100.             );
  101.   Appl.MainLoop;
  102.   Appl.Done;
  103. end.
  104.