home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 13.ddi / RTLOWL.ZIP / OWINDOWS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-10-28  |  95.1 KB  |  3,274 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal for Windows Run-time Library       }
  5. {       ObjectWindows Unit                              }
  6. {                                                       }
  7. {       Copyright (c) 1992 Borland International        }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit OWindows;
  12.  
  13. {$T-}
  14.  
  15. interface
  16.  
  17. uses WinTypes, WinProcs, Objects;
  18.  
  19. { Include resource file constants }
  20.  
  21. {$I OWINDOWS.INC}
  22.  
  23. const
  24.  
  25. { TWindowsObject Flags masks }
  26.  
  27.   wb_KBHandler    = $01;
  28.   wb_FromResource = $02;
  29.   wb_AutoCreate   = $04;
  30.   wb_MDIChild     = $08;
  31.   wb_Transfer     = $10;
  32.  
  33. { TWindowsObject Status codes }
  34.  
  35.   em_InvalidWindow     = -1;
  36.   em_OutOfMemory       = -2;
  37.   em_InvalidClient     = -3;
  38.   em_InvalidChild      = -4;
  39.   em_InvalidMainWindow = -5;
  40.  
  41. { TWindowsObject Transfer codes }
  42.  
  43.   tf_SizeData =    0;
  44.   tf_GetData  =    1;
  45.   tf_SetData  =    2;
  46.  
  47. type
  48.  
  49. { TMessage windows message record }
  50.  
  51.   PMessage = ^TMessage;
  52.   TMessage = record
  53.     Receiver: HWnd;
  54.     Message: Word;
  55.     case Integer of
  56.       0: (
  57.         WParam: Word;
  58.         LParam: Longint;
  59.     Result: Longint);
  60.       1: (
  61.     WParamLo: Byte;
  62.         WParamHi: Byte;
  63.         LParamLo: Word;
  64.         LParamHi: Word;
  65.         ResultLo: Word;
  66.         ResultHi: Word);
  67.   end;
  68.  
  69. { Used by TWindowsObject }
  70.  
  71.   PMDIClient = ^TMDIClient;
  72.   PScroller = ^TScroller;
  73.  
  74. { TWindowsObject object }
  75.  
  76.   PWindowsObject = ^TWindowsObject;
  77.   TWindowsObject = object(TObject)
  78.     Status: Integer;
  79.     HWindow: HWnd;
  80.     Parent, ChildList: PWindowsObject;
  81.     TransferBuffer: Pointer;
  82.     Instance: TFarProc;
  83.     Flags: Byte;
  84.     constructor Init(AParent: PWindowsObject);
  85.     constructor Load(var S: TStream);
  86.     destructor Done; virtual;
  87.     procedure Store(var S: TStream);
  88.     procedure DefWndProc(var Msg: TMessage); virtual {index 8};
  89.     procedure DefCommandProc(var Msg: TMessage); virtual {index 12};
  90.     procedure DefChildProc(var Msg: TMessage); virtual {index 16};
  91.     procedure DefNotificationProc(var Msg: TMessage); virtual {index 20};
  92.     procedure SetFlags(Mask: Byte; OnOff: Boolean);
  93.     function IsFlagSet(Mask: Byte): Boolean;
  94.     function FirstThat(Test: Pointer): PWindowsObject;
  95.     procedure ForEach(Action: Pointer);
  96.     function Next: PWindowsObject;
  97.     function Previous: PWindowsObject;
  98.     procedure Focus;
  99.     function Enable: Boolean;
  100.     function Disable: Boolean;
  101.     procedure EnableKBHandler;
  102.     procedure EnableAutoCreate;
  103.     procedure DisableAutoCreate;
  104.     procedure EnableTransfer;
  105.     procedure DisableTransfer;
  106.     function Register: Boolean; virtual;
  107.     function Create: Boolean; virtual;
  108.     procedure Destroy; virtual;
  109.     function GetId: Integer; virtual;
  110.     function ChildWithId(Id: Integer): PWindowsObject;
  111.     function GetClassName: PChar; virtual;
  112.     function GetClient: PMDIClient; virtual;
  113.     procedure GetChildPtr(var S: TStream; var P);
  114.     procedure PutChildPtr(var S: TStream; P: PWindowsObject);
  115.     procedure GetSiblingPtr(var S: TStream; var P);
  116.     procedure PutSiblingPtr(var S: TStream; P: PWindowsObject);
  117.     procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  118.     procedure SetupWindow; virtual;
  119.     procedure Show(ShowCmd: Integer);
  120.     function CanClose: Boolean;  virtual;
  121.     function Transfer(DataPtr: Pointer; TransferFlag: Word): Word; virtual;
  122.     procedure TransferData(Direction: Word); virtual;
  123.     procedure DispatchScroll(var Msg: TMessage); virtual;
  124.     procedure CloseWindow;
  125.     procedure GetChildren(var S: TStream);
  126.     procedure PutChildren(var S: TStream);
  127.     procedure AddChild(AChild: PWindowsObject);
  128.     procedure RemoveChild(AChild: PWindowsObject);
  129.     function IndexOf(P: PWindowsObject): Integer;
  130.     function At(I: Integer): PWindowsObject;
  131.     function CreateChildren: Boolean;
  132.     function CreateMemoryDC: HDC;
  133.     procedure WMVScroll(var Msg: TMessage); virtual wm_First + wm_VScroll;
  134.     procedure WMHScroll(var Msg: TMessage); virtual wm_First + wm_HScroll;
  135.     procedure WMCommand(var Msg: TMessage); virtual wm_First + wm_Command;
  136.     procedure WMClose(var Msg: TMessage); virtual wm_First + wm_Close;
  137.     procedure WMDestroy(var Msg: TMessage); virtual wm_First + wm_Destroy;
  138.     procedure WMNCDestroy(var Msg: TMessage); virtual wm_First + wm_NCDestroy;
  139.     procedure WMActivate(var Msg: TMessage); virtual wm_First + wm_Activate;
  140.     procedure WMQueryEndSession(var Msg: TMessage);
  141.       virtual wm_First + wm_QueryEndSession;
  142.     procedure CMExit(var Msg: TMessage); virtual cm_First + cm_Exit;
  143.   private
  144.     CreateOrder: Word;
  145.     SiblingList: PWindowsObject;
  146.   end;
  147.  
  148. { TWindow creation attributes }
  149.  
  150.   TWindowAttr = record
  151.     Title: PChar;
  152.     Style: LongInt;
  153.     ExStyle: LongInt;
  154.     X, Y, W, H: Integer;
  155.     Param: Pointer;
  156.     case Integer of
  157.       0: (Menu: HMenu);         { Menu handle }
  158.       1: (Id: Integer);         { Child identifier }
  159.   end;
  160.  
  161. { TWindow object }
  162.  
  163.   PWindow = ^TWindow;
  164.   TWindow = object(TWindowsObject)
  165.     Attr: TWindowAttr;
  166.     DefaultProc: TFarProc;
  167.     Scroller: PScroller;
  168.     FocusChildHandle: THandle;
  169.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  170.     constructor InitResource(AParent: PWindowsObject; ResourceID: Word);
  171.     constructor Load(var S: TStream);
  172.     destructor Done; virtual;
  173.     procedure Store(var S: TStream);
  174.     procedure SetCaption(ATitle: PChar);
  175.     procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  176.     procedure FocusChild;
  177.     procedure UpdateFocusChild;
  178.     function GetId: Integer; virtual;
  179.     function Create: Boolean; virtual;
  180.     procedure DefWndProc(var Msg: TMessage); virtual;
  181.     procedure WMActivate(var Msg: TMessage);
  182.       virtual wm_First + wm_Activate;
  183.     procedure WMMDIActivate(var Msg: TMessage);
  184.       virtual wm_First + wm_MDIActivate;
  185.     procedure SetupWindow; virtual;
  186.     procedure WMCreate(var Msg: TMessage);
  187.       virtual wm_First + wm_Create;
  188.     procedure WMHScroll(var Msg: TMessage);
  189.       virtual wm_First + wm_HScroll;
  190.     procedure WMVScroll(var Msg: TMessage);
  191.       virtual wm_First + wm_VScroll;
  192.     procedure WMPaint(var Msg: TMessage);
  193.       virtual wm_First + wm_Paint;
  194.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  195.     procedure WMSize(var Msg: TMessage);
  196.       virtual wm_First + wm_Size;
  197.     procedure WMMove(var Msg: TMessage);
  198.       virtual wm_First + wm_Move;
  199.     procedure WMLButtonDown(var Msg: TMessage);
  200.       virtual wm_First + wm_LButtonDown;
  201.     procedure WMSysCommand(var Msg: TMessage);
  202.       virtual wm_First + wm_SysCommand;
  203.   private
  204.     procedure UpdateWindowRect;
  205.   end;
  206.  
  207. { TMDIWindow object }
  208.  
  209.   PMDIWindow = ^TMDIWindow;
  210.   TMDIWindow = object(TWindow)
  211.     ClientWnd:  PMDIClient;
  212.     ChildMenuPos: Integer;
  213.     constructor Init(ATitle: PChar; AMenu: HMenu);
  214.     destructor Done; virtual;
  215.     constructor Load(var S: TStream);
  216.     procedure Store(var S: TStream);
  217.     procedure SetupWindow; virtual;
  218.     procedure InitClientWindow; virtual;
  219.     function GetClassName: PChar; virtual;
  220.     function GetClient: PMDIClient; virtual;
  221.     procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  222.     procedure DefWndProc(var Msg: TMessage); virtual;
  223.     function InitChild: PWindowsObject; virtual;
  224.     function CreateChild: PWindowsObject; virtual;
  225.     procedure CMCreateChild(var Msg: TMessage);
  226.       virtual cm_First + cm_CreateChild;
  227.     procedure TileChildren; virtual;
  228.     procedure CascadeChildren; virtual;
  229.     procedure ArrangeIcons; virtual;
  230.     procedure CloseChildren; virtual;
  231.     procedure CMTileChildren(var Msg: TMessage);
  232.       virtual cm_First + cm_TileChildren;
  233.     procedure CMCascadeChildren(var Msg: TMessage);
  234.       virtual cm_First + cm_CascadeChildren;
  235.     procedure CMArrangeIcons(var Msg: TMessage);
  236.       virtual cm_First + cm_ArrangeIcons;
  237.     procedure CMCloseChildren(var Msg: TMessage);
  238.       virtual cm_First + cm_CloseChildren;
  239.   end;
  240.  
  241. { TMDIClient object }
  242.  
  243.   TMDIClient = object(TWindow)
  244.     ClientAttr: TClientCreateStruct;
  245.     constructor Init(AParent: PMDIWindow);
  246.     constructor Load(var S: TStream);
  247.     procedure Store(var S: TStream);
  248.     function GetClassName: PChar; virtual;
  249.     function Register: Boolean; virtual;
  250.  
  251.     procedure TileChildren; virtual;
  252.     procedure CascadeChildren; virtual;
  253.     procedure ArrangeIcons; virtual;
  254.  
  255.     procedure WMPaint(var Msg: TMessage); virtual wm_First + wm_Paint;
  256.   end;
  257.  
  258. { TScroller object }
  259.  
  260.   TScroller = object(TObject)
  261.     Window: PWindow;
  262.     XPos: LongInt;    { current horizontal pos in horz scroll units }
  263.     YPos: LongInt;    { current vertical pos in vert scroll units }
  264.     XUnit: Integer;    { logical device units per horz scroll unit }
  265.     YUnit: Integer;    { logical device units per vert scroll unit }
  266.     XRange: LongInt;    { # of scrollable horz scroll units }
  267.     YRange: LongInt;    { # of scrollable vert scroll units }
  268.     XLine: Integer;    { # of horz scroll units per line }
  269.     YLine: Integer;    { # of vert scroll units per line }
  270.     XPage: Integer;    { # of horz scroll units per page }
  271.     YPage: Integer;    { # of vert scroll units per page }
  272.     AutoMode: Boolean;  { auto scrolling mode  }
  273.     TrackMode: Boolean; { track scroll mode    }
  274.     AutoOrg: Boolean;   { AutoOrg indicates Scroller offsets origin }
  275.     HasHScrollBar: Boolean;
  276.     HasVScrollBar: Boolean;
  277.     constructor Init(TheWindow: PWindow; TheXUnit, TheYUnit: Integer;
  278.       TheXRange, TheYRange: LongInt);
  279.     constructor Load(var S: TStream);
  280.     destructor Done; virtual;
  281.     procedure Store(var S: TStream);
  282.     procedure SetUnits(TheXUnit, TheYUnit: LongInt);
  283.     procedure SetPageSize; virtual;
  284.     procedure SetSBarRange; virtual;
  285.     procedure SetRange(TheXRange, TheYRange: LongInt);
  286.     procedure BeginView(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  287.     procedure EndView; virtual;
  288.     procedure VScroll(ScrollRequest: Word; ThumbPos: Integer); virtual;
  289.     procedure HScroll(ScrollRequest: Word; ThumbPos: Integer); virtual;
  290.     procedure ScrollTo(X, Y: LongInt);
  291.     procedure ScrollBy(Dx, Dy: LongInt);
  292.     procedure AutoScroll; virtual;
  293.     function IsVisibleRect(X, Y: LongInt; XExt, YExt: Integer): Boolean;
  294.   private
  295.     function XScrollValue(ARangeUnit: Longint): Integer;
  296.     function YScrollValue(ARangeUnit: Longint): Integer;
  297.     function XRangeValue(AScrollUnit: Integer): Longint;
  298.     function YRangeValue(AScrollUnit: Integer): Longint;
  299.   end;
  300.  
  301. { TApplication object }
  302.  
  303.   PApplication = ^TApplication;
  304.   TApplication = object(TObject)
  305.     Status: Integer;
  306.     Name: PChar;
  307.     MainWindow: PWindowsObject;
  308.     HAccTable: THandle;
  309.     KBHandlerWnd: PWindowsObject;
  310.     constructor Init(AName: PChar);
  311.     destructor Done; virtual;
  312.     function IdleAction: Boolean; virtual;
  313.     procedure InitApplication; virtual;
  314.     procedure InitInstance; virtual;
  315.     procedure InitMainWindow; virtual;
  316.     procedure Run; virtual;
  317.     procedure SetKBHandler(AWindowsObject: PWindowsObject);
  318.     procedure MessageLoop; virtual;
  319.     function ProcessAppMsg(var Message: TMsg): Boolean; virtual;
  320.     function ProcessDlgMsg(var Message: TMsg): Boolean; virtual;
  321.     function ProcessAccels(var Message: TMsg): Boolean; virtual;
  322.     function ProcessMDIAccels(var Message: TMsg): Boolean; virtual;
  323.     function MakeWindow(AWindowsObject: PWindowsObject): PWindowsObject; virtual;
  324.     function ExecDialog(ADialog: PWindowsObject): Integer; virtual;
  325.     function ValidWindow(AWindowsObject: PWindowsObject): PWindowsObject; virtual;
  326.     procedure Error(ErrorCode: Integer); virtual;
  327.     function CanClose: Boolean; virtual;
  328.   end;
  329.  
  330. { Utility functions }
  331.  
  332. function GetObjectPtr(HWindow: HWnd): PWindowsObject;
  333.  
  334. { Stream routines }
  335.  
  336. procedure RegisterOWindows;
  337. procedure RegisterWObjects;
  338.  
  339. { Longint inline routines }
  340.  
  341. function LongMul(X, Y: Integer): Longint;
  342. inline($5A/$58/$F7/$EA);
  343.  
  344. function LongDiv(X: Longint; Y: Integer): Integer;
  345. inline($59/$58/$5A/$F7/$F9);
  346.  
  347. { Application object pointer }
  348.  
  349. const
  350.   Application: PApplication = nil;
  351.  
  352. { Stream registration records }
  353.  
  354. const
  355.   RWindowsObject: TStreamRec = (
  356.     ObjType: 52;
  357.     VmtLink: Ofs(TypeOf(TWindowsObject)^);
  358.     Load:    @TWindowsObject.Load;
  359.     Store:   @TWindowsObject.Store);
  360.  
  361. const
  362.   RWindow: TStreamRec = (
  363.     ObjType: 53;
  364.     VmtLink: Ofs(TypeOf(TWindow)^);
  365.     Load:    @TWindow.Load;
  366.     Store:   @TWindow.Store);
  367.  
  368. const
  369.   RMDIWindow: TStreamRec = (
  370.     ObjType: 57;
  371.     VmtLink: Ofs(TypeOf(TMDIWindow)^);
  372.     Load:    @TMDIWindow.Load;
  373.     Store:   @TMDIWindow.Store);
  374.  
  375. const
  376.   RScroller: TStreamRec = (
  377.     ObjType: 68;
  378.     VmtLink: Ofs(TypeOf(TScroller)^);
  379.     Load:    @TScroller.Load;
  380.     Store:   @TScroller.Store);
  381.  
  382. type
  383.   TCreateDialogParam = function (HInstance: THandle; TemplateName: PChar;
  384.     WndParent: HWnd; DialogFunc: TFarProc; InitParam: LongInt): HWnd;
  385.   TDialogBoxParam = function (HInstance: THandle; TemplateName: PChar;
  386.     WndParent: HWnd; DialogFunc: TFarProc; InitParam: LongInt): Integer;
  387.   TDefaultProc = function (Wnd: HWnd; Msg, wParam: Word;
  388.     lParam: LongInt): LongInt;
  389.   TMessageBox = function (WndParent: HWnd; Txt, Caption: PChar;
  390.     TextType: Word): Integer;
  391.  
  392. const
  393.   CreateDialogParam: TCreateDialogParam = WinProcs.CreateDialogParam;
  394.   DialogBoxParam: TDialogBoxParam = WinProcs.DialogBoxParam;
  395.   DefWndDlgProc: TDefaultProc = WinProcs.DefWindowProc;
  396.   DefMDIDlgProc: TDefaultProc = WinProcs.DefMDIChildProc;
  397.   DefDlgProc: TDefaultProc = WinProcs.DefDlgProc;
  398.   MessageBox: TMessageBox = WinProcs.MessageBox;
  399.  
  400.   BWCCClassNames: Boolean = False;
  401.  
  402. implementation
  403.  
  404. uses Strings, OMemory, ODialogs;
  405.  
  406. type
  407.  
  408. { Windows window procedure type }
  409.  
  410.   TWindowProc = function(Window: HWND; Message: Word; WParam: Word;
  411.     LParam: Longint): Longint;
  412.  
  413. { Fixup list for TWindowsObject stream support }
  414.  
  415.   PFixupList = ^TFixupList;
  416.   TFixupList = array[1..4096] of Pointer;
  417.  
  418. { Object instance jump vector }
  419.  
  420.   PObjectInstance = ^TObjectInstance;
  421.   TObjectInstance = record
  422.     Code: Byte;
  423.     Offset: Integer;
  424.     case Integer of
  425.       0: (Next: PObjectInstance);
  426.       1: (ObjectPtr: PObject);
  427.   end;
  428.  
  429. { Object instance block }
  430.  
  431.   PInstanceBlock = ^TInstanceBlock;
  432.   TInstanceBlock = record
  433.     Next: Word;
  434.     Code: array[1..5] of Byte;
  435.     WndProcPtr: Pointer;
  436.     Instances: array[0..34] of TObjectInstance;
  437.   end;
  438.  
  439. { Virtual method table }
  440.  
  441.   TVMT = record
  442.     InstSize: Word;
  443.     NegCheckSum: Word;
  444.     DMTPtr: Word;
  445.     Reserved: Word;
  446.     EntryTable: record end;
  447.   end;
  448.  
  449. { Dynamic method table }
  450.  
  451.   TDMT = record
  452.     Parent: Word;
  453.     CacheIndex: Word;
  454.     CacheEntry: Word;
  455.     EntryCount: Word;
  456.     EntryTable: record end;
  457.   end;
  458.  
  459. { TWindowsObject VMT offsets }
  460.  
  461. const
  462.   TWindowsObject_DefWndProc          = SizeOf(TVMT) + 4;
  463.   TWindowsObject_DefCommandProc      = SizeOf(TVMT) + 8;
  464.   TWindowsObject_DefChildProc        = SizeOf(TVMT) + 12;
  465.   TWindowsObject_DefNotificationProc = SizeOf(TVMT) + 16;
  466.  
  467. { Object instance manager variables }
  468.  
  469. const
  470.   InstBlockList: Word = 0;
  471.   InstFreeList: PObjectInstance = nil;
  472.   StdWndProcInstance: TFarProc = nil;
  473.  
  474. { Creation window pointer for InitWndProc }
  475.  
  476. const
  477.   CreationWindow: PWindowsObject = nil;
  478.  
  479.   psSegProp: array[0..3] of Char = 'OW1';
  480.   psOfsProp: array[0..3] of Char = 'OW2';
  481.  
  482. { Fixup list for TWindowsObject stream support }
  483.  
  484. const
  485.   FixupList: PFixupList = nil;
  486.  
  487. const
  488.   __OWL_DISPATCH_HOOK__: Pointer = nil;
  489.  
  490. { Lookup a dynamic method call:
  491.   In     AX = Dynamic method index
  492.      BX = DS-based VMT offset
  493.      DX = Default method VMT offset
  494.  
  495.   Out DS:DI = Location of the method's address }
  496.  
  497. procedure DMTLookup; near; assembler;
  498. asm
  499.     MOV    SI,[BX].TVMT.DMTPtr
  500.     OR    SI,SI
  501.     JE    @@3
  502.     CMP    AX,[SI].TDMT.CacheIndex
  503.     JNE    @@1
  504.     MOV    DI,[SI].TDMT.CacheEntry
  505.         JMP     @@5
  506. @@1:    MOV    DI,DS
  507.     MOV    ES,DI
  508.     CLD
  509. @@2:    MOV    CX,[SI].TDMT.EntryCount
  510.     LEA    DI,[SI].TDMT.EntryTable
  511.     REPNE    SCASW
  512.     JE    @@4
  513.     MOV    SI,ES:[SI].TDMT.Parent
  514.     OR    SI,SI
  515.     JNE    @@2
  516. @@3:    ADD    BX,DX
  517.         MOV     DI,BX
  518.     JMP    @@5
  519. @@4:    MOV    DX,[SI].TDMT.EntryCount
  520.     DEC    DX
  521.     SHL    DX,1
  522.     SUB    DX,CX
  523.     SHL    DX,1
  524.     ADD    DI,DX
  525.         MOV     SI,[BX].TVMT.DMTPtr
  526.     MOV    [SI].TDMT.CacheIndex,AX
  527.     MOV    [SI].TDMT.CacheEntry,DI
  528. @@5:
  529. end;
  530.  
  531. { Attach properties to provide a backup method retieving the object
  532.   pointer from a HWindow }
  533.  
  534. procedure AttachProperties(HWindow: HWnd; Self: Pointer); assembler;
  535. asm
  536.     PUSH    HWindow
  537.         PUSH    DS
  538.         MOV    AX,OFFSET psSegProp
  539.         PUSH    AX
  540.         PUSH    Self.Word[2]
  541.         CALL    SetProp
  542.     PUSH    HWindow
  543.         PUSH    DS
  544.         MOV    AX,OFFSET psOfsProp
  545.         PUSH    AX
  546.         PUSH    Self.Word[0]
  547.         CALL    SetProp
  548. end;
  549.  
  550. { Remove properties associated with a window }
  551.  
  552. procedure RemoveProperties(HWindow: HWnd); assembler;
  553. asm
  554.     PUSH    HWindow
  555.     PUSH    DS
  556.     MOV    AX,OFFSET psSegProp
  557.         PUSH    AX
  558.     CALL    RemoveProp
  559.     PUSH    HWindow
  560.     PUSH    DS
  561.     MOV    AX,OFFSET psOfsProp
  562.         PUSH    AX
  563.     CALL    RemoveProp
  564. end;
  565.  
  566. { Return pointer to TWindowsObject given a window handle }
  567.  
  568. function GetObjectPtr(HWindow: HWND): PWindowsObject; assembler;
  569. asm
  570.     PUSH    HWindow
  571.     CALL    IsWindow
  572.     OR    AX,AX
  573.     CWD
  574.     JZ    @@2
  575.     PUSH    HWindow
  576.     MOV    AX,GWL_WNDPROC
  577.     PUSH    AX
  578.     CALL    GetWindowLong
  579.     MOV    BX,AX
  580.     MOV    ES,DX
  581.     XOR    AX,AX
  582.     CWD
  583.     CMP    ES:[BX].Byte[0], 0E8H
  584.     JNE    @@1
  585.     MOV    CX,2-3
  586.     SUB    CX,BX
  587.     CMP    CX,ES:[BX].Word[1]
  588.     JNE    @@1
  589.     CMP    ES:Word[2],02E5BH
  590.     JNE    @@1
  591.     MOV    AX,ES:[BX].Word[3]
  592.     MOV    DX,ES:[BX].Word[5]
  593.         JMP    @@2
  594. @@1:    PUSH    HWindow
  595.     PUSH    DS
  596.         MOV    AX,OFFSET psSegProp
  597.         PUSH    AX
  598.         CALL    GetProp
  599.         PUSH    AX
  600.         PUSH    HWindow
  601.         PUSH    DS
  602.         MOV    AX,OFFSET psOfsProp
  603.         PUSH    AX
  604.         CALL    GetProp
  605.         POP    DX
  606. @@2:
  607. end;
  608.  
  609. { Owl dispatch hook call }
  610. { In    DS:DI    Location of the method to be called }
  611. { Out    DS:DI    Location of the method to be called }
  612.  
  613. procedure DispatchHook(var Msg: TMessage; Self: Pointer); near; assembler;
  614. asm
  615.     PUSH    DI
  616.         PUSH    DS
  617.     LES    SI,Msg
  618.         PUSH    ES:[SI].TMessage.Receiver
  619.         PUSH    ES:[SI].TMessage.Message
  620.         PUSH    ES:[SI].TMessage.wParam
  621.         PUSH    ES:[SI].TMessage.lParamHi
  622.         PUSH    ES:[SI].TMessage.lParamLo
  623.         LES    SI,[DI]
  624.         PUSH    ES
  625.         PUSH    SI
  626.     LES    SI,Self
  627.         PUSH    ES
  628.         PUSH    SI
  629.         CALL    DWORD PTR [__OWL_DISPATCH_HOOK__]
  630.         POP    DS
  631.         POP    DI
  632.         POP    BP
  633.         RET        { Avoid they RET 8 since the caller needs
  634.               the parameters left on the stack }
  635. end;
  636.  
  637. { Standard window procedure }
  638.  
  639. function StdWndProc(HWindow: HWND; Message: Word; WParam: Word;
  640.   LParam: Longint): Longint; export; assembler;
  641. asm
  642.     MOV    DX,HWindow
  643.     MOV    ES:[BX].TWindowsObject.HWindow,DX
  644.     XOR    AX,AX
  645.         PUSH    AX            { ResultHi }
  646.         INC    AX
  647.         PUSH    AX            { ResultLo }
  648.         PUSH    LParam.Word[2]        { LParamHi }
  649.         PUSH    LParam.Word[0]        { LParamLo }
  650.         PUSH    WParam            { WParam }
  651.         MOV    AX,Message
  652.         PUSH    AX            { Message }
  653.     PUSH    DX            { Receiver }
  654.         MOV    DX,SP
  655.         PUSH    SS
  656.         PUSH    DX
  657.         PUSH    ES
  658.         PUSH    BX
  659.         MOV    BX,ES:[BX]
  660.         OR    AX,AX
  661.         JNS    @@1
  662.         MOV    DI,BX
  663.         ADD    DI,TWindowsObject_DefWndProc
  664.         JMP    @@2
  665. @@1:    MOV    DX,TWindowsObject_DefWndProc
  666.     CALL    DMTLookup
  667. @@2:    MOV    CX,__OWL_DISPATCH_HOOK__.Word[2]
  668.         JCXZ    @@3
  669.         CALL    DispatchHook
  670. @@3:    CALL    DWORD PTR [DI]
  671.     ADD    SP,10
  672.     POP    AX
  673.     POP    DX
  674. end;
  675.  
  676. { Initialization window procedure }
  677.  
  678. function InitWndProc(HWindow: HWND; Message: Word; WParam: Word;
  679.   LParam: Longint): Longint; export; assembler;
  680. asm
  681.     PUSH    HWindow
  682.     MOV    AX,gwl_WndProc
  683.     PUSH    AX
  684.     LES    DI,CreationWindow
  685.     LES    DI,ES:[DI].TWindowsObject.Instance
  686.     PUSH    ES
  687.     PUSH    DI
  688.     CALL    SetWindowLong
  689.         PUSH    HWindow
  690.         LES    DI,CreationWindow
  691.         PUSH    ES
  692.         PUSH    DI
  693.         CALL    AttachProperties
  694.     PUSH    HWindow
  695.     PUSH    Message
  696.     PUSH    WParam
  697.     PUSH    LParam.Word[2]
  698.     PUSH    LParam.Word[0]
  699.     MOV    AX,DS
  700.     LES    DI,CreationWindow
  701.     CALL    ES:[DI].TWindowsObject.Instance
  702. end;
  703.  
  704. { Allocate an object instance }
  705.  
  706. function MakeObjectInstance(P: PWindowsObject): TFarProc;
  707. const
  708.   BlockCode: array[1..5] of Byte = (
  709.     $5B,              { POP BX             }
  710.     $2E, $C4, $1F,    { LES BX,CS:[BX]     }
  711.     $EA);             { JMP FAR StdWndProc }
  712. var
  713.   Block: PInstanceBlock;
  714.   Instance: PObjectInstance;
  715. begin
  716.   if InstFreeList = nil then
  717.   begin
  718.     Block := GlobalLock(GlobalAlloc(gmem_Fixed, SizeOf(TInstanceBlock)));
  719.     Block^.Next := InstBlockList;
  720.     Move(BlockCode, Block^.Code, 5);
  721.     Block^.WndProcPtr := StdWndProcInstance;
  722.     Instance := @Block^.Instances;
  723.     repeat
  724.       Instance^.Code := $E8;  { CALL NEAR PTR Offset }
  725.       Instance^.Offset := (2 - 3) - PtrRec(Instance).Ofs;
  726.       Instance^.Next := InstFreeList;
  727.       InstFreeList := Instance;
  728.       Inc(PtrRec(Instance).Ofs, SizeOf(TObjectInstance));
  729.     until PtrRec(Instance).Ofs = SizeOf(TInstanceBlock);
  730.     InstBlockList := PtrRec(Block).Seg;
  731.     ChangeSelector(PtrRec(Block).Seg, PtrRec(Block).Seg);
  732.   end;
  733.   MakeObjectInstance := TFarProc(InstFreeList);
  734.   PtrRec(Instance).Ofs := PtrRec(InstFreeList).Ofs;
  735.   PtrRec(Instance).Seg := AllocCSToDSAlias(PtrRec(InstFreeList).Seg);
  736.   InstFreeList := Instance^.Next;
  737.   Instance^.ObjectPtr := P;
  738.   FreeSelector(PtrRec(Instance).Seg);
  739. end;
  740.  
  741. { Free an object instance }
  742.  
  743. procedure FreeObjectInstance(P: TFarProc);
  744. var
  745.   Instance: PObjectInstance;
  746. begin
  747.   PtrRec(Instance).Ofs := PtrRec(P).Ofs;
  748.   PtrRec(Instance).Seg := AllocCSToDSAlias(PtrRec(P).Seg);
  749.   Instance^.Next := InstFreeList;
  750.   FreeSelector(PtrRec(Instance).Seg);
  751.   InstFreeList := PObjectInstance(P);
  752. end;
  753.  
  754. function LongMin(A, B: LongInt): LongInt;
  755. begin
  756.   if A < B then LongMin := A else LongMin := B;
  757. end;
  758.  
  759. function LongMax(A, B: LongInt): LongInt;
  760. begin
  761.   if A > B then LongMax := A else LongMax := B;
  762. end;
  763.  
  764. { TWindowsObject }
  765.  
  766. { Constructor for a TWindowsObject.  If a parent window is passed, adds the
  767.   TWindowsObject to its parent's list of children.  Makes an instance
  768.   thunk to be used in associating an MS-Windows interface element to the
  769.   TWindowsObject. }
  770.  
  771. constructor TWindowsObject.Init(AParent: PWindowsObject);
  772. begin
  773.   TObject.Init;
  774.   Status := 0;
  775.   HWindow := 0;
  776.   CreateOrder := 0;
  777.   Parent := AParent;
  778.   if Parent <> nil then Parent^.AddChild(@Self)
  779.   else SiblingList := nil;
  780.   ChildList := nil;
  781.   TransferBuffer := nil;
  782.   Instance := MakeObjectInstance(@Self);
  783.   Flags := 0;
  784.   EnableAutoCreate;
  785. end;
  786.  
  787. { Destructor for a TWindowsObject.  Disposes of each window in its
  788.   ChildList and removes itself from a non-nil parent's list of children.
  789.   Destroys a still-associated MS-Windows interface element and frees the
  790.   instance thunk used for association of an MS-Windows element to the
  791.   TWindowsObject. }
  792.  
  793. destructor TWindowsObject.Done;
  794.  
  795.   procedure FreeChild(P: PWindowsObject); far;
  796.   begin
  797.     P^.Free;
  798.   end;
  799.  
  800. begin
  801.   Destroy;
  802.   ForEach(@FreeChild);
  803.   if Parent <> nil then Parent^.RemoveChild(@Self);
  804.   FreeObjectInstance(Instance);
  805.   TObject.Done;
  806. end;
  807.  
  808. { Constructs an instance of TWindowsObject from the passed TStream.
  809.   Loads each child window stored from ChildList. }
  810.  
  811. constructor TWindowsObject.Load(var S: TStream);
  812. begin
  813.   TObject.Init;
  814.   S.Read(Status, SizeOf(Status));
  815.   HWindow := 0;
  816.   Parent := nil;
  817.   SiblingList := nil;
  818.   ChildList := nil;
  819.   TransferBuffer := nil;
  820.   Instance := MakeObjectInstance(@Self);
  821.   S.Read(Flags, SizeOf(Flags));
  822.   S.Read(CreateOrder, SizeOf(CreateOrder));
  823.   GetChildren(S);
  824. end;
  825.  
  826. { Stores the TWindowsObject in the passed TStream.  Stores each child
  827.   window in ChildList. }
  828.  
  829. procedure TWindowsObject.Store(var S: TStream);
  830. var
  831.   SavedFlags: Byte;
  832. begin
  833.   S.Write(Status, SizeOf(Status));
  834.   SavedFlags := Flags;
  835.   if HWindow <> 0 then SavedFlags := SavedFlags or wb_AutoCreate;
  836.   S.Write(SavedFlags, SizeOf(SavedFlags));
  837.   S.Write(CreateOrder, SizeOf(CreateOrder));
  838.   PutChildren(S);
  839. end;
  840.  
  841. { Adds the TWindowsObjects stored on the given stream into its
  842.   child list.  Used by TWindowsObject.Load.  Adds to the fixup
  843.   list to insure that references to other to-be-loaded
  844.   TWindowsObjects are preserved.
  845.   IMPORTANT: This method assumes that the current child list
  846.   is empty! }
  847.  
  848. procedure TWindowsObject.GetChildren(var S: TStream);
  849. var
  850.   ChildCount, I: Integer;
  851.   SaveFixup: PFixupList;
  852.   W: PWindowsObject;
  853.   P, Q: ^Pointer;
  854. begin
  855.   SaveFixup := FixupList;
  856.   S.Read(ChildCount, SizeOf(ChildCount));
  857.   asm
  858.     MOV     CX,ChildCount
  859.     SHL     CX,1
  860.     SHL     CX,1
  861.     SUB     SP,CX
  862.     MOV     FixupList.Word[0],SP
  863.     MOV     FixupList.Word[2],SS
  864.     MOV     DI,SP
  865.     PUSH    SS
  866.     POP     ES
  867.     XOR     AL,AL
  868.     CLD
  869.     REP     STOSB
  870.   end;
  871.   for I := 1 to ChildCount do
  872.   begin
  873.     AddChild(PWindowsObject(S.Get));
  874.     ChildList^.Parent := @Self;
  875.   end;
  876.   W := ChildList;
  877.   for I := 1 to ChildCount do
  878.   begin
  879.     W := W^.Next;
  880.     P := FixupList^[I];
  881.     while P <> nil do
  882.     begin
  883.       Q := P;
  884.       P := P^;
  885.       Q^ := W;
  886.     end;
  887.   end;
  888.   FixupList := SaveFixup;
  889. end;
  890.  
  891. { Puts all the windows in the child list onto the given stream.  They
  892.   can be retrieved by calling the GetChildren method.  Used by the
  893.   TWindowsObject.Store method. This method also ensure that the
  894.   CreateOrder field is up to date, which is used by TWindow.Create.
  895.   This will ensure the order the windows will be created in is
  896.   the current order Windows has them in.}
  897.  
  898. procedure TWindowsObject.PutChildren(var S: TStream);
  899. var
  900.   ChildCount: Integer;
  901.  
  902.   procedure AssignCreateOrder;
  903.   var
  904.     CurWindow: HWnd;
  905.     Wnd: PWindowsObject;
  906.     I: Integer;
  907.   begin
  908.     Wnd := GetClient;
  909.     if Wnd = nil then CurWindow := HWindow
  910.     else CurWindow := Wnd^.HWindow;
  911.     CurWindow := GetWindow(CurWindow, gw_Child);
  912.     if CurWindow <> 0 then
  913.     begin
  914.       CurWindow := GetWindow(CurWindow, gw_HwndLast);
  915.       I := 1;
  916.       while CurWindow <> 0 do
  917.       begin
  918.     Wnd := GetObjectPtr(CurWindow);
  919.     if Wnd <> nil then
  920.     begin
  921.       Wnd^.CreateOrder := I;
  922.       Inc(I);
  923.     end;
  924.     CurWindow := GetWindow(CurWindow, gw_HwndPrev);
  925.       end;
  926.     end;
  927.   end;
  928.  
  929.  
  930.   procedure DoPutChild(P: PWindowsObject); far;
  931.   begin
  932.     S.Put(P);
  933.   end;
  934.  
  935. begin
  936.   AssignCreateOrder;
  937.   ChildCount := IndexOf(ChildList);
  938.   S.Write(ChildCount, SizeOf(ChildCount));
  939.   ForEach(@DoPutChild);
  940. end;
  941.  
  942. { Create the children of this object.  Returns true if the
  943.   all the windows where sucessfully created.
  944. }
  945.  
  946. function TWindowsObject.CreateChildren: Boolean;
  947. var
  948.   I: Integer;
  949.   P: PWindowsObject;
  950.   Failure: Boolean;
  951.  
  952.   function OrderIsI(P: PWindowsObject): Boolean; far;
  953.   begin
  954.     OrderIsI := P^.CreateOrder = I;
  955.   end;
  956.  
  957.   function CantCreateChild(P: PWindowsObject): Boolean;
  958.   var
  959.     Created: Boolean;
  960.     Text: array[0..80] of Char;
  961.   begin
  962.     with P^ do
  963.     begin
  964.       Created := not IsFlagSet(wb_AutoCreate) or Create;
  965.       if Created and IsIconic(HWindow) then
  966.       begin
  967.     GetWindowText(HWindow, Text, SizeOf(Text));
  968.     SetWindowText(HWindow, Text);
  969.       end;
  970.     end;
  971.     CantCreateChild := not Created;
  972.   end;
  973.  
  974.   function CreateZeroChild(P: PWindowsObject): Boolean; far;
  975.   begin
  976.     CreateZeroChild := (P^.CreateOrder = 0) and CantCreateChild(P);
  977.   end;
  978.  
  979. begin
  980.   I := 1;
  981.   Failure := False;
  982.   repeat
  983.     P := FirstThat(@OrderIsI);
  984.     if P <> nil then Failure := CantCreateChild(P);
  985.     Inc(I);
  986.   until Failure or (P = nil);
  987.   CreateChildren := not Failure and (FirstThat(@CreateZeroChild) = nil);
  988. end;
  989.  
  990. { Gets a pointer to a child window from the passed stream }
  991.  
  992. procedure TWindowsObject.GetChildPtr(var S: TStream; var P);
  993. var
  994.   Index: Word;
  995. begin
  996.   S.Read(Index, SizeOf(Word));
  997.   Pointer(P) := At(Index);
  998. end;
  999.  
  1000. { Puts a pointer to a child window onto the passed stream }
  1001.  
  1002. procedure TWindowsObject.PutChildPtr(var S: TStream; P: PWindowsObject);
  1003. var
  1004.   Index: Word;
  1005. begin
  1006.   if P = nil then Index := 0 else Index := IndexOf(P);
  1007.   S.Write(Index, SizeOf(Word));
  1008. end;
  1009.  
  1010. { Gets a pointer to a sibling window from the passed stream.  This method
  1011.   is only valid during a Load constructor and is not valid until the
  1012.   constructor returns.  The pointer will not be given a valid value until
  1013.   the parent window's load constructor loads all of the window's sibling
  1014.   windows. }
  1015.  
  1016. procedure TWindowsObject.GetSiblingPtr(var S: TStream; var P);
  1017. var
  1018.   Index: Integer;
  1019. begin
  1020.   S.Read(Index, SizeOf(Word));
  1021.   if (Index = 0) or (FixupList = nil) then Pointer(P) := nil else
  1022.   begin
  1023.     Pointer(P) := FixupList^[Index];
  1024.     FixupList^[Index] := @P;
  1025.   end;
  1026. end;
  1027.  
  1028. { Puts a pointer to a sibling window on to a stream.  The pointer can be
  1029.   read from the stream using GetSiblingPtr.  This method is only valid
  1030.   during a Store procedure. }
  1031.  
  1032. procedure TWindowsObject.PutSiblingPtr(var S: TStream; P: PWindowsObject);
  1033. var
  1034.   Index: Integer;
  1035. begin
  1036.   if P = nil then Index := 0 else Index := Parent^.IndexOf(P);
  1037.   S.Write(Index, SizeOf(Word));
  1038. end;
  1039.  
  1040. { Transfers window 'data' to/from the passed data buffer.  Used to
  1041.   initialize dialogs and get data out of them.  The TransferFlag passed
  1042.   specifies whether data is to be read from or written to the passed
  1043.   buffer, or whether the data element size is simply to be returned. The
  1044.   return value is the size (in bytes) of the transfer data.  This method
  1045.   simply returns zero and is redefined in TControl descendant classes.}
  1046.  
  1047. function TWindowsObject.Transfer(DataPtr: Pointer; TransferFlag: Word): Word;
  1048. begin
  1049.   Transfer := 0;
  1050. end;
  1051.  
  1052. { Focus the window }
  1053.  
  1054. procedure TWindowsObject.Focus;
  1055. begin
  1056.   if HWindow <> 0 then SetFocus(HWindow);
  1057. end;
  1058.  
  1059. { Enable then window }
  1060.  
  1061. function TWindowsObject.Enable: Boolean;
  1062. begin
  1063.   if HWindow <> 0 then Enable := EnableWindow(HWindow, True)
  1064.   else Enable := False;
  1065. end;
  1066.  
  1067. { Disable the window }
  1068.  
  1069. function TWindowsObject.Disable: Boolean;
  1070. begin
  1071.   if HWindow <> 0 then Disable := EnableWindow(HWindow, False)
  1072.   else Disable := False;
  1073. end;
  1074.  
  1075. { Sets flag which indicates that the TWindowsObject has requested
  1076.   "keyboard handling" (translation of keyboard input into control
  1077.   selections) similiar to the way that dialogs function. }
  1078.  
  1079. procedure TWindowsObject.EnableKBHandler;
  1080. begin
  1081.   SetFlags(wb_KBHandler, True);
  1082. end;
  1083.  
  1084. { Sets flag which indicates that the TWindowsObject should be
  1085.   created if a create is sent while in the parent's child list. }
  1086.  
  1087. procedure TWindowsObject.EnableAutoCreate;
  1088. begin
  1089.   SetFlags(wb_AutoCreate, True);
  1090. end;
  1091.  
  1092. { Sets flag which indicates that the TWindowsObject can/will
  1093.   tranfer data via the transfer mechanism.  Used in conjunction
  1094.   with the Transfer method which actually does the transfer. }
  1095.  
  1096. procedure TWindowsObject.EnableTransfer;
  1097. begin
  1098.   SetFlags(wb_Transfer, True);
  1099. end;
  1100.  
  1101. { Sets flag which indicates that the TWindowsObject should not be
  1102.   created if a create is sent while in the parent's child list. }
  1103.  
  1104. procedure TWindowsObject.DisableAutoCreate;
  1105. begin
  1106.   SetFlags(wb_AutoCreate, False);
  1107. end;
  1108.  
  1109. { Sets flag which indicates that the TWindowsObject cannot/
  1110.   will not tranfer data via the transfer mechanism. }
  1111.  
  1112. procedure TWindowsObject.DisableTransfer;
  1113. begin
  1114.   SetFlags(wb_Transfer, False);
  1115. end;
  1116.  
  1117. { Sets flag(s) for the TWindowsObject, which are stored in its Flags data
  1118.   field.  The mask of the flag(s) to be set (wb_KBHandler, etc.), and
  1119.   an OnOff "flag" is passed --  On = True, Off = False. }
  1120.  
  1121. procedure TWindowsObject.SetFlags(Mask: Byte; OnOff: Boolean);
  1122. begin
  1123.   if OnOff then Flags := Flags or Mask else Flags := Flags and not Mask;
  1124. end;
  1125.  
  1126. { Determines whether the flag whose mask is passed has been set, returning
  1127.   a Boolean indicator --  True = On, False = Off. }
  1128.  
  1129. function TWindowsObject.IsFlagSet(Mask: Byte): Boolean;
  1130. begin
  1131.   IsFlagSet := Flags and Mask = Mask;
  1132. end;
  1133.  
  1134. { Adds the passed pointer to a child window to the linked list
  1135.   of sibling windows which Self's ChildList points to. }
  1136.  
  1137. procedure TWindowsObject.AddChild(AChild: PWindowsObject);
  1138. begin
  1139.   if AChild <> nil then
  1140.     if ChildList = nil then
  1141.     begin
  1142.       ChildList := AChild;
  1143.       AChild^.SiblingList := AChild;
  1144.     end else
  1145.     begin
  1146.       AChild^.SiblingList := ChildList^.SiblingList;
  1147.       ChildList^.SiblingList := AChild;
  1148.       ChildList := AChild;
  1149.     end;
  1150. end;
  1151.  
  1152. { Returns a pointer to the TWindowsObject's next sibling (the next window
  1153.   in its parent's child window list).  If Self was the last child added to
  1154.   the list, returns a pointer to the first child added. }
  1155.  
  1156. function TWindowsObject.Next: PWindowsObject;
  1157. begin
  1158.   Next := SiblingList;
  1159. end;
  1160.  
  1161. { Returns a pointer to the TWindowsObject's previous sibling (the window
  1162.   previous to the TWindowsObject in its parent's child window list). Returns
  1163.   the sibling which points to Self.  If Self was the first child added to
  1164.   the list, returns a pointer to the last child added.}
  1165.  
  1166. function TWindowsObject.Previous: PWindowsObject;
  1167. var
  1168.   CurrentIndex: PWindowsObject;
  1169. begin
  1170.   if SiblingList = nil then Previous := nil else
  1171.   begin
  1172.     CurrentIndex := @Self;
  1173.     while CurrentIndex^.Next <> @Self do
  1174.       CurrentIndex := CurrentIndex^.Next;
  1175.     Previous := CurrentIndex;
  1176.   end;
  1177. end;
  1178.  
  1179. { Removes the passed pointer to a child window from the linked list of
  1180.   sibling windows which Self's ChildList points to. }
  1181.  
  1182. procedure TWindowsObject.RemoveChild(AChild: PWindowsObject);
  1183. var
  1184.   LastChild, NextChild: PWindowsObject;
  1185. begin
  1186.   if ChildList <> nil then
  1187.   begin
  1188.     LastChild := ChildList;
  1189.     NextChild := LastChild;
  1190.     while (NextChild^.SiblingList <> LastChild) and
  1191.         (NextChild^.SiblingList <> AChild) do
  1192.       NextChild := NextChild^.SiblingList;
  1193.     if NextChild^.SiblingList = AChild then
  1194.       if NextChild^.SiblingList = NextChild then ChildList := nil else
  1195.       begin
  1196.         if NextChild^.SiblingList = ChildList then ChildList := NextChild;
  1197.         NextChild^.SiblingList := NextChild^.SiblingList^.SiblingList;
  1198.       end;
  1199.   end;
  1200. end;
  1201.  
  1202. { Returns a generic pointer to the first TWindowsObject in the ChildList
  1203.   that meets some specified criteria.  If no child in the list meets the
  1204.   criteria, nil is returned.   The Test parameter passed is a pointer to
  1205.   a Boolean function, defining the criteria, which accepts a pointer to a 
  1206.   child window.  The Test function must return a Boolean value indicating
  1207.   whether the child passed meets the criteria.  }
  1208.  
  1209. function TWindowsObject.FirstThat(Test: Pointer): PWindowsObject; assembler;
  1210. var
  1211.   Last: Pointer;
  1212. asm
  1213.         LES     DI,Self
  1214.         LES     DI,ES:[DI].TWindowsObject.ChildList
  1215.         MOV     AX,ES
  1216.         OR      AX,DI
  1217.         JE      @@2
  1218.         MOV     Last.Word[0],DI
  1219.         MOV     Last.Word[2],ES
  1220. @@1:    LES     DI,ES:[DI].TWindowsObject.SiblingList
  1221.         PUSH    ES
  1222.         PUSH    DI
  1223.         PUSH    ES
  1224.         PUSH    DI
  1225.         MOV     AX,[BP]
  1226.         AND     AL,0FEH
  1227.         PUSH    AX
  1228.         CALL    Test
  1229.         POP     DI
  1230.         POP     ES
  1231.         OR      AL,AL
  1232.         JNE     @@2
  1233.         CMP     DI,Last.Word[0]
  1234.         JNE     @@1
  1235.     MOV     AX,ES
  1236.         CMP     AX,Last.Word[2]
  1237.         JNE     @@1
  1238.         XOR     DI,DI
  1239.         MOV     ES,DI
  1240. @@2:    MOV     AX,DI
  1241.         MOV     DX,ES
  1242. end;
  1243.  
  1244. { Iterates over each child window in Self's ChildList, calling the
  1245.   procedure whose pointer is passed as the Action to be performed for
  1246.   each child.  A pointer to a child is passed as the one parameter to
  1247.   the iteration procedure. }
  1248.  
  1249. procedure TWindowsObject.ForEach(Action: Pointer); assembler;
  1250. var
  1251.   Last: Pointer;
  1252. asm
  1253.         LES     DI,Self
  1254.         LES     DI,ES:[DI].TWindowsObject.ChildList
  1255.         MOV     AX,ES
  1256.         OR      AX,DI
  1257.         JE      @@4
  1258.         MOV     Last.Word[0],DI
  1259.         MOV     Last.Word[2],ES
  1260.         LES     DI,ES:[DI].TWindowsObject.SiblingList
  1261. @@1:    CMP     DI,Last.Word[0]
  1262.         JNE     @@2
  1263.         MOV     AX,ES
  1264.         CMP     AX,Last.Word[2]
  1265.         JE      @@3
  1266. @@2:    PUSH    ES:[DI].TWindowsObject.SiblingList.Word[2]
  1267.     PUSH    ES:[DI].TWindowsObject.SiblingList.Word[0]
  1268.         PUSH    ES
  1269.         PUSH    DI
  1270.         MOV     AX,[BP]
  1271.         AND     AL,0FEH
  1272.         PUSH    AX
  1273.         CALL    Action
  1274.         POP     DI
  1275.         POP     ES
  1276.         JMP     @@1
  1277. @@3:    MOV     AX,[BP]
  1278.         AND     AL,0FEH
  1279.         PUSH    AX
  1280.         CALL    Action
  1281. @@4:
  1282. end;
  1283.  
  1284. { Returns the Id of the TWindowsObject, used to identify the window in
  1285.   a specified parent's ChildList.  Redefined by TControl descendants to
  1286.   return their identifier from their attributes structure.  -1 is returned
  1287.   here as the default identifier.  This precludes any window with a -1 Id
  1288.   from being easily found.  This is the usual Windows strategy for handling
  1289.   static (unchanging child) windows like static controls.  If you need to
  1290.   address individual static controls, give them an id <> -1. }
  1291.  
  1292. function TWindowsObject.GetId: Integer;
  1293. begin
  1294.   GetId := -1;
  1295. end;
  1296.  
  1297. { Returns the 1 based position at which the passed child window appears
  1298.   in Self's ChildList.  If the child does not appear in the list, 0 is
  1299.   returned.}
  1300.  
  1301. function TWindowsObject.IndexOf(P: PWindowsObject): Integer; assembler;
  1302. asm
  1303.         LES     DI,Self
  1304.         LES     DI,ES:[DI].TWindowsObject.ChildList
  1305.         MOV     AX,ES
  1306.         OR      AX,DI
  1307.         JE      @@3
  1308.         MOV     CX,DI
  1309.         MOV     BX,ES
  1310.         XOR     AX,AX
  1311. @@1:    INC     AX
  1312.         LES     DI,ES:[DI].TWindowsObject.SiblingList
  1313.         MOV     DX,ES
  1314.         CMP     DI,P.Word[0]
  1315.         JNE     @@2
  1316.         CMP     DX,P.Word[2]
  1317.         JE      @@3
  1318. @@2:    CMP     DI,CX
  1319.         JNE     @@1
  1320.         CMP     DX,BX
  1321.         JNE     @@1
  1322.         XOR     AX,AX
  1323. @@3:
  1324. end;
  1325.  
  1326. { Returns the child at the passed position in Self's ChildList.  The
  1327.   ChildList is circularly-referent so that passing a position larger than
  1328.   the number of children will cause the traversal of the list to wrap. }
  1329.  
  1330. function TWindowsObject.At(I: Integer): PWindowsObject; assembler;
  1331. asm
  1332.         LES     DI,Self
  1333.         LES     DI,ES:[DI].TWindowsObject.ChildList
  1334.         MOV     AX,ES
  1335.         OR      AX,DI
  1336.         JE      @@2
  1337.         MOV     CX,I
  1338. @@1:    LES     DI,ES:[DI].TWindowsObject.SiblingList
  1339.         LOOP    @@1
  1340. @@2:    MOV     AX,DI
  1341.         MOV     DX,ES
  1342. end;
  1343.  
  1344. { Returns a pointer to the window in the ChildList with the passed Id.
  1345.   If no child in the list has the passed Id, nil is returned. }
  1346.  
  1347. function TWindowsObject.ChildWithId(Id: Integer): PWindowsObject;
  1348.  
  1349.   function IsItThisChild(P: PWindowsObject): Boolean; far;
  1350.   begin
  1351.     IsItThisChild := P^.GetId = Id;
  1352.   end;
  1353.  
  1354. begin
  1355.   ChildWithId := FirstThat(@IsItThisChild);
  1356. end;
  1357.  
  1358. { Performs default processing for an incoming message.  Does nothing, as
  1359.   defined here, relying on the Result field of the passed Msg argument to
  1360.   indicate to Windows that the message was/was not processed.  Is redefined
  1361.   in descendant classes to invoke appropriate default processing, as
  1362.   defined by MS-Windows. }
  1363.  
  1364. procedure TWindowsObject.DefWndProc(var Msg: TMessage);
  1365. begin
  1366. end;
  1367.  
  1368. { Calls a procedure in the TWindowsObject's DVMT which is tagged with the
  1369.   the passed DVMTIndex, if found.  Else calls the passed FailureProc.  Used
  1370.   internally in the OW to match incoming Windows messages to a specified
  1371.   response method. }
  1372.  
  1373. procedure MsgPerform(W: PWindowsObject; var M: TMessage; DVMTIndex: Word;
  1374.   FailureProc: Integer); assembler;
  1375. asm
  1376.     MOV    DX,FailureProc
  1377.     MOV    AX,DVMTIndex
  1378.     LES    DI,M
  1379.     PUSH    ES
  1380.     PUSH    DI
  1381.     LES    BX,W
  1382.     PUSH    ES
  1383.     PUSH    BX
  1384.     MOV    BX,ES:[BX]
  1385.     CALL    DMTLookup
  1386.     MOV    CX,__OWL_DISPATCH_HOOK__.Word[2]
  1387.     JCXZ    @@1
  1388.     CALL    DispatchHook
  1389. @@1:    CALL    DWORD PTR [DI]
  1390. end;
  1391.  
  1392. { Responds to an incoming wm_Command message.  If a child window had the
  1393.   focus when the message was sent or the child window sent a notification
  1394.   message to its parent, the message is sent to the child window. If the
  1395.   message cannot be given to a child window, it is given to Self. }
  1396.  
  1397. procedure TWindowsObject.WMCommand(var Msg: TMessage);
  1398. var
  1399.   CurrentWindow, Control: HWnd;
  1400.   Child: PWindowsObject;
  1401. begin
  1402.   if IsFlagSet(wb_KBHandler) and (Msg.LParam = 0) then
  1403.   begin
  1404.     Control := GetDlgItem(HWindow, Msg.WParam);
  1405.     if (Control <> 0) and (Word(SendMessage(Control, wm_GetDlgCode,
  1406.       0, 0)) and (dlgc_DefPushButton or dlgc_UndefPushButton) <> 0) then
  1407.     begin
  1408.       Msg.LParamLo := Control;
  1409.       Msg.LParamHi := bn_Clicked;
  1410.     end;
  1411.   end;
  1412.   if (Msg.lParamLo = 0) then        { it's a command message and... }
  1413.   begin
  1414.     if (Msg.wParam < cm_Count) then    { ...we can route it }
  1415.     begin
  1416.       { Find the object closed to the focus window }
  1417.       CurrentWindow := GetFocus; { window with focus when command was sent }
  1418.       Child := GetObjectPtr(CurrentWindow);
  1419.       while (Child = nil) and (CurrentWindow <> 0) and
  1420.     (CurrentWindow <> HWindow) do
  1421.       begin
  1422.     CurrentWindow := GetParent(CurrentWindow);
  1423.     Child := GetObjectPtr(CurrentWindow);
  1424.       end;
  1425.  
  1426.       { If the object is found, route to the object, else handle it yourself }
  1427.       if Child = nil then Child := @Self;
  1428.       MsgPerform(Child, Msg, cm_First + Msg.wParam,
  1429.     TWindowsObject_DefCommandProc)
  1430.     end
  1431.     else
  1432.       DefWndProc(Msg);
  1433.   end
  1434.   else
  1435.   begin
  1436.     { Find the child that generated the notification }
  1437.     Child := GetObjectPtr(GetDlgItem(HWindow, Msg.WParam));
  1438.  
  1439.     { If the child is found, give the notification to the child,
  1440.       else give it to Self as an "id" notification. }
  1441.     if (Child <> nil) and (Msg.lParamHi < nf_Count) then
  1442.       MsgPerform(Child, Msg, nf_First + Msg.lParamHi,
  1443.       TWindowsObject_DefNotificationProc)
  1444.     else if Msg.wParam < id_Count then
  1445.       MsgPerform(@Self, Msg, id_First + Msg.wParam,
  1446.           TWindowsObject_DefChildProc)
  1447.     else DefChildProc(Msg);
  1448.   end;
  1449. end;
  1450.  
  1451. { Dispatches scroll messages as if they where WMCommand message, that is
  1452.   by routing them to the scroll bar control as a notificationa and to
  1453.   Self as an "id" notification. }
  1454.  
  1455. procedure TWindowsObject.DispatchScroll(var Msg: TMessage);
  1456. var
  1457.   CurrentWindow: HWnd;
  1458.   Child: PWindowsObject;
  1459.   ChildId: Word;
  1460. begin
  1461.   if Msg.lParamHi <> 0 then
  1462.   begin
  1463.     Child := GetObjectPtr(Msg.lParamHi);
  1464.     if Child <> nil then
  1465.       MsgPerform(Child, Msg, nf_First + Msg.wParam,
  1466.         TWindowsObject_DefNotificationProc)
  1467.     else
  1468.     begin
  1469.       ChildId := GetWindowWord(Msg.lParamHi, gww_ID);
  1470.       if ChildId < id_Count then
  1471.         MsgPerform(@Self, Msg, id_First + ChildId,
  1472.           TWindowsObject_DefChildProc)
  1473.       else DefChildProc(Msg);
  1474.     end;
  1475.   end else DefWndProc(Msg);
  1476. end;
  1477.  
  1478. { Responds to an incoming wm_VScroll message by calling DispatchScroll. 
  1479.   If message is not handled, calls DefWndProc.  If the window has a
  1480.   window's style scroll bar, the DispatchScroll processing is bypassed
  1481.   since it cannot be determined who generated the scroll message. }
  1482.  
  1483. procedure TWindowsObject.WMVScroll(var Msg: TMessage);
  1484. begin
  1485.   if (GetWindowLong(HWindow, gwl_Style) and ws_VScroll) = 0 then
  1486.     DispatchScroll(Msg)
  1487.   else DefWndProc(Msg);
  1488. end;
  1489.  
  1490. { Responds to an incoming wm_HScroll message by calling DispatchScroll.
  1491.   If message is not handled, calls DefWndProc.  If the window has a
  1492.   window's style scroll bar, the DispatchScroll processing is bypassed
  1493.   since it cannot be determined who generated the scroll message. }
  1494.  
  1495. procedure TWindowsObject.WMHScroll(var Msg: TMessage);
  1496. begin
  1497.   if (GetWindowLong(HWindow, gwl_Style) and ws_HScroll) = 0 then
  1498.     DispatchScroll(Msg)
  1499.   else DefWndProc(Msg);
  1500. end;
  1501.  
  1502. { Performs default processing for a command message (menu selection or
  1503.   accelerator.  If the original message receiver was this object, give
  1504.   the message to DefWndProc, else if the object has a parent, give the
  1505.   message to the parent, else give the message to the original receiver. }
  1506.  
  1507. procedure TWindowsObject.DefCommandProc(var Msg: TMessage);
  1508. var
  1509.   Target: PWindowsObject;
  1510. begin
  1511.   if Msg.Receiver = HWindow then Target := nil else
  1512.     if Parent <> nil then Target := Parent else
  1513.       Target := GetObjectPtr(Msg.Receiver);
  1514.   if Target = nil then DefWndProc(Msg) else
  1515.     MsgPerform(Target, Msg, cm_First + Msg.WParam,
  1516.       TWindowsObject_DefCommandProc)
  1517. end;
  1518.  
  1519. { Performs default processing for an incoming notification message from
  1520.   a child of the TWindowsObject. Nothing can be done by default of a
  1521.   child notification (or "id" message). The user can override this method
  1522.   if it is more convienent to handle "id" messages in a case statement. }
  1523.  
  1524. procedure TWindowsObject.DefChildProc(var Msg: TMessage);
  1525. begin
  1526.   DefWndProc(Msg);
  1527. end;
  1528.  
  1529. { Performs default processing for a notification message generated by the
  1530.   TWindowsObject. (The TWindowsObject has the option to perform processing
  1531.   in response to its own notification messages. )  It passes the message to
  1532.   the parent as an "id" message.  It is assumed that the object giving this
  1533.   message to this object is the parent of this object.  This is done in
  1534.   WMCommand, WMHScroll, or WMVScroll of the parent. Notifications are
  1535.   translated into "id" message so that the parent does not confuse child
  1536.   notification with its own notifications. Since the Msg record does not
  1537.   contain the id if its an WMHScroll or WMVScroll the id is looked up
  1538.   explicitly.}
  1539.  
  1540. procedure TWindowsObject.DefNotificationProc(var Msg: TMessage);
  1541. begin
  1542.   if Parent <> nil then
  1543.     if Msg.Message = wm_Command then
  1544.       MsgPerform(Parent, Msg, id_First + Msg.WParam,
  1545.         TWindowsObject_DefChildProc)
  1546.     else
  1547.       MsgPerform(Parent, Msg, id_First + GetWindowWord(HWindow,
  1548.         gww_ID), TWindowsObject_DefChildProc);
  1549. end;
  1550.  
  1551. { Generates a run-time error (via call to inherited Abstract method)
  1552.   because an attempt should not be made to create an interface element to
  1553.   be associated with an instance of this abstract object type.
  1554.   Placeholder for descendant methods to redefine to create an MS-Windows
  1555.   element to be associated with a OW window object. }
  1556.  
  1557. function TWindowsObject.Create: Boolean;
  1558. begin
  1559.   Abstract;
  1560. end;
  1561.  
  1562. { Destroys an MS-Windows element associated with the TWindowsObject after
  1563.   setting the wb_AutoCreate flag to ON for each of the windows in Self's
  1564.   ChildList. }
  1565.  
  1566. procedure TWindowsObject.Destroy;
  1567.  
  1568.   procedure DoEnableAutoCreate(P: PWindowsObject); far;
  1569.   begin
  1570.     if P^.HWindow <> 0 then P^.EnableAutoCreate;
  1571.   end;
  1572.  
  1573. begin
  1574.   if HWindow <> 0 then
  1575.   begin
  1576.     ForEach(@DoEnableAutoCreate);
  1577.     if IsFlagSet(wb_MDIChild) and (Parent^.GetClient <> nil) then
  1578.       SendMessage((Parent^.GetClient)^.HWindow, wm_MDIDestroy, HWindow, 0)
  1579.     else DestroyWindow(HWindow);
  1580.   end;
  1581. end;
  1582.  
  1583. { Returns the name of the MS-Windows window class for TWindowsObjects. The
  1584.   default window class name is 'TurboWindow'. }
  1585.  
  1586. function TWindowsObject.GetClassName: PChar;
  1587. begin
  1588.   GetClassName := 'TurboWindow';
  1589. end;
  1590.  
  1591. { Initializes the passed parameter with the registration attributes for
  1592.   the TWindowsObject.  This method serves as a placeholder for descendant
  1593.   classes to redefine to specify registration attributes for the MS-Windows
  1594.   class of a window object. }
  1595.  
  1596. procedure TWindowsObject.GetWindowClass(var AWndClass: TWndClass);
  1597. begin
  1598.   Abstract;
  1599. end;
  1600.  
  1601. { Performs setup following creation of an associated MS-Windows window.
  1602.   Iterates though Self's ChildList, attempting to create an associated
  1603.   MS-Windows interface element for each child window object in the list.
  1604.   (A child's Create method is not called if its wb_AutoCreate flag is not
  1605.   set).  Calls TransferData to transfer data for its children for whom
  1606.   data transfer is enabled.  Can be redefined in descendant classes to
  1607.   perform additional special initialization.  The private field
  1608.   CreateOrder is used to ensure the create order is consistent through
  1609.   load and store of the object.  If the object is store'ed, store will
  1610.   fill in this value.  CreateOrder ranges in value from 1 to N where N
  1611.   is the number of objects with values.  All other objects will have a
  1612.   CreateOrder of Zero, which implies the object will be created
  1613.   after the last object with a create order.}
  1614.  
  1615. procedure TWindowsObject.SetupWindow;
  1616. begin
  1617.   if not CreateChildren then Status := em_InvalidChild
  1618.   else TransferData(tf_SetData);
  1619. end;
  1620.  
  1621. { Transfers data between the TWindowsObject's data buffer and the child
  1622.   windows in its ChildList. (Data is not transfered between any child
  1623.   windows whose wb_Transfer flag is not set). }
  1624.  
  1625. procedure TWindowsObject.TransferData(Direction: Word);
  1626. var
  1627.   DataPtr: Pointer;
  1628.  
  1629.   procedure TransferDataChild(AChild: PWindowsObject); far;
  1630.   begin
  1631.     if AChild^.IsFlagSet(wb_Transfer) then
  1632.       Inc(PtrRec(DataPtr).Ofs, AChild^.Transfer(DataPtr, Direction));
  1633.   end;
  1634.  
  1635. begin
  1636.   if TransferBuffer <> nil then
  1637.   begin
  1638.     DataPtr := TransferBuffer;
  1639.     ForEach(@TransferDataChild);
  1640.   end;
  1641. end;
  1642.  
  1643. { Registers the TWindowsObject's MS-Windows, if not already registered. }
  1644.  
  1645. function TWindowsObject.Register: Boolean;
  1646. var
  1647.   WindowClass: TWndClass;
  1648. begin
  1649.   Register := True;
  1650.   if not GetClassInfo(HInstance, GetClassName, WindowClass) then
  1651.   begin
  1652.     GetWindowClass(WindowClass);
  1653.     Register := RegisterClass(WindowClass);
  1654.   end;
  1655. end;
  1656.  
  1657. { Displays the TWindowsObject, after checking that it has a valid
  1658.  (non-zero) handle. }
  1659.  
  1660. procedure TWindowsObject.Show(ShowCmd: Integer);
  1661. begin
  1662.   if HWindow <> 0 then ShowWindow(HWindow, ShowCmd);
  1663. end;
  1664.  
  1665. { Returns a Boolean value indicating whether or not it is Ok to close
  1666.   the TWindowsObject.  Iterates through Self's ChildList, calling the
  1667.   CanClose method of each.  Returns False if any of the child windows
  1668.   return False. }
  1669.  
  1670. function TWindowsObject.CanClose: Boolean;
  1671.  
  1672.   function CannotCloseChild(P: PWindowsObject): Boolean; far;
  1673.   begin
  1674.     CannotCloseChild := (P^.HWindow <> 0) and not P^.CanClose;
  1675.   end;
  1676.  
  1677. begin
  1678.   CanClose := FirstThat(@CannotCloseChild) = nil;
  1679. end;
  1680.  
  1681. { The default response to a WMClose message is to send a CloseWindow
  1682.   message.  CloseWindow sends a CanClose to determine if the window
  1683.   can be closed. }
  1684. procedure TWindowsObject.WMClose(var Msg: TMessage);
  1685. begin
  1686.   CloseWindow;
  1687. end;
  1688.  
  1689. { Responds to an incoming wm_Close message or an explicit CloseWindow.
  1690.   Destroys the associated MS-Windows interface element and frees Self after
  1691.   determining that it is Ok to do so.  If Self is the main window of the
  1692.   application, calls the CanClose method of the application, else calls
  1693.   Self.CanClose, before calling Free. }
  1694.  
  1695. procedure TWindowsObject.CloseWindow;
  1696. var
  1697.   WillClose: Boolean;
  1698. begin
  1699.   if @Self = Application^.MainWindow then
  1700.     WillClose := Application^.CanClose
  1701.   else WillClose := CanClose;
  1702.   if WillClose then Free;
  1703. end;
  1704.  
  1705. { Create a memory DC that is compatible with the given window }
  1706.  
  1707. function TWindowsObject.CreateMemoryDC: HDC;
  1708. var
  1709.   DC: HDC;
  1710. begin
  1711.   DC := GetDC(HWindow);
  1712.   CreateMemoryDC := CreateCompatibleDC(DC);
  1713.   ReleaseDC(HWindow, DC);
  1714. end;
  1715.  
  1716. { Responds to an incoming wm_Destroy message.  If Self is the
  1717.   application's main window posts a 'quit' message to end the application. }
  1718.  
  1719. procedure TWindowsObject.WMDestroy(var Msg: TMessage);
  1720. begin
  1721.   if @Self = Application^.MainWindow then
  1722.     PostQuitMessage(HWindow);
  1723.   DefWndProc(Msg);
  1724. end;
  1725.  
  1726. { Responds to an incoming wm_NCDestroy message, the last message sent to
  1727.   an MS-Windows interface element.  Removes any properties that have been
  1728.   associated with HWindow. Sets the HWindow data field of the
  1729.   TWindowsObject to zero to indicate that an interface element is no
  1730.   longer associated with the object. }
  1731.  
  1732. procedure TWindowsObject.WMNCDestroy(var Msg: TMessage);
  1733. begin
  1734.   RemoveProperties(HWindow);
  1735.   DefWndProc(Msg);
  1736.   HWindow := 0;
  1737. end;
  1738.  
  1739. { Responds to an incoming wm_Activate message.  If the TWindowsObject is
  1740.   being activated and if it has requested keyboard handling for its
  1741.   messages, enables the "keyboard handler" by calling the
  1742.   SetKBHandler method of the application. }
  1743.  
  1744. procedure TWindowsObject.WMActivate(var Msg: TMessage);
  1745. begin
  1746.   DefWndProc(Msg);
  1747.   if Msg.WParam <> 0 then
  1748.     if IsFlagSet(wb_KBHandler) then
  1749.       Application^.SetKBHandler(@Self)
  1750.     else
  1751.       Application^.SetKBHandler(nil);
  1752. end;
  1753.  
  1754. { Respond to Windows attempt to close down. }
  1755.  
  1756. procedure TWindowsObject.WMQueryEndSession(var Msg: TMessage);
  1757. begin
  1758.   if @Self = Application^.MainWindow then
  1759.     Msg.Result := Integer(Application^.CanClose)
  1760.   else Msg.Result := Integer(CanClose);
  1761. end;
  1762.  
  1763. { If the window receives an Exit menu choice, it will attempt
  1764.   to close down the window. }
  1765.  
  1766. procedure TWindowsObject.CMExit(var Msg: TMessage);
  1767. begin
  1768.   if @Self = Application^.MainWindow then
  1769.     CloseWindow else
  1770.     DefCommandProc(Msg);
  1771. end;
  1772.  
  1773. { Returns a nil pointer to indicate that the TWindowsObject is not a
  1774.   TMDIWindow.  Is redefined for descendant TMDIWindows to return a pointer
  1775.   to their TMDIClient window. }
  1776.  
  1777. function TWindowsObject.GetClient: PMDIClient;
  1778. begin
  1779.   GetClient := nil;
  1780. end;
  1781.  
  1782. { TWindow }
  1783.  
  1784. { Constructor for a TWindow.  Initializes its data fields using passed
  1785.   parameters and default values. }
  1786.  
  1787. constructor TWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  1788. begin
  1789.   TWindowsObject.Init(AParent);
  1790.   with Attr do
  1791.   begin
  1792.     Title := StrNew(ATitle);
  1793.     DefaultProc := @DefWindowProc;
  1794.     if AParent = nil then
  1795.       Style := ws_OverlappedWindow
  1796.     else
  1797.       if AParent^.GetClient <> nil then
  1798.       begin
  1799.     SetFlags(wb_MDIChild, True);
  1800.     DefaultProc := @DefMDIChildProc;
  1801.     Style := ws_ClipSiblings;
  1802.       end
  1803.       else Style := ws_Visible;
  1804.     ExStyle := 0;
  1805.     X := cw_UseDefault;
  1806.     Y := 0;
  1807.     W := cw_UseDefault;
  1808.     H := 0;
  1809.     Param := nil;
  1810.     Menu := 0;
  1811.   end;
  1812.   Scroller := nil;
  1813.   FocusChildHandle := 0;
  1814. end;
  1815.  
  1816. { Destructor for a TWindow.  Disposes of its Scroller if the TScroller
  1817.   object was constructed, then calls TWindowsObject's Done destructor. }
  1818.  
  1819. destructor TWindow.Done;
  1820. begin
  1821.   StrDispose(Attr.Title);
  1822.   if Scroller <> nil then
  1823.   begin
  1824.     Dispose(Scroller, Done);
  1825.     Scroller := nil;
  1826.   end;
  1827.   TWindowsObject.Done;
  1828. end;
  1829.  
  1830. { Constructor for a TWindow to be associated with a MS-Windows interface
  1831.   element created by MS-Windows from a resource definition. Initializes
  1832.   its data fields using passed parameters and default values. }
  1833.  
  1834. constructor TWindow.InitResource(AParent: PWindowsObject; ResourceID: Word);
  1835. begin
  1836.   TWindowsObject.Init(AParent);
  1837.   SetFlags(wb_FromResource, True);
  1838.   FillChar(Attr, SizeOf(Attr), 0);
  1839.   Attr.ID := ResourceID;
  1840.   DefaultProc := nil;
  1841.   Scroller := nil;
  1842.   FocusChildHandle := 0;
  1843. end;
  1844.  
  1845. { Constructor for a TWindow.  Initializes the object with data from the
  1846.   passed TStream.  Loads its Scroller object, if stored. }
  1847.  
  1848. constructor TWindow.Load(var S: TStream);
  1849. begin
  1850.   TWindowsObject.Load(S);
  1851.   if IsFlagSet(wb_FromResource) then
  1852.   begin
  1853.     DefaultProc := nil;
  1854.     FillChar(Attr, SizeOf(Attr), 0)
  1855.   end
  1856.   else
  1857.   begin
  1858.     with Attr do
  1859.     begin
  1860.       Title := S.StrRead;
  1861.       S.Read(Style, SizeOf(Style));
  1862.       S.Read(ExStyle, SizeOf(ExStyle));
  1863.       S.Read(X, SizeOf(X));
  1864.       S.Read(Y, SizeOf(Y));
  1865.       S.Read(W, SizeOf(W));
  1866.       S.Read(H, SizeOf(H));
  1867.       S.Read(Param, SizeOf(Param));
  1868.     end;
  1869.     if IsFlagSet(wb_MDIChild) then
  1870.       DefaultProc := @DefMDIChildProc
  1871.     else DefaultProc := @DefWindowProc;
  1872.   end;
  1873.   S.Read(Attr.Id, SizeOf(Attr.Id));
  1874.   Scroller := PScroller(S.Get);
  1875.   if Scroller <> nil then Scroller^.Window := @Self;
  1876.   FocusChildHandle := 0;
  1877. end;
  1878.  
  1879. { Stores data of the TWindow in the passed TStream.  Stores its Scroller
  1880.   object, if constructed. }
  1881.  
  1882. procedure TWindow.Store(var S: TStream);
  1883. var
  1884.   SaveStyle: LongInt;
  1885. begin
  1886.   TWindowsObject.Store(S);
  1887.   if not IsFlagSet(wb_FromResource) then
  1888.     with Attr do
  1889.     begin
  1890.       SaveStyle := Style and not (ws_Minimize or ws_Maximize);
  1891.       if HWindow <> 0 then
  1892.     if IsIconic(HWindow) then SaveStyle := SaveStyle or ws_Minimize
  1893.     else if IsZoomed(HWindow) then SaveStyle := SaveStyle or ws_Maximize;
  1894.       S.StrWrite(Title);
  1895.       S.Write(SaveStyle, SizeOf(SaveStyle));
  1896.       S.Write(ExStyle, SizeOf(ExStyle));
  1897.       S.Write(X, SizeOf(X));
  1898.       S.Write(Y, SizeOf(Y));
  1899.       S.Write(W, SizeOf(W));
  1900.       S.Write(H, SizeOf(H));
  1901.       S.Write(Param, SizeOf(Param));
  1902.     end;
  1903.   S.Write(Attr.Id, SizeOf(Attr.Id));
  1904.   S.Put(Scroller);
  1905. end;
  1906.  
  1907. { Sets the caption of the window. }
  1908.  
  1909. procedure TWindow.SetCaption(ATitle: PChar);
  1910. begin
  1911.   with Attr do
  1912.   begin
  1913.     StrDispose(Title);
  1914.     Title := StrNew(ATitle);
  1915.     SetWindowText(HWindow, Title);
  1916.   end;
  1917. end;
  1918.  
  1919. { Specifies registration attributes for the MS-Windows window class of the
  1920.   TWindow, allowing instances of TWindow to be registered.  Sets the fields
  1921.   of the passed TWndClass parameter to the default attributes appropriate
  1922.   for a TWindow. }
  1923.  
  1924. procedure TWindow.GetWindowClass(var AWndClass: TWndClass);
  1925. begin
  1926.   AWndClass.cbClsExtra        := 0;
  1927.   AWndClass.cbWndExtra        := 0;
  1928.   AWndClass.hInstance        := HInstance;
  1929.   AWndClass.hIcon        := LoadIcon(0, idi_Application);
  1930.   AWndClass.hCursor        := LoadCursor(0, idc_Arrow);
  1931.   AWndClass.hbrBackground    := HBrush(color_Window + 1);
  1932.   AWndClass.lpszMenuName    := nil;
  1933.   AWndClass.lpszClassName    := GetClassName;
  1934.   AWndClass.style        := cs_HRedraw or cs_VRedraw;
  1935.   AWndClass.lpfnWndProc       := @InitWndProc;
  1936. end;
  1937.  
  1938. { Returns the resource id of the TWindow found in the attributes
  1939.   structure (the Attr data field). }
  1940.  
  1941. function TWindow.GetId: Integer;
  1942. begin
  1943.   GetId := Attr.Id;
  1944. end;
  1945.  
  1946. { Specifies default processing for an incoming message.  Invokes default
  1947.   processing, defined by MS-Windows. Stores the result of the call to the
  1948.   default window procedure in the Result field of the message record. }
  1949.  
  1950. procedure TWindow.DefWndProc(var Msg: TMessage); assembler;
  1951. asm
  1952.     LES    DI,Self
  1953.     PUSH    ES:[DI].TWindow.DefaultProc.Word[2]
  1954.     PUSH    ES:[DI].TWindow.DefaultProc.Word[0]
  1955.     PUSH    ES:[DI].TWindowsObject.HWindow
  1956.     LES    DI,Msg
  1957.     PUSH    ES:[DI].TMessage.Message
  1958.     PUSH    ES:[DI].TMessage.WParam
  1959.     PUSH    ES:[DI].TMessage.LParamHi
  1960.     PUSH    ES:[DI].TMessage.LParamLo
  1961.     CALL    CallWindowProc
  1962.     LES    DI,Msg
  1963.     MOV    ES:[DI].TMessage.ResultLo,AX
  1964.     MOV    ES:[DI].TMessage.ResultHi,DX
  1965. end;
  1966.  
  1967. { Associates an MS-Windows interface element with the TWindow object,
  1968.   after creating the interface element if not already created.  When
  1969.   creating an element, uses the creation attributes previously set in the
  1970.   Attr data field.  (Simply associates the TWindow with an
  1971.   already-created interface element if the "FromResource" flag is set.)
  1972.   If the TWindow could be successfully associated, calls SetupWindow and
  1973.   returns True.  Association is not attempted if the TWindow's Status
  1974.   data field is non-zero.  }
  1975.  
  1976. function TWindow.Create: Boolean;
  1977. var
  1978.   HParent: HWnd;
  1979.   TheMDIClient: PMDIClient;
  1980.   CreateStruct: TMDICreateStruct;
  1981. begin
  1982.   if Status = 0 then
  1983.   begin
  1984.     DisableAutoCreate;
  1985.     if Parent = nil then HParent := 0 else HParent := Parent^.HWindow;
  1986.     if not IsFlagSet(wb_FromResource) then
  1987.     begin
  1988.       if Register then
  1989.       begin
  1990.         CreationWindow := @Self;
  1991.     if not IsFlagSet(wb_MDIChild) then
  1992.           with Attr do
  1993.             HWindow := CreateWindowEx(ExStyle, GetClassName, Title,
  1994.               Style, X, Y, W, H, HParent, Menu, HInstance, Param)
  1995.         else { MDI Child window }
  1996.     begin
  1997.       with CreateStruct do
  1998.       begin
  1999.         szClass := GetClassName;
  2000.         szTitle := Attr.Title;
  2001.         hOwner := HInstance;
  2002.         x := Attr.X; y := Attr.Y; cx := Attr.W; cy := Attr.H;
  2003.         style := Attr.Style;
  2004.       end;
  2005.       TheMDIClient := Parent^.GetClient;
  2006.       if TheMDIClient <> nil then
  2007.         HWindow := HWnd(SendMessage(TheMDIClient^.HWindow, wm_MDICreate, 0,
  2008.           Longint(@CreateStruct)));
  2009.     end; { MDI Child window }
  2010.       end;
  2011.     end
  2012.     else { Windows already created window }
  2013.       HWindow := GetDlgItem(HParent, Attr.ID);
  2014.     if HWindow = 0 then
  2015.       Status := em_InvalidWindow
  2016.     else
  2017.       if GetObjectPtr(HWindow) = nil then
  2018.       begin
  2019.         AttachProperties(HWindow, @Self);
  2020.     DefaultProc := TFarProc(SetWindowLong(HWindow, gwl_WndProc,
  2021.       LongInt(Instance)));
  2022.     SetupWindow;
  2023.       end;
  2024.   end;
  2025.   Create := Status = 0;
  2026. end;
  2027.  
  2028. { Called upon activation or un-iconization to re-focus the last
  2029.   focused child }
  2030.  
  2031. procedure TWindow.FocusChild;
  2032. begin
  2033.   if (FocusChildHandle <> 0) and IsWindow(FocusChildHandle) and
  2034.       not IsIconic(HWindow) then
  2035.     SetFocus(FocusChildHandle);
  2036. end;
  2037.  
  2038. { Updates the value of FocusChildHandle }
  2039.  
  2040. procedure TWindow.UpdateFocusChild;
  2041. var
  2042.   CurrentFocus: Word;
  2043. begin
  2044.   CurrentFocus := GetFocus;
  2045.   if (CurrentFocus <> 0) and IsChild(HWindow, CurrentFocus) then
  2046.     FocusChildHandle := CurrentFocus;
  2047. end;
  2048.  
  2049. { Updates the coordinates in Attr to their new values }
  2050.  
  2051. procedure TWindow.UpdateWindowRect;
  2052. var
  2053.   WndRect: TRect;
  2054.   MDIClient: PMDIClient;
  2055. begin
  2056.   if not (IsIconic(HWindow) or IsZoomed(HWindow)) then
  2057.   begin
  2058.     GetWindowRect(HWindow, WndRect);
  2059.     Attr.W := WndRect.right - WndRect.left;
  2060.     Attr.H := WndRect.bottom - WndRect.top;
  2061.     if Parent <> nil then
  2062.     begin
  2063.       MDIClient := Parent^.GetClient;
  2064.       if (MDIClient <> nil) and IsFlagSet(wb_MDIChild) then 
  2065.         ScreenToClient(MDIClient^.HWindow, PPoint(@WndRect)^)
  2066.       else
  2067.         if Attr.Style and ws_Child <> 0 then
  2068.           ScreenToClient(Parent^.HWindow, PPoint(@WndRect)^);
  2069.     end;
  2070.     Attr.X := WndRect.left;
  2071.     Attr.Y := WndRect.top;
  2072.   end;
  2073. end;
  2074.  
  2075. { Response method for an incoming wm_Activate message.  If the TWindow has
  2076.   requested keyboard handling for its messages, saves the child with the
  2077.   focus if is being deactivated and restores the focus to this child when
  2078.   the TWindow is reactivated. }
  2079.  
  2080. procedure TWindow.WMActivate(var Msg: TMessage);
  2081. var
  2082.   CurrentFocus: HWnd;
  2083. begin
  2084.   TWindowsObject.WMActivate(Msg);
  2085.   if IsFlagSet(wb_KBHandler) then
  2086.   begin
  2087.     if (Msg.WParam <> 0) then FocusChild
  2088.     else UpdateFocusChild;
  2089.   end;
  2090. end;
  2091.  
  2092. procedure TWindow.WMMDIActivate(var Msg: TMessage);
  2093. begin
  2094.   WMActivate(Msg);
  2095. end;
  2096.  
  2097. { Initializes ("sets up") the TWindow.  Called following a successful
  2098.   association between an MS-Windows interface element and a TWindow.  Sets
  2099.   the focus to TWindows created as MDI children.  If the TWindow has a
  2100.   TScroller object, calls the TScroller's SetSBarRange to set the range of
  2101.   the TWindow's window scrollbars.  Calls TWindowsObject.SetupWindow to
  2102.   create windows in child list.  Can be redefined in descendant classes to
  2103.   perform additional initialization. }
  2104.  
  2105. procedure TWindow.SetupWindow;
  2106. begin
  2107.   TWindowsObject.SetupWindow;
  2108.   if IsFlagSet(wb_MDIChild) then SetFocus(HWindow);
  2109.   if Scroller <> nil then Scroller^.SetSBarRange;
  2110.   UpdateWindowRect;
  2111. end;
  2112.  
  2113. { WMCreate is received only if our default procedure is installed and
  2114.   therefore we can setup the already created window. }
  2115.  
  2116. procedure TWindow.WMCreate(var Msg: TMessage);
  2117. begin
  2118.   SetupWindow;
  2119.   DefWndProc(Msg);
  2120. end;
  2121.  
  2122. { Response method for an incoming wm_HScroll message.  If the message is
  2123.   from a scrollbar control, calls DispatchScroll directly to avoid calling
  2124.   TWindowsObject.WMHScroll so that GetWindowLong is called only once.
  2125.   Else passes the message to the TWindow's Scroller if it has been
  2126.   constructed, and calls DefWndProc. Assumes because of a Windows bug that
  2127.   if the window has the scrollbar style, it will not have scrollbar
  2128.   controls. }
  2129.  
  2130. procedure TWindow.WMHScroll(var Msg: TMessage);
  2131. begin
  2132.   if (GetWindowLong(HWindow, gwl_Style) and ws_HScroll) = 0 then
  2133.     DispatchScroll(Msg)
  2134.   else if (Scroller <> nil) then
  2135.     Scroller^.HScroll(Msg.WParam, Msg.LParamLo)
  2136.   else DefWndProc(Msg);
  2137. end;
  2138.  
  2139. { Response method for an incoming wm_VScroll message.  If the message is
  2140.   from a scrollbar control, calls DispatchScroll directly to avoid calling
  2141.   TWindowsObject.WMHScroll so that GetWindowLong is called only once.
  2142.   Else passes the message to the TWindow's Scroller if it has been
  2143.   constructed, and calls DefWndProc.  Assumes because of a Windows bug that
  2144.   if the window has the scrollbar style, it will not have scrollbar
  2145.   controls.}
  2146.  
  2147. procedure TWindow.WMVScroll(var Msg: TMessage);
  2148. begin
  2149.   if (GetWindowLong(HWindow, gwl_Style) and ws_VScroll) = 0 then
  2150.     DispatchScroll(Msg)
  2151.   else if (Scroller <> nil) then
  2152.     Scroller^.VScroll(Msg.WParam, Msg.LParamLo)
  2153.   else DefWndProc(Msg);
  2154. end;
  2155.  
  2156. { Response method for an incoming wm_Paint message. Calls Self.Paint,
  2157.   performing Windows-required paint setup and cleanup before and after.
  2158.   (If the TWindow has a TScroller, also calls its BeginView and EndView
  2159.   methods before and after call to Paint. }
  2160.  
  2161. procedure TWindow.WMPaint(var Msg: TMessage);
  2162. var
  2163.   PaintInfo: TPaintStruct;
  2164. begin
  2165.   BeginPaint(HWindow, PaintInfo);
  2166.   if Scroller <> nil then Scroller^.BeginView(PaintInfo.HDC, PaintInfo);
  2167.   Paint(PaintInfo.HDC, PaintInfo);
  2168.   if Scroller <> nil then Scroller^.EndView;
  2169.   EndPaint(HWindow, PaintInfo);
  2170. end;
  2171.  
  2172. { Redraws the contents of the TWindow after a WMPaint message is received.
  2173.   Placeholder for descendant object types to redefine. }
  2174.  
  2175. procedure TWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  2176. begin
  2177. end;
  2178.  
  2179. { Response method for an incoming wm_Size message.  Calls the SetPageSize
  2180.   method of the TWindow's Scroller, if it has been constructed.  Also
  2181.   saves the normal size of the window in Attr. }
  2182.  
  2183. procedure TWindow.WMSize(var Msg: TMessage);
  2184. var
  2185.   WndRect: TRect;
  2186. begin
  2187.   if (Scroller <> nil) and (Msg.WParam <> sizeIconic) then
  2188.     Scroller^.SetPageSize;
  2189.   if Msg.wParam = sizeNormal then
  2190.   begin
  2191.     GetWindowRect(HWindow, WndRect);
  2192.     Attr.H := WndRect.bottom - WndRect.top;
  2193.     Attr.W := WndRect.right - WndRect.left;
  2194.   end;
  2195.   DefWndProc(Msg);
  2196. end;
  2197.  
  2198. { Save the normal position of the window.  If IsIconic and IsZoomed
  2199.   ignore the position since it does not reflect the normal state. }
  2200.  
  2201. procedure TWindow.WMMove(var Msg: TMessage);
  2202. begin
  2203.   UpdateWindowRect;
  2204.   DefWndProc(Msg);
  2205. end;
  2206.  
  2207. { Response method for an incoming wm_LButtonDown message.  If the TWindow's
  2208.   Scroller has been constructed and if auto-scrolling has been requested,
  2209.   captures mouse input, loops until a wm_LButtonUp message comes in calling
  2210.   the Scroller's AutoScroll method, and then releases capture on mouse
  2211.   input. }
  2212.  
  2213. procedure TWindow.WMLButtonDown(var Msg: TMessage);
  2214. var
  2215.   LoopMsg: TMsg;
  2216. begin
  2217.   if (Scroller <> nil) and Scroller^.AutoMode then
  2218.   begin
  2219.     SetCapture(HWindow);
  2220.     repeat
  2221.       if PeekMessage(LoopMsg, 0, 0, 0, pm_Remove) then
  2222.       begin
  2223.     TranslateMessage(LoopMsg);
  2224.         DispatchMessage(LoopMsg);
  2225.       end;
  2226.       Scroller^.AutoScroll;
  2227.     until LoopMsg.Message = wm_LButtonUp;
  2228.     ReleaseCapture;
  2229.   end;
  2230.   DefWndProc(Msg);
  2231. end;
  2232.  
  2233. procedure TWindow.WMSysCommand(var Msg: TMessage);
  2234. begin
  2235.   if IsFlagSet(wb_KBHandler) then
  2236.     case Msg.wParam of
  2237.       sc_Minimize: UpdateFocusChild;
  2238.       sc_Restore: FocusChild;
  2239.     end;
  2240.   DefWndProc(Msg);
  2241. end;
  2242.  
  2243. { TMDIWindow }
  2244.  
  2245. { Constructor for a TMDIWindow.  Initializes the object with data from
  2246.   the passed TStream.  Loads its ClientWnd, if stored. }
  2247.  
  2248. constructor TMDIWindow.Load(var S: TStream);
  2249. begin
  2250.   TWindow.Load(S);
  2251.   ClientWnd := PMDIClient(S.Get);
  2252.   ClientWnd^.Parent := @Self;
  2253.   S.Read(ChildMenuPos, SizeOf(ChildMenuPos));
  2254. end;
  2255.  
  2256. { Stores data of the TMDIWindow in the passed TStream.  Stores its
  2257.   ClientWnd. }
  2258.  
  2259. procedure TMDIWindow.Store(var S: TStream);
  2260. begin
  2261.   TWindow.Store(S);
  2262.   S.Put(ClientWnd);
  2263.   S.Write(ChildMenuPos, SizeOf(ChildMenuPos));
  2264. end;
  2265.  
  2266. { Constructor for a TMDIWindow.  Initializes its data fields using passed
  2267.   parameters and default values. }
  2268.  
  2269. constructor TMDIWindow.Init(ATitle: PChar; AMenu: HMenu);
  2270. begin
  2271.   TWindow.Init(nil, ATitle);
  2272.   Attr.Menu := AMenu;
  2273.   ChildMenuPos := 0;
  2274.   ClientWnd := nil;
  2275.   InitClientWindow;
  2276. end;
  2277.  
  2278. { Constructs the TMDIWindow's MDI client window. }
  2279.  
  2280. procedure TMDIWindow.InitClientWindow;
  2281. begin
  2282.   ClientWnd := new(PMDIClient, Init(@Self));
  2283. end;
  2284.  
  2285. { Destructor for a TMDIWindow.  Disposes of the TMDIWindow's MDI client 
  2286.   window. }
  2287.  
  2288. destructor TMDIWindow.Done;
  2289. begin
  2290.   TWindow.Done;
  2291.   if ClientWnd <> nil then Dispose(ClientWnd, Done);
  2292. end;
  2293.  
  2294. { Returns the default name of the MS-Windows window class for a
  2295.   TMDIWindow - 'TurboMDIWindow' }
  2296.  
  2297. function TMDIWindow.GetClassName: PChar;
  2298. begin
  2299.   GetClassName := 'TurboMDIWindow';
  2300. end;
  2301.  
  2302. { Returns a pointer to the TMDIWindow's MDI client window. }
  2303.  
  2304. function TMDIWindow.GetClient: PMDIClient;
  2305. begin
  2306.   GetClient := ClientWnd;
  2307. end;
  2308.  
  2309. { Sets up the TMDIWindow by constructing and creating its TMDIClient. }
  2310.  
  2311. procedure TMDIWindow.SetupWindow;
  2312. var
  2313.   FrameMenu: HMenu;
  2314.   R: TRect;
  2315. begin
  2316.   FrameMenu := GetMenu(HWindow);
  2317.   ClientWnd^.ClientAttr.hWindowMenu := GetSubMenu(FrameMenu, ChildMenuPos);
  2318.   GetClientRect(HWindow, R);
  2319.   with ClientWnd^.Attr do
  2320.   begin
  2321.     if X = cw_UseDefault then
  2322.     begin
  2323.       X := R.left;
  2324.       Y := R.top;
  2325.     end;
  2326.     if W = cw_UseDefault then
  2327.     begin
  2328.       W := R.right - R.left;
  2329.       H := R.bottom - R.top;
  2330.     end;
  2331.   end;
  2332.   if not ClientWnd^.Create then
  2333.     Status := em_InvalidClient;
  2334.   TWindow.SetupWindow;
  2335. end;
  2336.  
  2337. { Specifies registration attributes for the MS-Windows window class of the
  2338.   TMDIWindow.  Sets the fields of the passed TWndClass parameter to the
  2339.   default attributes appropriate for a TMDIWindow. }
  2340.  
  2341. procedure TMDIWindow.GetWindowClass(var AWndClass: TWndClass);
  2342. begin
  2343.   TWindow.GetWindowClass(AWndClass);
  2344.   AWndClass.style := 0;
  2345. end;
  2346.  
  2347. { Specifies default processing for an incoming message.  Calls the
  2348.   MS-Windows default window procedure which is appropriate for a
  2349.   TMDIWindow.  Stores the result of the call in the Result field of
  2350.   the passed message record. }
  2351.  
  2352. procedure TMDIWindow.DefWndProc(var Msg: TMessage); assembler;
  2353. asm
  2354.     LES    DI,Self
  2355.     PUSH    ES:[DI].TMDIWindow.HWindow
  2356.     LES    DI,ES:[DI].TMDIWindow.ClientWnd
  2357.     MOV    AX,ES
  2358.     OR    AX,DI
  2359.     JE    @@1
  2360.     MOV    AX,ES:[DI].TMDIClient.HWindow
  2361. @@1:    PUSH    AX
  2362.     LES    DI,Msg
  2363.     PUSH    ES:[DI].TMessage.Message
  2364.     PUSH    ES:[DI].TMessage.WParam
  2365.     PUSH    ES:[DI].TMessage.LParamHi
  2366.     PUSH    ES:[DI].TMessage.LParamLo
  2367.     CALL    DefFrameProc
  2368.     LES    DI,Msg
  2369.     MOV    ES:[DI].TMessage.ResultLo,AX
  2370.     MOV    ES:[DI].TMessage.ResultHi,DX
  2371. end;
  2372.  
  2373. { Constructs a new MDI child window object.  By default, constructs an
  2374.   instance of TWindow as an MDI child window object.  Will almost always be
  2375.   redefined by descendants to construct an instance of a user-defined
  2376.   TWindow descendant as an MDI child window object. }
  2377.  
  2378. function TMDIWindow.InitChild: PWindowsObject;
  2379. begin
  2380.   InitChild := New(PWindow, Init(@Self, 'MDI Child'));
  2381. end;
  2382.  
  2383. { Creates a valid new MDI child window after calling Self.InitChild to
  2384.   construct a new MDI child window object. }
  2385.  
  2386. function TMDIWindow.CreateChild: PWindowsObject;
  2387. begin
  2388.   CreateChild := Application^.MakeWindow(InitChild);
  2389. end;
  2390.  
  2391. { Responds to an incoming "CreateChild" command (with a cm_CreateChild
  2392.   command identifier) by calling Self.CreateChild to construct and create
  2393.   a new MDI child. }
  2394.  
  2395. procedure TMDIWindow.CMCreateChild(var Msg: TMessage);
  2396. begin
  2397.   CreateChild;
  2398. end;
  2399.  
  2400. { Arranges iconized MDI child windows by calling the ArrangeIcons method
  2401.   of the MDI client window object. }
  2402.  
  2403. procedure TMDIWindow.ArrangeIcons;
  2404. begin
  2405.   ClientWnd^.ArrangeIcons;
  2406. end;
  2407.  
  2408. { Cascades the MDI child windows by calling the CascadeChildren method of
  2409.   the MDI client window object. }
  2410.  
  2411. procedure TMDIWindow.CascadeChildren;
  2412. begin
  2413.   ClientWnd^.CascadeChildren;
  2414. end;
  2415.  
  2416. { Tiles the MDI child windows by calling the TileChildren method of the
  2417.   MDI client window object. }
  2418.  
  2419. procedure TMDIWindow.TileChildren;
  2420. begin
  2421.   ClientWnd^.TileChildren;
  2422. end;
  2423.  
  2424. { Closes each MDI child, after calling the child's CanClose method to
  2425.   ensure that it is Ok to do so. }
  2426.  
  2427. procedure TMDIWindow.CloseChildren; 
  2428.  
  2429.   function CannotClose(P: PWindow): Boolean; far;
  2430.   begin
  2431.     if P^.IsFlagSet(wb_MDIChild) then
  2432.       CannotClose := not P^.CanClose
  2433.     else CannotClose := False;
  2434.   end;
  2435.  
  2436.   procedure CloseChild(P: PWindow); far;
  2437.   begin
  2438.     if P^.IsFlagSet(wb_MDIChild) then P^.Free;
  2439.   end;
  2440.  
  2441. begin
  2442.   if FirstThat(@CannotClose) = nil then ForEach(@CloseChild);
  2443. end;
  2444.  
  2445. { Responds to an incoming "Tile" command (with a cm_TileChildren command
  2446.   identifier) by calling Self.TileChildren to tile the MDI child
  2447.   windows. }
  2448.  
  2449. procedure TMDIWindow.CMTileChildren(var Msg: TMessage);
  2450. begin
  2451.   TileChildren;
  2452. end;
  2453.  
  2454. { Responds to an incoming "Cascade" command (with a cm_CascadeChildren
  2455.   command identifier) by calling Self.CascadeChildren to cascade the MDI
  2456.   child windows. }
  2457.  
  2458. procedure TMDIWindow.CMCascadeChildren(var Msg: TMessage);
  2459. begin
  2460.   CascadeChildren;
  2461. end;  
  2462.  
  2463. { Responds to an incoming "Arrange" command (with a cm_ArrangeIcons
  2464.   command identifier) by calling Self.ArrangeIcons to arrange the
  2465.   icons of the MDI child windows. }
  2466.  
  2467. procedure TMDIWindow.CMArrangeIcons(var Msg: TMessage);
  2468. begin
  2469.   ArrangeIcons;
  2470. end;  
  2471.  
  2472. { Responds to an incoming "CloseAll" command (with a cm_CloseChildren
  2473.   command identifier) by calling Self.CloseChildren to close the
  2474.   MDI child windows. }
  2475.  
  2476. procedure TMDIWindow.CMCloseChildren(var Msg: TMessage);
  2477. begin
  2478.   CloseChildren;
  2479. end;
  2480.  
  2481. { TMDIClient }
  2482.  
  2483. { Constructor for a TMDIClient.  Initializes the object with data from the
  2484.   passed TStream. }
  2485.  
  2486. constructor TMDIClient.Load(var S: TStream);
  2487. begin
  2488.   inherited Load(S);
  2489.   S.Read(ClientAttr, SizeOf(ClientAttr));
  2490.   Attr.Param := PChar(@ClientAttr);
  2491. end;
  2492.  
  2493. { Stores data of the TMDIClient in the passed TStream. }
  2494.  
  2495. procedure TMDIClient.Store(var S: TStream);
  2496. begin
  2497.   inherited Store(S);
  2498.   S.Write(ClientAttr, SizeOf(ClientAttr));
  2499. end;
  2500.  
  2501. { Constructor for a TMDIClient.  Initializes its data fields using passed
  2502.   parameter and default values.  The size is calculated so that a
  2503.   child window can be correctly created before the window is show.  If
  2504.   this is not done, the default size of the window would be zero. }
  2505.  
  2506. constructor TMDIClient.Init(AParent: PMDIWindow);
  2507. var
  2508.   SizeRect: TRect;
  2509. begin
  2510.   inherited Init(AParent, nil);
  2511.   Attr.Style := ws_Child or ws_Visible or ws_Group or ws_TabStop or
  2512.     ws_ClipChildren or ws_HScroll or ws_VScroll;
  2513.   Parent^.RemoveChild(@Self);
  2514.   ClientAttr.hWindowMenu := HMenu(0);
  2515.   ClientAttr.idFirstChild := id_FirstMDIChild;
  2516.   Attr.Param := PChar(@ClientAttr);
  2517. end;
  2518.  
  2519. { Returns the name of the MS-Windows window class for a TMDIClient. }
  2520.  
  2521. function TMDIClient.GetClassName: PChar;
  2522. begin
  2523.   GetClassName := 'MDIClient';
  2524. end;
  2525.  
  2526. { 'MDIClient' is supplied by MS Windows so return true }
  2527.  
  2528. function TMDIClient.Register: Boolean;
  2529. begin
  2530.   Register := True;
  2531. end;
  2532.  
  2533. { Arranges iconized MDI child windows. }
  2534.  
  2535. procedure TMDIClient.ArrangeIcons;
  2536. begin
  2537.   SendMessage(HWindow, wm_MDIIconArrange, 0, 0);
  2538. end;
  2539.  
  2540. { Cascades the MDI child windows. }
  2541.  
  2542. procedure TMDIClient.CascadeChildren;
  2543. begin
  2544.   SendMessage(HWindow, wm_MDICascade, 0, 0);
  2545. end;
  2546.  
  2547. { Tiles the MDI child windows. }
  2548.  
  2549. procedure TMDIClient.TileChildren;
  2550. begin
  2551.   SendMessage(HWindow, wm_MDITile, 0, 0);
  2552. end;
  2553.  
  2554. { Prevent a call to Paint since we are using a MS Windows supplied
  2555.   class }
  2556.  
  2557. procedure TMDIClient.WMPaint(var Msg: TMessage);
  2558. begin
  2559.   DefWndProc(Msg);
  2560. end;
  2561.  
  2562. { TScroller }
  2563.  
  2564. { Private. LongMulDiv multiplys the first two arguments and then
  2565.   divides by the third.  This is used so that real number
  2566.   (floating point) arithmetic is not necessary.  This routine saves
  2567.   the possible 64-bit value in a temp before doing the divide.  Does
  2568.   not do error checking like divide by zero.  Also assumes that the
  2569.   result is in the 32-bit range (Actually 31-bit, since this algorithm
  2570.   is for unsigned). }
  2571.  
  2572. function LongMulDiv(Mult1, Mult2, Div1: Longint): Longint; assembler;
  2573. type
  2574.   Quadword = record
  2575.     w0, w1, w2, w3: Word;
  2576.   end;
  2577. var
  2578.   Temp: Quadword;
  2579. asm
  2580. { Mul }
  2581.     MOV    DX,Mult1.Word[2]
  2582.     MOV    AX,Mult1.Word[0]
  2583.         MOV    CX,Mult2.Word[2]
  2584.     MOV    BX,Mult2.Word[0]
  2585.  
  2586.         MOV     DI,DX
  2587.         MOV     SI,AX
  2588.  
  2589.         MUL     BX
  2590.         MOV     Temp.w0,AX
  2591.         MOV     Temp.w1,DX
  2592.  
  2593.         MOV     AX,DI
  2594.         MUL     CX
  2595.         MOV     Temp.w2,AX
  2596.         MOV     Temp.w3,DX
  2597.  
  2598.         MOV     AX,DI
  2599.         MUL     BX
  2600.         ADD     Temp.w1,AX
  2601.         ADC     Temp.w2,DX
  2602.         ADC     Temp.w3,0
  2603.  
  2604.         MOV     AX,SI
  2605.         MUL     CX
  2606.         ADD     Temp.w1,AX
  2607.         ADC     Temp.w2,DX
  2608.         ADC     Temp.w3,0
  2609.  
  2610.     MOV    DX,Temp.w3
  2611.     MOV    SI,Temp.w2
  2612.     MOV    BX,Temp.w1
  2613.     MOV    AX,Temp.w0
  2614. { Adjust for rounding }
  2615.     MOV    CX,Div1.Word[2]
  2616.     MOV    DI,Div1.Word[0]
  2617.     SHR    CX,1
  2618.         RCR    DI,1
  2619.         ADD    AX,DI
  2620.     ADC    BX,CX
  2621.     ADC    SI,0
  2622.     ADC    DX,0
  2623. { Div }
  2624.         MOV     CX,32
  2625.         CLC
  2626.  
  2627. @1:    RCL     AX,1
  2628.         RCL     BX,1
  2629.         RCL     SI,1
  2630.         RCL     DX,1
  2631.         JNC     @3
  2632.  
  2633. @2:    SUB    SI,Div1.Word[0]
  2634.         SBB    DX,Div1.Word[2]
  2635.         STC
  2636.         LOOP    @1
  2637.         JMP     @5
  2638.  
  2639. @3:    CMP     DX,Div1.Word[2]
  2640.         JC      @4
  2641.         JNE     @2
  2642.         CMP     SI,Div1.Word[0]
  2643.         JNC     @2
  2644.  
  2645. @4:    CLC
  2646.         LOOP    @1
  2647.  
  2648. @5:    RCL     AX,1
  2649.         RCL     BX,1
  2650.  
  2651.         MOV     CX,SI
  2652.         MOV     DX,BX
  2653. end;
  2654.  
  2655. { Constructs a TScroller object, initializing its data fields to default
  2656.   values. }
  2657. constructor TScroller.Init(TheWindow: PWindow; TheXUnit, TheYUnit: Integer;
  2658.   TheXRange, TheYRange: LongInt);
  2659. begin
  2660.   TObject.Init;
  2661.   Window := TheWindow;
  2662.   XPos := 0;  YPos := 0;
  2663.   XUnit := TheXUnit;
  2664.   YUnit := TheYUnit;
  2665.   XRange := TheXRange;
  2666.   YRange := TheYRange;
  2667.   XLine := 1;  YLine := 1;
  2668.   XPage := 1;  YPage := 1;
  2669.   AutoMode := True; 
  2670.   TrackMode := True;
  2671.   AutoOrg := True;
  2672.   HasHScrollBar := (Window <> nil) and 
  2673.     ((Window^.Attr.Style and ws_HScroll) = ws_HScroll);
  2674.   HasVScrollBar := (Window <> nil) and
  2675.     ((Window^.Attr.Style and ws_VScroll) = ws_VScroll);
  2676. end;
  2677.  
  2678. { Constructs an instance of TScroller from the passed TStream. }
  2679.  
  2680. constructor TScroller.Load(var S: TStream);
  2681. begin
  2682.   TObject.Init;
  2683.   S.Read(XPos, SizeOf(XPos));
  2684.   S.Read(YPos, SizeOf(YPos));
  2685.   S.Read(XUnit, SizeOf(XUnit));
  2686.   S.Read(YUnit, SizeOf(YUnit));
  2687.   S.Read(XRange, SizeOf(XRange));
  2688.   S.Read(YRange, SizeOf(YRange));
  2689.   S.Read(XLine, SizeOf(XLine));
  2690.   S.Read(YLine, SizeOf(YLine));
  2691.   S.Read(XPage, SizeOf(XPage));
  2692.   S.Read(YPage, SizeOf(YPage));
  2693.   S.Read(AutoMode, SizeOf(AutoMode));
  2694.   S.Read(TrackMode, SizeOf(TrackMode));
  2695.   S.Read(AutoOrg, SizeOf(AutoOrg));
  2696.   S.Read(HasHScrollBar, SizeOf(HasHScrollBar));
  2697.   S.Read(HasVScrollBar, SizeOf(HasVScrollBar));
  2698. end;
  2699.  
  2700. { Destructs the scroller and resets the owning window's Scroller
  2701.   field to nil }
  2702.  
  2703. destructor TScroller.Done;
  2704. begin
  2705.   if (Window <> nil) and (Window^.Scroller = @Self) then
  2706.     Window^.Scroller := nil;
  2707.   TObject.Done;
  2708. end;
  2709.  
  2710. { Stores the TScroller in the passed TStream. }
  2711.  
  2712. procedure TScroller.Store(var S: TStream);
  2713. begin
  2714.   S.Write(XPos, SizeOf(XPos));
  2715.   S.Write(YPos, SizeOf(YPos));
  2716.   S.Write(XUnit, SizeOf(XUnit));
  2717.   S.Write(YUnit, SizeOf(YUnit));
  2718.   S.Write(XRange, SizeOf(XRange));
  2719.   S.Write(YRange, SizeOf(YRange));
  2720.   S.Write(XLine, SizeOf(XLine));
  2721.   S.Write(YLine, SizeOf(YLine));
  2722.   S.Write(XPage, SizeOf(XPage));
  2723.   S.Write(YPage, SizeOf(YPage));
  2724.   S.Write(AutoMode, SizeOf(AutoMode));
  2725.   S.Write(TrackMode, SizeOf(TrackMode));
  2726.   S.Write(AutoOrg, SizeOf(AutoOrg));
  2727.   S.Write(HasHScrollBar, SizeOf(HasHScrollBar));
  2728.   S.Write(HasVScrollBar, SizeOf(HasVScrollBar));
  2729. end;
  2730.  
  2731. { Private. Converts a horizontal range value from the scrollbar to
  2732.   a horizontal scroll value. }
  2733.  
  2734. function TScroller.XScrollValue(ARangeUnit: Longint): Integer;
  2735. begin
  2736.   XScrollValue := LongMulDiv(ARangeUnit, MaxInt, XRange);
  2737. end;
  2738.  
  2739. { Private. Converts a vertical range value from the scrollbar to a
  2740.   vertical scroll value. }
  2741.  
  2742. function TScroller.YScrollValue(ARangeUnit: Longint): Integer;
  2743. begin
  2744.   YScrollValue := LongMulDiv(ARangeUnit, MaxInt, YRange);
  2745. end;
  2746.  
  2747. { Private. Converts a horizontal scroll value from the scrollbar to
  2748.   a horizontal range value. }
  2749.  
  2750. function TScroller.XRangeValue(AScrollUnit: Integer): Longint;
  2751. begin
  2752.   XRangeValue := LongMulDiv(AScrollUnit, XRange, MaxInt);
  2753. end;
  2754.  
  2755. { Private. Converts a vertical scroll value from the scrollbar to a
  2756.   vertical range value. }
  2757.  
  2758. function TScroller.YRangeValue(AScrollUnit: Integer): Longint;
  2759. begin
  2760.   YRangeValue := LongMulDiv(AScrollUnit, YRange, MaxInt);
  2761. end;
  2762.  
  2763. { Sets the number of units per page (amount by which to scroll on a page
  2764.   scroll request) according to the current size of the Window's client
  2765.   area. }
  2766.  
  2767. procedure TScroller.SetPageSize;
  2768. var
  2769.   ClientRect: TRect;
  2770.   Width, Height: Integer;
  2771. begin
  2772.   if (Window <> nil) and (Window^.HWindow <> 0) then
  2773.   begin
  2774.     GetClientRect(Window^.HWindow, ClientRect);
  2775.     with ClientRect do
  2776.     begin
  2777.       Width := Right - Left;  Height := Bottom - Top;
  2778.       if (Width <> 0) and (Height <> 0) and (XUnit > 0) and (YUnit > 0) then
  2779.       begin
  2780.         XPage := ((Width+1) div XUnit) -1;
  2781.         YPage := ((Height+1) div YUnit) -1;
  2782.       end;
  2783.     end;
  2784.   end;
  2785. end;
  2786.  
  2787. { Sets the range of the TScroller and also sets the range of its Window's
  2788.   scrollbars. }
  2789.  
  2790. procedure TScroller.SetRange(TheXRange, TheYRange: LongInt);
  2791. begin
  2792.   XRange := TheXRange;
  2793.   YRange := TheYRange;
  2794.   SetSBarRange; 
  2795.   if HasHScrollBar then SetScrollPos(Window^.HWindow, sb_Horz, XPos, True);
  2796.   if HasVScrollBar then SetScrollPos(Window^.HWindow, sb_Vert, YPos, True);
  2797.   ScrollTo(LongMin(TheXRange, XPos), LongMin(TheYRange, YPos));
  2798. end;
  2799.  
  2800. { Resets the X and Y scroll unit size (in device units) to the passed
  2801.   parameters.  Calls SetPageSize to update the X and Y page size, which
  2802.   are specified in scroll units. }
  2803.  
  2804. procedure TScroller.SetUnits(TheXUnit, TheYUnit: LongInt);
  2805. begin
  2806.   XUnit := TheXUnit;
  2807.   YUnit := TheYUnit;
  2808.   SetPageSize; 
  2809. end;
  2810.  
  2811. { Sets the range of the Window's scrollbars. }
  2812.  
  2813. procedure TScroller.SetSBarRange;
  2814. begin
  2815.   if Window <> nil then
  2816.   begin
  2817.     if HasHScrollBar then SetScrollRange(Window^.HWindow, sb_Horz, 0,
  2818.       LongMax(0, LongMin(XRange, MaxInt)), False);
  2819.     if HasVScrollBar then SetScrollRange(Window^.HWindow, sb_Vert, 0,
  2820.       LongMax(0, LongMin(YRange, MaxInt)), False);
  2821.   end;
  2822. end;
  2823.  
  2824. { Sets the origin for the paint display context according to XPos, YPos. }
  2825.  
  2826. procedure TScroller.BeginView(PaintDC: HDC; var PaintInfo: TPaintStruct);
  2827. var
  2828.   XOrg, YOrg: LongInt;
  2829. begin
  2830.   XOrg := XPos * XUnit;
  2831.   YOrg := YPos * YUnit;
  2832.   if AutoOrg and (XOrg <= MaxInt) and (YOrg <= MaxInt) then
  2833.     SetViewPortOrg(PaintDC, -XOrg, -YOrg);
  2834. end;
  2835.  
  2836. { Updates the position of the Window's scrollbar(s). }
  2837.  
  2838. procedure TScroller.EndView;
  2839. var
  2840.   TempPos: Longint;
  2841. begin
  2842.   if Window <> nil then
  2843.   begin
  2844.     if HasHScrollBar then
  2845.     begin
  2846.       if (XRange > MaxInt) then
  2847.         TempPos := XScrollValue(XPos) else TempPos := XPos;
  2848.       if GetScrollPos(Window^.HWindow, sb_Horz) <> TempPos then
  2849.         SetScrollPos(Window^.HWindow, sb_Horz, TempPos, True);
  2850.     end;
  2851.     if HasVScrollBar then
  2852.     begin
  2853.       if (YRange > MaxInt) then
  2854.         TempPos := YScrollValue(YPos) else TempPos := YPos;
  2855.       if GetScrollPos(Window^.HWindow, sb_Vert) <> TempPos then
  2856.         SetScrollPos(Window^.HWindow, sb_Vert, TempPos, True);
  2857.     end;
  2858.   end;
  2859. end;
  2860.  
  2861. { Scrolls vertically according to scroll action and thumb position. }
  2862.  
  2863. procedure TScroller.VScroll(ScrollRequest: Word; ThumbPos: Integer);
  2864. begin
  2865.   case ScrollRequest of
  2866.     sb_LineDown: ScrollBy(0, YLine);
  2867.     sb_LineUp: ScrollBy(0, -YLine);
  2868.     sb_PageDown: ScrollBy(0, YPage);
  2869.     sb_PageUp: ScrollBy(0, -YPage);
  2870.     sb_ThumbPosition:
  2871.       if (YRange > MaxInt) then
  2872.     ScrollTo(XPos, YRangeValue(ThumbPos)) else ScrollTo(XPos, ThumbPos);
  2873.     sb_ThumbTrack:
  2874.       begin
  2875.     if TrackMode then
  2876.       if (YRange > MaxInt) then
  2877.             ScrollTo(XPos, YRangeValue(ThumbPos)) 
  2878.           else ScrollTo(XPos, ThumbPos);
  2879.     if ((Window <> nil) and HasVScrollBar) then
  2880.       SetScrollPos(Window^.HWindow, sb_Vert, ThumbPos, True);
  2881.       end;
  2882.   end;
  2883. end;
  2884.  
  2885. { Scrolls horizontally according to scroll action and thumb position. }
  2886.  
  2887. procedure TScroller.HScroll(ScrollRequest: Word; ThumbPos: Integer);
  2888. begin
  2889.   case ScrollRequest of
  2890.     sb_LineDown: ScrollBy(XLine, 0);
  2891.     sb_LineUp: ScrollBy(-XLine, 0);
  2892.     sb_PageDown: ScrollBy(XPage, 0);
  2893.     sb_PageUp: ScrollBy(-XPage, 0);
  2894.     sb_ThumbPosition:
  2895.       if (XRange > MaxInt) then
  2896.     ScrollTo(XRangeValue(ThumbPos), YPos) else ScrollTo(ThumbPos, YPos);
  2897.     sb_ThumbTrack:
  2898.       begin
  2899.     if TrackMode then
  2900.           if (XRange > MaxInt) then
  2901.         ScrollTo(XRangeValue(ThumbPos), YPos)
  2902.           else ScrollTo(ThumbPos, YPos);
  2903.     if ((Window <> nil) and HasHScrollBar) then
  2904.             SetScrollPos(Window^.HWindow, sb_Horz, ThumbPos, True);
  2905.       end;
  2906.   end;
  2907. end;
  2908.  
  2909. { Scrolls to an (X,Y) position, after checking boundary conditions.  Causes
  2910.   a WMPaint message to be sent.  First scrolls the contents of the client
  2911.   area, if a portion of the client area will remain visible. }
  2912.  
  2913. procedure TScroller.ScrollTo(X, Y: LongInt);
  2914. var
  2915.   NewXPos, NewYPos: LongInt;
  2916. begin
  2917.   if Window <> nil then
  2918.   begin
  2919.     NewXPos := LongMax(0, LongMin(X, XRange));
  2920.     NewYPos := LongMax(0, LongMin(Y, YRange));
  2921.     if (NewXPos <> XPos) or (NewYPos <> YPos) then
  2922.     begin
  2923.       if AutoOrg or (Abs(YPos - NewYPos) < YPage) and 
  2924.           (Abs(XPos - NewXPos) < XPage) then
  2925.         ScrollWindow(Window^.HWindow,
  2926.           (XPos - NewXPos) * XUnit, (YPos - NewYPos) * YUnit, nil, nil)
  2927.       else
  2928.         InvalidateRect(Window^.HWindow, nil, True);
  2929.       XPos := NewXPos;
  2930.       YPos := NewYPos;
  2931.       UpdateWindow(Window^.HWindow);
  2932.     end;
  2933.   end;
  2934. end;
  2935.  
  2936. { Scrolls to a position calculated using the passed "Delta" values. }
  2937.  
  2938. procedure TScroller.ScrollBy(Dx, Dy: LongInt);
  2939. begin
  2940.   ScrollTo(XPos + Dx, YPos + Dy);
  2941. end;
  2942.  
  2943. { Performs "auto-scrolling".  (Dragging the mouse from within the client
  2944.   area of the Window to without results in auto-scrolling when the AutoMode
  2945.   data field of the Scroller is True). }
  2946.  
  2947. procedure TScroller.AutoScroll;
  2948. var
  2949.   CursorPos: TPoint;
  2950.   ClientRect: TRect;
  2951.   Dx, Dy: LongInt;
  2952. begin
  2953.   if (AutoMode and (Window <> nil)) then
  2954.   begin
  2955.     GetCursorPos(CursorPos);
  2956.     ScreenToClient(Window^.HWindow, CursorPos);
  2957.     GetClientRect(Window^.HWindow, ClientRect);
  2958.     Dx := 0; Dy := 0;
  2959.     if CursorPos.Y < 0 then
  2960.       Dy := LongMin(-YLine, LongMax(-YPage, (CursorPos.Y div 10) * YLine))
  2961.     else
  2962.       if CursorPos.Y > ClientRect.Bottom then
  2963.     Dy := LongMax(YLine, LongMin(YPage, ((CursorPos.Y - ClientRect.Bottom) div 10) * YLine));
  2964.     if CursorPos.X < 0 then
  2965.       Dx := LongMin(-XLine, LongMax(-XPage, (CursorPos.X div 10) * XLine))
  2966.     else
  2967.       if CursorPos.X > ClientRect.Right then
  2968.     Dx := LongMax(XLine, LongMin(XPage, ((CursorPos.X - ClientRect.Right) div 10) * XLine));
  2969.     ScrollBy(Dx, Dy);
  2970.   end;
  2971. end;
  2972.  
  2973. { Returns a Boolean value indicating whether or not the passed area
  2974.   (in units) is currently visible. }
  2975.  
  2976. function TScroller.IsVisibleRect(X, Y: LongInt; XExt, YExt: Integer): Boolean;
  2977. begin
  2978.   IsVisibleRect := (X + XExt >= XPos) and (Y + YExt >= YPos)
  2979.     and (X < XPos + XPage) and (Y < YPos + YPage);
  2980. end;
  2981.  
  2982. { TApplication }
  2983.  
  2984. { Constructor for a TApplication object.  Sets the global Application
  2985.   variable to point to Self. Initializes instances, creating and
  2986.   displaying their main window (calls InitApplication for the first
  2987.   executing instance; calls InitInstance for all instances).}
  2988.  
  2989. constructor TApplication.Init(AName: PChar);
  2990. begin
  2991.   TObject.Init;
  2992.   Name := AName;
  2993.   Application := @Self;
  2994.   HAccTable := 0;
  2995.   Status := 0;
  2996.   MainWindow := nil;
  2997.   KBHandlerWnd := nil;
  2998.   StdWndProcInstance := MakeProcInstance(@StdWndProc, HInstance);
  2999.   InitMemory;
  3000.   if HPrevInst = 0 then InitApplication;
  3001.   if (Status = 0) then InitInstance;
  3002. end;
  3003.  
  3004. destructor TApplication.Done;
  3005. begin
  3006.   FreeProcInstance(StdWndProcInstance);
  3007.   TObject.Done;
  3008. end;
  3009.  
  3010. { A place to perform any actions required outside of the message loop.
  3011.   Should return true if the it is desired that the IdleAction be called
  3012.   again, else return false.  It will always be called at least once
  3013.   when the application goes idle. }
  3014.  
  3015. function TApplication.IdleAction: Boolean;
  3016. begin
  3017.   IdleAction := False;
  3018. end;
  3019.  
  3020. { Handles initialization for the first executing instance of the OW
  3021.   application. }
  3022.  
  3023. procedure TApplication.InitApplication;
  3024. begin
  3025. end;
  3026.  
  3027. { Handles initialization for each executing instance of the OW
  3028.   application.  Creates and displays the main window. }
  3029.  
  3030. procedure TApplication.InitInstance;
  3031. begin
  3032.   InitMainWindow;
  3033.   MainWindow := MakeWindow(MainWindow);
  3034.   if MainWindow <> nil then
  3035.     MainWindow^.Show(CmdShow)
  3036.   else Status := em_InvalidMainWindow;
  3037. end;
  3038.  
  3039. { Initializes the application's MainWindow object. }
  3040.  
  3041. procedure TApplication.InitMainWindow;
  3042. begin
  3043.   MainWindow := new(PWindow, Init(nil, nil));
  3044. end;
  3045.  
  3046. { Runs the application.  Enters message loop if initialization was
  3047.   successful. }
  3048.  
  3049. procedure TApplication.Run;
  3050. begin
  3051.   if (Status = 0) then MessageLoop
  3052.   else Error(Status);
  3053. end;
  3054.  
  3055. { Activates and deactivates "keyboard handling" (translation of keyboard
  3056.   input into control selections) for the currently active TWindowsObject.
  3057.   by setting the KBHandlerWnd to the parameter passed. This method
  3058.   is called internally by the OW whenever a OW window is activated.  If
  3059.   "keyboard handling" has been requested for the TWindowsObject, the
  3060.   parameter passed is non-nil, else nil is passed.  "Keyboard handling" is
  3061.   requested, by default, for all modeless dialogs and may be requested for
  3062.   a TWindow via a call to its EnableKBHandler method.}
  3063.  
  3064. procedure TApplication.SetKBHandler(AWindowsObject: PWindowsObject);
  3065. begin
  3066.   KBHandlerWnd := AWindowsObject;
  3067. end;
  3068.  
  3069. { General message loop.  Retrieves and processes a message from the OW
  3070.   application's message queue.  Calls ProcessAppMsg to allow special
  3071.   handling of the message.  If not specially handled, performs default
  3072.   processing of the message, dispatching the message to the TWindowsObject's
  3073.   window procedure).  All unusual processing can be accomplished by
  3074.   redefining ProcessAppMsg or any of the Process... methods. }
  3075.  
  3076. procedure TApplication.MessageLoop;
  3077. var
  3078.   Message: TMsg;
  3079.   IsDone: Boolean;
  3080. begin
  3081.   IsDone := False;
  3082.   repeat
  3083.     if PeekMessage(Message, 0, 0, 0, pm_Remove) then
  3084.     begin
  3085.       if Message.Message = wm_Quit then IsDone := True
  3086.       else
  3087.         if not ProcessAppMsg(Message) then
  3088.         begin
  3089.           TranslateMessage(Message);
  3090.           DispatchMessage(Message);
  3091.         end
  3092.     end
  3093.     else
  3094.       if not IdleAction then
  3095.         WaitMessage;
  3096.   until IsDone;
  3097.   Status := Message.WParam;
  3098. end;
  3099.  
  3100. { Performs special handling for the message last retrieved.  Translates
  3101.   keyboard input messages into control selections or command messages,
  3102.   when appropriate.  Dispatches message, if translated. }
  3103.  
  3104. function TApplication.ProcessAppMsg(var Message: TMsg): Boolean;
  3105. begin
  3106.   ProcessAppMsg :=
  3107.     ProcessDlgMsg(Message) or
  3108.     ProcessMDIAccels(Message) or
  3109.     ProcessAccels(Message);
  3110. end;
  3111.  
  3112. { Attempts to translate a message into a control selection if the currently
  3113.   active OW window has requested "keyboard handling".  (Some keyboard
  3114.   input messages are translated into control selection messages).
  3115.   Dispatches message, if translated. }
  3116.  
  3117. function TApplication.ProcessDlgMsg(var Message: TMsg): Boolean;
  3118. begin
  3119.   ProcessDlgMsg := False;
  3120.   if (KBHandlerWnd <> nil) and (KBHandlerWnd^.HWindow <> 0) then
  3121.     ProcessDlgMsg := IsDialogMessage(KBHandlerWnd^.HWindow,
  3122.       Message);
  3123. end;
  3124.  
  3125. { Attempts to translate a message into a command message if the TApplication
  3126.   has loaded an accelerator table. (Keyboard input messages for which an
  3127.   entry exists in the accelerator table are translated into command
  3128.   messages.)  Dispatches message, if translated.  (Translation of MDI
  3129.   accelerator messages is performed in ProcessMDIAccels method.)  }
  3130.  
  3131. function TApplication.ProcessAccels(var Message: TMsg): Boolean;
  3132. begin
  3133.   ProcessAccels := (HAccTable <> 0) and
  3134.     (TranslateAccelerator(MainWindow^.HWindow, HAccTable, Message) <> 0);
  3135. end;
  3136.  
  3137. { Attempts to translate a message into a system command message for MDI
  3138.   TApplications (whose main window is a TMDIWindow). (Some keyboard
  3139.   input messages are translated into system commands for MDI applications).
  3140.   Dispatches message, if translated. }
  3141.  
  3142. function TApplication.ProcessMDIAccels(var Message: TMsg): Boolean;
  3143. var
  3144.   MDIClient: PWindowsObject;
  3145. begin
  3146.   MDIClient := MainWindow^.GetClient;
  3147.   ProcessMDIAccels := (MDIClient <> nil) and
  3148.     TranslateMDISysAccel(MDIClient^.HWindow, Message);
  3149. end;
  3150.  
  3151. { Determines whether or not the passed TWindowsObject can be considered
  3152.   valid.  Returns a pointer to the TWindowsObject if valid.  If invalid,
  3153.   calls Error and disposes of the TWindowsObject, returning  nil.  A
  3154.   TWindowsObject is considered invalid if a low memory condition exists or
  3155.   if the TWindowsObject has a non-zero status. }
  3156.  
  3157. function TApplication.ValidWindow(AWindowsObject: PWindowsObject): PWindowsObject;
  3158. begin
  3159.   ValidWindow := nil;
  3160.   if AWindowsObject <> nil then
  3161.   begin
  3162.     if LowMemory then
  3163.     begin
  3164.       Error(em_OutOfMemory);
  3165.       Dispose(AWindowsObject, Done);
  3166.       RestoreMemory;
  3167.     end
  3168.     else if AWindowsObject^.Status <> 0 then
  3169.     begin
  3170.       Error(AWindowsObject^.Status);
  3171.       Dispose(AWindowsObject, Done);
  3172.     end else ValidWindow := AWindowsObject;
  3173.   end;
  3174. end;
  3175.  
  3176. { Attempts to associate an interface element with the TWindowsObject, if
  3177.   the object is valid.  Calls ValidWindow and the Create method of the
  3178.   TWindowsObject.  If either call returns an error, calls Error and
  3179.   disposes of the TWindowsObject, returning a nil pointer. }
  3180.  
  3181. function TApplication.MakeWindow(AWindowsObject: PWindowsObject): PWindowsObject;
  3182. begin
  3183.   MakeWindow := nil;
  3184.   if (AWindowsObject <> nil) and (ValidWindow(AWindowsObject) <> nil) then
  3185.     if not AWindowsObject^.Create then
  3186.     begin
  3187.       Error(AWindowsObject^.Status);
  3188.       Dispose(AWindowsObject, Done);
  3189.     end
  3190.     else MakeWindow := AWindowsObject;
  3191. end;
  3192.  
  3193. { Attempts to execute the passed TDialog, if the TDialog is valid.
  3194.   If valid (determined by call to TDialog.ValidWindow) returns True,
  3195.   calls Execute, and disposes of the TDialog.  Calls Error if Execute
  3196.   returns an error.  Returns the result of the call to Execute 
  3197.   (or id_Cancel if not called). }
  3198.  
  3199. function TApplication.ExecDialog(ADialog: PWindowsObject): Integer;
  3200. var
  3201.   ReturnValue: Integer;
  3202. begin
  3203.   ExecDialog := id_Cancel;
  3204.   if ValidWindow(ADialog) <> nil then
  3205.   begin
  3206.     ReturnValue := PDialog(ADialog)^.Execute;
  3207.     if ReturnValue < 0 then
  3208.       Error(ReturnValue)
  3209.     else
  3210.       ExecDialog := ReturnValue;
  3211.     Dispose(ADialog, Done);
  3212.   end;
  3213. end;
  3214.  
  3215. { Placeholder; may be redefined to process errors consistantly
  3216.   throughout the application. }
  3217.  
  3218. procedure TApplication.Error(ErrorCode: Integer);
  3219. var
  3220.   ErrorString: array[0..31] of Char;
  3221. begin
  3222.   WVSPrintF(ErrorString, 'Error code = %d. Continue?', ErrorCode);
  3223.   if MessageBox(0, ErrorString, 'Application Error',
  3224.       mb_IconStop + mb_YesNo) = id_No then
  3225.     Halt(ErrorCode);
  3226. end;
  3227.  
  3228. { Determines whether the application can be closed, returning a Boolean
  3229.   indicator.  The default behavior specified here is to return the result
  3230.   of a call to the CanClose method of the TApplication's MainWindow. }
  3231.  
  3232. function TApplication.CanClose: Boolean;
  3233. begin
  3234.   CanClose := MainWindow^.CanClose;
  3235. end;
  3236.  
  3237. { Objects registration procedure }
  3238.  
  3239. { Provided for OW 1.0 compatibility }
  3240.  
  3241. procedure RegisterWObjects;
  3242. begin
  3243.   RegisterType(RCollection);
  3244.   RegisterType(RStringCollection);
  3245.   RegisterType(RStrCollection);
  3246.   RegisterType(RWindowsObject);
  3247.   RegisterType(RWindow);
  3248.   RegisterType(RDialog);
  3249.   RegisterType(RDlgWindow);
  3250.   RegisterType(RControl);
  3251.   RegisterType(RMDIWindow);
  3252.   RegisterType(RMDIClient);
  3253.   RegisterType(RButton);
  3254.   RegisterType(RCheckBox);
  3255.   RegisterType(RRadioButton);
  3256.   RegisterType(RGroupBox);
  3257.   RegisterType(RListBox);
  3258.   RegisterType(RComboBox);
  3259.   RegisterType(RScrollBar);
  3260.   RegisterType(RStatic);
  3261.   RegisterType(REdit);
  3262.   RegisterType(RScroller);
  3263. end;
  3264.  
  3265. procedure RegisterOWindows;
  3266. begin
  3267.   RegisterType(RWindow);
  3268.   RegisterType(RMDIWindow);
  3269.   RegisterType(RMDIClient);
  3270.   RegisterType(RScroller);
  3271. end;
  3272.  
  3273. end.
  3274.