OS/2 Shareware BBS: 10 Tools/10-Tools.zip/vp21beta.zip/ORTLSRC.RAR/PMOBJ.PAS

Pascal/Delphi Source File | 2000-08-15 | 4KB | 193 lines

{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█                                                       █}
{█      Virtual Pascal Examples. Version 2.1.            █}
{█      Simple base objects for Presentation Manager.    █}
{█      ─────────────────────────────────────────────────█}
{█      Copyright (C) 1995-2000 vpascal.com              █}
{█                                                       █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

unit PmObj;

{&Use32+}

interface

uses Os2Def, Os2PmApi;

{ Resource ID for main client window }

const
  idClientWindow = 11000;

{ Base PM object }

type
  PPMObject = ^PMObject;
  PMObject = object
    constructor Init;
    procedure Free;
    destructor Done; virtual;
  end;

{ PM Application }

  PPMApplication = ^PMApplication;
  PMApplication = object(PMObject)
    constructor Init;
    procedure   Run;
    destructor  Done; virtual;
  end;

 { PM Window }

  PPMWindow = ^PMWindow;
  PMWindow  = object(PMObject)
    ClassName: PChar;                   { Name of then window class }
    Title: PChar;
    FrameWindow,ClientWindow: HWnd;
    constructor Init(ATitle,AClassName: PChar; ACreateFlags: Longint);
    procedure Register;
    function HandleMessage(Window: HWnd; Msg: ULong; Mp1,Mp2 : MParam): MResult; virtual;
    procedure StartupAction; virtual;
    destructor Done; virtual;
  end;

{ Type cast records }

  WordRec = record
   Lo,Hi: Byte;
  end;

  LongRec = record
   Lo,Hi: SmallWord;
  end;

{ Public variables }

var
  Anchor: HAB;
  MsgQue: HMQ;
  DesktopSize: PointL;

const
  HWndParent: HWnd = hwnd_Desktop;

function ClientWndProc(Window: HWnd; Msg: ULong; Mp1,Mp2: MParam): MResult; cdecl; export;

implementation

{ Private variables }

var
  TempSelf: PPMWindow;

{ Client Window Procedure }

function ClientWndProc(Window: HWnd; Msg: ULong; Mp1,Mp2: MParam): MResult;
var
  PWindow: PPMWindow;
  Exist: Boolean;
begin
  Exist := False;
  PWindow := PPMWindow(WinQueryWindowULong(Window, 0));
  if (PWindow = nil) then
  begin
    if (Msg = wm_Create) then
    begin
      PWindow := TempSelf;
      WinSetWindowULong(Window, 0, Longint(PWindow));
      Exist := True;
    end
  end else Exist := True;
  if Exist then ClientWndProc := PWindow^.HandleMessage(Window, Msg, Mp1, Mp2)
    else ClientWndProc := WinDefWindowProc(Window, Msg, Mp1, Mp2);
end;

{ PMObject }

constructor PMObject.Init;
type
  Image = record
    Link: Longint;
    Data: record end;
  end;
begin
  FillChar(Image(Self).Data, SizeOf(Self) - SizeOf(PMObject), 0);
end;

destructor PMObject.Done;
begin
end;

{ Shorthand procedure for a Done/Dispose }

procedure PMObject.Free;
begin
  Dispose(PPMObject(@Self), Done);
end;

{ PMApplication }

constructor PMApplication.Init;
begin
  inherited Init;
  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);
  DesktopSize.X := WinQuerySysValue(hwnd_Desktop, sv_CxScreen);
  DesktopSize.Y := WinQuerySysValue(hwnd_Desktop, sv_CyScreen);
end;

destructor PMApplication.Done;
begin
  WinDestroyMsgQueue(MsgQue);
  WinTerminate(Anchor);
  inherited Done;
end;

procedure PMApplication.Run;
var
  Message: QMsg;
begin
  while WinGetMsg(Anchor, Message, 0, 0, 0) do WinDispatchMsg(Anchor, Message);
end;

{ PMWindow }

constructor PMWindow.Init(ATitle,AClassName: PChar; ACreateFlags: Longint);
begin
  inherited Init;
  Title := ATitle;
  ClassName := AClassName;
  TempSelf := @Self;
  Register;
  FrameWindow := WinCreateStdWindow(HWndParent, 0, ACreateFlags, ClassName,
    Title, 0, 0, idClientWindow, @ClientWindow);
  StartupAction;
end;

procedure PMWindow.Register;
begin
  WinRegisterClass(Anchor, ClassName, ClientWndProc, cs_SizeRedraw, SizeOf(Pointer));
end;

function PMWindow.HandleMessage(Window: HWnd; Msg: ULong; Mp1,Mp2 : MParam): MResult;
begin
end;

procedure PMWindow.StartupAction;
begin
end;

destructor PMWindow.Done;
begin
  WinDestroyWindow(FrameWindow);
  inherited Done;
end;

end.