home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sp15demo.zip / libsrc.zip / LIBSRC / OBJECTPM.PAS < prev    next >
Pascal/Delphi Source File  |  1996-02-10  |  100KB  |  3,106 lines
  1. UNIT ObjectPM;
  2.  
  3. {**************************************************************************
  4.  *                                                                        *
  5.  *    General definitions for Object-PM                                   *
  6.  *    (C) 1993,94 SpeedSoft                                               *
  7.  *                                                                        *
  8.  *    Last modified: 4.8.1995                                             *
  9.  *                                                                        *
  10.  **************************************************************************}
  11.  
  12. {$R-,S-}
  13.  
  14. INTERFACE
  15.  
  16. USES PMWin,PMHelp,PmStdDlg,PmDev,PmGpi,Os2Def;
  17.  
  18. TYPE
  19.     { TObject base object }
  20.     POPMLObject = ^TOPMLObject;
  21.     TOPMLObject = OBJECT
  22.                    CONSTRUCTOR Init;
  23.                    PROCEDURE Free;
  24.                    DESTRUCTOR Done;VIRTUAL;
  25.               END;
  26.  
  27. PROCEDURE Abstract;
  28. FUNCTION NewStr(S:STRING):PString;
  29. PROCEDURE DisposeStr(ps:PString);
  30.  
  31. CONST
  32.      {General Notification Message constants}
  33.      WM_FIRST    = WM_NULL;          {General Window messages starting at 0}
  34.      WM_LAST     = WM_SPEED_USER-1;  {Last PM window message at $1002}
  35.      WM_USERLAST = $2FFF;            {Last user defined window message}
  36.      CM_FIRST    = $3000;            {Start of internal command messages}
  37.      CM_LAST     = $3FFF;            {Last internal command messages}
  38.      CM_USER     = $4000;            {Start of user defined command messages}
  39.      CM_USERLAST = $4FFF;            {Last user defined command message}
  40.  
  41. CONST
  42.      {Common command constants}
  43.      CM_TILE         =0;
  44.      CM_CASCADE      =1;
  45.      CM_CLOSE        =2;
  46.      CM_CLOSEALL     =3;
  47.      CM_NEXT         =4;
  48.      CM_OPEN         =5;
  49.      CM_SAVEAS       =6;
  50.      CM_NEW          =7;
  51.      CM_SAVE         =8;
  52.      CM_SAVEALL      =9;
  53.      CM_ABOUT        =10;
  54.      CM_QUIT         =11;
  55.      CM_FILE         =12;
  56.      CM_EDIT         =13;
  57.      CM_SEARCH       =14;
  58.      CM_WINDOW       =15;
  59.      CM_HELP         =16;
  60.      CM_DEBUG        =17;
  61.      CM_OPTIONS      =18;
  62.      CM_LIST         =19;
  63.      CM_HELPONHELP   =20;
  64.      CM_EXTENDEDHELP =21;
  65.      CM_KEYSHELP     =22;
  66.      CM_HELPINDEX    =23;
  67.      CM_HELPCONTENTS =24;
  68.      CM_FIND         =25;
  69.      CM_REPLACE      =26;
  70.      CM_GOTO         =27;
  71.      CM_SEARCHAGAIN  =28;
  72.      CM_CUT          =29;
  73.      CM_COPY         =30;
  74.      CM_PASTE        =31;
  75.      CM_UNDO         =32;
  76.      CM_REDO         =33;
  77.      CM_CONTEXTHELP  =34;
  78.      CM_PREVIOUS     =35;
  79.      CM_OK           =36;
  80.      CM_CANCEL       =37;
  81.  
  82. CONST
  83.      {Window data values}
  84.      QWL_SELF       =0;   {Points to SELF (LONGWORD)}
  85.  
  86. CONST
  87.      {Constants for Maximizing window. Set Attr.w or Attr.h
  88.      to this values for maximizing}
  89.      Width_Max      = 65535;
  90.      Height_Max     = 65535;
  91.  
  92. CONST
  93.      {Absolute positions of methods in the VMT}
  94.      TWindowsObject_HandleEvent    :WORD      = 5;       {_VMT_}
  95.      TWindowsObject_DefWndProc     :WORD      = 6;
  96.      TWindowsObject_FrameWndProc   :WORD      = 7;
  97.      TWindowsObject_FrameDefProc   :WORD      = 8;
  98.  
  99. CONST
  100.      {Flags for TWindowsObject}
  101.      WF_AUTOFILL         = 1;   {Auto fill background}
  102.      WF_AUTOCREATE       = 2;   {Automatically create Window}
  103.      WF_ISDESKTOP        = 4;   {Window is a desktop window (internally created)}
  104.      WF_ISMAINWINDOW     = 8;   {Window is main application window}
  105.      WF_TILEONSIZE       = 16;  {Tile child windows on size}
  106.      WF_WITHDESKTOP      = 32;  {Force desktop creation}
  107.      WF_DELETEDOUBLESCAN = 64;  {double scan events to repeat count}
  108.      WF_DELETEDOUBLECHAR = 128; {double char events to repeat count}
  109.      WF_SCALECHILDS      = 256; {Scale Childs at WMSIZE}
  110.  
  111.      {Run Error codes}
  112.      RF_NOMAINWINDOW    = 1;  {No main window defined or failed to create it}
  113.      RF_NODESKTOPWINDOW = 2;  {No Desktop window defined or failed to create it}
  114.  
  115. CONST
  116.      kbVK               = 256;
  117.      kb_Alt             = 512;
  118.      kb_Ctrl            = 1024;
  119.      kb_Shift           = 2048;
  120.  
  121.      {Keyboardcodes}
  122.      kbF1               = kbVK + VK_F1;
  123.      kbF2               = kbVK + VK_F2;
  124.      kbF3               = kbVK + VK_F3;
  125.      kbF4               = kbVK + VK_F4;
  126.      kbF5               = kbVK + VK_F5;
  127.      kbF6               = kbVK + VK_F6;
  128.      kbF7               = kbVK + VK_F7;
  129.      kbF8               = kbVK + VK_F8;
  130.      kbF9               = kbVK + VK_F9;
  131.      kbF10              = kbVK + VK_F10;
  132.      kbF11              = kbVK + VK_F11;
  133.      kbF12              = kbVK + VK_F12;
  134.      kbCLeft            = kbVK + VK_LEFT;
  135.      kbCRight           = kbVK + VK_RIGHT;
  136.      kbCUp              = kbVK + VK_UP;
  137.      kbCDown            = kbVK + VK_DOWN;
  138.      kbDel              = kbVK + VK_DELETE;
  139.      kbInsert           = kbVK + VK_INSERT;
  140.      kbEnd              = kbVK + VK_END;
  141.      kbPos1             = kbVK + VK_HOME;
  142.      kbPageDown         = kbVK + VK_PAGEDOWN;
  143.      kbPageUp           = kbVK + VK_PAGEUP;
  144.      kbBS               = kbVK + VK_BACKSPACE;
  145.      kbCR               = kbVK + VK_NEWLINE;
  146.      kbESC              = kbVK + VK_ESC;
  147.      kbTab              = kbVK + VK_TAB;
  148.      kbCapsLock         = kbVK + VK_CAPSLOCK;
  149.      kbNumLock          = kbVK + VK_NUMLOCK;
  150.      kbScrollLock       = kbVK + VK_SCRLLOCK;
  151.      kbSpace            = kbVK + VK_SPACE;
  152.      kbBreak            = kbVK + VK_BREAK;
  153.      kbBackTab          = kbVK + VK_BACKTAB;
  154.      kbAltGraf          = kbVK + VK_ALTGRAF;
  155.      kbPause            = kbVK + VK_PAUSE;
  156.      kbPrintScrn        = kbVK + VK_PRINTSCRN;
  157.      kbEnter            = kbVK + VK_ENTER;
  158.      kbSysRq            = kbVK + VK_SYSRQ;
  159.      kbAlt              = kbVK + VK_ALT + kb_Alt;
  160.      kbCtrl             = kbVK + VK_CTRL + kb_Ctrl;
  161.      kbShift            = kbVK + VK_SHIFT + kb_Shift;
  162.  
  163.      {Shift Codes are basic codes + kb_Shift}
  164.      kbShiftF1          = kb_Shift + kbF1;
  165.      kbShiftF2          = kb_Shift + kbF2;
  166.      kbShiftF3          = kb_Shift + kbF3;
  167.      kbShiftF4          = kb_Shift + kbF4;
  168.      kbShiftF5          = kb_Shift + kbF5;
  169.      kbShiftF6          = kb_Shift + kbF6;
  170.      kbShiftF7          = kb_Shift + kbF7;
  171.      kbShiftF8          = kb_Shift + kbF8;
  172.      kbShiftF9          = kb_Shift + kbF9;
  173.      kbShiftF10         = kb_Shift + kbF10;
  174.      kbShiftCLeft       = kb_Shift + kbCLeft;
  175.      kbShiftCRight      = kb_Shift + kbCRight;
  176.      kbShiftCUp         = kb_Shift + kbCUp;
  177.      kbShiftCDown       = kb_Shift + kbCDown;
  178.      kbShiftDel         = kb_Shift + kbDel;
  179.      kbShiftInsert      = kb_Shift + kbInsert;
  180.      kbShiftEnd         = kb_Shift + kbEnd;
  181.      kbShiftPos1        = kb_Shift + kbPos1;
  182.      kbShiftPageDown    = kb_Shift + kbPageDown;
  183.      kbShiftPageUp      = kb_Shift + kbPageUp;
  184.      kbShiftBS          = kb_Shift + kbBS;
  185.      kbShiftCR          = kb_Shift + kbCR;
  186.  
  187.      {Alt Codes are basic codes + kb_Alt}
  188.      kbAlt0             = kb_Alt + 48;
  189.      kbAlt1             = kb_Alt + 49;
  190.      kbAlt2             = kb_Alt + 50;
  191.      kbAlt3             = kb_Alt + 51;
  192.      kbAlt4             = kb_Alt + 52;
  193.      kbAlt5             = kb_Alt + 53;
  194.      kbAlt6             = kb_Alt + 54;
  195.      kbAlt7             = kb_Alt + 55;
  196.      kbAlt8             = kb_Alt + 56;
  197.      kbAlt9             = kb_Alt + 57;
  198.      kbAltA             = kb_Alt + 65;
  199.      kbAltB             = kb_Alt + 66;
  200.      kbAltC             = kb_Alt + 67;
  201.      kbAltD             = kb_Alt + 68;
  202.      kbAltE             = kb_Alt + 69;
  203.      kbAltF             = kb_Alt + 70;
  204.      kbAltG             = kb_Alt + 71;
  205.      kbAltH             = kb_Alt + 72;
  206.      kbAltI             = kb_Alt + 73;
  207.      kbAltJ             = kb_Alt + 74;
  208.      kbAltK             = kb_Alt + 75;
  209.      kbAltL             = kb_Alt + 76;
  210.      kbAltM             = kb_Alt + 77;
  211.      kbAltN             = kb_Alt + 78;
  212.      kbAltO             = kb_Alt + 79;
  213.      kbAltP             = kb_Alt + 80;
  214.      kbAltQ             = kb_Alt + 81;
  215.      kbAltR             = kb_Alt + 82;
  216.      kbAltS             = kb_Alt + 83;
  217.      kbAltT             = kb_Alt + 84;
  218.      kbAltU             = kb_Alt + 85;
  219.      kbAltV             = kb_Alt + 86;
  220.      kbAltW             = kb_Alt + 87;
  221.      kbAltX             = kb_Alt + 88;
  222.      kbAltY             = kb_Alt + 89;
  223.      kbAltZ             = kb_Alt + 90;
  224.      kbAltF1            = kb_Alt + kbF1;
  225.      kbAltF2            = kb_Alt + kbF2;
  226.      kbAltF3            = kb_Alt + kbF3;
  227.      kbAltF4            = kb_Alt + kbF4;
  228.      kbAltF5            = kb_Alt + kbF5;
  229.      kbAltF6            = kb_Alt + kbF6;
  230.      kbAltF7            = kb_Alt + kbF7;
  231.      kbAltF8            = kb_Alt + kbF8;
  232.      kbAltF9            = kb_Alt + kbF9;
  233.      kbAltF10           = kb_Alt + kbF10;
  234.      kbAltCLeft         = kb_Alt + kbCLeft;
  235.      kbAltCRight        = kb_Alt + kbCRight;
  236.      kbAltCUp           = kb_Alt + kbCUp;
  237.      kbAltCDown         = kb_Alt + kbCDown;
  238.      kbAltDel           = kb_Alt + kbDel;
  239.      kbAltInsert        = kb_Alt + kbInsert;
  240.      kbAltEnd           = kb_Alt + kbEnd;
  241.      kbAltPos1          = kb_Alt + kbPos1;
  242.      kbAltPageDown      = kb_Alt + kbPageDown;
  243.      kbAltPageUp        = kb_Alt + kbPageUp;
  244.      kbAltBS            = kb_Alt + kbBS;
  245.      kbAltCR            = kb_Alt + kbCR;
  246.  
  247.      {Ctrl codes are basic codes + kbCtrl}
  248.      kbCtrl0            = kb_Ctrl + 48;
  249.      kbCtrl1            = kb_Ctrl + 49;
  250.      kbCtrl2            = kb_Ctrl + 50;
  251.      kbCtrl3            = kb_Ctrl + 51;
  252.      kbCtrl4            = kb_Ctrl + 52;
  253.      kbCtrl5            = kb_Ctrl + 53;
  254.      kbCtrl6            = kb_Ctrl + 54;
  255.      kbCtrl7            = kb_Ctrl + 55;
  256.      kbCtrl8            = kb_Ctrl + 56;
  257.      kbCtrl9            = kb_Ctrl + 57;
  258.      kbCtrlA            = kb_Ctrl + 65;
  259.      kbCtrlB            = kb_Ctrl + 66;
  260.      kbCtrlC            = kb_Ctrl + 67;
  261.      kbCtrlD            = kb_Ctrl + 68;
  262.      kbCtrlE            = kb_Ctrl + 69;
  263.      kbCtrlF            = kb_Ctrl + 70;
  264.      kbCtrlG            = kb_Ctrl + 71;
  265.      kbCtrlH            = kb_Ctrl + 72;
  266.      kbCtrlI            = kb_Ctrl + 73;
  267.      kbCtrlJ            = kb_Ctrl + 74;
  268.      kbCtrlK            = kb_Ctrl + 75;
  269.      kbCtrlL            = kb_Ctrl + 76;
  270.      kbCtrlM            = kb_Ctrl + 77;
  271.      kbCtrlN            = kb_Ctrl + 78;
  272.      kbCtrlO            = kb_Ctrl + 79;
  273.      kbCtrlP            = kb_Ctrl + 80;
  274.      kbCtrlQ            = kb_Ctrl + 81;
  275.      kbCtrlR            = kb_Ctrl + 82;
  276.      kbCtrlS            = kb_Ctrl + 83;
  277.      kbCtrlT            = kb_Ctrl + 84;
  278.      kbCtrlU            = kb_Ctrl + 85;
  279.      kbCtrlV            = kb_Ctrl + 86;
  280.      kbCtrlW            = kb_Ctrl + 87;
  281.      kbCtrlX            = kb_Ctrl + 88;
  282.      kbCtrlY            = kb_Ctrl + 89;
  283.      kbCtrlZ            = kb_Ctrl + 90;
  284.      kbCtrlF1           = kb_Ctrl + kbF1;
  285.      kbCtrlF2           = kb_Ctrl + kbF2;
  286.      kbCtrlF3           = kb_Ctrl + kbF3;
  287.      kbCtrlF4           = kb_Ctrl + kbF4;
  288.      kbCtrlF5           = kb_Ctrl + kbF5;
  289.      kbCtrlF6           = kb_Ctrl + kbF6;
  290.      kbCtrlF7           = kb_Ctrl + kbF7;
  291.      kbCtrlF8           = kb_Ctrl + kbF8;
  292.      kbCtrlF9           = kb_Ctrl + kbF9;
  293.      kbCtrlF10          = kb_Ctrl + kbF10;
  294.      kbCtrlCLeft        = kb_Ctrl + kbCLeft;
  295.      kbCtrlCRight       = kb_Ctrl + kbCRight;
  296.      kbCtrlCUp          = kb_Ctrl + kbCUp;
  297.      kbCtrlCDown        = kb_Ctrl + kbCDown;
  298.      kbCtrlDel          = kb_Ctrl + kbDel;
  299.      kbCtrlInsert       = kb_Ctrl + kbInsert;
  300.      kbCtrlEnd          = kb_Ctrl + kbEnd;
  301.      kbCtrlPos1         = kb_Ctrl + kbPos1;
  302.      kbCtrlPageDown     = kb_Ctrl + kbPageDown;
  303.      kbCtrlPageUp       = kb_Ctrl + kbPageUp;
  304.      kbCtrlBS           = kb_Ctrl + kbBS;
  305.      kbCtrlCR           = kb_Ctrl + kbCR;
  306.  
  307. VAR
  308.    {Anchor block handle}
  309.    HInstance:HAB;
  310.    ScalX : Extended;
  311.    ScalY : Extended;
  312.  
  313. TYPE
  314.   {Window class record used in GetWindowClass}
  315.   TWndClass=RECORD
  316.                   ClassName:STRING;
  317.                   ClassNameUlong:LONGWORD;
  318.                   ClassStyle:LONGWORD;
  319.                   ClassWndProc:FUNCTION(Win:HWND;msg:LONGWORD;
  320.                                         para1,para2:LONGWORD):LONGWORD;
  321.                   cbWindowData:LONGWORD;
  322.             END;
  323.  
  324. TYPE
  325.     {Toolbar elements}
  326.     PWndProc=FUNCTION(Win:HWND;Msg:ULONG;para1,para2:ULONG):ULONG;CDECL;
  327.  
  328.     PToolBarInterior=^TToolBarInterior;
  329.     TToolBarInterior=RECORD
  330.                            Win:HWND;
  331.                            OldWndProc:PWndProc;
  332.                            id:LONGWORD;
  333.                            x,y,cx,cy:LONGWORD;
  334.                            Next:PToolBarInterior;
  335.                      END;
  336.  
  337.     {Statusbar elements}
  338.     PStatusBarInterior=^TStatusBarInterior;
  339.     TStatusBarInterior=RECORD
  340.                            id:WORD;
  341.                            x,y,cx,cy:LONGWORD;
  342.                            item:String;
  343.                            Col:LONGINT;
  344.                            Exclusive:BOOLEAN;
  345.                            Next:PStatusBarInterior;
  346.                      END;
  347.  
  348.      {Menuhelp elements}
  349.      PMenuHelpItems=^TMenuHelpItems;
  350.      TMenuHelpItems=RECORD
  351.                           StatusID:WORD;
  352.                           MenuID:WORD;
  353.                           HelpText:String;
  354.                           Col:LONGWORD;
  355.                           Next:PMenuHelpItems;
  356.                     END;
  357.  
  358. VAR
  359.   {Procedue addresses}
  360.   StartHandlerAddr:POINTER;
  361.   MessageHandlerAddr:POINTER;
  362.  
  363. TYPE
  364.   { TMessage windows message record }
  365.   TMessage = RECORD
  366.     Receiver: HWND;
  367.     Message:  LONGWORD;
  368.     Handled:  BOOLEAN;  {True if the message was handled}
  369.     CASE Integer OF
  370.       0: ( Param1: LONGWORD;
  371.            Param2: LONGWORD;
  372.            Result: LONGWORD);
  373.       1: ( Param1Lo: WORD;
  374.            Param1Hi: WORD;
  375.            Param2Lo: WORD;
  376.            Param2Hi: WORD;
  377.            ResultLo: WORD;
  378.            ResultHi: WORD);
  379.       2: ( Param1LoByteLo:BYTE;
  380.            Param1LoByteHi:BYTE;
  381.            Param1HiByteLo:BYTE;
  382.            Param1HiByteHi:BYTE;
  383.            Param2LoByteLo:BYTE;
  384.            Param2LoByteHi:BYTE;
  385.            Param2HiByteLo:BYTE;
  386.            Param2HiByteHi:BYTE;
  387.            ResultLoByteLo:BYTE;
  388.            ResultLoByteHi:BYTE;
  389.            ResultHiByteLo:BYTE;
  390.            ResultHiByteHi:BYTE);
  391.     END;
  392.  
  393. TYPE
  394.     { TWindowsObject object}
  395.     PWindowsObject = ^TWindowsObject;
  396.     TWindowsObject = OBJECT(TOPMLObject)
  397.           id:LONGINT;
  398.           HWindow:HWND;
  399.           HWindowFrame:HWND;
  400.           Parent,FirstChild,LastChild:PWindowsObject;
  401.           Previous,Next:PWindowsObject;
  402.           AutoCreate:BOOLEAN;
  403.           WinColor,WinBackColor:LONGINT;
  404.           WinFlags:LONGWORD;
  405.           OldFrameProc:POINTER;
  406.           ObjectPtr:PWindowsObject;
  407.           ActiveChild:PWindowsObject;
  408.           MaxDoubleChars,MaxDoubleScans:WORD;
  409.  
  410.           {Fixed procedures - Don't change positions of the following.....}
  411.           {****************************************************************}
  412.           FUNCTION HandleEvent(Win:HWND;Msg:LONGWORD;           {_VMT_}
  413.                           para1,para2:POINTER):LONGWORD;VIRTUAL {index 5};
  414.           PROCEDURE DefWndProc(var Msg: TMessage); VIRTUAL      {index 6};
  415.           FUNCTION FrameHandleEvent(Win:HWND;Msg:LONGWORD;
  416.                           para1,para2:POINTER):LONGWORD;VIRTUAL {index 7};
  417.           PROCEDURE FrameDefProc(VAR Msg:TMessage);VIRTUAL;     {index 8}
  418.           {****************************************************************}
  419.  
  420.           CONSTRUCTOR Init(AParent: PWindowsObject);
  421.           DESTRUCTOR Done;VIRTUAL;
  422.           PROCEDURE FrameHandler(VAR Msg:TMessage);VIRTUAL;
  423.           PROCEDURE HandleCharEvent(Win:HWND;param,Rep:WORD);VIRTUAL;
  424.           PROCEDURE HandleScanEvent(Win:HWND;param,Rep:WORD);VIRTUAL;
  425.           FUNCTION FirstThat(Test:FUNCTION(achild:PWindowsObject):BOOLEAN):
  426.                              PWindowsObject;
  427.           FUNCTION LastThat(Test:FUNCTION(achild:PWindowsObject):BOOLEAN):
  428.                              PWindowsObject;
  429.           PROCEDURE ForEach(Action:PROCEDURE(P:PWindowsObject));
  430.           PROCEDURE AddChild(AChild: PWindowsObject);VIRTUAL;
  431.           PROCEDURE RemoveChild(AChild: PWindowsObject);VIRTUAL;
  432.           PROCEDURE GetWindowClass(VAR AWndClass: TWndClass);VIRTUAL;
  433.           FUNCTION GetClassName:STRING;VIRTUAL;
  434.           FUNCTION Register: BOOLEAN;VIRTUAL;
  435.           PROCEDURE SetupWindow;VIRTUAL;
  436.           FUNCTION Create:BOOLEAN;VIRTUAL;
  437.           FUNCTION Enable: BOOLEAN;VIRTUAL;
  438.           FUNCTION Disable: BOOLEAN;VIRTUAL;
  439.           PROCEDURE Focus;VIRTUAL;
  440.           PROCEDURE Capture(Clear:BOOLEAN);VIRTUAL;
  441.           PROCEDURE CloseNotify;VIRTUAL;
  442.           PROCEDURE CloseWindow;VIRTUAL;
  443.           PROCEDURE SetFlags(Mask:LONGWORD;OnOff:BOOLEAN);
  444.           FUNCTION IsFlagSet(Mask:LONGWORD):BOOLEAN;
  445.           PROCEDURE EnableAutoFill;
  446.           PROCEDURE DisableAutoFill;
  447.           PROCEDURE EnableAutoCreate;
  448.           PROCEDURE DisableAutoCreate;
  449.           FUNCTION CanClose:BOOLEAN;VIRTUAL;
  450.           PROCEDURE Redraw(VAR ahps:HPS;VAR rc:RECTL);VIRTUAL;
  451.           PROCEDURE NoMoreChildWindows;VIRTUAL;
  452.           PROCEDURE FirstChildWindow;VIRTUAL;
  453.           PROCEDURE WindowToTop;VIRTUAL;
  454.           FUNCTION  GetActiveChild:PWindowsObject;VIRTUAL;
  455.           PROCEDURE SetActiveChild(NewChild:PWindowsObject);VIRTUAL;
  456.           FUNCTION  IsAChild(w:PWindowsObject):BOOLEAN;VIRTUAL;
  457.           PROCEDURE WindowDestroyed;VIRTUAL;
  458.           FUNCTION GetID:LONGINT;
  459.           FUNCTION ChildWithId(aId: LongInt): PWindowsObject;
  460.           FUNCTION IndexOf(P: PWindowsObject): Integer;
  461.           FUNCTION At(I: Integer): PWindowsObject;
  462.           PROCEDURE CreateChildren;
  463.           FUNCTION CreateMemoryDC: HDC;
  464.  
  465.           PROCEDURE WMCommand(var Msg: TMessage);
  466.                                    VIRTUAL WM_FIRST+WM_COMMAND;
  467.           PROCEDURE WMActivate(var Msg: TMessage);
  468.                                    VIRTUAL WM_FIRST+WM_ACTIVATE;
  469.           PROCEDURE WMClose(var Msg: TMessage);
  470.                                    VIRTUAL WM_FIRST+WM_CLOSE;
  471.           PROCEDURE WMDestroy(var Msg: TMessage);
  472.                                    VIRTUAL WM_FIRST+WM_DESTROY;
  473.           PROCEDURE WMEraseBackGround(VAR Msg:TMessage);
  474.                                    VIRTUAL WM_FIRST+WM_ERASEBACKGROUND;
  475.           PROCEDURE WMPaint(VAR Msg:TMessage);
  476.                                    VIRTUAL WM_FIRST+WM_PAINT;
  477.           PROCEDURE WMSize(VAR Msg:TMessage);
  478.                                    VIRTUAL WM_FIRST+WM_SIZE;
  479.           PROCEDURE WMMove(VAR Msg:TMessage);
  480.                                    VIRTUAL WM_FIRST+WM_MOVE;
  481.           PROCEDURE WMChar(VAR Msg:TMessage);
  482.                                    VIRTUAL WM_FIRST+WM_CHAR;
  483.           PROCEDURE WMButton1Down(VAR Msg:TMessage);
  484.                                    VIRTUAL WM_FIRST+WM_BUTTON1DOWN;
  485.           PROCEDURE WMButton2Down(VAR Msg:TMessage);
  486.                                    VIRTUAL WM_FIRST+WM_BUTTON2DOWN;
  487.           PROCEDURE WMButton1Up(VAR Msg:TMessage);
  488.                                    VIRTUAL WM_FIRST+WM_BUTTON1UP;
  489.           PROCEDURE WMButton2Up(VAR Msg:TMessage);
  490.                                    VIRTUAL WM_FIRST+WM_BUTTON2UP;
  491.           PROCEDURE WMButton1CLICK(VAR Msg:TMessage);
  492.                                    VIRTUAL WM_FIRST+WM_BUTTON1CLICK;
  493.           PROCEDURE WMButton2CLICK(VAR Msg:TMessage);
  494.                                    VIRTUAL WM_FIRST+WM_BUTTON2CLICK;
  495.           PROCEDURE WMButton1DBLCLK(VAR Msg:TMessage);
  496.                                    VIRTUAL WM_FIRST+WM_BUTTON1DBLCLK;
  497.           PROCEDURE WMButton2DBLCLK(VAR Msg:TMessage);
  498.                                    VIRTUAL WM_FIRST+WM_BUTTON2DBLCLK;
  499.           PROCEDURE WMMouseMove(VAR Msg:TMessage);
  500.                                    VIRTUAL WM_FIRST+WM_MOUSEMOVE;
  501.      END;
  502.  
  503.      { TWindow creation attributes }
  504.      TWindowAttr = RECORD
  505.                        Title:STRING;
  506.                        Style:LONGWORD;
  507.                        FrameFlags:LONGWORD;
  508.                        X, Y, W, H:LONGINT;
  509.                        ResourceId:LONGWORD;
  510.                        ResourceModule:HModule;
  511.                        WindowId:LONGWORD;
  512.                        HasMenu:BOOLEAN;
  513.                        Menu:HWND;
  514.                        HasIcon:BOOLEAN;
  515.                        HasAccelTable:BOOLEAN;
  516.                        HasHelp:BOOLEAN;
  517.                        HelpFileName:CSTRING;
  518.                        HelpWindowTitle:CSTRING;
  519.                        FontName:CSTRING;
  520.                        FontWidth,FontHeight:BYTE;
  521.                        FontNameSize:CSTRING;
  522.                    END;
  523.  
  524.      { TWindow object }
  525.      PWindow = ^TWindow;
  526.      TWindow = OBJECT(TWindowsObject)
  527.                    DesktopWin:PWindow;
  528.                    Attr:TWindowAttr;
  529.                    StatusBarSize,ToolBarSize:WORD;
  530.                    LeftToolBarSize,RightToolBarSize:WORD;
  531.                    ToolBarColor,StatusBarColor:LONGINT;
  532.                    ToolBarInterior:PToolBarInterior;
  533.                    StatusBarInterior:PStatusBarInterior;
  534.                    StatusBarFontName:CSTRING;
  535.                    StatusBarFontWidth,StatusBarFontHeight:WORD;
  536.                    StatusBarFontFlags:LONGWORD;
  537.                    MenuHelpItems:PMenuHelpItems;
  538.                    HelpWindow:HWND;
  539.                    StatusBarTextBaseLine:BYTE;
  540.                    RedrawExclusive:BOOLEAN;
  541.  
  542.                    CONSTRUCTOR Init(AParent:PWindowsObject; ATitle:STRING);
  543.                    FUNCTION InitializeDesktop(ParentWin:PWindowsObject):
  544.                                         PWindow;VIRTUAL;
  545.                    PROCEDURE HelpInitError(err:LONGWORD);VIRTUAL;
  546.                    FUNCTION Create:BOOLEAN;VIRTUAL;
  547.                    PROCEDURE Show(ShowCmd:LONGWORD);VIRTUAL;
  548.                    PROCEDURE SetPosition;VIRTUAL;
  549.                    PROCEDURE SetupWindow;VIRTUAL;
  550.                    PROCEDURE GetDesktopLimits(VAR aswp:SWP);VIRTUAL;
  551.                    PROCEDURE SetupDesktop;VIRTUAL;
  552.                    PROCEDURE CloseNotify;VIRTUAL;
  553.                    PROCEDURE CreateToolBar(Size:WORD);
  554.                    PROCEDURE CreateStatusBar(Size:WORD);
  555.                    PROCEDURE Redraw(VAR ahps:HPS;VAR rc:RECTL);VIRTUAL;
  556.                    PROCEDURE RedrawToolBar(ahps:HPS);VIRTUAL;
  557.                    PROCEDURE ToolBarSetButtonState(id:LONGWORD;Enabled:BOOLEAN);
  558.                    PROCEDURE ToolBarSetButtonText(id:LONGWORD;name:STRING);
  559.                    FUNCTION  GetToolBarControl(id:LONGWORD):PToolBarInterior;
  560.                    PROCEDURE HandleToolBarEvent(VAR Msg:TMessage;Control:PToolBarInterior);
  561.                    PROCEDURE RedrawStatusBar(ahps:HPS);VIRTUAL;
  562.                    PROCEDURE ToolBarInsertButton(id,res,x,y,
  563.                                                  cx,cy:LONGWORD);
  564.                    PROCEDURE ToolBarInsertControl(id,x,y,cx,cy,
  565.                                                   flag,aclass:LONGWORD;
  566.                                                   title:STRING);
  567.                    FUNCTION StatusBarInsertItem(id:WORD;x,y,cx,cy:LONGWORD;
  568.                                     Exclusive:BOOLEAN):PStatusBarInterior;
  569.                    PROCEDURE StatusBarSetText(id:WORD;item:STRING;Col:LONGINT);
  570.  
  571.                    PROCEDURE InsertMenuHelp(StatusID,MenuID:WORD;
  572.                                             HelpText:String;Col:LONGWORD);
  573.                    PROCEDURE SetupMenu;VIRTUAL;
  574.                    PROCEDURE SetMenuState(id:WORD;State:BOOLEAN);
  575.                    PROCEDURE InvalidateWindow;VIRTUAL;
  576.                    PROCEDURE FirstChildWindow;VIRTUAL;
  577.                    PROCEDURE NoMoreChildWindows;VIRTUAL;
  578.                    PROCEDURE InitWindowHelp(HelpFileName,HelpTitle:STRING);
  579.  
  580.                    PROCEDURE WMSize(VAR Msg:TMessage);
  581.                                    VIRTUAL WM_FIRST+WM_SIZE;
  582.                    PROCEDURE WMMenuSelect(VAR Msg:TMessage);
  583.                                    VIRTUAL WM_FIRST+WM_MENUSELECT;
  584.                    PROCEDURE WMMenuend(VAR Msg:TMessage);
  585.                                    VIRTUAL WM_FIRST+WM_MENUEND;
  586.                    PROCEDURE WMMove(VAR Msg:TMessage);
  587.                                    VIRTUAL WM_FIRST+WM_MOVE;
  588.                    PROCEDURE WMDestroy(var Msg: TMessage);
  589.                                    VIRTUAL WM_FIRST+WM_DESTROY;
  590.                    PROCEDURE WMTranslateAccel(VAR Msg:TMessage);
  591.                                    VIRTUAL WM_FIRST+WM_TRANSLATEACCEL;
  592.  
  593.                    PROCEDURE CMTile(VAR Msg:TMessage);
  594.                                    VIRTUAL CM_FIRST+CM_TILE;
  595.                    PROCEDURE CMCascade(VAR Msg:TMessage);
  596.                                    VIRTUAL CM_FIRST+CM_CASCADE;
  597.                    PROCEDURE CMClose(VAR Msg:TMessage);
  598.                                    VIRTUAL CM_FIRST+CM_CLOSE;
  599.                    PROCEDURE CMCloseAll(VAR Msg:TMessage);
  600.                                    VIRTUAL CM_FIRST+CM_CLOSEALL;
  601.                    PROCEDURE CMNext(VAR Msg:TMessage);
  602.                                    VIRTUAL CM_FIRST+CM_NEXT;
  603.                    PROCEDURE CMPrevious(VAR Msg:TMessage);
  604.                                    VIRTUAL CM_FIRST+CM_PREVIOUS;
  605.                    PROCEDURE CMQuit(VAR Msg:TMessage);
  606.                                    VIRTUAL CM_FIRST+CM_QUIT;
  607.                    PROCEDURE CMHelpOnHelp(VAR Msg:TMessage);
  608.                                    VIRTUAL CM_FIRST+CM_HELPONHELP;
  609.                    PROCEDURE CMExtendedHelp(VAR Msg:TMessage);
  610.                                    VIRTUAL CM_FIRST+CM_EXTENDEDHELP;
  611.                    PROCEDURE CMKeysHelp(VAR Msg:TMessage);
  612.                                    VIRTUAL CM_FIRST+CM_KEYSHELP;
  613.                    PROCEDURE CMHelpIndex(VAR Msg:TMessage);
  614.                                    VIRTUAL CM_FIRST+CM_HELPINDEX;
  615.                    PROCEDURE CMHelpContents(VAR Msg:TMessage);
  616.                                    VIRTUAL CM_FIRST+CM_HELPCONTENTS;
  617.               END;
  618.  
  619.      { TApplication object }
  620.      PApplication = ^TApplication;
  621.      TApplication = OBJECT
  622.                       ApplicationName: STRING;
  623.                       MainWindow: PWindow;
  624.                       CONSTRUCTOR Init(AName:STRING);
  625.                       DESTRUCTOR Done;VIRTUAL;
  626.                       PROCEDURE InitMainWindow;VIRTUAL;
  627.                       PROCEDURE Run;VIRTUAL;
  628.                       PROCEDURE MessageLoop;
  629.                       PROCEDURE SetupRun;VIRTUAL;
  630.                       PROCEDURE RunFailed(Code:BYTE);VIRTUAL;
  631.                     END;
  632.  
  633.  
  634. VAR
  635.    Application:PApplication;  {Main Application window}
  636.    Button1Down:BOOLEAN;
  637.    Button2Down:BOOLEAN;
  638.  
  639. FUNCTION  ConfirmBox(Options:LONGWORD;title,msg:STRING):BOOLEAN;
  640. PROCEDURE MessageBox(title,msg:STRING);
  641. PROCEDURE ErrorBox(Options:LONGWORD;title,err:STRING);
  642. PROCEDURE PerformDMTMsg(W: PWindowsObject; var M: TMessage; DVMTIndex: LONGWORD;
  643.                         FailureProc:LONGWORD);
  644. PROCEDURE DrawStringXY(ahps:HPS;VAR pt:POINTL;VAR s:STRING;start,Len:LONGWORD;
  645.                        Color,BackColor:LONGWORD);
  646. FUNCTION  IsWindowMinimized(Win:HWND):BOOLEAN;
  647. FUNCTION  IsWindowMaximized(Win:HWND):BOOLEAN;
  648. PROCEDURE GetWindowPos(Win:HWND;VAR x,y,cx,cy:LONGINT);
  649. PROCEDURE PopupMenu(VAR Menu:HWND;id:LONGWORD;x,y:LONGWORD;Parent:HWND);
  650. PROCEDURE CreateLogFont(_HPS:LONGWORD;CONST facename:CSTRING;
  651.                         hei,len,SelAttr:LONGWORD);
  652.  
  653. IMPLEMENTATION
  654.  
  655. IMPORTS
  656.        FUNCTION GpiCharStringAt(ahps:HPS;VAR pptlPoint:POINTL;lCount:LONG;
  657.                                 VAR pchString):LONG;
  658.                     APIENTRY;                PMGPI index 359;
  659.        FUNCTION GpiSetColor(ahps:HPS;lColor:LONG):BOOL;
  660.                     APIENTRY;                PMGPI index 517;
  661.        FUNCTION GpiSetBackColor(ahps:HPS;lColor:LONG):BOOL;
  662.                     APIENTRY;                PMGPI index 504;
  663.        FUNCTION GpiSetBackMix(ahps:HPS;lMixMode:LONG):BOOL;
  664.                     APIENTRY;                PMGPI index 505;
  665. END;
  666.  
  667. PROCEDURE Abstract;
  668. BEGIN
  669.      RunError(211);
  670. END;
  671.  
  672. FUNCTION NewStr(S:STRING):PString;
  673. VAR
  674.    p:PString;
  675. BEGIN
  676.      IF s='' THEN NewStr:=NIL
  677.      ELSE
  678.      BEGIN
  679.           getmem(p,length(s)+1);
  680.           p^:=s;
  681.           NewStr:=p;
  682.      END;
  683. END;
  684.  
  685. PROCEDURE DisposeStr(ps:PString);
  686. BEGIN
  687.      IF ps<>NIL THEN freemem(ps,length(ps^)+1);
  688. END;
  689.  
  690.  
  691. {*************************************************************************
  692.  *                                                                       *
  693.  *  Object TObject                                                       *
  694.  *                                                                       *
  695.  *************************************************************************}
  696.  
  697.  
  698. CONSTRUCTOR TOPMLObject.Init;
  699. BEGIN
  700. END;
  701.  
  702. PROCEDURE TOPMLObject.Free;
  703. BEGIN
  704.      SELF.Done;
  705. END;
  706.  
  707. DESTRUCTOR TOPMLObject.Done;
  708. BEGIN
  709. END;
  710.  
  711.  
  712. {*************************************************************************
  713.  *                                                                       *
  714.  *   Generic functions                                                   *
  715.  *                                                                       *
  716.  *************************************************************************}
  717.  
  718. PROCEDURE CreateLogFont(_hps:LONGWORD;CONST facename:CSTRING;hei,len,
  719.                         SelAttr:LONGWORD);
  720. VAR  fa:FATTRS;
  721. BEGIN
  722.      fa.szFaceName:=facename;
  723.      fa.usRecordLength:=sizeof(FATTRS);
  724.      fa.fsSelection:=SelAttr;
  725.      fa.lMatch:=1;
  726.      fa.idRegistry:=0;
  727.      fa.usCodePage:=0; {default}
  728.      fa.lMaxbaseLineExt:=hei;
  729.      fa.lAveCharWidth:=len;
  730.      fa.fsType:=0;
  731.      fa.fsFontUse:=0;
  732.      GpiCreateLogFont(_hps,NIL,1,fa);
  733.      GpiSetCharSet(_hps,1);
  734. END;
  735.  
  736.  
  737. PROCEDURE PopupMenu(VAR Menu:HWND;id:LONGWORD;x,y:LONGWORD;Parent:HWND);
  738. BEGIN
  739.      IF Menu=0 THEN Menu:=WinLoadMenu(HWND_OBJECT,0,id);
  740.      WinPopupMenu(Parent,Parent,Menu,x,y,0,
  741.                   PU_HCONSTRAIN OR PU_VCONSTRAIN OR PU_KEYBOARD OR
  742.                   PU_MOUSEBUTTON2 OR PU_MOUSEBUTTON1);
  743. END;
  744.  
  745. PROCEDURE GetWindowPos(Win:HWND;VAR x,y,cx,cy:LONGINT);
  746. VAR
  747.    aswp:SWP;
  748. BEGIN
  749.      WinQueryWindowPos(Win,aswp);
  750.      x:=aswp.x;
  751.      y:=aswp.y;
  752.      cx:=aswp.cx;
  753.      cy:=aswp.cy;
  754. END;
  755.  
  756. FUNCTION ConfirmBox(Options:LONGWORD;title,msg:String):BOOLEAN;
  757. VAR
  758.     result:LONGWORD;
  759.     Parent:HWND;
  760.     cmsg,ctitle:CSTRING;
  761. BEGIN
  762.      cmsg:=msg;
  763.      ctitle:=title;
  764.      Parent:=HWND_DESKTOP;
  765.      IF Application<>NIL THEN IF Application^.MainWindow<>NIL THEN
  766.        IF Application^.MainWindow^.HWindow<>0 THEN
  767.         Parent:=Application^.MainWindow^.HWindow;
  768.      result:=WinMessageBox(HWND_DESKTOP,Parent,cmsg,ctitle,0,
  769.                            MB_APPLMODAL OR MB_QUERY OR MB_YESNO OR MB_MOVEABLE
  770.                            OR Options);
  771.      ConfirmBox:=result=MBID_YES;
  772. END;
  773.  
  774. FUNCTION IsWindowMinimized(Win:HWND):BOOLEAN;
  775. VAR  r:LONGWORD;
  776. BEGIN
  777.      IF Win=0 THEN
  778.      BEGIN
  779.           IsWindowMinimized:=FALSE;
  780.           exit;
  781.      END;
  782.      IF WinQueryWindowUShort(Win,QWS_ID)=FID_CLIENT THEN
  783.         Win:=WinQueryWindow(Win,QW_PARENT);
  784.      r:=WinQueryWindowULong(Win,QWL_STYLE) AND WS_MINIMIZED;
  785.      IF r<>0 THEN IsWindowMinimized:=TRUE
  786.      ELSE IsWindowMinimized:=FALSE;
  787. END;
  788.  
  789. FUNCTION IsWindowMaximized(Win:HWND):BOOLEAN;
  790. VAR r:LONGWORD;
  791. BEGIN
  792.      IF Win=0 THEN
  793.      BEGIN
  794.           IsWindowMaximized:=FALSE;
  795.           exit;
  796.      END;
  797.      IF WinQueryWindowUShort(Win,QWS_ID)=FID_CLIENT THEN
  798.         Win:=WinQueryWindow(Win,QW_PARENT);
  799.      r:=WinQueryWindowULong(Win,QWL_STYLE) AND WS_MAXIMIZED;
  800.      IF r<>0 THEN IsWindowMaximized:=TRUE
  801.      ELSE IsWindowMaximized:=FALSE;
  802. END;
  803.  
  804.  
  805. PROCEDURE MessageBox(title,msg:String);
  806. VAR
  807.    Parent:HWND;
  808.    cmsg,ctitle:CSTRING;
  809. BEGIN
  810.      cmsg:=msg;
  811.      ctitle:=title;
  812.      Parent:=HWND_DESKTOP;
  813.      IF Application<>NIL THEN IF Application^.MainWindow<>NIL THEN
  814.        IF Application^.MainWindow^.HWindow<>0 THEN
  815.         Parent:=Application^.MainWindow^.HWindow;
  816.      WinMessageBox(HWND_DESKTOP,Parent,cmsg,ctitle,0,
  817.                   MB_APPLMODAL OR MB_OK OR MB_MOVEABLE OR MB_QUERY);
  818. END;
  819.  
  820. PROCEDURE ErrorBox(Options:LONGWORD;title,err:String);
  821. VAR Parent:HWND;
  822.     ctitle,cerr:CSTRING;
  823. BEGIN
  824.      ctitle:=title;
  825.      cerr:=err;
  826.      Parent:=HWND_DESKTOP;
  827.      IF Application<>NIL THEN IF Application^.MainWindow<>NIL THEN
  828.        IF Application^.MainWindow^.HWindow<>0 THEN
  829.         Parent:=Application^.MainWindow^.HWindow;
  830.      WinMessageBox(HWND_DESKTOP,Parent,cerr,ctitle,0,
  831.                    MB_APPLMODAL OR MB_OK OR MB_MOVEABLE OR Options);
  832. END;
  833.  
  834. PROCEDURE DrawStringXY(ahps:HPS;VAR pt:POINTL;VAR s:string;start,Len:LONGWORD;
  835.                        Color,BackColor:LONGWORD);
  836. BEGIN
  837.      GpiSetColor(ahps,Color);
  838.      GpiSetBackColor(ahps,BackColor);
  839.      GpiCharStringAt(ahps,pt,Len,s[Start]);
  840. END;
  841.  
  842.  
  843.  
  844. { Calls a procedure in the TWindowsObject's DVMT indicated by DVMTIndex,
  845.   if found.  Else calls the passed FailureProc - This is normaly
  846.   TWindowsObject_DefWndProc}
  847. PROCEDURE PerformDMTMsg(W: PWindowsObject; var M: TMessage; DVMTIndex: LONGWORD;
  848.                         FailureProc:LONGWORD);
  849. VAR DMTFound:BOOLEAN;
  850. LABEL l;
  851. BEGIN
  852.      DMTFound:=FALSE;
  853.      {Try to call DMT method}
  854.      ASM
  855.         MOV EDI,$W         //Pointer to Object
  856.         //MOV EDI,[EDI+0]    //SELF Pointer             EDI = SELF
  857.         MOV EDI,[EDI+0]    //Get VMT Pointer
  858.         MOV ESI,[EDI+0]    //Get DMT Pointer
  859.         MOV ECX,[ESI+0]    //number of DMT entries
  860.         CMP ECX,0
  861.         JE !NoDMT1         //no dynamic methods
  862.         ADD ESI,4          //onto first DMT entry
  863.         MOV EAX,$DVMTIndex
  864. !DMTLoop1:
  865.         CMP [ESI+0],EAX
  866.         JE !DMTHere1       //Message found
  867.         ADD ESI,8          //next DMT entry
  868.         LOOP !DMTLoop1
  869.         JMP !NoDMT1
  870. !DMTHere1:
  871.         MOVB $DMTFound,1
  872.         MOV EAX,$M
  873.         PUSH EAX           //Parameter for dynamic method call
  874.         MOV EAX,[ESI+4]    //Get VMT index
  875.         MOV ESI,$W
  876.         //MOV ESI,[ESI+0]    //SELF pointer
  877.         PUSH ESI           //VMT for dynamic method
  878.         CALLN32 [EDI+EAX*4]  //--> Call VMT method
  879. !NoDMT1:
  880.       END;
  881. l:
  882.       IF not DMTFound THEN {Call FailureProc in VMT}
  883.       BEGIN
  884.            ASM
  885.               MOV EAX,$M
  886.               PUSH EAX          //Push Parameter TMessage
  887.               MOV EDI,$W        //Get Pointer to Object
  888.               //MOV EDI,[EDI+0]   //SELF pointer
  889.               PUSH EDI
  890.               MOV EDI,[EDI+0]   //VMT table address
  891.               MOV EAX,$FailureProc  //Add failure Offset
  892.               CALLN32 [EDI+EAX*4]   //--> Call VMT method
  893.            END;
  894.       END;
  895. END;
  896.  
  897. {*************************************************************************
  898.  *                                                                       *
  899.  *  Object TWindowsObject                                                *
  900.  *                                                                       *
  901.  *************************************************************************}
  902.  
  903. {Creates and initializes the object}
  904. CONSTRUCTOR TWindowsObject.Init(AParent: PWindowsObject);
  905. BEGIN
  906.      id:=-1;
  907.      WinFlags:=0;  {No flags created}
  908.      HWindow:=0; {No window created}
  909.      HWindowFrame:=0; {No window created}
  910.      Parent:=AParent;  {Set parent window}
  911.      FirstChild:=NIL; {No child windows}
  912.      LastChild:=NIL; {No child windows}
  913.      Previous:=NIL; {No child windows}
  914.      Next:=NIL; {No child windows}
  915.      SetActiveChild(NIL);
  916.      {Getmem(ObjectPtr,4);
  917.      POINTER(ObjectPtr^):=POINTER(SELF); ??}
  918.      {}POINTER(ObjectPtr):=POINTER(SELF);{}
  919.      IF Parent<>NIL THEN Parent^.AddChild(ObjectPtr); {create child in parent}
  920.      AutoCreate:=TRUE;  {Create this window automatically}
  921.      WinColor:=CLR_BLACK;
  922.      WinBackColor:=CLR_WHITE;
  923.      Register;  {Register the Window Class}
  924.      EnableAutoCreate;  {Enable auto creation}
  925.      EnableAutoFill;    {Fill the background with the current color}
  926.      MaxDoubleChars:=10;
  927.      MaxDoubleScans:=10;
  928. END;
  929.  
  930. FUNCTION TWindowsObject.GetID:LONGINT;
  931. BEGIN
  932.      GetID:=id;
  933. END;
  934.  
  935. {This Method is called when the first child of a window is created via
  936.  TWindowsObject.Init. This can be used to enable/disable Menu-entries
  937.  for the child windows}
  938. PROCEDURE TWindowsObject.FirstChildWindow;
  939. BEGIN
  940. END;
  941.  
  942. {This Method is called whenever no childs of the current window exists.
  943.  This is when the the last of the child windows is closed via
  944.  TWindowsObject.CloseWindow.
  945.  This can be used to enable/disable Menu-entries for the child windows}
  946. PROCEDURE TWindowsObject.NoMoreChildWindows;
  947. BEGIN
  948. END;
  949.  
  950. FUNCTION TWindowsObject.IndexOf(P: PWindowsObject): Integer;
  951. VAR dummy:PWindowsObject;
  952.     result:INTEGER;
  953. LABEL l;
  954. BEGIN
  955.      result:=1;
  956.      dummy:=FirstChild;
  957.      WHILE dummy<>NIL DO
  958.      BEGIN
  959.           IF dummy=P THEN goto l;
  960.           inc(result);
  961.           dummy:=dummy^.Next;
  962.      END;
  963.      result:=0;
  964. l:
  965.      IndexOf:=result;
  966. END;
  967.  
  968. FUNCTION TWindowsObject.At(I: Integer): PWindowsObject;
  969. VAR dummy:PWindowsObject;
  970.     result:PWindowsObject;
  971.     count:Integer;
  972. LABEL l;
  973. BEGIN
  974.      dummy:=FirstChild;
  975.      count:=1;
  976.      WHILE dummy<>NIL DO
  977.      BEGIN
  978.           IF count=I THEN
  979.           BEGIN
  980.                result:=dummy;
  981.                goto l;
  982.           END;
  983.           inc(count);
  984.           dummy:=dummy^.next;
  985.      END;
  986.      result:=NIL;
  987. l:
  988.      At:=result;
  989. END;
  990.  
  991. {Deletes the Object}
  992. DESTRUCTOR TWindowsObject.Done;
  993. VAR
  994.    Win:HWND;
  995. BEGIN
  996.      IF Parent<>NIL THEN
  997.      BEGIN
  998.           Parent^.RemoveChild(ObjectPtr);
  999.           IF Parent^.FirstChild=NIL THEN Parent^.SetActiveChild(NIL);
  1000.           Parent:=NIL;
  1001.      END;
  1002.      IF HWindow=0 THEN exit;
  1003.      Win:=WinQueryWindow(HWindow,QW_PARENT);
  1004.      IF Win=0 THEN exit;
  1005.      WinDestroyWindow(Win);
  1006.      HWindow:=0;
  1007.      HWindowFrame:=0;
  1008. END;
  1009.  
  1010. FUNCTION TWindowsObject.CreateMemoryDC: HDC;
  1011. VAR
  1012.    s,c:CSTRING;
  1013.    dop:DEVOPENSTRUC;
  1014. BEGIN
  1015.      FillChar(dop,sizeof(DEVOPENSTRUC),0);
  1016.      s:='*';
  1017.      c:='DISPLAY';
  1018.      dop.pszDriverName:=@c;
  1019.      CreateMemoryDC := DevOpenDC(AppHandle,OD_MEMORY,s,3,dop,0);
  1020. END;
  1021.  
  1022. PROCEDURE TWindowsObject.SetFlags(Mask:LONGWORD;OnOff:BOOLEAN);
  1023. BEGIN
  1024.      IF OnOff THEN WinFlags:=WinFlags OR Mask
  1025.      ELSE WinFlags:=WinFlags AND (Not Mask);
  1026. END;
  1027.  
  1028. FUNCTION TWindowsObject.IsFlagSet(Mask:LONGWORD):BOOLEAN;
  1029. BEGIN
  1030.      IF WinFlags AND Mask=Mask THEN IsFlagSet:=TRUE
  1031.      ELSE IsFlagSet:=FALSE;
  1032. END;
  1033.  
  1034. FUNCTION TWindowsObject.GetActiveChild:PWindowsObject;
  1035. BEGIN
  1036.      GetActiveChild:=ActiveChild;
  1037. END;
  1038.  
  1039. FUNCTION TWindowsObject.IsAChild(w:PWindowsObject):BOOLEAN;
  1040. VAR dummy:PWindowsObject;
  1041.     result:BOOLEAN;
  1042. LABEL l;
  1043. BEGIN
  1044.      result:=FALSE;
  1045.      dummy:=FirstChild;
  1046.      WHILE dummy<>NIL DO
  1047.      BEGIN
  1048.           IF dummy=w THEN
  1049.           BEGIN
  1050.                result:=TRUE;
  1051.                goto l;
  1052.           END;
  1053.           dummy:=dummy^.next;
  1054.      END;
  1055. l:
  1056.      IsAChild:=result;
  1057. END;
  1058.  
  1059.  
  1060. PROCEDURE TWindowsObject.SetActiveChild(NewChild:PWindowsObject);
  1061. BEGIN
  1062.      ActiveChild:=NewChild;
  1063. END;
  1064.  
  1065.  
  1066. PROCEDURE TWindowsObject.EnableAutoFill;
  1067. BEGIN
  1068.      SetFlags(WF_AUTOFILL,TRUE);
  1069. END;
  1070.  
  1071. PROCEDURE TWindowsObject.DisableAutoFill;
  1072. BEGIN
  1073.      SetFlags(WF_AUTOFILL,FALSE);
  1074. END;
  1075.  
  1076. PROCEDURE TWindowsObject.EnableAutoCreate;
  1077. BEGIN
  1078.     SetFlags(WF_AUTOCREATE,TRUE);
  1079. END;
  1080.  
  1081. PROCEDURE TWindowsObject.DisableAutoCreate;
  1082. BEGIN
  1083.      SetFlags(WF_AUTOCREATE,FALSE);
  1084. END;
  1085.  
  1086. {Get the Standard ClassName}
  1087. FUNCTION TWindowsObject.GetClassName:STRING;
  1088. BEGIN
  1089.      GetClassName:='SpeedWindow';
  1090. END;
  1091.  
  1092.  
  1093. {This is the default window procedure for all objects called by PM.
  1094.  It is only called when the window is created and then redefined.}
  1095. FUNCTION TheStartHandler(Win:HWND;msg:LONGWORD;para1,para2:LONGWORD):
  1096.                          LONGWORD;CDECL;
  1097. BEGIN
  1098.      TheStartHandler:=WinDefWindowProc(Win,Msg,Para1,Para2);
  1099. END;
  1100.  
  1101. {This is the window procedure called by PM.
  1102.  As it has to be fast and low level programmed it is written in assembler...
  1103.  It will call HandleEvent VIRTUAL in the VMT}
  1104. FUNCTION TheMessageHandler(Win:HWND;Msg:LONGWORD;para1,para2:POINTER):
  1105.                            LONGWORD;CDECL;
  1106. BEGIN
  1107.      ASM
  1108.         //Prepare the parameters for a call to HandleEvent
  1109.         PUSHL $Win
  1110.         PUSHL $Msg
  1111.         PUSHL $para1
  1112.         PUSHL $para2
  1113.  
  1114.         PUSHL 0             //Get VMT pointer
  1115.         PUSHL $Win
  1116.         MOV AL,2
  1117.         CALLDLL PMWIN,843   //WinQueryWindowUlong
  1118.         ADD ESP,8
  1119.         MOV EDI,EAX
  1120.  
  1121.         PUSH EDI             //VMT Pointer      SELF
  1122.         MOV EDI,[EDI+0]      //get VMT pointer for HandleEvent
  1123.         MOV EAX,5            //TWindowsObject_HandleEvent = 5     {_VMT_}
  1124.         CALLN32 [EDI+EAX*4]  //call method
  1125.         MOV $!FUNCRESULT,EAX //result value
  1126.      END;
  1127. END;
  1128.  
  1129. FUNCTION TWindowsObject.ChildWithId(aId: LongInt): PWindowsObject;
  1130. VAR
  1131.    dummy:PWindowsObject;
  1132.    result:PWindowsObject;
  1133. LABEL l;
  1134. BEGIN
  1135.      result:=NIL;
  1136.      dummy:=FirstChild;
  1137.      WHILE dummy<>NIL DO
  1138.      BEGIN
  1139.           IF dummy^.GetID=aId THEN
  1140.           BEGIN
  1141.                result:=dummy;
  1142.                goto l;
  1143.           END;
  1144.           dummy:=dummy^.next;
  1145.      END;
  1146. l:
  1147.      ChildWithID:=result;
  1148. END;
  1149.  
  1150. PROCEDURE TWindowsObject.HandleCharEvent(Win:HWND;param,Rep:WORD);
  1151. BEGIN
  1152. END;
  1153.  
  1154. PROCEDURE TWindowsObject.HandleScanEvent(Win:HWND;param,Rep:WORD);
  1155. BEGIN
  1156. END;
  1157.  
  1158.  
  1159. PROCEDURE TWindowsObject.WindowToTop;
  1160. BEGIN
  1161.      WinSetWindowPos(HWindowFrame,HWND_TOP,0,0,0,0,SWP_ZORDER OR SWP_ACTIVATE
  1162.                      OR SWP_SHOW);
  1163.      WinSetActiveWindow(HWND_DESKTOP,HWindowFrame);
  1164.      IF Parent<>NIL THEN Parent^.SetActiveChild(ObjectPtr);
  1165. END;
  1166.  
  1167.  
  1168. PROCEDURE TWindowsObject.WMChar(VAR Msg:TMessage);
  1169. VAR  fsflags : WORD;
  1170.      ascii : WORD;
  1171.      virtkey : WORD;
  1172.      rep : BYTE;
  1173.      scan : WORD;
  1174.      param : WORD;
  1175.      Queue : QMSG;
  1176. LABEL lsc;
  1177.  
  1178. FUNCTION DeleteDoubles(VAR M : TMessage; MaxDoubles : BYTE) : BYTE;
  1179. VAR  rep : BYTE;
  1180. LABEL q;
  1181. BEGIN
  1182.      rep := 1;
  1183.      WHILE WinPeekMsg(HInstance,Queue,0,WM_CHAR,WM_CHAR,0) DO
  1184.      BEGIN
  1185.           IF (LONGWORD(Queue.mp1) = M.Param1) AND
  1186.              (LONGWORD(Queue.mp2) = M.Param2) THEN
  1187.           BEGIN
  1188.                WinGetMsg(HInstance,Queue,0,WM_CHAR,WM_CHAR);
  1189.                inc(rep);
  1190.                IF rep >= MaxDoubles THEN goto q;
  1191.           END
  1192.           ELSE goto q;
  1193.      END;
  1194. q:
  1195.      DeleteDoubles:=rep;
  1196. END;
  1197.  
  1198. BEGIN
  1199.      fsflags := Msg.Param1Lo;
  1200.      rep := Msg.Param1HiByteLo;
  1201.      scan := Msg.Param1HiByteHi;
  1202.      ascii := Msg.Param2LoByteLo;
  1203.      virtkey := Msg.Param2Hi;
  1204.  
  1205.      IF fsflags AND KC_KEYUP <> 0 THEN exit;
  1206.  
  1207.      IF fsflags AND KC_CHAR <> 0 THEN
  1208.      BEGIN
  1209.           IF (ascii < 32) OR  (fsflags AND KC_CTRL <> 0) THEN goto lsc;
  1210.           IF (fsflags AND KC_VIRTUALKEY <> 0) AND (fsflags AND KC_SHIFT <> 0)
  1211.           THEN goto lsc;    {numerical block}
  1212.           IF IsFlagSet(WF_DELETEDOUBLECHAR) THEN rep := DeleteDoubles(Msg,MaxDoubleChars);
  1213.           param := ascii;
  1214.           HandleCharEvent(Msg.Receiver,param,rep);
  1215.      END
  1216.      ELSE
  1217.      BEGIN
  1218. lsc:
  1219.           IF IsFlagSet(WF_DELETEDOUBLESCAN) THEN rep := DeleteDoubles(Msg,MaxDoubleScans);
  1220.           IF fsflags AND KC_VIRTUALKEY <> 0 THEN
  1221.           BEGIN
  1222.                param := virtkey OR kbVK;
  1223.                IF fsflags AND KC_SHIFT <> 0 THEN param := param OR kb_Shift;
  1224.           END
  1225.           ELSE param := ord(Upcase(chr(ascii)));       {e.g. Ctrl-J}
  1226.  
  1227.           IF fsflags AND KC_ALT <> 0 THEN param := param OR kb_Alt;
  1228.           IF fsflags AND KC_CTRL <> 0 THEN param := param OR kb_Ctrl;
  1229.           HandleScanEvent(Msg.Receiver,param,rep);
  1230.      END;
  1231. END;
  1232.  
  1233.  
  1234. PROCEDURE TWindowsObject.WMSize(VAR Msg:TMessage);
  1235. BEGIN
  1236. END;
  1237.  
  1238. PROCEDURE TWindowsObject.WMMove(VAR Msg:TMessage);
  1239. BEGIN
  1240. END;
  1241.  
  1242. {Register the desired window procedure if it is not always}
  1243. FUNCTION TWindowsObject.Register: BOOLEAN;
  1244. VAR
  1245.   aClass:CLASSINFO;
  1246.   WindowClass:TWndClass;
  1247.   cs:CSTRING;
  1248. BEGIN
  1249.   cs:=GetClassName;
  1250.   IF WinQueryClassInfo(HInstance,cs,aClass)=FALSE then
  1251.   BEGIN  {Class not registered}
  1252.       GetWindowClass(WindowClass);
  1253.       Register := BOOLEAN(WinRegisterClass(HInstance,cs,
  1254.                                            @WindowClass.ClassWndProc,
  1255.                                            WindowClass.ClassStyle,
  1256.                                            WindowClass.cbWindowData));
  1257.   END
  1258.   ELSE Register:=TRUE; {Class always registered}
  1259. END;
  1260.  
  1261.  
  1262. PROCEDURE TWindowsObject.GetWindowClass(VAR AWndClass: TWndClass);
  1263. BEGIN
  1264.      WITH AWndClass DO
  1265.      BEGIN
  1266.           ClassName:=GetClassName;
  1267.           ClassNameUlong:=0;   {for WC_Name Constants}
  1268.           ClassStyle:=CS_SIZEREDRAW OR CS_MOVENOTIFY;
  1269.           ClassWndProc:=@TheStartHandler;
  1270.           cbWindowData:=4;  {4 Byte window data for SELF pointer}
  1271.      END;
  1272. END;
  1273.  
  1274. {add an object to the childs list}
  1275. PROCEDURE TWindowsObject.AddChild(AChild: PWindowsObject);
  1276. BEGIN
  1277.      IF AChild=NIL THEN exit;
  1278.      IF FirstChild=NIL THEN
  1279.      BEGIN
  1280.           IF IsFlagSet(WF_ISDESKTOP) THEN  {route to parent}
  1281.           BEGIN
  1282.                IF Parent<>NIL THEN Parent^.FirstChildWindow
  1283.                ELSE FirstChildWindow;
  1284.           END
  1285.           ELSE FirstChildWindow;
  1286.           FirstChild:=AChild;
  1287.           FirstChild^.Previous:=NIL;
  1288.      END
  1289.      ELSE
  1290.      BEGIN
  1291.           AChild^.Previous:=LastChild;
  1292.           LastChild^.Next:=AChild;
  1293.      END;
  1294.      LastChild:=AChild;
  1295.      LastChild^.Next:=NIL;
  1296. END;
  1297.  
  1298. {removes a Object from the childs list}
  1299. PROCEDURE TWindowsObject.RemoveChild(AChild: PWindowsObject);
  1300. VAR List:PWindowsObject;
  1301. BEGIN
  1302.      IF AChild=NIL THEN exit;
  1303.      IF AChild=FirstChild THEN
  1304.      BEGIN
  1305.           FirstChild:=AChild^.Next;
  1306.           IF FirstChild<>NIL THEN FirstChild^.Previous:=NIL
  1307.           ELSE
  1308.           BEGIN
  1309.                IF IsFlagSet(WF_ISDESKTOP) THEN {route to parent}
  1310.                BEGIN
  1311.                     IF Parent<>NIL THEN Parent^.NoMoreChildWindows
  1312.                     ELSE NoMoreChildWindows;
  1313.                END
  1314.                ELSE NoMoreChildWindows;
  1315.           END;
  1316.           exit;
  1317.      END;
  1318.      IF AChild=LastChild THEN
  1319.      BEGIN
  1320.           LastChild:=AChild^.Previous;
  1321.           IF LastChild<>NIL THEN LastChild^.Next:=NIL;
  1322.           exit;
  1323.      END;
  1324.      List:=FirstChild;
  1325.      WHILE List<>NIL DO
  1326.      BEGIN
  1327.           IF List=AChild THEN
  1328.           BEGIN
  1329.                AChild^.Previous^.Next:=AChild^.Next;
  1330.                AChild^.Next^.Previous:=AChild^.Previous;
  1331.                exit;
  1332.           END;
  1333.           List:=List^.Next;
  1334.      END;
  1335. END;
  1336.  
  1337. {Perform the action for each child window beginning with the first added
  1338.  child window}
  1339. PROCEDURE TWindowsObject.ForEach(Action:PROCEDURE(P:PWindowsObject));
  1340. VAR
  1341.    aChild:PWindowsObject;
  1342. BEGIN
  1343.      aChild:=FirstChild;
  1344.      WHILE aChild<>NIL DO
  1345.      BEGIN
  1346.           Action(aChild);  {Do Action}
  1347.           aChild:=aChild^.Next;
  1348.      END;
  1349. END;
  1350.  
  1351.  
  1352. { Returns a pointer to the first TWindowsObject in the ChildList
  1353.   that meets some specified criteria returned by a function defined
  1354.   by Test. This Function has a PWindowsObject as the only parameter
  1355.   and must return a boolean value)}
  1356. FUNCTION TWindowsObject.FirstThat(Test:FUNCTION(achild:PWindowsObject):
  1357.                                   BOOLEAN ): PWindowsObject;
  1358. VAR
  1359.    aChild:PWindowsObject;
  1360. LABEL l;
  1361. BEGIN
  1362.      aChild:=FirstChild;
  1363.      WHILE aChild<>NIL DO
  1364.      BEGIN
  1365.           IF test(aChild) THEN goto l;
  1366.           aChild:=aChild^.Next;
  1367.      END;
  1368. l:
  1369.      FirstThat:=aChild;
  1370. END;
  1371.  
  1372. { Returns a pointer to the last TWindowsObject in the ChildList
  1373.   that meets some specified criteria returned by a function defined
  1374.   by Test. This Function has a PWindowsObject as the only parameter
  1375.   and must return a boolean value)}
  1376. FUNCTION TWindowsObject.LastThat(Test:FUNCTION(achild:PWindowsObject):
  1377.                                   BOOLEAN ): PWindowsObject;
  1378. VAR
  1379.    aChild:PWindowsObject;
  1380. LABEL l;
  1381. BEGIN
  1382.      aChild:=LastChild;
  1383.      WHILE aChild<>NIL DO
  1384.      BEGIN
  1385.           IF test(aChild) THEN goto l;
  1386.           aChild:=aChild^.Previous;
  1387.      END;
  1388. l:
  1389.      LastThat:=aChild;
  1390. END;
  1391.  
  1392.  
  1393. FUNCTION TWindowsObject.Create:BOOLEAN;
  1394. BEGIN
  1395.      Create:=FALSE;
  1396. END;
  1397.  
  1398.  
  1399. PROCEDURE CreateIt(P:PWindowsObject);
  1400. BEGIN
  1401.      P^.Create;
  1402. END;
  1403.  
  1404. PROCEDURE TWindowsObject.CreateChildren;
  1405. BEGIN
  1406.      ForEach(@CreateIt);  {Create all children}
  1407. END;
  1408.  
  1409. PROCEDURE TWindowsObject.SetupWindow;
  1410. BEGIN
  1411.      CreateChildren;
  1412. END;
  1413.  
  1414.  
  1415. PROCEDURE TWindowsObject.Redraw(VAR ahps:HPS;VAR rc:RECTL);
  1416. BEGIN
  1417. END;
  1418.  
  1419. PROCEDURE TWindowsObject.WMButton1Down(VAR Msg:TMessage);
  1420. BEGIN
  1421.      Button1Down:=TRUE;
  1422. END;
  1423.  
  1424. PROCEDURE TWindowsObject.WMButton2Down(VAR Msg:TMessage);
  1425. BEGIN
  1426.      Button2Down:=TRUE;
  1427. END;
  1428.  
  1429. PROCEDURE TWindowsObject.WMButton1Up(VAR Msg:TMessage);
  1430. BEGIN
  1431.      Button1Down:=FALSE;
  1432. END;
  1433.  
  1434. PROCEDURE TWindowsObject.WMButton2Up(VAR Msg:TMessage);
  1435. BEGIN
  1436.      Button2Down:=FALSE;
  1437. END;
  1438.  
  1439. PROCEDURE TWindowsObject.WMButton1CLICK(VAR Msg:TMessage);
  1440. BEGIN
  1441.      Button1Down:=FALSE;
  1442. END;
  1443.  
  1444. PROCEDURE TWindowsObject.WMButton2CLICK(VAR Msg:TMessage);
  1445. BEGIN
  1446.      Button2Down:=FALSE;
  1447. END;
  1448.  
  1449. PROCEDURE TWindowsObject.WMButton1DBLCLK(VAR Msg:TMessage);
  1450. BEGIN
  1451.      Button1Down:=FALSE;
  1452. END;
  1453.  
  1454. PROCEDURE TWindowsObject.WMButton2DBLCLK(VAR Msg:TMessage);
  1455. BEGIN
  1456.      Button2Down:=FALSE;
  1457. END;
  1458.  
  1459. PROCEDURE TWindowsObject.WMMouseMove(VAR Msg:TMessage);
  1460. VAR
  1461.    state:LONGWORD;
  1462. BEGIN
  1463.      IF Button1Down THEN
  1464.      BEGIN
  1465.           state:=WinGetKeyState(HWND_DESKTOP,VK_BUTTON1);
  1466.           IF state AND $8000=$8000 THEN
  1467.             WinSendMsg(Msg.Receiver,WM_MOUSEDRAG1,
  1468.                        Msg.Param1,Msg.Param2)
  1469.           ELSE Button1Down:=FALSE;
  1470.      END;
  1471.      IF Button2Down THEN
  1472.      BEGIN
  1473.           state:=WinGetKeyState(HWND_DESKTOP,VK_BUTTON2);
  1474.           IF state AND $8000=$8000 THEN
  1475.             WinSendMsg(Msg.Receiver,WM_MOUSEDRAG2,
  1476.                        Msg.Param1,Msg.Param2)
  1477.           ELSE Button2Down:=FALSE;
  1478.      END;
  1479. END;
  1480.  
  1481.  
  1482. PROCEDURE TWindowsObject.WMPaint(VAR Msg:TMessage);
  1483. VAR
  1484.      rc,rc1:RECTL;
  1485.      ahps:HPS;
  1486. BEGIN
  1487.      ahps:=WinBeginPaint(HWindow,0,rc);
  1488.      IF IsFlagSet(WF_AUTOFILL) THEN
  1489.      BEGIN
  1490.           WinQueryWindowRect(HWindow,rc1);  {Fill whole window}
  1491.           WinFillRect(ahps,rc1,WinBackColor);
  1492.      END;
  1493.      Redraw(ahps,rc);
  1494.      WinEndPaint(ahps);
  1495. END;
  1496.  
  1497.  
  1498.  
  1499. {This Message occured if the Background of a window has to be redrawn}
  1500. PROCEDURE TWindowsObject.WMEraseBackGround(VAR Msg:TMessage);
  1501. BEGIN
  1502. END;
  1503.  
  1504. {This function will be called as a result of the WM_COMMAND message
  1505.  It will call the Command procedure or DefCommandProc}
  1506. PROCEDURE TWindowsObject.WMCommand(var Msg: TMessage);
  1507. BEGIN
  1508.      PerformDMTMsg(@SELF, Msg, Msg.Param1Lo,
  1509.                    TWindowsObject_DefWndProc);  {Handle it via DMT}
  1510. END;
  1511.  
  1512. {Is invoked if a WM_ACTIVATE Message was occured}
  1513. PROCEDURE TWindowsObject.WMActivate(VAR Msg: TMessage);
  1514. VAR  PrevChild:PWindowsObject;
  1515.      PrevWin:HWND;
  1516. BEGIN
  1517.      IF Msg.Param1Lo = 1 THEN {Window is being activated}
  1518.      BEGIN
  1519.           IF Parent <> NIL THEN Parent^.SetActiveChild(ObjectPtr);
  1520.      END
  1521.      ELSE {Window is being deactivated}
  1522.      BEGIN
  1523.           PrevWin := WinQueryWindow(HWindowFrame,QW_NEXT);
  1524.           PrevWin := WinWindowFromID(PrevWin,FID_CLIENT);
  1525.           PrevChild := PWindowsObject(WinQueryWindowULong(PrevWin,QWL_SELF));
  1526.           IF Parent <> NIL THEN Parent^.SetActiveChild(PrevChild);
  1527.      END;
  1528. END;
  1529.  
  1530. PROCEDURE TWindowsObject.WMDestroy(VAR Msg:TMessage);
  1531. BEGIN
  1532. END;
  1533.  
  1534. { Close the PM window by invoking CloseWindow }
  1535. PROCEDURE TWindowsObject.WMClose(var Msg: TMessage);
  1536. BEGIN
  1537.      Msg.Handled:=TRUE;
  1538.      CloseWindow;
  1539. END;
  1540.  
  1541.  
  1542. {This function returnes TRUE if window cannot be closed}
  1543. FUNCTION CannotCloseChild(achild:PWindowsObject):BOOLEAN;
  1544. BEGIN
  1545.      IF achild^.CanClose THEN CannotCloseChild:=FALSE
  1546.      ELSE CannotCloseChild:=TRUE;  {Do not close !!}
  1547. END;
  1548.  
  1549. FUNCTION TWindowsObject.CanClose:BOOLEAN;
  1550. VAR p:PWindowsObject;
  1551. BEGIN
  1552.      p:=FirstThat(@CannotCloseChild);
  1553.      IF p=NIL THEN CanClose:=TRUE
  1554.      ELSE CanClose:=FALSE;
  1555. END;
  1556.  
  1557. PROCEDURE TWindowsObject.WindowDestroyed;
  1558. BEGIN
  1559. END;
  1560.  
  1561. PROCEDURE TWindowsObject.CloseNotify;
  1562. BEGIN
  1563. END;
  1564.  
  1565. {Close the window}
  1566. PROCEDURE TWindowsObject.CloseWindow;
  1567. VAR
  1568.    Win:HWND;
  1569. BEGIN
  1570.      IF HWindow=0 THEN exit;
  1571.      Win:=WinQueryWindow(HWindow,QW_PARENT);
  1572.      IF Win=0 THEN exit;
  1573.      IF CanClose THEN
  1574.      BEGIN
  1575.           CloseNotify;
  1576.           WinDestroyWindow(Win);
  1577.           HWindow:=0;
  1578.           HWindowFrame:=0;
  1579.           WindowDestroyed;
  1580.           IF Parent<>NIL THEN
  1581.           BEGIN
  1582.                Parent^.RemoveChild(ObjectPtr);
  1583.                IF Parent^.FirstChild=NIL THEN Parent^.SetActiveChild(NIL);
  1584.                Parent:=NIL;
  1585.           END;
  1586.           IF Pointer(SELF) = Application^.MainWindow
  1587.           THEN WinPostMsg(HWindow,WM_QUIT,0,0);
  1588.      END;
  1589. END;
  1590.  
  1591. {Message Handler. All Messages come here first. Use aMsg.Handled to indicate
  1592.  whether the message was handled or not}
  1593. FUNCTION TWindowsObject.HandleEvent(Win:HWND;Msg:LONGWORD;
  1594.                                     para1,para2:POINTER):LONGWORD;
  1595. {Handles messages for the main window}
  1596. VAR
  1597.     aMsg:TMessage;
  1598.     DMTFound:BOOLEAN;
  1599. BEGIN
  1600.      aMsg.Receiver:=Win;
  1601.      aMsg.Param1:=LONGWORD(Para1);
  1602.      aMsg.Param2:=LONGWORD(Para2);
  1603.      aMsg.Message:=Msg;
  1604.      amsg.Result:=0;
  1605.      amsg.Handled:=FALSE;  {not handled yet}
  1606.      DMTFound:=FALSE;
  1607.  
  1608.      PerformDmtMsg(@SELF,amsg,Msg,TWindowsObject_DefWndProc);
  1609.      IF not aMsg.Handled THEN DefWndProc(aMsg);  {not handled}
  1610.      HandleEvent:=aMsg.result;
  1611. END;
  1612.  
  1613. {Frame Message Handler. All Messages associated with the frame window
  1614.  come here first. Use amsg.Handled to indicate if the standard handler
  1615.  should be activated }
  1616. PROCEDURE TWindowsObject.FrameHandler(VAR Msg:TMessage);
  1617. BEGIN
  1618. END;
  1619.  
  1620. PROCEDURE TWindowsObject.FrameDefProc(VAR msg:TMessage);
  1621. VAR
  1622.    p:POINTER;
  1623.    amsg:LONGWORD;
  1624.    aWin:HWND;
  1625.    apara1,apara2:LONGWORD;
  1626.    result:LONGWORD;
  1627. BEGIN
  1628.      p:=OldFrameProc;
  1629.      amsg:=msg.message;
  1630.      aWin:=msg.receiver;
  1631.      apara1:=msg.Param1;
  1632.      apara2:=msg.Param2;
  1633.      ASM
  1634.         //Call old frame handler
  1635.         PUSHL $apara2
  1636.         PUSHL $apara1
  1637.         PUSHL $aMsg
  1638.         PUSHL $aWin
  1639.         MOV AL,4
  1640.         LEA EDI,$p
  1641.         CALLN32 [EDI+0]   //--> jump to old FrameWndProc
  1642.         ADD ESP,16
  1643.         MOV $result,EAX
  1644.      END;
  1645.      msg.result:=Result;
  1646.      msg.Handled:=TRUE;
  1647. END;
  1648.  
  1649. FUNCTION TWindowsObject.FrameHandleEvent(Win:HWND;Msg:LONGWORD;
  1650.                                          para1,para2:POINTER):LONGWORD;
  1651. VAR
  1652.     result:LONGWORD;
  1653.     aMsg:TMessage;
  1654. BEGIN
  1655.      aMsg.Receiver:=Win;
  1656.      aMsg.Param1:=LONGWORD(Para1);
  1657.      aMsg.Param2:=LONGWORD(Para2);
  1658.      aMsg.Message:=Msg;
  1659.      amsg.Result:=0;
  1660.      amsg.Handled:=FALSE;  {not handled yet}
  1661.      FrameHandler(amsg);
  1662.      IF not amsg.Handled THEN FrameDefProc(amsg);
  1663.      FrameHandleEvent:=amsg.result;
  1664. END;
  1665.  
  1666. FUNCTION TheFrameHandler(Win:HWND;Msg:LONGWORD;
  1667.                          para1,para2:POINTER):LONGWORD;CDECL;
  1668. VAR p:POINTER;
  1669.     ClientWin:HWND;
  1670.     VMT:LONGWORD;
  1671. BEGIN
  1672.      ClientWin:=WinWindowFromID(Win,FID_CLIENT);
  1673.      IF ClientWin=0 THEN Exit;
  1674.      VMT:=WinQueryWindowULong(ClientWin,0);
  1675.      ASM
  1676.         //Call FrameWndProc Method
  1677.         PUSHL $Win
  1678.         PUSHL $Msg
  1679.         PUSHL $Para1
  1680.         PUSHL $Para2
  1681.         PUSHL $VMT
  1682.         MOV EDI,$VMT
  1683.         MOV EDI,[EDI+0]      //VMT Index for FrameHandleEvent
  1684.         MOV EAX,7            //FrameWndProc=7
  1685.         CALLN32 [EDI+EAX*4]  //--> jump to Method FrameHandle
  1686.         MOV $!FUNCRESULT,EAX //Function result
  1687.      END;
  1688. END;
  1689.  
  1690. {Call the standard window procedure}
  1691. PROCEDURE TWindowsObject.DefWndProc(var Msg: TMessage);
  1692. BEGIN
  1693.      Msg.Result:=WinDefWindowProc(Msg.Receiver,Msg.Message,
  1694.                                   Msg.Param1,Msg.Param2);
  1695.      Msg.Handled:=TRUE;
  1696. END;
  1697.  
  1698. {Enable the Window}
  1699. FUNCTION TWindowsObject.Enable: Boolean;
  1700. BEGIN
  1701.      IF HWindow <> 0 then Enable := BOOLEAN(WinEnableWindow(HWindow,TRUE))
  1702.      ELSE Enable := False;
  1703. END;
  1704.  
  1705. { Disable the window }
  1706. FUNCTION TWindowsObject.Disable: Boolean;
  1707. BEGIN
  1708.      IF HWindow <> 0 THEN Disable := BOOLEAN(WinEnableWindow(HWindow,FALSE))
  1709.      ELSE Disable := False;
  1710. END;
  1711.  
  1712. { Focus the window }
  1713. PROCEDURE TWindowsObject.Focus;
  1714. BEGIN
  1715.      IF HWindow <> 0 THEN
  1716.        IF HWindow<>WinQueryFocus(HWND_DESKTOP) THEN
  1717.           WinSetFocus(HWND_DESKTOP,HWindow);
  1718. END;
  1719.  
  1720.  
  1721. PROCEDURE TWindowsObject.Capture(Clear:BOOLEAN);
  1722. BEGIN
  1723.      IF Clear THEN WinSetCapture(HWND_DESKTOP,0)
  1724.      ELSE WinSetCapture(HWND_DESKTOP,HWindow);
  1725. END;
  1726.  
  1727. {*************************************************************************
  1728.  *                                                                       *
  1729.  *  Object TWindow                                                       *
  1730.  *                                                                       *
  1731.  *************************************************************************}
  1732.  
  1733. CONSTRUCTOR TWindow.Init(AParent: PWindowsObject; ATitle:STRING);
  1734. VAR rc:RECTL;
  1735. BEGIN
  1736.      TWindowsObject.Init(AParent);
  1737.      WITH Attr DO
  1738.      BEGIN
  1739.           FontName:=''; {Standard}
  1740.           FontWidth:=16;
  1741.           FontHeight:=16;
  1742.           FontNameSize:=''; {Standard}
  1743.           Title:=ATitle;
  1744.           Style:=0;
  1745.           FrameFlags:=FCF_TASKLIST OR FCF_MINMAX OR FCF_SIZEBORDER OR
  1746.                       FCF_TITLEBAR OR FCF_SYSMENU;
  1747.           IF Parent=NIL THEN {Shellposition}
  1748.           BEGIN
  1749.                FrameFlags:=FrameFlags OR FCF_SHELLPOSITION;
  1750.                X:=0;
  1751.                Y:=0;
  1752.                W:=0;
  1753.                H:=0;
  1754.           END
  1755.           ELSE
  1756.           BEGIN
  1757.                FrameFlags:=FrameFlags OR FCF_NOBYTEALIGN;
  1758.                WinQueryWindowRect(AParent^.HWindow,rc);
  1759.                X:=rc.XLeft;
  1760.                Y:=rc.YBottom;
  1761.                W:=rc.XRight-rc.XLeft;
  1762.                H:=rc.YTop-Rc.YBottom;
  1763.           END;
  1764.           ResourceId:=0;
  1765.           ResourceModule:=DllModule;
  1766.           WindowId:=0;
  1767.           HasMenu := FALSE;
  1768.           HasIcon := FALSE;
  1769.           HasAccelTable:= FALSE;
  1770.           HasHelp := FALSE;
  1771.           HelpFileName:='';
  1772.           HelpWindowTitle:='';
  1773.      END;
  1774.      StatusBarSize:=0; {We don't have any Statusbar}
  1775.      RedrawExclusive:=FALSE;
  1776.      ToolBarSize:=0;   {We don't have any Toolbar}
  1777.      LeftToolBarSize:=0;
  1778.      RightToolBarSize:=0;
  1779.      DesktopWin:=NIL;
  1780.      ToolBarInterior:=NIL;
  1781.      StatusBarInterior:=NIL;
  1782.      MenuHelpItems:=NIL;
  1783.      StatusBarFontName:='System Proportional';
  1784.      StatusBarFontHeight:=10;
  1785.      StatusBarFontWidth:=5;
  1786.      StatusBarFontFlags:=0;
  1787.      StatusBarTextBaseLine := 6;
  1788.      HelpWindow:=0;
  1789.      SetFlags(WF_TILEONSIZE,FALSE);
  1790.      SetFlags(WF_SCALECHILDS,TRUE);
  1791. END;
  1792.  
  1793. PROCEDURE TWindow.InitWindowHelp(HelpFileName,HelpTitle:STRING);
  1794. BEGIN
  1795.      Attr.HasHelp:=TRUE;
  1796.      Attr.HelpFileName:=HelpFileName;
  1797.      Attr.HelpWindowTitle:=HelpTitle;
  1798.      PmHelp.HelpFilename:=HelpFileName;
  1799.      PmHelp.HelpWindowTitle:=HelpTitle;
  1800. END;
  1801.  
  1802.  
  1803.  
  1804. PROCEDURE TWindow.CloseNotify;
  1805. BEGIN
  1806.      Inherited CloseNotify;
  1807.      IF HelpWindow<>0 THEN WinDestroyHelpInstance(HelpWindow);
  1808. END;
  1809.  
  1810. PROCEDURE TWindow.WMTranslateAccel(VAR msg:TMessage);
  1811. VAR apqmsg:^QMSG;
  1812.     fsflags:BYTE;
  1813.     virtkey:WORD;
  1814. BEGIN
  1815.      IF not IsFlagSet(WF_ISDESKTOP) THEN exit;
  1816.      IF Parent=NIL THEN exit;
  1817.      apqmsg:=POINTER(msg.param1);
  1818.      fsflags := lo(apqmsg^.mp1);
  1819.      virtkey := hi(apqmsg^.mp2);
  1820.      IF fsflags AND KC_VIRTUALKEY <> 0 THEN
  1821.      BEGIN
  1822.           IF virtkey=VK_F10 THEN
  1823.           BEGIN
  1824.                apqmsg^.hwnd:=Parent^.HWindow;
  1825.                msg.result:=WinSendMsg(Parent^.HWindow,WM_TRANSLATEACCEL,
  1826.                                       msg.param1,msg.param2);
  1827.                msg.handled:=TRUE;
  1828.           END
  1829.           ELSE DefWndProc(msg);
  1830.      END
  1831.      ELSE DefWndProc(msg);
  1832. END;
  1833.  
  1834. {Show the Window}
  1835. PROCEDURE TWindow.Show(ShowCmd:LONGWORD);
  1836. BEGIN
  1837.      IF HWindow <> 0 THEN WinShowWindow(HWindow, BOOLEAN(ShowCmd));
  1838. END;
  1839.  
  1840. PROCEDURE TWindow.SetPosition;
  1841. BEGIN
  1842.      IF HWindow<>0 THEN
  1843.      BEGIN
  1844.          IF ((Attr.W=Width_Max)OR(Attr.H=Height_Max)) THEN
  1845.             WinSetWindowPos(HWindowFrame,HWND_TOP,0,0,0,0,
  1846.                             SWP_MAXIMIZE OR SWP_ACTIVATE OR SWP_SHOW)
  1847.          ELSE WinSetWindowPos(HWindowFrame,HWND_TOP,Attr.X,Attr.Y,Attr.W,
  1848.                               Attr.H,SWP_SIZE OR SWP_MOVE OR SWP_ACTIVATE
  1849.                               OR SWP_SHOW);
  1850.      END;
  1851. END;
  1852.  
  1853.  
  1854. PROCEDURE TWindow.SetupWindow;
  1855. BEGIN
  1856.      Inherited.SetupWindow;
  1857.      IF Attr.w>0 THEN SetPosition
  1858.      ELSE WinShowWindow(HWindowFrame,TRUE);
  1859.      Focus;
  1860. END;
  1861.  
  1862.  
  1863. PROCEDURE TWindow.WMMove(VAR Msg:TMessage);
  1864. BEGIN
  1865.      IF NOT IsWindowMinimized(HWindowFrame)
  1866.      THEN GetWindowPos(HWindowFrame,Attr.X,Attr.Y,Attr.W,Attr.H);
  1867. END;
  1868.  
  1869.  
  1870. PROCEDURE PosChild(Child:PWindow);
  1871. VAR aswp : SWP;
  1872.     rec : SWP;
  1873.     nx,ny : LONGINT;
  1874.     ncx,ncy : LONGINT;
  1875.     locScalX,locScalY : Extended;
  1876. BEGIN
  1877.      IF IsWindowMinimized(Child^.HWindowFrame) THEN exit;
  1878.      IF (ScalX = 0) OR (ScalY = 0) THEN exit; {Restore from Minimize}
  1879.  
  1880.      locScalX := ScalX;    {Save global Scale_ because of recursion}
  1881.      locScalY := ScalY;
  1882.      IF Child^.Parent = NIL THEN
  1883.      BEGIN
  1884.           aswp.cx := WinQuerySysValue(HWND_DESKTOP,SV_CXSCREEN);
  1885.           aswp.cy := WinQuerySysValue(HWND_DESKTOP,SV_CYSCREEN);
  1886.      END
  1887.      ELSE WinQueryWindowPos(Child^.Parent^.HWindow,aswp);
  1888.      WinQueryWindowPos(Child^.HWindowFrame,rec);
  1889.  
  1890.      nx := round(ScalX * rec.x);
  1891.      ncx := round(ScalX * rec.cx);
  1892.      IF IsWindowMaximized(Child^.HWindowFrame)
  1893.      THEN inc(aswp.cx,WinQuerySysValue(HWND_DESKTOP,SV_CXSIZEBORDER));
  1894.      IF nx + ncx > aswp.cx THEN ncx := aswp.cx - nx;
  1895.      IF ncx <= 0 THEN ncx := aswp.cx;
  1896.  
  1897.      ny := round(ScalY * rec.y);
  1898.      ncy := round(ScalY * rec.cy);
  1899.      IF IsWindowMaximized(Child^.HWindowFrame)
  1900.      THEN inc(aswp.cy,WinQuerySysValue(HWND_DESKTOP,SV_CYSIZEBORDER));
  1901.      IF ny + ncy > aswp.cy THEN ncy := aswp.cy - ny;
  1902.      IF ncy <= 0 THEN ncy := aswp.cy;
  1903.  
  1904.      WinSetWindowPos(Child^.HWindowFrame,0, nx, ny, ncx, ncy,
  1905.                      SWP_SIZE OR SWP_MOVE);
  1906.      ScalX := locScalX;
  1907.      ScalY := locScalY;
  1908. END;
  1909.  
  1910.  
  1911. PROCEDURE TWindow.WMSize(VAR Msg:TMessage);
  1912. VAR aswp : SWP;
  1913.     scxold,scyold : LONGINT;
  1914.     scxnew,scynew : LONGINT;
  1915. BEGIN
  1916.      Inherited.WMSize(Msg);
  1917.  
  1918.      IF NOT IsFlagSet(WF_ISDESKTOP) THEN
  1919.      BEGIN
  1920.           {Window size itself}
  1921.           {Window can have at least a maximum size of its parent}
  1922.           ScalX := 1;
  1923.           ScalY := 1;
  1924.           PosChild(ObjectPtr);
  1925.      END;
  1926.  
  1927.      IF NOT IsWindowMinimized(HWindowFrame)
  1928.      THEN GetWindowPos(HWindowFrame,Attr.X,Attr.Y,Attr.W,Attr.H);
  1929.  
  1930.      IF NOT IsFlagSet(WF_TILEONSIZE) THEN
  1931.      BEGIN
  1932.           IF IsFlagSet(WF_SCALECHILDS) THEN
  1933.             IF NOT IsFlagSet(WF_WITHDESKTOP) THEN
  1934.               IF NOT IsWindowMinimized(HWindowFrame) THEN
  1935.               BEGIN
  1936.                    scxold := Msg.Param1Lo;
  1937.                    scyold := Msg.Param1Hi;
  1938.                    scxnew := Msg.Param2Lo;
  1939.                    scynew := Msg.Param2Hi;
  1940.  
  1941.                    IF scxold = 0 THEN ScalX := 0
  1942.                    ELSE ScalX := scxnew / scxold;
  1943.  
  1944.                    IF scyold = 0 THEN ScalY := 0
  1945.                    ELSE ScalY := scynew / scyold;
  1946.                    ForEach(@PosChild);
  1947.               END;
  1948.      END
  1949.      ELSE WinSendMsg(Msg.Receiver,WM_COMMAND,CM_FIRST+CM_TILE,0);
  1950.  
  1951.      IF IsFlagSet(WF_WITHDESKTOP) THEN
  1952.      BEGIN
  1953.           IF DesktopWin <> NIL THEN
  1954.           BEGIN
  1955.                GetDesktopLimits(aswp);
  1956.                WinSetWindowPos(DesktopWin^.HWindowFrame,0,
  1957.                                aswp.x,aswp.y,aswp.cx,aswp.cy,
  1958.                                SWP_SIZE OR SWP_MOVE OR SWP_SHOW);
  1959.           END;
  1960.      END;
  1961. END;
  1962.  
  1963.  
  1964. PROCEDURE TWindow.GetDesktopLimits(VAR aswp:SWP);
  1965. VAR rc:RECTL;
  1966. BEGIN
  1967.      WinQueryWindowRect(HWindow,rc);
  1968.      aswp.x:=rc.xleft;
  1969.      aswp.cx:=rc.xright-rc.xleft;
  1970.      aswp.y:=rc.yBottom;
  1971.      aswp.cy:=rc.yTop-rc.yBottom;
  1972.  
  1973.      dec(aswp.cy,ToolBarSize);
  1974.      inc(aswp.y,StatusBarSize);
  1975.      dec(aswp.cy,StatusBarSize);
  1976.  
  1977.      dec(aswp.cx,RightToolBarSize);
  1978.      inc(aswp.x,LeftToolBarSize);
  1979.      dec(aswp.cx,LeftToolBarSize);
  1980. END;
  1981.  
  1982.  
  1983. PROCEDURE TWindow.HandleToolBarEvent(VAR Msg:TMessage;Control:PToolBarInterior);
  1984. VAR
  1985.    mdummy:PMenuHelpItems;
  1986.    w,w1:LONGWORD;
  1987.    Status:PStatusBarInterior;
  1988. LABEL l;
  1989. BEGIN
  1990.      CASE Msg.Message OF
  1991.          WM_Button1Down:
  1992.          BEGIN
  1993.               IF StatusBarSize=0 THEN goto l;
  1994.               w:=Control^.id;
  1995.               w1:=0;
  1996.               mdummy:=MenuHelpItems;
  1997.               WHILE mdummy<>NIL DO
  1998.               BEGIN
  1999.                    IF mdummy^.MenuID=65535 THEN w1:=mdummy^.StatusID;
  2000.                    IF mdummy^.MenuID=w THEN
  2001.                    BEGIN
  2002.                         w1:=mdummy^.StatusID;
  2003.                         Status:=StatusBarInterior;
  2004.                         WHILE Status<>NIL DO
  2005.                         BEGIN
  2006.                             IF Status^.ID=w1 THEN
  2007.                             BEGIN
  2008.                                 StatusBarSetText(w1,mdummy^.HelpText,
  2009.                                                  mdummy^.Col);
  2010.                                 exit;
  2011.                             END;
  2012.                             Status:=Status^.Next;
  2013.                         END;
  2014.                         goto l;
  2015.                    END;
  2016.                    mdummy:=mdummy^.Next;
  2017.               END;
  2018.          END;
  2019.          WM_Button1Up:
  2020.          BEGIN
  2021.               IF StatusBarSize=0 THEN goto l;
  2022.               mdummy:=MenuHelpItems;
  2023.               WHILE mdummy<>NIL DO
  2024.               BEGIN
  2025.                    IF mdummy^.MenuID=65535 THEN  {Clear it}
  2026.                    BEGIN
  2027.                         StatusBarSetText(mdummy^.StatusID,mdummy^.HelpText,
  2028.                                          mdummy^.Col);
  2029.                         goto l;
  2030.                    END;
  2031.                    mdummy:=mdummy^.Next;
  2032.               END;
  2033.          END;
  2034.     END; {case}
  2035. l:
  2036. END;
  2037.  
  2038. FUNCTION ToolBarWndProc(Win:HWND;Msg:ULONG;Para1,Para2:ULONG):ULONG;CDECL;
  2039. VAR dummy:PToolBarInterior;
  2040.     Message:TMessage;
  2041.     ObjectWindow:PWindow;
  2042.     r:ULONG;
  2043.     p:POINTER;
  2044. LABEL l1,l2,ex,l3,l4;
  2045. BEGIN
  2046.      ObjectWindow:=POINTER(Application^.MainWindow);
  2047.  
  2048.      dummy:=NIL;
  2049.      IF ObjectWindow=NIL THEN goto l3;
  2050.      dummy:=ObjectWindow^.ToolBarInterior;
  2051.      WHILE dummy<>NIL DO
  2052.      BEGIN
  2053.           IF dummy^.Win=Win THEN goto l3;
  2054.           dummy:=dummy^.next;
  2055.      END;
  2056. l3:
  2057.      CASE Msg OF
  2058.          WM_Button1Down,WM_Button1Up:
  2059.          BEGIN
  2060.               IF dummy<>NIL THEN goto l1
  2061.               ELSE goto l2;
  2062.          END;
  2063.          ELSE
  2064.          BEGIN
  2065. l2:
  2066.               IF dummy=NIL THEN
  2067.               BEGIN
  2068.                   r:=WinDefWindowProc(Win,msg,para1,para2);
  2069.                   goto ex;
  2070.               END
  2071.               ELSE goto l4;
  2072.          END;
  2073.      END; {case}
  2074. l1:
  2075.      Message.Message:=msg;
  2076.      Message.Receiver:=Win;
  2077.      Message.Handled:=FALSE;
  2078.      Message.param1:=para1;
  2079.      Message.param2:=para2;
  2080.      Message.Result:=0;
  2081.      ObjectWindow^.HandleToolBarEvent(Message,dummy);
  2082.      IF Message.Handled THEN
  2083.      BEGIN
  2084.           r:=Message.result;
  2085.           goto ex;
  2086.      END;
  2087. l4:
  2088.      r:=dummy^.OldWndProc(Win,Msg,Para1,Para2);
  2089. ex:
  2090.      ToolBarWndProc:=r;
  2091. END;
  2092.  
  2093. PROCEDURE TWindow.ToolBarInsertControl(id,x,y,cx,cy,flag,aclass:LONGWORD;
  2094.                                        title:STRING);
  2095. VAR
  2096.     Win:HWND;
  2097.     dummy:PToolBarInterior;
  2098.     ctitle:CSTRING;
  2099. BEGIN
  2100.      ctitle:=title;
  2101.      Win:=WinCreateWCWindow(HWindow,aclass,ctitle,Flag,x,y,cx,cy,HWindow,
  2102.                             HWND_TOP,id,NIL,NIL);
  2103.      IF ToolBarInterior=NIL THEN
  2104.      BEGIN
  2105.           New(ToolBarInterior);
  2106.           dummy:=ToolBarInterior;
  2107.      END
  2108.      ELSE
  2109.      BEGIN
  2110.           dummy:=ToolBarInterior;
  2111.           WHILE dummy^.Next<>NIL do dummy:=dummy^.next;
  2112.           new(dummy^.next);
  2113.           dummy:=dummy^.next;
  2114.      END;
  2115.      dummy^.Win:=Win;
  2116.      dummy^.id:=id;
  2117.      dummy^.x:=x;
  2118.      dummy^.y:=y;
  2119.      dummy^.cx:=cx;
  2120.      dummy^.cy:=cy;
  2121.      dummy^.Next:=NIL;
  2122.      IF dummy^.Win<>0 THEN
  2123.      BEGIN
  2124.           {WinSetWindowULong(dummy^.Win,QWL_USER,LONGWORD(ObjectPtr));}
  2125.           dummy^.OldWndProc:=WinSubClassWindow(Dummy^.Win,@ToolBarWndProc);
  2126.      END;
  2127. END;
  2128.  
  2129. PROCEDURE TWindow.ToolBarSetButtonState(id:LONGWORD;Enabled:BOOLEAN);
  2130. VAR
  2131.     dummy:PToolBarInterior;
  2132. LABEL l;
  2133. BEGIN
  2134.      IF ToolBarSize=0 THEN exit;
  2135.      dummy:=ToolBarInterior;
  2136.      WHILE dummy<>NIL DO
  2137.      BEGIN
  2138.           IF dummy^.id=id THEN goto l;
  2139.           dummy:=dummy^.next;
  2140.      END;
  2141.      exit;
  2142. l:
  2143.      IF Enabled THEN WinEnableWindow(dummy^.Win,TRUE)
  2144.      ELSE WinEnableWindow(dummy^.Win,FALSE)
  2145. END;
  2146.  
  2147. PROCEDURE TWindow.ToolBarSetButtonText(id:LONGWORD;name:STRING);
  2148. VAR
  2149.     dummy:PToolBarInterior;
  2150.     title:Cstring;
  2151.     aclass:LONGWORD;
  2152.     flag:LONGWORD;
  2153. LABEL l;
  2154. BEGIN
  2155.      IF ToolBarSize=0 THEN exit;
  2156.      dummy:=ToolBarInterior;
  2157.      WHILE dummy<>NIL DO
  2158.      BEGIN
  2159.           IF dummy^.id=id THEN goto l;
  2160.           dummy:=dummy^.next;
  2161.      END;
  2162.      exit;
  2163. l:
  2164.      WinDestroyWindow(dummy^.Win);
  2165.      title:=Name;
  2166.      aClass:=WC_BUTTON;
  2167.      IF title[0]='#' THEN Flag:=BS_NOPOINTERFOCUS OR BS_BITMAP
  2168.      ELSE Flag:=0;
  2169.      Dummy^.Win:=WinCreateWCWindow(HWindow,aclass,title,Flag,dummy^.x,
  2170.                  dummy^.y,dummy^.cx,dummy^.cy,HWindow,
  2171.                  HWND_TOP,dummy^.id,NIL,NIL);
  2172.      IF dummy^.Win<>0 THEN
  2173.      BEGIN
  2174.           {WinSetWindowULong(dummy^.Win,QWL_USER,LONGWORD(ObjectPtr));}
  2175.           dummy^.OldWndProc:=WinSubClassWindow(Dummy^.Win,@ToolBarWndProc);
  2176.      END;
  2177. END;
  2178.  
  2179. FUNCTION TWindow.GetToolBarControl(id:LONGWORD):PToolBarInterior;
  2180. VAR dummy:PToolBarInterior;
  2181.     result:PToolBarInterior;
  2182. LABEL l;
  2183. BEGIN
  2184.      result:=NIL;
  2185.      dummy:=ToolBarInterior;
  2186.      WHILE dummy<>NIL DO
  2187.      BEGIN
  2188.           IF dummy^.id=id THEN
  2189.           BEGIN
  2190.                result:=dummy;
  2191.                goto l;
  2192.           END;
  2193.           dummy:=dummy^.next;
  2194.      END;
  2195. l:
  2196.      GetToolBarControl:=result;
  2197. END;
  2198.  
  2199. PROCEDURE TWindow.ToolBarInsertButton(id,res,x,y,cx,cy:LONGWORD);
  2200. VAR
  2201.     title:string;
  2202.     aclass:LONGWORD;
  2203.     flag:LONGWORD;
  2204. BEGIN
  2205.      IF res<>0 THEN title:='#'+tostr(res)
  2206.      ELSE title:='';
  2207.      aClass:=WC_BUTTON;
  2208.      IF res=0 THEN Flag:=0  {No Bitmap}
  2209.      ELSE Flag:=BS_NOPOINTERFOCUS OR BS_BITMAP;
  2210.      ToolBarInsertControl(id,x,y,cx,cy,Flag,aClass,title);
  2211. END;
  2212.  
  2213.  
  2214. PROCEDURE TWindow.CreateToolBar(Size:WORD);
  2215. BEGIN
  2216.      ToolBarSize:=Size;
  2217.      ToolBarColor:=CLR_PALEGRAY;
  2218. END;
  2219.  
  2220. PROCEDURE TWindow.CreateStatusBar(Size:WORD);
  2221. BEGIN
  2222.      StatusBarSize:=Size;
  2223.      StatusBarColor:=CLR_PALEGRAY;
  2224. END;
  2225.  
  2226. PROCEDURE TWindow.Redraw(VAR ahps:HPS;VAR rc:RECTL);
  2227. BEGIN
  2228.      Inherited.Redraw(ahps,rc);
  2229.      RedrawToolBar(ahps);
  2230.      RedrawStatusBar(ahps);
  2231. END;
  2232.  
  2233. PROCEDURE TWindow.RedrawToolBar(ahps:HPS);
  2234. VAR
  2235.    aswp:SWP;
  2236.    rc:RECTL;
  2237.    xpos,ypos:LONGINT;
  2238.    dummy:PToolBarInterior;
  2239. BEGIN
  2240.      IF ToolBarSize=0 THEN exit;
  2241.      GetDesktopLimits(aswp);
  2242.      rc.xleft:=aswp.x;
  2243.      rc.xright:=rc.xleft+aswp.cx;
  2244.      rc.yBottom:=aswp.y+aswp.cy;
  2245.      rc.yTop:=rc.yBottom+ToolBarSize;
  2246.      WinFillRect(ahps,rc,ToolBarColor);
  2247.      WinDrawBorder(ahps,rc,1,1,CLR_DARKGRAY,CLR_WHITE,$800);
  2248.  
  2249.      dummy:=ToolBarInterior;
  2250.      xpos:=rc.xleft;
  2251.      ypos:=rc.yBottom;
  2252.      WHILE dummy<>NIL DO
  2253.      BEGIN
  2254.          WinSetWindowPos(dummy^.Win,HWND_TOP,xpos+dummy^.X,ypos+Dummy^.y,
  2255.                        dummy^.cx,dummy^.cy,SWP_SIZE OR SWP_MOVE OR SWP_SHOW);
  2256.          dummy:=dummy^.next;
  2257.      END;
  2258. END;
  2259.  
  2260. FUNCTION TWindow.StatusBarInsertItem(id:WORD;x,y,cx,cy:LONGWORD;
  2261.                           Exclusive:BOOLEAN):PStatusBarInterior;
  2262. VAR
  2263.    dummy:PStatusBarInterior;
  2264. BEGIN
  2265.      IF StatusBarInterior=NIL THEN
  2266.      BEGIN
  2267.           New(StatusBarInterior);
  2268.           dummy:=StatusBarInterior;
  2269.      END
  2270.      ELSE
  2271.      BEGIN
  2272.           dummy:=StatusBarInterior;
  2273.           WHILE dummy^.Next<>NIL do dummy:=dummy^.next;
  2274.           new(dummy^.next);
  2275.           dummy:=dummy^.next;
  2276.      END;
  2277.      dummy^.id:=id;
  2278.      dummy^.x:=x;
  2279.      dummy^.y:=y;
  2280.      dummy^.cx:=cx;
  2281.      dummy^.cy:=cy;
  2282.      dummy^.item:='';
  2283.      dummy^.Next:=NIL;
  2284.      dummy^.Col:=CLR_BLACK;
  2285.      dummy^.Exclusive:=Exclusive;
  2286.      StatusBarInsertItem:=dummy;
  2287. END;
  2288.  
  2289. PROCEDURE TWindow.StatusBarSetText(id:WORD;item:STRING;Col:LONGINT);
  2290. VAR
  2291.    dummy:PStatusBarInterior;
  2292.    FaceName:String;
  2293.    ahps:HPS;
  2294.    rc:rectl;
  2295.    pt:POINTL;
  2296.    aswp:SWP;
  2297. LABEL l;
  2298. BEGIN
  2299.      dummy:=StatusBarInterior;
  2300.      WHILE dummy<>NIL DO
  2301.      BEGIN
  2302.           IF dummy^.id=id THEN
  2303.           BEGIN
  2304.                dummy^.Col:=Col;
  2305.                IF dummy^.item=item THEN exit;
  2306.                dummy^.item:=item;
  2307.  
  2308.                ahps:=WinGetPS(HWindow);
  2309.  
  2310.                IF RedrawExclusive THEN IF dummy^.Exclusive=FALSE THEN
  2311.                BEGIN
  2312.                     RedrawExclusive:=FALSE;
  2313.                     RedrawStatusBar(ahps);
  2314.                     goto l;
  2315.                END;
  2316.  
  2317.                IF dummy^.Exclusive THEN IF RedrawExclusive=FALSE THEN
  2318.                BEGIN
  2319.                     RedrawExclusive:=TRUE;
  2320.                     RedrawStatusBar(ahps);
  2321.                     goto l;
  2322.                END;
  2323.  
  2324.                IF dummy^.Exclusive THEN IF RedrawExclusive THEN
  2325.                IF dummy^.item='' THEN
  2326.                BEGIN
  2327.                     RedrawExclusive:=FALSE;
  2328.                     RedrawStatusBar(ahps);
  2329.                     goto l;
  2330.                END;
  2331.  
  2332.                CreateLogFont(ahps,StatusBarFontName,StatusBarFontHeight,
  2333.                              StatusBarFontWidth,StatusBarFontFlags);
  2334.                GpiSetBackMix(ahps,2);
  2335.                rc.xleft:=dummy^.x+2;
  2336.                rc.yBottom:=dummy^.y+2;
  2337.                rc.xright:=dummy^.x+dummy^.cx;
  2338.                IF dummy^.cx=0 THEN
  2339.                BEGIN
  2340.                     GetDesktopLimits(aswp);
  2341.                     IF dummy^.exclusive THEN rc.xleft:=7;
  2342.                     rc.xright:=aswp.cx-5;
  2343.                END;
  2344.  
  2345.                IF dummy^.Exclusive THEN RedrawExclusive:=TRUE
  2346.                ELSE RedrawExclusive:=FALSE;
  2347.  
  2348.                dec(rc.xright,2);
  2349.                rc.yTop:=dummy^.y+dummy^.cy;
  2350.                dec(rc.ytop,2);
  2351.                WinFillRect(ahps,rc,StatusBarColor);
  2352.                pt.x:=dummy^.x+2;
  2353.                pt.y:=dummy^.y + StatusBarTextBaseLine;
  2354.                IF dummy^.item<>'' THEN DrawStringXY(ahps,pt,dummy^.item,
  2355.                               1,length(dummy^.item),dummy^.Col,
  2356.                                StatusBarColor);
  2357. l:
  2358.                WinReleasePS(ahps);
  2359.                exit;
  2360.           END;
  2361.           dummy:=dummy^.next;
  2362.      END;
  2363. END;
  2364.  
  2365.  
  2366. PROCEDURE TWindow.InsertMenuHelp(StatusID,MenuID:WORD;
  2367.                                  HelpText:String;Col:LONGWORD);
  2368. VAR
  2369.    dummy:PMenuHelpItems;
  2370. BEGIN
  2371.      IF MenuHelpItems=NIL THEN
  2372.      BEGIN
  2373.           New(MenuHelpItems);
  2374.           dummy:=MenuHelpItems;
  2375.      END
  2376.      ELSE
  2377.      BEGIN
  2378.           dummy:=MenuHelpItems;
  2379.           WHILE dummy^.Next<>NIL DO dummy:=dummy^.next;
  2380.           New(dummy^.Next);
  2381.           dummy:=dummy^.Next;
  2382.      END;
  2383.      dummy^.StatusID:=StatusID;
  2384.      dummy^.MenuID:=MenuID;
  2385.      dummy^.Col:=Col;
  2386.      dummy^.HelpText:=Helptext;
  2387.      dummy^.Next:=NIL;
  2388. END;
  2389.  
  2390. PROCEDURE TWindow.SetMenuState(id:WORD;State:BOOLEAN);
  2391. VAR
  2392.    HwndMenu:HWND;
  2393.    w,w1:WORD;
  2394.    p,p1:LONGWORD;
  2395. BEGIN
  2396.      HwndMenu:=WinWindowFromID(HWindowFrame,FID_MENU);
  2397.      IF HwndMenu=0 THEN exit;
  2398.      p:=MPFROM2SHORT(id,1);
  2399.      w:=MIA_DISABLED;
  2400.      IF State=FALSE THEN w1:=MIA_DISABLED
  2401.      ELSE w1:=0;  {Enabled}
  2402.      p1:=MPFROM2SHORT(w,w1);
  2403.      WinSendMsg(HwndMenu,MM_SETITEMATTR,p,p1);
  2404.      ToolBarSetButtonState(id,State);
  2405. END;
  2406.  
  2407.  
  2408. PROCEDURE TWindow.SetupMenu;
  2409. BEGIN
  2410.      Attr.Menu:=WinWindowFromID(HWindowFrame,FID_MENU);
  2411. END;
  2412.  
  2413. PROCEDURE TWindow.RedrawStatusBar(ahps:HPS);
  2414. VAR
  2415.    aswp:SWP;
  2416.    rc,rc1:RECTL;
  2417.    pt:POINTL;
  2418.    dummy:PStatusBarInterior;
  2419. BEGIN
  2420.      IF StatusBarSize=0 THEN exit;
  2421.      GetDesktopLimits(aswp);
  2422.      rc.xleft:=aswp.x;
  2423.      rc.xright:=rc.xleft+aswp.cx;
  2424.      rc.yTop:=aswp.y;
  2425.      rc.yBottom:=rc.yTop-StatusBarSize;
  2426.      WinFillRect(ahps,rc,StatusBarColor);
  2427.      WinDrawBorder(ahps,rc,1,1,CLR_DARKGRAY,CLR_WHITE,$800);
  2428.  
  2429.      CreateLogFont(ahps,StatusBarFontName,StatusBarFontHeight,
  2430.                    StatusBarFontWidth,StatusBarFontFlags); {default font}
  2431.      GpiSetBackMix(ahps,2);  {BM_OverPaint}
  2432.  
  2433.      IF RedrawExclusive THEN
  2434.      BEGIN
  2435.           dummy:=StatusBarInterior;
  2436.           WHILE dummy<>NIL DO
  2437.           BEGIN
  2438.               IF dummy^.Exclusive THEN
  2439.               BEGIN
  2440.                   rc1.xleft:=5;
  2441.                   rc1.yBottom:=dummy^.y;
  2442.                   rc1.xright:=rc.xright-5;
  2443.                   rc1.yTop:=dummy^.y+dummy^.cy;
  2444.                      WinDrawBorder(ahps,rc1,1,1,CLR_DARKGRAY,CLR_WHITE,$800);
  2445.  
  2446.                   pt.x:=7;
  2447.                   pt.y:=dummy^.y + StatusBarTextBaseLine;
  2448.                   IF dummy^.item<>'' THEN DrawStringXY(ahps,pt,dummy^.item,
  2449.                                            1,length(dummy^.item),dummy^.Col,
  2450.                                            StatusBarColor);
  2451.                   exit;
  2452.               END;
  2453.               dummy:=dummy^.next;
  2454.           END;
  2455.      END;
  2456.  
  2457.      dummy:=StatusBarInterior;
  2458.      WHILE dummy<>NIL DO
  2459.      BEGIN
  2460.           IF dummy^.Exclusive=FALSE THEN
  2461.           BEGIN
  2462.               rc1.xleft:=dummy^.x;
  2463.               rc1.yBottom:=dummy^.y;
  2464.               rc1.xright:=dummy^.x+dummy^.cx;
  2465.               rc1.yTop:=dummy^.y+dummy^.cy;
  2466.               IF dummy^.cx=0 THEN rc1.xright:=rc.xright-5;
  2467.               WinDrawBorder(ahps,rc1,1,1,CLR_DARKGRAY,CLR_WHITE,$800);
  2468.  
  2469.               pt.x:=dummy^.x+2;
  2470.               pt.y:=dummy^.y + StatusBarTextBaseLine;
  2471.               IF dummy^.item<>'' THEN DrawStringXY(ahps,pt,dummy^.item,
  2472.                                   1,length(dummy^.item),dummy^.Col,
  2473.                                         StatusBarColor);
  2474.           END;
  2475.           dummy:=dummy^.next;
  2476.      END;
  2477. END;
  2478.  
  2479.  
  2480.  
  2481. {Call Constructor for the Desktop Window. Overwrite this method
  2482.  if you want to use a new object for the Desktop Window.
  2483.  This Object must be a child of TWindow}
  2484. FUNCTION TWindow.InitializeDesktop(ParentWin:PWindowsObject):PWindow;
  2485. BEGIN
  2486.      InitializeDesktop:=NIL;  {Standard}
  2487. END;
  2488.  
  2489. PROCEDURE TWindow.SetupDesktop;
  2490. VAR
  2491.    WndClass:TWndClass;
  2492.    fr:LONGWORD;
  2493.    name:CSTRING;
  2494.    cClassName:CSTRING;
  2495.    aswp:SWP;
  2496.    AParentWin:PWindowsObject;
  2497. LABEL l;
  2498. BEGIN
  2499.      IF ToolBarSize=0 THEN IF StatusBarSize=0 THEN
  2500.       IF LeftToolBarSize=0 THEN IF RightToolBarSize=0 THEN {No desktop ???}
  2501.       BEGIN
  2502.            DesktopWin:=InitializeDesktop(ObjectPtr);  {Call Constructor}
  2503.            IF DesktopWin=NIL THEN {No desktop at all !}
  2504.            BEGIN
  2505.                 {GetMem(AParentWin,4);
  2506.                 POINTER(AParentWin^):=POINTER(SELF);???}
  2507.                 {}POINTER(AParentWin):=POINTER(SELF);{}
  2508.                 DesktopWin:=AParentWin;
  2509.                 exit;
  2510.            END;
  2511.  
  2512.            {Create Desktop window}
  2513.            DisableAutoFill; {We fill it via Desktopwin}
  2514.            GetWindowClass(WndClass);
  2515.            goto l; {proceed}
  2516.       END;
  2517.      {Create Desktop window}
  2518.      DisableAutoFill; {We fill it via Desktopwin}
  2519.      GetWindowClass(WndClass);
  2520.      DesktopWin:=InitializeDesktop(ObjectPtr);  {Call Constructor}
  2521.      IF DesktopWin=NIL THEN DesktopWin:=New(PWindow,Init(ObjectPtr,''));
  2522. l:
  2523.      SetFlags(WF_WITHDESKTOP,TRUE);  {with desktop}
  2524.      IF DesktopWin^.FirstChild=NIL THEN
  2525.        NoMoreChildWindows;  {No child windows exist}
  2526.      DesktopWin^.WinColor:=WinColor;
  2527.      DesktopWin^.WinBackColor:=WinBackColor;
  2528.      DesktopWin^.SetFlags(WF_ISDESKTOP,TRUE);
  2529.      DesktopWin^.DisableAutoCreate; {We create it ourselves !}
  2530.      fr:=0;
  2531.      name:='';
  2532.      cClassName:=WndClass.ClassName;
  2533.      DesktopWin^.HWindowFrame:=WinCreateStdWindow(HWindow,0,fr,
  2534.                                                cClassName,name,
  2535.                                                0,0,0,DesktopWin^.HWindow);
  2536.      WinSetWindowULong(DesktopWin^.HWindow,0,LONGWORD(DesktopWin)); {VMT pointer}
  2537.      WinSubClassWindow(DesktopWin^.HWindow,@TheMessageHandler);
  2538.      GetDesktopLimits(aswp);
  2539.      WinSetWindowPos(DesktopWin^.HWindowFrame,HWND_TOP,aswp.x,aswp.y,
  2540.                      aswp.cx,aswp.cy,SWP_SIZE OR SWP_MOVE OR SWP_SHOW);
  2541. END;
  2542.  
  2543. PROCEDURE TWindow.WMMenuEnd(VAR Msg:TMessage);
  2544. VAR
  2545.    dummy:PMenuHelpItems;
  2546.    Status:PStatusBarInterior;
  2547. BEGIN
  2548.      IF StatusBarSize=0 THEN exit;
  2549.      dummy:=MenuHelpItems;
  2550.      WHILE dummy<>NIL DO
  2551.      BEGIN
  2552.           IF dummy^.MenuID=65535 THEN  {Clear it}
  2553.           BEGIN
  2554.                StatusBarSetText(dummy^.StatusID,dummy^.HelpText,
  2555.                                 dummy^.Col);
  2556.                exit;
  2557.           END;
  2558.           dummy:=dummy^.Next;
  2559.      END;
  2560. END;
  2561.  
  2562. PROCEDURE TWindow.WMMenuSelect(VAR Msg:TMessage);
  2563. VAR
  2564.    w,w1:WORD;
  2565.    dummy:PMenuHelpItems;
  2566.    Status:PStatusBarInterior;
  2567. BEGIN
  2568.      IF StatusBarSize=0 THEN exit;
  2569.      w:=msg.Param1Lo;
  2570.      w1:=0;
  2571.      dummy:=MenuHelpItems;
  2572.      WHILE dummy<>NIL DO
  2573.      BEGIN
  2574.           IF dummy^.MenuID=65535 THEN w1:=dummy^.StatusID;
  2575.           IF dummy^.MenuID=w THEN
  2576.           BEGIN
  2577.                w1:=dummy^.StatusID;
  2578.                Status:=StatusBarInterior;
  2579.                WHILE Status<>NIL DO
  2580.                BEGIN
  2581.                     IF Status^.ID=w1 THEN
  2582.                     BEGIN
  2583.                          StatusBarSetText(w1,dummy^.HelpText,dummy^.Col);
  2584.                          exit;
  2585.                     END;
  2586.                     Status:=Status^.Next;
  2587.                END;
  2588.                exit;
  2589.           END;
  2590.           dummy:=dummy^.Next;
  2591.      END;
  2592.      IF w1<>0 THEN
  2593.      BEGIN
  2594.           StatusBarSetText(w1,'',-1);
  2595.      END;
  2596. END;
  2597.  
  2598. PROCEDURE TWindow.HelpInitError(err:LONGWORD);
  2599. BEGIN
  2600.      ErrorBox(MB_ICONHAND,'Error',
  2601.               'Application failed to initialize help (Error:'+
  2602.                 Tostr(err)+')');
  2603. END;
  2604.  
  2605.  
  2606. PROCEDURE TWindow.WMDestroy(var Msg: TMessage);
  2607. BEGIN
  2608.      Inherited.WMDestroy(msg);
  2609.      IF HelpWindow<>0 THEN
  2610.        WinAssociateHelpInstance( NULLHANDLE, HWindowFrame );
  2611. END;
  2612.  
  2613. FUNCTION TWindow.Create:BOOLEAN;
  2614. VAR
  2615.    ParentWin:HWND;
  2616.    WndClass:TWndClass;
  2617.    p:POINTER;
  2618.    aHelpInit:HelpInit;
  2619.    cTitle:CSTRING;
  2620.    cClassName:CSTRING;
  2621.    cFNS:CSTRING;
  2622. BEGIN
  2623.      IF HWindow<>0 THEN
  2624.      BEGIN
  2625.           Create:=TRUE;
  2626.           exit;  {Window always created}
  2627.      END;
  2628.      IF Parent<>NIL THEN ParentWin:=Parent^.HWindow
  2629.      ELSE ParentWin:=HWND_DESKTOP;
  2630.  
  2631.      IF Attr.HasMenu THEN
  2632.          Attr.FrameFlags:=Attr.FrameFlags OR FCF_MENU;
  2633.      IF Attr.HasIcon THEN
  2634.          Attr.FrameFlags:=Attr.FrameFlags OR FCF_ICON;
  2635.      IF Attr.HasAccelTable THEN
  2636.          Attr.FrameFlags:=Attr.FrameFlags OR FCF_ACCELTABLE;
  2637.  
  2638.      IF Attr.W>0 THEN IF Attr.H>0 THEN
  2639.        Attr.FrameFlags:=Attr.FrameFlags AND not FCF_SHELLPOSITION;
  2640.  
  2641.      GetWindowClass(WndClass);
  2642.      IF WndClass.ClassNameULong<>0 THEN {WC_Name Window}
  2643.      BEGIN
  2644.           cTitle:=Attr.Title;
  2645.           HWindow:=WinCreateWCWindow(ParentWin,WndClass.ClassNameULong,
  2646.                                      cTitle,Attr.Style,Attr.X,
  2647.                                      Attr.Y,Attr.W,Attr.H,ParentWin,HWND_TOP,
  2648.                                      Attr.WindowID,NIL,NIL);
  2649.           IF HWindow<>0 THEN HWindowFrame:=WinQueryWindow(HWindow,QW_PARENT);
  2650.      END
  2651.      ELSE {normal window}
  2652.      BEGIN
  2653.           cTitle:=Attr.Title;
  2654.           cClassName:=WndClass.ClassName;
  2655.           HWindowFrame:=WinCreateStdWindow(ParentWin,Attr.Style,
  2656.                                            Attr.FrameFlags,cClassName,
  2657.                                            cTitle,0,
  2658.                                            Attr.ResourceModule,
  2659.                                            Attr.ResourceId,
  2660.                                            HWindow);
  2661.      END;
  2662.      IF HWindow=0 THEN
  2663.      BEGIN
  2664.           Create:=FALSE;
  2665.           exit;
  2666.      END;
  2667.      WinSetPresParam(HWindow,PP_FOREGROUNDCOLORINDEX,4,WinColor);
  2668.      WinSetPresParam(HWindow,PP_BACKGROUNDCOLORINDEX,4,WinBackColor);
  2669.      cFNS:=Attr.FontNameSize;
  2670.      IF cFNS<>'' THEN
  2671.      BEGIN
  2672.           WinSetPresParam(HWindow,PP_FONTNAMESIZE,Length(cFNS)+1,cFNS);
  2673.           WinSetPresParam(HWindowFrame,PP_FONTNAMESIZE,Length(cFNS)+1,cFNS);
  2674.      END;
  2675.      WinSetWindowULong(HWindow,0,LONGWORD(SELF)); {VMT pointer}
  2676.      WinSubClassWindow(HWindow,@TheMessageHandler);
  2677.      OldFrameProc:=WinSubClassWindow(HWindowFrame,@TheFrameHandler);
  2678.      IF Attr.HasHelp THEN
  2679.      BEGIN
  2680.           aHelpInit.pszHelpWindowTitle:=@Attr.HelpWindowTitle;
  2681.           aHelpInit.pszHelpLibraryName:=@Attr.HelpFileName;
  2682.           aHelpInit.cb:=sizeof(HelpInit);
  2683.           aHelpInit.ulReturnCode:=0;
  2684.           aHelpInit.pszTutorialname:=NIL;
  2685.           aHelpInit.phtHelptable:=POINTER($FFFF0000 OR Attr.ResourceID);
  2686.           aHelpInit.hmodHelptableModule:=Attr.ResourceModule;
  2687.           aHelpInit.hmodAccelActionBarModule:=0;
  2688.           aHelpInit.idAcceltable:=0;
  2689.           aHelpInit.idActionBar:=0;
  2690.           aHelpInit.fShowPanelID:=0;
  2691.           HelpWindow:=WinCreateHelpInstance(HInstance,aHelpInit);
  2692.           HwndHelpInstance:=HelpWindow;
  2693.           fHelpEnabled:=TRUE;
  2694.           HELP_TABLE:=Attr.ResourceID;
  2695.  
  2696.           IF HelpWindow<>0 THEN
  2697.              WinAssociateHelpInstance(HelpWindow,HWindowFrame)
  2698.           ELSE HelpInitError(aHelpInit.ulReturnCode);
  2699.      END;
  2700.  
  2701.      SetupWindow;
  2702.      SetupDesktop;
  2703.      Create:=TRUE;
  2704. END;
  2705.  
  2706. PROCEDURE TWindow.CMTile(VAR Msg:TMessage);
  2707. VAR
  2708.     Buf:PSWPBUF;
  2709.     Square,Rows,Columns,ExtraCols,Width,Height:LONGWORD;
  2710.     rec:RECTL;
  2711.     Child:HWND;
  2712.     CurRow,CurCol:LONGWORD;
  2713.     ChildCnt,ChildCount:LONGWORD;
  2714.     t:LONGWORD;
  2715.     Win:HWND;
  2716.     TotalCount:BYTE;
  2717.     ChildList:PWindowsObject;
  2718. LABEL l;
  2719. BEGIN
  2720.      {Move active window to the end of the child list}
  2721.      IF DesktopWin=NIL THEN
  2722.      BEGIN
  2723.           ChildList:=GetActiveChild;
  2724.           RemoveChild(ChildList);
  2725.           AddChild(ChildList);
  2726.      END
  2727.      ELSE
  2728.      BEGIN
  2729.           ChildList:=DesktopWin^.GetActiveChild;
  2730.           DesktopWin^.RemoveChild(ChildList);
  2731.           DesktopWin^.AddChild(ChildList);
  2732.      END;
  2733.  
  2734.      IF DesktopWin=NIL THEN ChildList:=FirstChild
  2735.      ELSE ChildList:=DesktopWin^.FirstChild;
  2736.      ChildCnt:=0;
  2737.      ChildCount:=0;
  2738.      WHILE ChildList<>NIL DO
  2739.      BEGIN
  2740.           IF not IsWindowMinimized(ChildList^.HWindowFrame) THEN inc(ChildCnt);
  2741.           inc(ChildCount);
  2742.           ChildList:=ChildList^.next;
  2743.      END;
  2744.      TotalCount:=0;
  2745.      IF DesktopWin=NIL THEN Win:=HWindow
  2746.      ELSE Win:=DesktopWin^.HWindow;
  2747.      Square:=2;
  2748.      IF ChildCnt=0 THEN exit;
  2749.      WHILE Square*2<=ChildCnt DO inc(Square);
  2750.      IF ChildCnt=3 THEN Square:=3;
  2751.  
  2752.      Columns:=Square-1;
  2753.      Rows:=ChildCnt DIV Columns;
  2754.      ExtraCols:=ChildCnt MOD Columns;
  2755.  
  2756.      WinQueryWindowRect(Win,rec);
  2757.      IF rec.xRight>0 THEN IF rec.yBottom<rec.yTop THEN
  2758.      BEGIN
  2759.           IF DesktopWin=NIL THEN ChildList:=FirstChild
  2760.           ELSE ChildList:=DesktopWin^.FirstChild;
  2761.           IF ChildList=NIL THEN Child:=0
  2762.           ELSE Child:=ChildList^.HWindowFrame;
  2763.           IF Child<>0 THEN
  2764.           BEGIN
  2765.                GetMem(Buf,sizeof(TSWPBUF)*ChildCount);
  2766.                ChildCnt:=0;
  2767.                Height:=(rec.yTop-rec.yBottom) div Rows;
  2768.  
  2769.                FOR CurRow:=0 TO Rows-1 DO
  2770.                BEGIN
  2771.                     IF Rows-CurRow<=ExtraCols THEN inc(Columns);
  2772.                     FOR CurCol:=0 TO Columns-1 DO
  2773.                     BEGIN
  2774.                          Width:=rec.xRight div Columns;
  2775.  
  2776.                          {Skip minimized Windows}
  2777. l:
  2778.                          IF IsWindowMinimized(Child) THEN
  2779.                          BEGIN
  2780.                               ChildList:=ChildList^.Next;
  2781.                               IF ChildList=NIL THEN Child:=0
  2782.                               ELSE Child:=ChildList^.HWindowFrame;
  2783.                               If Child<>0 THEN goto l;
  2784.                          END;
  2785.  
  2786.                          IF Child<>0 THEN
  2787.                          BEGIN
  2788.                               inc(TotalCount);
  2789.                               IF IsWindowMaximized(Child) THEN
  2790.                                 Buf^[ChildCnt].fl:= SWP_SIZE OR SWP_MOVE
  2791.                                                  OR SWP_ACTIVATE OR SWP_SHOW
  2792.                                                  OR SWP_RESTORE
  2793.                               ELSE Buf^[ChildCnt].fl:=SWP_SIZE OR SWP_MOVE
  2794.                                                    OR SWP_ACTIVATE OR SWP_SHOW;
  2795.                               buf^[ChildCnt].x:=Width*CurCol;
  2796.                               buf^[ChildCnt].y:=rec.yTop-(Height*(CurRow+1));
  2797.                               buf^[ChildCnt].cx:=Width;
  2798.                               buf^[ChildCnt].cy:=Height;
  2799.                               buf^[ChildCnt].hwnd:=Child;
  2800.                               inc(ChildCnt);
  2801.  
  2802.                               ChildList:=ChildList^.Next;
  2803.                               IF ChildList=NIL THEN Child:=0
  2804.                               ELSE Child:=ChildList^.HWindowFrame;
  2805.                          END; {IF Childy<>0}
  2806.                     END;
  2807.                     IF Rows-CurRow<=ExtraCols THEN
  2808.                     BEGIN
  2809.                          dec(Columns);
  2810.                          dec(ExtraCols);
  2811.                     END;
  2812.                END;
  2813.  
  2814.                IF TotalCount>0 THEN WinSetMultWindowPos(HInstance,Buf^[0],
  2815.                                                         TotalCount);
  2816.                FreeMem(Buf,sizeof(TSWPBUF)*ChildCount);
  2817.           END;  {IF Child<>0}
  2818.      END;
  2819. END;
  2820.  
  2821. PROCEDURE TWindow.CMCascade(VAR Msg:TMessage);
  2822. VAR
  2823.     xloc,yloc,xlen,ylen:LONGINT;
  2824.     XDiv,YDiv:LONGWORD;
  2825.     ChildList:PWindowsObject;
  2826.     rc:RECTL;
  2827. BEGIN
  2828.      {Move active window to the end of the child list}
  2829.      IF DesktopWin=NIL THEN
  2830.      BEGIN
  2831.           ChildList:=GetActiveChild;
  2832.           RemoveChild(ChildList);
  2833.           AddChild(ChildList);
  2834.      END
  2835.      ELSE
  2836.      BEGIN
  2837.           ChildList:=DesktopWin^.GetActiveChild;
  2838.           DesktopWin^.RemoveChild(ChildList);
  2839.           DesktopWin^.AddChild(ChildList);
  2840.      END;
  2841.  
  2842.      XDiv:=WinQuerySysValue(HWND_DESKTOP,SV_CXSIZEBORDER);
  2843.      inc(XDiv,WinQuerySysValue(HWND_DESKTOP,SV_CXMINMAXBUTTON) DIV 2);
  2844.  
  2845.      YDiv:=WinQuerySysValue(HWND_DESKTOP,SV_CYSIZEBORDER);
  2846.      inc(YDiv,WinQuerySysValue(HWND_DESKTOP,SV_CYMINMAXBUTTON));
  2847.  
  2848.      IF DesktopWin=NIL THEN
  2849.      BEGIN
  2850.           WinQueryWindowRect(HWindow,rc);
  2851.           ChildList:=FirstChild;
  2852.      END
  2853.      ELSE
  2854.      BEGIN
  2855.           WinQueryWindowRect(DesktopWin^.HWindow,rc);
  2856.           ChildList:=DesktopWin^.FirstChild;
  2857.      END;
  2858.      xloc:=rc.xleft;
  2859.      xlen:=rc.xright-rc.xleft;
  2860.      yloc:=rc.yBottom;
  2861.      ylen:=rc.yTop-rc.yBottom;
  2862.      WHILE ChildList<>NIL DO
  2863.      BEGIN
  2864.           IF not IsWindowMinimized(ChildList^.HWindowFrame) THEN
  2865.           BEGIN
  2866.                WinSetWindowPos(ChildList^.HWindowFrame,HWND_TOP,
  2867.                                xloc,yloc,xlen,ylen,SWP_SIZE OR SWP_MOVE
  2868.                                OR SWP_ACTIVATE OR SWP_SHOW);
  2869.                inc(xloc,XDiv);
  2870.                dec(xlen,XDiv);
  2871.                dec(ylen,YDiv);
  2872.           END;
  2873.           ChildList:=ChildList^.Next;
  2874.      END;
  2875. END;
  2876.  
  2877. PROCEDURE TWindow.CMClose(VAR Msg:TMessage);
  2878. VAR
  2879.    Child:PWindowsObject;
  2880. BEGIN
  2881.      IF DesktopWin=NIL THEN Child:=GetActiveChild
  2882.      ELSE Child:=DesktopWin^.GetActiveChild;
  2883.      IF Child<>NIL THEN
  2884.      BEGIN
  2885.          IF DesktopWin=NIL THEN SetActiveChild(NIL)
  2886.          ELSE DesktopWin^.SetActiveChild(NIL);
  2887.          WinSendMsg(Child^.HWindow,WM_CLOSE,0,0);
  2888.      END;
  2889. END;
  2890.  
  2891. PROCEDURE CloseAWin(p:PWindowsObject);
  2892. BEGIN
  2893.      WinSendMsg(p^.HWindowFrame,WM_CLOSE,0,0);
  2894. END;
  2895.  
  2896. PROCEDURE TWindow.CMCloseAll(VAR Msg:TMessage);
  2897. BEGIN
  2898.      IF DesktopWin=NIL THEN ForEach(@CloseAWin)  {Close all child windows}
  2899.      ELSE DesktopWin^.ForEach(@CloseAWin);
  2900. END;
  2901.  
  2902.  
  2903. PROCEDURE TWindow.CMNext(VAR Msg:TMessage);
  2904. VAR
  2905.    Childs:PWindowsObject;
  2906. BEGIN
  2907.      IF DesktopWin=NIL THEN Childs:=GetActiveChild
  2908.      ELSE Childs:=DesktopWin^.GetActiveChild;
  2909.      IF Childs=NIL THEN exit;
  2910.      Childs:=Childs^.Next;
  2911.      IF Childs=NIL THEN
  2912.      BEGIN
  2913.           IF DesktopWin=NIL THEN Childs:=FirstChild
  2914.           ELSE Childs:=DesktopWin^.FirstChild;
  2915.      END;
  2916.      IF Childs=NIL THEN Exit;
  2917.      Childs^.WindowToTop;
  2918. END;
  2919.  
  2920. PROCEDURE TWindow.CMPrevious(VAR Msg:TMessage);
  2921. VAR
  2922.    Childs:PWindowsObject;
  2923. BEGIN
  2924.      IF DesktopWin=NIL THEN Childs:=GetActiveChild
  2925.      ELSE Childs:=DesktopWin^.GetActiveChild;
  2926.      IF Childs=NIL THEN exit;
  2927.      Childs:=Childs^.Previous;
  2928.      IF Childs=NIL THEN
  2929.      BEGIN
  2930.           IF DesktopWin=NIL THEN Childs:=LastChild
  2931.           ELSE Childs:=DesktopWin^.LastChild;
  2932.      END;
  2933.      IF Childs=NIL THEN Exit;
  2934.      Childs^.WindowToTop;
  2935. END;
  2936.  
  2937.  
  2938. PROCEDURE TWindow.CMQuit(VAR Msg:TMessage);
  2939. BEGIN
  2940.      WinSendMsg(Msg.Receiver,WM_CLOSE,0,0);
  2941. END;
  2942.  
  2943. PROCEDURE TWindow.CMHelpOnHelp(VAR Msg:TMessage);
  2944. VAR
  2945.    HelpWin:HWND;
  2946. BEGIN
  2947.      IF Application=NIL THEN Exit;
  2948.      HelpWin:=Application^.MainWindow^.HelpWindow;
  2949.      IF HelpWin<>0 THEN
  2950.                 WinSendMsg(HelpWin,HM_DISPLAY_HELP,0,0);
  2951. END;
  2952.  
  2953. PROCEDURE TWindow.CMExtendedHelp(VAR Msg:TMessage);
  2954. VAR
  2955.    HelpWin:HWND;
  2956. BEGIN
  2957.      IF Application=NIL THEN Exit;
  2958.      IF Application^.MainWindow=NIL THEN Exit;
  2959.      HelpWin:=Application^.MainWindow^.HelpWindow;
  2960.      IF HelpWin<>0 THEN
  2961.                WinSendMsg(HelpWin,HM_EXT_HELP,0,0);
  2962. END;
  2963.  
  2964. PROCEDURE TWindow.CMKeysHelp(VAR Msg:TMessage);
  2965. VAR
  2966.    HelpWin:HWND;
  2967. BEGIN
  2968.      IF Application=NIL THEN Exit;
  2969.      IF Application^.MainWindow=NIL THEN Exit;
  2970.      HelpWin:=Application^.MainWindow^.HelpWindow;
  2971.      IF HelpWin<>0 THEN
  2972.                WinSendMsg(HelpWin,HM_KEYS_HELP,0,0);
  2973. END;
  2974.  
  2975. PROCEDURE TWindow.CMHelpIndex(VAR Msg:TMessage);
  2976. VAR
  2977.    HelpWin:HWND;
  2978. BEGIN
  2979.      IF Application=NIL THEN Exit;
  2980.      IF Application^.MainWindow=NIL THEN Exit;
  2981.      HelpWin:=Application^.MainWindow^.HelpWindow;
  2982.      IF HelpWin<>0 THEN
  2983.                WinSendMsg(HelpWin,HM_HELP_INDEX,0,0);
  2984. END;
  2985.  
  2986. PROCEDURE TWindow.CMHelpContents(VAR Msg:TMessage);
  2987. VAR
  2988.    HelpWin:HWND;
  2989. BEGIN
  2990.      IF Application=NIL THEN Exit;
  2991.      IF Application^.MainWindow=NIL THEN Exit;
  2992.      HelpWin:=Application^.MainWindow^.HelpWindow;
  2993.      IF HelpWin<>0 THEN
  2994.          WinSendMsg(HelpWin,HM_HELP_CONTENTS,0,0);
  2995. END;
  2996.  
  2997. PROCEDURE TWindow.InvalidateWindow;
  2998. BEGIN
  2999.      WinInvalidateRect(HWindow,NIL,TRUE);
  3000. END;
  3001.  
  3002. PROCEDURE TWindow.FirstChildWindow;
  3003. BEGIN
  3004.      Inherited.FirstChildWindow;
  3005.      SetMenuState(CM_FIRST+CM_TILE,TRUE);
  3006.      SetMenuState(CM_FIRST+CM_LIST,TRUE);
  3007.      SetMenuState(CM_FIRST+CM_CASCADE,TRUE);
  3008.      SetMenuState(CM_FIRST+CM_NEXT,TRUE);
  3009.      SetMenuState(CM_FIRST+CM_PREVIOUS,TRUE);
  3010.      SetMenuState(CM_FIRST+CM_CLOSE,TRUE);
  3011.      SetMenuState(CM_FIRST+CM_CLOSEALL,TRUE);
  3012. END;
  3013.  
  3014. PROCEDURE TWindow.NoMoreChildWindows;
  3015. BEGIN
  3016.      Inherited.NoMoreChildWindows;
  3017.      SetMenuState(CM_FIRST+CM_TILE,FALSE);
  3018.      SetMenuState(CM_FIRST+CM_LIST,FALSE);
  3019.      SetMenuState(CM_FIRST+CM_CASCADE,FALSE);
  3020.      SetMenuState(CM_FIRST+CM_NEXT,FALSE);
  3021.      SetMenuState(CM_FIRST+CM_PREVIOUS,FALSE);
  3022.      SetMenuState(CM_FIRST+CM_CLOSE,FALSE);
  3023.      SetMenuState(CM_FIRST+CM_CLOSEALL,FALSE);
  3024. END;
  3025.  
  3026.  
  3027. {*************************************************************************
  3028.  *                                                                       *
  3029.  *  Object TApplication                                                  *
  3030.  *                                                                       *
  3031.  *************************************************************************}
  3032.  
  3033.  
  3034. CONSTRUCTOR TApplication.Init(AName:STRING);
  3035. BEGIN
  3036.      {GetMem(Application,4);
  3037.      POINTER(Application^):=POINTER(SELF);??}
  3038.      {}POINTER(Application):=POINTER(SELF);{}
  3039.      ApplicationName:=AName;
  3040.      MainWindow:=NIL;  {No Main-window specified}
  3041. END;
  3042.  
  3043. DESTRUCTOR TApplication.Done;
  3044. BEGIN
  3045.      {FreeMem(Application,4);}
  3046.      Application:=NIL;
  3047. END;
  3048.  
  3049. PROCEDURE TApplication.InitMainWindow;
  3050. BEGIN
  3051. END;
  3052.  
  3053. PROCEDURE TApplication.MessageLoop;
  3054. VAR
  3055.    Queue:QMSG;
  3056. BEGIN
  3057.      WHILE WinGetMsg(HInstance,Queue,0,0,0) DO
  3058.          WinDispatchMsg(HInstance,Queue);
  3059. END;
  3060.  
  3061.  
  3062. PROCEDURE TApplication.SetupRun;
  3063. BEGIN
  3064. END;
  3065.  
  3066. PROCEDURE TApplication.RunFailed(Code:BYTE);
  3067. BEGIN
  3068. END;
  3069.  
  3070. PROCEDURE TApplication.Run;
  3071. BEGIN
  3072.      InitMainWindow;
  3073.      IF MainWindow<>NIL THEN
  3074.      BEGIN
  3075.           MainWindow^.Create;  {ever create MainWindow Whatever is with
  3076.                                 WF_AUTOCREATE}
  3077.           IF MainWindow^.HWindow<>0 THEN
  3078.           BEGIN
  3079.                IF MainWindow^.FirstChild=NIL THEN
  3080.                  MainWindow^.NoMoreChildWindows;  {No child windows exist}
  3081.                MainWindow^.SetupMenu;
  3082.                MainWindow^.SetFlags(WF_ISMAINWINDOW,TRUE);
  3083.                SetupRun;
  3084.                IF MainWindow^.DesktopWin=NIL THEN MessageLoop
  3085.                ELSE
  3086.                BEGIN
  3087.                     IF MainWindow^.DesktopWin^.HWindow<>0 THEN MessageLoop
  3088.                     ELSE RunFailed(RF_NODESKTOPWINDOW);
  3089.                END;
  3090.           END
  3091.           ELSE RunFailed(RF_NOMAINWINDOW);
  3092.      END
  3093.      ELSE RunFailed(RF_NOMAINWINDOW);
  3094. END;
  3095.  
  3096. {$D+}
  3097.  
  3098. BEGIN
  3099.      StartHandlerAddr:=@TheStartHandler;
  3100.      MessageHandlerAddr:=@TheMessageHandler;
  3101.      AppHandle:=WinInitialize(0);
  3102.      AppQueueHandle:=WinCreateMsgQueue(AppHandle,0);
  3103.      HInstance:=AppHandle;
  3104. END.
  3105.  
  3106.