home *** CD-ROM | disk | FTP | other *** search
/ Software of the Month Club 1995 December / SOFM_Dec1995.bin / pc / os2 / vpascal / source / rtl / pmobj.pas < prev    next >
Pascal/Delphi Source File  |  1995-10-31  |  4KB  |  187 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal Examples. Version 1.0.            █}
  4. {█      Simple base objects for Presentation Manager.    █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 1995 B&M&T Corporation             █}
  7. {█      ─────────────────────────────────────────────────█}
  8. {█      Written by Vitaly Miryanov                       █}
  9. {█                                                       █}
  10. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  11.  
  12. unit PmObj;
  13.  
  14. interface
  15.  
  16. uses Os2Def, Os2PmApi, Use32;
  17.  
  18. { Resource ID for main client window }
  19.  
  20. const
  21.   idClientWindow = 11000;
  22.  
  23. { Base PM object }
  24.  
  25. type
  26.   PPMObject = ^PMObject;
  27.   PMObject = object
  28.     constructor Init;
  29.     procedure Free;
  30.     destructor Done; virtual;
  31.   end;
  32.  
  33. { PM Application }
  34.  
  35.   PPMApplication = ^PMApplication;
  36.   PMApplication = object(PMObject)
  37.     constructor Init;
  38.     procedure   Run;
  39.     destructor  Done; virtual;
  40.   end;
  41.  
  42.  { PM Window }
  43.  
  44.   PPMWindow = ^PMWindow;
  45.   PMWindow  = object(PMObject)
  46.     ClassName: PChar;                   { Name of then window class }
  47.     Title: PChar;
  48.     FrameWindow,ClientWindow: HWnd;
  49.     constructor Init(ATitle,AClassName: PChar; ACreateFlags: Longint);
  50.     procedure Register;
  51.     function HandleMessage(Window: HWnd; Msg: ULong; Mp1,Mp2 : MParam): MResult; virtual;
  52.     procedure StartupAction; virtual;
  53.     destructor Done; virtual;
  54.   end;
  55.  
  56. { Type cast records }
  57.  
  58.   WordRec = record
  59.    Lo,Hi: Byte;
  60.   end;
  61.  
  62.   LongRec = record
  63.    Lo,Hi: SmallWord;
  64.   end;
  65.  
  66. { Public variables }
  67.  
  68. var
  69.   Anchor: HAB;
  70.   MsgQue: HMQ;
  71.   DesktopSize: PointL;
  72.  
  73. function ClientWndProc(Window: HWnd; Msg: ULong; Mp1,Mp2: MParam): MResult; cdecl; export;
  74.  
  75. implementation
  76.  
  77. { Private variables }
  78.  
  79. var
  80.   TempSelf: PPMWindow;
  81.  
  82. { Client Window Procedure }
  83.  
  84. function ClientWndProc(Window: HWnd; Msg: ULong; Mp1,Mp2: MParam): MResult;
  85. var
  86.   PWindow: PPMWindow;
  87.   Exist: Boolean;
  88. begin
  89.   Exist := False;
  90.   PWindow := PPMWindow(WinQueryWindowULong(Window, 0));
  91.   if (PWindow = nil) then
  92.   begin
  93.     if (Msg = wm_Create) then
  94.     begin
  95.       PWindow := TempSelf;
  96.       WinSetWindowULong(Window, 0, Longint(PWindow));
  97.       Exist := True;
  98.     end
  99.   end else Exist := True;
  100.   if Exist then ClientWndProc := PWindow^.HandleMessage(Window, Msg, Mp1, Mp2)
  101.     else ClientWndProc := WinDefWindowProc(Window, Msg, Mp1, Mp2);
  102. end;
  103.  
  104. { PMObject }
  105.  
  106. constructor PMObject.Init;
  107. type
  108.   Image = record
  109.     Link: Longint;
  110.     Data: record end;
  111.   end;
  112. begin
  113.   FillChar(Image(Self).Data, SizeOf(Self) - SizeOf(PMObject), 0);
  114. end;
  115.  
  116. destructor PMObject.Done;
  117. begin
  118. end;
  119.  
  120. { Shorthand procedure for a Done/Dispose }
  121.  
  122. procedure PMObject.Free;
  123. begin
  124.   Dispose(PPMObject(@Self), Done);
  125. end;
  126.  
  127. { PMApplication }
  128.  
  129. constructor PMApplication.Init;
  130. begin
  131.   inherited Init;
  132.   Anchor := WinInitialize(0);
  133.   MsgQue := WinCreateMsgQueue(Anchor, 0);
  134.   if MsgQue = 0 then Halt(254);
  135.   DesktopSize.X := WinQuerySysValue(hwnd_Desktop, sv_CxScreen);
  136.   DesktopSize.Y := WinQuerySysValue(hwnd_Desktop, sv_CyScreen);
  137. end;
  138.  
  139. destructor PMApplication.Done;
  140. begin
  141.   WinDestroyMsgQueue(MsgQue);
  142.   WinTerminate(Anchor);
  143.   inherited Done;
  144. end;
  145.  
  146. procedure PMApplication.Run;
  147. var
  148.   Message: QMsg;
  149. begin
  150.   while WinGetMsg(Anchor, Message, 0, 0, 0) do WinDispatchMsg(Anchor, Message);
  151. end;
  152.  
  153. { PMWindow }
  154.  
  155. constructor PMWindow.Init(ATitle,AClassName: PChar; ACreateFlags: Longint);
  156. begin
  157.   inherited Init;
  158.   Title := ATitle;
  159.   ClassName := AClassName;
  160.   TempSelf := @Self;
  161.   Register;
  162.   FrameWindow := WinCreateStdWindow(HWnd_Desktop, 0, ACreateFlags, ClassName,
  163.     Title, 0, 0, idClientWindow, ClientWindow);
  164.   StartupAction;
  165. end;
  166.  
  167. procedure PMWindow.Register;
  168. begin
  169.   WinRegisterClass(Anchor, ClassName, ClientWndProc, cs_SizeRedraw, SizeOf(Pointer));
  170. end;
  171.  
  172. function PMWindow.HandleMessage(Window: HWnd; Msg: ULong; Mp1,Mp2 : MParam): MResult;
  173. begin
  174. end;
  175.  
  176. procedure PMWindow.StartupAction;
  177. begin
  178. end;
  179.  
  180. destructor PMWindow.Done;
  181. begin
  182.   WinDestroyWindow(FrameWindow);
  183.   inherited Done;
  184. end;
  185.  
  186. end.
  187.