home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / SPCC / FORMS.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-21  |  712KB  |  23,077 lines
  1.  
  2. {╔══════════════════════════════════════════════════════════════════════════╗
  3.  ║                                                                          ║
  4.  ║     Sibyl Portable Component Classes                                     ║
  5.  ║                                                                          ║
  6.  ║     Copyright (C) 1995,97 SpeedSoft Germany,   All rights reserved.      ║
  7.  ║                                                                          ║
  8.  ╚══════════════════════════════════════════════════════════════════════════╝}
  9.                              
  10. Unit Forms;
  11.  
  12. {$B-}
  13.  
  14. Interface
  15.  
  16. {$IFDEF OS2}
  17. Uses Os2Def,BseDos,PmWin,PmGpi,PmDev,PmStdDlg,PmBitmap,PmHelp;
  18. {$ENDIF}
  19.  
  20. {$IFDEF Win32}
  21. Uses WinDef,WinBase,WinNt,WinUser,WinGDI,CommCtrl;
  22. {$ENDIF}
  23.  
  24. Uses Messages,Dos,SysUtils,Classes;
  25.  
  26.  
  27. Type
  28. {$M+}
  29.     TCommand           = LongWord;
  30.  
  31. Const
  32.     {predefined Command Ids}
  33.     cmNull             = TCommand(0);
  34.     cmBase             = $8000;
  35.  
  36.     cmFile             = TCommand(cmBase+1);
  37.     cmOpen             = TCommand(cmBase+2);
  38.     cmNew              = TCommand(cmBase+3);
  39.     cmSave             = TCommand(cmBase+5);
  40.     cmSaveAs           = TCommand(cmBase+6);
  41.     cmSaveAll          = TCommand(cmBase+7);
  42.     cmPrint            = TCommand(cmBase+8);
  43.     cmExit             = TCommand(cmBase+9);
  44.     cmAbout            = TCommand(cmBase+10);
  45.     cmUndo             = TCommand(cmBase+11);
  46.     cmRedo             = TCommand(cmBase+12);
  47.     cmCut              = TCommand(cmBase+13);
  48.     cmCopy             = TCommand(cmBase+14);
  49.     cmPaste            = TCommand(cmBase+15);
  50.     cmTile             = TCommand(cmBase+16);
  51.     cmCascade          = TCommand(cmBase+17);
  52.     cmCloseAll         = TCommand(cmBase+18);
  53.     cmNext             = TCommand(cmBase+19);
  54.     cmPrevious         = TCommand(cmBase+20);
  55.     cmCloseTop         = TCommand(cmBase+21);
  56.     cmMaximize         = TCommand(cmBase+22);
  57.     cmMinimize         = TCommand(cmBase+23);
  58.     cmRestore          = TCommand(cmBase+24);
  59.     cmFind             = TCommand(cmBase+25);
  60.     cmReplace          = TCommand(cmBase+26);
  61.     cmHelpIndex        = TCommand(cmBase+27);
  62.     cmHelpContents     = TCommand(cmBase+28);
  63.     cmHelpOnHelp       = TCommand(cmBase+29);
  64.     cmKeysHelp         = TCommand(cmBase+30);
  65.     cmTopicSearch      = TCommand(cmBase+31);
  66.     cmChangeDir        = TCommand(cmBase+32);
  67.     cmSearchAgain      = TCommand(cmBase+33);
  68.     cmSelectAll        = TCommand(cmBase+34);
  69.     cmDeselectAll      = TCommand(cmBase+35);
  70.     cmBack             = TCommand(cmBase+36);
  71.     cmForward          = TCommand(cmBase+37);
  72.     cmDelete           = TCommand(cmBase+38);
  73.     cmCreateDir        = TCommand(cmBase+39);
  74.  
  75.     cmOk               = TCommand(cmBase+50);
  76.     cmCancel           = TCommand(cmBase+51);
  77.     cmHelp             = TCommand(cmBase+52);
  78.     cmYes              = TCommand(cmBase+53);
  79.     cmNo               = TCommand(cmBase+54);
  80.     cmClose            = TCommand(cmBase+55);
  81.     cmAbort            = TCommand(cmBase+56);
  82.     cmRetry            = TCommand(cmBase+57);
  83.     cmIgnore           = TCommand(cmBase+58);
  84.     cmAll              = TCommand(cmBase+59);
  85.     cmAccept           = TCommand(cmBase+60);
  86.     cmDiscard          = TCommand(cmBase+61);
  87.     cmDefault          = TCommand(cmBase+62);
  88.  
  89.     cmUser             = TCommand(cmBase+$1000);
  90. {$M-}
  91.  
  92. Const
  93.     WM_CAPTUREFOCUS           = WM_USER+1;
  94.     WM_DDE_DESTROY            = WM_USER+2;
  95.  
  96.     CM_COMMAND                = WM_COMMAND;
  97.     CM_PARENTPENCOLORCHANGED  = cmBase+110;
  98.     CM_PARENTCOLORCHANGED     = cmBase+111;
  99.     CM_PARENTFONTCHANGED      = cmBase+112;
  100.     CM_BUTTONPRESSED          = cmBase+120;
  101.     CM_RELEASE                = cmBase+125;
  102.     CM_TEXTCHANGED            = cmBase+126;
  103.     CM_UPDATEBUTTONS          = cmBase+127;
  104.     CM_ENDMODALSTATE          = cmBase+128;
  105.  
  106.  
  107. Const
  108.     {Caret Timer values for use with BlinkTime}
  109. {$M+}
  110.     ctNormal           = 500;
  111.     ctFast             = 100;
  112. {$M-}
  113.  
  114. Type
  115.     {General KeyCode Type. KeyCode constants apply to ScanEvent Methods}
  116. {$M+}
  117.     TKeyCode           = LongWord;
  118.  
  119. Const
  120.     {predefined Keyboars codes. To determine If Ctrl,Shift Or Alt was
  121.      Pressed together With the key you may Use Boolean operations}
  122.     kbNull             = TKeyCode(0);
  123.     kb_VK              = 256;
  124.     kb_Ctrl            = 512;
  125.     kb_Shift           = 1024;
  126.     kb_Alt             = 2048;
  127.     kb_Char            = 4096;
  128.  
  129.     kbF1               = TKeyCode(kb_VK + VK_F1);
  130.     kbF2               = TKeyCode(kb_VK + VK_F2);
  131.     kbF3               = TKeyCode(kb_VK + VK_F3);
  132.     kbF4               = TKeyCode(kb_VK + VK_F4);
  133.     kbF5               = TKeyCode(kb_VK + VK_F5);
  134.     kbF6               = TKeyCode(kb_VK + VK_F6);
  135.     kbF7               = TKeyCode(kb_VK + VK_F7);
  136.     kbF8               = TKeyCode(kb_VK + VK_F8);
  137.     kbF9               = TKeyCode(kb_VK + VK_F9);
  138.     kbF10              = TKeyCode(kb_VK + VK_F10);
  139.     kbF11              = TKeyCode(kb_VK + VK_F11);
  140.     kbF12              = TKeyCode(kb_VK + VK_F12);
  141.     kbCLeft            = TKeyCode(kb_VK + VK_LEFT);
  142.     kbCRight           = TKeyCode(kb_VK + VK_RIGHT);
  143.     kbCUp              = TKeyCode(kb_VK + VK_UP);
  144.     kbCDown            = TKeyCode(kb_VK + VK_DOWN);
  145.     kbDel              = TKeyCode(kb_VK + VK_DELETE);
  146.     kbIns              = TKeyCode(kb_VK + VK_INSERT);
  147.     kbEnd              = TKeyCode(kb_VK + VK_END);
  148.     kbHome             = TKeyCode(kb_VK + VK_HOME);
  149.     {$IFDEF OS2}
  150.     kbPageDown         = TKeyCode(kb_VK + VK_PAGEDOWN);
  151.     kbPageUp           = TKeyCode(kb_VK + VK_PAGEUP);
  152.     kbBkSp             = TKeyCode(kb_VK + VK_BACKSPACE);
  153.     kbCR               = TKeyCode(kb_VK + VK_NEWLINE);
  154.     kbEsc              = TKeyCode(kb_VK + VK_ESC);
  155.     kbCapsLock         = TKeyCode(kb_VK + VK_CAPSLOCK);
  156.     kbScrollLock       = TKeyCode(kb_VK + VK_SCRLLOCK);
  157.     kbEnter            = TKeyCode(kb_VK + VK_ENTER);
  158.     kbPrintScrn        = TKeyCode(kb_VK + VK_PRINTSCRN);
  159.     kbCtrl             = TKeyCode(kb_VK + VK_CTRL + kb_Ctrl);
  160.     kbAlt              = TKeyCode(kb_VK + VK_ALT + kb_Alt);
  161.     kbAltGraf          = TKeyCode(kb_VK + VK_ALTGRAF);
  162.     kbBackTab          = TKeyCode(kb_VK + VK_BACKTAB);
  163.     kbBreak            = TKeyCode(kb_VK + VK_BREAK);
  164.     {$ENDIF}
  165.     {$IFDEF Win32}
  166.     kbPageDown         = TKeyCode(kb_VK + VK_NEXT);
  167.     kbPageUp           = TKeyCode(kb_VK + VK_PRIOR);
  168.     kbBkSp             = TKeyCode(kb_VK + VK_BACK);
  169.     kbCR               = TKeyCode(kb_VK + VK_RETURN);
  170.     kbEsc              = TKeyCode(kb_VK + VK_ESCAPE);
  171.     kbCapsLock         = TKeyCode(kb_VK + VK_CAPITAL);
  172.     kbScrollLock       = TKeyCode(kb_VK + VK_SCROLL);
  173.     kbEnter            = TKeyCode(kb_VK + VK_RETURN);
  174.     kbPrintScrn        = TKeyCode(kb_VK + VK_PRINT);
  175.     kbCtrl             = TKeyCode(kb_VK + VK_CONTROL + kb_Ctrl);
  176.     kbAlt              = TKeyCode(kb_VK + VK_MENU + kb_Alt);
  177.     kbAltGraf          = TKeyCode(kb_VK + VK_MENU + kb_Alt + kb_Ctrl);
  178.     kbBackTab          = TKeyCode(kb_VK + VK_TAB);
  179.     kbBreak            = TKeyCode(kb_VK + VK_ESCAPE);    {?}
  180.     {$ENDIF}
  181.     kbTab              = TKeyCode(kb_VK + VK_TAB);
  182.     kbNumLock          = TKeyCode(kb_VK + VK_NUMLOCK);
  183.     kbSpace            = TKeyCode(kb_VK + VK_SPACE);
  184.     kbPause            = TKeyCode(kb_VK + VK_PAUSE);
  185.     kbShift            = TKeyCode(kb_VK + VK_SHIFT + kb_Shift);
  186.  
  187.     {Shift codes are basic codes + kb_Shift}
  188.     kbShiftF1          = TKeyCode(kb_Shift + kbF1);
  189.     kbShiftF2          = TKeyCode(kb_Shift + kbF2);
  190.     kbShiftF3          = TKeyCode(kb_Shift + kbF3);
  191.     kbShiftF4          = TKeyCode(kb_Shift + kbF4);
  192.     kbShiftF5          = TKeyCode(kb_Shift + kbF5);
  193.     kbShiftF6          = TKeyCode(kb_Shift + kbF6);
  194.     kbShiftF7          = TKeyCode(kb_Shift + kbF7);
  195.     kbShiftF8          = TKeyCode(kb_Shift + kbF8);
  196.     kbShiftF9          = TKeyCode(kb_Shift + kbF9);
  197.     kbShiftF10         = TKeyCode(kb_Shift + kbF10);
  198.     kbShiftF11         = TKeyCode(kb_Shift + kbF11);
  199.     kbShiftF12         = TKeyCode(kb_Shift + kbF12);
  200.     kbShiftCLeft       = TKeyCode(kb_Shift + kbCLeft);
  201.     kbShiftCRight      = TKeyCode(kb_Shift + kbCRight);
  202.     kbShiftCUp         = TKeyCode(kb_Shift + kbCUp);
  203.     kbShiftCDown       = TKeyCode(kb_Shift + kbCDown);
  204.     kbShiftDel         = TKeyCode(kb_Shift + kbDel);
  205.     kbShiftIns         = TKeyCode(kb_Shift + kbIns);
  206.     kbShiftEnd         = TKeyCode(kb_Shift + kbEnd);
  207.     kbShiftHome        = TKeyCode(kb_Shift + kbHome);
  208.     kbShiftPageDown    = TKeyCode(kb_Shift + kbPageDown);
  209.     kbShiftPageUp      = TKeyCode(kb_Shift + kbPageUp);
  210.     kbShiftBkSp        = TKeyCode(kb_Shift + kbBkSp);
  211.     kbShiftCR          = TKeyCode(kb_Shift + kbCR);
  212.     kbShiftSpace       = TKeyCode(kb_Shift + kbSpace);
  213.     kbShiftTab         = TKeyCode(kb_Shift + kbBackTab);
  214.     kbShiftEnter       = TKeyCode(kb_Shift + kbEnter);
  215.     kbShiftPause       = TKeyCode(kb_Shift + kbPause);
  216.     kbShiftBreak       = TKeyCode(kb_Shift + kbBreak);
  217.  
  218.     {$IFDEF OS2}
  219.     kbScanBase=TKeyCode(97);
  220.     {$ENDIF}
  221.     {$IFDEF WIN32}
  222.     kbScanBase=TKeyCode(65);
  223.     {$ENDIF}
  224.  
  225.     kbA                = TKeyCode(kbScanBase+0);
  226.     kbB                = TKeyCode(kbScanBase+1);
  227.     kbC                = TKeyCode(kbScanBase+2);
  228.     kbD                = TKeyCode(kbScanBase+3);
  229.     kbE                = TKeyCode(kbScanBase+4);
  230.     kbF                = TKeyCode(kbScanBase+5);
  231.     kbG                = TKeyCode(kbScanBase+6);
  232.     kbH                = TKeyCode(kbScanBase+7);
  233.     kbI                = TKeyCode(kbScanBase+8);
  234.     kbJ                = TKeyCode(kbScanBase+9);
  235.     kbK                = TKeyCode(kbScanBase+10);
  236.     kbL                = TKeyCode(kbScanBase+11);
  237.     kbM                = TKeyCode(kbScanBase+12);
  238.     kbN                = TKeyCode(kbScanBase+13);
  239.     kbO                = TKeyCode(kbScanBase+14);
  240.     kbP                = TKeyCode(kbScanBase+15);
  241.     kbQ                = TKeyCode(kbScanBase+16);
  242.     kbR                = TKeyCode(kbScanBase+17);
  243.     kbS                = TKeyCode(kbScanBase+18);
  244.     kbT                = TKeyCode(kbScanBase+19);
  245.     kbU                = TKeyCode(kbScanBase+20);
  246.     kbV                = TKeyCode(kbScanBase+21);
  247.     kbW                = TKeyCode(kbScanBase+22);
  248.     kbX                = TKeyCode(kbScanBase+23);
  249.     kbY                = TKeyCode(kbScanBase+24);
  250.     kbZ                = TKeyCode(kbScanBase+25);
  251.  
  252.     kb0                = TKeyCode(48);
  253.     kb1                = TKeyCode(49);
  254.     kb2                = TKeyCode(50);
  255.     kb3                = TKeyCode(51);
  256.     kb4                = TKeyCode(52);
  257.     kb5                = TKeyCode(53);
  258.     kb6                = TKeyCode(54);
  259.     kb7                = TKeyCode(55);
  260.     kb8                = TKeyCode(56);
  261.     kb9                = TKeyCode(57);
  262.  
  263.     {Ctrl codes are basic codes + kbCtrl}
  264.     kbCtrl0            = TKeyCode(kb_Ctrl + kb_Char + kb1);
  265.     kbCtrl1            = TKeyCode(kb_Ctrl + kb_Char + kb1);
  266.     kbCtrl2            = TKeyCode(kb_Ctrl + kb_Char + kb2);
  267.     kbCtrl3            = TKeyCode(kb_Ctrl + kb_Char + kb3);
  268.     kbCtrl4            = TKeyCode(kb_Ctrl + kb_Char + kb4);
  269.     kbCtrl5            = TKeyCode(kb_Ctrl + kb_Char + kb5);
  270.     kbCtrl6            = TKeyCode(kb_Ctrl + kb_Char + kb6);
  271.     kbCtrl7            = TKeyCode(kb_Ctrl + kb_Char + kb7);
  272.     kbCtrl8            = TKeyCode(kb_Ctrl + kb_Char + kb8);
  273.     kbCtrl9            = TKeyCode(kb_Ctrl + kb_Char + kb9);
  274.  
  275.     kbCtrlA             = TKeyCode(kb_Ctrl + kb_Char + kbA);
  276.     kbCtrlB             = TKeyCode(kb_Ctrl + kb_Char + kbB);
  277.     kbCtrlC             = TKeyCode(kb_Ctrl + kb_Char + kbC);
  278.     kbCtrlD             = TKeyCode(kb_Ctrl + kb_Char + kbD);
  279.     kbCtrlE             = TKeyCode(kb_Ctrl + kb_Char + kbE);
  280.     kbCtrlF             = TKeyCode(kb_Ctrl + kb_Char + kbF);
  281.     kbCtrlG             = TKeyCode(kb_Ctrl + kb_Char + kbG);
  282.     kbCtrlH             = TKeyCode(kb_Ctrl + kb_Char + kbH);
  283.     kbCtrlI             = TKeyCode(kb_Ctrl + kb_Char + kbI);
  284.     kbCtrlJ             = TKeyCode(kb_Ctrl + kb_Char + kbJ);
  285.     kbCtrlK             = TKeyCode(kb_Ctrl + kb_Char + kbK);
  286.     kbCtrlL             = TKeyCode(kb_Ctrl + kb_Char + kbL);
  287.     kbCtrlM             = TKeyCode(kb_Ctrl + kb_Char + kbM);
  288.     kbCtrlN             = TKeyCode(kb_Ctrl + kb_Char + kbN);
  289.     kbCtrlO             = TKeyCode(kb_Ctrl + kb_Char + kbO);
  290.     kbCtrlP             = TKeyCode(kb_Ctrl + kb_Char + kbP);
  291.     kbCtrlQ             = TKeyCode(kb_Ctrl + kb_Char + kbQ);
  292.     kbCtrlR             = TKeyCode(kb_Ctrl + kb_Char + kbR);
  293.     kbCtrlS             = TKeyCode(kb_Ctrl + kb_Char + kbS);
  294.     kbCtrlT             = TKeyCode(kb_Ctrl + kb_Char + kbT);
  295.     kbCtrlU             = TKeyCode(kb_Ctrl + kb_Char + kbU);
  296.     kbCtrlV             = TKeyCode(kb_Ctrl + kb_Char + kbV);
  297.     kbCtrlW             = TKeyCode(kb_Ctrl + kb_Char + kbW);
  298.     kbCtrlX             = TKeyCode(kb_Ctrl + kb_Char + kbX);
  299.     kbCtrlY             = TKeyCode(kb_Ctrl + kb_Char + kbY);
  300.     kbCtrlZ             = TKeyCode(kb_Ctrl + kb_Char + kbZ);
  301.  
  302.     kbCtrlF1           = TKeyCode(kb_Ctrl + kbF1);
  303.     kbCtrlF2           = TKeyCode(kb_Ctrl + kbF2);
  304.     kbCtrlF3           = TKeyCode(kb_Ctrl + kbF3);
  305.     kbCtrlF4           = TKeyCode(kb_Ctrl + kbF4);
  306.     kbCtrlF5           = TKeyCode(kb_Ctrl + kbF5);
  307.     kbCtrlF6           = TKeyCode(kb_Ctrl + kbF6);
  308.     kbCtrlF7           = TKeyCode(kb_Ctrl + kbF7);
  309.     kbCtrlF8           = TKeyCode(kb_Ctrl + kbF8);
  310.     kbCtrlF9           = TKeyCode(kb_Ctrl + kbF9);
  311.     kbCtrlF10          = TKeyCode(kb_Ctrl + kbF10);
  312.     kbCtrlF11          = TKeyCode(kb_Ctrl + kbF11);
  313.     kbCtrlF12          = TKeyCode(kb_Ctrl + kbF12);
  314.     kbCtrlCLeft        = TKeyCode(kb_Ctrl + kbCLeft);
  315.     kbCtrlCRight       = TKeyCode(kb_Ctrl + kbCRight);
  316.     kbCtrlCUp          = TKeyCode(kb_Ctrl + kbCUp);
  317.     kbCtrlCDown        = TKeyCode(kb_Ctrl + kbCDown);
  318.     kbCtrlDel          = TKeyCode(kb_Ctrl + kbDel);
  319.     kbCtrlIns          = TKeyCode(kb_Ctrl + kbIns);
  320.     kbCtrlEnd          = TKeyCode(kb_Ctrl + kbEnd);
  321.     kbCtrlHome         = TKeyCode(kb_Ctrl + kbHome);
  322.     kbCtrlPageDown     = TKeyCode(kb_Ctrl + kbPageDown);
  323.     kbCtrlPageUp       = TKeyCode(kb_Ctrl + kbPageUp);
  324.     kbCtrlBkSp         = TKeyCode(kb_Ctrl + kbBkSp);
  325.     kbCtrlCR           = TKeyCode(kb_Ctrl + kbCR);
  326.     kbCtrlSpace        = TKeyCode(kb_Ctrl + kbSpace);
  327.     kbCtrlTab          = TKeyCode(kb_Ctrl + kbTab);
  328.     kbCtrlEnter        = TKeyCode(kb_Ctrl + kbEnter);
  329.     kbCtrlPause        = TKeyCode(kb_Ctrl + kbPause);
  330.     kbCtrlBreak        = TKeyCode(kb_Ctrl + kbBreak);
  331.  
  332.     {Alt codes are basic codes + kbAlt}
  333.     kbAlt0             = TKeyCode(kb_Alt + kb_Char + 48);
  334.     kbAlt1             = TKeyCode(kb_Alt + kb_Char + 49);
  335.     kbAlt2             = TKeyCode(kb_Alt + kb_Char + 50);
  336.     kbAlt3             = TKeyCode(kb_Alt + kb_Char + 51);
  337.     kbAlt4             = TKeyCode(kb_Alt + kb_Char + 52);
  338.     kbAlt5             = TKeyCode(kb_Alt + kb_Char + 53);
  339.     kbAlt6             = TKeyCode(kb_Alt + kb_Char + 54);
  340.     kbAlt7             = TKeyCode(kb_Alt + kb_Char + 55);
  341.     kbAlt8             = TKeyCode(kb_Alt + kb_Char + 56);
  342.     kbAlt9             = TKeyCode(kb_Alt + kb_Char + 57);
  343.  
  344.     kbAltA             = TKeyCode(kb_Alt + kb_Char + kbA);
  345.     kbAltB             = TKeyCode(kb_Alt + kb_Char + kbB);
  346.     kbAltC             = TKeyCode(kb_Alt + kb_Char + kbC);
  347.     kbAltD             = TKeyCode(kb_Alt + kb_Char + kbD);
  348.     kbAltE             = TKeyCode(kb_Alt + kb_Char + kbE);
  349.     kbAltF             = TKeyCode(kb_Alt + kb_Char + kbF);
  350.     kbAltG             = TKeyCode(kb_Alt + kb_Char + kbG);
  351.     kbAltH             = TKeyCode(kb_Alt + kb_Char + kbH);
  352.     kbAltI             = TKeyCode(kb_Alt + kb_Char + kbI);
  353.     kbAltJ             = TKeyCode(kb_Alt + kb_Char + kbJ);
  354.     kbAltK             = TKeyCode(kb_Alt + kb_Char + kbK);
  355.     kbAltL             = TKeyCode(kb_Alt + kb_Char + kbL);
  356.     kbAltM             = TKeyCode(kb_Alt + kb_Char + kbM);
  357.     kbAltN             = TKeyCode(kb_Alt + kb_Char + kbN);
  358.     kbAltO             = TKeyCode(kb_Alt + kb_Char + kbO);
  359.     kbAltP             = TKeyCode(kb_Alt + kb_Char + kbP);
  360.     kbAltQ             = TKeyCode(kb_Alt + kb_Char + kbQ);
  361.     kbAltR             = TKeyCode(kb_Alt + kb_Char + kbR);
  362.     kbAltS             = TKeyCode(kb_Alt + kb_Char + kbS);
  363.     kbAltT             = TKeyCode(kb_Alt + kb_Char + kbT);
  364.     kbAltU             = TKeyCode(kb_Alt + kb_Char + kbU);
  365.     kbAltV             = TKeyCode(kb_Alt + kb_Char + kbV);
  366.     kbAltW             = TKeyCode(kb_Alt + kb_Char + kbW);
  367.     kbAltX             = TKeyCode(kb_Alt + kb_Char + kbX);
  368.     kbAltY             = TKeyCode(kb_Alt + kb_Char + kbY);
  369.     kbAltZ             = TKeyCode(kb_Alt + kb_Char + kbZ);
  370.  
  371.     kbAltF1            = TKeyCode(kb_Alt + kbF1);
  372.     kbAltF2            = TKeyCode(kb_Alt + kbF2);
  373.     kbAltF3            = TKeyCode(kb_Alt + kbF3);
  374.     kbAltF4            = TKeyCode(kb_Alt + kbF4);
  375.     kbAltF5            = TKeyCode(kb_Alt + kbF5);
  376.     kbAltF6            = TKeyCode(kb_Alt + kbF6);
  377.     kbAltF7            = TKeyCode(kb_Alt + kbF7);
  378.     kbAltF8            = TKeyCode(kb_Alt + kbF8);
  379.     kbAltF9            = TKeyCode(kb_Alt + kbF9);
  380.     kbAltF10           = TKeyCode(kb_Alt + kbF10);
  381.     kbAltF11           = TKeyCode(kb_Alt + kbF11);
  382.     kbAltF12           = TKeyCode(kb_Alt + kbF12);
  383.     kbAltCLeft         = TKeyCode(kb_Alt + kbCLeft);
  384.     kbAltCRight        = TKeyCode(kb_Alt + kbCRight);
  385.     kbAltCUp           = TKeyCode(kb_Alt + kbCUp);
  386.     kbAltCDown         = TKeyCode(kb_Alt + kbCDown);
  387.     kbAltDel           = TKeyCode(kb_Alt + kbDel);
  388.     kbAltIns           = TKeyCode(kb_Alt + kbIns);
  389.     kbAltEnd           = TKeyCode(kb_Alt + kbEnd);
  390.     kbAltHome          = TKeyCode(kb_Alt + kbHome);
  391.     kbAltPageDown      = TKeyCode(kb_Alt + kbPageDown);
  392.     kbAltPageUp        = TKeyCode(kb_Alt + kbPageUp);
  393.     kbAltBkSp          = TKeyCode(kb_Alt + kbBkSp);
  394.     kbAltCR            = TKeyCode(kb_Alt + kbCR);
  395.     kbAltSpace         = TKeyCode(kb_Alt + kbSpace);
  396.     kbAltTab           = TKeyCode(kb_Alt + kbTab);
  397.     kbAltEnter         = TKeyCode(kb_Alt + kbEnter);
  398.     kbAltPause         = TKeyCode(kb_Alt + kbPause);
  399.     kbAltBreak         = TKeyCode(kb_Alt + kbBreak);
  400. {$M-}
  401.  
  402.  
  403. Type
  404.     {General System Type. System constants apply To SystemMetrics method}
  405. {$M+}
  406.     TSystemMetrics     = LongInt;
  407.  
  408. Const
  409.     {System Value indices For TScreen.SystemMetrics()}
  410.     {$IFDEF OS2}
  411.     smCyTitlebar       = TSystemMetrics(SV_CYTITLEBAR);
  412.     smCyMenu           = TSystemMetrics(SV_CYMENU);
  413.     smCxMinMaxButton   = TSystemMetrics(SV_CXMINMAXBUTTON);
  414.     smCyMinMaxButton   = TSystemMetrics(SV_CYMINMAXBUTTON);
  415.     smCxSizeBorder     = TSystemMetrics(SV_CXSIZEBORDER);
  416.     smCySizeBorder     = TSystemMetrics(SV_CYSIZEBORDER);
  417.     smCxDlgBorder      = TSystemMetrics(SV_CXDLGFRAME);
  418.     smCyDlgBorder      = TSystemMetrics(SV_CYDLGFRAME);
  419.     smCxBorder         = TSystemMetrics(SV_CXBORDER);
  420.     smCyBorder         = TSystemMetrics(SV_CYBORDER);
  421.     smCxIcon           = TSystemMetrics(SV_CXICON);
  422.     smCyIcon           = TSystemMetrics(SV_CYICON);
  423.     smCxPointer        = TSystemMetrics(SV_CXPOINTER);
  424.     smCyPointer        = TSystemMetrics(SV_CYPOINTER);
  425.     smCxScreen         = TSystemMetrics(SV_CXSCREEN);
  426.     smCyScreen         = TSystemMetrics(SV_CYSCREEN);
  427.     smCxFullScreen     = TSystemMetrics(SV_CXFULLSCREEN);
  428.     smCyFullScreen     = TSystemMetrics(SV_CYFULLSCREEN);
  429.     smCxVScroll        = TSystemMetrics(SV_CXVSCROLL);
  430.     smCyHScroll        = TSystemMetrics(SV_CYHSCROLL);
  431.     smCxHScrollArrow   = TSystemMetrics(SV_CXHSCROLLARROW);
  432.     smCyHScrollArrow   = TSystemMetrics(SV_CYHSCROLL);
  433.     smCxVScrollArrow   = TSystemMetrics(SV_CXVSCROLL);
  434.     smCyVScrollArrow   = TSystemMetrics(SV_CYVSCROLLARROW);
  435.     smCxHSlider        = TSystemMetrics(SV_CXHSLIDER);
  436.     smCyVSlider        = TSystemMetrics(SV_CYVSLIDER);
  437.     smCMouseButtons    = TSystemMetrics(SV_CMOUSEBUTTONS);
  438.     smMousePresent     = TSystemMetrics(SV_MOUSEPRESENT);
  439.     smSwapButton       = TSystemMetrics(SV_SWAPBUTTON);
  440.     smCxDoubleClick    = TSystemMetrics(SV_CXDBLCLK);
  441.     smCyDoubleClick    = TSystemMetrics(SV_CYDBLCLK);
  442.     smDebug            = TSystemMetrics(SV_DEBUG);
  443.     {$ENDIF}
  444.     {$IFDEF Win32}
  445.     smCyTitlebar       = TSystemMetrics(SM_CYCAPTION);
  446.     smCyMenu           = TSystemMetrics(SM_CYMENU);
  447.     smCxMinMaxButton   = TSystemMetrics(SM_CXSIZE);
  448.     smCyMinMaxButton   = TSystemMetrics(SM_CYSIZE);
  449.     smCxSizeBorder     = TSystemMetrics(SM_CXFRAME);
  450.     smCySizeBorder     = TSystemMetrics(SM_CYFRAME);
  451.     smCxDlgBorder      = TSystemMetrics(SM_CXDLGFRAME);
  452.     smCyDlgBorder      = TSystemMetrics(SM_CYDLGFRAME);
  453.     smCxBorder         = TSystemMetrics(SM_CXBORDER);
  454.     smCyBorder         = TSystemMetrics(SM_CYBORDER);
  455.     smCxIcon           = TSystemMetrics(SM_CXICON);
  456.     smCyIcon           = TSystemMetrics(SM_CYICON);
  457.     smCxPointer        = TSystemMetrics(SM_CXCURSOR);
  458.     smCyPointer        = TSystemMetrics(SM_CYCURSOR);
  459.     smCxScreen         = TSystemMetrics(SM_CXSCREEN);
  460.     smCyScreen         = TSystemMetrics(SM_CYSCREEN);
  461.     smCxFullScreen     = TSystemMetrics(SM_CXFULLSCREEN);
  462.     smCyFullScreen     = TSystemMetrics(SM_CYFULLSCREEN);
  463.     smCxVScroll        = TSystemMetrics(SM_CXVSCROLL);
  464.     smCyHScroll        = TSystemMetrics(SM_CYHSCROLL);
  465.     smCxHScrollArrow   = TSystemMetrics(SM_CXHSCROLL);
  466.     smCyHScrollArrow   = TSystemMetrics(SM_CYHSCROLL);
  467.     smCxVScrollArrow   = TSystemMetrics(SM_CXVSCROLL);
  468.     smCyVScrollArrow   = TSystemMetrics(SM_CYVSCROLL);
  469.     smCxHSlider        = TSystemMetrics(SM_CXHTHUMB);
  470.     smCyVSlider        = TSystemMetrics(SM_CYVTHUMB);
  471.     smCMouseButtons    = TSystemMetrics(SM_CMOUSEBUTTONS);
  472.     smMousePresent     = TSystemMetrics(SM_MOUSEPRESENT);
  473.     smSwapButton       = TSystemMetrics(SM_SWAPBUTTON);
  474.     smCxDoubleClick    = TSystemMetrics(SM_CXDOUBLECLK);
  475.     smCyDoubleClick    = TSystemMetrics(SM_CYDOUBLECLK);
  476.     smDebug            = TSystemMetrics(SM_DEBUG);
  477.     {$ENDIF}
  478. {$M-}
  479.  
  480.  
  481. Const
  482.     {Standard Clipboard formats For Use within the SetData method In
  483.      TClipBoard}
  484.     {$IFDEF OS2}
  485.     cfText             = CF_TEXT;
  486.     cfBitmap           = CF_BITMAP;
  487.     cfMetaFile         = CF_METAFILE;
  488.     cfPalette          = CF_PALETTE;
  489.     cfDspText          = CF_DSPTEXT;
  490.     cfDspBitmap        = CF_DSPBITMAP;
  491.     cfDspMetaFile      = CF_DSPMETAFILE;
  492.     {$ENDIF}
  493.     {$IFDEF Win32}
  494.     cfText             = CF_TEXT;
  495.     cfBitmap           = CF_BITMAP;
  496.     cfMetaFile         = CF_METAFILEPICT;
  497.     cfPalette          = CF_PALETTE;
  498.     cfDspText          = CF_DSPTEXT;
  499.     cfDspBitmap        = CF_DSPBITMAP;
  500.     cfDspMetaFile      = CF_DSPMETAFILEPICT;
  501.     {$ENDIF}
  502.  
  503. Type
  504.     TClipBoard=Class(TComponent)
  505.       Private
  506.          FOpenWin: HWindow;
  507.          Function GetOwner:HWindow;
  508.          Function GetViewer:HWindow;
  509.          Procedure SetViewer(Viewer:HWindow);
  510.          Function GetFormatCount:LongInt;
  511.          Function GetFormats(Index:LongInt):LongWord;
  512.          Function GetAsText:AnsiString;
  513.          Procedure SetAsText(NewValue:AnsiString);
  514.       Public
  515.          Function Open(ahwnd:HWindow):Boolean;
  516.          Function Close:Boolean;
  517.          Function Empty:Boolean;
  518.          Function SetData(Data,format:LongWord):Boolean;
  519.          Function GetData(format:LongWord):LongWord;
  520.          Function CountFormats:LongInt;
  521.          Function EnumFormats(FormatIndex:LongWord):LongWord;
  522.          Function IsFormatAvailable(Format:LongWord):Boolean;
  523.          Function RegisterFormat(Const S:String):LongWord;
  524.          Function GetFormatName(format:LongWord):String;
  525.          Procedure SetTextBuf(Buffer:PChar);
  526.          Function HasFormat(Format:LongWord):Boolean;
  527.          Procedure Clear;
  528.          Property Parent:HWindow Read GetOwner;
  529.          Property Viewer:HWindow Read GetViewer Write SetViewer;
  530.          Property AsText:AnsiString read GetAsText write SetAsText;
  531.          Property FormatCount:LongInt read GetFormatCount;
  532.          Property Formats[Index:LongInt]:LongWord read GetFormats;
  533.     End;
  534.  
  535.  
  536. Type
  537.     {predefined mouse Cursor constants}
  538. {$M+}
  539.     TCursor       = LongInt;
  540.  
  541. Const
  542.     crDefault     = TCursor(0);
  543.     crNone        = TCursor(-1);
  544.     crArrow       = TCursor(-2);
  545.     crCross       = TCursor(-3);
  546.     crIBeam       = TCursor(-4);
  547.     crSize        = TCursor(-5);
  548.     crSizeNESW    = TCursor(-6);
  549.     crSizeNS      = TCursor(-7);
  550.     crSizeNWSE    = TCursor(-8);
  551.     crSizeWE      = TCursor(-9);
  552.     crUpArrow     = TCursor(-10);
  553.     crHourGlass   = TCursor(-11);
  554.     crDrag        = TCursor(-12);
  555.     crNoDrop      = TCursor(-13);
  556.     crHSplit      = TCursor(-14);
  557.     crVSplit      = TCursor(-15);
  558.     crMultiDrag   = TCursor(-16);
  559.     crSQLWait     = TCursor(-17);
  560.     crNo          = TCursor(-18);
  561.     crAppStart    = TCursor(-19);
  562.     crHelp        = TCursor(-20);
  563.  
  564.  
  565. Type
  566.     {Standard Font types}
  567.     TFontType=(ftBitmap,ftOutline);
  568.  
  569.     {Standard Font Attributes}
  570.     TFontAttributes=Set Of(faItalic,faUnderScore,faOutline,faStrikeOut,faBold);
  571.  
  572.     {Standard Font pitches}
  573.     TFontPitch=(fpFixed,fpProportional);
  574.  
  575.     {Standard Font character Set}
  576.     TFontCharSet=(fcsSBCS,fcsDBCS,fcsMBCS);  {Single,Double,mixed Byte}
  577. {$M-}
  578.  
  579.  
  580. ////////////////////////////////////////////////////////////////////////////
  581. //  Change Font Attributes only If you have created A Font Copy using
  582. //  CreateCompatibleFont Or created A New Font using GetFontFromPointSize
  583. //  Changing predefined Fonts As returned from GetSystemSmallFont Or
  584. //  GetSystemFixedFont will have global effects !
  585. ////////////////////////////////////////////////////////////////////////////
  586.  
  587.     TFont=Class(TComponent)
  588.       Private
  589.          FInternalPointSize:LongWord;   {internal Point.Name Value Or Nil}
  590.          {$IFDEF OS2}
  591.          FFontInfo:FONTMETRICS;
  592.          {$ENDIF}
  593.          {$IFDEF Win32}
  594.          FFontInfo:LOGFONT;
  595.          FHandle:HWindow;
  596.          FRefCount:LongWord;
  597.          {$ENDIF}
  598.          FUseCount:LongWord;
  599.          FCustom:Boolean;
  600.          FDefault:Boolean;
  601.          FAutoDestroy:Boolean;
  602.          FFontType:TFontType;
  603.          FAlternateName:PString; //Alternate name for SCU Win<->OS2
  604.          Function GetName:String;
  605.          Function GetFamily:String;
  606.          Function GetPitch:TFontPitch;
  607.          Function GetHeight:LongInt;
  608.          Function GetWidth:LongInt;
  609.          Function GetAttributes:TFontAttributes;
  610.          Procedure SetHeight(NewHeight:LongInt);
  611.          Procedure SetWidth(NewWidth:LongInt);
  612.          Procedure SetAttributes(NewAttr:TFontAttributes);
  613.          Function GetInternalLeading:LongInt;
  614.          Function GetNominalPointSize:LongInt;
  615.          Function GetMinimumPointSize:LongInt;
  616.          Function GetMaximumPointSize:LongInt;
  617.          Function GetCharSet:TFontCharSet;
  618.       Protected
  619.          Procedure SetupComponent;Override;
  620.       Public
  621.          Constructor Create(AOwner:TComponent);Override;
  622.          Destructor Destroy;Override;
  623.          Function WriteSCUResourceName(Stream:TResourceStream;ResName:TResourceName):Boolean;
  624.          //If This Is Set To True, the Font Is automatically freed when the Control that owns
  625.          //the Font Is destroyed And no other Control owns the Font
  626.          //This option Is only Valid For Fonts created With "CreateCompatibleFont"
  627.          Property IsDefault:Boolean Read FDefault; //undocumented !
  628.          Property AutoDestroy:Boolean Read FAutoDestroy Write FAutoDestroy;
  629.          Property FaceName:String Read GetName;
  630.          Property Family:String Read GetFamily;
  631.          Property Height:LongInt Read GetHeight Write SetHeight;
  632.          Property Width:LongInt Read GetWidth Write SetWidth;
  633.          Property InternalLeading:LongInt Read GetInternalLeading;
  634.          Property NominalPointSize:LongInt Read GetNominalPointSize;
  635.          Property MinimumPointSize:LongInt Read GetMinimumPointSize;
  636.          Property MaximumPointSize:LongInt Read GetMaximumPointSize;
  637.          Property Attributes:TFontAttributes Read GetAttributes Write SetAttributes;
  638.          Property Pitch:TFontPitch Read GetPitch;
  639.          Property CharSet:TFontCharSet Read GetCharSet;
  640.          Property FontType:TFontType Read FFontType;
  641.          Property PointSize:LongWord Read FInternalPointSize Write FInternalPointSize;
  642.     End;
  643.  
  644.     {Canvas Forward}
  645.     TCanvas=Class;
  646.  
  647.     {Standard Class styles}
  648.     TClassStyles=Set Of (wcsSizeRedraw,wcsHitTest,
  649.                          wcsFrame,wcsClipChildren,wcsClipSiblings,
  650.                          wcsParentClip,wcsSaveBits,wcsSyncPaint,wcsOwnDC);
  651.  
  652.     {Window Class Record}
  653.     TClassData=Record
  654.          StandardClass:Boolean;
  655.          ClassName:Cstring;
  656.          WindowProc:Pointer;
  657.          ClassStyle:TClassStyles;
  658.          DataCount:LongWord;
  659.          ClassULong:LongWord; {only used For OS/2}
  660.     End;
  661.  
  662.  
  663.     {internal Window Procedure format}
  664.     {$IFDEF OS2}
  665.     TWndProc=Function(Win,Msg,para1,para2:LongWord):LongWord;CDECL;
  666.     {$ENDIF}
  667.     {$IFDEF Win32}
  668.     TWndProc=Function(Win,Msg,para1,para2:LongWord):LongWord;APIENTRY;
  669.     {$ENDIF}
  670.  
  671. {$M+}
  672.     {Toolbar alignments}
  673.     TToolbarAlign=(tbLeft,tbRight,tbTop,tbBottom);
  674.  
  675.     TToolbarAlignments=Set Of TToolbarAlign;
  676.  
  677.     TToolBarBevel=(tbRaised,tbLowered,tbNone);
  678. {$M-}
  679.  
  680.     {Toolbar Forward}
  681.     TToolbar=Class;
  682.     TToolBarClass=Class Of TToolbar;
  683.  
  684.     {Control Forward}
  685.     TControl=Class;
  686.     TControlClass=Class Of TControl;
  687.  
  688.     {Form Forward}
  689.     TForm=Class;
  690.     TFormClass=Class Of TForm;
  691.  
  692.     {Timer Forward}
  693.     TTimer=Class;
  694.     TTimerClass=Class Of TTimer;
  695.  
  696.     {Graphic Forward}
  697.     TGraphic=Class;
  698.  
  699.     {Standard help context Type}
  700.     THelpContext=LongWord;
  701.  
  702.  
  703.     TTimer=Class(TComponent)
  704.       Private
  705.          FId:LongInt;
  706.          FRunning:Boolean;
  707.          FTime:LongInt;
  708.          FInterval:LongInt;
  709.          FOnTimer:TNotifyEvent;
  710.       Protected
  711.          Procedure SetupComponent;Override;
  712.          Procedure Timer;Virtual;
  713.       Public
  714.          Destructor Destroy;Override;
  715.          Procedure Start;
  716.          Procedure Stop;
  717.          Property Id:LongInt Read FId;
  718.          Property Running:Boolean Read FRunning;
  719.          Property Time:LongInt Read FTime Write FTime;
  720.       Published
  721.          Property Interval:LongInt Read FInterval Write FInterval;
  722.          Property OnTimer:TNotifyEvent Read FOnTimer Write FOnTimer;
  723.     End;
  724.  
  725.  
  726.     {Standard Menu entry styles}
  727.     TMenuItemStyles=Set Of (misText,misBitmap,misOwnerDraw,
  728.          misSubmenu,misMultMenu,misSysCommand,misHelp,misStatic,
  729.          misButtonSeparator,misBreak,misBreakSeparator,misGroup,misSingle);
  730.  
  731.     {Standard Menu entry Flags}
  732.     TMenuItemFlags=Set Of (mifNoDismiss,mifFramed,mifChecked,mifDisabled,
  733.          mifHilited);
  734.  
  735. {$M+}
  736.     TMenuBreak=(mbNone,mbBreak,mbBarBreak,mbSeparator);
  737. {$M-}
  738.  
  739.     {Menu Forward}
  740.     TMenu=Class;
  741.  
  742.     TMenuItem=Class(TComponent)
  743.       Private
  744.          FParent:TMenuItem;
  745.          FMenu:TMenu;
  746.          FMenuOwner:TControl; {Form}
  747.          FHandle:HWindow;
  748.          FItems:TList;
  749.          FInitItems:TList;   {FItems Or Nil}
  750.          FCaption:PString;
  751.          FStyles:TMenuItemStyles;
  752.          FFlags:TMenuItemFlags;
  753.          FGlyph:TGraphic;
  754.          FCommand:TCommand;
  755.          FInternalCommand:TCommand;
  756.          FCreated:Boolean;
  757.          FDefWndProc:TWndProc;
  758.          FHelpContext:THelpContext;
  759.          FShortCut:TKeyCode;
  760.          FHint:PString;
  761.          FOnClick:TNotifyEvent;
  762.          {$IFDEF OS2}
  763.          Procedure WMChar(Var Msg:TWMChar); Message WM_CHAR;
  764.          Procedure WMHelp(Var Msg:TMessage); Message WM_HELP;
  765.          {$ENDIF}
  766.          Procedure SetShortCut(NewAccel:TKeyCode);
  767.          Function GetCaption:String;
  768.          Procedure SetCaption(NewCaption:String);
  769.          Procedure SetStyles(NewStyles:TMenuItemStyles);
  770.          Procedure SetFlags(NewFlags:TMenuItemFlags);
  771.          Function GetULongFromStyle:LongWord;
  772.          Function GetULongFromFlags:LongWord;
  773.          Procedure SetGlyph(NewGlyph:TGraphic);
  774.          Procedure SetHint(Const NewText:String);
  775.          Function GetHint:String;
  776.          Function GetChecked:Boolean;
  777.          Procedure SetChecked(Value:Boolean);
  778.          Function GetEnabled:Boolean;
  779.          Procedure SetEnabled(Value:Boolean);
  780.          Function GetBreak:TMenuBreak;
  781.          Procedure SetBreak(Value:TMenuBreak);
  782.          Function GetSubMenu:Boolean;
  783.          Procedure SetSubMenu(Value:Boolean);
  784.          Function GetCount:LongInt;
  785.          Function GetItem(Index:LongInt):TMenuItem;
  786.          Function GetMenuIndex:LongInt;
  787.          Function GetIsEditMenuItem:Boolean;
  788.          {$IFDEF Win32}
  789.          Procedure RedrawMenuBar;
  790.          {$ENDIF}
  791.       Protected
  792.          Procedure SetupComponent;Override;
  793.          Procedure GetChildren(Proc:TGetChildProc);Override;
  794.          Procedure LoadedFromSCU(SCUParent:TComponent);Override;
  795.          Procedure CreateWnd;Virtual;
  796.          Property Flags:TMenuItemFlags Read FFlags Write SetFlags;
  797.          Property Styles:TMenuItemStyles Read FStyles Write SetStyles;
  798.       Public
  799.          Destructor Destroy;Override;
  800.          Procedure Add(Item:TMenuItem);
  801.          Procedure Insert(Index:LongInt;Item:TMenuItem);
  802.          Function IndexOf(Item:TMenuItem):LongInt;
  803.          Procedure Click;Virtual;
  804.          Property IsEditMenuItem:Boolean Read GetIsEditMenuItem; {raus}
  805.          Property Handle:HWindow Read FHandle;
  806.          Property Count:LongInt Read GetCount;
  807.          Property Items[Index:LongInt]:TMenuItem Read GetItem; Default;
  808.          Property MenuIndex:LongInt Read GetMenuIndex; {Write SetMenuIndex;}
  809.          Property Parent:TMenuItem Read FParent;
  810.          Property Glyph:TGraphic Read FGlyph Write SetGlyph;
  811.       Published
  812.          Property Caption:String Read GetCaption Write SetCaption;
  813.          Property Command:TCommand Read FCommand Write FCommand;
  814.          Property HelpContext:THelpContext Read FHelpContext Write FHelpContext;
  815.          Property ShortCut:TKeyCode Read FShortCut Write SetShortCut;
  816.          Property Hint:String Read GetHint Write SetHint;
  817.          Property Checked:Boolean Read GetChecked Write SetChecked;
  818.          Property Enabled:Boolean Read GetEnabled Write SetEnabled;
  819.          Property Break:TMenuBreak Read GetBreak Write SetBreak;
  820.          Property Submenu:Boolean Read GetSubMenu Write SetSubMenu;
  821.          Property OnClick:TNotifyEvent Read FOnClick Write FOnClick;
  822.     End;
  823.     TMenuItemClass=Class Of TMenuItem;
  824.  
  825.  
  826.     TMenu=Class(TComponent)
  827.       Private
  828.          FParent:TControl;      {Frame}
  829.          FItems:TMenuItem;
  830.          FInitItems:TMenuItem;  {FItems Or Nil}
  831.          FHandle:HWindow;
  832.          FResourceId:LongWord;
  833.          {$IFDEF OS2}
  834.          FDefWndProc:TWndProc;
  835.          {$ENDIF}
  836.          FFont:TFont;
  837.          FAlternateFontName:PString;
  838.          {$IFDEF OS2}
  839.          Procedure WMHelp(Var Msg:TMessage); Message WM_HELP;
  840.          Procedure WMChar(Var Msg:TWMChar); Message WM_CHAR;
  841.          {$ENDIF}
  842.          Function ItemFromCommand(Command:TCommand):TMenuItem;
  843.          Function ItemFromInternalCommand(Command:TCommand):TMenuItem;
  844.          Function GetSelectedMenuItem:TMenuItem;
  845.          Function GetWidth:LongInt;
  846.          Function GetHeight:LongInt;
  847.          Procedure SetFont(NewFont:TFont);
  848.       Protected
  849.          Procedure SetupComponent;Override;
  850.          Procedure GetChildren(Proc:TGetChildProc);Override;
  851.          Procedure LoadedFromSCU(SCUParent:TComponent);Override;
  852.          Procedure LoadResource;
  853.          Procedure CharEvent(entry:TMenuItem;Var key:Char;REP:Byte);Virtual;
  854.          Procedure ScanEvent(entry:TMenuItem;Var KeyCode:TKeyCode;REP:Byte);Virtual;
  855.          Procedure CreateMenu;Virtual;
  856.          Procedure Show;Virtual;
  857.          Property Width:LongInt Read GetWidth;
  858.          Property Height:LongInt Read GetHeight;
  859.       Public
  860.          Destructor Destroy;Override;
  861.          Procedure DisableCommands(Cmds:Array Of TCommand);
  862.          Procedure EnableCommands(Cmds:Array Of TCommand);
  863.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
  864.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  865.          Property Handle:HWindow Read FHandle;
  866.          Property Items:TMenuItem Read FItems;
  867.          Property MenuItems[Command:TCommand]:TMenuItem Read ItemFromCommand;
  868.       Published
  869.          Property ResourceId:LongWord Read FResourceId Write FResourceId;
  870.          Property Font:TFont Read FFont Write SetFont;
  871.     End;
  872.     TMenuClass=Class Of TMenu;
  873.  
  874.  
  875.     {MainMenu Class}
  876.     TMainMenu=Class(TMenu)
  877.       Protected
  878.          Procedure SetupComponent;Override;
  879.          Procedure Show;Override;
  880.       Public
  881.          Property Height;
  882.     End;
  883.     TMainMenuClass=Class Of TMainMenu;
  884.  
  885.  
  886.     {$M+}
  887.     TPopupAlignment=(paLeft,paCenter,paRight);
  888.     {$M-}
  889.  
  890.     {PopupMenu Class}
  891.     TPopupMenu=Class(TMenu)
  892.       Private
  893.          FAutoPopup:Boolean;
  894.          FPopupComponent:TComponent;
  895.          FAlignment:TPopupAlignment;
  896.          FOnPopup:TNotifyEvent;
  897.       Protected
  898.          Procedure SetupComponent;Override;
  899.          Procedure CreateMenu;Override;
  900.       Public
  901.          Procedure Popup(X,Y:LongInt);Virtual;
  902.          Property Width;
  903.          Property Height;
  904.          Property PopupComponent:TComponent Read FPopupComponent Write FPopupComPonent;
  905.       Published
  906.          Property AutoPopup:Boolean Read FAutoPopup Write FAutoPopup;
  907.          Property Alignment:TPopupAlignment Read FAlignment Write FAlignment;
  908.          Property OnPopup:TNotifyEvent Read FOnPopup Write FOnPopup;
  909.     End;
  910.     TPopupMenuClass=Class Of TPopupMenu;
  911.  
  912.  
  913.     TCaret=Class
  914.       Private
  915.          FLeft,FBottom,FWidth,FHeight:LongInt;
  916.          FCreated:Boolean;
  917.          FBlinkTime:LongInt;
  918.          FOldBlinkTime:LongInt;
  919.          FControl:TControl;
  920.          Procedure SetBlinkTime(ms:LongInt);
  921.       Public
  922.          Constructor Create(Owner:TControl);Virtual;
  923.          Procedure SetPos(Left,Bottom:LongInt);
  924.          Procedure SetSize(Width,Height:LongInt);
  925.          Procedure Show;
  926.          Procedure Hide;
  927.          Procedure Remove;
  928.          Property Left:LongInt Read FLeft Write FLeft;
  929.          Property Bottom:LongInt Read FBottom Write FBottom;
  930.          Property Width:LongInt Read FWidth Write FWidth;
  931.          Property Height:LongInt Read FHeight Write FHeight;
  932.          Property Created:Boolean Read FCreated Write FCreated;
  933.          Property BlinkTime:LongInt Read FBlinkTime Write SetBlinkTime;
  934.     End;
  935.  
  936.  
  937. {$M+}
  938.     TScrollCode=(scLineUp,scLineDown,scPageUp,scPageDown,
  939.                  scColumnLeft,scColumnRight,scPageLeft,scPageRight,
  940.                  scHorzTrack,scVertTrack,scHorzPosition,scVertPosition,
  941.                  scHorzEndScroll,scVertEndScroll);
  942.  
  943.     TDragMode=(dmManual,dmAutomatic);
  944.     TDragState=(dsDragEnter,dsDragMove,dsDragLeave);
  945.  
  946.     TDragDropSourceType=(drtSibyl,drtSibylObject,drtText,drtBinData,drtString);
  947.     TDragDropRenderType=(drmSibyl,drmSibylObject,drmPrint,drmFile,drmString);
  948.     TDragDropOperation=(doDefault,doCopy,doMove,doLink,doUnknown);
  949.     TDragDropSupportedOps=Set Of(doCopyable,doMoveable,doLinkable);
  950.  
  951.     PDragDropData=^TDragDropData;
  952.     {$M+}
  953.     TDragDropData=Record
  954.     {$M-}
  955.          SourceWindow:HWindow;
  956.          SourceType:TDragDropSourceType;
  957.          RenderType:TDragDropRenderType;
  958.          SourceString:String;
  959.          RenderString:String;
  960.          ContainerName:String;
  961.          SourceFileName:String;
  962.          TargetFileName:String;
  963.          SupportedOps:TDragDropSupportedOps;
  964.          DragOperation:TDragDropOperation;
  965.          ItemId:LongWord;
  966.     End;
  967.  
  968.     TExternalDragDropObject=Class(TComponent)
  969.       Private
  970.          FDragDropData:TDragDropData;
  971.       Public
  972.          Property SourceWindow:HWindow Read FDragDropData.SourceWindow;
  973.          Property SourceType:TDragDropSourceType Read FDragDropData.SourceType;
  974.          Property RenderType:TDragDropRenderType Read FDragDropData.RenderType;
  975.          Property SourceString:String Read FDragDropData.SourceString;
  976.          Property RenderString:String Read FDragDropData.RenderString;
  977.          Property ContainerName:String Read FDragDropData.ContainerName;
  978.          Property SourceFileName:String Read FDragDropData.SourceFileName;
  979.          Property TargetFileName:String Read FDragDropData.TargetFileName;
  980.          Property SupportedOps:TDragDropSupportedOps Read FDragDropData.SupporteDops;
  981.          Property DragOperation:TDragDropOperation Read FDragDropData.DragOperatIon;
  982.          Property ItemId:LongWord Read FDragDropData.ItemId;
  983.          Property DragDropData:TDragDropData read FDragDropData write FDragDropData;
  984.     End;
  985. {$M-}
  986.  
  987.     {ScrollbarControl Forward}
  988.     TScrollBar=Class;
  989.     TScrollBarClass=Class Of TScrollBar;
  990.  
  991. {$M+}
  992.     {Standard mouse Button states}
  993.     TMouseButton=(mbRight,mbLeft,mbMiddle);
  994.  
  995.     TShiftState=Set Of (ssShift,ssAlt,ssCtrl,ssRight,ssLeft,ssMiddle,ssDouble);
  996.  
  997.  
  998.     {TControl event types}
  999.     TCommandEvent=Procedure(Sender:TObject;Var Command:TCommand) Of Object;
  1000.     TKeyPressEvent=Procedure(Sender:TObject;Var key:Char) Of Object;
  1001.     TScanEvent=Procedure(Sender:TObject;Var KeyCode:TKeyCode) Of Object;
  1002.     TMouseEvent=Procedure(Sender:TObject;Button:TMouseButton;
  1003.          Shift:TShiftState;X,Y:LongInt) Of Object;
  1004.     TMouseMoveEvent=Procedure(Sender:TObject;Shift:TShiftState;
  1005.          X,Y:LongInt) Of Object;
  1006.     TPaintEvent=Procedure(Sender:TObject;Const rec:TRect) Of Object;
  1007.  
  1008.     TCanDragEvent=Procedure(Sender:TObject;X,Y:LongInt;Var Accept:Boolean) Of Object;
  1009.     TStartDragEvent=Procedure(Sender:TObject;Var DragData:TDragDropData) Of Object;
  1010.     TEndDragEvent=Procedure(Sender:TObject;target:TObject;X,Y:LongInt) Of Object;
  1011.     TDragOverEvent=Procedure(Sender:TObject;Source:TObject;X,Y:LongInt;
  1012.          State:TDragState;Var Accept:Boolean) Of Object;
  1013.     TDragDropEvent=Procedure(Sender:TObject;Source:TObject;X,Y:LongInt) Of Object;
  1014.  
  1015.     TMenuEvent=Procedure(Sender:TObject;AMenu:TMenu;entry:TMenuItem) Of Object;
  1016.  
  1017.  
  1018.     TScrollStyle=(ssNone,ssHorizontal,ssVertical,ssBoth);
  1019.  
  1020.     {Text Alignment constants}
  1021.     TAlignment=(taLeftJustify,taRightJustify,taCenter);
  1022.  
  1023.     {Alignment constants}
  1024.     TAlign=(alNone,alTop,alBottom,alLeft,alRight,alClient,alFrame,alScale,
  1025.          alCenter,alCenterX,alCenterY,
  1026.          alFixedLeftTop,alFixedLeftBottom,alFixedRightTop,alFixedRightBottom);
  1027.  
  1028.     {X Alignment constants}
  1029.     TXAlign=(xaNone,xaParent,xaLeft,xaRight,xaCenter);
  1030.  
  1031.     {Y Alignment constants}
  1032.     TYAlign=(yaNone,yaParent,yaBottom,yaTop,yaCenter);
  1033.  
  1034.     {X stretching constants}
  1035.     TXStretch=(xsNone,xsParent,xsFrame,xsScale,xsFixed);
  1036.  
  1037.     {Y stretching constants}
  1038.     TYStretch=(ysNone,ysParent,ysFrame,ysScale,ysFixed);
  1039.  
  1040.     TZOrder=(zoNone,zoBottom,zoTop);
  1041. {$M-}
  1042.  
  1043.     TMouseParam=Record
  1044.          pt:TPoint;
  1045.          Button:TMouseButton;
  1046.          ShiftState:TShiftState;
  1047.     End;
  1048.  
  1049.     TKeyParam=Record
  1050.          KeyCode:TKeyCode;
  1051.          RepeatCount:Byte;
  1052.     End;
  1053.  
  1054.     TDesignerNotifyCode=(dncMouseDown,dncMouseUp,dncMouseClick,
  1055.                          dncMouseDblClk,dncMouseMove,dncChar,dncScan,
  1056.                          dncPaint,dncSCUModified,dncNewMenuItem,
  1057.                          dncPropertyUpdate);
  1058.  
  1059.     TDesignerNotifyStruct=Record
  1060.          Sender:TComponent;
  1061.          Code:TDesignerNotifyCode;
  1062.          return:LongInt;
  1063.          Case TDesignerNotifyCode Of
  1064.              dncMouseDown,
  1065.              dncMouseUp,
  1066.              dncMouseClick,
  1067.              dncMouseDblClk,
  1068.              dncMouseMove:        (mouseparam:TMouseParam);
  1069.              dncChar,dncScan:     (keyparam:TKeyParam);
  1070.              dncPaint:            (rec:TRect);
  1071.     End;
  1072.  
  1073.  
  1074.     TCreateParams=Record
  1075.          Style:LongInt;
  1076.          ExStyle:LongInt;
  1077.          FrameStyle:LongInt;
  1078.     End;
  1079.  
  1080.  
  1081.     PScaleInfo=^TScaleInfo;
  1082.     TScaleInfo=Record
  1083.          Left,Right,Bottom,Top:Extended;
  1084.     End;
  1085.  
  1086.     PFrameInfo=^TFrameInfo;
  1087.     TFrameInfo=Record
  1088.          Left,Right,Bottom,Top:LongInt;
  1089.     End;
  1090.  
  1091.  
  1092.     TLastMsg=Class
  1093.       Private
  1094.          FControl:TControl;
  1095.          Function GetHandled:LongBool;
  1096.          Procedure SetHandled(Value:LongBool);
  1097.          Function GetResult:LongWord;
  1098.          Procedure SetResult(Value:LongWord);
  1099.       Public
  1100.          Procedure CallDefaultHandler;
  1101.          Property Handled:LongBool Read GetHandled Write SetHandled;
  1102.          Property Result:LongWord Read GetResult Write SetResult;
  1103.     End;
  1104.  
  1105.     {$M+}
  1106.     TControlState = Set Of (csLButtonDown, csClicked, csPalette,
  1107.                             csReadingState, csAlignmentNeeded, csFocusing, csCreating,
  1108.                             csPaintCopy,csWindowDestroying);
  1109.  
  1110.     TControlStyle = Set Of (csCaptureMouse,csFramed,csFixedWidth,csFixedHeight,
  1111.                             csDisplayDragImage,csHintWindow);
  1112.     {$M-}
  1113.  
  1114.     TCloseQueryEvent=Procedure(Sender:TObject;Var CanClose:Boolean) Of Object;
  1115.  
  1116.     TControl=Class(TComponent)
  1117.       Private
  1118.          FControlState:TControlState;
  1119.          FControlStyle:TControlStyle;
  1120.          FParent:TControl;
  1121.          FControls:TList;
  1122.          FWindowId:LongWord;
  1123.          FDefWndProc:TWndProc;
  1124.          FCursor:TCursor;
  1125.          FHandle:HWindow;
  1126.          FCanvas:TCanvas;
  1127.          FInitCanvas:Boolean;
  1128.          FCaption:PString;
  1129.          FFrame:TControl;
  1130.          FLeft,FBottom,FWidth,FHeight:LongInt;
  1131.          FXAlign:TXAlign;
  1132.          FYAlign:TYAlign;
  1133.          FXStretch:TXStretch;
  1134.          FYStretch:TYStretch;
  1135.          FZOrder:TZOrder;
  1136.          FPenColor:TColor;
  1137.          FColor:TColor;
  1138.          FHasFocus:Boolean;
  1139.          FIsToolBar:Boolean;
  1140.          {$IFDEF Win32}
  1141.          FClickTime:LongInt;
  1142.          FLastLButtonDownTime:LongInt;
  1143.          FLastRButtonDownTime:LongInt;
  1144.          FDefFontHandle:LongWord;
  1145.          FCtlBrush:LongWord;
  1146.          {$ENDIF}
  1147.          FFont:TFont;
  1148.          FEnabled:Boolean;
  1149.          FVisible:Boolean;
  1150.          FCursorTabStop:Boolean;
  1151.          FTabStop:Boolean;
  1152.          FTabOrder:LongInt;
  1153.          FTabList:TList;
  1154.          FForm:TForm;
  1155.          FHint:PString;
  1156.          FShowHint:Boolean;
  1157.          FParentShowHint:Boolean;
  1158.          FParentFont:Boolean;
  1159.          FParentPenColor:Boolean;
  1160.          FParentColor:Boolean;
  1161.          FUpdateEnabled:Boolean;
  1162.          FOldEnabledState:Boolean;
  1163.          FHelpContext:THelpContext;
  1164.          FAutoScale:PScaleInfo;
  1165.          FAutoFrame:PFrameInfo;
  1166.          FLastDeadKey:Word;
  1167.          FInitControls:Boolean;
  1168.          FFirstShow:Boolean;
  1169.          FOwnerDraw:Boolean;
  1170.          FHandlesDesignMouse:Boolean;
  1171.          FHandlesDesignKey:Boolean;
  1172.          FCommand:TCommand;
  1173.          FModalParent:TControl;
  1174.          FUpdatingPP:Boolean;
  1175.          FDragMode:TDragMode;
  1176.          FDragState:TDragState;
  1177.          FDragControl:TControl;
  1178.          FDragging:Boolean;
  1179.          FDragCursor:TCursor;
  1180.          FLastDragOperation:TDragDropOperation;
  1181.          {$IFDEF OS2}
  1182.          FDragInfo:PDRAGINFO;
  1183.          FDragCanvas:TCanvas;
  1184.          {$ENDIF}
  1185.          FAlternateFontName:PString;
  1186.          FCtl3d:Boolean;
  1187.          FMouseCapture:Boolean;
  1188.          FLastMsg:TLastMsg;
  1189.          FLastMsgAdr:PMessage;
  1190.          IsFontChangeEnabled:Boolean;
  1191.          IsStandardControl:Boolean;
  1192.          IsEditControl:Boolean;
  1193.          FPopupMenu:TPopupMenu;
  1194.          FOnEnter:TNotifyEvent;
  1195.          FOnExit:TNotifyEvent;
  1196.          FOnKeyPress:TKeyPressEvent;
  1197.          FOnScan:TScanEvent;
  1198.          FOnMouseDown:TMouseEvent;
  1199.          FOnMouseMove:TMouseMoveEvent;
  1200.          FOnMouseUp:TMouseEvent;
  1201.          FOnMouseClick:TMouseEvent;
  1202.          FOnMouseDblClick:TMouseEvent;
  1203.          FOnResize:TNotifyEvent;
  1204.          FOnMove:TNotifyEvent;
  1205.          FOnPaint:TPaintEvent;
  1206.          FOnBeforePaint,FOnAfterPaint:TPaintEvent;
  1207.          FOnCommand:TCommandEvent;
  1208.          FOnSetupShow:TNotifyEvent;
  1209.          FOnShow:TNotifyEvent;
  1210.          FOnHide:TNotifyEvent;
  1211.          FOnCanDrag:TCanDragEvent;
  1212.          FOnStartDrag:TStartDragEvent;
  1213.          FOnEndDrag:TEndDragEvent;
  1214.          FOnDragOver:TDragOverEvent;
  1215.          FOnDragDrop:TDragDropEvent;
  1216.          FOnFontChange:TNotifyEvent;
  1217.          FOnClick:TNotifyEvent;
  1218.          FOnDblClick:TNotifyEvent;
  1219.          FOnCloseQuery:TCloseQueryEvent;
  1220.       Private
  1221.          {$IFDEF OS2}
  1222.          Procedure WMBeginDrag(Var Msg:TMessage); Message WM_BEGINDRAG;
  1223.          Procedure WMEndDrag(Var Msg:TMessage); Message WM_ENDDRAG;
  1224.          Procedure DMDragOver(Var Msg:TMessage); Message DM_DRAGOVER;
  1225.          Procedure DMDragLeave(Var Msg:TMessage); Message DM_DRAGLEAVE;
  1226.          Procedure DMDrop(Var Msg:TMessage); Message DM_DROP;
  1227.          Procedure WMControl(Var Msg:TMessage); Message WM_CONTROL;
  1228.          Procedure WMButton1Down(Var Msg:TWMButton1Down); Message WM_BUTTON1DOWN;
  1229.          Procedure WMButton2Down(Var Msg:TWMButton2Down); Message WM_BUTTON2DOWN;
  1230.          Procedure WMSize(Var Msg:TWMSize); Message WM_SIZE;
  1231.          Procedure WMMove(Var Msg:TWMMove); Message WM_MOVE;
  1232.          Procedure WMPaint(Var Msg:TMessage); Message WM_PAINT;
  1233.          Procedure WMEraseBackGround(Var Msg:TMessage); Message WM_ERASEBACKGROUND;
  1234.          Procedure WMPresParamChanged(Var Msg:TMessage); Message WM_PRESPARAMCHANGED;
  1235.          Procedure WMChar(Var Msg:TWMChar); Message WM_CHAR;
  1236.          Procedure WMQueryConvertPos(Var Msg:TMessage); Message WM_QUERYCONVERTPOS;
  1237.          Procedure WMCommand(Var Msg:TWMCommand); Message WM_COMMAND;
  1238.          Procedure WMSetFocus(Var Msg:TWMSetFocus); Message WM_SETFOCUS;
  1239.          Procedure WMButton1Up(Var Msg:TWMButton1Up); Message WM_BUTTON1UP;
  1240.          Procedure WMButton2Up(Var Msg:TWMButton2Up); Message WM_BUTTON2UP;
  1241.          Procedure WMButton1Click(Var Msg:TWMButton1Click); Message WM_BUTTON1CLICK;
  1242.          Procedure WMButton1DblClk(Var Msg:TWMButton1DblClk); Message WM_BUTTON1DBLCLK;
  1243.          Procedure WMButton2Click(Var Msg:TWMButton2Click); Message WM_BUTTON2CLICK;
  1244.          Procedure WMButton2DblClk(Var Msg:TWMButton2DblClk); Message WM_BUTTON2DBLCLK;
  1245.          Procedure WMMouseMove(Var Msg:TWMMouseMove); Message WM_MOUSEMOVE;
  1246.          Procedure WMHScroll(Var Msg:TWMScroll); Message WM_HSCROLL;
  1247.          Procedure WMVScroll(Var Msg:TWMScroll); Message WM_VSCROLL;
  1248.          Procedure WMDestroy(Var Msg:TWMDestroy); Message WM_DESTROY;
  1249.          Procedure WMCaptureFocus(Var Msg:TMessage); Message WM_CAPTUREFOCUS;
  1250.          Procedure WMHelp(Var Msg:TMessage); Message WM_HELP;
  1251.          {$ENDIF}
  1252.          {$IFDEF Win32}
  1253.          Procedure WMButton1Down(Var Msg:TWMButton1Down); Message WM_LBUTTONDOWN;
  1254.          Procedure WMButton2Down(Var Msg:TWMButton2Down); Message WM_RBUTTONDOWN;
  1255.          Procedure WMSize(Var Msg:TWMSize); Message WM_SIZE;
  1256.          Procedure WMMove(Var Msg:TWMMove); Message WM_MOVE;
  1257.          Procedure WMPaint(Var Msg:TMessage); Message WM_PAINT;
  1258.          Procedure WMEraseBackGround(Var Msg:TMessage); Message WM_ERASEBKGND;
  1259.          Procedure WMCommand(Var Msg:TWMCommand); Message WM_COMMAND;
  1260.          Procedure WMChar(Var Msg:TWMChar); Message WM_CHAR;
  1261.          Procedure WMKillFocus(Var Msg:TMessage); Message WM_KILLFOCUS;
  1262.          Procedure WMSetFocus(Var Msg:TWMSetFocus); Message WM_SETFOCUS;
  1263.          Procedure WMButton1Up(Var Msg:TWMButton1Up); Message WM_LBUTTONUP;
  1264.          Procedure WMButton2Up(Var Msg:TWMButton2Up); Message WM_RBUTTONUP;
  1265.          Procedure WMButton1DblClk(Var Msg:TWMButton1DblClk); Message WM_LBUTTONDBLCLK;
  1266.          Procedure WMButton2DblClk(Var Msg:TWMButton2DblClk); Message WM_RBUTTONDBLCLK;
  1267.          Procedure WMKeyDown(Var Msg:TMessage); Message WM_KEYDOWN;
  1268.          Procedure WMSysKeyDown(Var Msg:TMessage); Message WM_SYSKEYDOWN;
  1269.          Procedure WMMouseMove(Var Msg:TWMMouseMove); Message WM_MOUSEMOVE;
  1270.          Procedure WMSetCursor(Var Msg:TMessage); Message WM_SETCURSOR;
  1271.          Procedure WMHScroll(Var Msg:TWMScroll); Message WM_HSCROLL;
  1272.          Procedure WMVScroll(Var Msg:TWMScroll); Message WM_VSCROLL;
  1273.          Procedure WMCtlColorBtn(Var Msg:TMessage); Message WM_CTLCOLORBTN;
  1274.          Procedure WMCtlColorStatic(Var Msg:TMessage); Message WM_CTLCOLORSTATIC;
  1275.          Procedure WMCtlColorDlg(Var Msg:TMessage); Message WM_CTLCOLORDLG;
  1276.          Procedure WMCtlColorScrollBar(Var Msg:TMessage); Message WM_CTLCOLORSCROLLBAR;
  1277.          Procedure WMCtlColorEdit(Var Msg:TMessage); Message WM_CTLCOLOREDIT;
  1278.          Procedure WMCtlColorListBox(Var Msg:TMessage); Message WM_CTLCOLORLISTBOX;
  1279.          Procedure WMDestroy(Var Msg:TWMDestroy); Message WM_DESTROY;
  1280.          Procedure WMNCDestroy(Var Msg:TMessage); Message WM_NCDESTROY;
  1281.          Procedure WMCaptureFocus(Var Msg:TMessage); Message WM_CAPTUREFOCUS;
  1282.          Procedure WMNotify(Var Msg:TMessage); Message WM_NOTIFY;
  1283.          {$ENDIF}
  1284.          Procedure WMMeasureItem(Var Msg:TMessage); Message WM_MEASUREITEM;
  1285.          Procedure WMDrawItem(Var Msg:TMessage); Message WM_DRAWITEM;
  1286.  
  1287.          Function GetControlState:TControlState;
  1288.          Function GetControlStyle:TControlStyle;
  1289.          Procedure SetControlState(NewValue:TControlState);
  1290.          Procedure SetControlStyle(NewValue:TControlStyle);
  1291.          Procedure SendScanMessage(Var Msg:TWMChar;Var KeyCode:TKeyCode;RepeatCount:Byte);
  1292.          Procedure SendCharMessage(Var Msg:TWMChar;Var CH:Char;RepeatCount:Byte);
  1293.          Function GetDesignerCoordinates(Var pt:TPoint):TControl;
  1294.          Procedure SetText(Const NewCaption:String);
  1295.          Function GetText:String;
  1296.          Function GetControlCount:LongInt;
  1297.          Function GetControl(AIndex:LongInt):TControl;
  1298.          Procedure SetColor(NewColor:TColor);Virtual;
  1299.          Procedure SetPenColor(NewColor:TColor);Virtual;
  1300.          Procedure SetParentFont(Value:Boolean);
  1301.          Procedure SetParentPenColor(Value:Boolean);
  1302.          Procedure SetParentColor(Value:Boolean);
  1303.          Procedure ParentFontChanged(Var Msg:TMessage); Message CM_PARENTFONTCHANGED;
  1304.          Procedure ParentPenColorChanged(Var Msg:TMessage); Message CM_PARENTPENCOLORCHANGEd;
  1305.          Procedure ParentColorChanged(Var Msg:TMessage); Message CM_PARENTCOLORCHANGED;
  1306.          Procedure SetCursor(Index:TCursor);
  1307.          Function GetWindowRect:TRect;
  1308.          Procedure SetWindowRect(Const rec:TRect);
  1309.          Function GetBoundsRect:TRect;
  1310.          Procedure SetBoundsRect(Const rec:TRect);
  1311.          Function GetClientRect:TRect;Virtual;
  1312.          Function GetClientWidth:LongInt;
  1313.          Function GetClientHeight:LongInt;
  1314.          Procedure SetClientWidth(NewWidth:LongInt);Virtual;
  1315.          Procedure SetClientHeight(NewHeight:LongInt);Virtual;
  1316.          Function GetClientOrigin:TPoint;Virtual;
  1317.          Function GetParentClientWidth:LongInt;
  1318.          Function GetParentClientHeight:LongInt;
  1319.          Procedure SetWidth(NewWidth:LongInt);
  1320.          Function GetWidth:LongInt;
  1321.          Procedure SetHeight(NewHeight:LongInt);Virtual;
  1322.          Function GetHeight:LongInt;
  1323.          Procedure SetLeft(NewLeft:LongInt);Virtual;
  1324.          Function GetLeft:LongInt;Virtual;
  1325.          Procedure SetBottom(NewBottom:LongInt);Virtual;
  1326.          Function GetBottom:LongInt;Virtual;
  1327.          Procedure SetTop(NewTop:LongInt);Virtual;
  1328.          Function GetTop:LongInt;
  1329.          Procedure SetRight(NewRight:LongInt);Virtual;
  1330.          Function GetRight:LongInt;
  1331.          Procedure SetAlign(NewAlign:TAlign);
  1332.          Function GetAlign:TAlign;
  1333.          Procedure SetXAlign(NewAlign:TXAlign);
  1334.          Function GetXAlign:TXAlign;
  1335.          Procedure SetYAlign(NewAlign:TYAlign);
  1336.          Function GetYAlign:TYAlign;
  1337.          Procedure SetXStretch(NewStretch:TXStretch);
  1338.          Function GetXStretch:TXStretch;
  1339.          Procedure SetYStretch(NewStretch:TYStretch);
  1340.          Function GetYStretch:TYStretch;
  1341.          Procedure SetZOrder(zo:TZOrder);
  1342.          Procedure UpdateFont;
  1343.          Procedure Enable;
  1344.          Procedure Disable;
  1345.          Function GetEnabled:Boolean;
  1346.          Procedure SetEnabled(NewState:Boolean);
  1347.          Function IsWindowVisible:Boolean;
  1348.          Function GetShowing:Boolean;
  1349.          Function GetVisible:Boolean;
  1350.          Procedure SetVisible(NewState:Boolean);
  1351.          Function GetTabOrder:LongInt;Virtual;
  1352.          Procedure SetTabOrder(Value:LongInt);
  1353.          Function GetWindowFlags:LongWord;
  1354.          Procedure SetHint(Const NewText:String);
  1355.          Function GetHint:String;
  1356.          Procedure SetShowHint(Value:Boolean);
  1357.          Function GetShowHint:Boolean;
  1358.          Procedure SetMouseCapture(captive:Boolean);
  1359.          Procedure SetUpdateEnabled(Value:Boolean);
  1360.          Procedure SetParent(AParent:TControl);
  1361.          {$IFDEF Win32}
  1362.          Procedure SetCtlColor(Var Msg:TMessage);
  1363.          {$ENDIF}
  1364.          Procedure Insert(AChild:TControl);
  1365.          Procedure Remove(AChild:TControl);
  1366.          Function GetNextTabControl:TControl;
  1367.          Function GetPrevTabControl:TControl;
  1368.          Procedure FocusTabControl(Next:Boolean);
  1369.          Procedure FocusKeyControl(KeyCode:TKeyCode);
  1370.          Function GetLastMsg:TLastMsg;
  1371.          {$IFDEF OS2}
  1372.          Function SetPPFontNameSize(Const FNS:String):Boolean;
  1373.          Function SetPPForeGroundColor(AColor:TColor):Boolean;
  1374.          Function SetPPBackGroundColor(AColor:TColor):Boolean;
  1375.          {$ENDIF}
  1376.          Procedure DragFinished(target:TObject; X,Y:LongInt; Accepted:Boolean);
  1377.          Procedure DragFree;
  1378.          Procedure SetPopupMenu(NewMenu:TPopupMenu);
  1379.       Protected
  1380.          Procedure SetFont(NewFont:TFont);Virtual;
  1381.          Procedure DefaultHandler(Var Msg);Override;
  1382.          Procedure WndProc(Var Msg:TMessage);Virtual;
  1383.          Procedure UpdateWindowPos(NewLeft,NewBottom,NewWidth,NewHeight:LongInt);Virtual;
  1384.          Procedure Scroll(Sender:TScrollBar;ScrollCode:TScrollCode;Var ScrollPos:Longint);Virtual;
  1385.          Function QueryConvertPos(Var Pos:TPoint):Boolean;Virtual;
  1386.          Procedure CharEvent(Var key:Char;RepeatCount:Byte);Virtual;
  1387.          Procedure ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);Virtual;
  1388.          Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongINt);Virtual;
  1389.          Procedure MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Virtual;
  1390.          Procedure MouseMove(ShiftState:TShiftState;X,Y:LongInt);Virtual;
  1391.          Procedure MouseClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInT);Virtual;
  1392.          Procedure MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LonGInT);Virtual;
  1393.          Procedure CheckMenuPopup(pt:TPoint);Virtual;
  1394.          Procedure Resize;Virtual;
  1395.          Procedure Move;Virtual;
  1396.          Procedure SetFocus;Virtual;
  1397.          Procedure KillFocus;Virtual;
  1398.          Procedure Paint(Const rec:TRect);Virtual;
  1399.          Procedure SetupComponent;Override;
  1400.          Procedure CreateParams(Var Params:TCreateParams);Virtual;
  1401.          Procedure GetClassData(Var ClassData:TClassData);Virtual;
  1402.          {$IFDEF Win32}
  1403.          Procedure CreateSubClass(Var ClassData:TClassData;Const ControlClassName:Cstring);
  1404.          {$ENDIF}
  1405.          Procedure RegisterClass;Virtual;
  1406.          Procedure LoadedFromSCU(SCUParent:TComponent);Override;
  1407.          Procedure SetupShow;Virtual;
  1408.          Procedure CreateError;Virtual;
  1409.          Procedure CreateWnd;Virtual;
  1410.          Procedure RecreateWnd;Virtual;
  1411.          Procedure CreateControls;Virtual;
  1412.          Procedure DisposeWnd;Virtual;
  1413.          Procedure DestroyWnd;Virtual;
  1414.          Procedure DestroyHandle;
  1415.          Procedure RealignControls;Virtual;
  1416.          Procedure CommandEvent(Var Command:TCommand);Virtual;
  1417.          Procedure ParentNotification(Var Msg:TMessage);Virtual;
  1418.          Function EvaluateShortCut(KeyCode:TKeyCode):Boolean;Virtual;
  1419.          Procedure CanDrag(X,Y:LongInt;Var Accept:Boolean);Virtual;
  1420.          Procedure DoStartDrag(Var DragData:TDragDropData);Virtual;
  1421.          Procedure DoEndDrag(target:TObject; X,Y:LongInt);Virtual;
  1422.          Procedure DragCanceled;Virtual;
  1423.          Procedure DragOver(Source:TObject;X,Y:LongInt;State:TDragState;Var Accept:Boolean);Virtual;
  1424.          Procedure FontChange;Virtual;
  1425.          Procedure NotifyControls(MsgId:ULONG);
  1426.          Procedure GetChildren(Proc:TGetChildProc);Override;
  1427.          Function HasParent:Boolean;Override;
  1428.       Public
  1429.          Procedure DesignerNotification(Var DNS:TDesignerNotifyStruct);Virtual;
  1430.          Procedure ScaleBy(CX,CY:LongInt);
  1431.          Procedure ScrollBy(DeltaX,DeltaY:LongInt);
  1432.          Function ContainsControl(Control: TControl):Boolean;
  1433.          Function ControlAtPos(Const Pos:TPoint;AllowDisabled:Boolean):TControl;
  1434.          Procedure GetTabOrderList(List:TList);
  1435.          Procedure Notification(AComponent:TComponent;Operation:TOperation);Override;
  1436.          Procedure BeginDrag(Immediate:Boolean); {dummy Parameter}
  1437.          Procedure DragDrop(Source:TObject;X,Y:LongInt);Virtual;
  1438.          Procedure CreateDragCanvas;
  1439.          Procedure DeleteDragCanvas;
  1440.          Destructor Destroy;Override;
  1441.          Procedure Show;Virtual;
  1442.          Procedure Hide;Virtual;
  1443.          Procedure BringToFront;Virtual;
  1444.          Procedure SendToBack;Virtual;
  1445.          Procedure InsertControl(AChild:TControl);Virtual;
  1446.          Procedure RemoveControl(AChild:TControl);Virtual;
  1447.          Procedure DestroyControls;
  1448.          Function CreateCanvas:TCanvas;Virtual;
  1449.          Procedure Redraw(Const rec:TRect);Virtual;
  1450.          Procedure Refresh;
  1451.          Procedure Repaint;
  1452.          Procedure Update;Virtual;
  1453.          Procedure Invalidate;Virtual;
  1454.          Procedure InvalidateRect(Const rec:TRect);
  1455.          Procedure SetWindowPos(NewLeft,NewBottom,NewWidth,NewHeight:LongInt);Virtual;
  1456.          Procedure SetBounds(NewLeft,NewTop,NewWidth,NewHeight:LongInt);Virtual; {VCL}
  1457.          Procedure Focus;
  1458.          Procedure CaptureFocus;
  1459.          Function Focused:Boolean;
  1460.          Function Perform(MsgId:ULONG;mp1,mp2:LONG):LONG;
  1461.          Procedure BroadCast(Var Msg:TMessage);
  1462.          Function GetControlFromPoint(pt:TPoint):TControl;
  1463.          Function ClientToScreen(Const Point:TPoint):TPoint;
  1464.          Function ScreenToClient(Const Point:TPoint):TPoint;
  1465.          Procedure MapPoints(target:TControl;Var pts:Array Of TPoint);
  1466.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInT);Override;
  1467.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  1468.       Protected
  1469.          Property DragState:TDragState read FDragState write FDragState;
  1470.          Property CursorTabStop:Boolean Read FCursorTabStop Write FCursorTabStop;
  1471.          Property DefWndProc:TWndProc Read FDefWndProc Write FDefWndProc;
  1472.          Property Form:TForm Read FForm;
  1473.          Property HandlesDesignKey:Boolean Read FHandlesDesignKey Write FHandlesDesignKey;
  1474.          Property HandlesDesignMouse:Boolean Read FHandlesDesignMouse Write FHandlesDeSignMouse;
  1475.          Property LastDragOperation:TDragDropOperation Read FLastDragOperation;
  1476.          Property LastMsg:TLastMsg Read GetLastMsg;
  1477.          Property Ownerdraw:Boolean Read FOwnerDraw Write FOwnerDraw;
  1478.  
  1479.          Property Color:TColor Read FColor Write SetColor;
  1480.          Property Caption:String Read GetText Write SetText;
  1481.          Property Command:TCommand Read FCommand Write FCommand;
  1482.          Property DragCursor:TCursor Read FDragCursor Write FDragCursor;
  1483.          Property DragMode:TDragMode Read FDragMode Write FDragMode;
  1484.          Property Font:TFont Read FFont Write SetFont;
  1485.          Property ParentColor:Boolean Read FParentColor Write SetParentColor;
  1486.          Property ParentFont:Boolean Read FParentFont Write SetParentFont;
  1487.          Property ParentPenColor:Boolean Read FParentPenColor Write SetParentPenColor;
  1488.          Property ParentShowHint:Boolean Read FParentShowHint Write FParentShowHint;
  1489.          Property PenColor:TColor Read FPenColor Write SetPenColor;
  1490.          Property PopupMenu:TPopupMenu Read FPopupMenu Write SetPopupMenu;
  1491.          Property ShowHint:Boolean Read FShowHint Write SetShowHint;
  1492.          Property Text:String Read GetText Write SetText;
  1493.          Property ZOrder:TZOrder Read FZOrder Write SetZOrder;
  1494.  
  1495.          Property OnCanDrag:TCanDragEvent Read FOnCanDrag Write FOnCanDrag;
  1496.          Property OnKeyPress:TKeyPressEvent Read FOnKeyPress Write FOnKeyPress;
  1497.          Property OnCommand:TCommandEvent Read FOnCommand Write FOnCommand;
  1498.          Property OnClick:TNotifyEvent Read FOnClick Write FOnClick;
  1499.          Property OnDblClick:TNotifyEvent Read FOnDblClick Write FOnDblClick;
  1500.          Property OnDragDrop:TDragDropEvent Read FOnDragDrop Write FOnDragDrop;
  1501.          Property OnDragOver:TDragOverEvent Read FOnDragOver Write FOnDragOver;
  1502.          Property OnEndDrag:TEndDragEvent Read FOnEndDrag Write FOnEndDrag;
  1503.          Property OnEnter:TNotifyEvent Read FOnEnter Write FOnEnter;
  1504.          Property OnExit:TNotifyEvent Read FOnExit Write FOnExit;
  1505.          Property OnFontChange:TNotifyEvent Read FOnFontChange Write FOnFontChange;
  1506.          Property OnHide:TNotifyEvent Read FOnHide Write FOnHide;
  1507.          Property OnMouseClick:TMouseEvent Read FOnMouseClick Write FOnMouseClick;
  1508.          Property OnMouseDblClick:TMouseEvent Read FOnMouseDblClick Write FOnMouseDblCLick;
  1509.          Property OnMouseDown:TMouseEvent Read FOnMouseDown Write FOnMouseDown;
  1510.          Property OnMouseMove:TMouseMoveEvent Read FOnMouseMove Write FOnMouseMove;
  1511.          Property OnMouseUp:TMouseEvent Read FOnMouseUp Write FOnMouseUp;
  1512.          Property OnMove:TNotifyEvent Read FOnMove Write FOnMove;
  1513.          Property OnPaint:TPaintEvent Read FOnPaint Write FOnPaint;
  1514.          Property OnResize:TNotifyEvent Read FOnResize Write FOnResize;
  1515.          Property OnScan:TScanEvent Read FOnScan Write FOnScan;
  1516.          Property OnSetupShow:TNotifyEvent Read FOnSetupShow Write FOnSetupShow;
  1517.          Property OnShow:TNotifyEvent Read FOnShow Write FOnShow;
  1518.          Property OnStartDrag:TStartDragEvent Read FOnStartDrag Write FOnStartDrag;
  1519.       Public
  1520.          Property Align:TAlign Read GetAlign Write SetAlign;
  1521.          Property BoundsRect:TRect Read GetBoundsRect write SetBoundsRect;
  1522.          Property Canvas:TCanvas Read FCanvas;
  1523.          Property ClientHeight:LongInt Read GetClientHeight Write SetClientHeight;
  1524.          Property ClientOrigin:TPoint Read GetClientOrigin;
  1525.          Property ClientRect:TRect Read GetClientRect;
  1526.          Property ClientWidth:LongInt Read GetClientWidth Write SetClientWidth;
  1527.          Property ControlCount:LongInt Read GetControlCount;
  1528.          Property Controls[Index:LongInt]:TControl Read GetControl;
  1529.          Property Dragging:Boolean Read FDragging;
  1530.          Property Enabled:Boolean Read GetEnabled Write SetEnabled;
  1531.          Property Handle:HWindow Read FHandle;
  1532.          Property WindowId:LongWord read FWindowId;
  1533.          Property HasFocus:Boolean Read FHasFocus;
  1534.          Property MouseCapture:Boolean Read FMouseCapture Write SetMouseCapture;
  1535.          Property OnBeforePaint:TPaintEvent Read FOnBeforePaint Write FOnBeforePaint;
  1536.          Property OnAfterPaint:TPaintEvent Read FOnAfterPaint Write FOnAfterPaint;
  1537.          Property Parent:TControl Read FParent Write SetParent;
  1538.          Property Showing:Boolean Read GetShowing;
  1539.          Property TabOrder:LongInt Read GetTabOrder Write SetTabOrder;
  1540.          Property TabStop:Boolean Read FTabStop Write FTabStop;
  1541.          Property UpdateEnabled:Boolean Read FUpdateEnabled Write SetUpdateEnabled;
  1542.          Property Visible:Boolean Read GetVisible Write SetVisible;
  1543.          Property WindowRect:TRect Read GetWindowRect write SetWindowRect;
  1544.          Property XAlign:TXAlign Read GetXAlign Write SetXAlign;
  1545.          Property XStretch:TXStretch Read GetXStretch Write SetXStretch;
  1546.          Property YAlign:TYAlign Read GetYAlign Write SetYAlign;
  1547.          Property YStretch:TYStretch Read GetYStretch Write SetYStretch;
  1548.          Property ControlState: TControlState read GetControlState write SetControlState;
  1549.          Property ControlStyle: TControlStyle read GetControlStyle write SetControlStyle;
  1550.       Published
  1551.          Property Bottom:LongInt Read GetBottom Write SetBottom;
  1552.          Property Height:LongInt Read GetHeight Write SetHeight;
  1553.          Property HelpContext:THelpContext Read FHelpContext Write FHelpContext;
  1554.          Property Hint:String Read GetHint Write SetHint;
  1555.          Property Left:LongInt Read GetLeft Write SetLeft;
  1556.          Property Cursor:TCursor Read FCursor Write SetCursor;
  1557.          Property Right:LongInt Read GetRight Write SetRight; Stored False;
  1558.          Property Top:LongInt Read GetTop Write SetTop; Stored False;
  1559.          Property Width:LongInt Read GetWidth Write SetWidth;
  1560.          Property OnCloseQuery:TCloseQueryEvent read FOnCloseQuery write FOnCloseQuery;
  1561.          Property Ctl3d:Boolean Read FCtl3d Write FCtl3d;
  1562.     End;
  1563.  
  1564.     TGraphicControl=Class(TControl)
  1565.       Protected
  1566.          Property Canvas;
  1567.     End;
  1568.  
  1569.     TBitBltMode=(cmSrcCopy, cmSrcPaint, cmSrcAnd, cmSrcInvert,
  1570.                  cmSrcErase, cmNotSrcCopy, cmNotSrcErase,
  1571.                  cmMergeCopy, cmMergePaint, cmPatCopy, cmPatPaint,
  1572.                  cmPatInvert, cmDstInvert, cmBlackness, cmWhiteness);
  1573.  
  1574.     TBitBltFlags=(bitfOr,bitfAnd,bitfIgnore);
  1575.  
  1576.  
  1577.     {$M+}
  1578.     TPenStyle = (psSolid, psDash, psDot, psDashDot, psDashDotDot, psClear,
  1579.                  psInsideFrame);
  1580.     TPenMode = (pmBlack, pmWhite, pmNop, pmNot, pmCopy, pmNotCopy, pmMergePenNot,
  1581.                 pmMaskPenNot, pmMergeNotPen, pmMaskNotPen, pmMerge, pmNotMerge,
  1582.                 pmMask, pmNotMask, pmXor, pmNotXor);
  1583.     {$M-}
  1584.  
  1585.     TPen=Class(TComponent)
  1586.       Private
  1587.          FCanvas:TCanvas;
  1588.          FColor:TColor;
  1589.          FStyle:TPenStyle;
  1590.          FMode:TPenMode;
  1591.          FWidth:LongInt;
  1592.          Procedure SetColor(NewColor:TColor);
  1593.          Procedure SetMode(NewMode:TPenMode);
  1594.          Procedure SetStyle(NewStyle:TPenStyle);
  1595.          Procedure SetWidth(NewWidth:LongInt);
  1596.       Public
  1597.          Procedure SetupComponent;Override;
  1598.          Procedure Assign(Source:TPersistent);Override;
  1599.       Published
  1600.          Property Color:TColor Read FColor Write SetColor;
  1601.          Property Mode:TPenMode Read FMode Write SetMode;
  1602.          Property Style:TPenStyle Read FStyle Write SetStyle;
  1603.          Property Width:LongInt Read FWidth Write SetWidth;
  1604.     End;
  1605.  
  1606.     {$M+}
  1607.     TBrushStyle = (bsSolid, bsClear, bsHorizontal, bsVertical, bsFDiagonal,
  1608.                    bsBDiagonal, bsCross, bsDiagCross);
  1609.     TBrushMode  = (bmTransparent,bmOpaque);
  1610.     {$M-}
  1611.  
  1612.     TBrush=Class(TComponent)
  1613.       Private
  1614.          FCanvas:TCanvas;
  1615.          FBitmap:TGraphic;
  1616.          FColor:TColor;
  1617.          FStyle:TBrushStyle;
  1618.          FMode:TBrushMode;
  1619.          Procedure SetColor(NewColor:TColor);
  1620.          Procedure SetStyle(NewStyle:TBrushStyle);
  1621.          Procedure SetBitmap(NewBitmap:TGraphic);
  1622.          Procedure SetMode(NewMode:TBrushMode);
  1623.       Public
  1624.          Procedure SetupComponent;Override;
  1625.          Destructor Destroy;Override;
  1626.          Property Bitmap:TGraphic Read FBitmap Write SetBitmap;
  1627.          Procedure Assign(Source:TPersistent);Override;
  1628.       Published
  1629.          Property Color:TColor Read FColor Write SetColor;
  1630.          Property Style:TBrushStyle Read FStyle Write SetStyle;
  1631.          Property Mode:TBrushMode Read FMode Write SetMode;
  1632.     End;
  1633.  
  1634.  
  1635.     {$M+}
  1636.     TSizeBorderEvent=Procedure(Sender:TObject;Var SizeDelta:LongInt) Of Object;
  1637.     TSizeBorderAlign=(baVertical,baHorizontal,baTop,baBottom,baLeft,baRight,
  1638.                       baParentWidth,baParentHeight);
  1639.     {$M-}
  1640.  
  1641.     TSizeBorder=Class(TControl)
  1642.       Private
  1643.          FBorderAlign:TSizeBorderAlign;
  1644.          FSizing:Boolean;
  1645.          FOffs:LongInt;
  1646.          FDelta:LongInt;
  1647.          OldFgMode:TPenMode;
  1648.          OldLineWidth:LongInt;
  1649.          OldLineType:TPenStyle;
  1650.          FOnSizing:TSizeBorderEvent;
  1651.          FOnSized:TSizeBorderEvent;
  1652.          Procedure SetBorderAlign(Value:TSizeBorderAlign);
  1653.          Procedure DrawSizeLine;
  1654.       Protected
  1655.          Procedure SetupComponent;Override;
  1656.          Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
  1657.          Procedure MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
  1658.          Procedure MouseMove(ShiftState:TShiftState;X,Y:LongInt);Override;
  1659.          Property Hint;
  1660.          Property Cursor;
  1661.       Public
  1662.          Procedure Redraw(Const rec:TRect);Override;
  1663.       Published
  1664.          Property BorderAlign:TSizeBorderAlign Read FBorderAlign Write SetBorderAliGn;
  1665.          Property OnSized:TSizeBorderEvent Read FOnSized Write FOnSized;
  1666.          Property OnSizing:TSizeBorderEvent Read FOnSizing Write FOnSizing;
  1667.     End;
  1668.  
  1669.  
  1670.     TToolbar=Class(TControl)
  1671.       Private
  1672.          FAlignment:TToolbarAlign;
  1673.          FBevelStyle:TToolBarBevel;
  1674.          FSizeable:Boolean;
  1675.          FOrder:LongInt;
  1676.          SizeBorderCtrl:TSizeBorder;
  1677.          Procedure SetAlignment(NewAlign:TToolbarAlign);
  1678.          Procedure SetBevelStyle(NewStyle:TToolBarBevel);
  1679.          Procedure SetSize(NewSize:LongInt);
  1680.          Function GetSize:LongInt;
  1681.          Function GetLeft:LongInt;Override;
  1682.          Function GetBottom:LongInt;Override;
  1683.          Procedure SetLeft(NewLeft:LongInt);Override;
  1684.          Procedure SetBottom(NewBottom:LongInt);Override;
  1685.          Procedure SetTop(NewTop:LongInt);Override;
  1686.          Procedure SetRight(NewRight:LongInt);Override;
  1687.          Procedure SetSizeable(Value:Boolean);
  1688.          Procedure SetOrder(Value:LongInt);
  1689.          Function GetOrder:LongInt;
  1690.          Procedure EvBorderSizing(Sender:TObject;Var SizeDelta:LongInt);
  1691.          Procedure EvBorderSized(Sender:TObject;Var SizeDelta:LongInt);
  1692.       Protected
  1693.          Procedure SetupComponent;Override;
  1694.          Procedure CreateWnd;Override;
  1695.          Procedure SetupShow;Override;
  1696.       Public
  1697.          Procedure Redraw(Const rec:TRect);Override;
  1698.          Procedure SetWindowPos(NewLeft,NewBottom,NewWidth,NewHeight:LongInt);Override;
  1699.          Procedure EnableCommands(Cmds:Array Of TCommand);   {raus}
  1700.          Procedure DisableCommands(Cmds:Array Of TCommand);  {raus}
  1701.          Procedure Hide;Override;
  1702.          Procedure Show;Override;
  1703.          Property Bottom;
  1704.          Property Height;
  1705.          Property Left;
  1706.          Property Right;
  1707.          Property Top;
  1708.          Property Width;
  1709.       Published
  1710.          Property Alignment:TToolbarAlign Read FAlignment Write SetAlignment;
  1711.          Property Color;
  1712.          Property BevelStyle:TToolBarBevel Read FBevelStyle Write SetBevelStyle;
  1713.          Property Enabled;
  1714.          Property PenColor;
  1715.          Property Font;
  1716.          Property HelpContext;
  1717.          Property Order:LongInt Read GetOrder Write SetOrder; Stored False;
  1718.          Property ParentColor;
  1719.          Property ParentPenColor;
  1720.          Property ParentFont;
  1721.          Property ParentShowHint;
  1722.          Property PopupMenu;
  1723.          Property ShowHint;
  1724.          Property Size:LongInt Read GetSize Write SetSize;
  1725.          Property Sizeable:Boolean Read FSizeable Write SetSizeable;
  1726.  
  1727.          Property OnClick;
  1728.          Property OnDblClick;
  1729.          Property OnCommand;
  1730.          Property OnDragDrop;
  1731.          Property OnDragOver;
  1732.          Property OnEndDrag;
  1733.          Property OnFontChange;
  1734.          Property OnMouseClick;
  1735.          Property OnMouseDblClick;
  1736.          Property OnMouseDown;
  1737.          Property OnMouseMove;
  1738.          Property OnMouseUp;
  1739.          Property OnResize;
  1740.          Property OnSetupShow;
  1741.     End;
  1742.  
  1743.  
  1744. {$M+}
  1745.     TScrollBarKind=(sbHorizontal,sbVertical);
  1746.  
  1747.     TScrollEvent=Procedure(Sender:TObject;ScrollCode:TScrollCode;
  1748.                              Var ScrollPos:LongInt) Of Object;
  1749. {$M-}
  1750.     TScrollBarInc=1..32767;
  1751.  
  1752.     TScrollingWinControl=Class;
  1753.  
  1754.     TScrollBar=Class(TControl)
  1755.       Private
  1756.          lastpos:LongInt;
  1757.          FMin:LongInt;
  1758.          FMax:LongInt;
  1759.          FSliderSize:LongInt;
  1760.          FCalcRange:LongInt;
  1761.          FPosition:LongInt;
  1762.          FScale:Extended;
  1763.          FSmallChange:TScrollBarInc;
  1764.          FLargeChange:TScrollBarInc;
  1765.          FKind:TScrollBarKind;
  1766.          FOnScroll:TScrollEvent;
  1767.          FOnChange:TNotifyEvent;
  1768.          FControl:TScrollingWinControl;
  1769.          Procedure SetPosition(NewPosition:LongInt);
  1770.          Procedure SetMin(NewMin:LongInt);
  1771.          Procedure SetMax(NewMax:LongInt);
  1772.          Procedure SetSliderSize(NewSliderSize:LongInt);
  1773.          Procedure SetKind(NewKind:TScrollBarKind);
  1774.          Procedure SetPenColor(NewColor:TColor);Override;
  1775.          Procedure SetColor(NewColor:TColor);Override;
  1776.       Protected
  1777.          Procedure SetupComponent;Override;
  1778.          Procedure GetClassData(Var ClassData:TClassData);Override;
  1779.          Procedure CreateParams(Var Params:TCreateParams);Override;
  1780.          Procedure SetupShow;Override;
  1781.       Public
  1782.          Procedure SetScrollRange(aMin,aMax,aSliderSize:LongInt);
  1783.          Procedure SetParams(aPosition,aMin,aMax:LongInt);
  1784.          Property XAlign;
  1785.          Property XStretch;
  1786.          Property YAlign;
  1787.          Property YStretch;
  1788.       Published
  1789.          Property Align;
  1790.          Property Color;
  1791.          Property DragCursor;
  1792.          Property DragMode;
  1793.          Property Enabled;
  1794.          Property Kind:TScrollBarKind Read FKind Write SetKind;
  1795.          Property LargeChange:TScrollBarInc Read FLargeChange Write FLargeChange;
  1796.          Property Max:LongInt Read FMax Write SetMax;
  1797.          Property Min:LongInt Read FMin Write SetMin;
  1798.          Property ParentShowHint;
  1799.          Property PopupMenu;
  1800.          Property Position:LongInt Read FPosition Write SetPosition;
  1801.          Property ShowHint;
  1802.          Property SliderSize:LongInt Read FSliderSize Write SetSliderSize;
  1803.          Property SmallChange:TScrollBarInc Read FSmallChange Write FSmallChange;
  1804.          Property TabOrder;
  1805.          Property TabStop;
  1806.          Property Visible;
  1807.          Property ZOrder;
  1808.  
  1809.          Property OnCanDrag;
  1810.          Property OnChange:TNotifyEvent Read FOnChange Write FOnChange;
  1811.          Property OnClick;
  1812.          Property OnDragDrop;
  1813.          Property OnDragOver;
  1814.          Property OnEndDrag;
  1815.          Property OnEnter;
  1816.          Property OnExit;
  1817.          Property OnMouseMove;
  1818.          Property OnScan;
  1819.          Property OnScroll:TScrollEvent Read FOnScroll Write FOnScroll;
  1820.          Property OnSetupShow;
  1821.          Property OnStartDrag;
  1822.     End;
  1823.  
  1824.  
  1825.     TControlScrollBar=Class(TScrollBar)
  1826.       Public
  1827.          Procedure SetupComponent;Override;
  1828.       Public
  1829.          Property Align;
  1830.          Property Bottom;
  1831.          Property Cursor;
  1832.          Property Left;
  1833.          Property Right;
  1834.          Property Top;
  1835.          Property HelpContext;
  1836.          Property Name;
  1837.          Property Tag;
  1838.          Property Width;
  1839.          Property Height;
  1840.          Property Hint;
  1841.          Property DragCursor;
  1842.          Property DragMode;
  1843.          Property Enabled;
  1844.          Property Kind;
  1845.          Property ParentShowHint;
  1846.          Property PopupMenu;
  1847.          Property ShowHint;
  1848.          Property TabOrder;
  1849.          Property TabStop;
  1850.          Property Visible;
  1851.          Property ZOrder;
  1852.  
  1853.          Property OnCanDrag;
  1854.          Property OnChange;
  1855.          Property OnDragDrop;
  1856.          Property OnDragOver;
  1857.          Property OnEndDrag;
  1858.          Property OnEnter;
  1859.          Property OnExit;
  1860.          Property OnMouseMove;
  1861.          Property OnScan;
  1862.          Property OnScroll;
  1863.          Property OnSetupShow;
  1864.          Property OnStartDrag;
  1865.     End;
  1866.  
  1867.  
  1868.     TScrollingWinControl=Class(TControl)
  1869.       Private
  1870.          FScrollBars:TScrollStyle;
  1871.          FHorzScrollBar:TControlScrollBar;
  1872.          FVertScrollBar:TControlScrollBar;
  1873.          FAutoScroll:Boolean;
  1874.          FHMin,FVMin:LongInt;
  1875.          FHMax,FVMax:LongInt;
  1876.          FHPos,FVPos:LongInt;
  1877.          FHLargeChange,FVLargeChange:LongInt;
  1878.          FHSmallChange,FVSmallChange:LongInt;
  1879.          FHColor,FVColor:LongInt;
  1880.          FHSliderSize,FVSliderSize:LongInt;
  1881.          FIgnoreAdjust:Boolean;
  1882.          Procedure SetScrollBars(NewValue:TScrollStyle);
  1883.          Procedure SetAutoScroll(NewValue:Boolean);
  1884.          Procedure AlignScrollbars;
  1885.          Procedure AdjustScrollbars;
  1886.       Protected
  1887.          Procedure Resize;Override;
  1888.          Procedure Paint(Const rec:TRect);Override;
  1889.          Procedure SetupComponent;Override;
  1890.          Procedure SetupShow;Override;
  1891.          Procedure Scroll(Sender:TScrollBar;ScrollCode:TScrollCode;Var ScrollPos:Longint);Override;
  1892.          Procedure Loaded;Override;
  1893.       Public
  1894.          Destructor Destroy;Override;
  1895.          Procedure ScrollInView(AControl:TControl);
  1896.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
  1897.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  1898.          Procedure InsertControl(AChild:TControl);Override;
  1899.          Procedure RemoveControl(AChild:TControl);Override;
  1900.       Public
  1901.          Property AutoScroll:Boolean read FAutoScroll write SetAutoScroll;
  1902.          Property HorzScrollBar:TControlScrollBar Read FHorzScrollBar;
  1903.          Property VertScrollBar:TControlScrollBar Read FVertScrollBar;
  1904.          Property ScrollBars:TScrollStyle Read FScrollBars Write SetScrollBars;
  1905.     End;
  1906.  
  1907.  
  1908.     {$M+}
  1909.     TFormBorderStyle=(bsNone,bsSingle,bsSizeable,bsDialog,bsToolWindow,
  1910.                       bsSizeToolWin);
  1911.     TBorderStyle=bsNone..bsSingle;
  1912.     {$M-}
  1913.  
  1914.     TScrollBox=Class(TScrollingWinControl)
  1915.       Private
  1916.         FBorderStyle:TBorderStyle;
  1917.         Procedure SetBorderStyle(NewValue:TBorderStyle);
  1918.       Protected
  1919.         Procedure SetupComponent;Override;
  1920.       Public
  1921.         Procedure Redraw(Const rec:TRect);Override;
  1922.       Published
  1923.         Property Align;
  1924.         Property Cursor;
  1925.         Property Tag;
  1926.         Property AutoScroll;
  1927.         Property BorderStyle:TBorderStyle read FBorderStyle write SetBorderStyle;
  1928.         Property DragCursor;
  1929.         Property DragMode;
  1930.         Property Enabled;
  1931.         Property Color;
  1932.         Property Font;
  1933.         Property HorzScrollBar; stored False;
  1934.         Property VertScrollBar; stored False;
  1935.         Property ParentColor;
  1936.         Property ParentFont;
  1937.         Property ParentShowHint;
  1938.         Property PopupMenu;
  1939.         Property ShowHint;
  1940.         Property TabOrder;
  1941.         Property TabStop;
  1942.         Property Visible;
  1943.         Property ZOrder;
  1944.         Property OnClick;
  1945.         Property OnCanDrag;
  1946.         Property OnKeyPress;
  1947.         Property OnDblClick;
  1948.         Property OnDragDrop;
  1949.         Property OnDragOver;
  1950.         Property OnEndDrag;
  1951.         Property OnEnter;
  1952.         Property OnExit;
  1953.         Property OnMouseDown;
  1954.         Property OnMouseMove;
  1955.         Property OnMouseUp;
  1956.         Property OnResize;
  1957.         Property OnPaint;
  1958.         Property OnScan;
  1959.         Property OnShow;
  1960.     End;
  1961.  
  1962.  
  1963. {$M+}
  1964.     TCloseAction=(caNone,caHide,caFree,caMinimize,caFreeHandle);
  1965.  
  1966.     TWindowState=(wsNormal,wsMinimized,wsMaximized);
  1967.  
  1968.     TBorderIcons=Set Of (biSystemMenu,biMinimize,biMaximize,biHelp);
  1969.  
  1970.     TFormStyle=(fsNormal,fsMDIChild,fsMDIForm);
  1971.  
  1972.     TTileMode=(tbHorizontal,tbVertical,tbNormal);
  1973.  
  1974.     TCloseEvent=Procedure(Sender:TObject;Var Action:TCloseAction) Of Object;
  1975.     TMDIActivateEvent=Procedure(Sender:TObject;Child:TForm) Of Object;
  1976.     TMDIDeactivateEvent=Procedure(Sender:TObject;Child:TForm) Of Object;
  1977.     TTranslateShortCutEvent=Procedure(Sender:TObject;KeyCode:TKeyCode;Var ReceiveR:TforM) Of object;
  1978. {$M-}
  1979.  
  1980.     {FAccelList Item}
  1981.     PAccelItem=^AccelItem;
  1982.     AccelItem=Record
  1983.          KeyCode:TKeyCode;
  1984.          Command:TCommand;
  1985.     End;
  1986.  
  1987.  
  1988.     TPosition=(poDesigned,poDefault,poDefaultPosOnly,poDefaultSizeOnly,poScreenCenter);
  1989.  
  1990.     TModalResult=TCommand;
  1991.  
  1992.     TForm=Class(TScrollingWinControl)
  1993.       Private
  1994.          FMainMenu:TMainMenu;
  1995.          FLastMenu:TMenu;
  1996.          FLastEntry:TMenuItem;
  1997.          FMenuHandleList:TList;
  1998.          FAccelList:TList;
  1999.          FAccel:LongWord;
  2000.          FShortCutsEnabled:Boolean;
  2001.          FTopMDIChild:TForm;
  2002.          FIsModal:Boolean;
  2003.          FModalShowing:Boolean;
  2004.          FModalResult:TModalResult;
  2005.          FLocked:Boolean;
  2006.          FWindowState:TWindowState;
  2007.          FBorderIcons:TBorderIcons;
  2008.          FBorderStyle:TFormBorderStyle;
  2009.          FFormStyle:TFormStyle;
  2010.          FTileMode:TTileMode;
  2011.          FMinTrackWidth:LongInt;
  2012.          FMinTrackHeight:LongInt;
  2013.          FMaxTrackWidth:LongInt;
  2014.          FMaxTrackHeight:LongInt;
  2015.          FEnableDocking:TToolbarAlignments;
  2016.          FMoveable:Boolean;
  2017.          FSizeable:Boolean;
  2018.          FActiveControl:TControl;
  2019.          FMDIChildren:TList;
  2020.          FToolBarLists:Array[TToolbarAlign] Of TList;
  2021.          FIcon:TGraphic;
  2022.          FInternalWindowIdCount:LongWord;
  2023.          FDBCSStatusLine:Boolean;
  2024.          DefaultButton:TControl;
  2025.          CancelButton:TControl;
  2026.          FPosition:TPosition;
  2027.          FOnActivate:TNotifyEvent;
  2028.          FOnDeactivate:TNotifyEvent;
  2029.          FOnMDIActivate:TMDIActivateEvent;
  2030.          FOnMDIDeactivate:TMDIDeactivateEvent;
  2031.          FOnClose:TCloseEvent;
  2032.          FOnDismissDlg:TNotifyEvent;
  2033.          FOnMenuInit:TMenuEvent;
  2034.          FOnMenuEnd:TMenuEvent;
  2035.          FOnMenuItemFocus:TMenuEvent;
  2036.          FOnTranslateShortCut:TTranslateShortCutEvent;
  2037.          FOnMinimize:TNotifyEvent;
  2038.          FOnMaximize:TNotifyEvent;
  2039.          FOnRestore:TNotifyEvent;
  2040.          FOnCreate:TNotifyEvent;
  2041.          FOnDestroy:TNotifyEvent;
  2042.          Procedure CMRelease(Var Msg:TMessage); Message CM_RELEASE;
  2043.          Procedure CMEndModalState(Var Msg:TMessage); Message CM_ENDMODALSTATE;
  2044.          Procedure CMUpdateButtons(Var Msg:TMessage); Message CM_UPDATEBUTTONS;
  2045.          Procedure WMActivate(Var Msg:TWMActivate); Message WM_ACTIVATE;
  2046.          {$IFDEF OS2}
  2047.          Procedure WMClose(Var Msg:TWMClose); Message WM_CLOSE;
  2048.          Procedure WMInitMenu(Var Msg:TMessage); Message WM_INITMENU;
  2049.          Procedure WMMenuEnd(Var Msg:TMessage); Message WM_MENUEND;
  2050.          Procedure WMMenuSelect(Var Msg:TMessage); Message WM_MENUSELECT;
  2051.          Procedure WMTranslateAccel(Var Msg:TMessage); Message WM_TRANSLATEACCEL;
  2052.          Procedure WMDDEInitiate(Var Msg:TMessage); Message WM_DDE_INITIATE;
  2053.          Procedure WMDDEDestroy(Var Msg:TMessage); Message WM_DDE_DESTROY;
  2054.          {$ENDIF}
  2055.          Procedure AlignToolBars;
  2056.          Function GetFrameFlags:LongWord;
  2057.          Function GetMDIChildCount:LongInt;
  2058.          Function GetMDIChild(AIndex:LongInt):TForm;
  2059.          Procedure SetWindowState(NewState:TWindowState);
  2060.          Function GetWindowState:TWindowState;
  2061.          Procedure SetBorderIcons(NewIcons:TBorderIcons);
  2062.          Procedure SetBorderStyle(NewStyle:TFormBorderStyle);
  2063.          Function GetTabOrder:LongInt;Override;
  2064.          Function GetAddWidth:LongInt;
  2065.          Function GetAddHeight:LongInt;
  2066.          Function GetClientRect:TRect;Override;
  2067.          Procedure SetClientWidth(NewWidth:LongInt);Override;
  2068.          Procedure SetClientHeight(NewHeight:LongInt);Override;
  2069.          Function GetClientOrigin:TPoint;Override;
  2070.          Procedure SetDBCSStatusLine(Value:Boolean);
  2071.          Procedure SetActiveControl(AControl:TControl);
  2072.          Procedure ForwardShortCut(Var Msg:TMessage);
  2073.          Procedure SetIcon(NewIcon:TGraphic);
  2074.          Function GetIcon:TGraphic;
  2075.          Procedure IconChanged(Sender:TObject);
  2076.          Procedure SetMainMenu(AMenu:TMainMenu);
  2077.          Procedure SetShortCutsEnabled(Value:Boolean);
  2078.          Procedure SetFormStyle(Value:TFormStyle);
  2079.          Procedure InsertMDIChild(Child:TForm);
  2080.          Procedure RemoveMDIChild(Child:TForm);
  2081.          Procedure CreateUniqueWindowId(AChild:TControl);
  2082.          Function GetLanguage:String;
  2083.          Procedure SetLanguage(Const NewLanguage:String);
  2084.          Procedure SetPosition(NewValue:TPosition);
  2085.          Constructor CreateIntern(AOwner:TComponent; Var AReference:TForm);
  2086.       Protected
  2087.          Procedure CreateControls;Override;
  2088.          Procedure RealignControls;Override;
  2089.          Procedure Activate;Virtual;
  2090.          Procedure Deactivate;Virtual;
  2091.          Procedure MDIActivate(Child:TForm);Virtual;
  2092.          Procedure MDIDeactivate(Child:TForm);Virtual;
  2093.          Function GetTileCascadeRect:TRect;Virtual;
  2094.          Procedure ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);Override;
  2095.          Procedure CommandEvent(Var Command:TCommand);Override;
  2096.          Procedure TranslateShortCut(KeyCode:TKeyCode;Var Receiver:TForm);Virtual;
  2097.          Function CloseQuery:Boolean;Virtual;
  2098.          Procedure EndModalState;Virtual;
  2099.          Procedure SetupComponent;Override;
  2100.          Procedure CreateWnd;Override;
  2101.          Procedure SetupShow;Override;
  2102.          Procedure SetFocus;Override;
  2103.          Procedure Resize;Override;
  2104.          Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
  2105.          Procedure MenuInit(AMenu:TMenu;entry:TMenuItem);Virtual;
  2106.          Procedure MenuEnd(AMenu:TMenu;entry:TMenuItem);Virtual;
  2107.          Procedure MenuItemFocus(AMenu:TMenu;entry:TMenuItem);Virtual;
  2108.          Procedure MenuCharEvent(AMenu:TMenu;entry:TMenuItem;Var key:Char;REP:ByTe);Virtual;
  2109.          Procedure MenuScanEvent(AMenu:TMenu;entry:TMenuItem;Var KeyCode:TKeyCodE;REP:Byte);Virtual;
  2110.          Procedure LoadedFromSCU(SCUParent:TComponent);Override;
  2111.       Public
  2112.          Constructor Create(AOwner:TComponent);Override;
  2113.          Constructor CreateNew(AOwner:TComponent);
  2114.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInT);Override;
  2115.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  2116.          Destructor Destroy;Override;
  2117.          Procedure Release;
  2118.          Function ShowModal:LongWord;Virtual;
  2119.          Procedure DismissDlg(Result:TCommand);Virtual;
  2120.          Procedure Close;Virtual;
  2121.          Procedure RemoveComponent(AComponent:TComponent);Override;
  2122.          Procedure InsertControl(AChild:TControl);Override;
  2123.          Procedure RemoveControl(AChild:TControl);Override;
  2124.          Procedure SetWindowPos(NewLeft,NewBottom,NewWidth,NewHeight:LongInt);Override;
  2125.          Procedure BringToFront;Override;
  2126.          Procedure Tile;Virtual;
  2127.          Procedure Cascade;Virtual;
  2128.          Procedure Next;Virtual;
  2129.          Function GetFormImage:TGraphic;
  2130.          Procedure Print(Canvas:TCanvas;Dest:TRect);
  2131.          Procedure Previous;Virtual;
  2132.          Procedure CloseAll;Virtual;
  2133.          Procedure AddShortCut(KeyCode:TKeyCode;Command:TCommand);
  2134.          Procedure DeleteShortCut(KeyCode:TKeyCode);
  2135.       Public
  2136.          Property Moveable:Boolean Read FMoveable Write FMoveable; {only OS2}
  2137.          Property Sizeable:Boolean Read FSizeable Write FSizeable; {only OS2}
  2138.          Property ModalResult:TModalResult Read FModalResult Write FModalResult;
  2139.          Property IsModal:Boolean Read FIsModal;
  2140.          Property TileMode:TTileMode Read FTileMode Write FTileMode;
  2141.          Property MDIChildren[Index:LongInt]:TForm Read GetMDIChild;
  2142.          Property MDIChildCount:LongInt Read GetMDIChildCount;
  2143.          Property ActiveMDIChild:TForm Read FTopMDIChild;
  2144.          Property ActiveControl:TControl Read FActiveControl Write SetActiveContRol;
  2145.          Property Frame:TControl Read FFrame;
  2146.          Property DBCSStatusLine:Boolean Read FDBCSStatusLine Write SetDBCSStatuSlinE;
  2147.          Property ShortCutsEnabled:Boolean Read FShortCutsEnabled Write SetShortCutsEnablEd;
  2148.          Property XAlign;
  2149.          Property XStretch;
  2150.          Property YAlign;
  2151.          Property YStretch;
  2152.       Published
  2153.          Property Align;
  2154.          Property AutoScroll;
  2155.          Property Color;
  2156.          Property BorderIcons:TBorderIcons Read FBorderIcons Write SetBorderIcons;
  2157.          Property BorderStyle:TFormBorderStyle Read FBorderStyle Write SetBorderStYlE;
  2158.          Property Caption;
  2159.          Property ClientWidth;
  2160.          Property ClientHeight;
  2161.          Property Language:String Read GetLanguage Write SetLanguage;
  2162.          Property Menu:TMainMenu Read FMainMenu Write SetMainMenu;
  2163.          Property MaxTrackWidth:LongInt Read FMaxTrackWidth Write FMaxTrackWidth;
  2164.          Property MaxTrackHeight:LongInt Read FMaxTrackHeight Write FMaxTrackHeighT;
  2165.          Property MinTrackWidth:LongInt Read FMinTrackWidth Write FMinTrackWidth;
  2166.          Property MinTrackHeight:LongInt Read FMinTrackHeight Write FMinTrackHeighT;
  2167.          Property PenColor;
  2168.          Property PopupMenu;
  2169.          Property Position:TPosition Read FPosition Write SetPosition;
  2170.          Property Enabled;
  2171.          Property EnableDocking:TToolbarAlignments Read FEnableDocking Write FEnabLeDockiNg;
  2172.          Property Font;
  2173.          Property FormStyle:TFormStyle Read FFormStyle Write SetFormStyle;
  2174.          Property Icon:TGraphic Read GetIcon Write SetIcon;
  2175.          Property ScrollBars;
  2176.          Property HorzScrollBar;
  2177.          Property VertScrollBar;
  2178.          Property ShowHint;
  2179.          Property Visible;
  2180.          Property WindowState:TWindowState Read GetWindowState Write SetWindowStatE;
  2181.  
  2182.          Property OnActivate:TNotifyEvent Read FOnActivate Write FOnActivate;
  2183.          Property OnClick;
  2184.          Property OnClose:TCloseEvent Read FOnClose Write FOnClose;
  2185.          Property OnCommand;
  2186.          Property OnCreate:TNotifyEvent Read FOnCreate Write FOnCreate;
  2187.          Property OnDblClick;
  2188.          Property OnDeactivate:TNotifyEvent Read FOnDeactivate Write FOnDeactivate;
  2189.          Property OnDestroy:TNotifyEvent Read FOnDestroy Write FOnDestroy;
  2190.          Property OnDismissDlg:TNotifyEvent Read FOnDismissDlg Write FOnDismissDlg;
  2191.          Property OnDragDrop;
  2192.          Property OnDragOver;
  2193.          Property OnEndDrag;
  2194.          Property OnFontChange;
  2195.          Property OnHide;
  2196.          Property OnKeyPress;
  2197.          Property OnMaximize:TNotifyEvent Read FOnMaximize Write FOnMaximize;
  2198.          Property OnMDIActivate:TMDIActivateEvent Read FOnMDIActivate Write FOnMDIAcTivatE;
  2199.          Property OnMDIDeactivate:TMDIDeactivateEvent Read FOnMDIDeactivate Write FONMDIDEacTivate;
  2200.          Property OnMenuEnd:TMenuEvent Read FOnMenuEnd Write FOnMenuEnd;
  2201.          Property OnMenuInit:TMenuEvent Read FOnMenuInit Write FOnMenuInit;
  2202.          Property OnMenuItemFocus:TMenuEvent Read FOnMenuItemFocus Write FOnMenuItemFocus;
  2203.          Property OnMinimize:TNotifyEvent Read FOnMinimize Write FOnMinimize;
  2204.          Property OnMouseClick;
  2205.          Property OnMouseDblClick;
  2206.          Property OnMouseDown;
  2207.          Property OnMouseMove;
  2208.          Property OnMouseUp;
  2209.          Property OnMove;
  2210.          Property OnPaint;
  2211.          Property OnResize;
  2212.          Property OnRestore:TNotifyEvent Read FOnRestore Write FOnRestore;
  2213.          Property OnScan;
  2214.          Property OnSetupShow;
  2215.          Property OnShow;
  2216.          Property OnTranslateShortCut:TTranslateShortCutEvent Read FOnTranslateShortCut WritE fonTranslateShortCut;
  2217.     End;
  2218.  
  2219.  
  2220.     HCursor=LongWord;
  2221.  
  2222.     PCursorRec=^TCursorRec;
  2223.     TCursorRec=Record
  2224.          Index:TCursor;
  2225.          Handle:HCursor;
  2226.          Next:PCursorRec;
  2227.     End;
  2228.  
  2229.  
  2230.     TScreen=Class(TComponent)
  2231.       Private
  2232.          FFonts:TList;                      //Font List available (TFont)
  2233.          FCursor:TCursor;
  2234.          FCursorList:PCursorRec;  //mouse Cursor List available
  2235.          FDefaultCursor:HCursor;
  2236.          FForms:TList;                      //Forms on the DeskTop (TForm)
  2237.          FActiveForm:TForm;                 //Active DeskTop Form
  2238.          FActiveControl:TControl;
  2239.          FLastActiveForm:TForm;
  2240.          FLastActiveControl:TControl;
  2241.          FCanvas:TCanvas;
  2242.          FMenuFont:TFont;
  2243.          FSystemFont:TFont;
  2244.          FDefaultFont:TFont;
  2245.          FDefaultFrameFont:TFont;
  2246.          FFontWindow:TControl;              //FontWindow For OS/2
  2247.          FHiddenWindow:TControl;             //Window For PopupMenus & Timers
  2248.          FOnActiveFormChange:TNotifyEvent;
  2249.          FOnActiveControlChange:TNotifyEvent;
  2250.          Procedure CreateCursors;
  2251.          Procedure DestroyCursors;
  2252.          Procedure InsertCursor(Index:TCursor;Handle:HCursor);
  2253.          Procedure DeleteCursor(Index:TCursor);
  2254.          Function GetCursors(Index:TCursor):HCursor;
  2255.          Procedure SetCursors(Index:TCursor;Handle:HCursor);
  2256.          Procedure SetCursor(Index:TCursor);
  2257.          Function GetHeight:LongInt;
  2258.          Function GetWidth:LongInt;
  2259.          Function GetFormCount:LongInt;
  2260.          Function GetForm(Index:LongInt):TForm;
  2261.          Function GetFontCount:LongInt;
  2262.          Function GetFont(Index:LongInt):TFont;
  2263.          Function GetMousePos:TPoint;
  2264.          Procedure SetMousePos(NewPos:TPoint);
  2265.          Function GetSystemDefaultFont:TFont;
  2266.          Function GetSystemFixedFont:TFont;
  2267.          Function GetSystemSmallFont:TFont;
  2268.          Procedure UpdateLastActive;
  2269.          Function GetCanvas:TCanvas;
  2270.       Protected
  2271.          Procedure SetupComponent;Override;
  2272.       Public
  2273.          Destructor Destroy;Override;
  2274.          Function CreateCompatibleFont(Src:TFont):TFont;
  2275.          Function GetFontFromName(FaceName:String;Height,Width:LongInt):TFont;
  2276.          Function GetFontFromPointSize(FaceName:String;PointSize:LongWord):TFont;
  2277.          Function GetControlFromPoint(pt:TPoint):TControl;
  2278.          Function SystemMetrics(sm:TSystemMetrics):LongInt;
  2279.          Function SystemColors(sc:TColor):TColor;
  2280.          Procedure Update;
  2281.          Procedure MapPoints(Target:TControl;Var pts:Array Of TPoint);
  2282.          Function AddCursor(Handle:HCursor):TCursor;
  2283.       Public
  2284.          Property Width:LongInt Read GetWidth;
  2285.          Property Height:LongInt Read GetHeight;
  2286.          Property Forms[Index:LongInt]:TForm Read GetForm;
  2287.          Property FormCount:LongInt Read GetFormCount;
  2288.          Property ActiveForm:TForm Read FActiveForm;
  2289.          Property ActiveControl:TControl Read FActiveControl;
  2290.          Property MousePos:TPoint Read GetMousePos Write SetMousePos;
  2291.          Property Cursor:TCursor Read FCursor Write SetCursor;
  2292.          Property Cursors[Index:TCursor]:HCursor Read GetCursors Write SetCursors;
  2293.          Property Fonts[Index:LongInt]:TFont Read GetFont;
  2294.          Property FontCount:LongInt Read GetFontCount;
  2295.          Property DefaultFrameFont:TFont Read FDefaultFrameFont;
  2296.          Property DefaultFont:TFont Read GetSystemDefaultFont;
  2297.          Property FixedFont:TFont Read GetSystemFixedFont;
  2298.          Property SmallFont:TFont Read GetSystemSmallFont;
  2299.          Property Canvas:TCanvas Read GetCanvas;
  2300.          Property MenuFont:TFont Read FMenuFont;
  2301.          Property OnActiveFormChange:TNotifyEvent Read FOnActiveFormChange Write FOnActiveFormChange;
  2302.          Property OnActiveControlChange:TNotifyEvent Read FOnActiveControlChange Write FOnActiveControlChange;
  2303.     End;
  2304.  
  2305.  
  2306.     {$HINTS OFF}
  2307.     TGraphic=Class(TComponent)
  2308.       Private
  2309.          FIsLocalCopy:Boolean;
  2310.          FOnChangedNotify:TNotifyEvent;
  2311.          FOnChange:TNotifyEvent;
  2312.          FCreatePalette:Boolean;
  2313.       Public
  2314.          Procedure Draw(Canvas:TCanvas;Const Dest:TRect);Virtual;Abstract;
  2315.          Procedure PartialDraw(Canvas:TCanvas;Const Src,Dest:TRect);Virtual;Abstract;
  2316.          Procedure LoadFromFile(Const FileName:String);Virtual;
  2317.          Procedure SaveToFile(Const FileName:String);Virtual;
  2318.          Procedure LoadFromStream(Stream:TStream);Virtual;Abstract;
  2319.          Procedure SaveToStream(Stream:TStream);Virtual;Abstract;
  2320.          Function CopyGraphic:TGraphic;Virtual;Abstract;
  2321.          Procedure Changed;Virtual;
  2322.          Function CreateMask(Color:TColor):TGraphic;Virtual;Abstract;
  2323.          Constructor Create;Virtual;
  2324.          Procedure LoadFromHandle(Handle:LongWord);Virtual;Abstract;
  2325.          Procedure LoadFromResourceId(Id:LongWord);Virtual;Abstract;
  2326.          Procedure LoadFromResourceName(Const Name:String);Virtual;Abstract;
  2327.          Procedure LoadFromMem(Var Buf;Size:LongInt);Virtual;Abstract;
  2328.       Protected
  2329.          Function GetEmpty:Boolean;Virtual;Abstract;
  2330.          Function GetHeight:LongInt;Virtual;Abstract;
  2331.          Procedure SetHeight(NewHeight:LongInt);Virtual;Abstract;
  2332.          Function GetWidth:LongInt;Virtual;Abstract;
  2333.          Procedure SetWidth(NewWidth:LongInt);Virtual;Abstract;
  2334.          Function GetHandle:LongWord;Virtual;Abstract;
  2335.          Function GetCanvas:TCanvas;Virtual;Abstract;
  2336.          Function GetSize:LongInt;Virtual;Abstract;
  2337.          Function WriteSCUResourceName(Stream:TResourceStream;ResName:TResourceNAme):Boolean;Virtual;Abstract;
  2338.          Procedure PaletteChanged;Virtual;Abstract;
  2339.          Procedure CreateNew(NewWidth,NewHeight:LongWord;Colors:LongWord);Virtual;Abstract;
  2340.       Public
  2341.          Property Empty:Boolean Read GetEmpty;
  2342.          Property Height:LongInt Read GetHeight Write SetHeight;
  2343.          Property Width:LongInt Read GetWidth Write SetWidth;
  2344.          Property Handle:LongWord Read GetHandle;
  2345.          Property Canvas:TCanvas Read GetCanvas;
  2346.          Property Size:LongInt Read GetSize;
  2347.          Property CreatePalette:Boolean Read FCreatePalette Write FCreatePalette;
  2348.          Property OnChange:TNotifyEvent read FOnChange write FOnChange;
  2349.     End;
  2350.     {$HINTS ON}
  2351.     TGraphicClass=Class Of TGraphic;
  2352.  
  2353.  
  2354.     TPalette=Class(TComponent)
  2355.       Private
  2356.          FHandle:LongWord;
  2357.          FCanvas:TCanvas;
  2358.       Private
  2359.          Function GetColor(Index:LongWord):TColor;
  2360.          Procedure SetColor(Index:LongWord;NewColor:TColor);
  2361.          Function GetColorCount:LongWord;
  2362.          Function GetHandle:LongWord;
  2363.       Protected
  2364.          Procedure SetupComponent;Override;
  2365.       Public
  2366.          Function GetColorArray(StartIndex:LongWord;Var ResultArray:Array Of TCoLor):LongWord;
  2367.          Procedure SetColorArray(StartIndex:LongWord;Const SourceArray:Array Of Tcolor);
  2368.          Procedure CreateNew(Var Colors:Array Of TColor);
  2369.          Procedure RealizePalette;
  2370.       Public
  2371.          Property ColorCount:LongWord Read GetColorCount;
  2372.          Property Handle:LongWord Read GetHandle Write FHandle;
  2373.          Property Colors[Index:LongWord]:TColor Read GetColor Write SetColor;
  2374.          Property Canvas:TCanvas Read FCanvas;
  2375.     End;
  2376.  
  2377.     TPathClipMode=(paAdd,paSubtract,paReplace,paDiff,paIntersect);
  2378.  
  2379.     {$IFDEF OS2}
  2380.     {
  2381.     Matrix of
  2382.  
  2383.     ┌           ┐
  2384.     │M11 M12 M13│
  2385.     │M21 M22 M23│
  2386.     │M31 M32 M33│
  2387.     └           ┘
  2388.  
  2389.     used for Canvas.Transform.
  2390.     }
  2391.  
  2392.     TMatrix=Object
  2393.        Private
  2394.           FMatrix:MATRIXLF;
  2395.        Private
  2396.           Function GetM11:Extended;
  2397.           Procedure SetM11(Const NewValue:Extended);
  2398.           Function GetM12:Extended;
  2399.           Procedure SetM12(Const NewValue:Extended);
  2400.           Function GetM21:Extended;
  2401.           Procedure SetM21(Const NewValue:Extended);
  2402.           Function GetM22:Extended;
  2403.           Procedure SetM22(Const NewValue:Extended);
  2404.           Constructor CreateIntern;
  2405.        Public
  2406.           Constructor CreateEmpty;
  2407.           Constructor Create(Const aM11,aM12:Extended;aM13:LongInt;
  2408.                              Const aM21,aM22:Extended;aM23:LongInt;
  2409.                              Const aM31,aM32,aM33:LongInt);
  2410.           Constructor CreateLike(m:TMatrix);
  2411.           Constructor CreateTranslation(DeltaX,DeltaY:LongInt);
  2412.           Constructor CreateScaling(Const ScalePercentX,ScalePercentY:Extended);
  2413.           Constructor CreateVertReflection;
  2414.           Constructor CreateHorzReflection;
  2415.           Constructor CreateYShear(Const Shear:Extended);
  2416.           Constructor CreateXShear(Const Shear:Extended);
  2417.           Constructor CreateRotation(Const Degree:Extended);
  2418.           Constructor CreateDefault;
  2419.           Destructor Destroy;
  2420.           Procedure Assign(m:TMatrix);
  2421.           Procedure TransformPoint(Var pt:TPoint);
  2422.        Public
  2423.           Property M11:Extended read GetM11 write SetM11;
  2424.           Property M12:Extended read GetM12 write SetM12;
  2425.           Property M13:Longint read FMatrix.lM13 write FMatrix.lM13;
  2426.           Property M21:Extended read GetM21 write SetM21;
  2427.           Property M22:Extended read GetM22 write SetM22;
  2428.           Property M23:LongInt read FMatrix.lM23 write FMatrix.lM23;
  2429.           Property M31:LongInt read FMatrix.lM31 write FMatrix.lM31;
  2430.           Property M32:LongInt read FMatrix.lM32 write FMatrix.lM32;
  2431.           Property M33:LongInt read FMatrix.lM33 write FMatrix.lM33;
  2432.     End;
  2433.  
  2434.     {$M+}
  2435.     TTransformMode=(trReplace,trAdd,trPreEmpt);
  2436.     TAreaMode=(arNoBoundary,arBoundary,arAlternate,arWinding,
  2437.                arNoBoundaryAlternate,arNoBoundaryWinding,
  2438.                arBoundaryWinding,arBoundaryAlternate);
  2439.     {$M-}
  2440.     {$ENDIF}
  2441.  
  2442.     TCanvas=Class(TComponent)
  2443.       Private
  2444.          FControl:TControl;
  2445.          FGraphic:TGraphic;
  2446.          {$IFDEF OS2}
  2447.          FUsePath:Boolean;
  2448.          {$ENDIF}
  2449.          {$IFDEF Win32}
  2450.          FPenHandle:LongWord;
  2451.          FBrushHandle:LongWord;
  2452.          FInPath:Boolean;
  2453.          {$ENDIF}
  2454.          FFont:TFont;
  2455.          FFontHandle:LongWord;
  2456.          FFontWidth,FFontHeight:LongInt;
  2457.          FFontAttr:TFontAttributes;
  2458.          FLineWidth:LongInt;
  2459.          FLineType:TPenStyle;
  2460.          FBackMix:TBrushMode;
  2461.          FForeMix:TPenMode;
  2462.          FClipRGN:LongWord;
  2463.          FClipRect:TRect;
  2464.          FHandle:LongWord;
  2465.          FPalette:TPalette;
  2466.          FBrush:TBrush;
  2467.          FPen:TPen;
  2468.          FCopyMode:TBitBltMode;
  2469.          FNonDisplayDevice:Boolean;
  2470.          FOwnerDraw:Boolean;
  2471.          Function GetPenPosition:TPoint;
  2472.          Procedure SetPenPosition(NewPosition:TPoint);
  2473.          Procedure CreateFont(NewFont:TFont;ModifyControlFont:Boolean);
  2474.          Procedure SetFont(NewFont:TFont);
  2475.          Procedure SetFontHeight(NewHeight:LongInt);
  2476.          Function GetFontHeight:LongInt;
  2477.          Procedure SetFontWidth(NewWidth:LongInt);
  2478.          Function GetFontWidth:LongInt;
  2479.          Procedure SetFontAttr(NewAttr:TFontAttributes);
  2480.          Function GetFontAttr:TFontAttributes;
  2481.          Procedure SetClipRect(Const rec:TRect);
  2482.          Function GetPixel(X,Y:LongInt):TColor;
  2483.          Procedure SetPixel(X,Y:LongInt;Value:TColor);
  2484.          Function GetVerticalRes:LongInt;
  2485.          Function GetHorizontalRes:LongInt;
  2486.          Procedure SetPen(NewPen:TPen);
  2487.          Procedure SetBrush(NewBrush:TBrush);
  2488.          Procedure SetPalette(NewPalette:TPalette);
  2489.          Function GetPageViewPort:TRect;
  2490.          Procedure SetPageViewPort(NewValue:TRect);
  2491.          {$IFDEF OS2}
  2492.          Procedure SetTransformMatrix(Const m:TMatrix);
  2493.          Function GetTransformMatrix:TMatrix;
  2494.          Function GetLineColor:TColor;
  2495.          Function GetCharColor:TColor;
  2496.          Function GetAreaColor:TColor;
  2497.          Procedure SetLineColor(NewValue:TColor);
  2498.          Procedure SetCharColor(NewValue:TColor);
  2499.          Procedure SetAreaColor(NewValue:TColor);
  2500.          {$ENDIF}
  2501.       Protected
  2502.          Procedure SetupComponent;Override;
  2503.       Public
  2504.          Destructor Destroy;Override;
  2505.          Procedure EraseBackGround;Virtual;
  2506.          Procedure Init;Virtual;
  2507.  
  2508.          {$IFDEF OS2}
  2509.          Procedure Transform(m:TMatrix;Mode:TTransformMode);
  2510.          Procedure ResetTransform;
  2511.          Procedure BeginArea(Mode:TAreaMode);
  2512.          Procedure EndArea;
  2513.          Procedure PolySpline(aptl:Array Of TPoint);
  2514.          {$ENDIF}
  2515.          Procedure CreateHandle;Virtual;
  2516.          Procedure DestroyHandle;Virtual;
  2517.          Procedure FillRect(Const rec:TRect;FillColor:TColor);Virtual;
  2518.          Procedure MoveTo(X,Y:LongInt);Virtual;
  2519.          Procedure LineTo(X,Y:LongInt);Virtual;
  2520.          Procedure Line(X,Y,X1,y1:LongInt);Virtual;
  2521.          Procedure PolyLine(Points:Array Of TPoint);Virtual;
  2522.          Procedure Polygon(Points:Array Of TPoint);Virtual;
  2523.          Procedure ShadowedBorder(Const rec:TRect;ColorHi,ColorLo:TColor);
  2524.          Procedure RoundShadowedBorder(Const rec:TRect;ColorHi,ColorLo:TColor);
  2525.          Procedure DrawFocusRect(Const rec:TRect);
  2526.          Procedure Rectangle(Const rec:TRect);
  2527.          Procedure RoundRect(Const rec:TRect;RoundWidth,RoundHeight:LongInt);
  2528.          Procedure FilledRoundRect(Const rec:TRect;RoundWidth,RoundHeight:LongInt);
  2529.          Procedure DrawInvertRect(Const rec:TRect);
  2530.          Procedure Box(Const rec:TRect);
  2531.          Procedure OutlineBox(Const rec:TRect);
  2532.          Procedure Circle(X,Y:LongInt;Radius:LongInt);
  2533.          Procedure Arc(X,Y:LongInt;RadiusX,RadiusY:LongInt;StartAngle,SweepAngle:Extended);
  2534.          Procedure BrushCopy(Const Dest:TRect;Bitmap:TGraphic;
  2535.                              Const Source:TRect;Color:TColor);
  2536.          Procedure Chord(X,Y:LongInt;RadiusX,RadiusY:LongInt;StartAngle,SweepAnglE:Extended);
  2537.          Procedure Pie(X,Y:LongInt;RadiusX,RadiusY:LongInt;StartAngle,SweepAngle:Extended);
  2538.          Procedure CopyRect(Const Dest:TRect;Canvas:TCanvas;Const Source:TRect);
  2539.          Procedure BezierSpline(X,Y:LongInt;Points:Array Of TPoint);
  2540.          Procedure FilledCircle(X,Y:LongInt;Radius:LongInt);
  2541.          Procedure Ellipse(X,Y:LongInt;RadiusX,RadiusY:LongInt);
  2542.          Procedure FilledEllipse(X,Y:LongInt;RadiusX,RadiusY:LongInt);
  2543.          Procedure DrawString(Const S:String);
  2544.          Procedure TextOut(X,Y:LongInt;Const S:String);
  2545.          Procedure MnemoTextOut(X,Y:LongInt;Const S:String);
  2546.          Procedure Draw(X,Y:LongInt;Graphic:TGraphic);
  2547.          Procedure PartialDraw(X,Y:LongInt;Const SourceRec:TRect;Graphic:TGraphic);
  2548.          Procedure StretchDraw(X,Y,Width,Height:LongInt;Graphic:TGraphic);
  2549.          Procedure StretchPartialDraw(X,Y,Width,Height:LongInt;Const SourceRec:TRect;Graphic:TGraphic);
  2550.          Function TextHeight(Const Text:String):LongInt;
  2551.          Function TextWidth(Const Text:String):LongInt;
  2552.          Procedure TextRect(Const rc:TRect;X,Y:LongInt;Const Text:String);
  2553.          Procedure FloodFill(X,Y:LongInt;BorderColor:TColor;FillSurface:Boolean);
  2554.          Procedure GetTextExtent(Const S:String;Var Width,Height:LongInt);
  2555.          Procedure SetClipRegion(Rects:Array Of TRect);
  2556.          Procedure DeleteClipRegion;
  2557.          Procedure ExcludeClipRect(Const rec:TRect);
  2558.          Procedure BitBlt(DestCanvas:TCanvas;Const Dest,Source:TRect;
  2559.                           Mode:TBitBltMode;Flags:TBitBltFlags);
  2560.          Procedure BeginPath;
  2561.          Procedure EndPath;
  2562.          Procedure FillPath;
  2563.          Procedure StrokePath;
  2564.          Procedure OutlinePath;
  2565.          Procedure CloseFigure;
  2566.          Procedure PathToClipRegion(Mode:TPathClipMode);
  2567.       Public
  2568.          Property NonDisplayDevice:Boolean read FNonDisplayDevice write FNonDisplayDevice;
  2569.          Property Handle:LongWord Read FHandle Write FHandle;
  2570.          Property OwnerDraw:Boolean read FOwnerDraw write FOwnerDraw;
  2571.          Property Graphic:TGraphic Read FGraphic;
  2572.          Property Control:TControl Read FControl;
  2573.          Property PenPos:TPoint Read GetPenPosition Write SetPenPosition;
  2574.          Property Font:TFont Read FFont Write SetFont;
  2575.          Property FontHeight:LongInt Read GetFontHeight Write SetFontHeight;
  2576.          Property FontWidth:LongInt Read GetFontWidth Write SetFontWidth;
  2577.          Property FontAttributes:TFontAttributes Read GetFontAttr Write SetFontAttr;
  2578.          Property ClipRect:TRect Read FClipRect Write SetClipRect;
  2579.          Property Pixels[X,Y:LongInt]:TColor Read GetPixel Write SetPixel;
  2580.          Property Palette:TPalette Read FPalette Write SetPalette;
  2581.          Property VerticalResolution:LongInt Read GetVerticalRes;
  2582.          Property HorizontalResolution:LongInt Read GetHorizontalRes;
  2583.          Property Pen:TPen Read FPen Write SetPen;
  2584.          Property Brush:TBrush Read FBrush Write SetBrush;
  2585.          Property CopyMode:TBitBltMode Read FCopyMode Write FCopyMode;
  2586.          Property PageViewPort:TRect read GetPageViewPort write SetPageViewPort;
  2587.          {$IFDEF OS2}
  2588.          Property TransformMatrix:TMatrix read GetTransformMatrix write SetTransformMatrix;
  2589.          Property LineColor:TColor read GetLineColor write SetLineColor;
  2590.          Property AreaColor:TColor read GetAreaColor write SetAreaColor;
  2591.          Property CharColor:TColor read GetCharColor write SetCharColor;
  2592.          {$ENDIF}
  2593.     End;
  2594.  
  2595.  
  2596. Type
  2597.     TPlatform=(OS2Ver20, OS2Ver30, OS2Ver40, Win32);
  2598.  
  2599.     THintInfo=Record
  2600.          HintControl:TControl;
  2601.          HintPos:TPoint;
  2602.          HintMaxWidth:LongInt;
  2603.          HintColor:TColor;
  2604.          HintPenColor:TColor;
  2605.          CursorRect:TRect;
  2606.          CursorPos:TPoint;
  2607.     End;
  2608.  
  2609. {$M+}
  2610.     TMessageEvent=Procedure(Var Msg:TMessage;Var Handled:Boolean) Of Object;
  2611.     TIdleEvent=Procedure(Sender:TObject;Var Done:Boolean) Of Object;
  2612.     TExceptionEvent=Procedure(Sender:TObject;E:Exception) Of Object;
  2613.     THelpEvent=Procedure(context:THelpContext;Var Result:Boolean) Of Object;
  2614.     TShowHintEvent=Procedure(Var HintStr:String;Var CanShow:Boolean;Var HintInfo:THintInfo) Of object;
  2615. {$M-}
  2616.  
  2617. {$M+}
  2618.     THintOrigin=(hiTop,hiBottom);
  2619. {$M-}
  2620.  
  2621.     THintWindow=Class(TControl)
  2622.       Protected
  2623.          Procedure SetupComponent;Override;
  2624.          {$IFDEF WIN32}
  2625.          Procedure GetClassData(Var ClassData:TClassData);Override;
  2626.          Procedure CreateParams(Var Params:TCreateParams);Override;
  2627.          Procedure CreateWnd;Override;
  2628.          {$ENDIF}
  2629.       Public
  2630.          Procedure Redraw(Const rec:TRect);Override;
  2631.          Procedure ActivateHint(Rect:TRect; Const AHint:String);Virtual;
  2632.          Procedure DeactivateHint;Virtual;
  2633.          Property Caption;
  2634.          Property Color;
  2635.          Property PenColor;
  2636.     End;
  2637.  
  2638.     THintWindowClass=Class Of THintWindow;
  2639.  
  2640.  
  2641. Const
  2642.     HintWindowClass:THintWindowClass=THintWindow;
  2643.  
  2644. Type
  2645.     {$HINTS OFF}
  2646.     TApplication=Class(TComponent)
  2647.       Private
  2648.          FMainForm:TForm;
  2649.          FShowMainForm:Boolean;
  2650.          FIcon:TGraphic;
  2651.          FHelpFile:PString;
  2652.          FHelpWindowTitle:PString;
  2653.          FHelpWindow:HWindow;
  2654.          FHintTimer:TTimer;
  2655.          FHintControl:TControl;
  2656.          FHintParent:TControl;
  2657.          FHintOwner:TControl;
  2658.          FHintWindow:THintWindow;
  2659.          FHint:String;
  2660.          FShowHint:Boolean;
  2661.          FHintPause:LongInt;
  2662.          FHintPenColor:TColor;
  2663.          FHintColor:TColor;
  2664.          FHintOrigin:THintOrigin;
  2665.          FMenuItemList:TList;
  2666.          FFont:TFont;
  2667.          FPlatform:TPlatform;
  2668.          FDBCSSystem:Boolean;
  2669.          FHasFocus:Boolean;
  2670.          FTerminate:Boolean;
  2671.          ExceptObject:Exception;
  2672.          FKeysHelpContext:THelpContext;
  2673.          FOnHint:TNotifyEvent;
  2674.          FOnIdle:TIdleEvent;
  2675.          FOnMessage:TMessageEvent;
  2676.          FOnMsgEvent:TMessageEvent;
  2677.          FOnException:TExceptionEvent;
  2678.          FOnHelp:THelpEvent;
  2679.          FOnShowHint:TShowHintEvent;
  2680.       Private
  2681.          Function GetHelpFile:String;
  2682.          Procedure SetHelpFile(NewName:String);
  2683.          Function GetHelpWindowTitle:String;
  2684.          Procedure SetHelpWindowTitle(NewTitle:String);
  2685.          Procedure SetHint(Const NewText:String);
  2686.          Procedure HintTimerExpired;
  2687.          Procedure DestroyHintWindow;
  2688.          Function NewMenuItem(entry:TMenuItem):TCommand;
  2689.          Procedure DeleteMenuItem(entry:TMenuItem);
  2690.          Function GetMenuItem(Command:TCommand):TMenuItem;
  2691.          Procedure SetFont(NewFont:TFont);
  2692.          Function ProcessMessage:Boolean;
  2693.          Procedure Idle;
  2694.          Function GetIcon:TGraphic;
  2695.          Procedure SetIcon(NewIcon:TGraphic);
  2696.          Function GetLanguage:String;
  2697.          Procedure SetLanguage(Const NewLanguage:String);
  2698.          Function GetExeName:String;
  2699.       Protected
  2700.          Procedure SetupComponent;Override;
  2701.       Public
  2702.          Constructor Create;Virtual;
  2703.          Destructor Destroy;Override;
  2704.          Procedure CreateForm(InstanceClass:TFormClass;Var Reference:TForm);
  2705.          Procedure Run;
  2706.          Procedure RunFailed;Virtual;
  2707.          Procedure ProcessMessages;
  2708.          Procedure HandleMessage;
  2709.          Procedure Terminate;
  2710.          Procedure HandleException(Sender:TObject);
  2711.          Procedure ShowException(E:Exception);
  2712.          Procedure HelpIndex;
  2713.          Procedure HelpOnHelp;
  2714.          Procedure HelpContents;
  2715.          Procedure KeysHelp;
  2716.          Function HelpJump(Const JumpId:String):Boolean;
  2717.          Function HelpContext(context:THelpContext):Boolean;
  2718.          Function Help(context:THelpContext):Boolean;Virtual;
  2719.       Public
  2720.          Property Language:String Read GetLanguage Write SetLanguage;
  2721.          Property MainForm:TForm Read FMainForm;
  2722.          Property HelpFile:String Read GetHelpFile Write SetHelpFile;
  2723.          Property HelpWindowTitle:String Read GetHelpWindowTitle Write SetHelpWindowTitle;
  2724.          Property HelpWindow:HWindow Read FHelpWindow;
  2725.          Property Platform:TPlatform Read FPlatform;
  2726.          Property DBCSSystem:Boolean Read FDBCSSystem;
  2727.          Property Terminated:Boolean Read FTerminate;
  2728.          Property HasFocus:Boolean Read FHasFocus;
  2729.          Property ExeName:String Read GetExeName;
  2730.          Property Hint:String Read FHint Write SetHint;
  2731.          Property ShowHint:Boolean Read FShowHint Write FShowHint;
  2732.          Property ShowMainForm:Boolean Read FShowMainForm Write FShowMainForm;
  2733.          Property HintPause:LongInt Read FHintPause Write FHintPause;
  2734.          Property HintPenColor:TColor Read FHintPenColor Write FHintPenColor;
  2735.          Property HintColor:TColor Read FHintColor Write FHintColor;
  2736.          Property HintOrigin:THintOrigin Read FHintOrigin Write FHintOrigin;
  2737.          Property Font:TFont Read FFont Write SetFont;
  2738.          Property Icon:TGraphic Read GetIcon Write SetIcon;
  2739.          Property KeysHelpContext:THelpContext read FKeysHelpContext write FKeysHelpContext;
  2740.          Property OnHint:TNotifyEvent Read FOnHint Write FOnHint;
  2741.          Property OnIdle:TIdleEvent Read FOnIdle Write FOnIdle;
  2742.          Property OnMessage:TMessageEvent Read FOnMessage Write FOnMessage;
  2743.          Property OnMsgEvent:TMessageEvent read FOnMsgEvent Write FOnMsgEvent;
  2744.          Property OnException:TExceptionEvent Read FOnException Write FOnException;
  2745.          Property OnHelp:THelpEvent Read FOnHelp Write FOnHelp;
  2746.          Property OnShowHint:TShowHintEvent Read FOnShowHint Write FOnShowHint;
  2747.     End;
  2748.     {$HINTS ON}
  2749.  
  2750. Type
  2751.     TCompLibData=Record
  2752.          NewHeapOrg,NewHeapEnd,NewHeapPtr:Pointer;
  2753.          NewHeapSize:LongWord;
  2754.          NewLastHeapPage,NewLastHeapPageAdr:Pointer;
  2755.          NewHeapMutex:LongWord;
  2756.          InsideWriteSCUAdr:Pointer;
  2757.          Screen:TScreen;
  2758.          Application:TApplication;
  2759.          Clipboard:TClipBoard;
  2760.          ToolsAPI:TObject;
  2761.          ToolsAPIRequired:Boolean;
  2762.          NullStr:PString;
  2763.     End;
  2764.  
  2765.  
  2766. Function Point(X,Y:LongInt):TPoint;
  2767. Function Rect(Left,Bottom,Right,Top:LongInt):TRect;
  2768. Function PointInRect(pt:TPoint; rec:TRect):Boolean;
  2769. Function RectInRect(Const childrec,parentrec:TRect):Boolean;
  2770. Procedure InflateRect(Var rec:TRect; X,Y:LongInt);
  2771. Procedure OffsetRect(Var rec:TRect; X,Y:LongInt);
  2772. Function IntersectRect(Const rec1,rec2:TRect):TRect;
  2773. Function UnionRect(Const rec1,rec2:TRect):TRect;
  2774. Function IsRectEmpty(Const rec:TRect):Boolean;
  2775.  
  2776. Function SendMsg(ahwnd:HWindow;Msg:ULONG;mp1,mp2:LONG):LONG;
  2777. Function PostMsg(ahwnd:HWindow;Msg:ULONG;mp1,mp2:LONG):BOOL;
  2778. Function HandleToControl(ahwnd:HWindow):TControl;
  2779. Function OppositeRGB(color:TColor):TColor;
  2780. Function ValuesToRGB(Red,Green,Blue:Byte):TColor;
  2781. Function RGBToValues(color:TColor;Var Red,Green,Blue:Byte):TColor;
  2782. Function SysColorToRGB(color:TColor):TColor;
  2783. Function WinColorToRGB(color:TColor):TColor;
  2784. Function RGBToWinColor(color:TColor):TColor;
  2785. Function GetShortHint(Const Hint:String):String;
  2786. Function GetLongHint(Const Hint:String):String;
  2787. Function IsControlLocked(Control:TControl):Boolean;
  2788. Function GetParentForm(Control:TControl):TForm;
  2789.  
  2790. Function ReadSCUFont(Var Data;DataLen:LongInt):TFont;
  2791.  
  2792. Procedure DrawSystemBorder(Control:TControl;Var rec:TRect;Style:TBorderStyle);
  2793. Procedure DrawSystemFrame(Control:TControl;Var rec:TRect;LightColor,DarkColor:TCoLor);
  2794.  
  2795.  
  2796. Procedure TransformPointToOS2(Var pt:TPoint;Control:TControl;Graphic:TGraphic);
  2797. Procedure TransformRectToOS2(Var rec:TRect;Control:TControl;Graphic:TGraphic);
  2798. Procedure TransformPointToWin32(Var pt:TPoint;Control:TControl;Graphic:TGraphic);
  2799. Procedure TransformRectToWin32(Var rec:TRect;Control:TControl;Graphic:TGraphic);
  2800. Procedure TransformClientPoint(Var pt:TPoint;Control:TControl;Graphic:TGraphic);
  2801. Procedure TransformClientRect(Var rec:TRect;Control:TControl;Graphic:TGraphic);
  2802. Procedure MapDialogPoints(SourceWindow:HWindow;Var ptl:TPoint);
  2803. Procedure RectToWin32Rect(Var rec:TRect);
  2804. Procedure Win32RectToRect(Var rec:TRect);
  2805. Function ptInRect(Const rc:TRect;Const pt:TPoint):Boolean;
  2806.  
  2807.  
  2808. {$IFDEF OS2}
  2809. Function IsDBCSFirstByte(CH:Char):Boolean;
  2810. {$ENDIF}
  2811.  
  2812. Var
  2813.    Screen:TScreen;
  2814.    Clipboard:TClipBoard;
  2815.    Application:TApplication;
  2816.  
  2817. Const
  2818.    {$IFDEF OS2}
  2819.    MnemoChar:Char='~';
  2820.    {$ENDIF}
  2821.    {$IFDEF Win32}
  2822.    MnemoChar:Char='&';
  2823.    {$ENDIF}
  2824.  
  2825. Function ReplaceMnemo(Const MnemoString:String):String;
  2826.  
  2827. Const
  2828.    RegisterToolsAPIProc:Procedure(ToolServ:TObject)=Nil;
  2829.  
  2830. {internal}
  2831. Procedure SetupCompLib(Var Data:TCompLibData);
  2832. Procedure RegisterAutomaticForm(FormClass:TFormClass;address:Pointer);
  2833. Procedure SetControlHandle(Control:TControl;Handle:HWND);
  2834. Procedure SetDefWndProc(Control:TControl;Proc:Pointer);
  2835. {$IFDEF OS2}
  2836. Function SubclassedWndProc(Win:HWND;Msg,para1,para2:ULONG):ULONG;CDECL;
  2837. {$ENDIF}
  2838. {$IFDEF Win32}
  2839. Function SubclassedWndProc(Win:HWND;Msg,para1,para2:ULONG):ULONG;APIENTRY;
  2840. {$ENDIF}
  2841.  
  2842. {$IFDEF OS2}
  2843. //operator overloads for TMatrix
  2844. Function MulMatrix(Const a,b:TMatrix):TMatrix; operator *;
  2845. Function AddMatrix(Const a,b:TMatrix):TMatrix; operator +;
  2846. Function SubMatrix(Const a,b:TMatrix):TMatrix; operator -;
  2847. Function MulMatrixInt1(Const a:TMatrix;b:LongInt):TMatrix; operator *;
  2848. Function MulMatrixExt1(Const a:TMatrix;Const b:Extended):TMatrix; operator *;
  2849. Function MulMatrixInt2(b:LongInt;Const a:TMatrix):TMatrix; operator *;
  2850. Function MulMatrixExt2(Const b:Extended;Const a:TMatrix):TMatrix; operator *;
  2851. {$ENDIF}
  2852.  
  2853. Var
  2854.   NewStyleControls: Boolean;
  2855.  
  2856. Implementation
  2857.  
  2858. {$R Cursors}
  2859.  
  2860. {$IFDEF OS2}
  2861. Function MulMatrix(Const a,b:TMatrix):TMatrix; //operator *;
  2862. Begin
  2863.      Result.CreateIntern;
  2864.      Result.M11:=a.M11*b.M11+a.M12*b.M21+a.M13*b.M31;
  2865.      Result.M21:=a.M21*b.M11+a.M22*b.M21+a.M23*b.M31;
  2866.      Result.M31:=Round(a.M31*b.M11+a.M32*b.M21+a.M33*b.M31);
  2867.  
  2868.      Result.M12:=a.M11*b.M12+a.M12*b.M22+a.M13*b.M32;
  2869.      Result.M22:=a.M21*b.M12+a.M22*b.M22+a.M23*b.M32;
  2870.      Result.M32:=Round(a.M31*b.M12+a.M32*b.M22+a.M33*b.M32);
  2871.  
  2872.      Result.M13:=Round(a.M11*b.M13+a.M12*b.M23+a.M13*b.M33);
  2873.      Result.M23:=Round(a.M21*b.M13+a.M22*b.M23+a.M23*b.M33);
  2874.      Result.M33:=Round(a.M31*b.M13+a.M32*b.M23+a.M33*b.M33);
  2875. End;
  2876.  
  2877. Function AddMatrix(Const a,b:TMatrix):TMatrix; //operator +;
  2878. Begin
  2879.      Result.CreateIntern;
  2880.      Result.M11:=a.M11+b.M11;
  2881.      Result.M12:=a.M12+b.M12;
  2882.      Result.M13:=a.M13+b.M13;
  2883.      Result.M21:=a.M21+b.M21;
  2884.      Result.M22:=a.M22+b.M22;
  2885.      Result.M23:=a.M23+b.M23;
  2886.      Result.M31:=a.M31+b.M31;
  2887.      Result.M32:=a.M32+b.M32;
  2888.      Result.M33:=a.M33+b.M33;
  2889. End;
  2890.  
  2891. Function SubMatrix(Const a,b:TMatrix):TMatrix; //operator -;
  2892. Begin
  2893.      Result.CreateIntern;
  2894.      Result.M11:=a.M11-b.M11;
  2895.      Result.M12:=a.M12-b.M12;
  2896.      Result.M13:=a.M13-b.M13;
  2897.      Result.M21:=a.M21-b.M21;
  2898.      Result.M22:=a.M22-b.M22;
  2899.      Result.M23:=a.M23-b.M23;
  2900.      Result.M31:=a.M31-b.M31;
  2901.      Result.M32:=a.M32-b.M32;
  2902.      Result.M33:=a.M33-b.M33;
  2903. End;
  2904.  
  2905. Function MulMatrixInt1(Const a:TMatrix;b:LongInt):TMatrix; //operator *;
  2906. Begin
  2907.      Result:=MulMatrixExt1(a,b);
  2908. End;
  2909.  
  2910. Function MulMatrixExt1(Const a:TMatrix;Const b:Extended):TMatrix; //operator *;
  2911. Begin
  2912.      Result.CreateIntern;
  2913.      Result.M11:=a.M11*b;
  2914.      Result.M12:=a.M12*b;
  2915.      Result.M13:=Round(a.M13*b);
  2916.      Result.M21:=a.M21*b;
  2917.      Result.M22:=a.M22*b;
  2918.      Result.M23:=Round(a.M23*b);
  2919.      Result.M31:=Round(a.M31*b);
  2920.      Result.M32:=Round(a.M32*b);
  2921.      Result.M33:=Round(a.M33*b);
  2922. End;
  2923.  
  2924. Function MulMatrixInt2(b:LongInt;Const a:TMatrix):TMatrix; //operator *;
  2925. Begin
  2926.      Result:=MulMatrixExt1(a,b);
  2927. End;
  2928.  
  2929. Function MulMatrixExt2(Const b:Extended;Const a:TMatrix):TMatrix; //operator *;
  2930. Begin
  2931.      Result:=MulMatrixExt1(a,b);
  2932. End;
  2933. {$ENDIF}
  2934.  
  2935. Function GetTopBottomHeight(Form:TForm):LongInt;
  2936. Var T:LongInt;
  2937.     List:TList;
  2938.     Toolbar:TToolbar;
  2939. Begin
  2940.      Result:=0;
  2941.  
  2942.      List:=Form.FToolBarLists[tbTop];
  2943.      If List<>Nil Then For T:=0 To List.Count-1 Do
  2944.      Begin
  2945.           Toolbar:=TToolbar(List[T]);
  2946.           If Toolbar.FVisible Then Inc(Result,Toolbar.Size);
  2947.      End;
  2948.  
  2949.      List:=Form.FToolBarLists[tbBottom];
  2950.      If List<>Nil Then For T:=0 To List.Count-1 Do
  2951.      Begin
  2952.           Toolbar:=TToolbar(List[T]);
  2953.           If Toolbar.FVisible Then Inc(Result,Toolbar.Size);
  2954.      End;
  2955. End;
  2956.  
  2957. Function GetLeftRightWidth(Form:TForm):LongInt;
  2958. Var T:LongInt;
  2959.     List:TList;
  2960.     Toolbar:TToolbar;
  2961. Begin
  2962.      Result:=0;
  2963.  
  2964.      List:=Form.FToolBarLists[tbLeft];
  2965.      If List<>Nil Then For T:=0 To List.Count-1 Do
  2966.      Begin
  2967.           Toolbar:=TToolbar(List[T]);
  2968.           If Toolbar.FVisible Then Inc(Result,Toolbar.Size);
  2969.      End;
  2970.  
  2971.      List:=Form.FToolBarLists[tbRight];
  2972.      If List<>Nil Then For T:=0 To List.Count-1 Do
  2973.      Begin
  2974.           Toolbar:=TToolbar(List[T]);
  2975.           If Toolbar.FVisible Then Inc(Result,Toolbar.Size);
  2976.      End;
  2977. End;
  2978.  
  2979.  
  2980. Type
  2981.     TFrameControl=Class(TControl)
  2982.       Private
  2983.          FResourceId:LongWord;
  2984.          FResourceModule:LongWord;
  2985.          FChild:TForm;
  2986.          {$IFDEF OS2}
  2987.          Procedure WMActivate(Var Msg:TWMActivate); Message WM_ACTIVATE;
  2988.          Procedure WMFormatFrame(Var Msg:TMessage); Message WM_FORMATFRAME;
  2989.          Procedure WMQueryFrameCtlCount(Var Msg:TMessage); Message WM_QUERYFRAMECTlcOUNt;
  2990.          Procedure WMCalcFrameRect(Var Msg:TMessage); Message WM_CALCFRAMERECT;
  2991.          Procedure WMQueryTrackInfo(Var Msg:TMessage); Message WM_QUERYTRACKINFO;
  2992.          Procedure WMMinMaxFrame(Var Msg:TMessage); Message WM_MINMAXFRAME;
  2993.          {$ENDIF}
  2994.          {$IFDEF Win32}
  2995.          Procedure WMClose(Var Msg:TWMClose); Message WM_CLOSE;
  2996.          Procedure WMChildActivate(Var Msg:TMessage); Message WM_CHILDACTIVATE;
  2997.          Procedure WMInitMenuPopup(Var Msg:TMessage); Message WM_INITMENUPOPUP;
  2998.          Procedure WMMenuSelect(Var Msg:TMessage); Message WM_MENUSELECT;
  2999.          Procedure WMMenuChar(Var Msg:TMessage); Message WM_MENUCHAR;
  3000.          Procedure WMGetMinMaxInfo(Var Msg:TMessage); Message WM_GETMINMAXINFO;
  3001.          Procedure WMSysCommand(Var Msg:TMessage); Message WM_SYSCOMMAND;
  3002.          {$ENDIF}
  3003.          Procedure SetResourceId(NewId:LongWord);
  3004.          Procedure GetClassData(Var ClassData:TClassData);Override;
  3005.          Function GetClientRect:TRect;Override;
  3006.       Protected
  3007.          Procedure SetupComponent;Override;
  3008.          Procedure CreateParams(Var Params:TCreateParams);Override;
  3009.          Procedure CreateWnd;Override;
  3010.       Public
  3011.          Destructor Destroy;Override;
  3012.          Property ResourceId:LongWord Read FResourceId Write SetResourceId; {?}
  3013.          Property Child:TForm Read FChild;
  3014.     End;
  3015.  
  3016. ////////////////////////////////////////////////////////////////////////////
  3017.  
  3018. Const
  3019.      {$IFDEF OS2}
  3020.      widClient = FID_CLIENT;
  3021.      {$ENDIF}
  3022.      {$IFDEF Win32}
  3023.      widClient = 1;
  3024.      {$ENDIF}
  3025.  
  3026.      cmInternalControlBase   = $9000;
  3027.      cmInternalMenuItemBase  = $1000;
  3028.  
  3029.      DBCSStatusLineHeight:LongInt = 0;
  3030.      ExternalDragDropObject:TExternalDragDropObject = Nil;
  3031.  
  3032.  
  3033. Function GetBorderWidth(Form:TForm):LongInt;
  3034. Begin
  3035.      Result := 0;
  3036.      If Form = Nil Then exit;
  3037.      If Not Form.Designed Then
  3038.      Begin
  3039.           Case Form.FBorderStyle Of
  3040.             bsSingle:   Result := Screen.SystemMetrics(smCxBorder);
  3041.             bsSizeable: Result := Screen.SystemMetrics(smCxSizeBorder);
  3042.             bsDialog:   Result := Screen.SystemMetrics(smCxDlgBorder);
  3043.           End;
  3044.      End
  3045.      Else Result := Screen.SystemMetrics(smCxSizeBorder);
  3046. End;
  3047.  
  3048.  
  3049. Function GetBorderHeight(Form:TForm):LongInt;
  3050. Begin
  3051.      Result := 0;
  3052.      If Form = Nil Then exit;
  3053.      If Not Form.Designed Then
  3054.      Begin
  3055.           Case Form.FBorderStyle Of
  3056.             bsSingle:   Result := Screen.SystemMetrics(smCyBorder);
  3057.             bsSizeable: Result := Screen.SystemMetrics(smCySizeBorder);
  3058.             bsDialog:   Result := Screen.SystemMetrics(smCyDlgBorder);
  3059.           End;
  3060.      End
  3061.      Else Result := Screen.SystemMetrics(smCySizeBorder);
  3062. End;
  3063.  
  3064.  
  3065.  
  3066. {$HINTS OFF}
  3067. Procedure TransformPointToOS2(Var pt:TPoint;Control:TControl;Graphic:TGraphic);
  3068. {$IFDEF Win32}
  3069. Var  OwnerHeight:LongInt;
  3070. {$ENDIF}
  3071. Begin
  3072.      {$IFDEF Win32}
  3073.      If Control <> Nil Then
  3074.      Begin
  3075.           OwnerHeight := Control.FHeight;
  3076.           If Control Is TFrameControl Then
  3077.           Begin
  3078.                Dec(OwnerHeight, Screen.SystemMetrics(smCyTitlebar));
  3079.                Dec(OwnerHeight, GetBorderHeight(Control.FForm));
  3080.                Inc(pt.Y, GetBorderWidth(Control.FForm));
  3081. //               Dec(OwnerHeight, GetBorderHeight(Control.FForm));
  3082.           End;
  3083.      End
  3084.      Else If Graphic <> Nil Then OwnerHeight := Graphic.Height
  3085.      Else OwnerHeight := Screen.Height;
  3086.      pt.Y := (OwnerHeight-pt.Y);
  3087.      {$ENDIF}
  3088. End;
  3089.  
  3090.  
  3091. Procedure TransformRectToOS2(Var rec:TRect;Control:TControl;Graphic:TGraphic);
  3092. {$IFDEF Win32}
  3093. Var  OwnerHeight:LongInt;
  3094. {$ENDIF}
  3095. Begin
  3096.      {$IFDEF Win32}
  3097.      If Control <> Nil Then
  3098.      Begin
  3099.           OwnerHeight := Control.FHeight;
  3100.           If Control Is TFrameControl Then
  3101.           Begin
  3102.                Dec(OwnerHeight, Screen.SystemMetrics(smCyTitlebar));
  3103.                Dec(OwnerHeight, GetBorderHeight(Control.FForm));
  3104.                Inc(rec.Left, GetBorderWidth(Control.FForm));
  3105.                Inc(rec.Right, GetBorderWidth(Control.FForm));
  3106.                {???}
  3107.                Dec(OwnerHeight, GetBorderHeight(Control.FForm));
  3108.           End;
  3109.      End
  3110.      Else If Graphic <> Nil Then OwnerHeight := Graphic.Height
  3111.      Else OwnerHeight := Screen.Height;
  3112.      rec.Bottom := (OwnerHeight-rec.Bottom);
  3113.      rec.Top := (OwnerHeight-rec.Top);
  3114.      {$ENDIF}
  3115. End;
  3116.  
  3117.  
  3118. Procedure TransformPointToWin32(Var pt:TPoint;Control:TControl;Graphic:TGraphic);
  3119. Begin
  3120.      {$IFDEF Win32}
  3121.      TransformPointToOS2(pt,Control,Graphic);
  3122.      {$ENDIF}
  3123. End;
  3124.  
  3125. Procedure TransformRectToWin32(Var rec:TRect;Control:TControl;Graphic:TGraphic);
  3126. Begin
  3127.      {$IFDEF Win32}
  3128.      TransformRectToOS2(rec,Control,Graphic);
  3129.      {$ENDIF}
  3130. End;
  3131.  
  3132. Procedure TransformClientPoint(Var pt:TPoint;Control:TControl;Graphic:TGraphic);
  3133. {$IFDEF Win32}
  3134. Var  OwnerHeight:LongInt;
  3135. {$ENDIF}
  3136. Begin
  3137.      {$IFDEF Win32}
  3138.      If Control <> Nil Then OwnerHeight := Control.FHeight
  3139.      Else If Graphic<>Nil Then OwnerHeight:=Graphic.Height
  3140.      Else OwnerHeight := Screen.Height;
  3141.      Dec(OwnerHeight);              {!}
  3142.      pt.Y:=(OwnerHeight-pt.Y);
  3143.      {$ENDIF}
  3144. End;
  3145.  
  3146. Procedure TransformClientRect(Var rec:TRect;Control:TControl;Graphic:TGraphic);
  3147. {$IFDEF Win32}
  3148. Var  OwnerHeight:LongInt;
  3149. {$ENDIF}
  3150. Begin
  3151.      {$IFDEF Win32}
  3152.      If Control <> Nil Then OwnerHeight := Control.FHeight
  3153.      Else If Graphic<>Nil Then OwnerHeight:=Graphic.Height
  3154.      Else OwnerHeight := Screen.Height;
  3155.      Dec(OwnerHeight);              {!}
  3156.      rec.Bottom:=(OwnerHeight-rec.Bottom);
  3157.      rec.Top:=(OwnerHeight-rec.Top);
  3158.      {$ENDIF}
  3159. End;
  3160.  
  3161.  
  3162. Procedure MapDialogPoints(SourceWindow:HWindow;Var ptl:TPoint);
  3163. Begin
  3164.      {$IFDEF OS2}
  3165.      WinMapDlgPoints(SourceWindow,POINTL(ptl),1,False);
  3166.      {$ENDIF}
  3167. End;
  3168.  
  3169. Function ptInRect(Const rc:TRect;Const pt:TPoint):Boolean;
  3170. Begin
  3171.      Result:=((pt.X>=rc.Left)And(pt.X<=rc.Top)And(pt.Y>=rc.Bottom)And(pt.Y<=rc.Top));
  3172. End;
  3173.  
  3174. Procedure RectToWin32Rect(Var rec:TRect);
  3175. {$IFDEF Win32}
  3176. Var  L:LongInt;
  3177. {$ENDIF}
  3178. Begin
  3179.      {$IFDEF Win32}
  3180.      L := rec.Top;
  3181.      rec.Top := rec.Bottom;
  3182.      rec.Bottom := L;
  3183.      {$ENDIF}
  3184. End;
  3185.  
  3186. Procedure Win32RectToRect(Var rec:TRect);
  3187. Begin
  3188.      {$IFDEF Win32}
  3189.      RectToWin32Rect(rec);
  3190.      {$ENDIF}
  3191. End;
  3192. {$HINTS ON}
  3193.  
  3194.  
  3195. Function SendMsg(ahwnd:HWindow;Msg:ULONG;mp1,mp2:LONG):LONG;
  3196. Begin
  3197.      {$IFDEF OS2}
  3198.      Result := WinSendMsg(ahwnd,Msg,mp1,mp2);
  3199.      {$ENDIF}
  3200.      {$IFDEF Win32}
  3201.      Result := SendMessage(ahwnd,Msg,mp1,mp2);
  3202.      {$ENDIF}
  3203. End;
  3204.  
  3205. Function PostMsg(ahwnd:HWindow;Msg:ULONG;mp1,mp2:LONG):BOOL;
  3206. Begin
  3207.      {$IFDEF OS2}
  3208.      Result := WinPostMsg(ahwnd,Msg,mp1,mp2);
  3209.      {$ENDIF}
  3210.      {$IFDEF Win32}
  3211.      Result := PostMessage(ahwnd,Msg,mp1,mp2);
  3212.      {$ENDIF}
  3213. End;
  3214.  
  3215.  
  3216. Function HandleToControl(ahwnd:HWindow):TControl;
  3217. {$IFDEF WIN32}
  3218. Var p:Pointer;
  3219. {$ENDIF}
  3220. Begin
  3221.      Result := Nil;
  3222.      {$IFDEF OS2}
  3223.      If ahwnd <> 0 Then Result := Pointer(WinQueryWindowULong(ahwnd,QWL_USER));
  3224.      {$ENDIF}
  3225.      {$IFDEF Win32}
  3226.      P:=Pointer(GetWindowLong(ahwnd,GWL_WNDPROC));
  3227.      If P<>@SubclassedWndProc Then Exit; //no Sibyl Window
  3228.      If ahwnd <> 0 Then Result := Pointer(GetWindowLong(ahwnd,GWL_USERDATA));
  3229.      {$ENDIF}
  3230. End;
  3231.  
  3232.  
  3233. Function GetParentForm(Control:TControl):TForm;
  3234. Begin
  3235.      Result := TForm(Control);
  3236.      While Result <> Nil Do
  3237.      Begin
  3238.           If Result Is TForm Then Exit;
  3239.           Result := TForm(Result.Parent);
  3240.  
  3241.           If TControl(Result) Is TFrameControl
  3242.           Then Result := TFrameControl(Result).FChild;
  3243.      End;
  3244.      Result := Nil;
  3245. End;
  3246.  
  3247.  
  3248. Procedure ListAdd(Var List:TList; Item:Pointer);
  3249. Begin
  3250.      If List = Nil Then List.Create;
  3251.      If List.IndexOf(Item) < 0 Then List.Add(Item);
  3252. End;
  3253.  
  3254.  
  3255. Procedure ListInsert(Var List:TList; Index:LongInt; Item:Pointer);
  3256. Begin
  3257.      If List = Nil Then List.Create;
  3258.      If List.IndexOf(Item) < 0 Then List.Insert(Index,Item);
  3259. End;
  3260.  
  3261.  
  3262. Procedure ListRemove(Var List:TList; Item:Pointer);
  3263. Begin
  3264.      If List <> Nil Then
  3265.      Begin
  3266.           List.Remove(Item);
  3267.           If List.Count = 0 Then
  3268.           Begin
  3269.                List.Destroy;
  3270.                List := Nil;
  3271.           End;
  3272.      End;
  3273. End;
  3274.  
  3275.  
  3276. Function ListFind(List:TList; Item:Pointer):LongInt;
  3277. Begin
  3278.      Result := -1;
  3279.      If List = Nil Then Exit;
  3280.      Result := List.IndexOf(Item);
  3281. End;
  3282.  
  3283. {$IFDEF OS2}
  3284. {
  3285. ╔═══════════════════════════════════════════════════════════════════════════╗
  3286. ║                                                                           ║
  3287. ║ Speed-Pascal/2 Version 2.0                                                ║
  3288. ║                                                                           ║
  3289. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  3290. ║                                                                           ║
  3291. ║ This section: TMatrix Class Implementation                                ║
  3292. ║                                                                           ║
  3293. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  3294. ║                                                                           ║
  3295. ╚═══════════════════════════════════════════════════════════════════════════╝
  3296. }
  3297.  
  3298. Function TMatrix.GetM11:Extended;
  3299. Begin
  3300.      Result:=FMatrix.fxM11/65536.0;
  3301. End;
  3302.  
  3303. Procedure TMatrix.SetM11(Const NewValue:Extended);
  3304. Begin
  3305.      FMatrix.fxM11:=Round(65536*NewValue);
  3306. End;
  3307.  
  3308. Function TMatrix.GetM12:Extended;
  3309. Begin
  3310.      Result:=FMatrix.fxM12/65536.0;
  3311. End;
  3312.  
  3313. Procedure TMatrix.SetM12(Const NewValue:Extended);
  3314. Begin
  3315.      FMatrix.fxM12:=Round(65536*NewValue);
  3316. End;
  3317.  
  3318. Function TMatrix.GetM21:Extended;
  3319. Begin
  3320.      Result:=FMatrix.fxM21/65536.0;
  3321. End;
  3322.  
  3323. Procedure TMatrix.SetM21(Const NewValue:Extended);
  3324. Begin
  3325.      FMatrix.fxM21:=Round(65536*NewValue);
  3326. End;
  3327.  
  3328. Function TMatrix.GetM22:Extended;
  3329. Begin
  3330.      Result:=FMatrix.fxM22/65536.0;
  3331. End;
  3332.  
  3333. Procedure TMatrix.SetM22(Const NewValue:Extended);
  3334. Begin
  3335.      FMatrix.fxM22:=Round(65536*NewValue);
  3336. End;
  3337.  
  3338. Constructor TMatrix.Create(Const aM11,aM12:Extended;aM13:LongInt;
  3339.                            Const aM21,aM22:Extended;aM23:LongInt;
  3340.                            Const aM31,aM32,aM33:LongInt);
  3341. Begin
  3342.      M11:=aM11;
  3343.      M12:=aM12;
  3344.      M13:=aM13;
  3345.      M21:=aM21;
  3346.      M22:=aM22;
  3347.      M23:=aM23;
  3348.      M31:=aM31;
  3349.      M32:=aM32;
  3350.      M33:=aM33;
  3351. End;
  3352.  
  3353. Constructor TMatrix.CreateIntern;
  3354. Begin
  3355. End;
  3356.  
  3357. Constructor TMatrix.CreateEmpty;
  3358. Begin
  3359.      M11:=0.0;
  3360.      M12:=0.0;
  3361.      M13:=0;
  3362.      M21:=0.0;
  3363.      M22:=0.0;
  3364.      M23:=0;
  3365.      M31:=0;
  3366.      M32:=0;
  3367.      M33:=0;
  3368. End;
  3369.  
  3370. Constructor TMatrix.CreateDefault;
  3371. Begin
  3372.      M11:=1.0;
  3373.      M12:=0.0;
  3374.      M13:=0;
  3375.      M21:=0.0;
  3376.      M22:=1.0;
  3377.      M23:=0;
  3378.      M31:=0;
  3379.      M32:=0;
  3380.      M33:=0;
  3381. End;
  3382.  
  3383. Constructor TMatrix.CreateLike(m:TMatrix);
  3384. Begin
  3385.      Assign(m);
  3386. End;
  3387.  
  3388. Constructor TMatrix.CreateTranslation(DeltaX,DeltaY:LongInt);
  3389. Begin
  3390.      M11:=1.0;
  3391.      M12:=0.0;
  3392.      M13:=0;
  3393.      M21:=0.0;
  3394.      M22:=1.0;
  3395.      M23:=0;
  3396.      M31:=DeltaX;
  3397.      M32:=DeltaY;
  3398.      M33:=1;
  3399. End;
  3400.  
  3401. Constructor TMatrix.CreateScaling(Const ScalePercentX,ScalePercentY:Extended);
  3402. Begin
  3403.      M11:=ScalePercentX/100;
  3404.      M12:=0.0;
  3405.      M13:=0;
  3406.      M21:=0.0;
  3407.      M22:=ScalePercentY/100;
  3408.      M23:=0;
  3409.      M31:=0;
  3410.      M32:=0;
  3411.      M33:=1;
  3412. End;
  3413.  
  3414. Constructor TMatrix.CreateVertReflection;
  3415. Begin
  3416.      M11:=-1.0;
  3417.      M12:=0.0;
  3418.      M13:=0;
  3419.      M21:=0.0;
  3420.      M22:=1.0;
  3421.      M23:=0;
  3422.      M31:=0;
  3423.      M32:=0;
  3424.      M33:=1;
  3425. End;
  3426.  
  3427. Constructor TMatrix.CreateHorzReflection;
  3428. Begin
  3429.      M11:=1.0;
  3430.      M12:=0.0;
  3431.      M13:=0;
  3432.      M21:=0.0;
  3433.      M22:=-1.0;
  3434.      M23:=0;
  3435.      M31:=0;
  3436.      M32:=0;
  3437.      M33:=1;
  3438. End;
  3439.  
  3440. Constructor TMatrix.CreateYShear(Const Shear:Extended);
  3441. Begin
  3442.      M11:=1.0;
  3443.      M12:=Shear;
  3444.      M13:=0;
  3445.      M21:=0.0;
  3446.      M22:=1.0;
  3447.      M23:=0;
  3448.      M31:=0;
  3449.      M32:=0;
  3450.      M33:=1;
  3451. End;
  3452.  
  3453. Constructor TMatrix.CreateXShear(Const Shear:Extended);
  3454. Begin
  3455.      M11:=1.0;
  3456.      M12:=0.0;
  3457.      M13:=0;
  3458.      M21:=Shear;
  3459.      M22:=1.0;
  3460.      M23:=0;
  3461.      M31:=0;
  3462.      M32:=0;
  3463.      M33:=1;
  3464. End;
  3465.  
  3466. Constructor TMatrix.CreateRotation(Const Degree:Extended);
  3467. Begin
  3468.      SetTrigMode(Deg);
  3469.      M11:=Cos(Degree);
  3470.      M12:=Sin(Degree);
  3471.      M13:=0;
  3472.      M21:=-Sin(Degree);
  3473.      M22:=Cos(Degree);
  3474.      M23:=0;
  3475.      m31:=0;
  3476.      m32:=0;
  3477.      m33:=1;
  3478. End;
  3479.  
  3480. Destructor TMatrix.Destroy;
  3481. Begin
  3482. End;
  3483.  
  3484. Procedure TMatrix.Assign(m:TMatrix);
  3485. Begin
  3486.      FMatrix:=m.FMatrix;
  3487. End;
  3488.  
  3489. Procedure TMatrix.TransformPoint(Var pt:TPoint);
  3490. Var Result:TPoint;
  3491. Begin
  3492.      Result.X:=Round(M11*pt.X+M21*pt.Y+M31);
  3493.      Result.Y:=Round(M12*pt.X+M22*pt.Y+M32);
  3494.      pt:=Result;
  3495. End;
  3496. {$ENDIF}
  3497.  
  3498. {
  3499. ╔═══════════════════════════════════════════════════════════════════════════╗
  3500. ║                                                                           ║
  3501. ║ Speed-Pascal/2 Version 2.0                                                ║
  3502. ║                                                                           ║
  3503. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  3504. ║                                                                           ║
  3505. ║ This section: TLastMsg Class Implementation                               ║
  3506. ║                                                                           ║
  3507. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  3508. ║                                                                           ║
  3509. ╚═══════════════════════════════════════════════════════════════════════════╝
  3510. }
  3511.  
  3512. Function GetLastMsgAdr(Control:TControl):PMessage;
  3513. Begin
  3514.      Result:=Control.FLastMsgAdr;
  3515. End;
  3516.  
  3517. Function TLastMsg.GetHandled:LongBool;
  3518. Begin
  3519.      If FControl.FLastMsgAdr <> Nil Then Result := FControl.FLastMsgAdr^.Handled
  3520.      Else Result := False;
  3521. End;
  3522.  
  3523. Procedure TLastMsg.SetHandled(Value:LongBool);
  3524. Begin
  3525.      If FControl.FLastMsgAdr <> Nil Then FControl.FLastMsgAdr^.Handled := Value;
  3526. End;
  3527.  
  3528. Function TLastMsg.GetResult:LongWord;
  3529. Begin
  3530.      If FControl.FLastMsgAdr <> Nil Then Result := FControl.FLastMsgAdr^.Result
  3531.      Else Result := 0;
  3532. End;
  3533.  
  3534. Procedure TLastMsg.SetResult(Value:LongWord);
  3535. Begin
  3536.      If FControl.FLastMsgAdr <> Nil Then FControl.FLastMsgAdr^.Result := Value;
  3537. End;
  3538.  
  3539. Procedure TLastMsg.CallDefaultHandler;
  3540. Begin
  3541.      If FControl.FLastMsgAdr <> Nil
  3542.      Then FControl.DefaultHandler(FControl.FLastMsgAdr^);
  3543. End;
  3544.  
  3545. {
  3546. ╔═══════════════════════════════════════════════════════════════════════════╗
  3547. ║                                                                           ║
  3548. ║ Speed-Pascal/2 Version 2.0                                                ║
  3549. ║                                                                           ║
  3550. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  3551. ║                                                                           ║
  3552. ║ This section: TClipBoard Class Implementation                             ║
  3553. ║                                                                           ║
  3554. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  3555. ║                                                                           ║
  3556. ╚═══════════════════════════════════════════════════════════════════════════╝
  3557. }
  3558.  
  3559. Function TClipBoard.GetOwner:HWindow;
  3560. Begin
  3561.      {$IFDEF OS2}
  3562.      Result := WinQueryClipbrdOwner(AppHandle);
  3563.      {$ENDIF}
  3564.      {$IFDEF Win32}
  3565.      Result := GetClipboardOwner;
  3566.      {$ENDIF}
  3567. End;
  3568.  
  3569. Function TClipBoard.GetViewer:HWindow;
  3570. Begin
  3571.      {$IFDEF OS2}
  3572.      Result := WinQueryClipbrdViewer(AppHandle);
  3573.      {$ENDIF}
  3574.      {$IFDEF Win32}
  3575.      Result := GetClipboardViewer;
  3576.      {$ENDIF}
  3577. End;
  3578.  
  3579. Procedure TClipBoard.SetViewer(Viewer:HWindow);
  3580. Begin
  3581.      {$IFDEF OS2}
  3582.      WinSetClipbrdViewer(AppHandle,Viewer);
  3583.      {$ENDIF}
  3584.      {$IFDEF Win32}
  3585.      SetClipboardViewer(Viewer);
  3586.      {$ENDIF}
  3587. End;
  3588.  
  3589.  
  3590. Function TClipBoard.Open(ahwnd:HWindow):Boolean;
  3591. Begin
  3592.      FOpenWin := ahwnd;
  3593.      {$IFDEF OS2}
  3594.      Result := WinOpenClipbrd(AppHandle);
  3595.      {$ENDIF}
  3596.      {$IFDEF Win32}
  3597.      Result := OpenClipboard(FOpenWin);
  3598.      {$ENDIF}
  3599. End;
  3600.  
  3601.  
  3602. Function TClipBoard.Close:Boolean;
  3603. Begin
  3604.      {$IFDEF OS2}
  3605.      Result := WinCloseClipbrd(AppHandle);
  3606.      {$ENDIF}
  3607.      {$IFDEF Win32}
  3608.      Result := CloseClipboard;
  3609.      {$ENDIF}
  3610. End;
  3611.  
  3612.  
  3613. Function TClipBoard.Empty:Boolean;
  3614. Begin
  3615.      {$IFDEF OS2}
  3616.      Result := WinEmptyClipbrd(AppHandle);
  3617.      If FOpenWin<>0 Then WinSetClipbrdOwner(AppHandle,FOpenWin);
  3618.      {$ENDIF}
  3619.      {$IFDEF Win32}
  3620.      Result := EmptyClipboard;
  3621.      {$ENDIF}
  3622. End;
  3623.  
  3624. Function TClipBoard.GetFormatCount:LongInt;
  3625. Begin
  3626.      Result:=CountFormats;
  3627. End;
  3628.  
  3629. Function TClipBoard.GetFormats(Index:LongInt):LongWord;
  3630. Begin
  3631.      Result:=EnumFormats(Index);
  3632. End;
  3633.  
  3634. Function TClipBoard.GetAsText:AnsiString;
  3635. Var p:PChar;
  3636. Begin
  3637.      p:=Pointer(GetData(cfText));
  3638.      If p=Nil Then Result:=''
  3639.      Else Result:=p^;
  3640. End;
  3641.  
  3642. Procedure TClipBoard.SetAsText(NewValue:AnsiString);
  3643. Begin
  3644.      SetTextBuf(PChar(NewValue));
  3645. End;
  3646.  
  3647. Procedure TClipBoard.SetTextBuf(Buffer:PChar);
  3648. Var Temp:PChar;
  3649. Begin
  3650.      If Buffer=Nil Then Empty
  3651.      Else
  3652.      Begin
  3653.           {$IFDEF OS2}
  3654.           DosAllocSharedMem(Temp,Nil,length(Buffer^)+1,PAG_COMMIT Or PAG_READ Or
  3655.                             PAG_WRITE Or OBJ_TILE Or OBJ_GIVEABLE);
  3656.           {$ENDIF}
  3657.           {$IFDEF WIN32}
  3658.           GetMem(Temp,length(Buffer^)+1);
  3659.           {$ENDIF}
  3660.           System.Move(Buffer^,Temp^,length(Buffer^)+1);
  3661.           SetData(LongWord(Temp),cfText);
  3662.      End;
  3663. End;
  3664.  
  3665. Function TClipBoard.HasFormat(Format:LongWord):Boolean;
  3666. Begin
  3667.      Result:=IsFormatAvailable(Format);
  3668. End;
  3669.  
  3670. Procedure TClipBoard.Clear;
  3671. Begin
  3672.      Empty;
  3673. End;
  3674.  
  3675. Function TClipBoard.SetData(Data,format:LongWord):Boolean;
  3676. {$IFDEF OS2}
  3677. Var  formatinfo:LongWord;
  3678. {$ENDIF}
  3679. Begin
  3680.      {$IFDEF OS2}
  3681.      If format In [cfBitmap,cfMetaFile,cfPalette,cfDspBitmap,cfDspMetaFile]
  3682.      Then formatinfo := CFI_HANDLE
  3683.      Else formatinfo := CFI_POINTER;
  3684.      Result := WinSetClipbrdData(AppHandle,Data,format,formatinfo);
  3685.      {$ENDIF}
  3686.      {$IFDEF Win32}
  3687.      Result := SetClipboardData(format,Data) <> 0;
  3688.      {$ENDIF}
  3689. End;
  3690.  
  3691.  
  3692. Function TClipBoard.GetData(format:LongWord):LongWord;
  3693. Begin
  3694.      {$IFDEF OS2}
  3695.      Result := WinQueryClipbrdData(AppHandle,format);
  3696.      {$ENDIF}
  3697.      {$IFDEF Win32}
  3698.      Result := GetClipboardData(format);
  3699.      {$ENDIF}
  3700. End;
  3701.  
  3702.  
  3703. Function TClipBoard.CountFormats:LongInt;
  3704. {$IFDEF OS2}
  3705. Var  ulNext:LongWord;
  3706. {$ENDIF}
  3707. Begin
  3708.      {$IFDEF OS2}
  3709.      Result := 0;
  3710.      ulNext := WinEnumClipbrdFmts(AppHandle,0);
  3711.      While ulNext <> 0 Do
  3712.      Begin
  3713.           Inc(Result);
  3714.           ulNext := WinEnumClipbrdFmts(AppHandle,ulNext);
  3715.      End;
  3716.      {$ENDIF}
  3717.      {$IFDEF Win32}
  3718.      Result := CountClipboardFormats;
  3719.      {$ENDIF}
  3720. End;
  3721.  
  3722.  
  3723. Function TClipBoard.EnumFormats(FormatIndex:LongWord):LongWord;
  3724. Begin
  3725.      {$IFDEF OS2}
  3726.      Result := WinEnumClipbrdFmts(AppHandle,FormatIndex);
  3727.      {$ENDIF}
  3728.      {$IFDEF Win32}
  3729.      Result := EnumClipboardFormats(FormatIndex);
  3730.      {$ENDIF}
  3731. End;
  3732.  
  3733.  
  3734. Function TClipBoard.IsFormatAvailable(format:LongWord):Boolean;
  3735. {$IFDEF OS2}
  3736. Var  formatinfo:LongWord;
  3737. {$ENDIF}
  3738. Begin
  3739.      {$IFDEF OS2}
  3740.      Result := WinQueryClipbrdFmtInfo(AppHandle,format,formatinfo);
  3741.      {$ENDIF}
  3742.      {$IFDEF Win32}
  3743.      Result := IsClipboardFormatAvailable(format);
  3744.      {$ENDIF}
  3745. End;
  3746.  
  3747.  
  3748. Function TClipBoard.RegisterFormat(Const S:String):LongWord;
  3749. Var  CS:Cstring;
  3750. Begin
  3751.      CS := S;
  3752.      {$IFDEF OS2}
  3753.      Result := WinAddAtom(WinQuerySystemAtomTable,CS);
  3754.      {$ENDIF}
  3755.      {$IFDEF Win32}
  3756.      Result := RegisterClipboardFormat(CS);
  3757.      {$ENDIF}
  3758. End;
  3759.  
  3760.  
  3761. Function TClipBoard.GetFormatName(format:LongWord):String;
  3762. Var  L:LongInt;
  3763.      CS:Cstring;
  3764. Begin
  3765.      {$IFDEF OS2}
  3766.      L := WinQueryAtomName(WinQuerySystemAtomTable,format,CS,SizeOf(CS));
  3767.      {$ENDIF}
  3768.      {$IFDEF Win32}
  3769.      L := GetClipboardFormatName(format,CS,SizeOf(CS));
  3770.      {$ENDIF}
  3771.      If L = 0 Then
  3772.        If IsFormatAvailable(format) Then CS := '#'+tostr(format);
  3773.      Result := CS;
  3774. End;
  3775.  
  3776.  
  3777. {
  3778. ╔═══════════════════════════════════════════════════════════════════════════╗
  3779. ║                                                                           ║
  3780. ║ Speed-Pascal/2 Version 2.0                                                ║
  3781. ║                                                                           ║
  3782. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  3783. ║                                                                           ║
  3784. ║ This section: TTimer Class Implementation                                 ║
  3785. ║                                                                           ║
  3786. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  3787. ║                                                                           ║
  3788. ╚═══════════════════════════════════════════════════════════════════════════╝
  3789. }
  3790.  
  3791. Type PTimerArray=^TTimerArray;
  3792.      TTimerArray=Array[1..4000] Of Boolean;
  3793.  
  3794. Var TimerList:TList;
  3795.     TimerArray:PTimerArray;
  3796.     TimerMutex:LongWord;
  3797.     TimerWindow:HWindow;
  3798.  
  3799.  
  3800. Procedure TTimer.SetupComponent;
  3801. Var  Id:LongInt;
  3802. Begin
  3803.      Inherited SetupComponent;
  3804.  
  3805.      {$IFDEF OS2}
  3806.      DosRequestMutexSem(TimerMutex,-1);
  3807.      {$ENDIF}
  3808.      {$IFDEF Win32}
  3809.      WaitForSingleObject(TimerMutex,$FFFFFFFF);
  3810.      {$ENDIF}
  3811.  
  3812.      TimerList.Add(Self);
  3813.      Asm
  3814.         MOV ECX,3999
  3815.         STD
  3816.         MOV EDI,Forms.TimerArray
  3817.         ADD EDI,ECX
  3818.         MOV AL,0
  3819.         REPNE
  3820.         SCASB
  3821.         ADD ECX,2
  3822.         MOV Id,ECX
  3823.      End;
  3824.      If Id=0 Then Raise EProcessTerm.Create(LoadNLSStr(SNoMoreTimers));
  3825.  
  3826.      FId:=Id;
  3827.      TimerArray^[Id]:=True;
  3828.  
  3829.      {$IFDEF Win32}
  3830.      ReleaseMutex(TimerMutex);
  3831.      {$ENDIF}
  3832.      {$IFDEF OS2}
  3833.      DosReleaseMutexSem(TimerMutex);
  3834.      {$ENDIF}
  3835.  
  3836.      FRunning:=False;
  3837.      FInterval:=100;
  3838.      FTime:=0;
  3839.      Name:='Timer';
  3840. End;
  3841.  
  3842.  
  3843. Destructor TTimer.Destroy;
  3844. Begin
  3845.      Stop;
  3846.  
  3847.      {$IFDEF OS2}
  3848.      DosRequestMutexSem(TimerMutex,-1);
  3849.      {$ENDIF}
  3850.      {$IFDEF Win32}
  3851.      WaitForSingleObject(TimerMutex,$FFFFFFFF);
  3852.      {$ENDIF}
  3853.  
  3854.      TimerList.Remove(Self);
  3855.      If TimerArray^[FId]<>True
  3856.      Then Raise EProcessTerm.Create(LoadNLSStr(SCouldNotRemoveTimer)+':'+tostr(FID));
  3857.      TimerArray^[FId]:=False;
  3858.  
  3859.      {$IFDEF Win32}
  3860.      ReleaseMutex(TimerMutex);
  3861.      {$ENDIF}
  3862.      {$IFDEF OS2}
  3863.      DosReleaseMutexSem(TimerMutex);
  3864.      {$ENDIF}
  3865.  
  3866.      Inherited Destroy;
  3867. End;
  3868.  
  3869.  
  3870. Procedure TTimer.Stop;
  3871. Begin
  3872.      If Not FRunning Then Exit;
  3873.  
  3874.      {$IFDEF OS2}
  3875.      WinStopTimer(AppHandle,TimerWindow,FId);
  3876.      {$ENDIF}
  3877.      {$IFDEF Win32}
  3878.      KillTimer(TimerWindow,FId);
  3879.      {$ENDIF}
  3880.  
  3881.      FRunning := False;
  3882. End;
  3883.  
  3884.  
  3885. Procedure TTimer.Start;
  3886. Begin
  3887.      If FRunning Then Exit;
  3888.  
  3889.      FTime := 0;
  3890.  
  3891.      {$IFDEF OS2}
  3892.      WinStartTimer(AppHandle,TimerWindow,FId,FInterval);
  3893.      {$ENDIF}
  3894.      {$IFDEF Win32}
  3895.      SetTimer(TimerWindow,FId,FInterval,Nil);
  3896.      {$ENDIF}
  3897.  
  3898.      FRunning := True;
  3899. End;
  3900.  
  3901.  
  3902. Procedure TTimer.Timer;
  3903. Begin
  3904.      If OnTimer<>Nil Then OnTimer(Self);
  3905. End;
  3906.  
  3907.  
  3908.  
  3909. {
  3910. ╔═══════════════════════════════════════════════════════════════════════════╗
  3911. ║                                                                           ║
  3912. ║ Speed-Pascal/2 Version 2.0                                                ║
  3913. ║                                                                           ║
  3914. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  3915. ║                                                                           ║
  3916. ║ This section: TCaret Class Implementation                                 ║
  3917. ║                                                                           ║
  3918. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  3919. ║                                                                           ║
  3920. ╚═══════════════════════════════════════════════════════════════════════════╝
  3921. }
  3922.  
  3923. Constructor TCaret.Create(Owner:TControl);
  3924. Begin
  3925.      Inherited Create;
  3926.      FControl := Owner;
  3927. End;
  3928.  
  3929.  
  3930. Procedure TCaret.SetPos(Left,Bottom:LongInt);
  3931. {$IFDEF Win32}
  3932. Var pt:WinDef.Point;
  3933. {$ENDIF}
  3934. Begin
  3935.      Hide;
  3936.      {$IFDEF OS2}
  3937.      If FControl.Handle <> 0
  3938.      Then WinCreateCursor(FControl.Handle,Left,Bottom,FWidth,FHeight,
  3939.                           CURSOR_SETPOS Or CURSOR_FLASH,Nil);
  3940.      {$ENDIF}
  3941.      {$IFDEF Win32}
  3942.      pt.X := Left;
  3943.      pt.Y := Bottom;
  3944.      TransformClientPoint(pt,FControl,Nil);
  3945.      Dec(pt.Y,FHeight-1);
  3946.      SetCaretPos(pt.X,pt.Y);
  3947.      {$ENDIF}
  3948.      FLeft := Left;
  3949.      FBottom := Bottom;
  3950.      Show;
  3951. End;
  3952.  
  3953.  
  3954. Procedure TCaret.SetSize(Width,Height:LongInt);
  3955. Begin
  3956.      If FControl.Handle <> 0 Then
  3957.      Begin
  3958.           {$IFDEF OS2}
  3959.           WinCreateCursor(FControl.Handle,FLeft,FBottom,Width,Height,
  3960.                           CURSOR_SOLID Or CURSOR_FLASH,Nil);
  3961.           {$ENDIF}
  3962.           {$IFDEF Win32}
  3963.           CreateCaret(FControl.Handle,0,Width,Height);
  3964.           {$ENDIF}
  3965.      End;
  3966.      FCreated := True;
  3967.      FWidth := Width;
  3968.      FHeight := Height;
  3969. End;
  3970.  
  3971.  
  3972. Procedure TCaret.Show;
  3973. Begin
  3974.      If FControl.Handle = 0 Then Exit;
  3975.      {$IFDEF OS2}
  3976.      WinShowCursor(FControl.Handle,True);
  3977.      {$ENDIF}
  3978.      {$IFDEF Win32}
  3979.      ShowCaret(FControl.Handle);
  3980.      {$ENDIF}
  3981. End;
  3982.  
  3983.  
  3984. Procedure TCaret.Hide;
  3985. Begin
  3986.      If FControl.Handle = 0 Then Exit;
  3987.      {$IFDEF OS2}
  3988.      WinShowCursor(FControl.Handle,False);
  3989.      {$ENDIF}
  3990.      {$IFDEF Win32}
  3991.      HideCaret(FControl.Handle);
  3992.      {$ENDIF}
  3993. End;
  3994.  
  3995.  
  3996. Procedure TCaret.Remove;
  3997. Begin
  3998.      Hide;
  3999.      {$IFDEF OS2}
  4000.      If FCreated Then
  4001.        If FControl.Handle <> 0 Then WinDestroyCursor(FControl.Handle);
  4002.      {$ENDIF}
  4003.      {$IFDEF Win32}
  4004.      If FCreated Then DestroyCaret;
  4005.      {$ENDIF}
  4006.      FCreated := False;
  4007. End;
  4008.  
  4009.  
  4010. Procedure TCaret.SetBlinkTime(ms:LongInt);
  4011. Begin
  4012.      If ms <= 0 Then {restore original BlinkTime}
  4013.      Begin
  4014.           {$IFDEF Win32}
  4015.           If FOldBlinkTime <> 0 Then SetCaretBlinkTime(FOldBlinkTime);
  4016.           FOldBlinkTime := 0;
  4017.           {$ENDIF}
  4018.           Exit;
  4019.      End;
  4020.  
  4021.      FBlinkTime := ms;
  4022.      {$IFDEF OS2}
  4023.      If FControl.Handle <> 0
  4024.      Then WinStartTimer(AppHandle,FControl.Handle,TID_CURSOR,FBlinkTime);
  4025.      {$ENDIF}
  4026.      {$IFDEF Win32}
  4027.      If FOldBlinkTime = 0 Then FOldBlinkTime := GetCaretBlinkTime;
  4028.      SetCaretBlinkTime(FBlinkTime);
  4029.      {$ENDIF}
  4030. End;
  4031.  
  4032.  
  4033. {
  4034. ╔═══════════════════════════════════════════════════════════════════════════╗
  4035. ║                                                                           ║
  4036. ║ Speed-Pascal/2 Version 2.0                                                ║
  4037. ║                                                                           ║
  4038. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  4039. ║                                                                           ║
  4040. ║ This section: TMenuItem Class Implementation                              ║
  4041. ║                                                                           ║
  4042. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  4043. ║                                                                           ║
  4044. ╚═══════════════════════════════════════════════════════════════════════════╝
  4045. }
  4046.  
  4047. Const
  4048.     MenuIDEEditStr     = '..........';
  4049.  
  4050.  
  4051. {$IFDEF OS2}
  4052. Function SubclassedMenuItemWndProc(Win:HWND;Msg,para1,para2:ULONG):ULONG;CDECL;
  4053. Var  Menu:TMenuItem;
  4054.      aMsg:TMessage;
  4055.      Handled:Boolean;
  4056. Begin
  4057.      Menu:=Pointer(WinQueryWindowULong(Win,QWL_USER));  {Get VMT Pointer}
  4058.      If Menu=Nil Then Exit;
  4059.      aMsg.Receiver:=Win;
  4060.      aMsg.ReceiverClass:=Menu;
  4061.      aMsg.Msg:=Msg;
  4062.      aMsg.Param1:=para1;
  4063.      aMsg.Param2:=para2;
  4064.      aMsg.Handled:=False;
  4065.  
  4066.      If ((Application<>Nil)And(Application.FOnMsgEvent<>Nil)) Then
  4067.      Begin
  4068.           Handled:=False;
  4069.           Application.FOnMsgEvent(aMsg,Handled);
  4070.           aMsg.Handled:=aMsg.Handled Or Handled;
  4071.      End;
  4072.  
  4073.      If not aMsg.Handled Then Menu.Dispatch(aMsg);
  4074.      If Not aMsg.Handled
  4075.      Then aMsg.Result:=Menu.FDefWndProc(aMsg.Receiver,aMsg.Msg,
  4076.                                         aMsg.Param1,aMsg.Param2);
  4077.      Result:=aMsg.Result;
  4078. End;
  4079. {$ENDIF}
  4080.  
  4081. {$IFDEF Win32}
  4082. Type
  4083.     PMenuHandleItem=^TMenuHandleItem;
  4084.     TMenuHandleItem=Record
  4085.          FObject:TComponent;
  4086.          FHandle:HWindow;
  4087.     End;
  4088.  
  4089.  
  4090. Procedure NewMenuHandleItem(AOwner:TForm;AHandle:LongWord;AObject:TComponent);
  4091. Var  pmhi:PMenuHandleItem;
  4092.      FOwner:TFrameControl;
  4093. Begin
  4094.      If AHandle = 0 Then Exit;
  4095.      If AObject = Nil Then Exit;
  4096.      FOwner := TFrameControl(AOwner);
  4097.      If FOwner Is TFrameControl Then AOwner := FOwner.Child;
  4098.      If Not (AOwner Is TForm) Then Exit;
  4099.      If AOwner.FMenuHandleList = Nil Then AOwner.FMenuHandleList.Create;
  4100.  
  4101.      GetMem(pmhi, SizeOf(TMenuHandleItem));
  4102.      pmhi^.FObject := AObject;
  4103.      pmhi^.FHandle := AHandle;
  4104.      AOwner.FMenuHandleList.Add(pmhi);
  4105. End;
  4106.  
  4107.  
  4108. Procedure DisposeMenuHandleItem(AOwner:TForm;AHandle:LongWord;AObject:TComponent);
  4109. Var  pmhi:PMenuHandleItem;
  4110.      I:LongInt;
  4111.      FOwner:TFrameControl;
  4112. Begin
  4113.      If AHandle = 0 Then Exit;
  4114.      If AObject = Nil Then Exit;
  4115.      FOwner := TFrameControl(AOwner);
  4116.      If FOwner Is TFrameControl Then AOwner := FOwner.Child;
  4117.      If Not (AOwner Is TForm) Then Exit;
  4118.      If AOwner.FMenuHandleList = Nil Then Exit;
  4119.  
  4120.      For I := AOwner.FMenuHandleList.Count-1 Downto 0 Do
  4121.      Begin
  4122.           pmhi := PMenuHandleItem(AOwner.FMenuHandleList.Items[I]);
  4123.           If (pmhi^.FObject = AObject) And (pmhi^.FHandle = AHandle) Then
  4124.           Begin
  4125.                FreeMem(pmhi, SizeOf(TMenuHandleItem));
  4126.                AOwner.FMenuHandleList.Delete(I);
  4127.           End;
  4128.      End;
  4129.      If AOwner.FMenuHandleList.Count = 0 Then
  4130.      Begin
  4131.           AOwner.FMenuHandleList.Destroy;
  4132.           AOwner.FMenuHandleList := Nil;
  4133.      End;
  4134. End;
  4135.  
  4136.  
  4137. Function GetMenuHandleItem(AOwner:TForm;AHandle:LongWord):TComponent;
  4138. Var  pmhi:PMenuHandleItem;
  4139.      I:LongInt;
  4140.      FOwner:TFrameControl;
  4141. Begin
  4142.      Result := Nil;
  4143.      If AHandle = 0 Then Exit;
  4144.      FOwner := TFrameControl(AOwner);
  4145.      If FOwner Is TFrameControl Then AOwner := FOwner.Child;
  4146.      If Not (AOwner Is TForm) Then Exit;
  4147.      If AOwner.FMenuHandleList = Nil Then Exit;
  4148.  
  4149.      For I := 0 To AOwner.FMenuHandleList.Count-1 Do
  4150.      Begin
  4151.           pmhi := PMenuHandleItem(AOwner.FMenuHandleList.Items[I]);
  4152.           If pmhi^.FHandle = AHandle Then
  4153.           Begin
  4154.                Result := pmhi^.FObject;
  4155.                Exit;
  4156.           End;
  4157.      End;
  4158. End;
  4159.  
  4160.  
  4161. Procedure TMenuItem.RedrawMenuBar;
  4162. Var  Frame:TControl;
  4163. Begin
  4164.      If FMenuOwner <> Nil Then
  4165.      Begin
  4166.           Frame := FMenuOwner;
  4167.           If Not (FMenuOwner Is TFrameControl) Then
  4168.             If FMenuOwner.FFrame <> Nil Then Frame := FMenuOwner.FFrame;
  4169.           DrawMenuBar(Frame.Handle);
  4170.      End;
  4171. End;
  4172. {$ENDIF}
  4173.  
  4174.  
  4175. {$IFDEF OS2}
  4176. Function GetKeyRepeat(Var M:TMessage):Byte;
  4177. Var  Queue:QMSG;
  4178. Begin
  4179.      Result := 1;
  4180.      While WinPeekMsg(AppHandle,Queue,0,WM_CHAR,WM_CHAR,0) Do
  4181.      Begin
  4182.           If (LongWord(Queue.mp1) = M.Param1) And
  4183.              (LongWord(Queue.mp2) = M.Param2) Then
  4184.           Begin
  4185.                WinGetMsg(AppHandle,Queue,0,WM_CHAR,WM_CHAR);
  4186.                Inc(Result);
  4187.           End
  4188.           Else Exit;
  4189.      End;
  4190. End;
  4191.  
  4192.  
  4193. Procedure TMenuItem.WMChar(Var Msg:TWMChar);
  4194. Var fsFlags:Word;
  4195.     REP:Byte;
  4196.     Menu:TMenu;
  4197.     Current:TMenuItem;
  4198.     CH:Char;
  4199.     {$IFDEF OS2}
  4200.     Param:TKeyCode;
  4201.     scan:Byte;
  4202.     ascii:Byte;
  4203.     virtkey:Word;
  4204.     {$ENDIF}
  4205. Label lsc;
  4206. Begin
  4207.      If Not (Self Is TMenuItem) Then Exit;
  4208.  
  4209.      Menu:=FMenu;
  4210.      If Menu=Nil Then Exit;
  4211.  
  4212.      Current:=Menu.GetSelectedMenuItem;
  4213.      If Current=Nil Then Exit;
  4214.  
  4215.      fsFlags := Msg.KeyData;
  4216.      REP := GetKeyRepeat(TMessage(Msg));
  4217.      scan := Msg.ScanCode;
  4218.      ascii := Lo(Msg.CharCode);
  4219.      virtkey := Msg.VirtualKeyCode;
  4220.  
  4221.      If fsFlags And KC_KEYUP <> 0 Then
  4222.      Begin
  4223.           If ((fsFlags And KC_VIRTUALKEY <> 0)And(ascii=32)And(Designed)) Then
  4224.           Begin
  4225.                //Special Handling For whitespace
  4226.                fsFlags := fsFlags Or KC_CHAR;
  4227.           End
  4228.           Else Exit;
  4229.      End;
  4230.  
  4231.      If fsFlags And KC_CHAR <> 0 Then
  4232.      Begin
  4233.           If (ascii < 32) Or  (fsFlags And KC_CTRL <> 0) Then Goto lsc;
  4234.           If (fsFlags And KC_VIRTUALKEY<>0) And (fsFlags And KC_SHIFT<>0)
  4235.           Then Goto lsc; {numerical block}
  4236.           CH := Chr(ascii);
  4237.           Menu.CharEvent(Current,CH,REP);
  4238.  
  4239.           If CH = #0 Then
  4240.           Begin
  4241.                Msg.Handled := True;
  4242.                Msg.Result := 0;
  4243.           End;
  4244.      End
  4245.      Else
  4246.      Begin
  4247. lsc:
  4248.           Param := 0;
  4249.           If fsFlags And KC_VIRTUALKEY <> 0 Then Param := virtkey Or kb_VK
  4250.           Else Param := ascii Or kb_Char;       {E.G. Ctrl-J}
  4251.  
  4252.           If fsFlags And KC_ALT <> 0 Then Param := Param Or kb_Alt;
  4253.           If fsFlags And KC_SHIFT <> 0 Then Param := Param Or kb_Shift;
  4254.           If fsFlags And KC_CTRL <> 0 Then Param := Param Or kb_Ctrl;
  4255.           Menu.ScanEvent(Current,Param,REP);
  4256.  
  4257.           If Param = kbNull Then
  4258.           Begin
  4259.                Msg.Handled := True;
  4260.                Msg.Result := 0;
  4261.           End;
  4262.      End;
  4263. End;
  4264. {$ENDIF}
  4265.  
  4266.  
  4267. Function GetMenuHandle(Item:TMenuItem):LongWord;
  4268. Begin
  4269.      Result := 0;
  4270.      Repeat
  4271.        If Item Is TMenuItem Then
  4272.        Begin
  4273.             If Item.Handle <> 0 Then
  4274.             Begin
  4275.                  Result := Item.Handle;
  4276.                  Exit;
  4277.             End;
  4278.             If Item.FParent = Nil Then   {Item Is root}
  4279.             Begin
  4280.                  Result := Item.FMenu.Handle;
  4281.                  Exit;
  4282.             End;
  4283.             Item := Item.FParent;
  4284.        End;
  4285.      Until Item = Nil;
  4286. End;
  4287.  
  4288.  
  4289. Function ReplaceMnemo(Const MnemoString:String):String;
  4290. Begin
  4291.      Result := MnemoString;
  4292.      {$IFDEF OS2}
  4293.      If Pos('&',Result) > Pos('~',Result) Then Result[Pos('&',Result)] := '~';
  4294.      {$ENDIF}
  4295.      {$IFDEF Win32}
  4296.      If Pos('~',Result) > Pos('&',Result) Then Result[Pos('~',Result)] := '&';
  4297.      {$ENDIF}
  4298. End;
  4299.  
  4300.  
  4301. Procedure InsertMenuEntry(AParent,Item:TMenuItem; Index:LongInt);
  4302. Var  HMen:LongWord;
  4303.      CS:Cstring;
  4304.      Child:TForm;
  4305.      {$IFDEF OS2}
  4306.      mi:MENUITEM;
  4307.      p1,p2:LongWord;
  4308.      {$ENDIF}
  4309.      {$IFDEF Win32}
  4310.      cmd:TCommand;
  4311.      {$ENDIF}
  4312. Begin
  4313.      If AParent = Nil Then Exit;
  4314.      If Item = Nil Then Exit;
  4315.  
  4316.      {AParent ist bereits created}
  4317.      Item.FMenu := AParent.FMenu;
  4318.      If Item.FMenu Is TMenu Then
  4319.      Begin
  4320.           Item.SetDesigning(AParent.Designed);
  4321.           Item.FMenuOwner := TForm(Item.FMenu.Owner);
  4322.      End;
  4323.  
  4324.      HMen := GetMenuHandle(AParent);
  4325.      {$IFDEF OS2}
  4326.      mi.afStyle := Item.GetULongFromStyle;
  4327.      mi.iPosition := Index;
  4328.      mi.afAttribute := Item.GetULongFromFlags;
  4329.      If Item.Handle = 0 Then Item.CreateWnd;
  4330.      mi.hwndSubMenu := Item.Handle;
  4331.      If Item.Glyph <> Nil Then mi.hItem := Item.Glyph.Handle
  4332.      Else mi.hItem := 0;
  4333.      mi.Id := Item.FInternalCommand;
  4334.      If Item.FCaption <> Nil Then CS := ReplaceMnemo(Item.FCaption^)
  4335.      Else CS := '';
  4336.      p1 := LongWord(@mi);
  4337.      p2 := LongWord(@CS);
  4338.      WinSendMsg(HMen,MM_INSERTITEM,p1,p2);
  4339.      {$ENDIF}
  4340.      {$IFDEF Win32}
  4341.      cmd := Item.FInternalCommand;
  4342.      If Item.FCaption <> Nil Then CS := ReplaceMnemo(Item.FCaption^)
  4343.      Else CS := '';
  4344.      If Item.Handle = 0 Then Item.CreateWnd;
  4345.      If Item.Handle <> 0 Then cmd := Item.Handle;
  4346.      InsertMenu(HMen,Index,MF_BYPOSITION Or Item.GetULongFromStyle Or
  4347.                            Item.GetULongFromFlags,cmd,CS);
  4348.      {$ENDIF}
  4349.      Item.FCreated := True;
  4350.  
  4351.      {Assign ShortCut}
  4352.      If Not Item.Designed Then
  4353.        If Item.FShortCut <> kbNull Then
  4354.          If Item.FMenuOwner Is TForm Then
  4355.          Begin
  4356.               Child := TForm(Item.FMenuOwner);
  4357.               Child.AddShortCut(Item.FShortCut, Item.FInternalCommand);
  4358.          End;
  4359. End;
  4360.  
  4361.  
  4362. Procedure TMenuItem.SetGlyph(NewGlyph:TGraphic);
  4363. Var  HMen:LongWord;
  4364.      {$IFDEF OS2}
  4365.      mi:MENUITEM;
  4366.      cmd:TCommand;
  4367.      {$ENDIF}
  4368. Begin
  4369.      If (FParent = Nil) And (FMenu <> Nil) Then Exit;  {the root Item}
  4370.  
  4371.      If NewGlyph<>Nil Then
  4372.      Begin
  4373.           Include(FStyles,misBitmap);
  4374.           Exclude(FStyles,misText);
  4375.      End
  4376.      Else
  4377.      Begin
  4378.           Include(FStyles,misText);
  4379.           Exclude(FStyles,misBitmap);
  4380.      End;
  4381.  
  4382.      If FCreated Then
  4383.      Begin
  4384.           HMen:=GetMenuHandle(Self);
  4385.           {$IFDEF OS2}
  4386.           cmd:=FInternalCommand;
  4387.           WinSendMsg(HMen,MM_QUERYITEM,MPFROM2SHORT(cmd,1),LongWord(@mi));
  4388.           mi.afStyle:=GetULongFromStyle;
  4389.           If NewGlyph<>Nil Then mi.hItem:=NewGlyph.Handle;
  4390.           WinSendMsg(HMen,MM_SETITEM,MPFROM2SHORT(cmd,1),LongWord(@mi));
  4391.           {$ENDIF}
  4392.           {$IFDEF Win32}
  4393.           {...?}
  4394.           {$ENDIF}
  4395.      End;
  4396.  
  4397.      FGlyph:=NewGlyph;
  4398. End;
  4399.  
  4400.  
  4401. Function TMenuItem.GetULongFromStyle:LongWord;
  4402. Begin
  4403.      Result:=0;
  4404.      If (FParent = Nil) And (FMenu <> Nil) Then Exit;  {the root Item}
  4405.  
  4406.      {$IFDEF OS2}
  4407.      If FStyles*[misText]<>[] Then Result:=Result Or MIS_TEXT;
  4408.      If FStyles*[misBitmap]<>[] Then Result:=Result Or MIS_BITMAP;
  4409.      If FStyles*[misOwnerDraw]<>[] Then Result:=Result Or MIS_OWNERDRAW;
  4410.      If FStyles*[misSubmenu]<>[] Then Result:=Result Or MIS_SUBMENU;
  4411.      If Caption='-' Then
  4412.        If Not Designed Then Result:=(Result Or MIS_SEPARATOR) And (Not MIS_TEXT);
  4413.      If FStyles*[misStatic]<>[] Then
  4414.        If Not Designed Then Result:=Result Or MIS_STATIC;
  4415.      If FStyles*[misBreak]<>[] Then Result:=Result Or MIS_BREAK;
  4416.      If FStyles*[misBreakSeparator]<>[] Then Result:=Result Or MIS_BREAKSEPARATOR;
  4417.      If FStyles*[misGroup]<>[] Then Result:=Result Or MIS_GROUP;
  4418.      If FStyles*[misSingle]<>[] Then Result:=Result Or MIS_SINGLE;
  4419.      If FStyles*[misButtonSeparator]<>[] Then Result:=Result Or MIS_BUTTONSEPARATOR;
  4420.      If FStyles*[misMultMenu]<>[] Then Result:=Result Or MIS_MULTMENU;
  4421.      If FStyles*[misSysCommand]<>[] Then Result:=Result Or MIS_SYSCOMMAND;
  4422.      If FStyles*[misHelp]<>[] Then Result:=Result Or MIS_HELP;
  4423.      {$ENDIF}
  4424.      {$IFDEF Win32}
  4425.      If FStyles*[misText]<>[] Then Result:=Result Or MF_STRING;
  4426.      If FStyles*[misBitmap]<>[] Then Result:=Result Or MF_BITMAP;
  4427.      If FStyles*[misOwnerDraw]<>[] Then Result:=Result Or MF_OWNERDRAW;
  4428.      If FStyles*[misSubmenu]<>[] Then Result:=Result Or MF_POPUP;
  4429.      If Caption='-' Then
  4430.        If Not Designed Then Result:=(Result Or MF_SEPARATOR) And (Not MF_STRING);
  4431.      If FStyles*[misStatic]<>[] Then
  4432.        If Not Designed Then Result:=Result Or MF_GRAYED;
  4433.      If FStyles*[misBreak]<>[] Then Result:=Result Or MF_MENUBREAK;
  4434.      If FStyles*[misBreakSeparator]<>[] Then Result:=Result Or MF_MENUBARBREAK;
  4435.     {If FStyles*[misMultMenu]<>[] Then Result:=Result Or MIS_MULTMENU;
  4436.      If FStyles*[misSysCommand]<>[] Then Result:=Result Or MIS_SYSCOMMAND;
  4437.      If FStyles*[misHelp]<>[] Then Result:=Result Or MIS_HELP;
  4438.      If FStyles*[misGroup]<>[] Then Result:=Result Or MIS_GROUP;
  4439.      If FStyles*[misSingle]<>[] Then Result:=Result Or MIS_SINGLE;
  4440.      If FStyles*[misButtonSeparator]<>[] Then Result:=Result Or MF_MENUBARBREAK;}
  4441.      {$ENDIF}
  4442. End;
  4443.  
  4444.  
  4445. {$IFDEF OS2}
  4446. Procedure TMenuItem.WMHelp(Var Msg:TMessage);
  4447. Var  mi:TMenuItem;
  4448.      hctx:THelpContext;
  4449. Begin
  4450.      hctx := HelpContext;
  4451.  
  4452.      mi := FMenu.GetSelectedMenuItem;
  4453.      If mi <> Nil Then
  4454.        If mi.HelpContext <> 0 Then hctx := mi.HelpContext;
  4455.  
  4456.      If hctx <> 0 Then Application.Help(hctx);
  4457.      Msg.Handled := True;
  4458. End;
  4459. {$ENDIF}
  4460.  
  4461.  
  4462. Function TMenuItem.GetULongFromFlags:LongWord;
  4463. Begin
  4464.      Result:=0;
  4465.      If (FParent = Nil) And (FMenu <> Nil) Then Exit;  {the root Item}
  4466.  
  4467.      {$IFDEF OS2}
  4468.      If FFlags*[mifNoDismiss]<>[] Then Result:=Result Or MIA_NODISMISS;
  4469.      If FFlags*[mifFramed]<>[] Then Result:=Result Or MIA_FRAMED;
  4470.      If FFlags*[mifChecked]<>[] Then Result:=Result Or MIA_CHECKED;
  4471.      If FFlags*[mifDisabled]<>[] Then Result:=Result Or MIA_DISABLED;
  4472.      If FFlags*[mifHilited]<>[] Then Result:=Result Or MIA_HILITED;
  4473.      If Designed Then Result:=Result Or MIA_NODISMISS;
  4474.      {$ENDIF}
  4475.      {$IFDEF Win32}
  4476.      {If FFlags*[mifNoDismiss]<>[] Then Result:=Result Or MIA_NODISMISS;}
  4477.      {If FFlags*[mifFramed]<>[] Then Result:=Result Or MIA_FRAMED;}
  4478.      If FFlags*[mifChecked]<>[] Then Result:=Result Or MF_CHECKED;
  4479.      If FFlags*[mifDisabled]<>[] Then Result:=Result Or MF_DISABLED Or MF_GRAYED;
  4480.      {If FFlags*[mifHilited]<>[] Then Result:=Result Or MIA_HILITED;}
  4481.      {If Designed Then Result:=Result Or MIA_NODISMISS;}
  4482.      {$ENDIF}
  4483. End;
  4484.  
  4485.  
  4486. Procedure TMenuItem.SetStyles(NewStyles:TMenuItemStyles);
  4487. Var  HMen:LongWord;
  4488.      CS:Cstring;
  4489.      entry:TMenuItem;
  4490.      T:LongInt;
  4491.      cmd:TCommand;
  4492.      {$IFDEF OS2}
  4493.      mi:MENUITEM;
  4494.      p1,p2:LongWord;
  4495.      {$ENDIF}
  4496.      {$IFDEF Win32}
  4497.      mp:LongInt;
  4498.      NewCaption:String;
  4499.      {$ENDIF}
  4500. Begin
  4501.      If (FParent = Nil) And (FMenu <> Nil) Then Exit;  {the root Item}
  4502.  
  4503.      FStyles:=NewStyles;
  4504.  
  4505.      If FCreated Then
  4506.      Begin
  4507.           HMen:=GetMenuHandle(FParent);
  4508.           cmd:=FInternalCommand;
  4509.           {$IFDEF OS2}
  4510.           WinSendMsg(HMen,MM_QUERYITEM,MPFROM2SHORT(cmd,1),LongWord(@mi));
  4511.           {$ENDIF}
  4512.  
  4513.           If (FStyles*[misSubmenu]<>[]) Xor (FHandle<>0) Then
  4514.           Begin
  4515.                {$IFDEF OS2}
  4516.                WinSendMsg(HMen,MM_DELETEITEM,MPFROM2SHORT(cmd,1),LongWord(@mi));
  4517.                {$ENDIF}
  4518.  
  4519.                {$IFDEF Win32}
  4520.                mp:=GetMenuIndex;
  4521.                DeleteMenu(HMen,mp,MF_BYPOSITION);
  4522.                DisposeMenuHandleItem(TForm(FMenuOwner),FHandle,TComponent(Self));
  4523.                {$ENDIF}
  4524.  
  4525.                If FHandle=0 Then {misSubmenu Set}
  4526.                Begin
  4527.                     {$IFDEF OS2}
  4528.                     HMen := GetMenuHandle(FParent);
  4529.                     FHandle := WinCreateMenu(HMen,Nil);
  4530.                     WinSetWindowULong(FHandle,QWL_USER,LongWord(Self));    {VMT Pointer}
  4531.                     FDefWndProc:=Pointer(WinSubClassWindow(FHandle,@SubclassedMenuItemWndProc));
  4532.                     {$ENDIF}
  4533.  
  4534.                     {$IFDEF Win32}
  4535.                     FHandle:=WinUser.CreateMenu;
  4536.                     NewMenuHandleItem(TForm(FMenuOwner),FHandle,TComponent(Self));
  4537.                     {$ENDIF}
  4538.                End
  4539.                Else              {misSubmenu cleared}
  4540.                Begin
  4541.                     FHandle:=0;
  4542.                     {Clear All Submenu entries}
  4543.                     {Destroy subitems}
  4544.                     If FItems <> Nil Then
  4545.                     Begin
  4546.                          For T := FItems.Count-1 Downto 0
  4547.                             Do TMenuItem(FItems[T]).Destroy;
  4548.                          FItems.Destroy;
  4549.                          FItems := Nil;
  4550.                     End;
  4551.                End;
  4552.  
  4553.                {$IFDEF OS2}
  4554.                mi.afStyle:=GetULongFromStyle;
  4555.                mi.hwndSubMenu:=FHandle;
  4556.                If FCaption<>Nil Then CS:=FCaption^
  4557.                Else CS:='';
  4558.                p1:=LongWord(@mi);
  4559.                p2:=LongWord(@CS);
  4560.                WinSendMsg(HMen,MM_INSERTITEM,p1,p2);
  4561.                {$ENDIF}
  4562.  
  4563.                {$IFDEF Win32}
  4564.                If FHandle<>0 Then cmd:=FHandle;
  4565.                {CS:=ReplaceMnemo(Caption);}
  4566.                NewCaption:=Caption;
  4567.                T:=Pos('\t',NewCaption);
  4568.                If T>0 Then
  4569.                Begin
  4570.                   Delete(NewCaption,T,1);
  4571.                   NewCaption[T]:=#9;
  4572.  
  4573.                   {Test whether Self Is A main entry Of the MainMenu}
  4574.                   If FMenu Is TMainMenu Then
  4575.                     If FMenu.FItems = FParent Then SetLength(NewCaption,T-1);
  4576.                End;
  4577.                CS:=NewCaption;
  4578.                InsertMenu(HMen,mp,MF_BYPOSITION Or GetULongFromStyle Or
  4579.                                   GetULongFromFlags,cmd,CS);
  4580.                RedrawMenuBar;
  4581.                {$ENDIF}
  4582.  
  4583.                If Designed Then
  4584.                  If FHandle<>0 Then
  4585.                    If Not IsEditMenuItem Then
  4586.                Begin
  4587.                     {Insert New Empty Item To edit the New Submenu Items}
  4588.                     entry.Create(FMenu.Owner);
  4589.                     entry.Caption:=MenuIDEEditStr;
  4590.                     Add(entry);
  4591.                End;
  4592.           End
  4593.           Else
  4594.           Begin
  4595.                {$IFDEF OS2}
  4596.                mi.afStyle:=GetULongFromStyle;
  4597.                mi.hwndSubMenu:=FHandle;
  4598.                WinSendMsg(HMen,MM_SETITEM,MPFROM2SHORT(cmd,1),LongWord(@mi));
  4599.                {$ENDIF}
  4600.  
  4601.                {$IFDEF Win32}
  4602.                If FHandle<>0 Then cmd:=FHandle;
  4603.                {CS:=ReplaceMnemo(Caption);}
  4604.                NewCaption:=Caption;
  4605.                T:=Pos('\t',NewCaption);
  4606.                If T>0 Then
  4607.                Begin
  4608.                   Delete(NewCaption,T,1);
  4609.                   NewCaption[T]:=#9;
  4610.  
  4611.                   {Test whether Self Is A main entry Of the MainMenu}
  4612.                   If FMenu Is TMainMenu Then
  4613.                     If FMenu.FItems = FParent Then SetLength(NewCaption,T-1);
  4614.                End;
  4615.                CS:=NewCaption;
  4616.                ModifyMenu(HMen,GetMenuIndex,MF_BYPOSITION Or GetULongFromStyle Or
  4617.                           GetULongFromFlags,cmd,CS);
  4618.                RedrawMenuBar;
  4619.                {$ENDIF}
  4620.           End;
  4621.      End;
  4622. End;
  4623.  
  4624.  
  4625. Procedure TMenuItem.SetFlags(NewFlags:TMenuItemFlags);
  4626. Var  HMen:LongWord;
  4627.      OldFlags:TMenuItemFlags;
  4628.      cmd:TCommand;
  4629.      {$IFDEF Win32}
  4630.      CS:Cstring;
  4631.      NewCaption:String;
  4632.      t:LongInt;
  4633.      {$ENDIF}
  4634. Begin
  4635.      If (FParent = Nil) And (FMenu <> Nil) Then Exit;  {the root Item}
  4636.  
  4637.      OldFlags:=FFlags;
  4638.      FFlags:=NewFlags;
  4639.  
  4640.      If FCreated Then
  4641.      Begin
  4642.           HMen:=GetMenuHandle(Self);
  4643.           cmd:=FInternalCommand;
  4644.           {$IFDEF OS2}
  4645.           If FFlags*[mifNoDismiss]<>OldFlags*[mifNoDismiss] Then
  4646.               WinSendMsg(HMen,MM_SETITEMATTR,MPFROM2SHORT(cmd,1),
  4647.                          MPFROM2SHORT(MIA_NODISMISS,GetULongFromFlags And MIA_NODISMISS));
  4648.           If FFlags*[mifFramed]<>OldFlags*[mifFramed] Then
  4649.               WinSendMsg(HMen,MM_SETITEMATTR,MPFROM2SHORT(cmd,1),
  4650.                          MPFROM2SHORT(MIA_FRAMED,GetULongFromFlags And MIA_FRAMED));
  4651.           If FFlags*[mifChecked]<>OldFlags*[mifChecked] Then
  4652.               WinSendMsg(HMen,MM_SETITEMATTR,MPFROM2SHORT(cmd,1),
  4653.                          MPFROM2SHORT(MIA_CHECKED,GetULongFromFlags And MIA_CHECKED));
  4654.           If FFlags*[mifDisabled]<>OldFlags*[mifDisabled] Then
  4655.               WinSendMsg(HMen,MM_SETITEMATTR,MPFROM2SHORT(cmd,1),
  4656.                          MPFROM2SHORT(MIA_DISABLED,GetULongFromFlags And MIA_DISABLED));
  4657.           If FFlags*[mifHilited]<>OldFlags*[mifHilited] Then
  4658.               WinSendMsg(HMen,MM_SETITEMATTR,MPFROM2SHORT(cmd,1),
  4659.                          MPFROM2SHORT(MIA_HILITED,GetULongFromFlags And MIA_HILITED));
  4660.           {$ENDIF}
  4661.           {$IFDEF Win32}
  4662.           If FHandle<>0 Then cmd:=FHandle;
  4663.           {CS:=ReplaceMnemo(Caption);}
  4664.           NewCaption:=Caption;
  4665.           T:=Pos('\t',NewCaption);
  4666.           If T>0 Then
  4667.           Begin
  4668.              Delete(NewCaption,T,1);
  4669.              NewCaption[T]:=#9;
  4670.  
  4671.              {Test whether Self Is A main entry Of the MainMenu}
  4672.              If FMenu Is TMainMenu Then
  4673.                 If FMenu.FItems = FParent Then SetLength(NewCaption,T-1);
  4674.           End;
  4675.           CS:=NewCaption;
  4676.           ModifyMenu(HMen,GetMenuIndex,MF_BYPOSITION Or GetULongFromStyle Or
  4677.                      GetULongFromFlags,cmd,CS);
  4678.           RedrawMenuBar;
  4679.           {$ENDIF}
  4680.      End;
  4681. End;
  4682.  
  4683.  
  4684. Procedure TMenuItem.CreateWnd;
  4685. Var  T:LongInt;
  4686.      Item:TMenuItem;
  4687.      {$IFDEF OS2}
  4688.      HMen:LongWord;
  4689.      {$ENDIF}
  4690. Begin
  4691.      If FMenu = Nil Then Exit;
  4692.      If FMenu.FItems <> Self Then  {Not the root Item}
  4693.      Begin
  4694.           If Handle<>0 Then Exit;
  4695.           If FInitItems=Nil Then Exit;
  4696.  
  4697.           {$IFDEF OS2}
  4698.           HMen := GetMenuHandle(FParent);
  4699.           FHandle := WinCreateMenu(HMen,Nil);
  4700.           WinSetWindowULong(FHandle,QWL_USER,LongWord(Self));    {VMT Pointer}
  4701.           FDefWndProc:=Pointer(WinSubClassWindow(FHandle,@SubclassedMenuItemWndPRoc));
  4702.           {$ENDIF}
  4703.           {$IFDEF Win32}
  4704.           FHandle:=WinUser.CreateMenu;
  4705.           NewMenuHandleItem(TForm(FMenuOwner),FHandle,TComponent(Self));
  4706.           {$ENDIF}
  4707.      End;
  4708.  
  4709.      If FInitItems<>Nil Then
  4710.      Begin
  4711.           For T:=0 To FInitItems.Count-1 Do
  4712.           Begin
  4713.                Item:=FInitItems.Items[T];
  4714.                InsertMenuEntry(Self,Item,-1);
  4715.           End;
  4716.           FInitItems:=Nil;
  4717.      End;
  4718. End;
  4719.  
  4720.  
  4721. Function TMenuItem.GetCaption:String;
  4722. Var  T:Byte;
  4723.      {$IFDEF WIN32}
  4724.      CS:CString;
  4725.      {$ENDIF}
  4726. Begin
  4727.      Result:='';
  4728.      If (FParent = Nil) And (FMenu <> Nil) Then Exit;  {the root Item}
  4729.  
  4730.      If FCaption<>Nil Then Result:=FCaption^;
  4731.      If Result=MenuIDEEditStr Then Result:='';
  4732.      T:=Pos(#9,Result);
  4733.      If T<>0 Then
  4734.      Begin
  4735.           System.Insert('\',Result,T);
  4736.           Result[T+1]:='t';
  4737.      End;
  4738.  
  4739.      Result := ReplaceMnemo(Result);
  4740. End;
  4741.  
  4742.  
  4743. Procedure TMenuItem.SetCaption(NewCaption:String);
  4744. Var  C:Cstring;
  4745.      HMen:LongWord;
  4746.      Own:TMenuItem;
  4747.      entry:TMenuItem;
  4748.      T:Byte;
  4749.      cmd:TCommand;
  4750.      DNS:TDesignerNotifyStruct;
  4751.      {$IFDEF OS2}
  4752.      mi:MENUITEM;
  4753.      {$ENDIF}
  4754. Begin
  4755.      If (FParent = Nil) And (FMenu <> Nil) Then Exit;  {the root Item}
  4756.  
  4757.      {$IFDEF WIN32}
  4758.      StrOemToAnsi(NewCaption);
  4759.      {$ENDIF}
  4760.  
  4761.      T:=Pos('\t',NewCaption);
  4762.      If T>0 Then
  4763.      Begin
  4764.           Delete(NewCaption,T,1);
  4765.           NewCaption[T]:=#9;
  4766.  
  4767.           {Test whether Self Is A main entry Of the MainMenu}
  4768.           If FMenu Is TMainMenu Then
  4769.             If FMenu.FItems = FParent Then SetLength(NewCaption,T-1);
  4770.      End;
  4771.  
  4772.      If FCaption<>Nil Then
  4773.      Begin
  4774.           If Designed Then
  4775.             If FCreated Then
  4776.               If FParent <> Nil Then
  4777.                 If IsEditMenuItem Then
  4778.                   If NewCaption<>MenuIDEEditStr Then
  4779.                   Begin
  4780.                        If (FParent.FParent = Nil) And
  4781.                           (FMenu Is TMainMenu) Then
  4782.                        Begin
  4783.                             {New main Menu entry}
  4784.                             entry.Create(FMenu.Owner);
  4785.                             entry.Caption:=MenuIDEEditStr;
  4786.                             FMenu.Items.Add(entry);
  4787.  
  4788.                             Own:=Self;
  4789.                        End
  4790.                        Else Own:=FParent;
  4791.  
  4792.                        {New SUB Menu entry}
  4793.                        entry.Create(FMenu.Owner);
  4794.                        entry.Caption:=MenuIDEEditStr;
  4795.                        Own.Add(entry);
  4796.  
  4797.                        If FMenu.Owner Is TForm Then
  4798.                        Begin
  4799.                             {GenNewComponent}
  4800.                             DNS.Sender := Self;
  4801.                             DNS.Code := dncNewMenuItem;
  4802.                             DNS.return := 0;
  4803.                             TForm(FMenu.Owner).DesignerNotification(DNS);
  4804.                        End;
  4805.                   End;
  4806.  
  4807.           DisposeStr(FCaption);
  4808.           FCaption:=Nil;
  4809.      End;
  4810.  
  4811.      If NewCaption <> '' Then AssignStr(FCaption,NewCaption);
  4812.  
  4813.      If FCreated Then
  4814.      Begin
  4815.           HMen:=GetMenuHandle(FParent);
  4816.           cmd:=FInternalCommand;
  4817.  
  4818.           {$IFDEF OS2}
  4819.           C := ReplaceMnemo(NewCaption);
  4820.           If (NewCaption = '-') And Not Designed Then
  4821.           Begin
  4822.                WinSendMsg(HMen,MM_QUERYITEM,MPFROM2SHORT(cmd,1),LongWord(@mi));
  4823.                mi.afStyle:=GetULongFromStyle;
  4824.                WinSendMsg(HMen,MM_SETITEM,MPFROM2SHORT(cmd,1),LongWord(@mi));
  4825.           End
  4826.           Else WinSendMsg(HMen,MM_SETITEMTEXT,cmd,LongWord(@C));
  4827.           {$ENDIF}
  4828.           {$IFDEF Win32}
  4829.           If FHandle<>0 Then cmd:=FHandle;
  4830.           C := ReplaceMnemo(NewCaption);
  4831.           ModifyMenu(HMen,GetMenuIndex,MF_BYPOSITION Or GetULongFromFlags Or
  4832.                      GetULongFromStyle,cmd,C);
  4833.           RedrawMenuBar;
  4834.           {$ENDIF}
  4835.      End;
  4836. End;
  4837.  
  4838. Function IsControl(Control:TControl):Boolean;
  4839. Var RegionSize,Flags:LongWord;
  4840.     p:^Pointer;
  4841.     p1:^Pointer;
  4842. {$IFDEF WIN32}
  4843. Var MemInfo:MEMORY_BASIC_INFORMATION;
  4844. {$ENDIF}
  4845. Begin
  4846.      //check smallest/largest possible address (64KB And 1GB)
  4847.      {$IFDEF OS2}
  4848.      If ((LongWord(Control)<$10000)Or(LongWord(Control)>$40000000)) Then
  4849.      Begin
  4850.           Result:=False;
  4851.           Exit;
  4852.      End;
  4853.  
  4854.      Result:=True;
  4855.  
  4856.      RegionSize:=4;
  4857.      Flags:=0;
  4858.      If DosQueryMem(Pointer(Control),RegionSize,Flags)<>0 Then Result:=False
  4859.      Else If (Flags And PAG_COMMIT)=0 Then Result:=False
  4860.      Else If (Flags And PAG_READ)=0 Then Result:=False
  4861.      Else
  4862.      Begin
  4863.          p1:=Pointer(Control);
  4864.          p:=p1^;
  4865.          RegionSize:=4;
  4866.          Flags:=0;
  4867.          If DosQueryMem(p,RegionSize,Flags)<>0 Then Result:=False
  4868.          Else If (Flags And PAG_COMMIT)=0 Then Result:=False
  4869.          Else If (Flags And PAG_READ)=0 Then Result:=False
  4870.          Else
  4871.          Begin
  4872.               p1 := p;
  4873.               p := p1^;
  4874.               If DosQueryMem(p,RegionSize,Flags)<>0 Then Result:=False
  4875.               Else If (Flags And PAG_EXECUTE)=0 Then Result:=False
  4876.               Else If (Flags And PAG_READ)=0 Then Result:=False
  4877.               Else If not (Control Is TControl) Then Result:=False;
  4878.          End;
  4879.      End;
  4880.      {$ENDIF}
  4881.      {$IFDEF WIN32}
  4882.      If ((LongWord(Control)<$410000)Or(LongWord(Control)>$f0000000)) Then
  4883.      Begin
  4884.           Result:=False;
  4885.           Exit;
  4886.      End;
  4887.  
  4888.      Result:=True;
  4889.  
  4890.      Try
  4891.         If IsBadReadPtr(Pointer(Control),4) Then Result:=False
  4892.         Else
  4893.         Begin
  4894.             p1:=Pointer(Control);
  4895.             p:=p1^;
  4896.             If IsBadReadPtr(p,4) Then Result:=False
  4897.             Else
  4898.             Begin
  4899.                  p1 := p;
  4900.                  p := p1^;
  4901.                  If IsBadReadPtr(p,4) Then Result:=False
  4902.                  Else If IsBadCodePtr(p) Then Result:=False
  4903.                  Else If not (Control Is TControl) Then Result:=False;
  4904.             End;
  4905.         End;
  4906.      Except
  4907.         Result:=False;
  4908.      End;
  4909.      {$ENDIF}
  4910. End;
  4911.  
  4912.  
  4913. Procedure TMenuItem.SetupComponent;
  4914. Begin
  4915.      Inherited SetupComponent;
  4916.  
  4917.      Name:='MenuItem';
  4918.      Caption:=Name;
  4919.      FStyles:=[misText];
  4920.      FFlags:=[];
  4921.      FCommand:=cmNull;
  4922.      If IsControl(TControl(Owner)) Then FMenuOwner:=TControl(Owner);
  4923.  
  4924.      If Application <> Nil Then FInternalCommand := Application.NewMenuItem(Self);
  4925. End;
  4926.  
  4927.  
  4928. Procedure TMenuItem.Add(Item:TMenuItem);
  4929. Begin
  4930.      Insert(-1,Item);
  4931. End;
  4932.  
  4933.  
  4934. Procedure TMenuItem.Insert(Index:LongInt;Item:TMenuItem);
  4935. Begin
  4936.      If Item = Nil Then Exit;
  4937.      Item.FParent := Self;
  4938.  
  4939.      If FItems = Nil Then FItems.Create;
  4940.      If Index > FItems.Count Then Index := FItems.Count;
  4941.      If Index < 0 Then Index := FItems.Add(Item)
  4942.      Else FItems.Insert(Index,Item);
  4943.  
  4944.      styles := styles + [misSubmenu];
  4945.  
  4946.      If FCreated Then InsertMenuEntry(Self,Item,Index)
  4947.      Else FInitItems := FItems;
  4948. End;
  4949.  
  4950.  
  4951. Function AccelToString(kbValue:TKeyCode):String;
  4952. Var  Mask:TKeyCode;
  4953. Begin
  4954.      Result := '';
  4955.      If kbValue And kb_Ctrl <> 0 Then Result := Result + 'Ctrl+';
  4956.      If kbValue And kb_Shift <> 0 Then Result := Result + 'Shift+';
  4957.      If kbValue And kb_Alt <> 0 Then Result := Result + 'Alt+';
  4958.      If kbValue And kb_Char <> 0
  4959.      Then Result := Result + UpCase(Chr(kbValue And 255));
  4960.      If kbValue And kb_VK <> 0 Then
  4961.      Begin
  4962.           Mask := kb_Ctrl Or kb_Shift Or kb_Alt Or kb_Char;
  4963.           Case kbValue And Not Mask Of
  4964.             kbF1:        Result := Result + 'F1';
  4965.             kbF2:        Result := Result + 'F2';
  4966.             kbF3:        Result := Result + 'F3';
  4967.             kbF4:        Result := Result + 'F4';
  4968.             kbF5:        Result := Result + 'F5';
  4969.             kbF6:        Result := Result + 'F6';
  4970.             kbF7:        Result := Result + 'F7';
  4971.             kbF8:        Result := Result + 'F8';
  4972.             kbF9:        Result := Result + 'F9';
  4973.             kbF10:       Result := Result + 'F10';
  4974.             kbF11:       Result := Result + 'F11';
  4975.             kbF12:       Result := Result + 'F12';
  4976.             kbCLeft:     Result := Result + 'Left';
  4977.             kbCRight:    Result := Result + 'Right';
  4978.             kbCUp:       Result := Result + 'Up';
  4979.             kbCDown:     Result := Result + 'Down';
  4980.             kbDel:       Result := Result + 'Del';
  4981.             kbIns:       Result := Result + 'Ins';
  4982.             kbEnd:       Result := Result + 'End';
  4983.             kbHome:      Result := Result + 'Home';
  4984.             kbPageDown:  Result := Result + 'PageDown';
  4985.             kbPageUp:    Result := Result + 'PageUp';
  4986.             kbBkSp:      Result := Result + 'BkSp';
  4987.             kbCR:        Result := Result + 'CR';
  4988.             kbEsc:       Result := Result + 'Esc';
  4989.             {$IFDEF OS2}
  4990.             kbEnter:     Result := Result + 'Enter';
  4991.             {$ENDIF}
  4992.             kbPrintScrn: Result := Result + 'PrintScrn';
  4993.             {$IFDEF OS2}
  4994.             kbBackTab:   Result := Result + 'BackTab';
  4995.             {$ENDIF}
  4996.             kbTab:       Result := Result + 'Tab';
  4997.             kbSpace:     Result := Result + 'Space';
  4998.             kbPause:     Result := Result + 'Pause';
  4999.             kbCapsLock:  Result := Result + 'CapsLock';
  5000.             kbScrollLock:Result := Result + 'ScrollLock';
  5001.             kbNumLock:   Result := Result + 'NumLock';
  5002.           End;
  5003.      End;
  5004.  
  5005.      If Result <> '' Then
  5006.        If Result[Length(Result)] = '+' Then Result := '';
  5007. End;
  5008.  
  5009.  
  5010. Procedure TMenuItem.SetShortCut(NewAccel:TKeyCode);
  5011. Var Child:TForm;
  5012.     OldAccel:LongWord;
  5013.     S:String;
  5014.     acl:String;
  5015.     P:Integer;
  5016. Begin
  5017.      If (FParent = Nil) And (FMenu <> Nil) Then Exit;  {the root Item}
  5018.  
  5019.      {Test whether Self Is A main entry Of the MainMenu}
  5020.      If FMenu Is TMainMenu Then
  5021.        If FMenu.FItems = FParent Then Exit;
  5022.  
  5023.      OldAccel:=FShortCut;
  5024.      FShortCut:=NewAccel;
  5025.      If Not Designed Then
  5026.        If FShortCut<>kbNull Then
  5027.          If FMenuOwner Is TForm Then
  5028.          Begin
  5029.               Child:=TForm(FMenuOwner);
  5030.               If OldAccel<>kbNull Then Child.DeleteShortCut(OldAccel);
  5031.               Child.AddShortCut(FShortCut,FInternalCommand);
  5032.          End;
  5033.  
  5034.      {auto Add ShortCut String}
  5035.      If Designed Then
  5036.      Begin
  5037.           S := Caption;
  5038.           P := Pos('\t',S);
  5039.           If P > 0 Then Delete(S,P,255);
  5040.           If NewAccel <> kbNull Then
  5041.           Begin
  5042.                acl := AccelToString(NewAccel);
  5043.                If acl <> '' Then S := S + '\t' + acl;
  5044.           End;
  5045.           Caption := S;
  5046.      End;
  5047. End;
  5048.  
  5049.  
  5050. Destructor TMenuItem.Destroy;
  5051. Var  HMen:LongWord;
  5052.      Child:TForm;
  5053.      idx,T:LongInt;
  5054.      {$IFDEF OS2}
  5055.      Id:Word;
  5056.      {$ENDIF}
  5057. Begin
  5058.      idx := GetMenuIndex;
  5059.      Try
  5060.         If FParent Is TMenuItem Then FParent.FItems.Remove(Self); {entferne aus Liste}
  5061.      Except
  5062.         //ErrorBox2('Menu item not found in Parent menu (Destroy)');
  5063.      End;
  5064.  
  5065.      HMen := GetMenuHandle(FParent);
  5066.      If HMen <> 0 Then
  5067.        If idx >= 0 Then
  5068.      Begin
  5069.           {$IFDEF OS2}
  5070.           Id := FInternalCommand;
  5071.           If WinSendMsg(HMen,MM_ITEMIDFROMPOSITION,idx,0) = Id
  5072.           Then WinSendMsg(HMen,MM_DELETEITEMBYPOS,idx,0)
  5073.           Else WinSendMsg(HMen,MM_DELETEITEM,MPFROM2SHORT(Id,1),0);
  5074.           {$ENDIF}
  5075.           {$IFDEF Win32}
  5076.           DeleteMenu(HMen,idx,MF_BYPOSITION);
  5077.           DisposeMenuHandleItem(TForm(FMenuOwner),FHandle,TComponent(Self));
  5078.           RedrawMenuBar;
  5079.           {$ENDIF}
  5080.      End;
  5081.  
  5082.      If Not Designed Then
  5083.        If FShortCut <> 0 Then
  5084.          If FMenuOwner Is TForm Then
  5085.      Begin
  5086.           Child := TForm(FMenuOwner);
  5087.           Child.DeleteShortCut(FShortCut);
  5088.           FShortCut := 0;
  5089.      End;
  5090.  
  5091.      If FHandle <> 0 Then
  5092.      Begin
  5093.           {$IFDEF OS2}
  5094.           WinSubClassWindow(FHandle,@FDefWndProc);
  5095.           WinDestroyWindow(FHandle);
  5096.           {$ENDIF}
  5097.           {$IFDEF Win32}
  5098.           DestroyMenu(FHandle);   //war DestroyWindow(FHandle);
  5099.           {$ENDIF}
  5100.           FHandle := 0;
  5101.      End;
  5102.  
  5103.      {Destroy subitems}
  5104.      If FItems <> Nil Then
  5105.      Begin
  5106.           For T := FItems.Count-1 Downto 0 Do TMenuItem(FItems[T]).Destroy;
  5107.           FItems.Destroy;
  5108.           FItems := Nil;
  5109.      End;
  5110.  
  5111.      DisposeStr(FCaption);
  5112.      FCaption := Nil;
  5113.  
  5114.      Application.DeleteMenuItem(Self);
  5115.  
  5116.      Inherited Destroy;
  5117. End;
  5118.  
  5119.  
  5120. Function TMenuItem.IndexOf(Item:TMenuItem):LongInt;
  5121. Begin
  5122.      If FItems <> Nil Then Result := FItems.IndexOf(Item)
  5123.      Else Result := -1;
  5124. End;
  5125.  
  5126.  
  5127. Procedure TMenuItem.LoadedFromSCU(SCUParent:TComponent);
  5128. Begin
  5129.      Inherited LoadedFromSCU(SCUParent);
  5130.  
  5131.      If SCUParent Is TMenuItem Then TMenuItem(SCUParent).Add(Self);
  5132.      If SCUParent Is TMenu Then TMenu(SCUParent).FItems.Add(Self);
  5133. End;
  5134.  
  5135.  
  5136. Procedure TMenuItem.GetChildren(Proc:TGetChildProc);
  5137. Var  T:LongInt;
  5138.      Item:TMenuItem;
  5139. Begin
  5140.      If Count > 0 Then
  5141.      Begin
  5142.           For T := 0 To Count-1 Do
  5143.           Begin
  5144.                Item := Items[T];
  5145.                If Item.Designed Then
  5146.                  If Not Item.IsEditMenuItem Then Proc(Item);
  5147.           End;
  5148.      End;
  5149. End;
  5150.  
  5151.  
  5152. Procedure TMenuItem.SetHint(Const NewText:String);
  5153. Begin
  5154.      DisposeStr(FHint);
  5155.      FHint := Nil;
  5156.      If NewText = '' Then Exit;
  5157.      AssignStr(FHint,NewText);
  5158. End;
  5159.  
  5160.  
  5161. Function TMenuItem.GetHint:String;
  5162. Begin
  5163.      If FHint = Nil Then Result := ''
  5164.      Else Result := FHint^;
  5165. End;
  5166.  
  5167.  
  5168. Function TMenuItem.GetChecked:Boolean;
  5169. Begin
  5170.      Result := Flags * [mifChecked] <> [];
  5171. End;
  5172.  
  5173.  
  5174. Procedure TMenuItem.SetChecked(Value:Boolean);
  5175. Begin
  5176.      If GetChecked = Value Then Exit;
  5177.  
  5178.      If Value Then Flags := Flags + [mifChecked]
  5179.      Else Flags := Flags - [mifChecked];
  5180. End;
  5181.  
  5182.  
  5183. Function TMenuItem.GetEnabled:Boolean;
  5184. Begin
  5185.      Result := Flags * [mifDisabled] = [];
  5186. End;
  5187.  
  5188.  
  5189. Procedure TMenuItem.SetEnabled(Value:Boolean);
  5190. Begin
  5191.      If GetEnabled = Value Then Exit;
  5192.  
  5193.      If Value Then Flags := Flags - [mifDisabled]
  5194.      Else Flags := Flags + [mifDisabled];
  5195. End;
  5196.  
  5197.  
  5198. Function TMenuItem.GetBreak:TMenuBreak;
  5199. Begin
  5200.      If Caption = '-' Then Result := mbSeparator
  5201.      Else If FStyles * [misBreakSeparator] <> [] Then Result := mbBarBreak
  5202.      Else If FStyles * [misBreak] <> [] Then Result := mbBreak
  5203.           Else Result := mbNone;
  5204. End;
  5205.  
  5206.  
  5207. Procedure TMenuItem.SetBreak(Value:TMenuBreak);
  5208. Begin
  5209.      Case Value Of
  5210.        mbNone:
  5211.        Begin
  5212.             Exclude(FStyles,misBreak);
  5213.             Exclude(FStyles,misBreakSeparator);
  5214.             If Caption = '-' Then Caption := '';
  5215.        End;
  5216.        mbBreak:
  5217.        Begin
  5218.             Include(FStyles,misBreak);
  5219.             Exclude(FStyles,misBreakSeparator);
  5220.             If Caption = '-' Then Caption := '';
  5221.        End;
  5222.        mbBarBreak:
  5223.        Begin
  5224.             Exclude(FStyles,misBreak);
  5225.             Include(FStyles,misBreakSeparator);
  5226.             If Caption = '-' Then Caption := '';
  5227.        End;
  5228.        mbSeparator:
  5229.        Begin
  5230.             Exclude(FStyles,misBreak);
  5231.             Exclude(FStyles,misBreakSeparator);
  5232.             Caption := '-';
  5233.        End;
  5234.      End;
  5235.      SetStyles(FStyles); {Update the Menu}
  5236. End;
  5237.  
  5238.  
  5239. Function TMenuItem.GetSubMenu:Boolean;
  5240. Begin
  5241.      Result := styles * [misSubmenu] <> [];
  5242. End;
  5243.  
  5244.  
  5245. Procedure TMenuItem.SetSubMenu(Value:Boolean);
  5246. Begin
  5247.      If GetSubMenu = Value Then Exit;
  5248.  
  5249.      If Value Then styles := styles + [misSubmenu]
  5250.      Else styles := styles + [misSubmenu];
  5251. End;
  5252.  
  5253.  
  5254. Function TMenuItem.GetCount:LongInt;
  5255. Begin
  5256.      If FItems <> Nil Then Result := FItems.Count
  5257.      Else Result := 0;
  5258. End;
  5259.  
  5260.  
  5261. Function TMenuItem.GetItem(Index:LongInt):TMenuItem;
  5262. Begin
  5263.      If FItems <> Nil Then Result := TMenuItem(FItems[Index])
  5264.      Else Result := Nil;
  5265. End;
  5266.  
  5267.  
  5268. Function TMenuItem.GetMenuIndex:LongInt;
  5269. Begin
  5270.      If FParent <> Nil Then Result := FParent.IndexOf(Self)
  5271.      Else Result := -1;
  5272. End;
  5273.  
  5274.  
  5275. Function TMenuItem.GetIsEditMenuItem:Boolean;
  5276. Begin
  5277.      Result := False;
  5278.      If Designed Then
  5279.        If FCaption <> Nil Then
  5280.          If FCaption^ = MenuIDEEditStr Then Result := True;
  5281. End;
  5282.  
  5283.  
  5284. Procedure TMenuItem.Click;
  5285. Begin
  5286.      If FOnClick <> Nil Then FOnClick(Self);
  5287.  
  5288.      If IsControl(FMenuOwner) Then SendMsg(FMenuOwner.Handle,WM_COMMAND,FCommand,0);
  5289. End;
  5290.  
  5291.  
  5292. {
  5293. ╔═══════════════════════════════════════════════════════════════════════════╗
  5294. ║                                                                           ║
  5295. ║ Speed-Pascal/2 Version 2.0                                                ║
  5296. ║                                                                           ║
  5297. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  5298. ║                                                                           ║
  5299. ║ This section: TMenu Class Implementation                                  ║
  5300. ║                                                                           ║
  5301. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  5302. ║                                                                           ║
  5303. ╚═══════════════════════════════════════════════════════════════════════════╝
  5304. }
  5305.  
  5306. {$IFDEF OS2}
  5307. Function SubclassedMenuWndProc(Win:HWND;Msg,para1,para2:ULONG):ULONG;CDECL;
  5308. Var  Menu:TMenu;
  5309.      aMsg:TMessage;
  5310.      Handled:Boolean;
  5311. Begin
  5312.      Menu:=Pointer(WinQueryWindowULong(Win,QWL_USER));  {Get VMT Pointer}
  5313.      If Menu=Nil Then Exit;
  5314.      aMsg.Receiver:=Win;
  5315.      aMsg.ReceiverClass:=Menu;
  5316.      aMsg.Msg:=Msg;
  5317.      aMsg.Param1:=para1;
  5318.      aMsg.Param2:=para2;
  5319.      aMsg.Handled:=False;
  5320.  
  5321.      If ((Application<>Nil)And(Application.FOnMsgEvent<>Nil)) Then
  5322.      Begin
  5323.           Handled:=False;
  5324.           Application.FOnMsgEvent(aMsg,Handled);
  5325.           aMsg.Handled:=aMsg.Handled Or Handled;
  5326.      End;
  5327.  
  5328.      If Not aMsg.Handled Then Menu.Dispatch(aMsg);
  5329.      If Not aMsg.Handled
  5330.      Then aMsg.Result:=Menu.FDefWndProc(aMsg.Receiver,aMsg.Msg,
  5331.                                         aMsg.Param1,aMsg.Param2);
  5332.      Result:=aMsg.Result;
  5333. End;
  5334. {$ENDIF}
  5335.  
  5336.  
  5337. Procedure DereferenceFont(FFont:TFont);
  5338. Begin
  5339.      If FFont<>Nil Then
  5340.      Begin
  5341.           {$IFDEF Win32}
  5342.           If FFont.FHandle<>0 Then
  5343.           Begin
  5344.                If FFont.FRefCount>1 Then Dec(FFont.FRefCount)
  5345.                Else
  5346.                Begin
  5347.                     DeleteObject(FFont.FHandle);
  5348.                     FFont.FHandle:=0;
  5349.                End;
  5350.           End;
  5351.           {$ENDIF}
  5352.           If FFont.FUseCount>0 Then Dec(FFont.FUseCount);
  5353.           If ((FFont.FCustom)And(FFont.AutoDestroy)And(FFont.FUseCount=0)) Then FFont.Destroy;
  5354.      End;
  5355. End;
  5356.  
  5357.  
  5358. Procedure TMenu.SetFont(NewFont:TFont);
  5359. Var  {$IFDEF OS2}
  5360.      S:String;
  5361.      C:Cstring;
  5362.      CS:Cstring;
  5363.      {$ENDIF}
  5364.      {$IFDEF Win32}
  5365.      aFontInfo:LOGFONT;
  5366.      FDefFontHandle:LongWord;
  5367.      {$ENDIF}
  5368. Begin
  5369.      If FFont<>NewFont Then
  5370.      Begin
  5371.           DereferenceFont(FFont);
  5372.           FFont:=NewFont;
  5373.           If FFont<>Nil Then Inc(FFont.FUseCount);
  5374.      End;
  5375.  
  5376.      {$IFDEF Win32}
  5377.      If FFont<>Nil Then
  5378.      Begin
  5379.           If FFont.FHandle<>0 Then
  5380.           Begin
  5381.                If FDefFontHandle<>FFont.FHandle Then
  5382.                Begin
  5383.                     FDefFontHandle:=FFont.FHandle;
  5384.                     Inc(FFont.FRefCount);
  5385.                End;
  5386.           End
  5387.           Else
  5388.           Begin
  5389.                aFontInfo:=FFont.FFontInfo;
  5390.                aFontInfo.lfHeight:=FFont.FFontInfo.lfHeight;
  5391.                aFontInfo.lfWidth:=FFont.FFontInfo.lfWidth;
  5392.                aFontInfo.lfQuality:=DRAFT_QUALITY;
  5393.                aFontInfo.lfItalic:=0;
  5394.                aFontInfo.lfUnderline:=0;
  5395.                aFontInfo.lfStrikeOut:=0;
  5396.                aFontInfo.lfWeight:=FW_NORMAL;
  5397.                FDefFontHandle:=CreateFontIndirect(aFontInfo);
  5398.                FFont.FHandle:=FDefFontHandle;
  5399.                FFont.FRefCount:=1;
  5400.           End;
  5401.      End;
  5402.      {$ENDIF}
  5403.  
  5404.      If Handle <> 0 Then If FFont<>Nil Then
  5405.      Begin
  5406.           {$IFDEF OS2}
  5407.           If FFont.FInternalPointSize<>0 Then
  5408.           Begin
  5409.                S:=tostr(FFont.FInternalPointSize)+'.';
  5410.                C:=FFont.FaceName;
  5411.           End
  5412.           Else
  5413.           Begin
  5414.                S:=tostr((FFont.FFontInfo.sNominalPointSize) Div 10)+'.';
  5415.                C:=FFont.FFontInfo.szFaceName;
  5416.           End;
  5417.  
  5418.           CS:=S+C;
  5419.           WinSetPresParam(Handle,PP_FONTNAMESIZE,Length(CS)+1,CS);
  5420.           {$ENDIF}
  5421.           {$IFDEF Win32}
  5422.           SendMessage(Handle,WM_SETFONT,FDefFontHandle,1);
  5423.           {$ENDIF}
  5424.      End;
  5425. End;
  5426.  
  5427.  
  5428. Procedure TMenu.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  5429. Begin
  5430.      If ResName = rnFont Then
  5431.      Begin
  5432.           If DataLen <> 0 Then
  5433.           Begin
  5434.                Font := ReadSCUFont(Data,DataLen);
  5435.                If ((Font<>Nil)And(Font.FAlternateName<>Nil)) Then
  5436.                Begin
  5437.                    AssignStr(FAlternateFontName,Font.FAlternateName^);
  5438.                    DisposeStr(Font.FAlternateName);
  5439.                    Font.FAlternateName:=Nil;
  5440.                End;
  5441.           End;
  5442.      End
  5443.      Else Inherited ReadSCUResource(ResName,Data,DataLen)
  5444. End;
  5445.  
  5446.  
  5447. Function TMenu.WriteSCUResource(Stream:TResourceStream):Boolean;
  5448. Begin
  5449.      Result := Inherited WriteSCUResource(Stream);
  5450.      If Not Result Then Exit;
  5451.  
  5452.      If FFont = Nil Then
  5453.      Begin
  5454.           Result := True;
  5455.           Exit;
  5456.      End;
  5457.  
  5458.      DisposeStr(FFont.FAlternateName);
  5459.      FFont.FAlternateName:=FAlternateFontName;
  5460.      Result := FFont.WriteSCUResourceName(Stream,rnFont);
  5461.      FFont.FAlternateName:=Nil;
  5462. End;
  5463.  
  5464.  
  5465. Procedure TMenu.DisableCommands(Cmds:Array Of TCommand);
  5466. Var  T:LongInt;
  5467.      entry:TMenuItem;
  5468. Begin
  5469.      For T := Low(Cmds) To High(Cmds) Do
  5470.      Begin
  5471.           entry := ItemFromCommand(Cmds[T]);
  5472.           If entry <> Nil Then entry.Enabled := False;
  5473.      End;
  5474. End;
  5475.  
  5476.  
  5477. Procedure TMenu.EnableCommands(Cmds:Array Of TCommand);
  5478. Var  T:LongInt;
  5479.      entry:TMenuItem;
  5480. Begin
  5481.      For T := Low(Cmds) To High(Cmds) Do
  5482.      Begin
  5483.           entry := ItemFromCommand(Cmds[T]);
  5484.           If entry <> Nil Then entry.Enabled := True;
  5485.      End;
  5486. End;
  5487.  
  5488.  
  5489. {$IFDEF OS2}
  5490. Procedure TMenu.WMHelp(Var Msg:TMessage);
  5491. Var  mi:TMenuItem;
  5492. Begin
  5493.      mi := GetSelectedMenuItem;
  5494.      If mi <> Nil Then
  5495.        If mi.HelpContext <> 0 Then Application.Help(mi.HelpContext);
  5496.  
  5497.      Msg.Handled := True;
  5498. End;
  5499.  
  5500.  
  5501. Procedure TMenu.WMChar(Var Msg:TWMChar);
  5502. Var fsFlags:Word;
  5503.     REP:Byte;
  5504.     scan:Byte;
  5505.     ascii:Byte;
  5506.     virtkey:Word;
  5507.     Current:TMenuItem;
  5508.     CH:Char;
  5509.     Param:TKeyCode;
  5510.     SelItem:Word;
  5511. Label lsc;
  5512. Begin
  5513.      fsFlags := Msg.KeyData;
  5514.      REP := GetKeyRepeat(TMessage(Msg));
  5515.      scan := Msg.ScanCode;
  5516.      ascii := Lo(Msg.CharCode);
  5517.      virtkey := Msg.VirtualKeyCode;
  5518.  
  5519.      If fsFlags And KC_KEYUP <> 0 Then Exit;
  5520.      If Not (Self Is TMenu) Then Exit;
  5521.  
  5522.      SelItem:=WinSendMsg(Handle,MM_QUERYSELITEMID,MPFROM2SHORT(0,1),0);
  5523.      Current:=ItemFromInternalCommand(SelItem);
  5524.      If Current=Nil Then Exit;
  5525.  
  5526.      If fsFlags And KC_CHAR <> 0 Then
  5527.      Begin
  5528.           If (ascii < 32) Or  (fsFlags And KC_CTRL <> 0) Then Goto lsc;
  5529.           If (fsFlags And KC_VIRTUALKEY <> 0) And (fsFlags And KC_SHIFT <> 0)
  5530.           Then Goto lsc;    {numerical block}
  5531.           CH := Chr(ascii);
  5532.           CharEvent(Current,CH,REP);
  5533.  
  5534.           If CH = #0 Then
  5535.           Begin
  5536.                Msg.Handled := True;
  5537.                Msg.Result := 0;
  5538.           End;
  5539.      End
  5540.      Else
  5541.      Begin
  5542. lsc:
  5543.           Param := 0;
  5544.           If fsFlags And KC_VIRTUALKEY <> 0 Then Param := virtkey Or kb_VK
  5545.           Else Param := ascii Or kb_Char;       {E.G. Ctrl-J}
  5546.  
  5547.           If fsFlags And KC_ALT <> 0 Then Param := Param Or kb_Alt;
  5548.           If fsFlags And KC_SHIFT <> 0 Then Param := Param Or kb_Shift;
  5549.           If fsFlags And KC_CTRL <> 0 Then Param := Param Or kb_Ctrl;
  5550.           ScanEvent(Current,Param,REP);
  5551.  
  5552.           If Param = kbNull Then
  5553.           Begin
  5554.                Msg.Handled := True;
  5555.                Msg.Result := 0;
  5556.           End;
  5557.      End;
  5558. End;
  5559. {$ENDIF}
  5560.  
  5561.  
  5562. Procedure TMenu.CharEvent(entry:TMenuItem;Var key:Char;REP:Byte);
  5563. Var  Child:TForm;
  5564. Begin
  5565.      If Owner Is TForm Then
  5566.      Begin
  5567.           Child:=TForm(Owner);
  5568.           Child.MenuCharEvent(Self,entry,key,REP);
  5569.  
  5570.           If Designed Then key := #0;
  5571.      End;
  5572. End;
  5573.  
  5574.  
  5575. Procedure TMenu.ScanEvent(entry:TMenuItem;Var KeyCode:TKeyCode;REP:Byte);
  5576. Var  Child:TForm;
  5577. Begin
  5578.      If Owner Is TForm Then
  5579.      Begin
  5580.           Child:=TForm(Owner);
  5581.           Child.MenuScanEvent(Self,entry,KeyCode,REP);
  5582.  
  5583.           If Designed Then
  5584.             If Not (KeyCode In [kbEsc,kbCLeft,kbCRight])
  5585.             Then KeyCode := kbNull;
  5586.      End;
  5587. End;
  5588.  
  5589.  
  5590. Procedure TMenu.LoadedFromSCU(SCUParent:TComponent);
  5591.   Procedure ProcessSubMenus(ParentItem:TMenuItem);
  5592.   Var  T:LongInt;
  5593.        entry:TMenuItem;
  5594.   Begin
  5595.        {Append pseudo Menus}
  5596.        For T := 0 To ParentItem.Count-1 Do
  5597.        Begin
  5598.             entry := ParentItem.Items[T];
  5599.             If entry Is TMenuItem Then
  5600.             Begin
  5601.                  If ((Self Is TMainMenu) And (ParentItem = Items)) Or
  5602.                      (entry.Count > 0) Then ProcessSubMenus(entry);
  5603.             End;
  5604.        End;
  5605.  
  5606.        {New Submenu entry}
  5607.        entry.Create(Owner{Self});
  5608.        entry.Caption := MenuIDEEditStr;
  5609.        ParentItem.Add(entry);
  5610.   End;
  5611. Begin
  5612.      Inherited LoadedFromSCU(SCUParent);
  5613.  
  5614.      If Designed Then ProcessSubMenus(Items);
  5615. End;
  5616.  
  5617.  
  5618. Procedure TMenu.GetChildren(Proc:TGetChildProc);
  5619. Begin
  5620.      FItems.GetChildren(Proc);
  5621. End;
  5622.  
  5623.  
  5624. Function SearchSubEntry(Menu:TMenu;AParent:TMenuItem;Command:TCommand;
  5625.                         internal:Boolean):TMenuItem;
  5626. Var  T:LongInt;
  5627.      cmd:TCommand;
  5628.      entry:TMenuItem;
  5629. Begin
  5630.      Result := Nil;
  5631.      For T := 0 To AParent.Count-1 Do
  5632.      Begin
  5633.           entry := AParent.Items[T];
  5634.           If internal Then cmd := entry.FInternalCommand
  5635.           Else cmd := entry.FCommand;
  5636.  
  5637.           If cmd = Command Then
  5638.           Begin
  5639.                Result := entry;
  5640.                Exit;
  5641.           End;
  5642.           If entry.Count > 0 Then
  5643.           Begin
  5644.                Result := SearchSubEntry(Menu,entry,Command,internal);
  5645.                If Result <> Nil Then Exit;
  5646.           End;
  5647.      End;
  5648. End;
  5649.  
  5650.  
  5651. Function TMenu.ItemFromCommand(Command:TCommand):TMenuItem;
  5652. Begin
  5653.      Result := SearchSubEntry(Self,Items,Command,False);
  5654. End;
  5655.  
  5656.  
  5657. Function TMenu.ItemFromInternalCommand(Command:TCommand):TMenuItem;
  5658. Begin
  5659.      Result := Application.GetMenuItem(Command);
  5660. End;
  5661.  
  5662. Function TMenu.GetSelectedMenuItem:TMenuItem;
  5663. {$IFDEF OS2}
  5664. Var  SelItemId:Word;
  5665. {$ENDIF}
  5666. Begin
  5667.      {$IFDEF OS2}
  5668.      SelItemId := WinSendMsg(Handle,MM_QUERYSELITEMID,MPFROM2SHORT(0,1),0);
  5669.      Result := ItemFromInternalCommand(SelItemId);
  5670.      {$ENDIF}
  5671.      {$IFDEF Win32}
  5672.      Result:=Nil;
  5673.      {...?}
  5674.      {$ENDIF}
  5675. End;
  5676.  
  5677.  
  5678. Function TMenu.GetWidth:LongInt;
  5679. Var  rc:RECTL;
  5680. Begin
  5681.      Result := 0;
  5682.      {$IFDEF OS2}
  5683.      If FHandle <> 0 Then
  5684.        If WinQueryWindowRect(FHandle,rc) Then Result := rc.xRight;
  5685.      {$ENDIF}
  5686.      {$IFDEF Win32}
  5687.      If FHandle <> 0 Then
  5688.        If Items.Count > 0 Then
  5689.      Begin
  5690.           {rightmost MENUITEM}
  5691.           WinUser.GetMenuItemRect(FParent.Handle,FHandle,Items.Count-1,rc);
  5692.           Result := rc.Right;
  5693.           {leftmost MENUITEM}
  5694.           WinUser.GetMenuItemRect(FParent.Handle,FHandle,0,rc);
  5695.           Dec(Result,rc.Left);
  5696.      End;
  5697.      {$ENDIF}
  5698. End;
  5699.  
  5700.  
  5701. Function TMenu.GetHeight:LongInt;
  5702. Var  rc:RECTL;
  5703. Begin
  5704.      Result := 0;
  5705.      {$IFDEF OS2}
  5706.      If FHandle <> 0 Then
  5707.        If WinQueryWindowRect(FHandle,rc) Then Result := rc.yTop;
  5708.      {$ENDIF}
  5709.      {$IFDEF Win32}
  5710.      If FHandle <> 0 Then
  5711.        If Items.Count > 0 Then
  5712.      Begin
  5713.           {rightmost MENUITEM}
  5714.           WinUser.GetMenuItemRect(FParent.Handle,FHandle,Items.Count-1,rc);
  5715.           Result := rc.Bottom;
  5716.           {leftmost MENUITEM}
  5717.           WinUser.GetMenuItemRect(FParent.Handle,FHandle,0,rc);
  5718.           Dec(Result,rc.Top);
  5719.      End;
  5720.      {$ENDIF}
  5721. End;
  5722.  
  5723.  
  5724. Destructor TMenu.Destroy;
  5725. Var  HMen:LongWord;
  5726. Begin
  5727.      If FHandle<>0 Then
  5728.      Begin
  5729.           HMen:=FHandle;
  5730.           FHandle:=0;
  5731.  
  5732.           {maybe FParent Is already destroyed}
  5733.           If Not (IsControl(FParent)) Then FParent := Nil;
  5734.  
  5735.           {$IFDEF OS2}
  5736.           WinSubClassWindow(HMen,@FDefWndProc);
  5737.           WinDestroyWindow(HMen);
  5738.           If FParent <> Nil Then
  5739.           Begin
  5740.                WinSendMsg(FParent.Handle,WM_UPDATEFRAME,FCF_MENU,0);
  5741.           End;
  5742.           {$ENDIF}
  5743.  
  5744.           {$IFDEF Win32}
  5745.           DestroyMenu(HMen);
  5746.           If FParent <> Nil Then
  5747.           Begin
  5748.                DisposeMenuHandleItem(TForm(FParent),HMen,TComponent(Self));
  5749.                SetMenu(FParent.Handle,0);
  5750.           End;
  5751.           {$ENDIF}
  5752.      End;
  5753.  
  5754.      FItems.Destroy;
  5755.      FItems := Nil;
  5756.      If FAlternateFontName<>Nil Then DisposeStr(FAlternateFontName);
  5757.      FAlternateFontName:=Nil;
  5758.  
  5759.      Inherited Destroy;
  5760. End;
  5761.  
  5762.  
  5763. Const
  5764.    TMenuItemRegistered:Boolean=False;
  5765.  
  5766. Procedure TMenu.SetupComponent;
  5767. Begin
  5768.      Inherited SetupComponent;
  5769.  
  5770.      Name:='Menu';
  5771.  
  5772.      FFont:=Screen.MenuFont;
  5773.      FParent := TControl(Owner);
  5774.      If Owner <> Nil Then SetDesigning(Owner.Designed);
  5775.  
  5776.      FItems.Create(Nil);
  5777.      FItems.FParent := Nil;
  5778.      FItems.FMenu := Self;
  5779.      FItems.SetDesigning(Designed);
  5780.      Include(FItems.ComponentState, csDetail);
  5781.  
  5782.      If Not TMenuItemRegistered Then
  5783.      Begin
  5784.           RegisterClasses([TMenuItem]); {RuntimeSCU}
  5785.           TMenuItemRegistered := True;
  5786.      End;
  5787. End;
  5788.  
  5789.  
  5790. Procedure TMenu.LoadResource;
  5791. Begin
  5792.      {$IFDEF OS2}
  5793.      WinLoadMenu(FParent.Handle,0,FResourceId);
  5794.      {$ENDIF}
  5795.      {$IFDEF Win32}
  5796.      SetMenu(FParent.Handle,LoadMenu(DllModule,MAKEINTRESOURCE(FResourceId)^));
  5797.      {$ENDIF}
  5798. End;
  5799.  
  5800.  
  5801. Procedure TMenu.CreateMenu;
  5802. Begin
  5803.      {$IFDEF OS2}
  5804.      FHandle:=WinCreateMenu(FParent.Handle,Nil);  {Empty Menu}
  5805.      If FHandle=0 Then
  5806.      Begin
  5807.           //ErrorBox2('Error creating menu');
  5808.           Exit;
  5809.      End;
  5810.      WinSetWindowULong(FHandle,QWL_USER,LongWord(Self));    {VMT Pointer}
  5811.      FDefWndProc:=Pointer(WinSubClassWindow(FHandle,@SubclassedMenuWndProc));
  5812.      {$ENDIF}
  5813.  
  5814.      {$IFDEF Win32}
  5815.      FHandle:=WinUser.CreateMenu;
  5816.      If FHandle=0 Then
  5817.      Begin
  5818.           //ErrorBox2('Error creating menu');
  5819.           Exit;
  5820.      End;
  5821.      NewMenuHandleItem(TForm(FParent){Parent},FHandle,TComponent(Self));
  5822.      {$ENDIF}
  5823.  
  5824.      If FFont<>Nil Then SetFont(FFont);
  5825. End;
  5826.  
  5827.  
  5828. Procedure TMenu.Show;
  5829. Begin
  5830.      If Not (IsControl(TControl(Owner))) Then Exit;
  5831.      If FParent = Nil Then Exit;
  5832.      If FParent.Handle = 0 Then Exit;
  5833.  
  5834.      If FResourceId<>0 Then
  5835.      Begin
  5836.           LoadResource;
  5837.           Exit;
  5838.      End;
  5839.  
  5840.      If FHandle=0 Then
  5841.      Begin
  5842.           CreateMenu;
  5843.           If FHandle = 0 Then Exit;
  5844.  
  5845.           FItems.CreateWnd;
  5846.           FItems.FCreated := True;
  5847.      End;
  5848.  
  5849.      If Not ((Self Is TMainMenu) Or (Self Is TPopupMenu)) Then
  5850.      Begin {?}
  5851.           {$IFDEF OS2}
  5852.           WinShowWindow(FHandle,True);
  5853.           {$ENDIF}
  5854.           {$IFDEF Win32}
  5855.           DrawMenuBar(FParent.Handle);
  5856.           {$ENDIF}
  5857.      End;
  5858. End;
  5859.  
  5860.  
  5861. {
  5862. ╔═══════════════════════════════════════════════════════════════════════════╗
  5863. ║                                                                           ║
  5864. ║ Speed-Pascal/2 Version 2.0                                                ║
  5865. ║                                                                           ║
  5866. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  5867. ║                                                                           ║
  5868. ║ This section: TPopupMenu Class Implementation                             ║
  5869. ║                                                                           ║
  5870. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  5871. ║                                                                           ║
  5872. ╚═══════════════════════════════════════════════════════════════════════════╝
  5873. }
  5874.  
  5875. Procedure TPopupMenu.SetupComponent;
  5876. Begin
  5877.      Inherited SetupComponent;
  5878.  
  5879.      Name := 'PopupMenu';
  5880.      FAutoPopup := True;
  5881.      FAlignment := paCenter;
  5882.      Include(ComponentState, csHandleLinks);
  5883. End;
  5884.  
  5885.  
  5886. Procedure TPopupMenu.CreateMenu;
  5887. Begin
  5888.      {$IFDEF OS2}
  5889.      Inherited CreateMenu;
  5890.      {$ENDIF}
  5891.  
  5892.      {$IFDEF Win32}
  5893.      FHandle:=WinUser.CreatePopupMenu;
  5894.      If FHandle=0 Then
  5895.      Begin
  5896.           //ErrorBox2('Error creating menu');
  5897.           Exit;
  5898.      End;
  5899.      NewMenuHandleItem(TForm(FParent),FHandle,TComponent(Self));
  5900.      {$ENDIF}
  5901. End;
  5902.  
  5903.  
  5904. Procedure TPopupMenu.Popup(X,Y:LongInt);
  5905. Var  {$IFDEF OS2}
  5906.      iditem:LongWord;
  5907.      AL:LongInt;
  5908.      {$ENDIF}
  5909.      {$IFDEF Win32}
  5910.      pt:TPoint;
  5911.      AL:Word;
  5912.      {$ENDIF}
  5913. Begin
  5914.      If Handle = 0 Then Show;
  5915.      If Handle = 0 Then Exit;
  5916.  
  5917.      If FOnPopup <> Nil Then FOnPopup(Self);
  5918.  
  5919.      {$IFDEF OS2}
  5920.      If (Width = 0) And (FAlignment = paRight) Then
  5921.      Begin //Create the Window outside Of the Screen To Get the Real Width
  5922.           WinPopupMenu(HWND_DESKTOP,Screen.FHiddenWindow.Handle,Handle,
  5923.                        Screen.Width,Screen.Height, 0, 0);
  5924.      End;
  5925.  
  5926.      If FItems.Count > 0 Then iditem := FItems.Items[0].FInternalCommand
  5927.      Else iditem := 0;
  5928.  
  5929.      AL := PU_HCONSTRAIN Or PU_VCONSTRAIN;
  5930.      Case FAlignment Of
  5931.        paCenter: AL := AL Or PU_POSITIONONITEM;
  5932.        paRight: Dec(X, Width);
  5933.      End;
  5934.      WinPopupMenu(HWND_DESKTOP,Screen.FHiddenWindow.Handle,Handle,X,Y,iditem,
  5935.                   AL Or PU_KEYBOARD Or PU_MOUSEBUTTON1);
  5936.      {$ENDIF}
  5937.      {$IFDEF Win32}
  5938.      WinUser.SetCursor(Screen.Cursors[crArrow]); {force Cursor}
  5939.      pt := Point(X,Y);
  5940.      TransformPointToWin32(pt,Nil,Nil);
  5941.  
  5942.      Case FAlignment Of
  5943.        paLeft: AL := TPM_LEFTALIGN;
  5944.        paCenter: AL := TPM_CENTERALIGN;
  5945.        paRight: AL := TPM_RIGHTALIGN;
  5946.      End;
  5947.  
  5948.      TrackPopupMenu(Handle,AL, pt.X,pt.Y,0,Screen.FHiddenWindow.Handle,Nil);
  5949.      {$ENDIF}
  5950. End;
  5951.  
  5952.  
  5953. {
  5954. ╔═══════════════════════════════════════════════════════════════════════════╗
  5955. ║                                                                           ║
  5956. ║ Speed-Pascal/2 Version 2.0                                                ║
  5957. ║                                                                           ║
  5958. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  5959. ║                                                                           ║
  5960. ║ This section: TMainMenu Class Implementation                              ║
  5961. ║                                                                           ║
  5962. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  5963. ║                                                                           ║
  5964. ╚═══════════════════════════════════════════════════════════════════════════╝
  5965. }
  5966.  
  5967. Procedure TMainMenu.SetupComponent;
  5968. Begin
  5969.      Inherited SetupComponent;
  5970.  
  5971.      Name := 'MainMenu';
  5972.      Include(ComponentState, csHandleLinks);
  5973. End;
  5974.  
  5975.  
  5976. Procedure TMainMenu.Show;
  5977. {$IFDEF OS2}
  5978. Var  HMen:LongWord;
  5979.      ulStyle:LongWord;
  5980. {$ENDIF}
  5981. Begin
  5982.      If FParent Is TForm Then
  5983.        If TForm(FParent).Frame <> Nil
  5984.        Then FParent := TForm(FParent).Frame;
  5985.  
  5986.      Inherited Show;
  5987.  
  5988.      If FHandle=0 Then Exit;
  5989.  
  5990.      {$IFDEF OS2}
  5991.      HMen:=WinWindowFromID(FParent.Handle,FID_MENU);
  5992.  
  5993.      If HMen<>0 Then
  5994.      Begin
  5995.           WinSetParent(HMen,WinQueryObjectWindow(HWND_DESKTOP),False);
  5996.           WinSetOwner(HMen,WinQueryObjectWindow(HWND_DESKTOP));
  5997.      End;
  5998.  
  5999.      ulStyle:=WinQueryWindowULong(FHandle,QWL_STYLE);
  6000.      ulStyle:=ulStyle Or {MS_ROOT Or} MS_ACTIONBAR Or WS_CLIPSIBLINGS;
  6001.      ulStyle:=ulStyle And Not WS_SAVEBITS;
  6002.      WinSetWindowULong(FHandle,QWL_STYLE,ulStyle);
  6003.      WinSetWindowUShort(FHandle,QWS_ID,FID_MENU);
  6004.  
  6005.      WinSetParent(FHandle,FParent.Handle,False);
  6006.      WinSetOwner(FHandle,FParent.Handle);
  6007.  
  6008.      WinSendMsg(FParent.Handle,WM_UPDATEFRAME,FCF_MENU,0);
  6009.      {$ENDIF}
  6010.  
  6011.      {$IFDEF Win32}
  6012.      SetMenu(FParent.Handle,FHandle);
  6013.      {$ENDIF}
  6014. End;
  6015.  
  6016.  
  6017. {
  6018. ╔═══════════════════════════════════════════════════════════════════════════╗
  6019. ║                                                                           ║
  6020. ║ Speed-Pascal/2 Version 2.0                                                ║
  6021. ║                                                                           ║
  6022. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  6023. ║                                                                           ║
  6024. ║ This section: TForm Class Implementation                                  ║
  6025. ║                                                                           ║
  6026. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  6027. ║                                                                           ║
  6028. ╚═══════════════════════════════════════════════════════════════════════════╝
  6029. }
  6030.  
  6031. {$IFDEF OS2}
  6032. Function SubclassedWndProc(Win:HWND;Msg,para1,para2:ULONG):ULONG;CDECL;
  6033. {$ENDIF}
  6034. {$IFDEF Win32}
  6035. Function SubclassedWndProc(Win:HWND;Msg,para1,para2:ULONG):ULONG;APIENTRY;
  6036. {$ENDIF}
  6037. Var Control:TControl;
  6038. Const LastWnd:HWND=0;
  6039.       LastControl:TControl=Nil;
  6040. Begin
  6041.      {$IFDEF OS2}
  6042.      If not WinIsWindow(AppHandle,Win) Then exit;
  6043.      {$ENDIF}
  6044.  
  6045.      If Win=LastWnd Then Control:=LastControl
  6046.      Else
  6047.      Begin
  6048.          If ((Msg>=WM_USER+1000)And(Msg<=WM_USER+1013)) Then //Web Messages
  6049.          Begin
  6050.              Control := HandleToControl(para1);
  6051.              If ((Control=Nil)Or(not (IsControl(Control)))) Then Control := HandleToControl(Win);
  6052.          End
  6053.          Else Control := HandleToControl(Win);                      {Get VMT Pointer}
  6054.          If Control=Nil Then exit; //do not handle
  6055.          LastWnd:=Win;
  6056.          LastControl:=Control;
  6057.      End;
  6058.  
  6059.      Asm
  6060.         PUSHL 0                 //Message.Result
  6061.         PUSHL para2             //Message.para2
  6062.         PUSHL para1             //Message.para1
  6063.         PUSHL 0                 //Message.Handled
  6064.         PUSHL Win               //Message.Receiver
  6065.         PUSHL Control           //Message.ReceiverClass
  6066.         PUSHL Msg               //Message.Message
  6067.         MOV   EDX,ESP
  6068.         PUSH  EDX               //Var Message
  6069.         PUSHL Control           //Self
  6070.         CALLN32 TControl.WndProc
  6071.         ADD   ESP,24
  6072.         POP   EAX               //Result
  6073.         MOV   Result,EAX
  6074.      End;
  6075. End;
  6076.  
  6077.  
  6078. {$IFDEF WIN32}
  6079. Var ModalArray:Array[1..50] Of TControl;
  6080.  
  6081. Const
  6082.      ModalCount:Byte=0;
  6083.  
  6084. Procedure LockDesktopWindows(Lock:Boolean;Exclude:TControl);
  6085. Var  T:LongInt;
  6086.      actual:TForm;
  6087. Begin
  6088.      For T := 0 To Screen.FForms.Count-1 Do
  6089.      Begin
  6090.           actual := Screen.FForms.Items[T];
  6091.           If Actual <> Exclude Then
  6092.           Begin
  6093.                If Lock Then
  6094.                Begin
  6095.                     //If ModalCount = 0 Then
  6096.                     If not Actual.FLocked Then
  6097.                     Begin
  6098.                          Actual.FOldEnabledState := Actual.FEnabled;
  6099.                          If Actual.FFrame <> Nil Then Actual.FFrame.Disable;
  6100.                     End;
  6101.                     Actual.Disable;
  6102.                     Actual.FLocked := True;
  6103.                End
  6104.                Else
  6105.                Begin
  6106.                     If ((ModalCount = 1)Or(Actual = ModalArray[ModalCount-1])) Then
  6107.                     Begin
  6108.                          Actual.FLocked := False;
  6109.                          If Actual.FOldEnabledState Or Actual.Designed
  6110.                          Then
  6111.                          Begin
  6112.                              If Actual.FFrame <> Nil Then Actual.FFrame.Enable;
  6113.                              Actual.Enable;
  6114.                          End;
  6115.                     End;
  6116.                End;
  6117.           End
  6118.           Else
  6119.           Begin
  6120.                If not Lock Then
  6121.                Begin
  6122.                   Actual.FLocked := False;
  6123.                   If Actual.FFrame <> Nil Then Actual.FFrame.Enable;
  6124.                   Actual.Enable;
  6125.                End;
  6126.           End;
  6127.      End;
  6128.  
  6129.      If Lock Then
  6130.      Begin
  6131.           Inc(ModalCount);
  6132.           ModalArray[ModalCount] := Exclude;
  6133.      End
  6134.      Else If ModalCount > 0 Then Dec(ModalCount);
  6135. End;
  6136. {$ENDIF}
  6137.  
  6138. {$IFDEF OS2}
  6139. Const
  6140.    CurrentModalForm:TControl=NIL;
  6141.    CurrentModalFrame:HWND=0;
  6142.    DesktopHWND:HWND=0;
  6143.    ModalList:TList=NIL;
  6144.  
  6145. {$HINTS OFF}
  6146. Function InputHook(ahab:HAB;VAR apqmsg:QMSG;fs:ULONG):Bool;CDecl;
  6147. Var  aHwnd,aHwnd1:HWND;
  6148. Begin
  6149.      Result := False;
  6150.  
  6151.      If DesktopHWND = 0 Then DesktopHWND := WinQueryDesktopWindow(AppHandle, 0);
  6152.      aHwnd := apqmsg.hwnd;
  6153.  
  6154.      If not (apqmsg.msg IN [WM_CHAR,WM_VIOCHAR,WM_TRANSLATEACCEL,WM_SYSCOMMAND,
  6155.                             WM_MOUSEFIRST..WM_MOUSELAST]) Then exit;
  6156.  
  6157.      If (aHwnd = DesktopHWND) Or (aHwnd = 0) Then exit;
  6158.  
  6159.      While (aHwnd <> DesktopHWND) And (aHwnd <> 0) Do
  6160.      Begin
  6161.           // check if it is in the modal form
  6162.           If aHwnd = CurrentModalFrame Then exit;
  6163.  
  6164.           // check if it is a popup menu
  6165.           If aHwnd = Screen.FHiddenWindow.Handle Then exit;
  6166.  
  6167.           aHwnd1:=aHwnd;
  6168.           aHwnd := WinQueryWindow(aHwnd, QW_OWNER);
  6169.  
  6170.           If aHwnd = $1001{PMERR_INVALID_HWND} Then exit;
  6171.           If aHwnd = $1003{PMERR_PARAMETER_OUT_OF_RANGE} Then exit;
  6172.  
  6173.           If ((aHwnd=DesktopHWND)Or(aHwnd=0)) Then
  6174.           Begin
  6175.               //test Non SPCC form
  6176.               If aHwnd1<>0 Then
  6177.               Begin
  6178.                    //check if this is a memory pointer
  6179.                    If not IsControl(HandleToControl(aHwnd1)) Then exit;
  6180.               End;
  6181.           End;
  6182.      End;
  6183.  
  6184.      If apqmsg.msg = WM_BUTTON1DOWN Then
  6185.        If CurrentModalForm <> Nil Then CurrentModalForm.BringToFront;
  6186.  
  6187.      Result := True;
  6188. End;
  6189. {$HINTS ON}
  6190.  
  6191. Procedure LockDesktopWindows(Lock:Boolean;Exclude:TControl);
  6192. Var  t:LongInt;
  6193.      aForm:TForm;
  6194. Begin
  6195.      If Lock Then
  6196.      Begin
  6197.           If ModalList = Nil Then ModalList.Create;
  6198.           ModalList.Insert(0, Exclude);
  6199.           CurrentModalForm := Exclude;
  6200.           CurrentModalFrame := Exclude.FFrame.Handle;
  6201.  
  6202.           If ModalList.Count = 1 Then
  6203.           Begin
  6204.                WinSetHook(
  6205.                   AppHandle,
  6206.                   HMQ_CURRENT,
  6207.                   HK_INPUT,
  6208.                   @InputHook,
  6209.                   0);
  6210.           End;
  6211.      End
  6212.      Else
  6213.      Begin
  6214.           ModalList.Remove(Exclude);
  6215.  
  6216.           If ModalList.Count = 0 Then
  6217.           Begin
  6218.                CurrentModalForm := Nil;
  6219.                CurrentModalFrame := 0;
  6220.  
  6221.                WinReleaseHook(
  6222.                  AppHandle,
  6223.                  HMQ_CURRENT,
  6224.                  HK_INPUT,
  6225.                  @InputHook,
  6226.                  0);
  6227.  
  6228.                ModalList.Destroy;
  6229.                ModalList := Nil;
  6230.           End
  6231.           Else
  6232.           Begin
  6233.                CurrentModalForm := TControl(ModalList[0]);
  6234.                CurrentModalFrame := CurrentModalForm.FFrame.Handle
  6235.           End;
  6236.      End;
  6237.  
  6238.      For t := 0 To Screen.FForms.Count-1 Do
  6239.      Begin
  6240.           aForm := Screen.FForms.Items[t];
  6241.           If CurrentModalForm <> Nil Then
  6242.           Begin
  6243.                If aForm.Visible Then aForm.FLocked := aForm <> CurrentModalForm
  6244.                Else aForm.FLocked := False;
  6245.           End
  6246.           Else aForm.FLocked := False;
  6247.      End;
  6248. End;
  6249. {$ENDIF}
  6250.  
  6251. Procedure TForm.SetPosition(NewValue:TPosition);
  6252. Begin
  6253.     If NewValue<>FPosition Then
  6254.     Begin
  6255.          FPosition:=NewValue;
  6256.          If Not (csDesigning In ComponentState) Then RecreateWnd;
  6257.     End;
  6258. End;
  6259.  
  6260.  
  6261. Function TForm.GetLanguage:String;
  6262. Var S:String;
  6263. Begin
  6264.     Asm
  6265.        PUSH DWord Ptr Self
  6266.        LEA EAX,s
  6267.        PUSH EAX
  6268.        CALLN32 Classes.GetLanguage
  6269.     End;
  6270.     Result:=S;
  6271. End;
  6272.  
  6273.  
  6274. Procedure TForm.SetLanguage(Const NewLanguage:String);
  6275. Begin
  6276.      Asm
  6277.         PUSH DWord Ptr Self
  6278.         PUSH DWord Ptr NewLanguage
  6279.         CALLN32 Classes.SetLanguage
  6280.      End
  6281. End;
  6282.  
  6283. Const DdeMan_WMDDEDestroy:Procedure(Var Msg:TMessage)=Nil;
  6284.       DdeMan_WMDdeInitiate:Procedure(Self:TForm;Var Msg:TMessage)=Nil;
  6285.       DdeMan_OpenClientLinks:Procedure(Form:TForm)=Nil;
  6286.       DdeMan_CloseClientLinks:Procedure(Form:TForm)=Nil;
  6287.       DdeMan_CloseAllLinks:Procedure=Nil;
  6288.  
  6289. {$IFDEF OS2}
  6290. Procedure TForm.WMDDEDestroy(Var Msg:TMessage);
  6291. Begin
  6292.      If DdeMan_WMDdeDestroy<>Nil Then DdeMan_WMDdeDestroy(Msg);
  6293. End;
  6294. {$ENDIF}
  6295.  
  6296. {$IFDEF OS2}
  6297. Procedure TForm.WMDDEInitiate(Var Msg:TMessage);
  6298. Begin
  6299.      If DdeMan_WMDdeInitiate<>Nil Then DdeMan_WMDdeInitiate(Self,Msg);
  6300. End;
  6301. {$ENDIF}
  6302.  
  6303.  
  6304. {$HINTS OFF}
  6305. Procedure TForm.MenuInit(AMenu:TMenu;entry:TMenuItem);
  6306. Begin
  6307.      If FOnMenuInit <> Nil Then FOnMenuInit(Self,AMenu,entry);
  6308. End;
  6309.  
  6310. Procedure TForm.MenuEnd(AMenu:TMenu;entry:TMenuItem);
  6311. Begin
  6312.      If FOnMenuEnd <> Nil Then FOnMenuEnd(Self,AMenu,entry);
  6313. End;
  6314.  
  6315. Procedure TForm.MenuItemFocus(AMenu:TMenu;entry:TMenuItem);
  6316. Begin
  6317.      If OnMenuItemFocus <> Nil Then OnMenuItemFocus(Self,AMenu,entry);
  6318. End;
  6319.  
  6320. Procedure TForm.MenuCharEvent(AMenu:TMenu;entry:TMenuItem;Var key:Char;REP:Byte);
  6321. Begin
  6322. End;
  6323.  
  6324. Procedure TForm.MenuScanEvent(AMenu:TMenu;entry:TMenuItem;Var KeyCode:TKeyCode;REP:Byte);
  6325. Begin
  6326. End;
  6327. {$HINTS ON}
  6328.  
  6329.  
  6330. Procedure TForm.Activate;
  6331. Begin
  6332.      If OnActivate <> Nil Then OnActivate(Self);
  6333. End;
  6334.  
  6335.  
  6336. Procedure TForm.Deactivate;
  6337. Begin
  6338.      If OnDeactivate <> Nil Then OnDeactivate(Self);
  6339. End;
  6340.  
  6341.  
  6342. Procedure TForm.WMActivate(Var Msg:TWMActivate);
  6343. Begin
  6344.      If Application <> Nil Then Application.DestroyHintWindow;
  6345.  
  6346.      {$IFDEF OS2}
  6347.      If Msg.Active Then
  6348.      {$ENDIF}
  6349.      {$IFDEF Win32}
  6350.      If Msg.Active <> WA_INACTIVE Then
  6351.      {$ENDIF}
  6352.      Begin
  6353.           {
  6354.           If FLocked Then
  6355.           Begin
  6356.                Msg.Handled := True;
  6357.                Msg.Result := 0;
  6358.                Exit;
  6359.           End;
  6360.           }
  6361.  
  6362.           If Parent = Nil Then Screen.FActiveForm := Self;
  6363.           Activate;
  6364.      End
  6365.      Else Deactivate;
  6366.  
  6367.      Screen.UpdateLastActive;
  6368. End;
  6369.  
  6370.  
  6371. Procedure TForm.Release;
  6372. Begin
  6373.      {$IFDEF OS2}
  6374.      If Handle <> 0 Then PostMsg(Handle,CM_RELEASE,0,0)
  6375.      Else Self.Destroy;
  6376.      {$ENDIF}
  6377.      {$IFDEF WIN32}
  6378.      Self.Destroy;
  6379.      {$ENDIF}
  6380. End;
  6381.  
  6382.  
  6383. Procedure TForm.CMRelease(Var Msg:TMessage);
  6384. Begin
  6385.      Self.Destroy;
  6386.      Msg.Handled := True;
  6387. End;
  6388.  
  6389.  
  6390. {$IFDEF OS2}
  6391. Procedure TForm.WMClose(Var Msg:TWMClose);
  6392. Begin
  6393.      Close;
  6394.  
  6395.      Msg.Handled := True;
  6396.      Msg.Result := 0;
  6397. End;
  6398.  
  6399.  
  6400. Procedure TForm.WMInitMenu(Var Msg:TMessage);
  6401. Var  Win:LongWord;
  6402.      AMenu:TMenu;
  6403.      entry:TMenuItem;
  6404. Begin
  6405.      If Application<>Nil Then Application.DestroyHintWindow;
  6406.  
  6407.      Win := Msg.Param2;
  6408.      entry := Pointer(WinQueryWindowULong(Win,QWL_USER));  {Get VMT Pointer}
  6409.  
  6410.      If entry Is TMenuItem Then AMenu := entry.FMenu
  6411.      Else
  6412.      Begin
  6413.           AMenu := TMenu(entry);
  6414.           If Not (AMenu Is TMenu) Then AMenu := Nil;
  6415.           entry := Nil;
  6416.      End;
  6417.  
  6418.      MenuInit(AMenu,entry);
  6419. End;
  6420.  
  6421.  
  6422. Procedure TForm.WMMenuEnd(Var Msg:TMessage);
  6423. Var  Win:LongWord;
  6424.      AMenu:TMenu;
  6425.      entry:TMenuItem;
  6426. Begin
  6427.      Win := Msg.Param2;
  6428.      entry := Pointer(WinQueryWindowULong(Win,QWL_USER));  {Get VMT Pointer}
  6429.  
  6430.      If entry Is TMenuItem Then AMenu := entry.FMenu
  6431.      Else
  6432.      Begin
  6433.           AMenu := TMenu(entry);
  6434.           If Not (AMenu Is TMenu) Then AMenu := Nil;
  6435.           entry := Nil;
  6436.      End;
  6437.  
  6438.      MenuEnd(AMenu,entry);
  6439.  
  6440.      Application.Hint := '';
  6441. End;
  6442.  
  6443.  
  6444. Procedure TForm.WMMenuSelect(Var Msg:TMessage);
  6445. Var  Win:LongWord;
  6446.      AMenu:TMenu;
  6447.      entry:TMenuItem;
  6448. Begin
  6449.      Win := Msg.Param2;
  6450.      entry := Pointer(WinQueryWindowULong(Win,QWL_USER));  {Get VMT Pointer}
  6451.  
  6452.      If entry Is TMenuItem Then
  6453.      Begin
  6454.           AMenu := entry.FMenu;
  6455.           If AMenu = Nil Then Exit;
  6456.      End
  6457.      Else
  6458.      Begin
  6459.           AMenu := TMenu(entry);
  6460.           If Not (AMenu Is TMenu) Then Exit;
  6461.      End;
  6462.  
  6463.      entry := Menu.ItemFromInternalCommand(Msg.Param1Lo);
  6464.  
  6465.      MenuItemFocus(AMenu,entry);
  6466.  
  6467.      If entry <> Nil Then Application.Hint := GetLongHint(entry.Hint)
  6468.      Else Application.Hint := '';
  6469. End;
  6470. {$ENDIF}
  6471.  
  6472.  
  6473. Procedure TForm.CMUpdateButtons(Var Msg:TMessage);
  6474. Begin
  6475.      Case Msg.Param1 Of
  6476.        1: DefaultButton := TControl(Msg.Param2);
  6477.        2: CancelButton := TControl(Msg.Param2);
  6478.        3: Msg.Result := LongWord(DefaultButton);
  6479.        4: Msg.Result := LongWord(CancelButton);
  6480.      End;
  6481.      Msg.Handled := True;
  6482. End;
  6483.  
  6484.  
  6485. Procedure TForm.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
  6486. Var  aMsg:TMessage;
  6487. Begin
  6488.      Inherited ScanEvent(KeyCode,RepeatCount);
  6489.  
  6490.      Case KeyCode Of
  6491.        {$IFDEF OS2}
  6492.        kbEnter,
  6493.        {$ENDIF}
  6494.        kbCR:
  6495.        Begin
  6496.             Try
  6497.                If Not (IsControl(DefaultButton)) Then DefaultButton := Nil;
  6498.             Except
  6499.                DefaultButton := Nil;
  6500.             End;
  6501.  
  6502.             If DefaultButton <> Nil Then
  6503.               If DefaultButton.Enabled Then
  6504.                 If DefaultButton.Visible Then
  6505.             Begin
  6506.                  FillChar(aMsg,SizeOf(aMsg),0);
  6507.                  {ReceiverClass = 0 -> no Default handler Is called}
  6508.                  {$IFDEF OS2}
  6509.                  aMsg.Msg := WM_CONTROL;
  6510.                  {$ENDIF}
  6511.                  {$IFDEF Win32}
  6512.                  aMsg.Msg := WM_COMMAND;
  6513.                  {$ENDIF}
  6514.                  aMsg.Param1Lo := DefaultButton.FWindowId;
  6515.                  aMsg.Param1Hi := BN_CLICKED;
  6516.                  DefaultButton.ParentNotification(aMsg); {causes Click}
  6517.                  If aMsg.Handled Then KeyCode := kbNull;
  6518.             End;
  6519.        End; {Case}
  6520.        kbEsc:
  6521.        Begin
  6522.             Try
  6523.                If Not (IsControl(CancelButton)) Then CancelButton := Nil;
  6524.             Except
  6525.                CancelButton := Nil;
  6526.             End;
  6527.  
  6528.             If CancelButton <> Nil Then
  6529.              If CancelButton.Enabled Then
  6530.                 If CancelButton.Visible Then
  6531.             Begin
  6532.                  FillChar(aMsg,SizeOf(aMsg),0);
  6533.                  {ReceiverClass = 0 -> no Default handler Is called}
  6534.                  {$IFDEF OS2}
  6535.                  aMsg.Msg := WM_CONTROL;
  6536.                  {$ENDIF}
  6537.                  {$IFDEF Win32}
  6538.                  aMsg.Msg := WM_COMMAND;
  6539.                  {$ENDIF}
  6540.                  aMsg.Param1Lo := CancelButton.FWindowId;
  6541.                  aMsg.Param1Hi := BN_CLICKED;
  6542.                  CancelButton.ParentNotification(aMsg); {causes Click}
  6543.             End;
  6544.             KeyCode := kbNull; {!}
  6545.        End;
  6546.      End;
  6547. End;
  6548.  
  6549.  
  6550. {$IFDEF OS2}
  6551. Procedure TForm.WMTranslateAccel(Var Msg:TMessage);
  6552. Var  fsFlags:Word;
  6553.      ascii:Word;
  6554.      virtkey:Word;
  6555.      scan:TKeyCode;
  6556.      Param:TKeyCode;
  6557.      apqmsg:^QMSG;
  6558.      Receiver:TForm;
  6559. Label lsc;
  6560. Begin
  6561.      If FLocked Then Exit;
  6562.  
  6563.      apqmsg:=Pointer(Msg.Param1);
  6564.  
  6565.      fsFlags := Lo(apqmsg^.mp1);
  6566.      virtkey := Hi(apqmsg^.mp2); {Valid If KC_VIRTKEY}
  6567.      scan := Hi(apqmsg^.mp1);    {Valid If KC_SCANCODE}
  6568.      ascii := Lo(apqmsg^.mp2);   {Valid If KC_CHAR}
  6569.  
  6570.      If fsFlags And KC_CHAR <> 0 Then
  6571.      Begin
  6572.           If (ascii < 32) Or  (fsFlags And KC_CTRL <> 0) Then Goto lsc;
  6573.           If (fsFlags And KC_VIRTUALKEY <> 0) And (fsFlags And KC_SHIFT <> 0)
  6574.           Then Goto lsc;    {numerical block}
  6575.           Param := ascii;
  6576.      End
  6577.      Else
  6578.      Begin
  6579. lsc:
  6580.           Param := 0;
  6581.           If fsFlags And KC_VIRTUALKEY <> 0 Then Param := virtkey Or kb_VK
  6582.           Else If fsFlags And KC_KEYUP <> 0 Then Exit {!}
  6583.                Else Param := ascii Or kb_Char;  {E.G. Ctrl-J}
  6584.  
  6585.           If virtkey = VK_ALT Then Param := Param Or kb_Alt;
  6586.           If fsFlags And KC_ALT <> 0 Then Param := Param Or kb_Alt;
  6587.           If fsFlags And KC_SHIFT <> 0 Then Param := Param Or kb_Shift;
  6588.           If fsFlags And KC_CTRL <> 0 Then Param := Param Or kb_Ctrl;
  6589.      End;
  6590.  
  6591.      Receiver := Nil;
  6592.      TranslateShortCut(Param, Receiver);
  6593.      If Receiver Is TForm Then Receiver.ForwardShortCut(Msg);
  6594. End;
  6595. {$ENDIF}
  6596.  
  6597.  
  6598. {$HINTS OFF}
  6599. Procedure TForm.TranslateShortCut(KeyCode:TKeyCode;Var Receiver:TForm);
  6600. Begin
  6601.      If OnTranslateShortCut <> Nil Then OnTranslateShortCut(Self,KeyCode,Receiver);
  6602. End;
  6603. {$HINTS ON}
  6604.  
  6605.  
  6606. {als Reaktion auf eine TranslateShortCut event}
  6607. {$HINTS OFF}
  6608. Procedure TForm.ForwardShortCut(Var Msg:TMessage);
  6609. {$IFDEF OS2}
  6610. Var  apqmsg:^QMSG;
  6611. {$ENDIF}
  6612. Begin
  6613.      {$IFDEF OS2}
  6614.      apqmsg := Pointer(Msg.Param1);
  6615.      If apqmsg^.HWND = Handle Then Exit;     {prevent recursion}
  6616.      apqmsg^.HWND := Handle;
  6617.      WinSendMsg(Handle,WM_TRANSLATEACCEL,Msg.Param1,Msg.Param2);
  6618.      Msg.Handled := True;
  6619.      Msg.Result := 1;
  6620.      {$ENDIF}
  6621. End;
  6622. {$HINTS ON}
  6623.  
  6624. Var IconClass:TGraphicClass;
  6625.     BitmapClass:TGraphicClass;
  6626.  
  6627. Function TForm.GetFormImage:TGraphic;
  6628. Var
  6629.     FDC,FPS,FHandle,ScreenPS:LongWord;
  6630.     {$IFDEF WIN95}
  6631.     rec:TRect;
  6632.     {$ENDIF}
  6633.     {$IFDEF OS2}
  6634.     sizl:SIZEL;
  6635.     bmp2:BITMAPINFOHEADER2;
  6636.     aptl:ARRAY[0..2] OF TPoint;
  6637.     {$ENDIF}
  6638. Begin
  6639.      Result:=Nil;
  6640.  
  6641.      {$IFDEF OS2}
  6642.      FDC:=DevOpenDC(AppHandle,OD_MEMORY,'*',0,NIL,0) ;
  6643.      sizl.cx:=0;
  6644.      sizl.cy:=0;
  6645.      FPS:=GpiCreatePS(AppHandle,FDC,sizl,
  6646.                       PU_PELS OR GPIF_DEFAULT OR GPIT_MICRO OR GPIA_ASSOC);
  6647.      FillChar(bmp2,sizeof(BITMAPINFOHEADER2),0);
  6648.      bmp2.cbFix:=sizeof(BITMAPINFOHEADER2);
  6649.      bmp2.cx:=Width;
  6650.      bmp2.cy:=Height;
  6651.      bmp2.cPlanes:=1;
  6652.      bmp2.cBitCount:=8;
  6653.      FHandle:=GpiCreateBitmap (FPS,bmp2,0,NIL,NIL);
  6654.      {$ENDIF}
  6655.      {$IFDEF Win95}
  6656.      FDC:=CreateDC('DISPLAY',NIL,NIL,NIL);
  6657.      FPS:=CreateCompatibleDC(FDC);
  6658.      FHandle:=CreateCompatibleBitmap(FDC,Width,Height);
  6659.      SelectObject(FPS,FHandle);
  6660.      {$ENDIF}
  6661.  
  6662.      {$IFDEF Win95}
  6663.      ScreenPS:=FDC;
  6664.  
  6665.      rec:=WindowRect;
  6666.      RectToWin32Rect(rec);
  6667.      TransformRectToWin32(rec,NIL,NIL);
  6668.  
  6669.      WinGDI.BitBlt(FPS,0,0,Width,Height,ScreenPS,
  6670.                    rec.Left,rec.Bottom,SRCCOPY);
  6671.  
  6672.      DeleteObject(SelectObject(ScreenPS,0));
  6673.      {$ENDIF}
  6674.      {$IFDEF OS2}
  6675.      ScreenPS:=WinGetScreenPS(HWND_DESKTOP);
  6676.      GpiCreateLogColorTable(ScreenPS,LCOL_RESET,LCOLF_RGB,0,0,NIL);
  6677.  
  6678.      GpiSetBitmap (FPS,FHandle);
  6679.      aptl[0].x:=0;
  6680.      aptl[0].y:=0;
  6681.      aptl[1].x:=Width;
  6682.      aptl[1].y:=Height;
  6683.      aptl[2].x:=Left;
  6684.      aptl[2].y:=Bottom;
  6685.      GpiBitBlt (FPS,ScreenPS,3,aptl[0],ROP_SRCCOPY,BBO_IGNORE) ;
  6686.  
  6687.      GpiDeleteSetId (ScreenPS,LCID_DEFAULT) ;
  6688.      WinReleasePS(ScreenPS);
  6689.      {$ENDIF}
  6690.  
  6691.      If BitmapClass=Nil Then exit;
  6692.      Result:=TGraphic(BitmapClass.Create);
  6693.      Result.CreatePalette:=True;
  6694.      Result.LoadFromHandle(FHandle);
  6695.  
  6696.      {$IFDEF Win95}
  6697.      DeleteObject(SelectObject(FPS,0));
  6698.      DeleteDC(FPS);
  6699.      DeleteDC(FDC);
  6700.      {$ENDIF}
  6701.      {$IFDEF OS2}
  6702.      GpiSetBitmap(FPS,0);
  6703.      GpiSelectPalette(FPS,0);
  6704.      GpiDeleteBitmap(FHandle);
  6705.      WinReleasePS(FPS);
  6706.      DevCloseDC(FDC);
  6707.      {$ENDIF}
  6708. End;
  6709.  
  6710. Procedure TForm.Print(Canvas:TCanvas;Dest:TRect);
  6711. Var FormImage:TGraphic;
  6712. Begin
  6713.      FormImage:=GetFormImage;
  6714.      FormImage.Draw(Canvas,Dest);
  6715.      FormImage.Destroy;
  6716. End;
  6717.  
  6718. Procedure TForm.SetIcon(NewIcon:TGraphic);
  6719. Begin
  6720.      If ((FIcon<>Nil)And(FIcon<>NewIcon)And(FIcon.FIsLocalCopy)) Then
  6721.      Begin
  6722.           FIcon.Destroy;
  6723.           FIcon:=Nil;
  6724.      End;
  6725.  
  6726.      If ((NewIcon<>Nil)And(NewIcon<>FIcon)And(NewIcon.FIsLocalCopy)And(IconClass<>Nil)) Then
  6727.      Begin
  6728.           //Create A Copy !!
  6729.           Try
  6730.              NewIcon:=NewIcon.CopyGraphic;
  6731.              NewIcon.FIsLocalCopy:=True;
  6732.           Except
  6733.              NewIcon:=Nil;
  6734.           End;
  6735.      End;
  6736.  
  6737.      FIcon := NewIcon;
  6738.  
  6739.      If ((FIcon<>Nil)And(FIcon.FIsLocalCopy)) Then FIcon.FOnChangedNotify:=IconChanged;
  6740.  
  6741.      If ((Frame<>Nil)And(Handle<>0)And(Frame.Handle<>0)) Then
  6742.      Begin
  6743.           {$IFDEF OS2}
  6744.           If ((FIcon=Nil)Or(FIcon.Empty)) Then WinSendMsg(Frame.Handle,WM_SETICON,0,0)
  6745.           Else WinSendMsg(Frame.Handle,WM_SETICON,FIcon.Handle,0);
  6746.           {$ENDIF}
  6747.           {$IFDEF Win95}
  6748.           //SendMessage(Frame.Handle,WM_SETICON,ICON_BIG,FIcon);
  6749.           If ((FIcon=Nil)Or(FIcon.Empty)) Then SendMessage(Frame.Handle,WM_SETICON,ICON_SmalL,0)
  6750.           Else SendMessage(Frame.Handle,WM_SETICON,ICON_SMALL,FIcon.Handle);
  6751.           {$ENDIF}
  6752.      End;
  6753. End;
  6754.  
  6755.  
  6756. Procedure TForm.IconChanged(Sender:TObject);
  6757. Begin
  6758.      If TGraphic(Sender)=FIcon Then Icon:=TGraphic(Sender)
  6759.      Else TGraphic(Sender).FOnChangedNotify:=Nil;
  6760. End;
  6761.  
  6762.  
  6763. Function TForm.GetIcon:TGraphic;
  6764. Begin
  6765.      If FIcon = Nil Then
  6766.        If IconClass <> Nil Then
  6767.      Begin //Create Empty
  6768.           FIcon := TGraphic(IconClass.Create);
  6769.           FIcon.FIsLocalCopy := True;
  6770.      End;
  6771.      Result := FIcon;
  6772. End;
  6773.  
  6774.  
  6775. Procedure TForm.SetMainMenu(AMenu:TMainMenu);
  6776. {$IFDEF OS2}
  6777. Var  HMen:LongWord;
  6778. {$ENDIF}
  6779. Begin
  6780.      FMainMenu := AMenu;
  6781.  
  6782.      If FMainMenu <> Nil Then
  6783.      Begin
  6784.           //FMainMenu.ComponentIndex := 0;   {the First MainMenu Is Visible}
  6785.           If Handle <> 0 Then FMainMenu.Show
  6786.           Else FInitControls := True;
  6787.      End
  6788.      Else
  6789.      If FFrame <> Nil Then {Clear the main Menu}
  6790.      Begin
  6791.           {$IFDEF OS2}
  6792.           HMen := WinWindowFromID(FFrame.Handle,FID_MENU);
  6793.  
  6794.           If HMen <> 0 Then
  6795.           Begin
  6796.                WinSetParent(HMen,WinQueryObjectWindow(HWND_DESKTOP),False);
  6797.                WinSetOwner(HMen,WinQueryObjectWindow(HWND_DESKTOP));
  6798.                WinSendMsg(FFrame.Handle,WM_UPDATEFRAME,FCF_MENU,0);
  6799.           End;
  6800.           {$ENDIF}
  6801.           {$IFDEF Win32}
  6802.           SetMenu(FFrame.Handle,0);
  6803.           {$ENDIF}
  6804.      End;
  6805. End;
  6806.  
  6807. Procedure TForm.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
  6808. Begin
  6809.      Inherited MouseDown(Button,ShiftState,X,Y);
  6810.  
  6811.      BringToFront;
  6812. End;
  6813.  
  6814.  
  6815. Procedure TForm.SetFocus;
  6816. Begin
  6817.      Inherited SetFocus;
  6818.  
  6819.      If FFormStyle = fsMDIChild Then
  6820.        If Parent Is TForm Then TForm(Parent).FTopMDIChild := Self;
  6821. End;
  6822.  
  6823.  
  6824. Procedure TForm.Resize;
  6825. Begin
  6826.      Inherited Resize;
  6827.  
  6828.      {Make sure, that the Toolbars Do Not Draw over the Frame border}
  6829.      If IsWindowVisible Then
  6830.      Begin
  6831.           If ClientWidth < 1 Then  ClientWidth := 1;
  6832.           If ClientHeight < 1 Then ClientHeight := 1;
  6833.      End;
  6834. End;
  6835.  
  6836.  
  6837. Function TForm.GetFrameFlags:LongWord;
  6838. Type
  6839.     {Standard Frame Window styles}
  6840.     TFrameStyle=(wbsTitleBar, wbsSysMenu, wbsMenu, wbsTaskList,
  6841.                  wbsMinButton, wbsMaxButton, wbsHideButton,
  6842.                  wbsSizeBorder, wbsDlgBorder, wbsBorder,
  6843.                  wbsShellPosition, wbsNoMoveWithOwner,
  6844.                  wbsAutoIcon, wbsIcon, wbsAccelTable, wbsSysModal,
  6845.                  wbsNoByteAlign, wbsScreenAlign, wbsMouseAlign,wbsHelp);
  6846.     TFrameStyles=Set Of TFrameStyle;
  6847. Const
  6848.      {$IFDEF OS2}
  6849.      FrameFlags:Array[Low(TFrameStyle)..High(TFrameStyle)] Of LongWord=
  6850.              (FCF_TITLEBAR, FCF_SYSMENU, FCF_MENU, FCF_TASKLIST,
  6851.               FCF_MINBUTTON, FCF_MAXBUTTON, FCF_HIDEBUTTON,
  6852.               FCF_SIZEBORDER, FCF_DLGBORDER, FCF_BORDER,
  6853.               FCF_SHELLPOSITION, FCF_NOMOVEWITHOWNER{WS_EX_ABSPOSITION},
  6854.               FCF_AUTOICON, FCF_ICON, FCF_ACCELTABLE, FCF_SYSMODAL,
  6855.               FCF_NOBYTEALIGN, FCF_SCREENALIGN, FCF_MOUSEALIGN,0);
  6856.      {$ENDIF}
  6857.      {$IFDEF Win32}
  6858.      FrameFlags:Array[Low(TFrameStyle)..High(TFrameStyle)] Of LongWord=
  6859.              (WS_CAPTION, WS_SYSMENU, 0, 0,
  6860.               WS_MINIMIZEBOX, WS_MAXIMIZEBOX, 0,
  6861.               WS_THICKFRAME, WS_DLGFRAME OR DS_MODALFRAME, WS_BORDER,
  6862.               0,0,0,0,0,0,0,0,0,0);
  6863.      {$ENDIF}
  6864. Var  T:TFrameStyle;
  6865.      Flags:TFrameStyles;
  6866. Begin
  6867.      Result := 0;
  6868.      Flags := [wbsTitleBar,wbsTaskList,wbsNoByteAlign];
  6869.      If Designed Then
  6870.      Begin
  6871.           Flags := Flags + [wbsSizeBorder,wbsSysMenu{,wbsMinButton,wbsMaxButton}];
  6872.      End
  6873.      Else
  6874.      Begin
  6875.           Case FBorderStyle Of
  6876.             bsNone: ;
  6877.             bsSingle:   Include(Flags,wbsBorder);
  6878.             bsSizeable: Include(Flags,wbsSizeBorder);
  6879.             bsDialog: Include(Flags,wbsDlgBorder);
  6880.           End;
  6881.           If biSystemMenu In FBorderIcons Then Include(Flags,wbsSysMenu);
  6882.           If biMinimize In FBorderIcons Then Include(Flags,wbsMinButton);
  6883.           If biMaximize In FBorderIcons Then Include(Flags,wbsMaxButton);
  6884.           if biHelp in FBorderIcons then Include(Flags,wbsHelp);
  6885.      End;
  6886.  
  6887.      For T := Low(TFrameStyle) To High(TFrameStyle) Do
  6888.         If Flags * [T] <> [] Then Result := Result Or FrameFlags[T];
  6889.  
  6890.      {$IFDEF OS2}
  6891.      If FDBCSStatusLine Then Result := Result Or FCF_DBE_APPSTAT;
  6892.      {$ENDIF}
  6893. End;
  6894.  
  6895.  
  6896. Procedure TForm.SetWindowState(NewState:TWindowState);
  6897. Var  Win:LongWord;
  6898.      WinStyle:LongWord;
  6899.      {$IFDEF Win32}
  6900.      Placement:WINDOWPLACEMENT;
  6901.      {$ENDIF}
  6902. Begin
  6903.      FWindowState := NewState;
  6904.      If Designed Then Exit;
  6905.  
  6906.      If Frame = Nil Then Exit;
  6907.      Win := Frame.Handle;
  6908.      If Win = 0 Then Exit;
  6909.  
  6910.      {$IFDEF OS2}
  6911.      Case NewState Of
  6912.         wsNormal:    WinStyle := SWP_RESTORE;
  6913.         wsMinimized: WinStyle := SWP_MINIMIZE;
  6914.         wsMaximized: WinStyle := SWP_MAXIMIZE;
  6915.      End;
  6916.      WinSetWindowPos(Win,HWND_TOP,0,0,0,0,WinStyle);
  6917.      {$ENDIF}
  6918.  
  6919.      {$IFDEF Win32}
  6920.      Case NewState Of
  6921.         wsNormal:    WinStyle := SW_NORMAL;
  6922.         wsMinimized: WinStyle := SW_SHOWMINIMIZED;
  6923.         wsMaximized: WinStyle := SW_SHOWMAXIMIZED;
  6924.      End;
  6925.      FillChar(Placement,SizeOf(Placement),0);
  6926.      Placement.Length := SizeOf(WINDOWPLACEMENT);
  6927.      GetWindowPlacement(Win,Placement);
  6928.      Placement.ShowCmd := WinStyle;        {alten löschen?}
  6929.      SetWindowPlacement(Win,Placement);
  6930.      {$ENDIF}
  6931. End;
  6932.  
  6933.  
  6934. Function TForm.GetWindowState:TWindowState;
  6935. Var  Win:LongWord;
  6936.      WinStyle:LongWord;
  6937.      {$IFDEF Win32}
  6938.      Placement:WINDOWPLACEMENT;
  6939.      {$ENDIF}
  6940. Begin
  6941.      Result := FWindowState;
  6942.      If Designed Then Exit;
  6943.  
  6944.      If Frame = Nil Then Exit;
  6945.      Win := Frame.Handle;
  6946.      If Win = 0 Then Exit;
  6947.  
  6948.      {$IFDEF OS2}
  6949.      WinStyle := WinQueryWindowULong(Win,QWL_STYLE);
  6950.      If WinStyle And WS_MAXIMIZED <> 0 Then Result := wsMaximized
  6951.      Else
  6952.      If WinStyle And WS_MINIMIZED <> 0 Then Result := wsMinimized
  6953.      Else Result := wsNormal;
  6954.      {$ENDIF}
  6955.  
  6956.      {$IFDEF Win32}
  6957.      FillChar(Placement,SizeOf(Placement),0);
  6958.      Placement.Length := SizeOf(WINDOWPLACEMENT);
  6959.      GetWindowPlacement(Win,Placement);
  6960.      WinStyle := Placement.ShowCmd;
  6961.      If WinStyle = SW_SHOWMAXIMIZED Then Result := wsMaximized
  6962.      Else
  6963.      If WinStyle = SW_SHOWMINIMIZED Then Result := wsMinimized
  6964.      Else Result := wsNormal;
  6965.      {$ENDIF}
  6966. End;
  6967.  
  6968.  
  6969. Procedure TForm.SetBorderIcons(NewIcons:TBorderIcons);
  6970. Begin
  6971.      If (Handle = 0) Or Designed Then FBorderIcons := NewIcons;
  6972. End;
  6973.  
  6974.  
  6975. Procedure TForm.SetBorderStyle(NewStyle:TFormBorderStyle);
  6976. Begin
  6977.      If (Handle = 0) Or Designed Then FBorderStyle := NewStyle;
  6978. End;
  6979.  
  6980.  
  6981. Function TForm.GetTabOrder:LongInt;
  6982. Begin
  6983.      Result := -1;
  6984. End;
  6985.  
  6986. Procedure TForm.SetDBCSStatusLine(Value:Boolean);
  6987. Begin
  6988.      If Handle = 0 Then FDBCSStatusLine := Value;
  6989. End;
  6990.  
  6991.  
  6992. Function TForm.GetAddWidth:LongInt;
  6993. Begin
  6994.      Result := GetBorderWidth(Self);
  6995.  
  6996.      Inc(Result,Result);
  6997.  
  6998.      Inc(Result,GetLeftRightWidth(Self));
  6999. End;
  7000.  
  7001.  
  7002. Function TForm.GetAddHeight:LongInt;
  7003. Begin
  7004.      Result := GetBorderHeight(Self);
  7005.  
  7006.      Inc(Result,Result);
  7007.  
  7008.      If FMainMenu <> Nil Then
  7009.      Begin
  7010.           If FMainMenu.Handle <> 0 Then Inc(Result,FMainMenu.Height)
  7011.           Else Inc(Result,Screen.SystemMetrics(smCyMenu));
  7012.      End
  7013.      Else If ComponentState*[csHasMainMenu]<>[] Then
  7014.      Begin
  7015.           Inc(Result,Screen.SystemMetrics(smCyMenu));
  7016.      End;
  7017.  
  7018.      Inc(Result,Screen.SystemMetrics(smCyTitlebar));
  7019.  
  7020.      Inc(Result,GetTopBottomHeight(Self));
  7021.  
  7022.      If FDBCSStatusLine Then Inc(Result,DBCSStatusLineHeight);
  7023. End;
  7024.  
  7025.  
  7026. Function _GetAddWidth_(Form:TForm):LongInt;
  7027. Begin
  7028.      Result:=Form.GetAddWidth;
  7029. End;
  7030.  
  7031. Function _GetAddHeight_(Form:TForm):LongInt;
  7032. Begin
  7033.      Result:=Form.GetAddHeight;
  7034. End;
  7035.  
  7036.  
  7037. Function TForm.GetClientRect:TRect;
  7038. Begin
  7039.      Result := Inherited GetClientRect;
  7040.  
  7041.      If Handle = 0 Then
  7042.      Begin
  7043.           Dec(Result.Right, GetAddWidth);
  7044.           Dec(Result.Top, GetAddHeight);
  7045.      End;
  7046. End;
  7047.  
  7048.  
  7049. Procedure TForm.SetClientWidth(NewWidth:LongInt);
  7050. Begin
  7051.      Inc(NewWidth, GetAddWidth);
  7052.  
  7053.      Inherited SetClientWidth(NewWidth);
  7054. End;
  7055.  
  7056.  
  7057. Procedure TForm.SetClientHeight(NewHeight:LongInt);
  7058. Begin
  7059.      Inc(NewHeight, GetAddHeight);
  7060.  
  7061.      Inherited SetClientHeight(NewHeight);
  7062. End;
  7063.  
  7064.  
  7065. Function TForm.GetClientOrigin:TPoint;
  7066. Var List:TList;
  7067.     T:LongInt;
  7068.     Toolbar:TToolbar;
  7069. Begin
  7070.      Result := Inherited GetClientOrigin;
  7071.  
  7072.      Case FBorderStyle Of
  7073.        bsSingle:
  7074.        Begin
  7075.             Inc(Result.X, Screen.SystemMetrics(smCxBorder));
  7076.             Inc(Result.Y, Screen.SystemMetrics(smCyBorder));
  7077.        End;
  7078.        bsSizeable:
  7079.        Begin
  7080.             Inc(Result.X, Screen.SystemMetrics(smCxSizeBorder));
  7081.             Inc(Result.Y, Screen.SystemMetrics(smCySizeBorder));
  7082.        End;
  7083.        bsDialog:
  7084.        Begin
  7085.             Inc(Result.X, Screen.SystemMetrics(smCxDlgBorder));
  7086.             Inc(Result.Y, Screen.SystemMetrics(smCyDlgBorder));
  7087.        End;
  7088.      End;
  7089.  
  7090.      List:=FToolBarLists[tbLeft];
  7091.      If List<>Nil Then For T:=0 To List.Count-1 Do
  7092.      Begin
  7093.           Toolbar:=TToolbar(List[T]);
  7094.           If Toolbar.FVisible Then Inc(Result.X,Toolbar.Size);
  7095.      End;
  7096.  
  7097.      List:=FToolBarLists[tbBottom];
  7098.      If List<>Nil Then For T:=0 To List.Count-1 Do
  7099.      Begin
  7100.           Toolbar:=TToolbar(List[T]);
  7101.           If Toolbar.FVisible Then Inc(Result.Y,Toolbar.Size);
  7102.      End;
  7103.  
  7104.      If FDBCSStatusLine Then Inc(Result.Y,DBCSStatusLineHeight);
  7105. End;
  7106.  
  7107.  
  7108. Procedure TForm.RealignControls;
  7109. Var  Control:TControl;
  7110.      T,I:LongInt;
  7111.      LastFocus:TForm;
  7112. Begin
  7113.      Inherited RealignControls;
  7114.  
  7115.      {Align MDI Child windows again}
  7116.      If FMDIChildren = Nil Then Exit;
  7117.  
  7118.      LastFocus := FTopMDIChild;
  7119.      If LastFocus <> Nil Then
  7120.      Begin
  7121.           I := FMDIChildren.Remove(LastFocus);
  7122.           FMDIChildren.Add(LastFocus);
  7123.      End;
  7124.  
  7125.      If FMDIChildren <> Nil Then
  7126.      For T := 0 To FMDIChildren.Count-1 Do
  7127.      Begin
  7128.           Control := FMDIChildren.Items[T];
  7129.           If IsControl(Control) Then
  7130.             If (Control.XAlign In [xaLeft,xaRight,xaCenter]) Or
  7131.                (Control.YAlign In [yaBottom,yaTop,yaCenter]) Or
  7132.                (Control.XStretch In [xsParent,xsFrame,xsScale]) Or
  7133.                (Control.YStretch In [ysParent,ysFrame,ysScale]) Then
  7134.           Begin
  7135.                Control.SetWindowPos(Control.Left,Control.Bottom,
  7136.                                     Control.Width,Control.Height);
  7137.           End;
  7138.      End;
  7139.  
  7140.      If LastFocus <> Nil Then      {back To original Position}
  7141.        If I >= 0 Then FMDIChildren.Move(FMDIChildren.Count-1,I);
  7142. End;
  7143.  
  7144.  
  7145. Procedure TForm.AlignToolBars;
  7146. {$IFDEF Win32}
  7147. Var  T:TToolbarAlign;
  7148.      ToolBar:TToolBar;
  7149.      t1,t2:LongInt;
  7150.      List:TList;
  7151.      rc,rc1:TRect;
  7152.      _Left,_Bottom,_Width,_Height:LongInt;
  7153.      TheBottom,TheLeft,TheTop,TheRight:LongInt;
  7154.      MaxLeft,MaxRight,MaxBottom,MaxTop:LongInt;
  7155.  
  7156.      Procedure AlignToolBar(ToolBar:TToolBar);
  7157.      Begin
  7158.         If Toolbar.FVisible Then
  7159.         Begin
  7160.              Case t Of
  7161.                 tbTop:
  7162.                 Begin
  7163.                      Toolbar.FLeft:=rc.Left-MaxLeft;
  7164.                      Toolbar.FBottom:=TheTop;
  7165.                      Toolbar.FWidth:=(rc.Right+1-rc.Left)+MaxLeft+MaxRight;
  7166.                      Toolbar.FHeight:=Toolbar.Size;
  7167.                      Inc(TheTop,Toolbar.Size);
  7168.                End;
  7169.                tbBottom:
  7170.                Begin
  7171.                     Toolbar.FLeft:=rc.Left-MaxLeft;
  7172.                     Toolbar.FBottom:=TheBottom;
  7173.                     Toolbar.FWidth:=(rc.Right+1-rc.Left)+MaxLeft+MaxRight;
  7174.                     Toolbar.FHeight:=Toolbar.Size;
  7175.                     inc(TheBottom,Toolbar.Size);
  7176.                End;
  7177.                tbLeft:
  7178.                Begin
  7179.                     Toolbar.FLeft:=rc.Left-MaxLeft+TheLeft;
  7180.                     Toolbar.FBottom:=MaxTop;
  7181.                     Toolbar.FWidth:=Toolbar.Size;
  7182.                     Toolbar.FHeight:=(rc.Top+1-rc.Bottom);
  7183.                     Inc(TheLeft,Toolbar.Size);
  7184.                End;
  7185.                tbRight:
  7186.                Begin
  7187.                     Toolbar.FLeft:=rc.Right+1+TheRight-Toolbar.Size;
  7188.                     Toolbar.FBottom:=MaxTop;
  7189.                     Toolbar.FWidth:=Toolbar.Size;
  7190.                     Toolbar.FHeight:=(rc.Top+1-rc.Bottom);
  7191.                     Dec(TheRight,Toolbar.Size);
  7192.                End;
  7193.              End; {Case}
  7194.  
  7195.              If Toolbar.Handle <> 0
  7196.              Then WinUser.SetWindowPos(Toolbar.Handle,0,
  7197.                                        Toolbar.FLeft,
  7198.                                        Toolbar.FBottom,
  7199.                                        Toolbar.FWidth,
  7200.                                        Toolbar.FHeight,
  7201.                                        SWP_SHOWWINDOW);
  7202.         End; //If Toolbar.FVisible
  7203.  
  7204.      End;
  7205. {$ENDIF}
  7206. Begin
  7207.      If Frame = Nil Then Exit;
  7208.      If Frame.Handle = 0 Then Exit;
  7209.  
  7210.      {$IFDEF Win32}
  7211.      rc := Frame.GetClientRect;
  7212.  
  7213.      MaxLeft:=0;
  7214.      List:=FToolBarLists[tbLeft];
  7215.      If List<>Nil Then For t1:=0 To List.Count-1 Do
  7216.      Begin
  7217.           Toolbar:=TToolbar(List[t1]);
  7218.           If Toolbar.FVisible Then Inc(MaxLeft,Toolbar.Size);
  7219.      End;
  7220.  
  7221.      MaxRight:=0;
  7222.      List:=FToolBarLists[tbRight];
  7223.      If List<>Nil Then For t1:=0 To List.Count-1 Do
  7224.      Begin
  7225.           Toolbar:=TToolbar(List[t1]);
  7226.           If Toolbar.FVisible Then Inc(MaxRight,Toolbar.Size);
  7227.      End;
  7228.  
  7229.      MaxBottom:=0;
  7230.      List:=FToolBarLists[tbBottom];
  7231.      If List<>Nil Then For t1:=0 To List.Count-1 Do
  7232.      Begin
  7233.           Toolbar:=TToolbar(List[t1]);
  7234.           If Toolbar.FVisible Then Inc(MaxBottom,Toolbar.Size);
  7235.      End;
  7236.  
  7237.      MaxTop:=0;
  7238.      List:=FToolBarLists[tbTop];
  7239.      If List<>Nil Then For t1:=0 To List.Count-1 Do
  7240.      Begin
  7241.           Toolbar:=TToolbar(List[t1]);
  7242.           If Toolbar.FVisible Then Inc(MaxTop,Toolbar.Size);
  7243.      End;
  7244.  
  7245.      //windows coordinates Grow from Top To Bottom !
  7246.      TheBottom:=(rc.Top+1-rc.Bottom)+MaxTop;
  7247.      TheTop:=0;
  7248.      TheLeft:=0;
  7249.      TheRight:=MaxRight;
  7250.  
  7251.      //zuerst Top und Bottom !
  7252.      For t := High(TToolbarAlign) Downto Low(TToolbarAlign) Do
  7253.      Begin
  7254.           List:=FToolBarLists[t];
  7255.  
  7256.           If List=Nil Then continue;
  7257.  
  7258.           If t=tbBottom Then
  7259.           Begin
  7260.                For t2:=List.Count-1 DownTo 0 Do AlignToolBar(TToolBar(List[t2]));
  7261.           End
  7262.           Else
  7263.           Begin
  7264.                For t2:=0 To List.Count-1 Do AlignToolBar(TToolBar(List[t2]));
  7265.           End;
  7266.      End;
  7267.  
  7268.      {ClientBereich}
  7269.      If Handle = 0 Then Exit;
  7270.      WinUser.GetClientRect(Frame.Handle,RECTL(rc1));
  7271.      rc := Frame.GetClientRect;
  7272.      _Width := rc.Right-rc.Left+1;
  7273.      _Height := rc.Top-rc.Bottom+1;
  7274.      _Left := rc.Left;
  7275.      _Bottom := ((rc1.Top-rc1.Bottom)-_Height)-rc.Bottom;
  7276.      WinUser.SetWindowPos(Handle,0,_Left,_Bottom,_Width,_Height, SWP_SHOWWINDOW);
  7277.      {$ENDIF}
  7278.  
  7279.      {$IFDEF OS2}
  7280.      WinSendMsg(Frame.Handle, WM_UPDATEFRAME, GetFrameFlags, 0);
  7281.      {$ENDIF}
  7282. End;
  7283.  
  7284.  
  7285. Procedure TForm.SetWindowPos(NewLeft,NewBottom,NewWidth,NewHeight:LongInt);
  7286. Begin
  7287.      If FFrame <> Nil Then
  7288.      Begin
  7289.           FFrame.SetWindowPos(NewLeft,NewBottom,NewWidth,NewHeight);
  7290.           {$IFDEF OS2}
  7291.           FLeft := Frame.FLeft;
  7292.           FBottom := Frame.FBottom;
  7293.           FWidth := Frame.FWidth;
  7294.           FHeight := Frame.FHeight;
  7295.           {$ENDIF}
  7296.           Exit;
  7297.      End;
  7298.      Inherited SetWindowPos(NewLeft,NewBottom,NewWidth,NewHeight);
  7299. End;
  7300.  
  7301.  
  7302. {$HINTS OFF}
  7303. Procedure TForm.MDIActivate(Child:TForm);
  7304. Begin
  7305.      If OnMDIActivate <> Nil Then OnMDIActivate(Self,Child);
  7306. End;
  7307.  
  7308.  
  7309. Procedure TForm.MDIDeactivate(Child:TForm);
  7310. Begin
  7311.      If OnMDIDeactivate <> Nil Then OnMDIDeactivate(Self,Child);
  7312. End;
  7313. {$HINTS ON}
  7314.  
  7315.  
  7316. Function TForm.GetMDIChildCount:LongInt;
  7317. Begin
  7318.      If FMDIChildren = Nil Then Result := 0
  7319.      Else Result := FMDIChildren.Count;
  7320. End;
  7321.  
  7322.  
  7323. Function TForm.GetMDIChild(AIndex:LongInt):TForm;
  7324. Begin
  7325.      Result := Nil;
  7326.      If FMDIChildren = Nil Then Exit;
  7327.      If (AIndex < 0) Or (AIndex > FMDIChildren.Count-1) Then Exit;
  7328.      Result := FMDIChildren.Items[AIndex];
  7329. End;
  7330.  
  7331.  
  7332. Procedure TForm.InsertMDIChild(Child:TForm);
  7333. Var  rc:TRect;
  7334. Begin
  7335.      Child.FParent := Self;
  7336.      ListAdd(FMDIChildren, Child);
  7337.      If FMDIChildren.Count = 1 Then FTopMDIChild := Child;
  7338.  
  7339.      If (Child.FWidth = 0) Or (Child.FHeight = 0) Then
  7340.      Begin
  7341.           rc := GetTileCascadeRect;
  7342.           Child.FLeft := rc.Left;
  7343.           Child.FBottom := rc.Bottom;
  7344.           Child.FWidth := rc.Right - rc.Left;
  7345.           Child.FHeight := rc.Top - rc.Bottom;
  7346.      End;
  7347.  
  7348.      If Handle <> 0 Then
  7349.      Begin
  7350.           Child.CreateWnd;
  7351.           If Child.FVisible Or Child.Designed Then Child.Show;
  7352.      End
  7353.      Else FInitControls := True;
  7354. End;
  7355.  
  7356.  
  7357. Procedure TForm.RemoveMDIChild(Child:TForm);
  7358. Begin
  7359.      ListRemove(FMDIChildren, Child);
  7360.  
  7361.      If FTopMDIChild = Child Then FTopMDIChild := Nil;
  7362. End;
  7363.  
  7364.  
  7365. Procedure TForm.CreateUniqueWindowId(AChild:TControl);
  7366. Begin
  7367.      If AChild <> Nil Then
  7368.      Begin
  7369.           AChild.FWindowId := FInternalWindowIdCount;
  7370.           Inc(FInternalWindowIdCount);
  7371.      End;
  7372. End;
  7373.  
  7374.  
  7375. Procedure TForm.CreateControls;
  7376. Var  AForm:TForm;
  7377.      I:LongInt;
  7378. Begin
  7379.      If Not FInitControls Then Exit;
  7380.  
  7381.      Inherited CreateControls;
  7382.  
  7383.      If FMainMenu <> Nil Then
  7384.        If FFrame <> Nil Then FMainMenu.Show;
  7385.  
  7386.      For I := 0 To MDIChildCount-1 Do
  7387.      Begin
  7388.           AForm := MDIChildren[I];
  7389.           AForm.CreateWnd;
  7390.           If AForm.FVisible Or AForm.Designed Then AForm.Show;
  7391.      End;
  7392. End;
  7393.  
  7394.  
  7395. Procedure TForm.SetFormStyle(Value:TFormStyle);
  7396. Var  OldStyle:TFormStyle;
  7397.      P:LongInt;
  7398. Begin
  7399.      If Value <> FFormStyle Then
  7400.      Begin
  7401.           If ComponentState * [csReading] = [] Then
  7402.           Case Value Of
  7403.             fsMDIForm: color := clAppWorkSpace;
  7404.             fsMDIChild: color := clWindow;
  7405.             fsNormal: ;
  7406.           End;
  7407.  
  7408.           If (Value = fsMDIChild) And (Position = poDesigned)
  7409.           Then Position := poDefault;
  7410.  
  7411.           OldStyle := FFormStyle;
  7412.           If (OldStyle = fsMDIChild) Or (Value = fsMDIChild) Then
  7413.             If Parent Is TForm Then  {Update contents Of the lists}
  7414.             Begin {but only If already in a List}
  7415.                  If OldStyle = fsMDIChild
  7416.                  Then P := ListFind(TForm(Parent).FMDIChildren,Self)
  7417.                  Else P := ListFind(Parent.FControls,Self);
  7418.  
  7419.                  If P >= 0 Then {was already inserted}
  7420.                  Begin
  7421.                       Parent.RemoveControl(Self);
  7422.                       FFormStyle := Value;
  7423.                       Parent.InsertControl(Self);
  7424.                  End;
  7425.             End;
  7426.           FFormStyle := Value;
  7427.      End;
  7428. End;
  7429.  
  7430.  
  7431. Procedure TForm.BringToFront;
  7432. Var  Flags:LongWord;
  7433. Begin
  7434.      If FLocked Then Exit;
  7435.  
  7436.      {$IFDEF OS2}
  7437.      If Frame <> Nil Then
  7438.      Begin
  7439.           If {F}Visible Then Flags := SWP_SHOW
  7440.           Else Flags := 0;
  7441.           WinSetWindowPos(Frame.Handle,HWND_TOP,0,0,0,0,
  7442.                           Flags Or SWP_ZORDER Or SWP_ACTIVATE); {? NoFocus}
  7443.      End;
  7444.      {$ENDIF}
  7445.      {$IFDEF Win32}
  7446.      If Frame <> Nil Then
  7447.      Begin
  7448.           If Parent <> Nil Then SendMessage(GetTopWindow(Parent.Handle),
  7449.                                             WM_NCACTIVATE,0,0);
  7450.           If {F}Visible Then Flags := SWP_SHOWWINDOW
  7451.           Else Flags := 0;
  7452.           WinUser.SetWindowPos(Frame.Handle,HWND_TOP,0,0,0,0,
  7453.                                Flags Or SWP_NOMOVE Or SWP_NOSIZE);
  7454.           SendMessage(Frame.Handle,WM_NCACTIVATE,1,0);  {? NoFocus}
  7455.           SetForeGroundWindow(Handle);
  7456.      End;
  7457.      {$ENDIF}
  7458. End;
  7459.  
  7460.  
  7461.  
  7462. Procedure TForm.RemoveComponent(AComponent:TComponent);
  7463. Begin
  7464.      Inherited RemoveComponent(AComponent);
  7465.  
  7466.      If AComponent = FMainMenu Then FMainMenu := Nil;
  7467. End;
  7468.  
  7469.  
  7470. Procedure TForm.InsertControl(AChild:TControl);
  7471. Var  Toolbar:TToolbar;
  7472. Begin
  7473.      If AChild Is TForm Then
  7474.        If TForm(AChild).FormStyle = fsMDIChild Then
  7475.          If FormStyle = fsMDIForm Then
  7476.          Begin
  7477.               InsertMDIChild(TForm(AChild));
  7478.               Exit;
  7479.          End;
  7480.  
  7481.      Inherited InsertControl(AChild);
  7482.  
  7483.      If AChild.FIsToolBar Then
  7484.      Begin
  7485.           Toolbar := TToolbar(AChild);
  7486.  
  7487.           ListAdd(FToolBarLists[Toolbar.Alignment], Toolbar);
  7488.  
  7489.           If Handle <> 0 Then
  7490.           Begin
  7491.                Toolbar.CreateWnd;
  7492.                Toolbar.Show;
  7493.                AlignToolBars;
  7494.           End;
  7495.      End;
  7496. End;
  7497.  
  7498.  
  7499. Procedure TForm.RemoveControl(AChild:TControl);
  7500. Var  Toolbar:TToolbar;
  7501. Begin
  7502.      If FFormStyle = fsMDIForm Then
  7503.        If AChild Is TForm Then
  7504.          If TForm(AChild).FFormStyle = fsMDIChild
  7505.            Then RemoveMDIChild(TForm(AChild));
  7506.  
  7507.      Inherited RemoveControl(AChild);    {Destroy the Handle}
  7508.  
  7509.      If AChild.FIsToolBar Then
  7510.      Begin
  7511.           Toolbar := TToolbar(AChild);
  7512.  
  7513.           ListRemove(FToolBarLists[Toolbar.Alignment], Toolbar);
  7514.           AlignToolBars;
  7515.      End;
  7516. End;
  7517.  
  7518.  
  7519. Procedure GenerateShortCuts(AForm:TForm);
  7520. {$IFDEF OS2}
  7521. Var
  7522.      T,t1:LongInt;
  7523.      dummy,dummy1:PAccelItem;
  7524.      Temp:LongWord;
  7525.      CH:Char;
  7526.      aAccel:PAccelTable;
  7527. Const
  7528.      _CHAR_=$0001;
  7529.      _VIRTUALKEY_=$0002;
  7530.      _SCANCODE_=$0004;
  7531.      _SHIFT_=$0008;
  7532.      _CONTROL_=$0010;
  7533.      _ALT_=$0020;
  7534.      _LONEKEY_=$0040;
  7535.      _SYSCOMMAND_=$0100;
  7536.      _HELP_=$0200;
  7537. Type PCharAccels=^TCharAccels;
  7538.      TCharAccels=Record
  7539.                        dummy:PAccelItem;
  7540.                        Next:PCharAccels;
  7541.                  End;
  7542. Var  CharAccels,TempCharAccel:PCharAccels;
  7543. Label weiter;
  7544. {$ENDIF}
  7545. Begin
  7546.      If AForm.Frame=Nil Then Exit;
  7547.      If AForm.Frame.Handle=0 Then Exit;
  7548.  
  7549.      {$IFDEF OS2}
  7550.      If AForm.FAccel<>0 Then
  7551.      Begin
  7552.           WinSetAccelTable(AppHandle,0,AForm.Frame.Handle);  //Erase old
  7553.           WinDestroyAccelTable(AForm.FAccel);
  7554.           AForm.FAccel:=0;
  7555.      End;
  7556.  
  7557.      If AForm.FAccelList=Nil Then Exit;
  7558.  
  7559.      CharAccels:=Nil;
  7560.      For T:=0 To AForm.FAccelList.Count-1 Do
  7561.      Begin
  7562.           dummy:=AForm.FAccelList.Items[T];
  7563.           If dummy^.KeyCode And kb_Char<>0 Then
  7564.           Begin
  7565.                Temp:=dummy^.KeyCode And 255;
  7566.                CH:=Chr(Temp);
  7567.                If UpCase(CH) In ['A'..'Z'] Then  //Add also uppercase/lowercase Version Of accel
  7568.                Begin
  7569.                    If CH=UpCase(CH) Then
  7570.                    Begin
  7571.                        //check lowercase Version
  7572.                        CH:=Chr(Ord(CH)+32);
  7573.                    End
  7574.                    Else
  7575.                    Begin
  7576.                        //Insert uppercase Version
  7577.                        CH:=Chr(Ord(CH)-32);
  7578.                    End;
  7579.  
  7580.                    //look If the ShortCut Is already present
  7581.                    For t1:=0 To AForm.FAccelList.Count-1 Do
  7582.                    Begin
  7583.                         dummy1:=AForm.FAccelList.Items[t1];
  7584.                         If dummy1^.KeyCode And kb_Char<>0 Then
  7585.                           If (dummy1^.KeyCode And Not 255)=(dummy^.KeyCode And Not 255) Then
  7586.                             If (dummy1^.KeyCode And 255)=Ord(CH) Then Goto weiteR;
  7587.                    End;
  7588.  
  7589.                    If CharAccels=Nil Then
  7590.                    Begin
  7591.                         New(CharAccels);
  7592.                         TempCharAccel:=CharAccels;
  7593.                         TempCharAccel^.Next:=Nil;
  7594.                    End
  7595.                    Else
  7596.                    Begin
  7597.                         New(TempCharAccel);
  7598.                         TempCharAccel^.Next:=CharAccels;
  7599.                         CharAccels:=TempCharAccel;
  7600.                    End;
  7601.                    TempCharAccel^.dummy:=dummy;
  7602.                End;
  7603. weiter:
  7604.           End;
  7605.      End;
  7606.  
  7607.      While CharAccels<>Nil Do
  7608.      Begin
  7609.           New(dummy);
  7610.           dummy^:=CharAccels^.dummy^;
  7611.           CH:=Chr(dummy^.KeyCode And 255);
  7612.           dummy^.KeyCode:=dummy^.KeyCode And Not 255;
  7613.           If CH=UpCase(CH) Then
  7614.           Begin
  7615.                //Insert lowercase Version
  7616.                dummy^.KeyCode:=dummy^.KeyCode Or (Ord(CH)+32);
  7617.           End
  7618.           Else
  7619.           Begin
  7620.                //Insert uppercase Version
  7621.                dummy^.KeyCode:=dummy^.KeyCode Or(Ord(CH)-32);
  7622.           End;
  7623.           AForm.FAccelList.Add(dummy);
  7624.           TempCharAccel:=CharAccels^.Next;
  7625.           Dispose(CharAccels);
  7626.           CharAccels:=TempCharAccel;
  7627.      End;
  7628.  
  7629.      GetMem(aAccel,(AForm.FAccelList.Count*SizeOf(accel))+4);
  7630.      aAccel^.cAccel:=AForm.FAccelList.Count;
  7631.      aAccel^.codepage:=0;
  7632.  
  7633.      For T:=0 To AForm.FAccelList.Count-1 Do
  7634.      Begin
  7635.           dummy:=AForm.FAccelList.Items[T];
  7636.           With aAccel^.aAccel[T] Do
  7637.           Begin
  7638.                fs:=0;
  7639.                Temp:=dummy^.KeyCode And 255;
  7640.                If dummy^.KeyCode And kb_VK<>0 Then fs:=fs Or _VIRTUALKEY_;
  7641.                If dummy^.KeyCode And kb_Ctrl<>0 Then fs:=fs Or _CONTROL_;
  7642.                If dummy^.KeyCode And kb_Shift<>0 Then fs:=fs Or _SHIFT_;
  7643.                If dummy^.KeyCode And kb_Alt<>0 Then fs:=fs Or _ALT_;
  7644.                If dummy^.KeyCode And kb_Char<>0 Then fs:=fs Or _CHAR_;
  7645.                If fs=0 Then fs:=_CHAR_;
  7646.                key:=Temp;
  7647.                cmd:=dummy^.Command;
  7648.           End;
  7649.      End;
  7650.  
  7651.      AForm.FAccel:=WinCreateAccelTable(AppHandle,aAccel^);
  7652.      If AForm.FAccel<>0
  7653.      Then WinSetAccelTable(AppHandle,AForm.FAccel,AForm.Frame.Handle); //Set New
  7654.  
  7655.      FreeMem(aAccel,(AForm.FAccelList.Count*SizeOf(accel))+4);
  7656.      {$ENDIF}
  7657. End;
  7658.  
  7659.  
  7660. Procedure TForm.AddShortCut(KeyCode:TKeyCode;Command:TCommand);
  7661. Var  dummy:PAccelItem;
  7662.      T:LongInt;
  7663. Begin
  7664.      If Command=cmNull Then Exit;
  7665.  
  7666.      If FAccelList<>Nil Then
  7667.      Begin
  7668.           For T:=0 To FAccelList.Count-1 Do
  7669.           Begin
  7670.                dummy:=FAccelList.Items[T];
  7671.                If dummy^.KeyCode=KeyCode Then Exit;  //no Duplicates !
  7672.           End;
  7673.      End
  7674.      Else FAccelList.Create;
  7675.  
  7676.      New(dummy);
  7677.      dummy^.KeyCode:=KeyCode;
  7678.      dummy^.Command:=Command;
  7679.  
  7680.      FAccelList.Add(dummy);
  7681.  
  7682.      If Frame<>Nil Then
  7683.        If Frame.Handle<>0 Then
  7684.          If FShortCutsEnabled Then GenerateShortCuts(Self);
  7685. End;
  7686.  
  7687.  
  7688. Procedure TForm.DeleteShortCut(KeyCode:TKeyCode);
  7689. Var  dummy:PAccelItem;
  7690.      T:LongInt;;
  7691.      ACommand:TCommand;
  7692. Begin
  7693.      If FAccelList = Nil Then Exit;
  7694.  
  7695.      ACommand := -1;
  7696.      For T := FAccelList.Count-1 Downto 0 Do
  7697.      Begin
  7698.           dummy := FAccelList.Items[T];
  7699.           If (dummy^.KeyCode=KeyCode) Or (dummy^.Command=ACommand) Then
  7700.           Begin
  7701.                ACommand := dummy^.Command;
  7702.                FAccelList.Remove(dummy);
  7703.                Dispose(dummy);
  7704.           End;
  7705.      End;
  7706.  
  7707.      If FAccelList.Count = 0 Then
  7708.      Begin
  7709.           FAccelList.Destroy;
  7710.           FAccelList := Nil;
  7711.      End;
  7712.  
  7713.      If Frame <> Nil Then
  7714.        If Frame.Handle <> 0 Then
  7715.          If FShortCutsEnabled Then GenerateShortCuts(Self);
  7716. End;
  7717.  
  7718.  
  7719. Procedure TForm.SetShortCutsEnabled(Value:Boolean);
  7720. Begin
  7721.      If Not FShortCutsEnabled Then
  7722.        If Value Then GenerateShortCuts(Self);
  7723.      FShortCutsEnabled := Value;
  7724. End;
  7725.  
  7726. Procedure TForm.DismissDlg(Result:TCommand);
  7727. Begin
  7728.      If FModalShowing Then
  7729.      Begin
  7730.           FModalResult := Result;
  7731.           If OnDismissDlg <> Nil Then OnDismissDlg(Self);
  7732.           If FModalResult <> cmNull Then EndModalState;
  7733.      End;
  7734. End;
  7735.  
  7736.  
  7737. Procedure TForm.CMEndModalState(Var Msg:TMessage);
  7738. Var  AParent:TControl;
  7739. Begin
  7740.      If FIsModal Then AParent:=FModalParent
  7741.      Else AParent:=Nil;
  7742.  
  7743.      {$IFDEF Win32}
  7744.      If AParent<>Nil Then
  7745.      Begin
  7746.           {If AParent.FFrame<>Nil
  7747.           Then SetForeGroundWindow(AParent.FFrame.Handle)
  7748.           Else SetForeGroundWindow(AParent.Handle);}
  7749.      End;
  7750.  
  7751.      //DestroyHandle;
  7752.      {$ENDIF}
  7753.      {$IFDEF OS2}
  7754.      If AParent<>Nil Then
  7755.      Begin
  7756.           If AParent.FFrame<>Nil
  7757.           Then WinSetActiveWindow(HWND_DESKTOP,AParent.FFrame.Handle)
  7758.           Else WinSetActiveWindow(HWND_DESKTOP,AParent.Handle);
  7759.      End;
  7760.  
  7761.      DestroyHandle;
  7762.      {$ENDIF}
  7763.  
  7764.      FModalShowing := False;
  7765.      Msg.Handled:=True;
  7766. End;
  7767.  
  7768. Procedure TForm.EndModalState;
  7769. Begin
  7770.      PostMsg(Handle,CM_ENDMODALSTATE,0,0);
  7771. End;
  7772.  
  7773.  
  7774. Procedure TForm.Close;
  7775. Var  Action:TCloseAction;
  7776.      i:LongInt;
  7777. Begin
  7778.      If CloseQuery Then
  7779.      Begin
  7780.           {If FFormStyle = fsMDIChild Then Action := caMinimize
  7781.           Else} Action := caFree; {!! caHide?}
  7782.  
  7783.           If dsAutoCreate In DesignerState Then Action := caFreeHandle;
  7784.  
  7785.           If FOnClose <> Nil Then FOnClose(Self, Action);
  7786.  
  7787.           If Action = caNone Then Exit;
  7788.  
  7789.           If FModalShowing Then
  7790.           Begin
  7791.                DismissDlg(cmCancel);
  7792.                Exit;
  7793.           End;
  7794.  
  7795.           If Application.MainForm = Self Then
  7796.           Begin
  7797.                {$IFDEF OS2}
  7798.                If ModalList <> Nil Then
  7799.                  For i := 0 To ModalList.Count-1
  7800.                   Do TForm(ModalList[i]).EndModalState;
  7801.                {$ENDIF}
  7802.  
  7803.                Application.FTerminate:=True;
  7804.                {$IFDEF WIN32}
  7805.                Application.Terminate;
  7806.                {$ENDIF}
  7807.                Release;
  7808.                Exit;
  7809.           End;
  7810.  
  7811.           Case Action Of
  7812.             caHide: Hide;
  7813.             caFree: Release;  {Post Destroy}
  7814.             caMinimize: WindowState := wsMinimized;
  7815.             caFreeHandle: DestroyHandle;
  7816.           End;
  7817.      End;
  7818. End;
  7819.  
  7820.  
  7821. Function TForm.CloseQuery:Boolean;
  7822. Var  T:LongInt;
  7823.      Form:TForm;
  7824. Begin
  7825.      Result := False;
  7826.  
  7827.      For T := 0 To ControlCount-1 Do
  7828.      Begin
  7829.           Form := TForm(Controls[T]);
  7830.           If Form Is TForm Then
  7831.           Begin
  7832.             If Not Form.CloseQuery Then Exit;
  7833.           End
  7834.           Else
  7835.           Begin
  7836.             If Form.OnCloseQuery<>Nil Then
  7837.             Begin
  7838.                  Form.OnCloseQuery(Form,Result);
  7839.                  If not Result Then exit;
  7840.             End;
  7841.           End;
  7842.      End;
  7843.  
  7844.      If FMDIChildren <> Nil Then
  7845.      Begin
  7846.           For T := 0 To FMDIChildren.Count-1 Do
  7847.           Begin
  7848.                Form := FMDIChildren.Items[T];
  7849.                If Form Is TForm Then
  7850.                  If Not Form.CloseQuery Then Exit;
  7851.           End;
  7852.      End;
  7853.      Result := True;
  7854.  
  7855.      If OnCloseQuery <> Nil Then OnCloseQuery(Self,Result);
  7856. End;
  7857.  
  7858.  
  7859. Destructor TForm.Destroy;
  7860. Var  dummy:PAccelItem;
  7861.      T:LongInt;
  7862. Begin
  7863.      If FOnDestroy <> Nil Then FOnDestroy(Self);
  7864.  
  7865.      If Application<>Nil Then
  7866.        If Application.MainForm = Self Then Application.Terminate; {End MsgLoop}
  7867.  
  7868.      If Screen.FActiveForm = Self Then Screen.FActiveForm := Nil;
  7869.  
  7870.      Screen.FForms.Remove(Self);
  7871.  
  7872.      If FModalShowing Then DismissDlg(cmCancel);
  7873.  
  7874.      If FIcon<>Nil Then If FIcon.FIsLocalCopy Then FIcon.Destroy;
  7875.      FIcon:=Nil;
  7876.  
  7877.      If FAccelList <> Nil Then
  7878.      Begin
  7879.           For T := 0 To FAccelList.Count-1 Do
  7880.           Begin
  7881.                dummy := FAccelList.Items[T];
  7882.                Dispose(dummy);
  7883.           End;
  7884.  
  7885.           FAccelList.Destroy;
  7886.           FAccelList := Nil;
  7887.      End;
  7888.  
  7889.      FTopMDIChild := Nil;
  7890.  
  7891.      Inherited Destroy;
  7892.  
  7893.      If FFrame <> Nil Then
  7894.      Begin
  7895.           TFrameControl(FFrame).FChild := Nil;
  7896.           FFrame.Destroy;
  7897.           FFrame := Nil;
  7898.      End;
  7899.  
  7900.      If Application<>Nil Then
  7901.        If Application.MainForm = Self Then Application.FMainForm := Nil;
  7902.  
  7903.      Screen.UpdateLastActive;
  7904. End;
  7905.  
  7906.  
  7907. Procedure TForm.SetupComponent;
  7908. Begin
  7909.      Inherited SetupComponent;
  7910.  
  7911.      If Designed Then Include(ComponentState, csReference);
  7912.      Name := 'Form';
  7913.      Caption := Name;
  7914.      AutoScroll:=False;
  7915.      FParentPenColor := False;
  7916.      FParentColor := False;
  7917.      FColor := clDlgWindow;
  7918.      FShowHint := True;
  7919.      FWindowState := wsNormal;
  7920.      FBorderIcons := [biSystemMenu,biMinimize,biMaximize];
  7921.      FBorderStyle := bsSizeable;
  7922.      FFormStyle := fsNormal;
  7923.      FTileMode := tbNormal;
  7924.      FMinTrackWidth := 0;
  7925.      FMinTrackHeight := 0;
  7926.      FMaxTrackWidth := MaxInt;
  7927.      FMaxTrackHeight := MaxInt;
  7928.      FEnableDocking := [];
  7929.      FMoveable := True;
  7930.      FSizeable := True;
  7931.      FTabStop := False;
  7932.      FCursorTabStop := False;
  7933.      FActiveControl := Self;
  7934.      FFrame := Nil;
  7935.      FForm := Self;
  7936.      Include(ComponentState, csForm); {To decide SetupSCU}
  7937.      Include(ComponentState, csAcceptsControls);
  7938.      FShortCutsEnabled := True;
  7939.      FPosition := poDesigned;
  7940.      FInternalWindowIdCount := cmInternalControlBase;
  7941. End;
  7942.  
  7943.  
  7944. Constructor TForm.CreateIntern(AOwner:TComponent; Var AReference:TForm);
  7945. Begin
  7946.      AReference := Self;
  7947.      If Application <> Nil Then
  7948.        If Application.FMainForm = Nil Then Application.FMainForm := Self;
  7949.  
  7950.      TForm.Create(AOwner);
  7951. End;
  7952.  
  7953.  
  7954. Constructor TForm.Create(AOwner:TComponent);
  7955. Begin
  7956.      Include(ComponentState, csForm); {To decide SetupSCU}
  7957.  
  7958.      Inherited Create(AOwner);
  7959.  
  7960.      Asm
  7961.         PUSH DWord Ptr Self
  7962.         CALLN32 Classes.SetupFormSCU
  7963.      End;
  7964.      If FOnCreate <> Nil Then FOnCreate(Self);
  7965.  
  7966.      If Not (csReference In ComponentState) Then
  7967.        If Screen.FForms.IndexOf(Self) < 0 Then Screen.FForms.Add(Self);
  7968. End;
  7969.  
  7970.  
  7971. Constructor TForm.CreateNew(AOwner:TComponent);
  7972. Begin
  7973.      Include(ComponentState, csForm); {To decide SetupSCU}
  7974.  
  7975.      Inherited Create(AOwner);
  7976.  
  7977.      If FOnCreate <> Nil Then FOnCreate(Self);
  7978.  
  7979.      If Not (csReference In ComponentState) Then
  7980.        If Screen.FForms.IndexOf(Self) < 0 Then Screen.FForms.Add(Self);
  7981. End;
  7982.  
  7983.  
  7984. Procedure TForm.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LonGInt);
  7985. Begin
  7986.      If ResName = rnIcon Then
  7987.      Begin
  7988.           If DataLen <> 0 Then If ((FIcon=Nil)Or(FIcon.Empty)) Then
  7989.           Begin
  7990.                If IconClass<>Nil Then
  7991.                Begin
  7992.                     If FIcon=Nil Then
  7993.                     Begin
  7994.                          FIcon:=TGraphic(IconClass.Create);
  7995.                          FIcon.FIsLocalCopy:=True;
  7996.                     End;
  7997.                     Try
  7998.                        FIcon.ReadSCUResource(rnBitmap,Data,DataLen);
  7999.                     Except
  8000.                        FIcon.Destroy;
  8001.                        FIcon:=Nil;
  8002.                     End;
  8003.                End;
  8004.           End;
  8005.      End
  8006.      Else Inherited ReadSCUResource(ResName,Data,DataLen);
  8007. End;
  8008.  
  8009.  
  8010. Function TForm.WriteSCUResource(Stream:TResourceStream):Boolean;
  8011. Begin
  8012.      Result := Inherited WriteSCUResource(Stream);
  8013.      If Not Result Then Exit;
  8014.  
  8015.      If FIcon <> Nil Then
  8016.        If Not FIcon.Empty Then
  8017.          If FIcon<>Application.FIcon Then Result := FIcon.WriteSCUResourceName(Stream,rnIcoN);
  8018. End;
  8019.  
  8020.  
  8021. {$HINTS OFF}
  8022. Procedure TForm.LoadedFromSCU(SCUParent:TComponent);
  8023. Begin
  8024.      Exclude(ComponentState,csHasMainMenu);
  8025.  
  8026.      {SCUParent Is Nil; because Form Is ON DeskTop Or Is Reference}
  8027.      Inherited LoadedFromSCU(Nil);
  8028. End;
  8029. {$HINTS ON}
  8030.  
  8031.  
  8032. Procedure TForm.CreateWnd;
  8033. Var  Temp:TControl;
  8034.      TopMDI:TForm;
  8035.      dist:LONGINT;
  8036.      {$IFDEF WIN32}
  8037.      SysMenu:LongWord;
  8038.      {$ENDIF}
  8039. Begin
  8040.      If Not Designed Then
  8041.        If FFormStyle = fsMDIChild Then
  8042.          If Application.MainForm <> Nil Then
  8043.            If Application.MainForm.FormStyle = fsMDIForm Then
  8044.              If Parent = Nil Then
  8045.              Begin
  8046.                   TopMDI := Application.MainForm.ActiveMDIChild;
  8047.  
  8048.                   Parent := Application.MainForm;
  8049.  
  8050.                   If FPosition = poDefault Then
  8051.                   Begin
  8052.                        If TopMDI = Self Then TopMDI := Nil;
  8053.                        If TopMDI <> Nil Then
  8054.                        Begin
  8055.                             dist := Screen.SystemMetrics(smCySizeBorder);
  8056.                             inc(dist, Screen.SystemMetrics(smCyTitlebar));
  8057.  
  8058.                             SetBounds(TopMDI.Left+dist, TopMDI.Top+dist,
  8059.                                       TopMDI.Width, TopMDI.Height);
  8060.                        End
  8061.                        Else
  8062.                        Begin
  8063.                             SetBounds(0,0, (Application.MainForm.Width Div 3)*2,
  8064.                                       (Application.MainForm.Height Div 3)*2);
  8065.                        End;
  8066.                   End;
  8067.              End;
  8068.  
  8069.  
  8070.      ShortCutsEnabled := False;
  8071.  
  8072.      If FIsModal And (Not Designed) Then
  8073.      Begin
  8074.           Temp := FParent;
  8075.           FParent := FModalParent; {?}
  8076.           FModalParent := Temp;
  8077.      End;
  8078.  
  8079.      Inherited CreateWnd;
  8080.  
  8081.      {$IFDEF WIN32}
  8082.      If Frame<>Nil Then
  8083.        If ((FBorderStyle<>bsNone)And(biSystemMenu In FBorderIcons)And
  8084.            (FormStyle <> fsMDIChild)) then
  8085.      Begin
  8086.           SysMenu := GetSystemMenu(Frame.Handle, False);
  8087.  
  8088.           If SysMenu<>0 Then
  8089.           Begin
  8090.                If FBorderStyle=bsDialog Then
  8091.                Begin
  8092.                     DeleteMenu(SysMenu, SC_TASKLIST, MF_BYCOMMAND);
  8093.                     DeleteMenu(SysMenu, 7, MF_BYPOSITION);
  8094.                     DeleteMenu(SysMenu, 5, MF_BYPOSITION);
  8095.                     DeleteMenu(SysMenu, SC_MAXIMIZE, MF_BYCOMMAND);
  8096.                     DeleteMenu(SysMenu, SC_MINIMIZE, MF_BYCOMMAND);
  8097.                     DeleteMenu(SysMenu, SC_SIZE, MF_BYCOMMAND);
  8098.                     DeleteMenu(SysMenu, SC_RESTORE, MF_BYCOMMAND);
  8099.                End
  8100.                Else
  8101.                Begin
  8102.                     If not (biMinimize In FBorderIcons) Then
  8103.                        EnableMenuItem(SysMenu, SC_MINIMIZE, MF_BYCOMMAND or MF_GRAYED);
  8104.                     If not (biMaximize in FBorderIcons) Then
  8105.                        EnableMenuItem(SysMenu, SC_MAXIMIZE, MF_BYCOMMAND or MF_GRAYED);
  8106.                End;
  8107.           End;
  8108.      End;
  8109.      {$ENDIF}
  8110.  
  8111.      ShortCutsEnabled := True;
  8112.  
  8113.      If Not Designed Then
  8114.        If DDEMan_OpenClientLinks<>Nil Then DDEMan_OpenClientLinks(Self); //Open DDE clients
  8115. End;
  8116.  
  8117.  
  8118. Procedure TForm.SetupShow;
  8119. Begin
  8120.      Inherited SetupShow;
  8121.      If FIcon<>Nil Then Icon:=FIcon
  8122.      Else If ((Application<>Nil)And
  8123.               (Application.Icon<>Nil)And
  8124.               (Not Application.Icon.Empty)And
  8125.               (IconClass<>Nil)) then
  8126.      Begin
  8127.           Icon:=Application.Icon;
  8128.      End;
  8129.  
  8130.      If FActiveControl <> Nil Then FActiveControl.Focus;
  8131. End;
  8132.  
  8133.  
  8134. Function TForm.ShowModal:LongWord;
  8135. Var  LastActiveForm:TForm;
  8136.      OldFParent:TControl;
  8137.      {$IFDEF OS2}
  8138.      Queue:QMSG;
  8139.      {$ENDIF}
  8140.      {$IFDEF Win32}
  8141.      aMsg:WinUser.Msg;
  8142.      {$ENDIF}
  8143.      ex:Boolean;
  8144. Label again;
  8145. Begin
  8146.      If Designed Then
  8147.      Begin
  8148.           Show;
  8149.           Exit;
  8150.      End;
  8151.  
  8152.      FIsModal := True;
  8153.      FModalResult := cmNull;
  8154.      FWindowState := wsNormal;
  8155.      LastActiveForm := Screen.ActiveForm;
  8156.  
  8157.      FModalShowing := True;
  8158.  
  8159.      OldFParent := FParent;
  8160.      FModalParent := Nil;
  8161.  
  8162.      If Handle = 0 Then CreateWnd;
  8163.      If Handle <> 0 Then LockDesktopWindows(True, Self);
  8164.      Show;
  8165.      BringToFront;
  8166.  
  8167. again:
  8168.      ex:=False;
  8169.      Try
  8170.         Repeat
  8171.               If Application = Nil Then
  8172.               Begin
  8173.                    {$IFDEF OS2}
  8174.                    If WinPeekMsg(AppHandle,Queue,0,0,0,PM_REMOVE) Then
  8175.                    Begin
  8176.                        If Queue.Msg <> WM_QUIT Then
  8177.                          WinDispatchMsg(AppHandle,Queue);
  8178.                    End;
  8179.                    {$ENDIF}
  8180.  
  8181.                    {$IFDEF Win32}
  8182.                    If PeekMessage(aMsg,0,0,0,PM_REMOVE) Then
  8183.                    Begin
  8184.                        If aMsg.Message <> WM_QUIT Then
  8185.                        Begin
  8186.                             TranslateMessage(aMsg);
  8187.                             DispatchMessage(aMsg);
  8188.                        End;
  8189.                    End;
  8190.                    {$ENDIF}
  8191.               End
  8192.               Else Application.HandleMessage;
  8193.         Until Not FModalShowing;
  8194.         ex:=False;
  8195.      Except
  8196.         On E:Exception Do
  8197.         Begin
  8198.              If Application<>Nil Then
  8199.              Begin
  8200.                 Application.ExceptObject := E;
  8201.                 Application.HandleException(Self);
  8202.                 Application.ExceptObject := Nil;
  8203.              End
  8204.              Else Raise;
  8205.         End;
  8206.         ex:=True;
  8207.      End;
  8208.      If ex Then goto again; //don't terminate dialog on exception
  8209.  
  8210.      Result := FModalResult;
  8211.  
  8212.      LockDesktopWindows(False,Self);
  8213.      {$IFDEF WIN32}
  8214.      DestroyHandle; //done in DismissDlg for OS/2
  8215.      {$ENDIF}
  8216.      FParent := OldFParent;
  8217.  
  8218.      Try
  8219.         {LastActiveForm destroyed?}
  8220.         If Not (LastActiveForm Is TForm) Then LastActiveForm := Nil;
  8221.      Except
  8222.         LastActiveForm := Nil;
  8223.      End;
  8224. End;
  8225.  
  8226.  
  8227. Procedure TForm.SetActiveControl(AControl:TControl);
  8228. Begin
  8229.      If IsControl(AControl) Then AControl.Focus
  8230.      Else Focus;
  8231. End;
  8232.  
  8233.  
  8234. Function TForm.GetTileCascadeRect:TRect;
  8235. Begin
  8236.      Result := GetClientRect;
  8237. End;
  8238.  
  8239.  
  8240. Procedure TForm.CommandEvent(Var Command:TCommand);
  8241. Var  MsgHandled:Boolean;
  8242. Begin
  8243.      Inherited CommandEvent(Command);
  8244.  
  8245.      MsgHandled := True;
  8246.      Case Command Of
  8247.         cmExit: Application.MainForm.Close;
  8248.         cmClose: Close;
  8249.         cmTile: Tile;
  8250.         cmCascade: Cascade;
  8251.         cmNext: Next;
  8252.         cmPrevious: previous;
  8253.         cmCloseAll: CloseAll;
  8254.         cmMaximize: If FTopMDIChild <> Nil Then FTopMDIChild.WindowState := wsMaXimIzed;
  8255.         cmMinimize: If FTopMDIChild <> Nil Then FTopMDIChild.WindowState := wsMiNimIzed;
  8256.         cmRestore: If FTopMDIChild <> Nil Then FTopMDIChild.WindowState := wsNorMal;
  8257.         cmCloseTop: If FTopMDIChild <> Nil Then FTopMDIChild.Close;
  8258.         cmHelpIndex: Application.HelpIndex;
  8259.         cmHelpContents: Application.HelpContents;
  8260.         cmHelpOnHelp: Application.HelpOnHelp;
  8261.         cmKeysHelp: Application.KeysHelp;
  8262.         cmHelp: Application.Help(HelpContext);
  8263.         Else MsgHandled := False;
  8264.      End; {Case}
  8265.  
  8266.      If MsgHandled Then Command := cmNull;
  8267. End;
  8268.  
  8269.  
  8270. Procedure TForm.Tile;
  8271. Var  ChildCnt:LongInt;
  8272.      Rows,Columns,ExtraCols,CurRow,CurCol:LongWord;
  8273.      Square:LongWord;
  8274.      aLeft,aBottom,aHeight,aWidth:LongInt;
  8275.      rec:TRect;
  8276.      Child:TForm;
  8277.      LastFocus:TForm;
  8278.      I:LongInt;
  8279. Begin
  8280.      If FFormStyle <> fsMDIForm Then Exit;
  8281.  
  8282.      If FMDIChildren=Nil Then Exit;
  8283.      ChildCnt:=FMDIChildren.Count;
  8284.      If ChildCnt=0 Then Exit;
  8285.  
  8286.      LastFocus := FTopMDIChild;
  8287.      If LastFocus <> Nil Then
  8288.      Begin
  8289.           FMDIChildren.Remove(LastFocus);
  8290.           FMDIChildren.Add(LastFocus);
  8291.      End;
  8292.  
  8293.      Case FTileMode Of
  8294.        tbHorizontal:
  8295.        Begin
  8296.             rec := GetTileCascadeRect;
  8297.             aLeft := rec.Left;
  8298.             aBottom := rec.Bottom;
  8299.             aHeight := (rec.Top - rec.Bottom) Div ChildCnt;
  8300.             aWidth := rec.Right - rec.Left;
  8301.             For I := 0 To ChildCnt-1 Do
  8302.             Begin
  8303.                  Child := FMDIChildren.Items[I];
  8304.                  If Child.WindowState <> wsNormal
  8305.                    Then Child.WindowState := wsNormal;
  8306.  
  8307.                  aBottom := rec.Bottom + I*aHeight;
  8308.                  If I = ChildCnt-1 Then aHeight := rec.Top - aBottom;
  8309.  
  8310.                  Child.SetWindowPos(aLeft, aBottom, aWidth, aHeight);
  8311.             End;
  8312.        End;
  8313.        tbVertical:
  8314.        Begin
  8315.             rec := GetTileCascadeRect;
  8316.             aLeft := rec.Left;
  8317.             aBottom := rec.Bottom;
  8318.             aHeight := rec.Top - rec.Bottom;
  8319.             aWidth := (rec.Right - rec.Left) Div ChildCnt;
  8320.             For I := 0 To ChildCnt-1 Do
  8321.             Begin
  8322.                  Child := FMDIChildren.Items[I];
  8323.                  If Child.WindowState <> wsNormal
  8324.                    Then Child.WindowState := wsNormal;
  8325.  
  8326.                  aLeft := rec.Left + I*aWidth;
  8327.                  If I = ChildCnt-1 Then aWidth := rec.Right - aLeft;
  8328.  
  8329.                  Child.SetWindowPos(aLeft, aBottom, aWidth, aHeight);
  8330.             End;
  8331.        End;
  8332.        tbNormal:
  8333.        Begin
  8334.             Square:=2;
  8335.             While Square*2<=ChildCnt Do Inc(Square);
  8336.             If ChildCnt=3 Then Square:=3;
  8337.  
  8338.             Columns:=Square-1;
  8339.             Rows:=ChildCnt Div Columns;
  8340.             ExtraCols:=ChildCnt Mod Columns;
  8341.             rec:=GetTileCascadeRect;
  8342.  
  8343.             aHeight:=(rec.Top-rec.Bottom) Div Rows;
  8344.             ChildCnt:=0;
  8345.  
  8346.             For CurRow:=0 To Rows-1 Do
  8347.             Begin
  8348.                  If Rows-CurRow<=ExtraCols Then Inc(Columns);
  8349.                  For CurCol:=0 To Columns-1 Do
  8350.                  Begin
  8351.                       aWidth:=rec.Right Div Columns;
  8352.  
  8353.                       If ChildCnt<FMDIChildren.Count Then
  8354.                       Begin
  8355.                            Child:=FMDIChildren.Items[ChildCnt];
  8356.                            Inc(ChildCnt);
  8357.  
  8358.                            If Child.WindowState<>wsNormal
  8359.                            Then Child.WindowState:=wsNormal;
  8360.  
  8361.                            Child.SetWindowPos(aWidth*CurCol,
  8362.                                               rec.Top-(aHeight*(CurRow+1)),
  8363.                                               aWidth,
  8364.                                               aHeight);
  8365.                       End;
  8366.                  End;
  8367.                  If Rows-CurRow<=ExtraCols Then
  8368.                  Begin
  8369.                       Dec(Columns);
  8370.                       Dec(ExtraCols);
  8371.                  End;
  8372.             End;
  8373.        End;
  8374.      End;
  8375.  
  8376.      If ActiveMDIChild <> Nil Then ActiveMDIChild.BringToFront;
  8377. End;
  8378.  
  8379.  
  8380. Procedure TForm.Cascade;
  8381. Var  xloc,yloc,xlen,ylen:LongInt;
  8382.      XDiv,YDiv:LongWord;
  8383.      rec:TRect;
  8384.      T:LongInt;
  8385.      Child:TForm;
  8386.      LastFocus:TForm;
  8387. Begin
  8388.      If FFormStyle <> fsMDIForm Then Exit;
  8389.  
  8390.      If FMDIChildren=Nil Then Exit;
  8391.  
  8392.      LastFocus := FTopMDIChild;
  8393.      If LastFocus <> Nil Then
  8394.      Begin
  8395.           FMDIChildren.Remove(LastFocus);
  8396.           FMDIChildren.Add(LastFocus);
  8397.      End;
  8398.  
  8399.      XDiv:=Screen.SystemMetrics(smCxSizeBorder);
  8400.      Inc(XDiv,Screen.SystemMetrics(smCyTitlebar));
  8401.  
  8402.      YDiv:=Screen.SystemMetrics(smCySizeBorder);
  8403.      Inc(YDiv,Screen.SystemMetrics(smCyTitlebar));
  8404.  
  8405.      rec:=GetTileCascadeRect;
  8406.      xloc:=rec.Left;
  8407.      xlen:=rec.Right-rec.Left;
  8408.      yloc:=rec.Bottom;
  8409.      ylen:=rec.Top-rec.Bottom;
  8410.      For T:=0 To FMDIChildren.Count-1 Do
  8411.      Begin
  8412.           Child:=FMDIChildren.Items[T];
  8413.           If Child.WindowState<>wsNormal Then Child.WindowState:=wsNormal;
  8414.           Child.SetWindowPos(xloc,yloc,xlen,ylen);
  8415.           Child.BringToFront;
  8416.           Inc(xloc,XDiv);
  8417.           Dec(xlen,XDiv);
  8418.           Dec(ylen,YDiv);
  8419.      End;
  8420. End;
  8421.  
  8422. (*
  8423. Procedure TForm.ArrangeIcons;
  8424. Begin
  8425.      If FFormStyle <> fsMDIForm Then Exit;
  8426.  
  8427.      {$IFDEF OS2}
  8428.      {...}
  8429.      {$ENDIF}
  8430.      {$IFDEF Win32}
  8431.      If (FFormStyle = fsMDIForm) And (Handle <> 0)
  8432.      Then SendMessage(Handle,WM_MDIICONARRANGE,0,0);
  8433.      {$ENDIF}
  8434. End;
  8435. *)
  8436.  
  8437. Procedure TForm.Next;
  8438. Var Child:TForm;
  8439.     L:LongInt;
  8440. Begin
  8441.      If FFormStyle <> fsMDIForm Then Exit;
  8442.  
  8443.      If FMDIChildren=Nil Then Exit;
  8444.      If FMDIChildren.Count<2 Then Exit;
  8445.  
  8446.      Child:=FTopMDIChild;
  8447.      L:=FMDIChildren.IndexOf(Child);
  8448.      If L >= 0 Then
  8449.      Begin
  8450.         If L >= FMDIChildren.Count-1 Then L:=0
  8451.         Else Inc(L);
  8452.      End
  8453.      Else L := 0;
  8454.      Child:=FMDIChildren.Items[L];
  8455.      Child.BringToFront;
  8456. End;
  8457.  
  8458.  
  8459. Procedure TForm.Previous;
  8460. Var Child:TForm;
  8461.     L:LongInt;
  8462. Begin
  8463.      If FFormStyle <> fsMDIForm Then Exit;
  8464.  
  8465.      If FMDIChildren=Nil Then Exit;
  8466.      If FMDIChildren.Count<2 Then Exit;
  8467.  
  8468.      Child:=FTopMDIChild;
  8469.      L:=FMDIChildren.IndexOf(Child);
  8470.      If L >= 0 Then
  8471.      Begin
  8472.        If L=0 Then L:=FMDIChildren.Count-1
  8473.        Else Dec(L);
  8474.      End
  8475.      Else L := 0;
  8476.      Child:=FMDIChildren.Items[L];
  8477.      Child.BringToFront;
  8478. End;
  8479.  
  8480.  
  8481. Procedure TForm.CloseAll;
  8482. Var  Child:TForm;
  8483.      L:LongInt;
  8484. Begin
  8485.      If FFormStyle <> fsMDIForm Then Exit;
  8486.  
  8487.      For L := MDIChildCount-1 Downto 0 Do
  8488.      Begin
  8489.           Child := MDIChildren[L];
  8490.           Child.Close;
  8491.      End;
  8492. End;
  8493.  
  8494.  
  8495. {
  8496. ╔═══════════════════════════════════════════════════════════════════════════╗
  8497. ║                                                                           ║
  8498. ║ Speed-Pascal/2 Version 2.0                                                ║
  8499. ║                                                                           ║
  8500. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  8501. ║                                                                           ║
  8502. ║ This section: TApplication Class Implementation                           ║
  8503. ║                                                                           ║
  8504. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  8505. ║                                                                           ║
  8506. ╚═══════════════════════════════════════════════════════════════════════════╝
  8507. }
  8508.  
  8509.  
  8510. Procedure MsgProc;
  8511. Begin
  8512.      Application.HandleMessage;
  8513. End;
  8514.  
  8515.  
  8516. Procedure ProcessProc;
  8517. Begin
  8518.      Application.ProcessMessage;
  8519. End;
  8520.  
  8521.  
  8522. Constructor TApplication.Create;
  8523. Begin
  8524.      Asm
  8525.         MOV EAX,@Forms.MsgProc
  8526.         MOV Classes.MsgProc,EAX
  8527.         MOV EAX,@Forms.ProcessProc
  8528.         MOV Classes.ProcessProc,EAX
  8529.      End;
  8530.      FShowMainForm:=True;
  8531.      Inherited Create(Nil);
  8532. End;
  8533.  
  8534.  
  8535. Function TApplication.GetLanguage:String;
  8536. Var S:String;
  8537. Begin
  8538.      Asm
  8539.         LEA EAX,s
  8540.         PUSH EAX
  8541.         CALLN32 Classes.GetAppLanguage
  8542.      End;
  8543.      Result:=S;
  8544. End;
  8545.  
  8546.  
  8547. Function TApplication.GetExeName:String;
  8548. Begin
  8549.     Result:=ParamStr(0);
  8550. End;
  8551.  
  8552.  
  8553. Procedure TApplication.SetLanguage(Const NewLanguage:String);
  8554. Var Form:TForm;
  8555.     T:LongInt;
  8556. Begin
  8557.      Asm
  8558.         PUSH DWord Ptr NewLanguage
  8559.         CALLN32 Classes.SetAppLanguage
  8560.      End;
  8561.  
  8562.      For T:=0 To Screen.FormCount-1 Do
  8563.      Begin
  8564.          Form:=Screen.Forms[T];
  8565.          Form.Language:=NewLanguage;
  8566.      End;
  8567. End;
  8568.  
  8569.  
  8570. Function TApplication.GetIcon:TGraphic;
  8571. Begin
  8572.      If FIcon = Nil Then
  8573.        If IconClass <> Nil Then
  8574.      Begin //Create Empty
  8575.           FIcon := TGraphic(IconClass.Create);
  8576.           FIcon.FIsLocalCopy := True;
  8577.      End;
  8578.      Result := FIcon;
  8579. End;
  8580.  
  8581. Procedure TApplication.SetIcon(NewIcon:TGraphic);
  8582. Begin
  8583.      If ((FIcon<>Nil)And(FIcon<>NewIcon)And(FIcon.FIsLocalCopy)) Then FIcon.Destroy;
  8584.      FIcon:=Nil;
  8585.  
  8586.      If ((NewIcon<>Nil)And(NewIcon<>FIcon)And(NewIcon.FIsLocalCopy)And(IconClass<>Nil)) Then
  8587.      Begin
  8588.           //Create A Copy !!
  8589.           Try
  8590.              NewIcon:=NewIcon.CopyGraphic;
  8591.              NewIcon.FIsLocalCopy:=True;
  8592.           Except
  8593.              NewIcon:=Nil;
  8594.           End;
  8595.      End;
  8596.  
  8597.      FIcon:=NewIcon;
  8598. End;
  8599.  
  8600.  
  8601. Procedure TApplication.SetupComponent;
  8602. {$IFDEF OS2}
  8603. Var  Version_Major:LongInt;
  8604.      Version_Minor:LongInt;
  8605.      MemBuf:Array[0..11] Of Byte;
  8606.      cc:COUNTRYCODE;
  8607. {$ENDIF}
  8608. Begin
  8609.      Inherited SetupComponent;
  8610.  
  8611.      Application := Self;
  8612.      FHint := '';
  8613.      FShowHint := True;
  8614.      FHintPause := 1000;
  8615.      FHintPenColor := clInfoText;
  8616.      FHintColor := clInfo;
  8617.      FHintControl := Nil;
  8618.      FHintParent := Nil;
  8619.      FHintOwner := Nil;
  8620.      FHintOrigin := hiBottom;
  8621.      FMenuItemList.Create;
  8622.      FFont := Screen.DefaultFont;
  8623.      FTerminate := False;
  8624.  
  8625.      {$IFDEF OS2}
  8626.      FPlatform := OS2Ver40;
  8627.      If DosQuerySysInfo(11,11,Version_Major,4) = 0 Then
  8628.        If DosQuerySysInfo(12,12,Version_Minor,4) = 0 Then
  8629.          If Version_Major = 20 Then
  8630.            Case Version_Minor Of
  8631.              0,10,11: FPlatform := OS2Ver20;
  8632.              30:      FPlatform := OS2Ver30;
  8633.            End;
  8634.      FDBCSSystem := False;
  8635.      cc.country := 0;
  8636.      cc.codepage := 0;
  8637.      If DosQueryDBCSEnv(12,cc,MemBuf) = 0 Then
  8638.        If (MemBuf[0] <> 0) And (MemBuf[1] <> 0) Then FDBCSSystem := True;
  8639.      {$ENDIF}
  8640.      {$IFDEF Win32}
  8641.      FPlatform := Win32;
  8642.      FDBCSSystem := False;
  8643.      {$ENDIF}
  8644. End;
  8645.  
  8646.  
  8647. Procedure TApplication.CreateForm(InstanceClass:TFormClass;Var Reference:TForm);
  8648. Var  OldMainForm:TForm;
  8649. Begin
  8650.      OldMainForm := FMainForm;
  8651.  
  8652.      Try
  8653.         Reference := InstanceClass.CreateIntern(Nil,Reference);
  8654.      Except
  8655.         On E:Exception Do
  8656.         Begin
  8657.              Reference := Nil;
  8658.              FMainForm := OldMainForm;
  8659.              If Application <> Nil Then
  8660.              Begin
  8661.                 Application.ExceptObject := E;
  8662.                 Application.HandleException(Self);
  8663.                 Application.ExceptObject := Nil;
  8664.              End
  8665.              Else Raise;
  8666.         End;
  8667.      End;
  8668. End;
  8669.  
  8670.  
  8671. Type
  8672.      PForm=^TForm;
  8673.      PAutomaticRec=^TAutomaticRec;
  8674.      TAutomaticRec=Record
  8675.                          Form:PForm;
  8676.                          FormClass:TFormClass;
  8677.                    End;
  8678.  
  8679. Const AutomaticForms:TList=Nil;
  8680.  
  8681. Procedure RegisterAutomaticForm(FormClass:TFormClass;address:Pointer);
  8682. Var dummy:PAutomaticRec;
  8683. Begin
  8684.      If AutomaticForms=Nil Then AutomaticForms.Create;
  8685.      New(dummy);
  8686.      dummy^.Form:=address;
  8687.      dummy^.FormClass:=FormClass;
  8688.      AutomaticForms.Add(dummy);
  8689. End;
  8690.  
  8691. Procedure CreateAutomaticForms;
  8692. Var T:LongInt;
  8693.     Item:PAutomaticRec;
  8694. Begin
  8695.      If AutomaticForms<>Nil Then
  8696.      Begin
  8697.           For T:=0 To AutomaticForms.Count-1 Do
  8698.           Begin
  8699.                Item:=AutomaticForms[T];
  8700.                //main Form Is already created !!
  8701.                If Item^.Form^<>Application.FMainForm Then
  8702.                   Application.CreateForm(Item^.FormClass,Item^.Form^);
  8703.                Dispose(Item);
  8704.           End;
  8705.           AutomaticForms.Destroy;
  8706.      End;
  8707. End;
  8708.  
  8709.  
  8710. Procedure TApplication.Run;
  8711. Var i:LongInt;
  8712.     AForm:TForm;
  8713.     {$IFDEF OS2}
  8714.     aHelpInit:HELPINIT;
  8715.     C,c1:Cstring;
  8716.     rec:TRect;
  8717.     {$ENDIF}
  8718.     ex:Boolean;
  8719.     AIcon:TGraphic;
  8720. Label again;
  8721. Begin
  8722.      ex:=False;
  8723.      Try
  8724.         CreateAutomaticForms;
  8725.  
  8726.         If FMainForm = Nil Then Exit;
  8727.  
  8728.         If IconClass<>Nil Then //Try to load default icon
  8729.         Begin
  8730.              AIcon:=IconClass.Create;
  8731.              Try
  8732.                 //First try if we have an application icon from Sibyl
  8733.                 AIcon.LoadFromResourceId(1);
  8734.              Except
  8735.                 //Try default icon in Cursors.rc
  8736.                 Try
  8737.                    AIcon.LoadFromResourceId(2);
  8738.                 Except
  8739.                    AIcon.Destroy;
  8740.                    AIcon:=Nil;
  8741.                 End;
  8742.              End;
  8743.  
  8744.              FIcon:=AIcon;
  8745.         End;
  8746.  
  8747.         Application.Font:=MainForm.Font;
  8748.  
  8749.         FMainForm.CreateWnd;
  8750.         If FMainForm.Handle = 0 Then RunFailed;
  8751.         If HelpFile <> '' Then
  8752.         Begin
  8753.              {$IFDEF OS2}
  8754.              C := HelpWindowTitle;
  8755.              aHelpInit.pszHelpWindowTitle := @C;
  8756.              c1 := HelpFile;
  8757.              aHelpInit.pszHelpLibraryName := @c1;
  8758.              aHelpInit.cb := SizeOf(HELPINIT);
  8759.              aHelpInit.ulReturnCode := 0;
  8760.              aHelpInit.pszTutorialname := Nil;
  8761.              aHelpInit.phtHelptable := Nil{Pointer($FFFF0000 Or Attr.ResourceId)};
  8762.              aHelpInit.hmodHelptableModule := 0{Attr.ResourceModule};
  8763.              aHelpInit.hmodAccelActionBarModule := 0;
  8764.              aHelpInit.idAcceltable := 0;
  8765.              aHelpInit.idActionBar := 0;
  8766.              aHelpInit.fShowPanelID := 0;
  8767.              FHelpWindow := WinCreateHelpInstance(AppHandle,aHelpInit);
  8768.  
  8769.              If FHelpWindow <> 0 Then
  8770.              Begin
  8771.                   WinAssociateHelpInstance(HelpWindow,FMainForm.Frame.Handle);
  8772.  
  8773.                   rec.Left := 0;
  8774.                   rec.Right := Screen.Width Div 2;
  8775.                   rec.Bottom := 0;
  8776.                   rec.Top := Screen.Height;
  8777.                   WinSendMsg(FHelpWindow,HM_SET_COVERPAGE_SIZE,LongWord(@rec),0);
  8778.              End
  8779.              Else ErrorBox2(LoadNLSStr(SAppHelpFailed));
  8780.              {$ENDIF}
  8781.         End;
  8782.         If FShowMainForm Then FMainForm.Show;
  8783.  
  8784.         // show all visible MDI Forms
  8785.         If FMainForm.FormStyle = fsMDIForm Then
  8786.           For i := 0 To Screen.FormCount-1 Do
  8787.           Begin
  8788.                AForm := Screen.Forms[i];
  8789.                If AForm <> FMainForm Then
  8790.                  If AForm.FormStyle = fsMDIChild Then
  8791.                    If AForm.Visible Then AForm.Show;
  8792.           End;
  8793.  
  8794.  
  8795. again:
  8796.         ex:=False;
  8797.         Try
  8798.            Repeat
  8799.               HandleMessage;
  8800.            Until Terminated;
  8801.         Except
  8802.            On E:Exception Do
  8803.            Begin
  8804.                ex:=True;
  8805.                ExceptObject := E;
  8806.                HandleException(Self);
  8807.                ExceptObject := Nil;
  8808.            End;
  8809.         End;
  8810.         If ex Then goto again; //don't terminate on exception
  8811.      Except
  8812.         On E:Exception Do
  8813.         Begin
  8814.              If ex Then raise; //don't show msg twice
  8815.              ExceptObject := E;
  8816.              HandleException(Self);
  8817.              ExceptObject := Nil;
  8818.         End;
  8819.      End;
  8820.  
  8821.      Try
  8822.         If DDEMan_CloseAllLinks<>Nil Then DDEMan_CloseAllLinks;
  8823.      Except
  8824.      End;
  8825. End;
  8826.  
  8827. Function TApplication.ProcessMessage:Boolean;
  8828. Var  Msg:TMessage;
  8829.      Handled:Boolean;
  8830.      Control:TControl;
  8831.      {$IFDEF OS2}
  8832.      Queue:QMSG;
  8833.      {$ENDIF}
  8834.      {$IFDEF Win32}
  8835.      aMsg:WinUser.Msg;
  8836.      {$ENDIF}
  8837. Begin
  8838.      Result := False;
  8839.      {$IFDEF OS2}
  8840.      If WinPeekMsg(AppHandle,Queue,0,0,0,PM_REMOVE) Then
  8841.      Begin
  8842.           Result := True;
  8843.           If Queue.Msg <> WM_QUIT Then
  8844.           Begin
  8845.                Handled := False;
  8846.                If FOnMessage <> Nil Then
  8847.                Begin
  8848.                     FillChar(Msg,SizeOf(Msg),0);
  8849.                     Msg.Receiver := Queue.HWND;
  8850.                     Msg.ReceiverClass := HandleToControl(Queue.HWND);
  8851.                     Msg.Msg := Queue.Msg;
  8852.                     Msg.Param1 := Queue.mp1;
  8853.                     Msg.Param2 := Queue.mp2;
  8854.                     FOnMessage(Msg, Handled);
  8855.                End;
  8856.                If Not Handled Then WinDispatchMsg(AppHandle,Queue);
  8857.           End
  8858.           Else
  8859.           Begin
  8860.                Try
  8861.                   If FMainForm <> Nil Then
  8862.                     If FMainForm.FFrame <> Nil Then
  8863.                       If Queue.hwnd = FMainForm.FFrame.Handle
  8864.                       Then FMainForm.Close;
  8865.                Finally
  8866.                   FTerminate := True;
  8867.                End;
  8868.           End;
  8869.      End;
  8870.      {$ENDIF}
  8871.  
  8872.      {$IFDEF Win32}
  8873.      If PeekMessage(aMsg,0,0,0,PM_REMOVE) Then
  8874.      Begin
  8875.           Result := True;
  8876.           If aMsg.Message <> WM_QUIT Then
  8877.           Begin
  8878.                Handled := False;
  8879.                If FOnMessage <> Nil Then
  8880.                Begin
  8881.                     FillChar(Msg,SizeOf(Msg),0);
  8882.                     Msg.Receiver := aMsg.HWND;
  8883.                     Msg.ReceiverClass := HandleToControl(aMsg.HWND);
  8884.                     Msg.Msg := aMsg.Message;
  8885.                     Msg.Param1 := aMsg.WParam;
  8886.                     Msg.Param2 := aMsg.LParam;
  8887.                     FOnMessage(Msg, Handled);
  8888.                End;
  8889.                If Not Handled Then
  8890.                Begin
  8891.                     TranslateMessage(aMsg);
  8892.                     DispatchMessage(aMsg);
  8893.                End;
  8894.           End
  8895.           Else
  8896.           Begin
  8897.                Try
  8898.                   If FMainForm <> Nil Then FMainForm.Close;
  8899.                Finally
  8900.                   FTerminate := True;
  8901.                End;
  8902.           End;
  8903.      End;
  8904.      {$ENDIF}
  8905. End;
  8906.  
  8907. Procedure TApplication.ProcessMessages;
  8908. Begin
  8909.      While ProcessMessage Do ;
  8910. End;
  8911.  
  8912.  
  8913. Procedure TApplication.HandleMessage;
  8914. Begin
  8915.      If Not ProcessMessage Then Idle;
  8916. End;
  8917.  
  8918.  
  8919. Procedure TApplication.Idle;
  8920. Var  Done:Boolean;
  8921. Begin
  8922.      Done := True;
  8923.      If FOnIdle <> Nil Then FOnIdle(Self, Done);
  8924.      {$IFDEF OS2}
  8925.      If Done Then WinWaitMsg(AppHandle,0,0);
  8926.      {$ENDIF}
  8927.      {$IFDEF Win32}
  8928.      If Done Then WaitMessage;
  8929.      {$ENDIF}
  8930. End;
  8931.  
  8932.  
  8933. Procedure TApplication.Terminate;
  8934. {$IFDEF OS2}
  8935. Var  Msg:TMessage;
  8936. {$ENDIF}
  8937. Begin
  8938.      {$IFDEF OS2}
  8939.      If MainForm <> Nil Then
  8940.      Begin
  8941.           FillChar(Msg,SizeOf(Msg),0);
  8942.           Msg.Receiver := MainForm.Handle;
  8943.           Msg.ReceiverClass := MainForm;
  8944.           Msg.Msg := WM_CLOSE;
  8945.           MainForm.DefaultHandler(Msg);
  8946.           {DefaultHandler posts WM_QUIT To Queue}
  8947.      End;
  8948.      {$ENDIF}
  8949.      {$IFDEF Win32}
  8950.      PostQuitMessage(0);
  8951.      {$ENDIF}
  8952. End;
  8953.  
  8954.  
  8955. Procedure TApplication.HandleException(Sender:TObject);
  8956. Begin
  8957.      If FOnException <> Nil Then FOnException(Sender,ExceptObject)
  8958.      Else ShowException(ExceptObject);
  8959. End;
  8960.  
  8961.  
  8962. Procedure TApplication.ShowException(E:Exception);
  8963. Begin
  8964.      If MessageBox2(E.Message+' at '+tohex(LONGWORD(E.ExcptAddr))+' !'#13#10+
  8965.         LoadNLSStr(STerminateProgram),mtCritical,mbYesNo)=mrYes Then Raise E;
  8966. End;
  8967.  
  8968.  
  8969. Procedure TApplication.HelpIndex;
  8970. Begin
  8971.      If FHelpWindow<>0 Then
  8972.      Begin
  8973.           {$IFDEF OS2}
  8974.           WinSendMsg(FHelpWindow,HM_HELP_INDEX,0,0);
  8975.           {$ENDIF}
  8976.      End;
  8977. End;
  8978.  
  8979.  
  8980. Procedure TApplication.KeysHelp;
  8981. Begin
  8982.      If FHelpWindow<>0 Then
  8983.      Begin
  8984.           If FKeysHelpContext <> 0 Then
  8985.           Begin
  8986.                HelpContext(FKeysHelpContext);
  8987.                exit;
  8988.           End;
  8989.           {$IFDEF OS2}
  8990.           WinSendMsg(FHelpWindow,HM_KEYS_HELP,0,0);
  8991.           {$ENDIF}
  8992.      End;
  8993. End;
  8994.  
  8995.  
  8996. Procedure TApplication.HelpOnHelp;
  8997. Begin
  8998.      If FHelpWindow<>0 Then
  8999.      Begin
  9000.           {$IFDEF OS2}
  9001.           WinSendMsg(FHelpWindow,HM_DISPLAY_HELP,0,0);
  9002.           {$ENDIF}
  9003.      End;
  9004. End;
  9005.  
  9006.  
  9007. Procedure TApplication.HelpContents;
  9008. Begin
  9009.      If FHelpWindow<>0 Then
  9010.      Begin
  9011.           {$IFDEF OS2}
  9012.           WinSendMsg(FHelpWindow,HM_HELP_CONTENTS,0,0);
  9013.           {$ENDIF}
  9014.      End;
  9015. End;
  9016.  
  9017.  
  9018. Function TApplication.HelpJump(Const JumpId:String):Boolean;
  9019. {$IFDEF OS2}
  9020. Var  CS:Cstring;
  9021. {$ENDIF}
  9022. Begin
  9023.      Result := False;
  9024.      If FHelpWindow <> 0 Then
  9025.      Begin
  9026.           {$IFDEF OS2}
  9027.           CS := JumpId;
  9028.           Result := (WinSendMsg(FHelpWindow,HM_DISPLAY_HELP,
  9029.                                 LongWord(@CS),HM_PANELNAME) = 0);
  9030.           {$ENDIF}
  9031.      End;
  9032. End;
  9033.  
  9034.  
  9035. Function TApplication.Help(context:THelpContext):Boolean;
  9036. Begin
  9037.      If FOnHelp<>Nil Then FOnHelp(context,Result)
  9038.      Else Result:=HelpContext(context);
  9039. End;
  9040.  
  9041.  
  9042. Function TApplication.HelpContext(context:THelpContext):Boolean;
  9043. Begin
  9044.      If context=0 Then
  9045.      Begin
  9046.           HelpContents;
  9047.           Result:=True;
  9048.      End
  9049.      Else
  9050.      Begin
  9051.           Result := False;
  9052.           If FHelpWindow <> 0 Then
  9053.           Begin
  9054.                {$IFDEF OS2}
  9055.                Result := (WinSendMsg(FHelpWindow,HM_DISPLAY_HELP,
  9056.                           LongWord(context),HM_RESOURCEID) = 0);
  9057.                {$ENDIF}
  9058.           End;
  9059.      End;
  9060. End;
  9061.  
  9062.  
  9063. Procedure TApplication.RunFailed;
  9064. Begin
  9065.      ErrorBox2(LoadNLSStr(SMainWindowFailed)+'. '+LoadNLSStr(SProgramAborted)+'.');
  9066.      Halt(0);
  9067. End;
  9068.  
  9069.  
  9070. Destructor TApplication.Destroy;
  9071. Var  AForm:TForm;
  9072. Begin
  9073.      Inherited Destroy;
  9074.      {FMainForm.Destroy;}
  9075.  
  9076.      //Destroy All DeskTop Forms
  9077.      While Screen.FForms.Count > 0 Do
  9078.      Begin
  9079.           AForm:=Screen.FForms[0];
  9080.           AForm.Destroy;
  9081.      End;
  9082.  
  9083.      FMenuItemList.Destroy;
  9084.      FMenuItemList := Nil;;
  9085. End;
  9086.  
  9087.  
  9088. Function TApplication.GetHelpFile:String;
  9089. Begin
  9090.      Result := '';
  9091.      If FHelpFile <> Nil Then Result := FHelpFile^;
  9092. End;
  9093.  
  9094.  
  9095. Procedure TApplication.SetHelpFile(NewName:String);
  9096. Begin
  9097.      If FMainForm <> Nil Then
  9098.        If FMainForm.Handle <> 0 Then Exit;
  9099.  
  9100.      AssignStr(FHelpFile,NewName);
  9101. End;
  9102.  
  9103.  
  9104. Function TApplication.GetHelpWindowTitle:String;
  9105. Begin
  9106.      Result := '';
  9107.      If FHelpWindowTitle <> Nil Then Result := FHelpWindowTitle^;
  9108. End;
  9109.  
  9110.  
  9111. Procedure TApplication.SetHelpWindowTitle(NewTitle:String);
  9112. Begin
  9113.      If FMainForm <> Nil Then
  9114.        If FMainForm.Handle <> 0 Then Exit;
  9115.  
  9116.      AssignStr(FHelpWindowTitle,NewTitle);
  9117. End;
  9118.  
  9119.  
  9120. Procedure TApplication.SetHint(Const NewText:String);
  9121. Begin
  9122.      If FHint <> NewText Then
  9123.      Begin
  9124.           FHint := NewText;
  9125.           If FOnHint <> Nil Then FOnHint(Self);
  9126.      End;
  9127. End;
  9128.  
  9129.  
  9130. Procedure TApplication.HintTimerExpired;
  9131. Var  HintInfo:THintInfo;
  9132.      CanShow:Boolean;
  9133.      MousePos:TPoint;
  9134.      BubbleSizeX,BubbleSizey:LongInt;
  9135.      BubbleText:String;
  9136.      HintRect:TRect;
  9137. Begin
  9138.      If FHintTimer <> Nil Then FHintTimer.Destroy;
  9139.      FHintTimer := Nil;
  9140.      If FHintControl = Nil Then Exit;
  9141.      If FHintControl.Designed Then Exit;
  9142.      If Not FHintControl.Enabled Then Exit;
  9143.  
  9144.      If Not FHasFocus Then exit;
  9145.  
  9146.      If FHintWindow = Nil Then
  9147.      Begin
  9148.           FHintWindow := HintWindowClass.Create(Nil);
  9149.           FHintWindow.CreateWnd;
  9150.      End
  9151.      Else
  9152.      Begin
  9153.          {$IFDEF WIN32}
  9154.          FHintWindow.Left:=-1000;
  9155.          ShowWindow(FHintWindow.Handle,SW_SHOWNA);
  9156.          {$ENDIF}
  9157.      End;
  9158.  
  9159.      MousePos := Screen.MousePos;
  9160.  
  9161.      If Screen.GetControlFromPoint(MousePos) = Nil Then exit;
  9162.  
  9163.      BubbleText := GetShortHint(FHintControl.FHint^);
  9164.      If BubbleText = '' Then Exit;
  9165.  
  9166.      FHintWindow.Canvas.GetTextExtent(BubbleText,BubbleSizeX,BubbleSizeY);
  9167.  
  9168.      inc(BubbleSizeX,6);
  9169.      inc(BubbleSizeY,4);
  9170.  
  9171.      {Position der Bubble anpassen}
  9172.      HintRect.Left := MousePos.X;
  9173.      If FHintOrigin = hiBottom Then HintRect.Bottom := MousePos.Y - 15 - BubbleSizeY
  9174.      Else HintRect.Bottom := MousePos.Y;
  9175.  
  9176.      HintInfo.HintControl := FHintControl;
  9177.      HintInfo.HintPos := Point(HintRect.Left,HintRect.Bottom);
  9178.      HintInfo.HintMaxWidth := Screen.Width;
  9179.      HintInfo.HintColor := FHintColor;
  9180.      HintInfo.HintPenColor := FHintPenColor;
  9181.      HintInfo.CursorRect := FHintControl.WindowRect;
  9182.      HintInfo.CursorPos := MousePos;
  9183.  
  9184.      CanShow := True;
  9185.      If FOnShowHint <> Nil Then FOnShowHint(BubbleText,CanShow,HintInfo);
  9186.      If Not CanShow Then Exit;
  9187.  
  9188.      FHintWindow.Color := HintInfo.HintColor;
  9189.      FHintWindow.PenColor := HintInfo.HintPenColor;
  9190.  
  9191.      HintRect.Left := HintInfo.HintPos.X;
  9192.      HintRect.Bottom := HintInfo.HintPos.Y;
  9193.      HintRect.Right := HintRect.Left + BubbleSizeX;
  9194.      HintRect.Top := HintRect.Bottom + BubbleSizeY;
  9195.  
  9196.      //hier evtl. Word Wrap
  9197.      If HintInfo.HintMaxWidth < BubbleSizeX Then
  9198.      Begin
  9199.           HintRect.Right := HintRect.Left + HintInfo.HintMaxWidth;
  9200.      End;
  9201.  
  9202.      FHintWindow.ActivateHint(HintRect, BubbleText);
  9203.  
  9204.      FHintOwner := FHintControl;
  9205.      FHintParent := FHintControl.Parent;
  9206. End;
  9207.  
  9208.  
  9209. Procedure TApplication.DestroyHintWindow;
  9210. Begin
  9211.      If FHintOwner = Nil Then Exit; {no Hint Is Showing}
  9212.      FHintOwner := Nil;
  9213.      FHintParent := Nil;
  9214.  
  9215.      FHintWindow.DeactivateHint;
  9216. End;
  9217.  
  9218.  
  9219. Function TApplication.NewMenuItem(entry:TMenuItem):TCommand;
  9220. Begin
  9221.      Result := FMenuItemList.Count + cmInternalMenuItemBase;
  9222.      FMenuItemList.Add(entry);
  9223. End;
  9224.  
  9225.  
  9226. Procedure TApplication.DeleteMenuItem(entry:TMenuItem);
  9227. Var  idx:LongInt;
  9228. Begin
  9229.      idx := FMenuItemList.IndexOf(entry);
  9230.      If idx >= 0 Then FMenuItemList.Items[idx] := Nil;
  9231. End;
  9232.  
  9233.  
  9234. Function TApplication.GetMenuItem(Command:TCommand):TMenuItem;
  9235. Var  idx:LongInt;
  9236. Begin
  9237.      idx := Command - cmInternalMenuItemBase;
  9238.      If (idx >= 0) And (idx < FMenuItemList.Count) Then
  9239.      Begin
  9240.           Result := TMenuItem(FMenuItemList.Items[idx]);
  9241.           If Not (Result Is TMenuItem) Then Result := Nil;
  9242.      End
  9243.      Else Result := Nil;
  9244. End;
  9245.  
  9246.  
  9247. Procedure TApplication.SetFont(NewFont:TFont);
  9248. Var  Form:TForm;
  9249.      I:LongInt;
  9250. Begin
  9251.      If FFont <> NewFont Then
  9252.      Begin
  9253.           DereferenceFont(FFont);
  9254.           FFont := NewFont;
  9255.           If FFont <> Nil Then Inc(FFont.FUseCount);
  9256.      End;
  9257.  
  9258.      For I := 0 To Screen.FormCount-1 Do
  9259.      Begin
  9260.           Form := Screen.Forms[I];
  9261.           If Not Form.Designed Then
  9262.             If Form.ParentFont Then
  9263.             Begin
  9264.                  Form.SetFont(FFont);
  9265.                  Form.FParentFont := True;
  9266.             End;
  9267.      End;
  9268. End;
  9269.  
  9270.  
  9271. {
  9272. ╔═══════════════════════════════════════════════════════════════════════════╗
  9273. ║                                                                           ║
  9274. ║ Speed-Pascal/2 Version 2.0                                                ║
  9275. ║                                                                           ║
  9276. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  9277. ║                                                                           ║
  9278. ║ This section: THintWindow Class Implementation                            ║
  9279. ║                                                                           ║
  9280. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  9281. ║                                                                           ║
  9282. ╚═══════════════════════════════════════════════════════════════════════════╝
  9283. }
  9284.  
  9285. Procedure THintWindow.SetupComponent;
  9286. Begin
  9287.      Inherited SetupComponent;
  9288.  
  9289.      Font := Screen.SmallFont;
  9290.      {$IFDEF WIN32}
  9291.      Ownerdraw := True;
  9292.      {$ENDIF}
  9293.      Include(ControlStyle,csHintWindow);
  9294. End;
  9295.  
  9296. {$IFDEF WIN32}
  9297.  
  9298. Procedure THintWindow.GetClassData(Var ClassData:TClassData);
  9299. Begin
  9300.      Inherited GetClassData(ClassData);
  9301.  
  9302.      CreateSubClass(ClassData,'BUTTON');
  9303. End;
  9304.  
  9305. Procedure THintWindow.CreateParams(Var Params:TCreateParams);
  9306. Begin
  9307.      Inherited CreateParams(Params);
  9308.  
  9309.      Params.Style := Params.Style Or BS_USERBUTTON Or WS_DISABLED Or WS_POPUP;
  9310. End;
  9311.  
  9312. Procedure THintWindow.CreateWnd;
  9313. Var Style:LongWord;
  9314.     cCaption:CString;
  9315.     rc:TRect;
  9316.     OldWndProc:Pointer;
  9317. Begin
  9318.      {$IFDEF WIN32}
  9319.      FLeft:=-1000;
  9320.      {$ENDIF}
  9321.  
  9322.      Inherited CreateWnd;
  9323.  
  9324.      {$IFDEF WIN32}
  9325.      ShowWindow(Handle,SW_SHOWNA);
  9326.      {$ENDIF}
  9327. End;
  9328. {$ENDIF}
  9329.  
  9330.  
  9331. Procedure THintWindow.Redraw(Const rec:TRect);
  9332. Var  rc:TRect;
  9333. Begin
  9334.      If Canvas = Nil Then exit;
  9335.  
  9336.      Canvas.Pen.Color := PenColor;
  9337.      Canvas.Brush.Color := Color;
  9338.  
  9339.      Inherited Redraw(rec);
  9340.  
  9341.      rc := ClientRect;
  9342.      Canvas.TextOut(3,2, Caption);
  9343.      Canvas.ShadowedBorder(rc,clWhite,clBlack);
  9344.      InflateRect(rc,-1,-1);
  9345.      Canvas.ShadowedBorder(rc,Color,clDkGray);
  9346. End;
  9347.  
  9348. Procedure THintWindow.ActivateHint(Rect:TRect; Const AHint:String);
  9349. Begin
  9350.      Caption := AHint;
  9351.      WindowRect := Rect;
  9352.  
  9353.      If Rect.Left + Width > Screen.Width Then Rect.Left := Screen.Width - Width;
  9354.      If Rect.Left < 0 Then Rect.Left := 0;
  9355.      If Rect.Bottom + Height > Screen.Height Then Rect.Bottom := Screen.Height - HeIght;
  9356.      If Rect.Bottom < 0 Then Rect.Bottom := 0;
  9357.  
  9358.      SetWindowPos(Rect.Left, Rect.Bottom, Width, Height);
  9359.      Show;
  9360. End;
  9361.  
  9362.  
  9363. Procedure THintWindow.DeactivateHint;
  9364. Begin
  9365.      Hide;
  9366. End;
  9367.  
  9368. {
  9369. ╔═══════════════════════════════════════════════════════════════════════════╗
  9370. ║                                                                           ║
  9371. ║ Speed-Pascal/2 Version 2.0                                                ║
  9372. ║                                                                           ║
  9373. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  9374. ║                                                                           ║
  9375. ║ This section: TFont Class Implementation                                  ║
  9376. ║                                                                           ║
  9377. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  9378. ║                                                                           ║
  9379. ╚═══════════════════════════════════════════════════════════════════════════╝
  9380. }
  9381.  
  9382. Constructor TFont.Create(AOwner:TComponent);
  9383. Begin
  9384.      If AOwner<>Screen Then AOwner:=Screen; //!!
  9385.      Inherited Create(AOwner);
  9386. End;
  9387.  
  9388. Procedure TFont.SetupComponent;
  9389. Begin
  9390.      Inherited SetupComponent;
  9391.  
  9392.      Name:='Font';
  9393. End;
  9394.  
  9395. Destructor TFont.Destroy;
  9396. Begin
  9397.      Inherited Destroy;
  9398.  
  9399.      If FAlternateName<>Nil Then DisposeStr(FAlternateName);
  9400.      FAlternateName:=Nil;
  9401. End;
  9402.  
  9403. Procedure TFont.SetHeight(NewHeight:LongInt);
  9404. Begin
  9405.      {If Font Is changed FInternalPointSize Is no longer Valid}
  9406.      FInternalPointSize:=0;
  9407.      {$IFDEF OS2}
  9408.      FFontInfo.lMaxbaseLineExt:=NewHeight;
  9409.      {$ENDIF}
  9410.      {$IFDEF Win32}
  9411.      FFontInfo.lfHeight:=NewHeight;
  9412.      {$ENDIF}
  9413. End;
  9414.  
  9415. Procedure TFont.SetWidth(NewWidth:LongInt);
  9416. Begin
  9417.      {If Font Is changed FInternalPointSize Is no longer Valid}
  9418.      FInternalPointSize:=0;
  9419.      {$IFDEF OS2}
  9420.      FFontInfo.LMaxCharInc:=NewWidth;
  9421.      {$ENDIF}
  9422.      {$IFDEF Win32}
  9423.      FFontInfo.lfWidth:=NewWidth;
  9424.      {$ENDIF}
  9425. End;
  9426.  
  9427. Procedure TFont.SetAttributes(NewAttr:TFontAttributes);
  9428. Begin
  9429.      {$IFDEF OS2}
  9430.      FFontInfo.fsSelection:=FFontInfo.fsSelection And Not
  9431.                   (FM_SEL_BOLD Or FM_SEL_ITALIC Or FM_SEL_UNDERSCORE Or
  9432.                    FM_SEL_STRIKEOUT Or FM_SEL_OUTLINE);
  9433.      If NewAttr*[faBold]<>[] Then
  9434.         FFontInfo.fsSelection:=FFontInfo.fsSelection Or FM_SEL_BOLD;
  9435.      If NewAttr*[faItalic]<>[] Then
  9436.         FFontInfo.fsSelection:=FFontInfo.fsSelection Or FM_SEL_ITALIC;
  9437.      If NewAttr*[faUnderScore]<>[] Then
  9438.         FFontInfo.fsSelection:=FFontInfo.fsSelection Or FM_SEL_UNDERSCORE;
  9439.      If NewAttr*[faStrikeOut]<>[] Then
  9440.         FFontInfo.fsSelection:=FFontInfo.fsSelection Or FM_SEL_STRIKEOUT;
  9441.      If NewAttr*[faOutline]<>[] Then
  9442.         FFontInfo.fsSelection:=FFontInfo.fsSelection Or FM_SEL_OUTLINE;
  9443.      {$ENDIF}
  9444.      {$IFDEF Win32}
  9445.      If NewAttr*[faBold]<>[] Then FFontInfo.lfWeight:=FW_BOLD
  9446.      Else If FFontInfo.lfWeight=FW_BOLD Then FFontInfo.lfWeight:=0;
  9447.      If NewAttr*[faItalic]<>[] Then FFontInfo.lfItalic:=1
  9448.      Else FFontInfo.lfItalic:=0;
  9449.      If NewAttr*[faUnderScore]<>[] Then FFontInfo.lfUnderline:=1
  9450.      Else FFontInfo.lfUnderline:=0;
  9451.      If NewAttr*[faStrikeOut]<>[] Then FFontInfo.lfStrikeOut:=1
  9452.      Else FFontInfo.lfStrikeOut:=0;
  9453.      {$ENDIF}
  9454. End;
  9455.  
  9456. Function TFont.GetAttributes:TFontAttributes;
  9457. Begin
  9458.      Result:=[];
  9459.      {$IFDEF OS2}
  9460.      If FFontInfo.fsSelection And FM_SEL_BOLD<>0 Then Include(Result,faBold);
  9461.      If FFontInfo.fsSelection And FM_SEL_ITALIC<>0 Then Include(Result,faItalic);
  9462.      If FFontInfo.fsSelection And FM_SEL_UNDERSCORE<>0 Then Include(Result,faUnderSCore);
  9463.      If FFontInfo.fsSelection And FM_SEL_STRIKEOUT<>0 Then Include(Result,faStrikeOUt);
  9464.      If FFontInfo.fsSelection And FM_SEL_OUTLINE<>0 Then Include(Result,faOutline);
  9465.      {$ENDIF}
  9466.      {$IFDEF Win32}
  9467.      If FFontInfo.lfWeight=FW_BOLD Then Include(Result,faBold);
  9468.      If FFontInfo.lfItalic<>0 Then Include(Result,faItalic);
  9469.      If FFontInfo.lfUnderline<>0 Then Include(Result,faUnderScore);
  9470.      If FFontInfo.lfStrikeOut<>0 Then Include(Result,faStrikeOut);
  9471.      {$ENDIF}
  9472. End;
  9473.  
  9474. Function TFont.GetMinimumPointSize:LongInt;
  9475. Begin
  9476.      {$IFDEF OS2}
  9477.      Result:=FFontInfo.sMinimumPointSize Div 10;
  9478.      {$ENDIF}
  9479.      {$IFDEF Win32}
  9480.      {.?.}
  9481.      Result:=PointSize;
  9482.      {$ENDIF}
  9483. End;
  9484.  
  9485. Function TFont.GetMaximumPointSize:LongInt;
  9486. Begin
  9487.      {$IFDEF OS2}
  9488.      Result:=FFontInfo.sMaximumPointSize Div 10;
  9489.      {$ENDIF}
  9490.      {$IFDEF Win32}
  9491.      {.?.}
  9492.      Result:=PointSize;
  9493.      {$ENDIF}
  9494. End;
  9495.  
  9496. Function TFont.GetNominalPointSize:LongInt;
  9497. Begin
  9498.      {$IFDEF OS2}
  9499.      Result:=FFontInfo.sNominalPointSize Div 10;
  9500.      {$ENDIF}
  9501.      {$IFDEF Win32}
  9502.      Result:=PointSize;
  9503.      {$ENDIF}
  9504. End;
  9505.  
  9506. Function TFont.GetInternalLeading:LongInt;
  9507. Begin
  9508.      {$IFDEF OS2}
  9509.      Result:=FFontInfo.lInternalLeading;
  9510.      {$ENDIF}
  9511.      {$IFDEF Win32}
  9512.      Result:=0;
  9513.      {$ENDIF}
  9514. End;
  9515.  
  9516. Function TFont.GetHeight:LongInt;
  9517. Begin
  9518.      {$IFDEF OS2}
  9519.      Result:=FFontInfo.lMaxbaseLineExt;
  9520.      {$ENDIF}
  9521.      {$IFDEF Win32}
  9522.      Result:=FFontInfo.lfHeight;
  9523.      {$ENDIF}
  9524. End;
  9525.  
  9526. Function TFont.GetWidth:LongInt;
  9527. Begin
  9528.      {$IFDEF OS2}
  9529.      Result:=FFontInfo.LMaxCharInc;
  9530.      {$ENDIF}
  9531.      {$IFDEF Win32}
  9532.      Result:=FFontInfo.lfWidth;
  9533.      {$ENDIF}
  9534. End;
  9535.  
  9536. Function TFont.GetPitch:TFontPitch;
  9537. Begin
  9538.      {$IFDEF OS2}
  9539.      If FFontInfo.fsType And FM_TYPE_FIXED<>0 Then Result:=fpFixed
  9540.      Else Result:=fpProportional;
  9541.      {$ENDIF}
  9542.      {$IFDEF Win32}
  9543.      If FFontInfo.lfPitchAndFamily And 3=1 Then Result:=fpFixed
  9544.      Else Result:=fpProportional;
  9545.      {$ENDIF}
  9546. End;
  9547.  
  9548. Function TFont.GetCharSet:TFontCharSet;
  9549. Begin
  9550.      {$IFDEF OS2}
  9551.      If FFontInfo.fsType And FM_TYPE_MBCS <> 0 Then Result := fcsMBCS
  9552.      Else If FFontInfo.fsType And FM_TYPE_DBCS <> 0 Then Result := fcsDBCS
  9553.           Else Result := fcsSBCS;
  9554.      {$ENDIF}
  9555.      {$IFDEF Win32}
  9556.      Result := fcsSBCS;
  9557.      {$ENDIF}
  9558. End;
  9559.  
  9560. Function TFont.GetName:String;
  9561. Begin
  9562.      {$IFDEF OS2}
  9563.      Result:=FFontInfo.szFaceName;
  9564.      {$ENDIF}
  9565.      {$IFDEF Win32}
  9566.      Result:=FFontInfo.lfFaceName;
  9567.      {$ENDIF}
  9568. End;
  9569.  
  9570. Function TFont.GetFamily:String;
  9571. {$IFDEF Win32}
  9572. Var Family:Byte;
  9573. {$ENDIF}
  9574. Begin
  9575.      {$IFDEF OS2}
  9576.      Result:=FFontInfo.szFamilyName;
  9577.      {$ENDIF}
  9578.      {$IFDEF Win32}
  9579.      If FFontType=ftBitmap Then Result:='Bitmap'
  9580.      Else Result:='TrueType';
  9581.      Family:=FFontInfo.lfPitchAndFamily And 240;
  9582.      If Family=FF_ROMAN Then Result:='Roman';
  9583.      If Family=FF_SWISS Then Result:='Swiss';
  9584.      If Family=FF_MODERN Then Result:='Modern';
  9585.      If Family=FF_SCRIPT Then Result:='Script';
  9586.      If Family=FF_DECORATIVE Then Result:='Decorative';
  9587.      {$ENDIF}
  9588. End;
  9589.  
  9590.  
  9591. Type
  9592.     PFontRes=^TFontRes;
  9593.     TFontRes=Array[0..512] Of Char;
  9594.  
  9595.  
  9596. Function TFont.WriteSCUResourceName(Stream:TResourceStream;ResName:TResourceName):BOolean;
  9597. Var  Data:PFontRes;
  9598.      T:Byte;
  9599.      S,s1:String;
  9600.      Attrs:TFontAttributes;
  9601.      t1:LongInt;
  9602. Begin
  9603.      If FAlternateName=Nil Then
  9604.        If ((Self=Screen.DefaultFont)Or(FDefault)) Then {dont Write it}
  9605.        Begin
  9606.             Result := True;
  9607.             Exit;
  9608.        End;
  9609.  
  9610.      S:=FaceName;
  9611.      If FDefault Then S:='System Default Font';
  9612.  
  9613.      s1:=S;
  9614.      UpcaseStr(s1);
  9615.      Attrs:=Attributes;
  9616.      If Attrs*[faBold]<>[] Then If Pos(' BOLD',s1)=0 Then S:=S+'!BOLD!';
  9617.      If Attrs*[faItalic]<>[] Then If Pos(' ITALIC',s1)=0 Then S:=S+'!ITALIC!';
  9618.      If Attrs*[faOutline]<>[] Then S:=S+'!OUTLINE!';
  9619.      If Attrs*[faStrikeOut]<>[] Then S:=S+'!STRIKEOUT!';
  9620.      If Attrs*[faUnderScore]<>[] Then S:=S+'!UNDERSCORE!';
  9621.  
  9622.      GetMem(Data,512);
  9623.      For T := 0 To Length(S) Do Data^[T] := S[T];
  9624.  
  9625.      T := Length(S)+1;
  9626.  
  9627.      If FAlternateName<>Nil Then
  9628.      Begin
  9629.           //AlternateName starts with #2
  9630.           For t1:=1 To length(FAlternateName^) Do
  9631.             Data^[(t+t1)-1]:=FAlternateName^[t1];
  9632.           inc(t,length(FAlternateName^));
  9633.      End;
  9634.  
  9635.      If FInternalPointSize <> 0 Then
  9636.      Begin
  9637.           Data^[T] := #1;
  9638.           Data^[T+1] := Chr(FInternalPointSize);
  9639.           Data^[T+2] := #0;
  9640.      End
  9641.      Else
  9642.      Begin
  9643.           Data^[T] := #0;
  9644.           Data^[T+1] := Chr(Width);
  9645.           Data^[T+2] := Chr(Height);
  9646.      End;
  9647.  
  9648.      inc(t,3);
  9649.      Result := Stream.NewResourceEntry(ResName,Data^,t);
  9650.      FreeMem(Data,512);
  9651. End;
  9652.  
  9653. Function ModifyFontName(FontName:String;Const Attrs:TFontAttributes):String;
  9654. Begin
  9655.      Result:=FontName;
  9656.      UpcaseStr(FontName);
  9657.      If Attrs*[faItalic]<>[] Then If Pos(' ITALIC',FontName)=0 Then Result:=Result+'.Italic';
  9658.      If Attrs*[faBold]<>[] Then If Pos(' BOLD',FontName)=0 Then Result:=Result+'.Bold';
  9659.      If Attrs*[faOutline]<>[] Then Result:=Result+'.Outline';
  9660.      If Attrs*[faStrikeOut]<>[] Then Result:=Result+'.Strikeout';
  9661.      If Attrs*[faUnderScore]<>[] Then Result:=Result+'.Underscore';
  9662. End;
  9663.  
  9664. {$HINTS OFF}
  9665. Function ReadSCUFont(Var Data;DataLen:LongInt):TFont;
  9666. Var  Data1:PFontRes;
  9667.      T,T1:Byte;
  9668.      PointSize,W,H:Byte;
  9669.      Face,FaceName:String;
  9670.      Attrs,AlternateAttrs:TFontAttributes;
  9671.      AlternateFace,AlternateFaceName:String;
  9672.      AlternatePointSize:Byte;
  9673.      AlternateW,AlternateH:Byte;
  9674. Label go;
  9675. Begin
  9676.      AlternateFaceName:='';
  9677.      AlternateFace:='';
  9678.      AlternatePointSize:=0;
  9679.      AlternateW:=0;
  9680.      AlternateH:=0;
  9681.      PointSize:=0;
  9682.      W:=0;
  9683.      H:=0;
  9684.  
  9685.      Data1 := @Data;
  9686.      For T := 0 To Ord(Data1^[0]) Do FaceName[T] := Data1^[T];
  9687.      Face:=FaceName;
  9688.  
  9689.      Attrs:=[];
  9690.      T:=Pos('!',FaceName);
  9691.      If T<>0 Then
  9692.      Begin
  9693.           If Pos('!BOLD!',FaceName)<>0 Then Attrs:=Attrs+[faBold];
  9694.           If Pos('!ITALIC!',FaceName)<>0 Then Attrs:=Attrs+[faItalic];
  9695.           If Pos('!OUTLINE!',FaceName)<>0 Then Attrs:=Attrs+[faOutline];
  9696.           If Pos('!STRIKEOUT!',FaceName)<>0 Then Attrs:=Attrs+[faStrikeOut];
  9697.           If Pos('!UNDERSCORE!',FaceName)<>0 Then Attrs:=Attrs+[faUnderScore];
  9698.           If Attrs<>[] Then FaceName[0]:=Chr(T-1);
  9699.      End;
  9700.  
  9701.      If FaceName='System Default Font' Then
  9702.      Begin
  9703.           Result:=Screen.DefaultFont;
  9704.           //ignore alternate facename here, the user wants default fonts !
  9705.      End
  9706.      Else
  9707.      Begin
  9708.           T := Ord(Data1^[0])+1;
  9709. go:
  9710.           If Data1^[T] = #1 Then
  9711.           Begin
  9712.                PointSize := Ord(Data1^[T+1]);
  9713.                FaceName:=ModifyFontName(FaceName,Attrs);
  9714.                Result := Screen.GetFontFromPointSize(FaceName,PointSize);
  9715.           End
  9716.           Else If Data1^[t] = #2 Then //Alternate Facename follows, new SCU
  9717.           Begin
  9718.                inc(t);
  9719.                For t1:=t To t+Ord(Data1^[t]) Do AlternateFaceName[t1-t]:=Data1^[t1];
  9720.                inc(t,ord(Data1^[t])+1);
  9721.                AlternateFace:=AlternateFaceName;
  9722.  
  9723.                AlternateAttrs:=[];
  9724.                T1:=Pos('!',AlternateFaceName);
  9725.                If T1<>0 Then
  9726.                Begin
  9727.                   If Pos('!BOLD!',AlternateFaceName)<>0 Then AlternateAttrs:=AlternateAttrs+[faBold];
  9728.                   If Pos('!ITALIC!',AlternateFaceName)<>0 Then AlternateAttrs:=AlternateAttrs+[faItalic];
  9729.                   If Pos('!OUTLINE!',AlternateFaceName)<>0 Then AlternateAttrs:=AlternateAttrs+[faOutline];
  9730.                   If Pos('!STRIKEOUT!',AlternateFaceName)<>0 Then AlternateAttrs:=AlternateAttrs+[faStrikeOut];
  9731.                   If Pos('!UNDERSCORE!',AlternateFaceName)<>0 Then AlternateAttrs:=AlternateAttrs+[faUnderScore];
  9732.                   If AlternateAttrs<>[] Then AlternateFaceName[0]:=Chr(T1-1);
  9733.                End;
  9734.  
  9735.                If Data1^[T] = #1 Then
  9736.                Begin
  9737.                     AlternatePointSize := Ord(Data1^[T+1]);
  9738.                     AlternateFaceName:=ModifyFontName(AlternateFaceName,AlternateAttrs);
  9739.                     inc(t,3); //skip also dummy #0
  9740.                     goto go;
  9741.                End
  9742.                Else
  9743.                Begin
  9744.                    AlternateW := Ord(Data1^[T+1]);
  9745.                    AlternateH := Ord(Data1^[T+2]);
  9746.                    AlternateFaceName:=ModifyFontName(AlternateFaceName,AlternateAttrs);
  9747.                    inc(t,3);
  9748.                    goto go;
  9749.                End;
  9750.           End
  9751.           Else //old style SCU format
  9752.           Begin
  9753.                W := Ord(Data1^[T+1]);
  9754.                H := Ord(Data1^[T+2]);
  9755.                FaceName:=ModifyFontName(FaceName,Attrs);
  9756.                Result := Screen.GetFontFromName(FaceName,H,W);
  9757.           End;
  9758.  
  9759.           If Result=Nil Then //Font could not be created,maybe its OS/2 or Win Font
  9760.           Begin
  9761.                //Try alternate facename if present
  9762.                If AlternateFaceName<>'' Then
  9763.                Begin
  9764.                     Attrs:=AlternateAttrs;
  9765.  
  9766.                     If AlternateFace='System Default Font' Then Result:=Screen.DefaultFont
  9767.                     Else
  9768.                     Begin
  9769.                        If AlternatePointSize<>0 Then
  9770.                          Result := Screen.GetFontFromPointSize(AlternateFaceName,AlternatePointSize)
  9771.                        Else
  9772.                          Result := Screen.GetFontFromName(AlternateFaceName,AlternateH,AlternateW);
  9773.                     End;
  9774.                End;
  9775.  
  9776.                //if neither normal nor alternate font work, set a default
  9777.                If Result=Nil Then Result:=Screen.SmallFont;
  9778.  
  9779.                //set alternate facename (the one that did not work)
  9780.                If Face<>'' Then
  9781.                Begin
  9782.                    FaceName:=#2+Face[0]+Face;
  9783.                    If PointSize<>0 Then
  9784.                        FaceName:=FaceName+#1+chr(PointSize)+#0
  9785.                    Else
  9786.                        FaceName:=FaceName+#0+chr(W)+chr(H);
  9787.                End
  9788.                Else FaceName:='';
  9789.  
  9790.                If FaceName<>'' Then
  9791.                 If Result<>Nil Then AssignStr(Result.FAlternateName,FaceName);
  9792.           End
  9793.           Else
  9794.           Begin
  9795.                //Font is ok, set alternate facename if present
  9796.                If AlternateFace<>'' Then
  9797.                Begin
  9798.                    AlternateFaceName:=#2+AlternateFace[0]+AlternateFace;
  9799.                    If AlternatePointSize<>0 Then
  9800.                       AlternateFaceName:=AlternateFaceName+#1+chr(AlternatePointSize)+#0
  9801.                    Else
  9802.                       AlternateFaceName:=AlternateFaceName+#0+chr(AlternateW)+chr(AlternateH);
  9803.                End
  9804.                Else AlternateFaceName:='';
  9805.  
  9806.                If AlternateFaceName<>'' Then
  9807.                  If Result<>Nil Then AssignStr(Result.FAlternateName,AlternateFaceName);
  9808.           End;
  9809.  
  9810.           If Result<>Nil Then If Result.Attributes*Attrs<>Attrs Then
  9811.           Begin
  9812.                Result:=Screen.CreateCompatibleFont(Result);
  9813.                Result.Attributes:=Attrs;
  9814.                Result.AutoDestroy:=True;
  9815.           End;
  9816.      End;
  9817. End;
  9818. {$HINTS ON}
  9819.  
  9820. ///////////////////////////////////////////////////////////////////////
  9821.  
  9822. Type
  9823.     THiddenWindow=Class(TControl)
  9824.       Private
  9825.          {$IFDEF OS2}
  9826.          Procedure WMInitMenu(Var Msg:TMessage); Message WM_INITMENU;
  9827.          Procedure WMMenuEnd(Var Msg:TMessage); Message WM_MENUEND;
  9828.          Procedure WMMenuSelect(Var Msg:TMessage); Message WM_MENUSELECT;
  9829.          Function GetData(Handle:LongWord;Var Menu:TPopupMenu;Var entry:TMenuItem):TForm;
  9830.          {$ENDIF}
  9831.          Procedure WMTimer(Var Msg:TWMTimer); Message WM_TIMER;
  9832.     End;
  9833.  
  9834. {$IFDEF OS2}
  9835. Function THiddenWindow.GetData(Handle:LongWord;Var Menu:TPopupMenu;Var entry:TMenuItem):TForm;
  9836. Begin
  9837.      entry := Pointer(WinQueryWindowULong(Handle,QWL_USER));  {Get VMT Pointer}
  9838.  
  9839.      If entry Is TMenuItem Then Menu := TPopupMenu(entry.FMenu)
  9840.      Else
  9841.      Begin
  9842.           Menu := TPopupMenu(entry);
  9843.           entry := Nil;
  9844.      End;
  9845.  
  9846.      If Not (Menu Is TPopupMenu) Then Menu:=Nil;
  9847.  
  9848.      //determine Form !
  9849.      If Menu<>Nil Then
  9850.      Begin
  9851.           If Menu.FPopupComponent Is TForm Then Result:=TForm(Menu.FPopupComponent)
  9852.           Else If Menu.Owner Is TForm Then Result:=TForm(Menu.Owner)
  9853.           Else Result:=Nil;
  9854.      End
  9855.      Else Result:=Nil;
  9856. End;
  9857.  
  9858. Procedure THiddenWindow.WMInitMenu(Var Msg:TMessage);
  9859. Var Form:TForm;
  9860.     entry:TMenuItem;
  9861.     Menu:TPopupMenu;
  9862. Begin
  9863.      Form:=GetData(Msg.Param2,Menu,entry);
  9864.      If Form<>Nil Then Form.MenuInit(Menu,entry);
  9865. End;
  9866.  
  9867. Procedure THiddenWindow.WMMenuEnd(Var Msg:TMessage);
  9868. Var Form:TForm;
  9869.     entry:TMenuItem;
  9870.     Menu:TPopupMenu;
  9871. Begin
  9872.      Form:=GetData(Msg.Param2,Menu,entry);
  9873.      If Form<>Nil Then Form.MenuEnd(Menu,entry);
  9874. End;
  9875.  
  9876. Procedure THiddenWindow.WMMenuSelect(Var Msg:TMessage);
  9877. Var Form:TForm;
  9878.     entry:TMenuItem;
  9879.     Menu:TPopupMenu;
  9880. Begin
  9881.      Form:=GetData(Msg.Param2,Menu,entry);
  9882.      If Menu<>Nil Then entry := Menu.ItemFromInternalCommand(Msg.Param1Lo);
  9883.      If Form<>Nil Then Form.MenuItemFocus(Menu,entry);
  9884. End;
  9885. {$ENDIF}
  9886.  
  9887.  
  9888. //////////// Handle Timer Messages
  9889.  
  9890. Procedure THiddenWindow.WMTimer(Var Msg:TWMTimer);
  9891. Var  TID:LongWord;
  9892.      Timer:TTimer;
  9893.      T:LongInt;
  9894. Begin
  9895.      TID := Msg.TimerId;
  9896.  
  9897.      {Search If the Timer Is Valid For us}
  9898.      T := 0;
  9899.      While T < TimerList.Count Do
  9900.      Begin
  9901.           Timer := TimerList.Items[T];
  9902.  
  9903.           If Timer <> Nil Then
  9904.             If Timer.FId = TID Then
  9905.               //If Timer.FControl = Self Then {found}
  9906.               Begin
  9907.                    If Timer = Application.FHintTimer Then
  9908.                    Begin
  9909.                         If Application.ShowHint Then
  9910.                           If Application.FHintControl <> Nil Then
  9911.                             If Application.FHintControl.FHint <> Nil Then
  9912.                               If Application.FHintControl.GetShowHint
  9913.                               Then Application.HintTimerExpired;
  9914.                    End
  9915.                    Else
  9916.                    Begin
  9917.                         Inc(Timer.FTime,Timer.FInterval);
  9918.                         Timer.Timer;
  9919.                    End;
  9920.  
  9921.                    Msg.Handled := True;
  9922.                    Msg.Result := 0;
  9923.                    break;
  9924.               End;
  9925.           Inc(T);
  9926.      End;
  9927. End;
  9928.  
  9929.  
  9930. {
  9931. ╔═══════════════════════════════════════════════════════════════════════════╗
  9932. ║                                                                           ║
  9933. ║ Speed-Pascal/2 Version 2.0                                                ║
  9934. ║                                                                           ║
  9935. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  9936. ║                                                                           ║
  9937. ║ This section: TScreen Class Implementation                                ║
  9938. ║                                                                           ║
  9939. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  9940. ║                                                                           ║
  9941. ╚═══════════════════════════════════════════════════════════════════════════╝
  9942. }
  9943.  
  9944. {$IFDEF Win32}
  9945. {$HINTS OFF}
  9946. Function EnumFontCallBack(Var lplf:LOGFONT;Var lptm:TEXTMETRIC;
  9947.                           nFontType:LongInt;Data:Pointer):LongInt;APIENTRY;
  9948. Var Font,Temp:TFont;
  9949. Begin
  9950.      Font.Create(Screen);
  9951.      Font.FFontInfo:=lplf;
  9952.      Font.FFontType:=ftBitmap;
  9953.      If nFontType And 4=4 Then Font.FFontType:=ftOutline;
  9954.      Screen.FFonts.Add(Font);
  9955.  
  9956.      If Font.FaceName='Times New Roman' Then
  9957.      Begin
  9958.           Temp:=Screen.CreateCompatibleFont(Font);
  9959.           Temp.FCustom:=False;
  9960.           FillChar(Temp.FFontInfo,SizeOf(Temp.FFontInfo),0);
  9961.           Temp.FFontInfo.lfFaceName:='Times New Roman';
  9962.           Temp.FFontInfo.lfHeight:=16;
  9963.           Temp.FFontInfo.lfWidth:=6;
  9964.           Screen.FFonts.Add(Temp);
  9965.      End;
  9966.  
  9967.      If Font.FaceName='Arial' Then
  9968.      Begin
  9969.           Temp:=Screen.CreateCompatibleFont(Font);
  9970.           Temp.FCustom:=False;
  9971.           FillChar(Temp.FFontInfo,SizeOf(Temp.FFontInfo),0);
  9972.           Temp.FFontInfo.lfFaceName:='Arial';
  9973.           Temp.FFontInfo.lfHeight:=14;
  9974.           Temp.FFontInfo.lfWidth:=5;
  9975.           Screen.FFonts.Add(Temp);
  9976.  
  9977.           Temp:=Screen.CreateCompatibleFont(Font);
  9978.           Temp.FCustom:=False;
  9979.           FillChar(Temp.FFontInfo,SizeOf(Temp.FFontInfo),0);
  9980.           Temp.FFontInfo.lfFaceName:='Arial';
  9981.           Temp.FFontInfo.lfHeight:=16;
  9982.           Temp.FFontInfo.lfWidth:=6;
  9983.           Screen.FFonts.Add(Temp);
  9984.      End;
  9985.      If Font.FaceName='MS Sans Serif' Then
  9986.      Begin
  9987.           Temp:=Screen.CreateCompatibleFont(Font);
  9988.           Temp.FCustom:=False;
  9989.           FillChar(Temp.FFontInfo,SizeOf(Temp.FFontInfo),0);
  9990.           Temp.FFontInfo.lfFaceName:='MS Sans Serif';
  9991.           Temp.FFontInfo.lfHeight:=15;
  9992.           Temp.FFontInfo.lfWidth:=5;
  9993.           Temp.FInternalPointSize:=8;
  9994.           Screen.FFonts.Add(Temp);
  9995.  
  9996.           Temp:=Screen.CreateCompatibleFont(Font);
  9997.           Temp.FCustom:=False;
  9998.           FillChar(Temp.FFontInfo,SizeOf(Temp.FFontInfo),0);
  9999.           Temp.FFontInfo.lfFaceName:='MS Sans Serif';
  10000.           Temp.FFontInfo.lfHeight:=16;
  10001.           Temp.FFontInfo.lfWidth:=7;
  10002.           Temp.FInternalPointSize:=10;
  10003.           Screen.FFonts.Add(Temp);
  10004.      End;
  10005.      Result:=1;
  10006. End;
  10007. {$HINTS ON}
  10008. {$ENDIF}
  10009.  
  10010.  
  10011. Function TScreen.GetCanvas:TCanvas;
  10012. Begin
  10013.      Result:=FCanvas;
  10014.      {$IFDEF WIN32}
  10015.      If FCanvas<>Nil Then If FCanvas.FHandle=0 Then
  10016.      Begin
  10017.           FCanvas.FHandle:=CreateDC('DISPLAY',Nil,Nil,Nil);
  10018.           FCanvas.Brush.Color:=FCanvas.Brush.FColor;
  10019.           FCanvas.Brush.Mode:=FCanvas.Brush.FMode;
  10020.           FCanvas.Brush.Style:=FCanvas.Brush.FStyle;
  10021.           FCanvas.Pen.Color:=FCanvas.Pen.FColor;
  10022.           FCanvas.Pen.Mode:=FCanvas.Pen.FMode;
  10023.           FCanvas.Pen.Style:=FCanvas.Pen.FStyle;
  10024.           FCanvas.Pen.Width:=FCanvas.Pen.FWidth;
  10025.           FCanvas.Font:=FCanvas.FFont;
  10026.      End;
  10027.      {$ENDIF}
  10028. End;
  10029.  
  10030. Procedure TScreen.MapPoints(target:TControl;Var pts:Array Of TPoint);
  10031. Begin
  10032.      If ((target=Nil)Or(target.Handle=0)) Then Exit;
  10033.  
  10034.      {$IFDEF OS2}
  10035.      WinMapWindowPoints(HWND_DESKTOP,target.Handle,pts[0],High(pts)+1);
  10036.      {$ENDIF}
  10037.      {$IFDEF Win32}
  10038.      {!!!!!!!!!!!!!!!! evtl umrechnen}
  10039.      MapWindowPoints(HWND_DESKTOP,target.Handle,pts[0],High(pts)+1);
  10040.      {$ENDIF}
  10041. End;
  10042.  
  10043.  
  10044. Procedure TScreen.Update;
  10045. Begin
  10046.      {$IFDEF OS2}
  10047.      WinUpdateWindow(HWND_DESKTOP);
  10048.      {$ENDIF}
  10049.      {$IFDEF Win32}
  10050.      WinUser.UpdateWindow(HWND_DESKTOP);
  10051.      {$ENDIF}
  10052. End;
  10053.  
  10054.  
  10055. Procedure TScreen.SetupComponent;
  10056. {$IFDEF OS2}
  10057. Var Count:LongInt;
  10058.     aPS:HPS;
  10059.     T:LongInt;
  10060.     Font:TFont;
  10061. Type
  10062.    PMyFontMetrics=^TMyFontMetrics;
  10063.    TMyFontMetrics=Array[0..1] Of FONTMETRICS;
  10064. Var
  10065.    pfm:PMyFontMetrics;
  10066.    fcd:FRAMECDATA;
  10067.    FHandle,Menu:LongWord;
  10068.    Titlebar:LongWord;
  10069.    cFNS:Cstring;
  10070.    FaceName,Temp:String;
  10071.    PointSize:LongInt;
  10072.    C:Integer;
  10073.    fm:FONTMETRICS;
  10074. {$ENDIF}
  10075. {$IFDEF Win95}
  10076. Var
  10077.    aHDC:HDC;
  10078. {$ENDIF}
  10079. Begin
  10080.      Inherited SetupComponent;
  10081.  
  10082.      FFonts.Create;
  10083.  
  10084.      {$IFDEF OS2}
  10085.      aPS:=WinGetPS(HWND_DESKTOP);
  10086.      Count:=0;
  10087.      Count:=GpiQueryFonts(aPS,QF_PUBLIC,Nil,Count,0,Nil);
  10088.      If Count>0 Then
  10089.      Begin
  10090.           GetMem(pfm,Count*SizeOf(FONTMETRICS));
  10091.           GpiQueryFonts(aPS,QF_PUBLIC,Nil,Count,
  10092.                         SizeOf(FONTMETRICS),pfm^[0]);
  10093.  
  10094.           For T:=0 To Count-1 Do
  10095.           Begin
  10096.                Font.Create(Screen);
  10097.                Font.FFontInfo:=pfm^[T];
  10098.                Font.FFontType:=ftBitmap;
  10099.                If Font.FFontInfo.fsDefn And FM_DEFN_OUTLINE<>0
  10100.                Then Font.FFontType:=ftOutline;
  10101.                {Else Font.FInternalPointSize:=Font.FFontInfo.sNominalPointSize Div 10;}
  10102.                FFonts.Add(Font);
  10103.           End;
  10104.      End;
  10105.      FreeMem(pfm,Count*SizeOf(FONTMETRICS));
  10106.      WinReleasePS(aPS);
  10107.      {$ENDIF}
  10108.      {$IFDEF Win95}
  10109.      aHDC:=GetDC(HWND_DESKTOP);
  10110.      EnumFonts(aHDC,Nil,Pointer(@EnumFontCallBack),Nil);
  10111.      ReleaseDC(HWND_DESKTOP,aHDC);
  10112.      {$ENDIF}
  10113.  
  10114.      FFontWindow.Create(Nil);
  10115.      FFontWindow.FOwnerDraw:=True;
  10116.      FFontWindow.CreateWnd;
  10117.  
  10118.      FHiddenWindow:=THiddenWindow.Create(Nil);
  10119.      FHiddenWindow.CreateWnd;
  10120.  
  10121.      // target Window For WM_TIMER Messages
  10122.      TimerWindow := FHiddenWindow.Handle;
  10123.  
  10124.  
  10125.      {$IFDEF OS2}
  10126.      //determine Default Font
  10127.      aPS:=WinGetPS(HWND_DESKTOP);
  10128.      If GpiQueryFontMetrics(aPS,SizeOf(FONTMETRICS),fm) Then
  10129.      Begin
  10130.           If fm.sNominalPointSize<>0 Then
  10131.             FDefaultFont:=Screen.GetFontFromPointSize(fm.szFaceName,fm.sNominalPointSize Div 10);
  10132.           If FDefaultFont=Nil Then FDefaultFont:=GetFontFromPointSize(fm.szFaceName,10);
  10133.      End;
  10134.      WinReleasePS(aPS);
  10135.      If DefaultFont<>Nil Then If FSystemFont=Nil Then
  10136.      Begin
  10137.           FSystemFont:=Screen.CreateCompatibleFont(DefaultFont);
  10138.           FSystemFont.FDefault:=True;
  10139.      End;
  10140.  
  10141.      //determine Default System Menu Font
  10142.      fcd.cb:=SizeOf(FRAMECDATA);
  10143.      fcd.flCreateFlags:=FCF_TITLEBAR Or FCF_SYSMENU;
  10144.      fcd.hModResources:=0;
  10145.      fcd.idResources:=0;
  10146.  
  10147.      cFNS:='';
  10148.      FHandle:=WinCreateWCWindow(HWND_DESKTOP,WC_FRAME,cFNS,
  10149.                                 0,               //flStyle
  10150.                                 0,0,             //leave This ON 0 - Set by .Show
  10151.                                 0,0,             //Position And Size
  10152.                                 HWND_DESKTOP,    //Parent
  10153.                                 HWND_TOP,        //Insert behind
  10154.                                 1,               //Window Id
  10155.                                 @fcd,            //CtlData
  10156.                                 Nil);            //Presparams
  10157.      Menu:=WinWindowFromID(FHandle,FID_SYSMENU);
  10158.      If WinQueryPresParam(Menu,PP_FONTNAMESIZE,0,Nil,SizeOf(cFNS),cFNS,QPF_NOINHERIT)<>0 Then
  10159.      Begin
  10160.           FaceName:=cFNS;
  10161.           If Pos('.',FaceName)<>0 Then
  10162.           Begin
  10163.                Temp:=Copy(FaceName,1,Pos('.',FaceName)-1);
  10164.                Delete(FaceName,1,Pos('.',FaceName));
  10165.                Val(Temp,PointSize,C);
  10166.                If C=0 Then FMenuFont:=GetFontFromPointSize(FaceName,PointSize)
  10167.                Else FMenuFont:=DefaultFont;
  10168.           End;
  10169.      End
  10170.      Else FMenuFont:=DefaultFont;
  10171.  
  10172.      Titlebar:=WinWindowFromID(FHandle,FID_TITLEBAR);
  10173.      If WinQueryPresParam(Titlebar,PP_FONTNAMESIZE,0,Nil,SizeOf(cFNS),cFNS,QPF_NOINHERIT)<>0 then
  10174.      Begin
  10175.           FaceName:=cFNS;
  10176.           If Pos('.',FaceName)<>0 Then
  10177.           Begin
  10178.                Temp:=Copy(FaceName,1,Pos('.',FaceName)-1);
  10179.                Delete(FaceName,1,Pos('.',FaceName));
  10180.                Val(Temp,PointSize,C);
  10181.                If C=0 Then FDefaultFrameFont:=GetFontFromPointSize(FaceName,PointSize)
  10182.                Else FDefaultFrameFont:=DefaultFont;
  10183.           End;
  10184.      End
  10185.      Else FDefaultFrameFont:=DefaultFont;
  10186.  
  10187.      WinDestroyWindow(FHandle);
  10188.      {$ENDIF}
  10189.      {$IFDEF Win95}
  10190.      FMenuFont:=DefaultFont;
  10191.      FDefaultFrameFont:=DefaultFont;
  10192.      {$ENDIF}
  10193.  
  10194.      FForms.Create;
  10195.      FActiveForm:=Nil;
  10196.      CreateCursors;
  10197.      FCursor:=crDefault;
  10198.      Name:='Screen';
  10199.      FCanvas.Create(Nil);
  10200.      FCanvas.FOwnerDraw:=True;
  10201.  
  10202.      {$IFDEF OS2}
  10203.      FCanvas.Handle:=WinGetScreenPS(HWND_DESKTOP);
  10204.      GpiCreateLogColorTable(FCanvas.Handle,LCOL_RESET,LCOLF_RGB,0,0,Nil);
  10205.      {$ENDIF}
  10206.      {$IFDEF Win95}
  10207.      FCanvas.FHandle:=CreateDC('DISPLAY',Nil,Nil,Nil);
  10208.      FCanvas.FPenHandle:=CreatePen(PS_SOLID,0,0);  //Black solid Pen
  10209.      FCanvas.FBrushHandle:=CreateSolidBrush(0);    //Black Brush
  10210.      {$ENDIF}
  10211.      FCanvas.Init;
  10212.      FCanvas.Font:=DefaultFont; {small}
  10213. End;
  10214.  
  10215.  
  10216. Function TScreen.CreateCompatibleFont(Src:TFont):TFont;
  10217. Begin
  10218.      Result.Create(Screen);
  10219.      Result.FFontInfo:=Src.FFontInfo;
  10220.      Result.FFontType:=Src.FFontType;
  10221.      Result.FInternalPointSize:=Src.FInternalPointSize;
  10222.      Result.FCustom:=True;
  10223. End;
  10224.  
  10225.  
  10226. Function TScreen.GetFontFromPointSize(FaceName:String;PointSize:LongWord):TFont;
  10227. Var  T:LongInt;
  10228.      Font:TFont;
  10229.      {$IFDEF OS2}
  10230.      S,s1:String;
  10231.      _hps:LongWord;
  10232. Label l;
  10233.      {$ENDIF}
  10234.      {$IFDEF WIN32}
  10235. Var
  10236.      s,s1:String;
  10237.      b:Byte;
  10238.      aFontInfo:LOGFONT;
  10239.      tm:TEXTMETRIC;
  10240.      TempHandle:LongWord;
  10241.      {$ENDIF}
  10242. Var
  10243.      Attrs:TFontAttributes;
  10244. Label BoldItalic;
  10245. Begin
  10246.      Attrs:=[];
  10247.      {$IFDEF OS2}
  10248.      S:=FaceName;
  10249.      UpcaseStr(S);
  10250. L:
  10251.      For T:=Length(S) Downto 1 Do
  10252.      Begin
  10253.           If S[T]='.' Then
  10254.           Begin
  10255.                s1:=Copy(S,T+1,255);
  10256.                If ((s1='BOLD')Or(s1='ITALIC')Or(s1='UNDERSCORE')Or(s1='STRIKEOUT')Or
  10257.                    (s1='OUTLINE')) Then
  10258.                Begin
  10259.                     S[0]:=Chr(T-1);
  10260.                     FaceName[0]:=Chr(T-1);
  10261.  
  10262.                     If s1='BOLD' Then Attrs:=Attrs+[faBold]
  10263.                     Else If s1='ITALIC' Then Attrs:=Attrs+[faItalic]
  10264.                     Else If s1='UNDERSCORE' Then Attrs:=Attrs+[faUnderScore]
  10265.                     Else If s1='STRIKEOUT' Then Attrs:=Attrs+[faStrikeOut]
  10266.                     Else If s1='OUTLINE' Then Attrs:=Attrs+[faOutline];
  10267.                End;
  10268.           End;
  10269.      End;
  10270.      {$ENDIF}
  10271.  
  10272.      If FaceName='System Default Font' Then
  10273.      Begin
  10274.           Result:=DefaultFont;
  10275.           Exit;
  10276.      End;
  10277.  
  10278.      //don't allow To Set "Helv Bold.Bold" Or "Helv Italic.Italic" !
  10279.      S:=FaceName+' ';
  10280.      UpcaseStr(S);
  10281.      If Pos(' BOLD',S)<>0 Then Attrs:=Attrs-[faBold];
  10282.      If Pos(' ITALIC',S)<>0 Then Attrs:=Attrs-[faItalic];
  10283.  
  10284.      {$IFDEF WIN32}
  10285.      s1:=FaceName;
  10286.      UpcaseStr(s1);
  10287.      b:=pos('.BOLD',s1);
  10288.      If b<>0 Then
  10289.      Begin
  10290.           Attrs:=Attrs+[faBold];
  10291.           Delete(s1,b,length('.BOLD'));
  10292.           Delete(FaceName,b,length('.BOLD'));
  10293.      End;
  10294.      b:=pos('.ITALIC',s1);
  10295.      If b<>0 Then
  10296.      Begin
  10297.           Attrs:=Attrs+[faItalic];
  10298.           Delete(s1,b,length('.ITALIC'));
  10299.           Delete(FaceName,b,length('.ITALIC'));
  10300.      End;
  10301.      b:=pos('.OUTLINE',s1);
  10302.      If b<>0 Then
  10303.      Begin
  10304.           Attrs:=Attrs+[faOutLine];
  10305.           Delete(s1,b,length('.OUTLINE'));
  10306.           Delete(FaceName,b,length('.OUTLINE'));
  10307.      End;
  10308.      b:=pos('.STRIKEOUT',s1);
  10309.      If b<>0 Then
  10310.      Begin
  10311.           Attrs:=Attrs+[faStrikeOut];
  10312.           Delete(s1,b,length('.STRIKEOUT'));
  10313.           Delete(FaceName,b,length('.STRIKEOUT'));
  10314.      End;
  10315.      b:=pos('.UNDERSCORE',s1);
  10316.      If b<>0 Then
  10317.      Begin
  10318.           Attrs:=Attrs+[faUnderScore];
  10319.           Delete(s1,b,length('.UNDERSCORE'));
  10320.           Delete(FaceName,b,length('.UNDERSCORE'));
  10321.      End;
  10322.      {$ENDIF}
  10323.  
  10324.      If Attrs*[faBold,faItalic]=[faBold,faItalic] Then
  10325.      Begin
  10326.           //look If we Find A Bold Italic Font With the same Name !
  10327. BoldItalic:
  10328.           For T:=0 To Screen.FontCount-1 Do
  10329.           Begin
  10330.                s1:=Screen.Fonts[T].FaceName;
  10331.                UpcaseStr(s1);
  10332.                If Pos(S,s1)=1 Then If Pos(' BOLD ITALIC',s1)<>0 Then
  10333.                Begin
  10334.                     Attrs:=Attrs-[faBold,faItalic];
  10335.                     FaceName:=Screen.Fonts[T].FaceName;
  10336.                     break;
  10337.                End;
  10338.           End;
  10339.      End
  10340.      Else If Attrs*[faBold]<>[] Then
  10341.      Begin
  10342.           //look If we Find A Bold Font With the same Name !
  10343.           T:=Pos(' ITALIC',S);
  10344.           If T<>0 Then
  10345.           Begin
  10346.                Delete(S,T,7);
  10347.                Goto BoldItalic;
  10348.           End;
  10349.  
  10350.           For T:=0 To Screen.FontCount-1 Do
  10351.           Begin
  10352.                s1:=Screen.Fonts[T].FaceName;
  10353.                UpcaseStr(s1);
  10354.                If Pos(S,s1)=1 Then If Pos(' BOLD',s1)<>0 Then
  10355.                 If ((Pos(' ITALIC',s1)=0)Or(Pos(' ITALIC',S)<>0)) Then
  10356.                Begin
  10357.                     Attrs:=Attrs-[faBold];
  10358.                     FaceName:=Screen.Fonts[T].FaceName;
  10359.                     break;
  10360.                End;
  10361.           End;
  10362.      End
  10363.      Else If Attrs*[faItalic]<>[] Then
  10364.      Begin
  10365.           //look If we Find an Italic Font With the same Name !
  10366.           For T:=0 To Screen.FontCount-1 Do
  10367.           Begin
  10368.                s1:=Screen.Fonts[T].FaceName;
  10369.                UpcaseStr(s1);
  10370.                If Pos(S,s1)=1 Then If Pos(' ITALIC',s1)<>0 Then
  10371.                  If ((Pos(' BOLD',s1)=0)Or(Pos(' BOLD',S)<>0)) Then
  10372.                Begin
  10373.                     Attrs:=Attrs-[faItalic];
  10374.                     FaceName:=Screen.Fonts[T].FaceName;
  10375.                     break;
  10376.                End;
  10377.           End;
  10378.      End;
  10379.  
  10380.      {look If the Font Is already registered}
  10381.      Result:=Nil;
  10382.  
  10383.      For T:=0 To Screen.FontCount-1 Do
  10384.      Begin
  10385.           Font:=Screen.Fonts[T];
  10386.           If Font.FaceName=FaceName Then
  10387.             If Font.FInternalPointSize=PointSize Then
  10388.               If Font.Attributes=Attrs Then
  10389.             Begin
  10390.                  Result:=Font;
  10391.                  If Screen<>Nil Then
  10392.                  Begin
  10393.                       //don't return DefaultFont here, create a copy instead
  10394.                       If Result<>Screen.FDefaultFont Then exit;
  10395.                  End
  10396.                  Else Exit;
  10397.             End;
  10398.      End;
  10399.  
  10400.      If Result<>Nil Then //A defaultfont was previously found
  10401.      Begin
  10402.           Result:=CreateCompatibleFont(Result);
  10403.           Result.FCustom:=False;
  10404.           Result.FInternalPointSize:=PointSize;
  10405.           exit;
  10406.      End;
  10407.  
  10408.      Result:=Nil;
  10409.      {look If there Is A Font registered called FaceName}
  10410.      If FFonts<>Nil Then For T:=0 To FFonts.Count-1 Do
  10411.      Begin
  10412.           Font:=FFonts[T];
  10413.           If Font.FaceName=FaceName Then
  10414.           Begin
  10415.                Result:=CreateCompatibleFont(Font);
  10416.                Result.FCustom:=False;
  10417.                Result.FInternalPointSize:=PointSize;
  10418.  
  10419.                {$IFDEF OS2}
  10420.                S:=tostr(PointSize)+'.'+FaceName;
  10421.  
  10422.                S:=ModifyFontName(S,Attrs);
  10423.                If Not Screen.FFontWindow.SetPPFontNameSize(S) Then
  10424.                Begin
  10425.                     //Some Error occured
  10426.                     //ErrorBox2('Font could not be created:'+S);
  10427.                     Result.Destroy;
  10428.                     Result:=Nil;
  10429.                     Exit;
  10430.                End;
  10431.  
  10432.                _hps:=WinGetPS(Screen.FFontWindow.Handle{HWND_DESKTOP});
  10433.                If Not GpiQueryFontMetrics(_hps,SizeOf(FONTMETRICS),Result.FFontInfO) Then
  10434.                Begin
  10435.                     //Some Error occured
  10436.                     Result.Destroy;
  10437.                     Result:=Nil;
  10438.                     WinReleasePS(_hps);
  10439.                     Exit;
  10440.                End;
  10441.                WinReleasePS(_hps);
  10442.                Result.FFontType:=ftBitmap;
  10443.                If Result.FFontInfo.fsDefn And FM_DEFN_OUTLINE<>0 Then Result.FFontTypE:=FtOuTline;
  10444.  
  10445.                //don't allow To Set "Helv Bold.Bold" Or "Helv Italic.Italic" !
  10446.                If Attrs*[faBold]<>[] Then
  10447.                Begin
  10448.                     S:=Result.FaceName;
  10449.                     UpcaseStr(S);
  10450.                     If Pos(' BOLD',S)=0 Then Result.FFontInfo.fsSelection:=Result.FFoNtINfo.FsseleCtioN or fm_SEL_BOLD
  10451.                     Else Result.FFontInfo.fsSelection:=Result.FFontInfo.fsSelectioN And Not Fm_SeL_BOLD;
  10452.                End;
  10453.                If Attrs*[faItalic]<>[] Then
  10454.                Begin
  10455.                     S:=Result.FaceName;
  10456.                     UpcaseStr(S);
  10457.                     If Pos(' ITALIC',S)=0 Then Result.FFontInfo.fsSelection:=ResulT.FfonTinfO.fSselEctIoN or FM_SEL_ITALIC
  10458.                     Else Result.FFontInfo.fsSelection:=Result.FFontInfo.fsSelectioN And Not FM_SeL_ITALIC
  10459.                End;
  10460.  
  10461.                If Attrs*[faUnderScore]<>[] Then
  10462.                   Result.FFontInfo.fsSelection:=Result.FFontInfo.fsSelection Or FM_SEl_UNdeRSCORe;
  10463.                If Attrs*[faStrikeOut]<>[] Then
  10464.                   Result.FFontInfo.fsSelection:=Result.FFontInfo.fsSelection Or FM_SEl_STriKEOUT;
  10465.                If Attrs*[faOutline]<>[] Then
  10466.                   Result.FFontInfo.fsSelection:=Result.FFontInfo.fsSelection Or FM_SEl_OUtlINE;
  10467.                {$ENDIF}
  10468.                {$IFDEF Win95}
  10469.                Result.Attributes:=Attrs;
  10470.                Result.FFontInfo.lfHeight:=PointSize;
  10471.                Result.FFontInfo.lfWidth:=0;
  10472.  
  10473.                aFontInfo:=Result.FFontInfo;
  10474.                aFontInfo.lfHeight:=Result.FFontInfo.lfHeight;
  10475.                aFontInfo.lfWidth:=Result.FFontInfo.lfWidth;
  10476.                aFontInfo.lfQuality:=DRAFT_QUALITY;
  10477.                aFontInfo.lfItalic:=0;
  10478.                aFontInfo.lfUnderline:=0;
  10479.                aFontInfo.lfStrikeOut:=0;
  10480.                aFontInfo.lfWeight:=FW_NORMAL;
  10481.                TempHandle:=CreateFontIndirect(aFontInfo);
  10482.                SelectObject(FFontWindow.Canvas.Handle,TempHandle);
  10483.                FillChar(tm,sizeof(tm),0);
  10484.                GetTextMetrics(FFontWindow.Canvas.Handle,tm);
  10485.                //ErrorBox2('Height for FaceName='+FaceName+'='+tostr(tm.tmHeight)+' Width='+tostr(tm.tmMaxCharWidth));
  10486.                If tm.tmHeight<>0 Then Result.FFontInfo.lfHeight:=tm.tmHeight;
  10487.                Result.FFontInfo.lfWidth:=tm.tmMaxCharWidth;
  10488.                DeleteObject(TempHandle);
  10489.                {$ENDIF}
  10490.                FFonts.Add(Result);
  10491.                Exit;
  10492.           End;
  10493.      End;
  10494. End;
  10495.  
  10496. Function TScreen.GetControlFromPoint(pt:TPoint):TControl;
  10497. Var  ahwnd:LongWord;
  10498. Begin
  10499.      {$IFDEF OS2}
  10500.      ahwnd := WinWindowFromPoint(HWND_DESKTOP,pt,True);
  10501.      {$ENDIF}
  10502.      {$IFDEF Win32}
  10503.      TransformClientPoint(pt,Nil,Nil);
  10504.      ahwnd := WindowFromPoint(POINTL(pt));
  10505.      {$ENDIF}
  10506.      Result := HandleToControl(ahwnd);
  10507.  
  10508.      If not IsControl(Result) Then Result:=Nil;
  10509. End;
  10510.  
  10511.  
  10512. Function TScreen.SystemMetrics(sm:TSystemMetrics):LongInt;
  10513. Begin
  10514.      {$IFDEF OS2}
  10515.      Result := WinQuerySysValue(HWND_DESKTOP,sm);
  10516.      If sm = smCxMinMaxButton Then Result := Result Div 2;
  10517.      {$ENDIF}
  10518.      {$IFDEF Win32}
  10519.      Result := GetSystemMetrics(sm);
  10520.      {$ENDIF}
  10521. End;
  10522.  
  10523. Function TScreen.SystemColors(sc:TColor):TColor;
  10524. Begin
  10525.      Result := SysColorToRGB(sc);
  10526. End;
  10527.  
  10528.  
  10529. Function TScreen.GetFontFromName(FaceName:String;Height,Width:LongInt):TFont;
  10530. Var T:LongInt;
  10531.     DifY,DifX:Word;
  10532.     tx,ty:Word;
  10533.     Font:TFont;
  10534.     Attrs:TFontAttributes;
  10535. {$IFDEF OS2}
  10536.     S,s1:String;
  10537. Label L;
  10538. {$ENDIF}
  10539. Begin
  10540.      If FaceName='System Default Font' Then
  10541.      Begin
  10542.           Result:=DefaultFont;
  10543.           Exit;
  10544.      End;
  10545.  
  10546.      Attrs:=[];
  10547.      {$IFDEF OS2}
  10548.      S:=FaceName;
  10549.      UpcaseStr(S);
  10550. L:
  10551.      For T:=Length(S) Downto 1 Do
  10552.      Begin
  10553.           If S[T]='.' Then
  10554.           Begin
  10555.                s1:=Copy(S,T+1,255);
  10556.                If ((s1='BOLD')Or(s1='ITALIC')Or(s1='UNDERSCORE')Or(s1='STRIKEOUT')Or
  10557.                    (s1='OUTLINE')) Then
  10558.                Begin
  10559.                     S[0]:=Chr(T-1);
  10560.                     FaceName[0]:=Chr(T-1);
  10561.  
  10562.                     If s1='BOLD' Then Attrs:=Attrs+[faBold]
  10563.                     Else If s1='ITALIC' Then Attrs:=Attrs+[faItalic]
  10564.                     Else If s1='UNDERSCORE' Then Attrs:=Attrs+[faUnderScore]
  10565.                     Else If s1='STRIKEOUT' Then Attrs:=Attrs+[faStrikeOut]
  10566.                     Else If s1='OUTLINE' Then Attrs:=Attrs+[faOutline];
  10567.                     Goto L;
  10568.                End;
  10569.           End;
  10570.      End;
  10571.      {$ENDIF}
  10572.  
  10573.      //Attrs mit einbeziehen
  10574.  
  10575.      Result:=Nil;
  10576.      DifY:=65535;
  10577.      DifX:=65535;
  10578.      For T:=0 To FFonts.Count-1 Do
  10579.      Begin
  10580.           Font:=Fonts[T];
  10581.           {$IFDEF OS2}
  10582.           If Font.FFontInfo.szFaceName=FaceName Then
  10583.           Begin
  10584.                ty:=Abs(Font.FFontInfo.lMaxbaseLineExt-Height);
  10585.                tx:=Abs(Font.FFontInfo.LMaxCharInc-Width);
  10586.  
  10587.                If ty<=DifY Then If tx<=DifX Then
  10588.                Begin
  10589.                    Result:=Font;
  10590.                    DifY:=ty;
  10591.                    DifX:=tx;
  10592.                End;
  10593.           End;
  10594.           {$ENDIF}
  10595.           {$IFDEF Win95}
  10596.           If Font.FFontInfo.lfFaceName=FaceName Then
  10597.           Begin
  10598.                ty:=Abs(Font.FFontInfo.lfHeight-Height);
  10599.                If Font.FFontInfo.lfHeight=0 Then ty:=0;
  10600.                tx:=Abs(Font.FFontInfo.lfWidth-Width);
  10601.                If Font.FFontInfo.lfWidth=0 Then tx:=0;
  10602.  
  10603.                If ty<=DifY Then If tx<=DifX Then
  10604.                Begin
  10605.                    Result:=Font;
  10606.                    DifY:=ty;
  10607.                    DifX:=tx;
  10608.                End
  10609.                Else
  10610.                Begin
  10611.                     If ty<=DifY Then
  10612.                     Begin
  10613.                          {tx greater}
  10614.                          If tx-DifX<DifY-ty Then
  10615.                          Begin
  10616.                               Result:=Font;
  10617.                               DifY:=ty;
  10618.                               DifX:=tx;
  10619.                          End;
  10620.                     End
  10621.                     Else If tx<=DifX Then
  10622.                     Begin
  10623.                          {ty greater}
  10624.                          If ty-DifY<DifX-tx Then
  10625.                          Begin
  10626.                               Result:=Font;
  10627.                               DifY:=ty;
  10628.                               DifX:=tx;
  10629.                          End;
  10630.                     End;
  10631.                End;
  10632.           End;
  10633.           {$ENDIF}
  10634.      End;
  10635. End;
  10636.  
  10637.  
  10638. Function TScreen.GetSystemFixedFont:TFont;
  10639. Var  I:LongInt;
  10640.      F:TFont;
  10641. Begin
  10642.      {$IFDEF OS2}
  10643.      Result := GetFontFromName('Courier',16,9);
  10644.      {$ENDIF}
  10645.      {$IFDEF Win32}
  10646.      Result := GetFontFromName('Fixedsys',15,8);
  10647.      {$ENDIF}
  10648.  
  10649.      If Result = Nil Then
  10650.      For I := 0 To Screen.FontCount-1 Do
  10651.      Begin
  10652.           F := Screen.Fonts[I];
  10653.           If F.Pitch = fpFixed Then
  10654.             If F.FontType = ftBitmap Then
  10655.             Begin
  10656.                  Result := F;
  10657.                  Exit;
  10658.             End;
  10659.      End;
  10660.      If Result = Nil Then Result := GetSystemDefaultFont; {never return Nil}
  10661. End;
  10662.  
  10663.  
  10664. Function TScreen.GetSystemDefaultFont:TFont;
  10665. Begin
  10666.      If FSystemFont<>Nil Then
  10667.      Begin
  10668.           Result:=FSystemFont;
  10669.           Exit;
  10670.      End;
  10671.  
  10672.      {$IFDEF OS2}
  10673.      If FDefaultFont<>Nil Then Result:=FDefaultFont
  10674.      Else
  10675.      Begin
  10676.           Result:=GetFontFromPointSize('System Proportional',10);
  10677.           If Result=Nil Then Result := GetFontFromName('System Proportional',20,16);
  10678.      End;
  10679.      //If Result <> Nil Then Result.FFontInfo.usCodePage := 850;
  10680.      {$ENDIF}
  10681.      {$IFDEF Win95}
  10682.      If FDefaultFont<>Nil Then Result:=FDefaultFont
  10683.      Else
  10684.      Begin
  10685.           Result := GetFontFromName('MS Sans Serif',15,5);
  10686.           If Result=Nil Then Result := GetFontFromName('Fixedsys',15,8);
  10687.      End;
  10688.      {$ENDIF}
  10689. End;
  10690.  
  10691. Function TScreen.GetSystemSmallFont:TFont;
  10692. Begin
  10693.      If Width > 800 Then  //big Fonts
  10694.      Begin
  10695.           {$IFDEF OS2}
  10696.           Result := GetFontFromPointSize('Helv',8);
  10697.           {$ENDIF}
  10698.           {$IFDEF Win32}
  10699.           Result := GetFontFromName('MS Sans Serif',15,5);
  10700.           If Result = Nil Then Result := GetFontFromName('Arial',16,6);
  10701.           {$ENDIF}
  10702.      End
  10703.      Else
  10704.      Begin
  10705.           {$IFDEF OS2}
  10706.           Result := GetFontFromPointSize('Helv',8);
  10707.           {$ENDIF}
  10708.           {$IFDEF Win32}
  10709.           Result := GetFontFromName('MS Sans Serif',15,5);
  10710.           If Result = Nil Then Result := GetFontFromName('Arial',14,5);
  10711.           {$ENDIF}
  10712.      End;
  10713.      If Result = Nil Then Result := GetSystemDefaultFont;
  10714. End;
  10715.  
  10716.  
  10717. Function TScreen.GetFormCount:LongInt;
  10718. Begin
  10719.      Result := FForms.Count;
  10720. End;
  10721.  
  10722.  
  10723. Function TScreen.GetForm(Index:LongInt):TForm;
  10724. Begin
  10725.      Result := FForms.Items[Index];
  10726. End;
  10727.  
  10728.  
  10729. Function TScreen.GetFontCount:LongInt;
  10730. Begin
  10731.      Result:=FFonts.Count;
  10732. End;
  10733.  
  10734. Function TScreen.GetFont(Index:LongInt):TFont;
  10735. Begin
  10736.      Result:=FFonts.Items[Index];
  10737. End;
  10738.  
  10739. Function TScreen.GetMousePos:TPoint;
  10740. Begin
  10741.      {$IFDEF OS2}
  10742.      WinQueryPointerPos(HWND_DESKTOP,Result);
  10743.      {$ENDIF}
  10744.      {$IFDEF Win32}
  10745.      WinUser.GetCursorPos(Result);
  10746.      TransformClientPoint(Result,Nil,Nil);
  10747.      {$ENDIF}
  10748. End;
  10749.  
  10750. Procedure TScreen.SetMousePos(NewPos:TPoint);
  10751. Begin
  10752.      {$IFDEF OS2}
  10753.      WinSetPointerPos(HWND_DESKTOP,NewPos.X,NewPos.Y);
  10754.      {$ENDIF}
  10755.      {$IFDEF Win32}
  10756.      TransformClientPoint(NewPos,Nil,Nil);
  10757.      WinUser.SetCursorPos(NewPos.X,NewPos.Y);
  10758.      {$ENDIF}
  10759. End;
  10760.  
  10761. Destructor TScreen.Destroy;
  10762. Begin
  10763.      FFonts.Destroy;
  10764.      FFonts := Nil;
  10765.      FForms.Destroy;
  10766.      FForms := Nil;
  10767.      FFontWindow.Destroy;
  10768.      FFontWindow := Nil;
  10769.      FHiddenWindow.Destroy;
  10770.      FHiddenWindow := Nil;
  10771.      DestroyCursors;
  10772.  
  10773.      Inherited Destroy;  //Destroys All owned Components As well
  10774.  
  10775.      If Self=Screen Then Screen:=Nil;
  10776. End;
  10777.  
  10778. Procedure TScreen.CreateCursors;
  10779. Begin
  10780.      DestroyCursors;
  10781.  
  10782.      {$IFDEF OS2}
  10783.      InsertCursor(crDefault,WinQuerySysPointer(HWND_DESKTOP,SPTR_ARROW,False));
  10784.      InsertCursor(crArrow,WinQuerySysPointer(HWND_DESKTOP,SPTR_ARROW,False));
  10785.      InsertCursor(crCross,WinLoadPointer(HWND_DESKTOP,0,21));
  10786.      InsertCursor(crIBeam,WinQuerySysPointer(HWND_DESKTOP,SPTR_TEXT,False));
  10787.      InsertCursor(crSize,WinQuerySysPointer(HWND_DESKTOP,SPTR_MOVE,False));
  10788.      InsertCursor(crSizeNESW,WinQuerySysPointer(HWND_DESKTOP,SPTR_SIZENESW,False));
  10789.      InsertCursor(crSizeNS,WinQuerySysPointer(HWND_DESKTOP,SPTR_SIZENS,False));
  10790.      InsertCursor(crSizeNWSE,WinQuerySysPointer(HWND_DESKTOP,SPTR_SIZENWSE,False));
  10791.      InsertCursor(crSizeWE,WinQuerySysPointer(HWND_DESKTOP,SPTR_SIZEWE,False));
  10792.      InsertCursor(crUpArrow,WinLoadPointer(HWND_DESKTOP,0,Abs(crUpArrow)));
  10793.      InsertCursor(crHourGlass,WinQuerySysPointer(HWND_DESKTOP,SPTR_WAIT,False));
  10794.      InsertCursor(crDrag,WinQuerySysPointer(HWND_DESKTOP,SPTR_FILE,False));
  10795.      InsertCursor(crNoDrop,WinQuerySysPointer(HWND_DESKTOP,SPTR_ILLEGAL,False));
  10796.      InsertCursor(crHSplit,WinLoadPointer(HWND_DESKTOP,0,Abs(crHSplit)));
  10797.      InsertCursor(crVSplit,WinLoadPointer(HWND_DESKTOP,0,Abs(crVSplit)));
  10798.      InsertCursor(crMultiDrag,WinQuerySysPointer(HWND_DESKTOP,SPTR_MULTFILE,False));
  10799.      InsertCursor(crSQLWait,WinLoadPointer(HWND_DESKTOP,0,Abs(crSQLWait)));
  10800.      InsertCursor(crNo,WinQuerySysPointer(HWND_DESKTOP,SPTR_ICONERROR,False));
  10801.      InsertCursor(crAppStart,WinLoadPointer(HWND_DESKTOP,0,Abs(crAppStart)));
  10802.      InsertCursor(crHelp,WinLoadPointer(HWND_DESKTOP,0,Abs(crHelp)));
  10803.      {$ENDIF}
  10804.  
  10805.      {$IFDEF Win32}
  10806.      InsertCursor(crDefault,LoadCursor(0,IDC_ARROW));
  10807.      InsertCursor(crArrow,LoadCursor(0,IDC_ARROW));
  10808.      InsertCursor(crCross,LoadCursor(DllModule,MAKEINTRESOURCE(21)));
  10809.      InsertCursor(crIBeam,LoadCursor(0,IDC_IBEAM));
  10810.      InsertCursor(crSize,LoadCursor(0,IDC_SIZE));
  10811.      InsertCursor(crSizeNESW,LoadCursor(0,IDC_SIZENESW));
  10812.      InsertCursor(crSizeNS,LoadCursor(0,IDC_SIZENS));
  10813.      InsertCursor(crSizeNWSE,LoadCursor(0,IDC_SIZENWSE));
  10814.      InsertCursor(crSizeWE,LoadCursor(0,IDC_SIZEWE));
  10815.      InsertCursor(crUpArrow,LoadCursor(0,IDC_UPARROW));
  10816.      InsertCursor(crHourGlass,LoadCursor(0,IDC_WAIT));
  10817.      InsertCursor(crDrag,LoadCursor(DllModule,MAKEINTRESOURCE(12)));
  10818.      InsertCursor(crNoDrop,LoadCursor(0,IDC_NO));
  10819.      InsertCursor(crHSplit,LoadCursor(DllModule,IDC_HSPLIT));
  10820.      InsertCursor(crVSplit,LoadCursor(DllModule,IDC_VSPLIT));
  10821.      InsertCursor(crMultiDrag,LoadCursor(0,IDC_MULTIDRAG));
  10822.      InsertCursor(crSQLWait,LoadCursor(DllModule,MAKEINTRESOURCE(17)));
  10823.      InsertCursor(crNo,LoadCursor(0,IDC_NO));
  10824.      InsertCursor(crAppStart,LoadCursor(0,IDC_APPSTARTING));
  10825.      InsertCursor(crHelp,LoadCursor(DllModule,IDC_HELP));
  10826.      {$ENDIF}
  10827. End;
  10828.  
  10829.  
  10830. Procedure TScreen.DestroyCursors;
  10831. Var  dummy:PCursorRec;
  10832. Begin
  10833.      While FCursorList <> Nil Do
  10834.      Begin
  10835.           {$IFDEF Win32}
  10836.           DestroyCursor(FCursorList^.Handle);
  10837.           {$ENDIF}
  10838.           dummy := FCursorList^.Next;
  10839.           Dispose(FCursorList);
  10840.           FCursorList := dummy;
  10841.      End;
  10842.      FDefaultCursor := 0;
  10843. End;
  10844.  
  10845.  
  10846. Procedure TScreen.SetCursors(Index:TCursor;Handle:HCursor);
  10847. Begin
  10848.      If Index = crNone Then Exit;
  10849.  
  10850.      DeleteCursor(Index);
  10851.      If Handle <> 0 Then
  10852.      Begin
  10853.           InsertCursor(Index, Handle);
  10854.           If Index = crDefault Then FDefaultCursor := Handle;
  10855.      End;
  10856. End;
  10857.  
  10858.  
  10859. Function TScreen.GetCursors(Index:TCursor):HCursor;
  10860. Var  dummy:PCursorRec;
  10861. Begin
  10862.      Result := 0;
  10863.      If Index = crNone Then Exit;
  10864.  
  10865.      dummy := FCursorList;
  10866.      While dummy <> Nil Do
  10867.      Begin
  10868.           If dummy^.Index = Index Then
  10869.           Begin
  10870.                Result := dummy^.Handle;
  10871.                Exit;
  10872.           End;
  10873.           dummy := dummy^.Next;
  10874.      End;
  10875.      Result := FDefaultCursor;
  10876. End;
  10877.  
  10878.  
  10879. Procedure TScreen.InsertCursor(Index:TCursor;Handle:HCursor);
  10880. Var  dummy:PCursorRec;
  10881. Begin
  10882.      New(dummy);
  10883.      dummy^.Next := FCursorList;
  10884.      dummy^.Index := Index;
  10885.      dummy^.Handle := Handle;
  10886.      FCursorList := dummy;
  10887. End;
  10888.  
  10889.  
  10890. Function TScreen.AddCursor(Handle:HCursor):TCursor;
  10891. Var dummy:PCursorRec;
  10892. Begin
  10893.      //look For the Next Free TCursor Handle
  10894.      Result:=TCursor(crDefault+1);
  10895.      While True Do
  10896.      Begin
  10897.           //look If the TCursor Handle Is used by another user...
  10898.           dummy:=FCursorList;
  10899.           While dummy<>Nil Do
  10900.           Begin
  10901.                If dummy^.Index=Result Then break;
  10902.                dummy:=dummy^.Next;
  10903.           End;
  10904.  
  10905.           If dummy=Nil Then break; //the Item Is available
  10906.           Inc(Result);
  10907.      End;
  10908.  
  10909.      InsertCursor(Result,Handle);
  10910. End;
  10911.  
  10912.  
  10913. Procedure TScreen.DeleteCursor(Index:TCursor);
  10914. Var  dummy,Prev:PCursorRec;
  10915. Begin
  10916.      Prev := Nil;
  10917.      dummy := FCursorList;
  10918.      While dummy <> Nil Do
  10919.      Begin
  10920.           If dummy^.Index = Index Then
  10921.           Begin
  10922.                If Prev = Nil Then FCursorList := dummy^.Next
  10923.                Else Prev^.Next := dummy^.Next;
  10924.                {$IFDEF Win32}
  10925.                DestroyCursor(dummy^.Handle);
  10926.                {$ENDIF}
  10927.                Dispose(dummy);
  10928.                Exit;
  10929.           End;
  10930.           dummy := dummy^.Next;
  10931.      End;
  10932. End;
  10933.  
  10934.  
  10935. Procedure TScreen.SetCursor(Index:TCursor);
  10936. Var  Control:TControl;
  10937. Begin
  10938.      FCursor := Index;
  10939.      Control := GetControlFromPoint(MousePos);
  10940.      If Control <> Nil Then Control.Cursor := Control.Cursor;
  10941. End;
  10942.  
  10943.  
  10944. Function TScreen.GetHeight:LongInt;
  10945. Begin
  10946.      Result := SystemMetrics(smCyScreen);
  10947. End;
  10948.  
  10949.  
  10950. Function TScreen.GetWidth:LongInt;
  10951. Begin
  10952.      Result := SystemMetrics(smCxScreen);
  10953. End;
  10954.  
  10955.  
  10956. Procedure TScreen.UpdateLastActive;
  10957. Begin
  10958.      If FLastActiveForm <> FActiveForm Then
  10959.      Begin
  10960.           FLastActiveForm := FActiveForm;
  10961.           If FOnActiveFormChange <> Nil Then FOnActiveFormChange(Self);
  10962.      End;
  10963.  
  10964.      If FLastActiveControl <> FActiveControl Then
  10965.      Begin
  10966.           FLastActiveControl := FActiveControl;
  10967.           If FOnActiveControlChange <> Nil Then FOnActiveControlChange(Self);
  10968.      End;
  10969. End;
  10970.  
  10971. {
  10972. ╔═══════════════════════════════════════════════════════════════════════════╗
  10973. ║                                                                           ║
  10974. ║ Speed-Pascal/2 Version 2.0                                                ║
  10975. ║                                                                           ║
  10976. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  10977. ║                                                                           ║
  10978. ║ This section: TGraphic Class Implementation                               ║
  10979. ║                                                                           ║
  10980. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  10981. ║                                                                           ║
  10982. ╚═══════════════════════════════════════════════════════════════════════════╝
  10983. }
  10984.  
  10985. Constructor TGraphic.Create;
  10986. Begin
  10987.      Inherited Create(Nil);
  10988. End;
  10989.  
  10990. Procedure TGraphic.LoadFromFile(Const FileName:String);
  10991. Var
  10992.    FileStream:TStream;
  10993. Begin
  10994.      FileStream:=TFileStream.Create(FileName, Stream_OpenRead);
  10995.      Try
  10996.          LoadFromStream(FileStream);
  10997.      Finally
  10998.          FileStream.Destroy;
  10999.      End;
  11000. End;
  11001.  
  11002. Procedure TGraphic.SaveToFile(Const FileName:String);
  11003. Var
  11004.    FileStream:TStream;
  11005. Begin
  11006.      FileStream:=TFileStream.Create(FileName,Stream_Create);
  11007.      Try
  11008.          SaveToStream(FileStream);
  11009.      Finally
  11010.          FileStream.Destroy;
  11011.      End;
  11012. End;
  11013.  
  11014. Procedure TGraphic.changed;
  11015. Begin
  11016.      If FOnChangedNotify<>Nil Then FOnChangedNotify(Self);
  11017.      If FOnChange<>Nil Then FOnChange(Self);
  11018. End;
  11019.  
  11020.  
  11021. {
  11022. ╔═══════════════════════════════════════════════════════════════════════════╗
  11023. ║                                                                           ║
  11024. ║ Speed-Pascal/2 Version 2.0                                                ║
  11025. ║                                                                           ║
  11026. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  11027. ║                                                                           ║
  11028. ║ This section: TPalette Class Implementation                               ║
  11029. ║                                                                           ║
  11030. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  11031. ║                                                                           ║
  11032. ╚═══════════════════════════════════════════════════════════════════════════╝
  11033. }
  11034.  
  11035. {$IFDEF WIN32}
  11036. Type PPaletteEntryArray=^TPaletteEntryArray;
  11037.      TPaletteEntryArray=Array[0..1] Of PALETTEENTRY;
  11038. {$ENDIF}
  11039. {$IFDEF OS2}
  11040. Type PPaletteEntryArray=^TPaletteEntryArray;
  11041.      TPaletteEntryArray=Array[0..1] Of RGB2;
  11042. {$ENDIF}
  11043.  
  11044. Procedure TPalette.SetupComponent;
  11045. Begin
  11046.      Inherited SetupComponent;
  11047.  
  11048.      Name:='Palette';
  11049.  
  11050.      If Owner Is TCanvas Then FCanvas:=TCanvas(Owner);
  11051. End;
  11052.  
  11053. Function TPalette.GetHandle:LongWord;
  11054. {$IFDEF WIN32}
  11055. Var lp:LOGPALETTE;
  11056.     Temp:LongWord;
  11057. {$ENDIF}
  11058. Begin
  11059.      If FHandle<>0 Then Result:=FHandle
  11060.      Else If FCanvas<>Nil Then
  11061.      Begin
  11062.           FCanvas:=TCanvas(Owner);
  11063.  
  11064.           {$IFDEF OS2}
  11065.           Result:=GpiQueryPalette(FCanvas.Handle);
  11066.           {$ENDIF}
  11067.           {$IFDEF WIN32}
  11068.           lp.palVersion:=$300;
  11069.           lp.palNumEntries:=1;
  11070.           Temp:=CreatePalette(lp);
  11071.           Result:=SelectPalette(FCanvas.Handle,Temp,False);
  11072.           SelectPalette(FCanvas.Handle,Result,False);
  11073.           DeleteObject(Temp);
  11074.           {$ENDIF}
  11075.  
  11076.           FHandle:=Result;
  11077.      End
  11078. End;
  11079.  
  11080. Procedure TPalette.CreateNew(Var Colors:Array Of TColor);
  11081. Var
  11082.     {$IFDEF OS2}
  11083.     Entries:PPaletteEntryArray;
  11084.     {$ENDIF}
  11085.     {$IFDEF WIN32}
  11086.     Entries:^LOGPALETTE;
  11087.     {$ENDIF}
  11088.     Count:LongWord;
  11089.     t:LongInt;
  11090. Begin
  11091.      Count:=High(Colors)+1;
  11092.      {$IFDEF OS2}
  11093.      GetMem(Entries,Count*sizeof(RGB2));
  11094.      For t:=0 To Count-1 Do
  11095.      Begin
  11096.           Entries^[t].bRed:=TRGB(Colors[t]).Red;
  11097.           Entries^[t].bGreen:=TRGB(Colors[t]).Green;
  11098.           Entries^[t].bBlue:=TRGB(Colors[t]).Blue;
  11099.           Entries^[t].fcOptions:=0;
  11100.      End;
  11101.      FHandle:=GpiCreatePalette(AppHandle,
  11102.                                0{LCOL_OVERRIDE_DEFAULT_COLORS},
  11103.                                LCOLF_CONSECRGB,
  11104.                                Count,
  11105.                                Entries^);
  11106.      FreeMem(Entries,Count*sizeof(RGB2));
  11107.      {$ENDIF}
  11108.      {$IFDEF WIN32}
  11109.      GetMem(Entries,sizeof(LOGPALETTE)+Count*sizeof(PALETTEENTRY));
  11110.      Entries^.palVersion:=$300;
  11111.      Entries^.palNumEntries:=Count;
  11112.      For t:=0 To Count-1 Do
  11113.      Begin
  11114.           Entries^.palPalEntry[t].peRed:=TRGB(Colors[t]).Red;
  11115.           Entries^.palPalEntry[t].peGreen:=TRGB(Colors[t]).Green;
  11116.           Entries^.palPalEntry[t].peBlue:=TRGB(Colors[t]).Blue;
  11117.           Entries^.palPalEntry[t].peFlags:=0;
  11118.      End;
  11119.      FHandle:=CreatePalette(Entries^);
  11120.      GetMem(Entries,sizeof(LOGPALETTE)+Count*sizeof(PALETTEENTRY));
  11121.      {$ENDIF}
  11122. End;
  11123.  
  11124. Procedure TPalette.RealizePalette;
  11125. Begin
  11126.      If FCanvas=Nil Then exit;
  11127.  
  11128.      {$IFDEF OS2}
  11129.      GpiSelectPalette(FCanvas.Handle,Handle);
  11130.      {$ENDIF}
  11131.      {$IFDEF WIN32}
  11132.      SelectPalette(FCanvas.Handle,Handle,False);
  11133.      WinGDI.RealizePalette(FCanvas.Handle);
  11134.      {$ENDIF}
  11135. End;
  11136.  
  11137. Function TPalette.GetColor(Index:LongWord):TColor;
  11138. Var CArray:Array[1..1] Of TColor;
  11139. Begin
  11140.      GetColorArray(Index,CArray);
  11141.      Result:=CArray[1];
  11142. End;
  11143.  
  11144. Procedure TPalette.SetColor(Index:LongWord;NewColor:TColor);
  11145. Var CArray:Array[1..1] Of TColor;
  11146. Begin
  11147.      CArray[1]:=NewColor;
  11148.      SetColorArray(Index,CArray);
  11149. End;
  11150.  
  11151. Function TPalette.GetColorArray(StartIndex:LongWord;Var ResultArray:Array Of TColor):Longword;
  11152. Var Count:LongWord;
  11153.     {$IFDEF WIN32}
  11154.     Entries:PPaletteEntryArray;
  11155.     t:LongInt;
  11156.     {$ENDIF}
  11157. Begin
  11158.      Count:=High(ResultArray)+1;
  11159.      {$IFDEF OS2}
  11160.      Result:=GpiQueryPaletteInfo(Handle,Canvas.Handle,0,StartIndex,Count,ResultArray);
  11161.      {$ENDIF}
  11162.      {$IFDEF Win32}
  11163.      GetMem(Entries,Count*sizeof(PALETTEENTRY));
  11164.      Result:=GetPaletteEntries(Handle,StartIndex,Count,Entries^[0]);
  11165.      If Result<>0 Then
  11166.      Begin
  11167.           For t:=0 To Count-1 Do
  11168.             ResultArray[t]:=ValuesToRGB(Entries^[t].peRed,Entries^[t].peGreen,Entries^[t].peBlue);
  11169.      End;
  11170.      FreeMem(Entries,Count*sizeof(PALETTEENTRY));
  11171.      {$ENDIF}
  11172. End;
  11173.  
  11174. Procedure TPalette.SetColorArray(StartIndex:LongWord;Const SourceArray:Array Of TColor);
  11175. Var
  11176.    Count:LongInt;
  11177.    {$IFDEF WIN32}
  11178.    Entries:PPaletteEntryArray;
  11179.    t:LongInt;
  11180.    {$ENDIF}
  11181. Begin
  11182.      Count:=High(SourceArray)+1;
  11183.      {$IFDEF OS2}
  11184.      GpiSetPaletteEntries(Handle,LCOLF_CONSECRGB,StartIndex,Count,SourceARray);
  11185.      {$ENDIF}
  11186.      {$IFDEF Win32}
  11187.      GetMem(Entries,Count*sizeof(PALETTEENTRY));
  11188.      For t:=0 To Count-1 Do
  11189.      Begin
  11190.           Entries^[t].peRed:=TRGB(SourceArray[t]).Red;
  11191.           Entries^[t].peGreen:=TRGB(SourceArray[t]).Green;
  11192.           Entries^[t].peBlue:=TRGB(SourceArray[t]).Blue;
  11193.           Entries^[t].peFlags:=0;
  11194.      End;
  11195.      SetPaletteEntries(Handle,StartIndex,Count,Entries^[0]);
  11196.      FreeMem(Entries,Count*sizeof(PALETTEENTRY));
  11197.      {$ENDIF}
  11198. End;
  11199.  
  11200. Function TPalette.GetColorCount:LongWord;
  11201. Begin
  11202.      {$IFDEF OS2}
  11203.      Result:=GpiQueryPaletteInfo(Handle,Canvas.Handle,0,0,0,Nil);
  11204.      {$ENDIF}
  11205.      {$IFDEF Win32}
  11206.      Result:=0;
  11207.      GetObject(Handle,4,Result);
  11208.      {$ENDIF}
  11209. End;
  11210.  
  11211.  
  11212. {
  11213. ╔═══════════════════════════════════════════════════════════════════════════╗
  11214. ║                                                                           ║
  11215. ║ Speed-Pascal/2 Version 2.0                                                ║
  11216. ║                                                                           ║
  11217. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  11218. ║                                                                           ║
  11219. ║ This section: TPen Class Implementation                                   ║
  11220. ║                                                                           ║
  11221. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  11222. ║                                                                           ║
  11223. ╚═══════════════════════════════════════════════════════════════════════════╝
  11224. }
  11225.  
  11226. Procedure TPen.SetupComponent;
  11227. Begin
  11228.      Inherited SetupComponent;
  11229.      Name:='Pen';
  11230.      If Owner Is TCanvas Then
  11231.        If not (csWriting IN ComponentState) Then FCanvas:=TCanvas(Owner);
  11232.      Include(DesignerState, dsStored);
  11233.      Width:=1;
  11234.      color:=clBlack;
  11235.      Mode:=pmCopy;
  11236.      Style:=psSolid;
  11237. End;
  11238.  
  11239. Procedure TPen.Assign(Source:TPersistent);
  11240. Begin
  11241.      If not (Source Is TPen) Then Inherited Assign(Source)
  11242.      Else
  11243.      Begin
  11244.           Color:=TPen(Source).Color;
  11245.           Mode:=TPen(Source).Mode;
  11246.           Style:=TPen(Source).Style;
  11247.           Width:=TPen(Source).Width;
  11248.      End;
  11249. End;
  11250.  
  11251. {$IFDEF WIN32}
  11252. Procedure CreateWin32Pen(Canvas:TCanvas);
  11253. Begin
  11254.      If Canvas.FPenHandle<>0 Then exit;
  11255.      Canvas.FPenHandle:=GetStockObject(BLACK_PEN); //CreatePen(PS_SOLID,0,0);
  11256.      If Canvas.FHandle<>0 Then SelectObject(Canvas.FHandle,Canvas.FPenHandle);
  11257. End;
  11258.  
  11259. Procedure CreateWin32Brush(Canvas:TCanvas);
  11260. Begin
  11261.      If Canvas.FBrushHandle<>0 Then exit;
  11262.      Canvas.FBrushHandle:=GetStockObject(WHITE_BRUSH); //CreateSolidBrush(0);
  11263.      If Canvas.FHandle<>0 Then SelectObject(Canvas.FHandle,Canvas.FBrushHandle);
  11264. End;
  11265. {$ENDIF}
  11266.  
  11267. Procedure TPen.SetColor(NewColor:TColor);
  11268. {$IFDEF Win32}
  11269. Var lp:LOGPEN;
  11270.     lb:LOGBRUSH;
  11271.     NewPen:LongWord;
  11272.     NewBrush:LongWord;
  11273. {$ENDIF}
  11274. Begin
  11275.      FColor := NewColor;   {Store original Value, Not the Modified one}
  11276.  
  11277.      If FCanvas <> Nil Then
  11278.      Begin
  11279.           {$IFDEF WIN32}
  11280.           If not (FCanvas.FOwnerDraw) Then exit; //not ownerdraw
  11281.           {$ENDIF}
  11282.  
  11283.           NewColor := SysColorToRGB(NewColor);
  11284.           {$IFDEF OS2}
  11285.           GpiSetColor(FCanvas.FHandle,NewColor);
  11286.           {$ENDIF}
  11287.           {$IFDEF Win32}
  11288.           NewColor := RGBToWinColor(NewColor);
  11289.  
  11290.           CreateWin32Pen(FCanvas);
  11291.           GetObject(FCanvas.FPenHandle,SizeOf(LOGPEN),lp);
  11292.           lp.lopnColor:=NewColor;
  11293.           NewPen:=CreatePenIndirect(lp);
  11294.           If FCanvas.FHandle<>0 Then SelectObject(FCanvas.FHandle,NewPen);
  11295.           If FCanvas.FPenHandle<>0 Then DeleteObject(FCanvas.FPenHandle);
  11296.           FCanvas.FPenHandle:=NewPen;
  11297.  
  11298.           CreateWin32Brush(FCanvas);
  11299.           GetObject(FCanvas.FBrushHandle,SizeOf(LOGBRUSH),lb);
  11300.           lb.lbColor:=NewColor;
  11301.           NewBrush:=CreateBrushIndirect(lb);
  11302.           If FCanvas.FHandle<>0 Then SelectObject(FCanvas.FHandle,NewBrush);
  11303.           If FCanvas.FBrushHandle<>0 Then DeleteObject(FCanvas.FBrushHandle);
  11304.           FCanvas.FBrushHandle:=NewBrush;
  11305.           WinGDI.SetTextColor(FCanvas.FHandle,NewColor);
  11306.           {$ENDIF}
  11307.      End;
  11308. End;
  11309.  
  11310.  
  11311. Procedure TPen.SetMode(NewMode:TPenMode);
  11312. {$IFDEF OS2}
  11313. Const FgModes:Array[pmBlack..pmNotXor] Of LongWord=
  11314.                 (FM_ZERO,FM_ONE,FM_LEAVEALONE,FM_INVERT,
  11315.                  FM_OVERPAINT,FM_NOTCOPYSRC,FM_MERGESRCNOT,FM_MASKSRCNOT,FM_MERGENOTSRC,
  11316.                  FM_SUBTRACT,FM_OR,FM_NOTMERGESRC,FM_AND,FM_NOTMASKSRC,
  11317.                  FM_XOR,FM_NOTXORSRC);
  11318. {$ENDIF}
  11319. {$IFDEF Win32}
  11320. Const FgModes:Array[pmBlack..pmNotXor] Of LongWord=
  11321.                 (R2_BLACK,R2_WHITE,R2_NOP,R2_NOT,
  11322.                  R2_COPYPEN,R2_NOTCOPYPEN,R2_MERGEPENNOT,R2_MASKPENNOT,R2_MERGENOTPEN,
  11323.                  R2_MASKNOTPEN,R2_MERGEPEN,R2_NOTMERGEPEN,R2_MASKPEN,R2_NOTMASKPEN,
  11324.                  R2_XORPEN,R2_NOTXORPEN);
  11325. {$ENDIF}
  11326. Var NewMode1:LongWord;
  11327. Begin
  11328.      FMode:=NewMode;
  11329.      If FCanvas = Nil Then Exit;
  11330.      FCanvas.FForeMix:=NewMode;
  11331.      NewMode1:=FgModes[NewMode];
  11332.      {$IFDEF Win32}
  11333.      SetROP2(FCanvas.FHandle,NewMode1);
  11334.      {$ENDIF}
  11335.      {$IFDEF OS2}
  11336.      GpiSetMix(FCanvas.FHandle,NewMode1);
  11337.      {$ENDIF}
  11338. End;
  11339.  
  11340.  
  11341. Procedure TPen.SetStyle(NewStyle:TPenStyle);
  11342. {$IFDEF Win32}
  11343. Const LineStyles:Array[psSolid..psInsideFrame] Of LongWord=
  11344.                    (PS_SOLID,PS_DASH,PS_DOT,PS_DASHDOT,PS_DASHDOTDOT,
  11345.                     PS_NULL,PS_INSIDEFRAME);
  11346. {$ENDIF}
  11347. {$IFDEF OS2}
  11348. Const LineStyles:Array[psSolid..psInsideFrame] Of LongWord=
  11349.                    (LINETYPE_SOLID,LINETYPE_LONGDASH,LINETYPE_DOT,
  11350.                     LINETYPE_DASHDOT,LINETYPE_DASHDOUBLEDOT,
  11351.                     LINETYPE_INVISIBLE,LINETYPE_ALTERNATE);
  11352. {$ENDIF}
  11353. {$IFDEF Win32}
  11354. Var PenData:LOGPEN;
  11355.     NewPen:LongWord;
  11356. {$ENDIF}
  11357. Var NewStyle1:LongWord;
  11358. Begin
  11359.      FStyle:=NewStyle;
  11360.      If FCanvas = Nil Then Exit;
  11361.  
  11362.      {$IFDEF WIN32}
  11363.      If not (FCanvas.FOwnerDraw) Then exit; //not ownerdraw
  11364.      {$ENDIF}
  11365.  
  11366.      FCanvas.FLineType:=NewStyle;
  11367.      NewStyle1:=LineStyles[NewStyle];
  11368.      {$IFDEF Win32}
  11369.      CreateWin32Pen(FCanvas);
  11370.      GetObject(FCanvas.FPenHandle,SizeOf(LOGPEN),PenData);
  11371.      PenData.lopnStyle:=NewStyle1;
  11372.      NewPen:=CreatePenIndirect(PenData);
  11373.      If FCanvas.FHandle<>0 Then SelectObject(FCanvas.FHandle,NewPen);
  11374.      If FCanvas.FPenHandle<>0 Then DeleteObject(FCanvas.FPenHandle);
  11375.      FCanvas.FPenHandle:=NewPen;
  11376.      {$ENDIF}
  11377.      {$IFDEF OS2}
  11378.      GpiSetLineType(FCanvas.FHandle,NewStyle1);
  11379.      {$ENDIF}
  11380. End;
  11381.  
  11382.  
  11383. Procedure TPen.SetWidth(NewWidth:LongInt);
  11384. {$IFDEF Win32}
  11385. Var PenData:LOGPEN;
  11386.     NewPen:LongWord;
  11387. {$ENDIF}
  11388. Begin
  11389.      FWidth:=NewWidth;
  11390.      If FCanvas = Nil Then Exit;
  11391.  
  11392.      {$IFDEF WIN32}
  11393.      If not (FCanvas.FOwnerDraw) Then exit; //not ownerdraw
  11394.      {$ENDIF}
  11395.  
  11396.      FCanvas.FLineWidth:=NewWidth;
  11397.      {$IFDEF Win32}
  11398.      CreateWin32Pen(FCanvas);
  11399.      GetObject(FCanvas.FPenHandle,SizeOf(LOGPEN),PenData);
  11400.      PenData.lopnWidth:=Point(NewWidth,0);
  11401.      NewPen:=CreatePenIndirect(PenData);
  11402.      If FCanvas.FHandle<>0 Then SelectObject(FCanvas.FHandle,NewPen);
  11403.      If FCanvas.FPenHandle<>0 Then DeleteObject(FCanvas.FPenHandle);
  11404.      FCanvas.FPenHandle:=NewPen;
  11405.      {$ENDIF}
  11406.      {$IFDEF OS2}
  11407.      If NewWidth>2 Then
  11408.      Begin
  11409.           GpiSetLineWidthGeom(FCanvas.FHandle,NewWidth);
  11410.           GpiSetLineWidth(FCanvas.FHandle,MAKEFIXED(1,0));
  11411.           FCanvas.FUsePath:=True;
  11412.      End
  11413.      Else
  11414.      Begin
  11415.           GpiSetLineWidth(FCanvas.FHandle,MAKEFIXED(NewWidth,0));
  11416.           FCanvas.FUsePath:=False;
  11417.      End;
  11418.      {$ENDIF}
  11419. End;
  11420.  
  11421. {
  11422. ╔═══════════════════════════════════════════════════════════════════════════╗
  11423. ║                                                                           ║
  11424. ║ Speed-Pascal/2 Version 2.0                                                ║
  11425. ║                                                                           ║
  11426. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  11427. ║                                                                           ║
  11428. ║ This section: TBrush Class Implementation                                 ║
  11429. ║                                                                           ║
  11430. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  11431. ║                                                                           ║
  11432. ╚═══════════════════════════════════════════════════════════════════════════╝
  11433. }
  11434.  
  11435. Procedure TBrush.SetupComponent;
  11436. Begin
  11437.      Inherited SetupComponent;
  11438.      Name:='Brush';
  11439.      If Owner Is TCanvas Then
  11440.        If not (csWriting IN ComponentState) Then FCanvas:=TCanvas(Owner);
  11441.      Include(DesignerState, dsStored);
  11442.      Mode:=bmOpaque;
  11443.      Style:=bsSolid;
  11444.      color:=clWhite;
  11445. End;
  11446.  
  11447. Procedure TBrush.Assign(Source:TPersistent);
  11448. Begin
  11449.      If not (Source Is TBrush) Then Inherited Assign(Source)
  11450.      Else
  11451.      Begin
  11452.           Color:=TBrush(Source).Color;
  11453.           Mode:=TBrush(Source).Mode;
  11454.           Style:=TBrush(Source).Style;
  11455.      End;
  11456. End;
  11457.  
  11458. Destructor TBrush.Destroy;
  11459. Begin
  11460.      If FBitmap<>Nil Then
  11461.      Begin
  11462.           FBitmap.Destroy;
  11463.           FBitmap:=Nil;
  11464.      End;
  11465.      Inherited Destroy;
  11466. End;
  11467.  
  11468. Procedure TBrush.SetColor(NewColor:TColor);
  11469. Begin
  11470.      FColor := NewColor; {Store original Value}
  11471.      If FCanvas <> Nil Then
  11472.      Begin
  11473.           NewColor := SysColorToRGB(NewColor);
  11474.           {$IFDEF OS2}
  11475.           GPISetBackColor(FCanvas.FHandle,NewColor);
  11476.           {$ENDIF}
  11477.           {$IFDEF Win32}
  11478.           NewColor := RGBToWinColor(NewColor);
  11479.           SetBkColor(FCanvas.FHandle,NewColor);
  11480.           {$ENDIF}
  11481.      End;
  11482. End;
  11483.  
  11484. Procedure TBrush.SetStyle(NewStyle:TBrushStyle);
  11485. Var
  11486.    {$IFDEF OS2}
  11487.    Temp:LongWord;
  11488.    {$ENDIF}
  11489.    {$IFDEF Win32}
  11490.    lb:LOGBRUSH;
  11491.    NewBrush:LongWord;
  11492.    {$ENDIF}
  11493. Begin
  11494.      If FBitmap<>Nil Then Exit;  //Function illegal If A Bitmap Is Selected As Brush
  11495.  
  11496.      FStyle:=NewStyle;
  11497.      If FCanvas = Nil Then Exit;
  11498.  
  11499.      If NewStyle=bsClear Then color:=clWhite; {??}
  11500.  
  11501.      {$IFDEF OS2}
  11502.      Case NewStyle Of
  11503.          bsSolid:Temp:=PATSYM_SOLID;
  11504.          bsHorizontal:Temp:=PATSYM_HORIZ;
  11505.          bsVertical:Temp:=PATSYM_VERT;
  11506.          bsFDiagonal:Temp:=PATSYM_DIAG3;
  11507.          bsBDiagonal:Temp:=PATSYM_DIAG1;
  11508.          bsCross:Temp:=PATSYM_DENSE7;
  11509.          bsDiagCross:Temp:=PATSYM_DENSE5;
  11510.          bsClear:Temp:=PATSYM_BLANK;
  11511.          Else Temp:=PATSYM_SOLID;
  11512.      End; {Case}
  11513.      GPISetPattern(FCanvas.FHandle,Temp);
  11514.      {$ENDIF}
  11515.      {$IFDEF Win32}
  11516.      If not FCanvas.FOwnerDraw Then exit;
  11517.  
  11518.      CreateWin32Brush(FCanvas);
  11519.      GetObject(FCanvas.FBrushHandle,SizeOf(LOGBRUSH),lb);
  11520.  
  11521.      If NewStyle=bsSolid Then
  11522.      Begin
  11523.          //WinGDI.SetBkMode(FCanvas.FHandle,OPAQUE);
  11524.          lb.lbColor:=RGBToWinColor(SysColorToRGB(color));
  11525.      End
  11526.      Else
  11527.      Begin
  11528.           //WinGDI.SetBkMode(FCanvas.FHandle,TRANSPARENT);
  11529.           {windows specific: Win95 does Not Draw Brush hatches If bkcolor=Brush color}
  11530.           lb.lbColor:=Not RGBToWinColor(SysColorToRGB(color));
  11531.      End;
  11532.  
  11533.      Case NewStyle Of
  11534.          bsSolid:lb.lbStyle:=BS_SOLID;
  11535.          bsClear:lb.lbStyle:=BS_HOLLOW;
  11536.          bsHorizontal:
  11537.          Begin
  11538.               lb.lbStyle:=BS_HATCHED;
  11539.               lb.lbHatch:=HS_HORIZONTAL;
  11540.          End;
  11541.          bsVertical:
  11542.          Begin
  11543.               lb.lbStyle:=BS_HATCHED;
  11544.               lb.lbHatch:=HS_VERTICAL;
  11545.          End;
  11546.          bsFDiagonal:
  11547.          Begin
  11548.               lb.lbStyle:=BS_HATCHED;
  11549.               lb.lbHatch:=HS_FDIAGONAL;
  11550.          End;
  11551.          bsBDiagonal:
  11552.          Begin
  11553.               lb.lbStyle:=BS_HATCHED;
  11554.               lb.lbHatch:=HS_BDIAGONAL;
  11555.          End;
  11556.          bsCross:
  11557.          Begin
  11558.               lb.lbStyle:=BS_HATCHED;
  11559.               lb.lbHatch:=HS_CROSS;
  11560.          End;
  11561.          bsDiagCross:
  11562.          Begin
  11563.               lb.lbStyle:=BS_HATCHED;
  11564.               lb.lbHatch:=HS_DIAGCROSS;
  11565.          End;
  11566.      End; {Case}
  11567.      NewBrush:=CreateBrushIndirect(lb);
  11568.      If FCanvas.FHandle<>0 Then SelectObject(FCanvas.FHandle,NewBrush);
  11569.      If FCanvas.FBrushHandle<>0 Then DeleteObject(FCanvas.FBrushHandle);
  11570.      FCanvas.FBrushHandle:=NewBrush;
  11571.      {$ENDIF}
  11572. End;
  11573.  
  11574.  
  11575. Procedure TBrush.SetMode(NewMode:TBrushMode);
  11576. Begin
  11577.      FMode:=NewMode;
  11578.      If FCanvas = Nil Then Exit;
  11579.  
  11580.      FCanvas.FBackMix:=NewMode;
  11581.      {$IFDEF OS2}
  11582.      Case NewMode Of
  11583.         bmTransparent:GpiSetBackMix(FCanvas.FHandle,BM_LEAVEALONE);
  11584.         bmOpaque:GpiSetBackMix(FCanvas.FHandle,BM_OVERPAINT);
  11585.      End; {Case}
  11586.      {$ENDIF}
  11587.      {$IFDEF Win32}
  11588.      Case Mode Of
  11589.         bmTransparent:WinGDI.SetBkMode(FCanvas.FHandle,TRANSPARENT);
  11590.         bmOpaque:WinGDI.SetBkMode(FCanvas.FHandle,OPAQUE);
  11591.      End; {Case}
  11592.      {$ENDIF}
  11593. End;
  11594.  
  11595. Procedure TBrush.SetBitmap(NewBitmap:TGraphic);
  11596. Var  Stream:TMemoryStream;
  11597.      {$IFDEF Win32}
  11598.      lb:LOGBRUSH;
  11599.      NewBrush:LongWord;
  11600.      {$ENDIF}
  11601.      {$IFDEF OS2}
  11602.      BmpClass:Class Of TGraphic;
  11603.      {$ENDIF}
  11604. Begin
  11605.      {$IFDEF OS2}
  11606.      If FBitmap<>Nil Then
  11607.      Begin
  11608.           GpiSetPatternSet(FCanvas.FHandle,LCID_DEFAULT);
  11609.           GpiDeleteSetId(FCanvas.FHandle,2);
  11610.           FBitmap.Destroy;
  11611.      End;
  11612.  
  11613.      If NewBitmap<>Nil Then
  11614.      Begin
  11615.           BmpClass:=NewBitmap.ClassType;
  11616.           FBitmap:=BmpClass.Create;
  11617.           Stream.Create;
  11618.           NewBitmap.SaveToStream(Stream);
  11619.           Stream.Position:=0;
  11620.           FBitmap.LoadFromStream(Stream);
  11621.           Stream.Destroy;
  11622.           GpiSetBitmap(FBitmap.Canvas.Handle,0);
  11623.      End
  11624.      Else FBitmap:=Nil;
  11625.      If FBitmap<>Nil Then
  11626.      Begin
  11627.           GpiSetBitmapId(FCanvas.FHandle,FBitmap.Handle,2);
  11628.           GpiSetPatternSet(FCanvas.FHandle,2);
  11629.      End;
  11630.      {$ENDIF}
  11631.      {$IFDEF Win32}
  11632.      If FBitmap<>Nil Then FBitmap.Destroy;
  11633.      FBitmap:=NewBitmap;
  11634.      If not (FCanvas.FOwnerDraw) Then exit;
  11635.  
  11636.      CreateWin32Brush(FCanvas);
  11637.      GetObject(FCanvas.FBrushHandle,SizeOf(LOGBRUSH),lb);
  11638.      If FBitmap<>Nil Then
  11639.      Begin
  11640.           lb.lbStyle:=BS_PATTERN;
  11641.           lb.lbHatch:=FBitmap.Handle;
  11642.           {windows specific: Win95 does Not Draw Brush hatches If bkcolor=Brush color}
  11643.           lb.lbColor:=Not RGBToWinColor(SysColorToRGB(color));
  11644.      End
  11645.      Else
  11646.      Begin
  11647.           lb.lbHatch:=0;
  11648.           lb.lbStyle:=BS_SOLID;
  11649.      End;
  11650.      NewBrush:=CreateBrushIndirect(lb);
  11651.      If FCanvas.FHandle<>0 Then SelectObject(FCanvas.FHandle,NewBrush);
  11652.      If FCanvas.FBrushHandle<>0 Then DeleteObject(FCanvas.FBrushHandle);
  11653.      FCanvas.FBrushHandle:=NewBrush;
  11654.      {$ENDIF}
  11655. End;
  11656.  
  11657.  
  11658. {
  11659. ╔═══════════════════════════════════════════════════════════════════════════╗
  11660. ║                                                                           ║
  11661. ║ Speed-Pascal/2 Version 2.0                                                ║
  11662. ║                                                                           ║
  11663. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  11664. ║                                                                           ║
  11665. ║ This section: TCanvas Class Implementation                                ║
  11666. ║                                                                           ║
  11667. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  11668. ║                                                                           ║
  11669. ╚═══════════════════════════════════════════════════════════════════════════╝
  11670. }
  11671.  
  11672. Procedure TCanvas.CreateHandle;
  11673. Begin
  11674. End;
  11675.  
  11676. Procedure TCanvas.DestroyHandle;
  11677. Begin
  11678. End;
  11679.  
  11680. {$IFDEF OS2}
  11681. Function TCanvas.GetLineColor:TColor;
  11682. Begin
  11683.      GpiQueryAttrs(Handle,PRIM_LINE,LBB_COLOR,Result);
  11684. End;
  11685. Function TCanvas.GetCharColor:TColor;
  11686. Begin
  11687.      GpiQueryAttrs(Handle,PRIM_CHAR,CBB_COLOR,Result);
  11688. End;
  11689.  
  11690. Function TCanvas.GetAreaColor:TColor;
  11691. Begin
  11692.      GpiQueryAttrs(Handle,PRIM_AREA,ABB_COLOR,Result);
  11693. End;
  11694.  
  11695. Procedure TCanvas.SetLineColor(NewValue:TColor);
  11696. Begin
  11697.      GpiSetAttrs(Handle,PRIM_LINE,LBB_COLOR,0,NewValue);
  11698. End;
  11699.  
  11700. Procedure TCanvas.SetCharColor(NewValue:TColor);
  11701. Begin
  11702.      GpiSetAttrs(Handle,PRIM_CHAR,CBB_COLOR,0,NewValue);
  11703. End;
  11704.  
  11705. Procedure TCanvas.SetAreaColor(NewValue:TColor);
  11706. Begin
  11707.      GpiSetAttrs(Handle,PRIM_AREA,ABB_COLOR,0,NewValue);
  11708. End;
  11709.  
  11710. Procedure TCanvas.BeginArea(Mode:TAreaMode);
  11711. Var Flag:LongWord;
  11712. Begin
  11713.      Case Mode Of
  11714.        arNoBoundary:Flag:=BA_NOBOUNDARY;
  11715.        arBoundary:Flag:=BA_BOUNDARY;
  11716.        arAlternate:Flag:=BA_ALTERNATE;
  11717.        arNoBoundaryAlternate:Flag:=BA_NOBOUNDARY OR BA_ALTERNATE;
  11718.        arNoBoundaryWinding:Flag:=BA_NOBOUNDARY OR BA_WINDING;
  11719.        arBoundaryWinding:Flag:=BA_BOUNDARY OR BA_WINDING;
  11720.        arBoundaryAlternate:Flag:=BA_BOUNDARY OR BA_ALTERNATE;
  11721.        Else Flag:=BA_WINDING;
  11722.      End;
  11723.      GpiBeginArea(Handle,Flag);
  11724. End;
  11725.  
  11726. Procedure TCanvas.EndArea;
  11727. Begin
  11728.      GpiEndArea(Handle);
  11729. End;
  11730.  
  11731. Procedure TCanvas.PolySpline(aptl:Array Of TPoint);
  11732. Begin
  11733.      GpiMove(Handle,aptl[0]);
  11734.      GpiPolySpline(Handle,High(aptl),aptl[1]);
  11735. End;
  11736.  
  11737. Procedure TCanvas.Transform(m:TMatrix;Mode:TTransformMode);
  11738. Var Flags:LongWord;
  11739. Begin
  11740.      Case Mode Of
  11741.        trReplace:Flags:=TRANSFORM_REPLACE;
  11742.        trAdd:Flags:=TRANSFORM_ADD;
  11743.        Else Flags:=TRANSFORM_PREEMPT;
  11744.      End;
  11745.  
  11746.      GpiSetModelTransformMatrix(Handle,9,m.FMatrix,Flags);
  11747. End;
  11748.  
  11749. Procedure TCanvas.ResetTransform;
  11750. Var m:TMatrix;
  11751. Begin
  11752.      m.CreateDefault;
  11753.      Transform(m,trReplace);
  11754.      m.Destroy;
  11755. End;
  11756.  
  11757. Procedure TCanvas.SetTransformMatrix(Const m:TMatrix);
  11758. Begin
  11759.      Transform(m,trReplace);
  11760. End;
  11761.  
  11762. Function TCanvas.GetTransformMatrix:TMatrix;
  11763. Begin
  11764.      Result.CreateIntern;
  11765.      GpiQueryModelTransformMatrix(Handle,9,Result.FMatrix);
  11766. End;
  11767. {$ENDIF}
  11768.  
  11769. Procedure TCanvas.SetPalette(NewPalette:TPalette);
  11770. Var OldHandle:LongWord;
  11771. Begin
  11772.      If NewPalette=Nil Then Exit;
  11773.      OldHandle:=Palette.Handle;
  11774.      Palette.Handle:=NewPalette.Handle;
  11775.      {$IFDEF OS2}
  11776.      GpiSelectPalette(Handle,Palette.Handle);
  11777.      GpiCreateLogColorTable(Handle,0,LCOLF_RGB,0,0,Nil);
  11778.      {$ENDIF}
  11779.      {$IFDEF Win95}
  11780.      SelectPalette(Handle,Palette.Handle,True);
  11781.      {$ENDIF}
  11782.  
  11783.      If Owner Is TGraphic Then TGraphic(Owner).PaletteChanged
  11784.      Else
  11785.      Begin
  11786.           {$IFDEF OS2}
  11787.           GpiDeletePalette(OldHandle);
  11788.           {$ENDIF}
  11789.           {$IFDEF Win95}
  11790.           DeleteObject(OldHandle);
  11791.           {$ENDIF}
  11792.      End;
  11793. End;
  11794.  
  11795. Function TCanvas.GetPageViewPort:TRect;
  11796. Begin
  11797.      {$IFDEF OS2}
  11798.      GpiQueryPageViewPort(Handle,RECTL(Result));
  11799.      {$ENDIF}
  11800. End;
  11801.  
  11802. Procedure TCanvas.SetPageViewPort(NewValue:TRect);
  11803. Begin
  11804.      {$IFDEF OS2}
  11805.      GpiSetPageViewPort(Handle,RECTL(NewValue));
  11806.      {$ENDIF}
  11807. End;
  11808.  
  11809. Procedure TCanvas.SetPen(NewPen:TPen);
  11810. Begin
  11811.      If ((NewPen=Nil)Or(FPen=Nil)) Then Exit;
  11812.  
  11813.      FPen.color:=NewPen.color;
  11814.      FPen.Style:=NewPen.Style;
  11815.      FPen.Mode:=NewPen.Mode;
  11816.      FPen.Width:=NewPen.Width;
  11817. End;
  11818.  
  11819. Procedure TCanvas.SetBrush(NewBrush:TBrush);
  11820. Begin
  11821.      If ((NewBrush=Nil)Or(FBrush=Nil)) Then Exit;
  11822.  
  11823.      FBrush.color:=NewBrush.color;
  11824.      FBrush.Mode:=NewBrush.Mode;
  11825.      FBrush.Style:=NewBrush.Style;
  11826.      FBrush.Bitmap:=NewBrush.Bitmap;
  11827. End;
  11828.  
  11829. Procedure TCanvas.CopyRect(Const Dest:TRect;Canvas:TCanvas;Const Source:TRect);
  11830. Begin
  11831.      BitBlt(Canvas,Dest,Source,CopyMode,bitfIgnore);
  11832. End;
  11833.  
  11834.  
  11835. Procedure TCanvas.BitBlt(DestCanvas:TCanvas;Const Dest,Source:TRect;
  11836.                          Mode:TBitBltMode;Flags:TBitBltFlags);
  11837. {$IFDEF OS2}
  11838. Const BitBltModes:Array[TBitBltMode] Of LongWord=
  11839.           (ROP_SRCCOPY,ROP_SRCPAINT,ROP_SRCAND,ROP_SRCINVERT,
  11840.            ROP_SRCERASE,ROP_NOTSRCCOPY,ROP_NOTSRCERASE,ROP_MERGECOPY,
  11841.            ROP_MERGEPAINT,ROP_PATCOPY,ROP_PATPAINT,ROP_PATINVERT,
  11842.            ROP_DSTINVERT,ROP_ZERO,ROP_ONE);
  11843. Const BitBltOptions:Array[TBitBltFlags] Of LongWord=
  11844.           (BBO_OR,BBO_AND,BBO_IGNORE);
  11845. {$ENDIF}
  11846. {$IFDEF Win32}
  11847. Const BitBltModes:Array[TBitBltMode] Of LongWord=
  11848.           (SRCCOPY,SRCPAINT,SRCAND,SRCINVERT,
  11849.            SRCERASE,NOTSRCCOPY,NOTSRCERASE,MERGECOPY,
  11850.            MERGEPAINT,PATCOPY,PATPAINT,PATINVERT,
  11851.            DSTINVERT,BLACKNESS,WHITENESS);
  11852. {$ENDIF}
  11853. Var  aptl:Array[0..3] Of POINTL;
  11854.      {$IFDEF Win32}
  11855.      _Source,_Dest:TRect;
  11856.      {$ENDIF}
  11857. Begin
  11858.      {$IFDEF OS2}
  11859.      aptl[0].X:=Dest.Left;
  11860.      aptl[0].Y:=Dest.Bottom;
  11861.      aptl[1].X:=Dest.Right;
  11862.      aptl[1].Y:=Dest.Top;
  11863.      aptl[2].X:=Source.Left;
  11864.      aptl[2].Y:=Source.Bottom;
  11865.      aptl[3].X:=Source.Right;
  11866.      aptl[3].Y:=Source.Top;
  11867.      GpiBitBlt(DestCanvas.Handle,Handle,4,aptl[0],BitBltModes[Mode],BitBltOptions[Flags]);
  11868.      {$ENDIF}
  11869.      {$IFDEF Win32}
  11870.      CreateHandle;
  11871.      DestCanvas.CreateHandle;
  11872.  
  11873.      _Dest := Dest;
  11874.      RectToWin32Rect(_Dest);
  11875.      TransformRectToWin32(_Dest,DestCanvas.Control,DestCanvas.Graphic);
  11876.      _Source := Source;
  11877.      RectToWin32Rect(_Source);
  11878.      TransformRectToWin32(_Source,FControl,FGraphic);
  11879.      StretchBlt(DestCanvas.Handle, _Dest.Left,_Dest.Bottom,
  11880.                 _Dest.Right-_Dest.Left, _Dest.Top-_Dest.Bottom,
  11881.                 Handle, _Source.Left, _Source.Bottom,
  11882.                 _Source.Right-_Source.Left, _Source.Top-_Source.Bottom,
  11883.                 BitBltModes[Mode]);
  11884.  
  11885.      DestCanvas.DestroyHandle;
  11886.      DestroyHandle;
  11887.      {$ENDIF}
  11888. End;
  11889.  
  11890.  
  11891.  
  11892. Procedure TCanvas.SetClipRegion(Rects:Array Of TRect);
  11893. Var  T:LongInt;
  11894.      {$IFDEF Win32}
  11895.      FClip1:LongWord;
  11896.      {$ENDIF}
  11897. Begin
  11898.      If FClipRGN <> 0 Then DeleteClipRegion;
  11899.  
  11900.      FClipRect := Rects[0];
  11901.      {FClipRect > Rectangle that covers All clip rectangles}
  11902.      For T := 1 To High(Rects) Do FClipRect := UnionRect(FClipRect,Rects[T]);
  11903.  
  11904.      {$IFDEF OS2}
  11905.      For T := 0 To High(Rects) Do
  11906.      Begin
  11907.           Inc(Rects[T].Right);
  11908.           Inc(Rects[T].Top);
  11909.      End;
  11910.  
  11911.      FClipRGN := GpiCreateRegion(FHandle,High(Rects)+1,RECTL(Rects[0]));
  11912.      GpiSetClipRegion(FHandle,FClipRGN,Nil);
  11913.      {$ENDIF}
  11914.      {$IFDEF Win32}
  11915.      For T := 0 To High(Rects) Do
  11916.      Begin
  11917.           TransformClientRect(Rects[T],FControl,FGraphic);
  11918.           Inc(Rects[T].Right);
  11919.           Inc(Rects[T].Bottom);
  11920.      End;
  11921.  
  11922.      FClipRGN := CreateRectRgnIndirect(RECTL(Rects[0]));
  11923.      SelectClipRgn(FHandle,FClipRGN);
  11924.      For T := 1 To High(Rects) Do
  11925.      Begin
  11926.           FClip1 := CreateRectRgnIndirect(RECTL(Rects[T]));
  11927.           ExtSelectClipRgn(FHandle,FClip1,RGN_OR);
  11928.           DeleteObject(FClip1);
  11929.      End;
  11930.      {$ENDIF}
  11931. End;
  11932.  
  11933.  
  11934. Procedure TCanvas.DeleteClipRegion;
  11935. Begin
  11936.      If FClipRGN = 0 Then Exit;
  11937.      {$IFDEF OS2}
  11938.      GpiSetClipRegion(FHandle,0,Nil);
  11939.      GpiDestroyRegion(FHandle,FClipRGN);
  11940.      {$ENDIF}
  11941.      {$IFDEF Win32}
  11942.      SelectClipRgn(FHandle,0);
  11943.      DeleteObject(FClipRGN);
  11944.      {$ENDIF}
  11945.      FClipRGN := 0;
  11946.      FillChar(FClipRect,SizeOf(TRect),0);
  11947. End;
  11948.  
  11949.  
  11950. Procedure TCanvas.ExcludeClipRect(Const rec:TRect);
  11951. {$IFDEF Win32}
  11952. Var  FClip1:LongWord;
  11953.      rc:TRect;
  11954. {$ENDIF}
  11955. Begin
  11956.      If FClipRGN=0 Then Exit;
  11957.      If IsRectEmpty(rec) Then Exit;
  11958.      {$IFDEF OS2}
  11959.      GpiExcludeClipRectangle(FHandle,RECTL(rec));
  11960.      {$ENDIF}
  11961.      {$IFDEF Win32}
  11962.      rc := rec;
  11963.      {??}
  11964.      //Dec(rc.Right); //!!
  11965.      //Dec(rc.Top);   //!!
  11966.      dec(rc.Bottom); //!!
  11967.      TransformClientRect(rc,FControl,FGraphic);
  11968.      FClip1:=CreateRectRgnIndirect(RECTL(rc));
  11969.      ExtSelectClipRgn(FHandle,FClip1,RGN_XOR);
  11970.      DeleteObject(FClip1);
  11971.      {$ENDIF}
  11972. End;
  11973.  
  11974.  
  11975. Procedure TCanvas.SetClipRect(Const rec:TRect);
  11976. Begin
  11977.      SetClipRegion([rec]);
  11978. End;
  11979.  
  11980.  
  11981. Function TCanvas.GetPixel(X,Y:LongInt):TColor;
  11982. Var  P:TPoint;
  11983. Begin
  11984.      P := Point(X,Y);
  11985.      {$IFDEF OS2}
  11986.      Result := GpiQueryPel(FHandle,P);
  11987.      {$ENDIF}
  11988.      {$IFDEF Win32}
  11989.      TransformClientPoint(P,FControl,FGraphic);
  11990.      Result := WinGDI.GetPixel(FHandle, P.X, P.Y);
  11991.      Result := WinColorToRGB(Result);
  11992.      {$ENDIF}
  11993. End;
  11994.  
  11995.  
  11996. Procedure TCanvas.SetPixel(X,Y:LongInt;Value:TColor);
  11997. Var  P:TPoint;
  11998.      {$IFDEF OS2}
  11999.      OldColor:TColor;
  12000.      {$ENDIF}
  12001. Begin
  12002.      P := Point(X,Y);
  12003.      {$IFDEF OS2}
  12004.      OldColor := Pen.color;
  12005.      Pen.color := Value;
  12006.      GpiSetPel(FHandle,P);
  12007.      Pen.color := OldColor;
  12008.      {$ENDIF}
  12009.      {$IFDEF Win32}
  12010.      TransformClientPoint(P,FControl,FGraphic);
  12011.      WinGDI.SetPixel(FHandle, P.X, P.Y, RGBToWinColor(SysColorToRGB(Value)));
  12012.      {$ENDIF}
  12013. End;
  12014.  
  12015.  
  12016. Function TCanvas.TextHeight(Const Text:String):LongInt;
  12017. Var CX:LongInt;
  12018. Begin
  12019.      GetTextExtent(Text,CX,Result);
  12020. End;
  12021.  
  12022.  
  12023. Function TCanvas.TextWidth(Const Text:String):LongInt;
  12024. Var CY:LongInt;
  12025. Begin
  12026.      GetTextExtent(Text,Result,CY);
  12027. End;
  12028.  
  12029.  
  12030. Procedure TCanvas.TextRect(Const rc:TRect;X,Y:LongInt;Const Text:String);
  12031. Var SaveClip:TRect;
  12032. Begin
  12033.      SaveClip:=ClipRect;
  12034.      ClipRect:=rc;
  12035.      TextOut(X,Y,Text);
  12036.      ClipRect:=SaveClip;
  12037. End;
  12038.  
  12039.  
  12040. Procedure TCanvas.GetTextExtent(Const S:String;Var Width,Height:LongInt);
  12041. Var  aPS:PString;
  12042.      {$IFDEF OS2}
  12043.      Extent:Array[0..TXTBOX_COUNT] Of POINTL;
  12044.      {$ENDIF}
  12045.      {$IFDEF Win32}
  12046.      Extent:Size;
  12047.      s1:String;
  12048.      {$ENDIF}
  12049. Begin
  12050.      {$IFDEF OS2}
  12051.      aPS:=@S;
  12052.      GpiQueryTextBox(FHandle,Length(aPS^),aPS^[1],TXTBOX_COUNT,Extent[0]);
  12053.      Width:=(Extent[TXTBOX_TOPRIGHT].X-Extent[TXTBOX_BOTTOMLEFT].X);
  12054.      Height:=(Extent[TXTBOX_TOPLEFT].Y-Extent[TXTBOX_BOTTOMLEFT].Y);
  12055.      {$ENDIF}
  12056.      {$IFDEF Win32}
  12057.      s1:=s;
  12058.      StrOemToAnsi(s1);
  12059.      aPS:=@s1;
  12060.      GetTextExtentPoint32(FHandle,aPS^[1],Length(aPS^),Extent);
  12061.      Width:=Extent.CX;
  12062.      Height:=Extent.CY;
  12063.      {$ENDIF}
  12064. End;
  12065.  
  12066. Procedure TCanvas.SetFont(NewFont:TFont);
  12067. Var xRes:LongInt;
  12068.     S:String;
  12069.     TheFont:TFont;
  12070. Begin
  12071.      If NewFont=FFont Then Exit; //!!!
  12072.  
  12073.      xRes:=HorizontalResolution;
  12074.      If NewFont<>Nil Then
  12075.       If ((Screen<>Nil)And(Screen.Canvas<>Nil)) Then
  12076.        If xRes>Screen.Canvas.HorizontalResolution Then //Canvas Is Not A Screen Canvas
  12077.      Begin
  12078.           //Workaround For Printer Devices
  12079.           S:=NewFont.FaceName;
  12080.           UpcaseStr(S);
  12081.           If Pos(' ITALIC',S)=0 Then
  12082.           Begin
  12083.                S:=NewFont.FaceName+' Italic';
  12084.                If NewFont.PointSize<>0 Then
  12085.                  TheFont:=Screen.GetFontFromPointSize(S,NewFont.PointSize)
  12086.                Else
  12087.                  TheFont:=Screen.GetFontFromName(S,NewFont.Width,NewFont.Height);
  12088.  
  12089.                If TheFont=Nil Then
  12090.                Begin
  12091.                     S:=NewFont.FaceName+'.Italic';
  12092.                     If NewFont.PointSize<>0 Then
  12093.                       TheFont:=Screen.GetFontFromPointSize(S,NewFont.PointSize)
  12094.                     Else
  12095.                       TheFont:=Screen.GetFontFromName(S,NewFont.Width,NewFont.Height);
  12096.                End;
  12097.  
  12098.                If TheFont<>Nil Then
  12099.                Begin
  12100.                     FFontWidth:=0;
  12101.                     FFontHeight:=0;
  12102.                     FFontAttr:=[];
  12103.                     {der ControlFont darf nicht verändert werden !!!}
  12104.                     {Siehe auch TControl.SetFont !!}
  12105.                     CreateFont(TheFont,False);
  12106.                End;
  12107.           End;
  12108.      End;
  12109.  
  12110.      {Set values To Default}
  12111.      FFontWidth:=0;
  12112.      FFontHeight:=0;
  12113.      FFontAttr:=[];
  12114.      {der ControlFont darf nicht verändert werden !!!}
  12115.      {Siehe auch TControl.SetFont !!}
  12116.      CreateFont(NewFont,False);
  12117. End;
  12118.  
  12119. Procedure TCanvas.CreateFont(NewFont:TFont;ModifyControlFont:Boolean);
  12120. {$IFDEF OS2}
  12121. Var fa:FATTRS;
  12122.     aSizeF:SIZEF;
  12123.     fsSelection:LongInt;
  12124.     aptl:Array[0..1] Of POINTL;
  12125.     S:String;
  12126.     C:Cstring;
  12127.     Metrics:FONTMETRICS;
  12128.     xRes,yRes:LongInt;
  12129.     aHDC:HDC;
  12130.     res:LongInt;
  12131.     SafeTry,SafeTry1:Boolean;
  12132.     f1,f2:String;
  12133. Label TryAgain;
  12134. {$ENDIF}
  12135. {$IFDEF Win32}
  12136. Var ahFont:HFONT;
  12137.     aFontInfo:LOGFONT;
  12138. {$ENDIF}
  12139. Var aWidth,aHeight:LongInt;
  12140.     aFontAttr:TFontAttributes;
  12141.     otherfont:Boolean;
  12142. Label L;
  12143. Begin
  12144.      otherfont:=False;
  12145.      If NewFont=Nil Then NewFont:=Screen.DefaultFont; {small}
  12146.  
  12147.      If FFontWidth=0 Then aWidth:=NewFont.Width     //Default
  12148.      Else
  12149.      Begin
  12150.           aWidth:=FFontWidth;
  12151.           otherfont:=True;
  12152.      End;
  12153.      If FFontHeight=0 Then aHeight:=NewFont.Height  //Default
  12154.      Else
  12155.      Begin
  12156.           aHeight:=FFontHeight;
  12157.           otherfont:=True;
  12158.      End;
  12159.      If FFontAttr=[] Then aFontAttr:=NewFont.Attributes
  12160.      Else
  12161.      Begin
  12162.           aFontAttr:=FFontAttr;
  12163.           otherfont:=True;
  12164.      End;
  12165.  
  12166.      {$IFDEF Win32}
  12167. L:
  12168.      aFontInfo:=NewFont.FFontInfo;
  12169.      aFontInfo.lfHeight:=aHeight;
  12170.      aFontInfo.lfWidth:=aWidth;
  12171.      aFontInfo.lfQuality:=DRAFT_QUALITY;
  12172.      If aFontAttr*[faItalic]<>[] Then aFontInfo.lfItalic:=1
  12173.      Else aFontInfo.lfItalic:=0;
  12174.      If aFontAttr*[faUnderScore]<>[] Then aFontInfo.lfUnderline:=1
  12175.      Else aFontInfo.lfUnderline:=0;
  12176.      If aFontAttr*[faStrikeOut]<>[] Then aFontInfo.lfStrikeOut:=1
  12177.      Else aFontInfo.lfStrikeOut:=0;
  12178.      If aFontAttr*[faBold]<>[] Then aFontInfo.lfWeight:=FW_BOLD
  12179.      Else aFontInfo.lfWeight:=FW_NORMAL;
  12180.  
  12181.      If Not otherfont Then
  12182.      Begin
  12183.           If NewFont.FHandle<>0 Then
  12184.           Begin
  12185.                If ahFont<>NewFont.FHandle Then
  12186.                Begin
  12187.                     ahFont:=NewFont.FHandle;
  12188.                     Inc(NewFont.FRefCount);
  12189.                End;
  12190.           End
  12191.           Else
  12192.           Begin
  12193.                ahFont:=CreateFontIndirect(aFontInfo);
  12194.                NewFont.FHandle:=ahFont;
  12195.                NewFont.FRefCount:=1;
  12196.           End;
  12197.      End
  12198.      Else ahFont:=CreateFontIndirect(aFontInfo);
  12199.  
  12200.      If ahFont<>0 Then
  12201.      Begin
  12202.           If FHandle<>0 Then SelectObject(FHandle,ahFont);
  12203.           If FFontHandle<>0 Then
  12204.           Begin
  12205.                If FFontHandle=FFont.FHandle Then
  12206.                Begin
  12207.                     If FFont.FRefCount>1 Then Dec(FFont.FRefCount)
  12208.                     Else
  12209.                     Begin
  12210.                          DeleteObject(FFontHandle);
  12211.                          FFont.FRefCount:=0;
  12212.                          FFont.FHandle:=0;
  12213.                     End;
  12214.                End
  12215.                Else If FFontHandle<>0 Then DeleteObject(FFontHandle)
  12216.           End;
  12217.  
  12218.           If FFont<>Nil Then If FFont<>NewFont Then
  12219.           Begin
  12220.                If FFont.FUseCount>0 Then Dec(FFont.FUseCount);
  12221.                If ((FFont.FCustom)And(FFont.AutoDestroy)And(FFont.FUseCount=0)) Then FFont.DestRoy;
  12222.           End;
  12223.  
  12224.           If FFont<>NewFont Then
  12225.           Begin
  12226.                FFont:=NewFont;
  12227.                If FFont<>Nil Then Inc(FFont.FUseCount);
  12228.           End;
  12229.           FFontHandle:=ahFont;
  12230.      End
  12231.      Else If FFont<>Nil Then //restore old Font
  12232.      Begin
  12233.           Beep(10,10);
  12234.           NewFont:=FFont;
  12235.           Goto L;
  12236.      End;
  12237.      If FControl<>Nil Then
  12238.      Begin
  12239.           If ModifyControlFont Then
  12240.           Begin
  12241.                SendMessage(FControl.Handle,WM_SETFONT,ahFont,1);
  12242.                If FControl.IsFontChangeEnabled Then FControl.FontChange;
  12243.           End;
  12244.      End;
  12245.      {$ENDIF}
  12246.  
  12247.      {$IFDEF OS2}
  12248. L:
  12249.      GpiSetCharSet(FHandle,LCID_DEFAULT);
  12250.      GpiDeleteSetId(FHandle,1);
  12251.  
  12252.      FillChar(fa,SizeOf(FATTRS),0);
  12253.      fa.szFaceName:=NewFont.FFontInfo.szFaceName;
  12254.      fa.usRecordLength:=SizeOf(FATTRS);
  12255.  
  12256.      fsSelection:=0;
  12257.      If aFontAttr*[faItalic]<>[] Then
  12258.        fsSelection:=fsSelection Or FATTR_SEL_ITALIC;
  12259.      If aFontAttr*[faUnderScore]<>[] Then
  12260.        fsSelection:=fsSelection Or FATTR_SEL_UNDERSCORE;
  12261.      If aFontAttr*[faOutline]<>[] Then
  12262.        fsSelection:=fsSelection Or FATTR_SEL_OUTLINE;
  12263.      If aFontAttr*[faStrikeOut]<>[] Then
  12264.        fsSelection:=fsSelection Or FATTR_SEL_STRIKEOUT;
  12265.      If aFontAttr*[faBold]<>[] Then
  12266.        fsSelection:=fsSelection Or FATTR_SEL_BOLD;
  12267.      fa.fsSelection:=fsSelection;
  12268.  
  12269.      fa.lMatch:=0;
  12270.      fa.idRegistry:=NewFont.FFontInfo.idRegistry;
  12271.      fa.usCodePage:=NewFont.FFontInfo.usCodePage;
  12272.      fa.lMaxbaseLineExt:=NewFont.FFontInfo.lMaxbaseLineExt;
  12273.      If NewFont.FFontType=ftOutline Then fa.lMaxbaseLineExt:=0;
  12274.      fa.lAveCharWidth:=NewFont.FFontInfo.lAveCharWidth;
  12275.      If NewFont.FFontType=ftOutline Then fa.lAveCharWidth:=0;
  12276.  
  12277.      fa.fsType:=0;
  12278.      If NewFont.FFontInfo.fsType And FM_TYPE_KERNING<>0 Then
  12279.        fa.fsType:=fa.fsType Or FATTR_TYPE_KERNING;
  12280.      If NewFont.FFontInfo.fsType And FM_TYPE_MBCS<>0 Then
  12281.        fa.fsType:=fa.fsType Or FATTR_TYPE_MBCS;
  12282.      If NewFont.FFontInfo.fsType And FM_TYPE_DBCS<>0 Then
  12283.        fa.fsType:=fa.fsType Or FATTR_TYPE_DBCS;
  12284.  
  12285.      fa.fsFontUse:=0;
  12286.  
  12287.      xRes:=HorizontalResolution;
  12288.      If ((Screen<>Nil)And(Screen.Canvas<>Nil)) Then
  12289.       If xRes>Screen.Canvas.HorizontalResolution Then //Canvas Is Not A Screen Canvas
  12290.          fa.fsFontUse:=FATTR_FONTUSE_TRANSFORMABLE;
  12291.  
  12292.      If NewFont.FFontType=ftOutline Then
  12293.        fa.fsFontUse:=FATTR_FONTUSE_OUTLINE Or FATTR_FONTUSE_TRANSFORMABLE;
  12294.  
  12295.      SafeTry:=False;
  12296.      SafeTry1:=False;
  12297. TryAgain:
  12298.      {the System Default Font results FONT_DEFAULT !!!}
  12299.      res:=GpiCreateLogFont(FHandle,Nil,1,fa);
  12300.      If res = FONT_DEFAULT Then {Test, If it Is really the Default Font}
  12301.      Begin
  12302.           If (Screen <> Nil) And (Screen.FDefaultFont <> Nil) Then
  12303.             If NewFont <> Nil Then
  12304.             Begin
  12305.               f1 := NewFont.FaceName;
  12306.               f2 := Screen.FDefaultFont.FaceName;
  12307.               UpcaseStr(f1);
  12308.               UpcaseStr(f2);
  12309.               If f1 = f2 Then res := FONT_MATCH; {Font Is Ok}
  12310.             End;
  12311.      End;
  12312.      If ((res<>GPI_ERROR)And(res<>FONT_DEFAULT)) Then
  12313.      Begin
  12314.           If FFont<>NewFont Then
  12315.           Begin
  12316.                DereferenceFont(FFont);
  12317.                FFont:=NewFont;
  12318.                If FFont<>Nil Then Inc(FFont.FUseCount);
  12319.           End;
  12320.           GpiSetCharSet(FHandle,1);
  12321.      End
  12322.      Else
  12323.      Begin
  12324.           If res=FONT_DEFAULT Then
  12325.           Begin
  12326.                If Not SafeTry Then
  12327.                Begin
  12328.                     //Try If we can Create the Font If we don't Use Special Flags
  12329.                     SafeTry:=True;
  12330.                     fa.usCodePage:=0;
  12331.                     Goto TryAgain;
  12332.                End
  12333.                Else If Not SafeTry1 Then
  12334.                Begin
  12335.                     SafeTry1:=True;
  12336.                     fa.fsSelection:=0;
  12337.                     fa.idRegistry:=0;
  12338.                     fa.fsType:=0;
  12339.                     Goto TryAgain;
  12340.                End;
  12341.           End;
  12342.  
  12343.           If FFont<>Nil Then //restore old Font
  12344.           Begin
  12345.                If FFont=NewFont Then FFont:=Screen.DefaultFont;
  12346.                NewFont:=FFont;
  12347.                Goto L;
  12348.           End;
  12349.      End;
  12350.  
  12351.  
  12352.      If NewFont.FFontType=ftOutline Then
  12353.      Begin
  12354.           //Set character Box
  12355.           If NewFont.FInternalPointSize<>0 Then
  12356.           Begin
  12357.                aHDC:=GpiQueryDevice(FHandle);
  12358.                DevQueryCaps(aHDC,CAPS_HORIZONTAL_FONT_RES,1,xRes);
  12359.                DevQueryCaps(aHDC,CAPS_VERTICAL_FONT_RES,1,yRes);
  12360.  
  12361.                aSizeF.CX:=65536*xRes*NewFont.FInternalPointSize Div 72;
  12362.                aSizeF.CY:=65536*yRes*NewFont.FInternalPointSize Div 72;
  12363.           End
  12364.           Else
  12365.           Begin
  12366.                aptl[0].X:=0;
  12367.                aptl[0].Y:=0;
  12368.                aptl[1].X:=aWidth*13;   {Font Width In Pixels}
  12369.                aptl[1].Y:=aHeight*13;  {Font Height In Pixels}
  12370.                //Convert To page coordinates
  12371.                GpiConvert(FHandle,CVTC_DEVICE,CVTC_PAGE,2,aptl[0]);
  12372.                aSizeF.CX:=(aptl[1].X-aptl[0].X) Shl 12;
  12373.                aSizeF.CY:=(aptl[1].Y-aptl[0].Y) Shl 12;
  12374.           End;
  12375.  
  12376.           If aSizeF.CX<aSizeF.CY Then aSizeF.CY:=aSizeF.CX
  12377.           Else aSizeF.CX:=aSizeF.CY;
  12378.  
  12379.           GpiSetCharBox(FHandle,aSizeF);
  12380.      End;
  12381.  
  12382.      If FControl <> Nil Then
  12383.        If FControl.Handle <> 0 Then
  12384.          If ModifyControlFont Then
  12385.      Begin
  12386.           If NewFont.FInternalPointSize<>0 Then
  12387.           Begin
  12388.                S:=tostr(NewFont.FInternalPointSize)+'.';
  12389.                C:=NewFont.FaceName;
  12390.           End
  12391.           Else
  12392.           Begin
  12393.                GpiQueryFontMetrics(FHandle,SizeOf(FONTMETRICS),Metrics);
  12394.                S:=tostr((Metrics.sNominalPointSize) Div 10)+'.';
  12395.                C:=Metrics.szFaceName;
  12396.           End;
  12397.  
  12398.           S:=S+C;
  12399.           S:=ModifyFontName(S,aFontAttr);
  12400.           FControl.SetPPFontNameSize(S);
  12401.      End;
  12402.      {$ENDIF}
  12403. End;
  12404.  
  12405. Procedure TCanvas.SetFontAttr(NewAttr:TFontAttributes);
  12406. Begin
  12407.      If GetFontAttr <> NewAttr Then
  12408.      Begin
  12409.           FFontAttr:=NewAttr;
  12410.           {der ControlFont darf nicht verändert werden !!!}
  12411.           CreateFont(FFont,False);
  12412.      End;
  12413. End;
  12414.  
  12415. Function TCanvas.GetFontAttr:TFontAttributes;
  12416. Begin
  12417.      If FFontAttr=[] Then Result:=FFont.Attributes
  12418.      Else Result:=FFontAttr;
  12419. End;
  12420.  
  12421. Procedure TCanvas.SetFontHeight(NewHeight:LongInt);
  12422. Begin
  12423.      If GetFontHeight <> NewHeight Then
  12424.      Begin
  12425.           FFontHeight:=NewHeight;
  12426.           {der ControlFont darf nicht verändert werden !!!}
  12427.           CreateFont(FFont,False);
  12428.      End;
  12429. End;
  12430.  
  12431. Function TCanvas.GetFontHeight:LongInt;
  12432. Begin
  12433.      If FFontHeight=0 Then Result:=FFont.Height
  12434.      Else Result:=FFontHeight;
  12435. End;
  12436.  
  12437. Procedure TCanvas.SetFontWidth(NewWidth:LongInt);
  12438. Begin
  12439.      If GetFontWidth <> NewWidth Then
  12440.      Begin
  12441.           FFontWidth:=NewWidth;
  12442.           {der ControlFont darf nicht verändert werden !!!}
  12443.           CreateFont(FFont,False);
  12444.      End;
  12445. End;
  12446.  
  12447. Function TCanvas.GetFontWidth:LongInt;
  12448. Begin
  12449.      If FFontWidth=0 Then Result:=FFont.Width
  12450.      Else Result:=FFontWidth;
  12451. End;
  12452.  
  12453.  
  12454. Procedure TCanvas.SetupComponent;
  12455. Begin
  12456.      Inherited SetupComponent;
  12457.  
  12458.      //If Owner = Nil Then Exit;
  12459.      Include(ComponentState, csDetail);
  12460.      FControl:=Nil;
  12461.      FGraphic:=Nil;
  12462.      If IsControl(TControl(Owner)) Then FControl := TControl(Owner)
  12463.      Else If Owner Is TGraphic Then FGraphic := TGraphic(Owner);
  12464.  
  12465.      Name:='Canvas';
  12466.      FPen.Create(Self);
  12467.      FBrush.Create(Self);
  12468.      FLineWidth:=1;
  12469.      FLineType:=psSolid;
  12470.      FCopyMode:=cmSrcCopy;
  12471.      FFontAttr:=[];
  12472. End;
  12473.  
  12474. Procedure TCanvas.Init;
  12475. Begin
  12476.      If (FControl <> Nil) And (FControl.Handle <> 0) Then
  12477.      Begin
  12478.           FOwnerDraw:=FControl.FOwnerDraw;
  12479.           {$IFDEF OS2}
  12480.           FHandle:=WinGetPS(FControl.Handle);
  12481.           GpiCreateLogColorTable(FHandle,LCOL_RESET,LCOLF_RGB,0,0,Nil);
  12482.           {$ENDIF}
  12483.           {$IFDEF Win32}
  12484.           If FOwnerDraw Then
  12485.           Begin
  12486.                If FHandle=0 Then FHandle:=GetDC(FControl.Handle);
  12487.                SetTextAlign(FHandle,TA_LEFT Or TA_BOTTOM);
  12488.                {
  12489.                If FPenHandle=0 Then FPenHandle:=CreatePen(PS_SOLID,0,0);  //Black solid Pen
  12490.                If FBrushHandle=0 Then FBrushHandle:=CreateSolidBrush(0);  //Black Brush
  12491.                }
  12492.           End;
  12493.           {$ENDIF}
  12494.  
  12495.           If FControl.FFont <> Nil Then Font := FControl.FFont
  12496.           Else Font := Screen.DefaultFont; {small}
  12497.      End
  12498.      Else If FGraphic<>Nil Then
  12499.      Begin
  12500.           FOwnerDraw:=True;
  12501.           {$IFDEF Win32}
  12502.           {
  12503.           FPenHandle:=CreatePen(PS_SOLID,0,0);  //Black solid Pen
  12504.           FBrushHandle:=CreateSolidBrush(0);    //Black Brush
  12505.           }
  12506.  
  12507.           {$ENDIF}
  12508.           Font:=Screen.DefaultFont; {small}
  12509.      End;
  12510.  
  12511.      Pen.color:=clBlack;
  12512.      Brush.color:=clWhite;
  12513.      Brush.Mode:=bmOpaque;
  12514.      Brush.Style:=bsSolid;
  12515.      Pen.Mode:=pmCopy;
  12516.      Pen.Style:=psSolid;
  12517.  
  12518.      FPalette.Create(Self);
  12519.  
  12520.      {$IFDEF WIN32}
  12521.      If FPenHandle<>0 Then
  12522.      Begin
  12523.          If FHandle<>0 Then
  12524.            SelectObject(FHandle,GetStockObject(BLACK_PEN));
  12525.          DeleteObject(FPenHandle);
  12526.          FPenHandle:=0;
  12527.      End;
  12528.      If FBrushHandle<>0 Then
  12529.      Begin
  12530.           If FHandle<>0 Then
  12531.             SelectObject(FHandle,GetStockObject(WHITE_BRUSH));
  12532.           DeleteObject(FBrushHandle);
  12533.           FBrushHandle:=0;
  12534.      End;
  12535.      {$ENDIF}
  12536.  
  12537. End;
  12538.  
  12539.  
  12540. Destructor TCanvas.Destroy;
  12541. Begin
  12542.      {$IFDEF OS2}
  12543.      If FHandle<>0 Then WinReleasePS(FHandle);
  12544.      DereferenceFont(FFont);
  12545.      {$ENDIF}
  12546.      {$IFDEF Win32}
  12547.      If FHandle<>0 Then
  12548.      Begin
  12549.           SelectObject(FHandle,GetStockObject(BLACK_PEN));
  12550.           SelectObject(FHandle,GetStockObject(WHITE_BRUSH));
  12551.           If FControl <> Nil Then ReleaseDC(FControl.Handle,FHandle);
  12552.           SelectClipRgn(FHandle,0);
  12553.           FHandle:=0;
  12554.      End;
  12555.      If FPenHandle<>0 Then DeleteObject(FPenHandle);
  12556.      FPenHandle:=0;
  12557.      If FBrushHandle<>0 Then DeleteObject(FBrushHandle);
  12558.      FBrushHandle:=0;
  12559.      If FFontHandle<>0 Then
  12560.      Begin
  12561.           If FFontHandle=FFont.FHandle Then
  12562.           Begin
  12563.               If FFont.FRefCount>1 Then Dec(FFont.FRefCount)
  12564.               Else
  12565.               Begin
  12566.                    If FFontHandle<>0 Then DeleteObject(FFontHandle);
  12567.                    FFont.FRefCount:=0;
  12568.                    FFont.FHandle:=0;
  12569.               End;
  12570.           End
  12571.           Else
  12572.           If FFontHandle<>0 Then DeleteObject(FFontHandle);
  12573.      End;
  12574.      If FClipRGN<>0 Then DeleteObject(FClipRGN);
  12575.      FFontHandle:=0;
  12576.      If FFont<>Nil Then
  12577.      Begin
  12578.          If FFont.FUseCount>0 Then Dec(FFont.FUseCount);
  12579.          If ((FFont.FCustom)And(FFont.AutoDestroy)And(FFont.FUseCount=0)) Then FFont.Destroy;
  12580.      End;
  12581.      {$ENDIF}
  12582.  
  12583.      If FPalette <> Nil Then FPalette.Destroy;   {DragCanvas has no Palette}
  12584.      FPalette := Nil;
  12585.      If FPen <> Nil Then FPen.Destroy;
  12586.      FPen := Nil;
  12587.      If FBrush <> Nil Then FBrush.Destroy;
  12588.      FBrush := Nil;
  12589.  
  12590.      Inherited Destroy;   {erst hier weil Palette In ComponentListe steht}
  12591. End;
  12592.  
  12593.  
  12594. Function TCanvas.GetPenPosition:TPoint;
  12595. Begin
  12596.      {$IFDEF OS2}
  12597.      GPIQueryCurrentPosition(FHandle,Result);
  12598.      {$ENDIF}
  12599.      {$IFDEF Win32}
  12600.      GetCurrentPositionEx(FHandle,Result);
  12601.      TransformClientPoint(Result,FControl,FGraphic);
  12602.      {$ENDIF}
  12603. End;
  12604.  
  12605. Procedure TCanvas.SetPenPosition(NewPosition:TPoint);
  12606. Begin
  12607.      {$IFDEF OS2}
  12608.      GPIMove(FHandle,NewPosition);
  12609.      {$ENDIF}
  12610.      {$IFDEF Win32}
  12611.      TransformClientPoint(NewPosition,FControl,FGraphic);
  12612.      MoveToEx(FHandle,NewPosition.X,NewPosition.Y,NewPosition);
  12613.      {$ENDIF}
  12614. End;
  12615.  
  12616. Procedure TCanvas.EraseBackGround;
  12617. Begin
  12618.      If FControl = Nil Then Exit;
  12619.      FillRect(FControl.GetClientRect,FControl.color);
  12620. End;
  12621.  
  12622.  
  12623. {wenn Systemfarbe eingestellt ist, dann versuchen Die Standardfarbtabelle
  12624.   verwenden und nicht RGB}
  12625. Procedure TCanvas.FillRect(Const rec:TRect; FillColor:TColor);
  12626. Var  rc:TRect;
  12627.      {$IFDEF Win32}
  12628.      TempBrush:HBRUSH;
  12629.      {$ENDIF}
  12630. Begin
  12631.      rc := rec;
  12632.      Inc(rc.Right);
  12633.      Inc(rc.Top);
  12634.  
  12635.      FillColor := SysColorToRGB(FillColor);
  12636.      {$IFDEF OS2}
  12637.      WinFillRect(FHandle,RECTL(rc),FillColor);
  12638.      {$ENDIF}
  12639.      {$IFDEF Win32}
  12640.      TransformClientRect(rc,FControl,FGraphic);
  12641.      Inc(rc.Bottom);
  12642.      Inc(rc.Top);
  12643.  
  12644.      FillColor:=RGBToWinColor(FillColor);
  12645.      TempBrush:=CreateSolidBrush(FillColor);
  12646.      If FHandle<>0 Then SelectObject(FHandle,TempBrush);
  12647.      WinUser.FillRect(FHandle,RECTL(rc),TempBrush);
  12648.      If FBrushHandle<>0 Then SelectObject(FHandle,FBrushHandle)
  12649.      Else SelectObject(FHandle,GetStockObject(WHITE_BRUSH));
  12650.      If TempBrush<>0 Then DeleteObject(TempBrush);
  12651.      {$ENDIF}
  12652. End;
  12653.  
  12654.  
  12655. {$IFDEF Win32}
  12656. Function ExtendLastPoint(Src,Dest:TPoint):TPoint;
  12657. Var  X,Y,DX,dy:LongInt;
  12658. Begin
  12659.      Result := Dest;
  12660.      DX := Dest.X - Src.X;
  12661.      dy := Dest.Y - Src.Y;
  12662.      If (DX = 0) And (dy = 0) Then Exit;
  12663.      If Abs(DX) >= Abs(dy) Then
  12664.      Begin
  12665.           If Dest.X > Src.X Then Result.X := Dest.X + 1
  12666.           Else Result.X := Dest.X - 1;
  12667.           X := Result.X - Src.X;
  12668.           If dy <> 0 Then Result.Y := Round(((X * dy) / DX) + Src.Y)
  12669.      End
  12670.      Else
  12671.      Begin
  12672.           If Dest.Y > Src.Y Then Result.Y := Dest.Y + 1
  12673.           Else Result.Y := Dest.Y - 1;
  12674.           Y := Result.Y - Src.Y;
  12675.           If DX <> 0 Then Result.X := Round(((Y * DX) / dy) + Src.X)
  12676.      End;
  12677. End;
  12678. {$ENDIF}
  12679.  
  12680.  
  12681. Procedure TCanvas.MoveTo(X,Y:LongInt);
  12682. Begin
  12683.      PenPos:=Point(X,Y);
  12684. End;
  12685.  
  12686.  
  12687. Function TCanvas.GetVerticalRes:LongInt;
  12688. {$IFDEF OS2}
  12689. Var HDC:LongWord;
  12690. {$ENDIF}
  12691. Begin
  12692.      Result:=0;
  12693.      {$IFDEF OS2}
  12694.      If FControl=Nil Then
  12695.      Begin
  12696.           HDC:=GpiQueryDevice(FHandle);
  12697.           DevQueryCaps(HDC,CAPS_VERTICAL_RESOLUTION,1,Result);
  12698.      End
  12699.      Else
  12700.      Begin
  12701.           HDC:=WinOpenWindowDC(FControl.Handle);
  12702.           DevQueryCaps(HDC,CAPS_VERTICAL_RESOLUTION,1,Result);
  12703.           DevCloseDC(HDC);
  12704.      End;
  12705.      {$ENDIF}
  12706.      {$IFDEF Win32}
  12707.      Result:=GetDeviceCaps(FHandle,LOGPIXELSY);
  12708.      {$ENDIF}
  12709. End;
  12710.  
  12711. Function TCanvas.GetHorizontalRes:LongInt;
  12712. {$IFDEF OS2}
  12713. Var HDC:LongWord;
  12714. {$ENDIF}
  12715. Begin
  12716.      Result:=0;
  12717.      {$IFDEF OS2}
  12718.      If FControl=Nil Then
  12719.      Begin
  12720.           HDC:=GpiQueryDevice(FHandle);
  12721.           DevQueryCaps(HDC,CAPS_HORIZONTAL_RESOLUTION,1,Result);
  12722.      End
  12723.      Else
  12724.      Begin
  12725.           HDC:=WinOpenWindowDC(FControl.Handle);
  12726.           DevQueryCaps(HDC,CAPS_HORIZONTAL_RESOLUTION,1,Result);
  12727.           DevCloseDC(HDC);
  12728.      End;
  12729.      {$ENDIF}
  12730.      {$IFDEF Win32}
  12731.      Result:=GetDeviceCaps(FHandle,LOGPIXELSX);
  12732.      {$ENDIF}
  12733. End;
  12734.  
  12735. Procedure TCanvas.BeginPath;
  12736. Begin
  12737.      {$IFDEF OS2}
  12738.      GpiBeginPath(FHandle,1);
  12739.      {$ENDIF}
  12740.      {$IFDEF Win32}
  12741.      WinGDI.BeginPath(FHandle);
  12742.      FInPath := True;
  12743.      {$ENDIF}
  12744. End;
  12745.  
  12746. Procedure TCanvas.EndPath;
  12747. Begin
  12748.      {$IFDEF OS2}
  12749.      GpiEndPath(FHandle);
  12750.      {$ENDIF}
  12751.      {$IFDEF Win32}
  12752.      WinGDI.EndPath(FHandle);
  12753.      FInPath := False;
  12754.      {$ENDIF}
  12755. End;
  12756.  
  12757. Procedure TCanvas.CloseFigure;
  12758. Begin
  12759.      {$IFDEF OS2}
  12760.      GpiCloseFigure(FHandle);
  12761.      {$ENDIF}
  12762.      {$IFDEF Win32}
  12763.      WinGDI.CloseFigure(FHandle);
  12764.      {$ENDIF}
  12765. End;
  12766.  
  12767. Procedure TCanvas.FillPath;
  12768. Begin
  12769.      {$IFDEF OS2}
  12770.      GpiFillPath(FHandle,1,FPATH_ALTERNATE);
  12771.      {$ENDIF}
  12772.      {$IFDEF Win32}
  12773.      WinGDI.FillPath(FHandle);
  12774.      {$ENDIF}
  12775. End;
  12776.  
  12777. Procedure TCanvas.StrokePath;
  12778. Begin
  12779.      {$IFDEF OS2}
  12780.      GpiStrokePath(FHandle,1,0);
  12781.      {$ENDIF}
  12782.      {$IFDEF Win32}
  12783.      WinGDI.StrokePath(FHandle);
  12784.      {$ENDIF}
  12785. End;
  12786.  
  12787. Procedure TCanvas.OutlinePath;
  12788. Begin
  12789.      {$IFDEF OS2}
  12790.      GpiOutlinePath(FHandle,1,0);
  12791.      {$ENDIF}
  12792.      {$IFDEF Win32}
  12793.      WinGDI.StrokePath(FHandle); {.?.}
  12794.      {$ENDIF}
  12795. End;
  12796.  
  12797. Procedure TCanvas.PathToClipRegion(Mode:TPathClipMode);
  12798. {$IFDEF OS2}
  12799. Var  reg1,reg2,regnew,regold:HRGN;
  12800. {$ENDIF}
  12801. {$IFDEF Win32}
  12802. Var  iMode:LongWord;
  12803. {$ENDIF}
  12804. Begin
  12805.      {$IFDEF OS2}
  12806.      reg2:=GpiPathToRegion(FHandle,1,FPATH_ALTERNATE);
  12807.  
  12808.      If Mode<>paReplace Then
  12809.      Begin
  12810.           GpiSetClipRegion(FHandle,0,reg1);
  12811.           regnew:=GpiCreateRegion(FHandle,0,Nil);
  12812.           GpiCombineRegion(FHandle,regnew,reg1,reg2,CRGN_DIFF);
  12813.      End
  12814.      Else
  12815.      Begin
  12816.           regnew:=reg2;
  12817.           reg1:=0;
  12818.           reg2:=0;
  12819.      End;
  12820.  
  12821.      Case Mode Of
  12822.         paSubtract:GpiCombineRegion(FHandle,regnew,reg1,reg2,CRGN_XOR);
  12823.         paAdd:GpiCombineRegion(FHandle,regnew,reg1,reg2,CRGN_OR);
  12824.         paDiff:GpiCombineRegion(FHandle,regnew,reg1,reg2,CRGN_DIFF);
  12825.         paIntersect:GpiCombineRegion(FHandle,regnew,reg1,reg2,CRGN_AND);
  12826.         paReplace:;
  12827.      End;
  12828.  
  12829.      GpiSetClipRegion(FHandle,regnew,regold);
  12830.      If regold<>0 Then GpiDestroyRegion(FHandle,regold);
  12831.      If reg1<>0 Then GpiDestroyRegion(FHandle,reg1);
  12832.      If reg2<>0 Then GpiDestroyRegion(FHandle,reg2);
  12833.      If FClipRGN<>0 Then GpiDestroyRegion(FHandle,FClipRGN);
  12834.      FClipRGN:=regnew;
  12835.      {$ENDIF}
  12836.      {$IFDEF Win32}
  12837.      Case Mode Of
  12838.         paSubtract:iMode:=RGN_XOR;
  12839.         paAdd:iMode:=RGN_OR;
  12840.         paDiff:iMode:=RGN_DIFF;
  12841.         paIntersect:iMode:=RGN_AND;
  12842.         paReplace:iMode:=RGN_COPY;
  12843.      End;
  12844.      WinGDI.SelectClipPath(FHandle,iMode);
  12845.      {$ENDIF}
  12846. End;
  12847.  
  12848.  
  12849. Procedure TCanvas.LineTo(X,Y:LongInt);
  12850. Var  Dest:TPoint;
  12851. Begin
  12852.      Dest := Point(X,Y);
  12853.      {$IFDEF OS2}
  12854.      If FUsePath Then GpiBeginPath(FHandle,1);
  12855.      GpiLine(FHandle,Dest);
  12856.      If FUsePath Then
  12857.      Begin
  12858.           GpiEndPath(FHandle);
  12859.           GpiStrokePath(FHandle,1,0);
  12860.      End;
  12861.      {$ENDIF}
  12862.      {$IFDEF Win32}
  12863.      Dest := ExtendLastPoint(GetPenPosition,Dest);
  12864.      TransformClientPoint(Dest,FControl,FGraphic);
  12865.      WinGDI.LineTo(FHandle,Dest.X,Dest.Y);
  12866.      {$ENDIF}
  12867. End;
  12868.  
  12869. Procedure TCanvas.Line(X,Y,X1,y1:LongInt);
  12870. Begin
  12871.      MoveTo(X,Y);
  12872.      LineTo(X1,y1);
  12873. End;
  12874.  
  12875. Procedure TCanvas.PolyLine(Points:Array Of TPoint);
  12876. {$IFDEF Win32}
  12877. Var  T:LongInt;
  12878.      P:TPoint;
  12879.      Q:TPoint;
  12880. {$ENDIF}
  12881. Begin
  12882.      {$IFDEF OS2}
  12883.      If FUsePath Then GpiBeginPath(FHandle,1);
  12884.      GPIMove(FHandle,Points[0]);
  12885.      GpiPolyLine(FHandle,High(Points)+1,Points[0]);
  12886.      If FUsePath Then
  12887.      Begin
  12888.           GpiEndPath(FHandle);
  12889.           GpiStrokePath(FHandle,1,0);
  12890.      End;
  12891.      {$ENDIF}
  12892.      {$IFDEF Win32}
  12893.      If High(Points) > 1 Then
  12894.      Begin
  12895.           P:=Points[High(Points)-1];
  12896.           Points[High(Points)]:=ExtendLastPoint(P,Points[High(Points)]);
  12897.      End;
  12898.  
  12899.      If FInPath Then
  12900.      Begin
  12901.           For T:=1 To High(Points) Do
  12902.           Begin
  12903.                Q := Points[T-1];
  12904.                P := Points[T];
  12905.                If (Q.X < P.X) And (Q.Y > P.Y) Then
  12906.                Begin
  12907.                     P.X := P.X + 1;
  12908.                     P.Y := P.Y - 1;
  12909.                     Points[T] := P;
  12910.                End;
  12911.           End;
  12912.      End;
  12913.  
  12914.      For T:=0 To High(Points)
  12915.         Do TransformClientPoint(Points[T],FControl,FGraphic);
  12916.      WinGDI.PolyLine(FHandle,WinDef.Point(Points[0]),High(Points)+1);
  12917.      PenPos:=Points[High(Points)];
  12918.      {$ENDIF}
  12919. End;
  12920.  
  12921. Procedure TCanvas.Polygon(Points:Array Of TPoint);
  12922. {$IFDEF OS2}
  12923. Var  ThePolygon:PmGpi.Polygon;
  12924. {$ENDIF}
  12925. {$IFDEF Win32}
  12926. Var  T:LongInt;
  12927. {$ENDIF}
  12928. Begin
  12929.      {$IFDEF OS2}
  12930.      If FUsePath Then GpiBeginPath(FHandle,1);
  12931.      GPIMove(FHandle,Points[0]);
  12932.      ThePolygon.ulPoints:=High(Points)+1;
  12933.      ThePolygon.POINTL:=@Points[0];
  12934.      GpiPolygons(FHandle,1,ThePolygon,0,0);
  12935.      If FUsePath Then
  12936.      Begin
  12937.           GpiEndPath(FHandle);
  12938.           GpiStrokePath(FHandle,1,0);
  12939.      End;
  12940.      {$ENDIF}
  12941.      {$IFDEF Win32}
  12942.      For T:=0 To High(Points)
  12943.         Do TransformClientPoint(Points[T],FControl,FGraphic);
  12944.      WinGDI.Polygon(FHandle,WinDef.Point(Points[0]),High(Points)+1);
  12945.      PenPos:=Points[High(Points)];
  12946.      {$ENDIF}
  12947. End;
  12948.  
  12949. Procedure TCanvas.ShadowedBorder(Const rec:TRect;ColorHi,ColorLo:TColor);
  12950. {$IFDEF Win32}
  12951. Var  Pen:HPEN;
  12952.      Pen1:HPEN;
  12953. {$ENDIF}
  12954. {$IFDEF OS2}
  12955. Var  OldPenColor:TColor;
  12956.      OldPenWidth:LongInt;
  12957. {$ENDIF}
  12958. Begin
  12959.      If FHandle = 0 Then Exit;
  12960.      ColorHi := SysColorToRGB(ColorHi);
  12961.      ColorLo := SysColorToRGB(ColorLo);
  12962.  
  12963.      {$IFDEF OS2}
  12964.      OldPenColor := Pen.color;
  12965.      OldPenWidth := Pen.Width;
  12966.      Pen.color := ColorHi;
  12967.      Line(rec.Left,rec.Top,rec.Right,rec.Top);
  12968.      Pen.color := ColorLo;
  12969.      Line(rec.Left,rec.Bottom,rec.Right,rec.Bottom);
  12970.      Pen.color := ColorHi;
  12971.      Line(rec.Left,rec.Bottom,rec.Left,rec.Top);
  12972.      Pen.color := ColorLo;
  12973.      Line(rec.Right,rec.Bottom,rec.Right,rec.Top);
  12974.      Pen.color := OldPenColor;
  12975.      Pen.Width := OldPenWidth;
  12976.      {$ENDIF}
  12977.  
  12978.      {$IFDEF Win32}
  12979.      ColorLo := RGBToWinColor(ColorLo);
  12980.      ColorHi := RGBToWinColor(ColorHi);
  12981.      Pen1 := CreatePen(PS_SOLID,1,ColorHi);
  12982.      SelectObject(FHandle,Pen1);
  12983.      Line(rec.Left,rec.Bottom,rec.Left,rec.Top);
  12984.      Line(rec.Left,rec.Top,rec.Right,rec.Top);
  12985.      Pen:=CreatePen(PS_SOLID,1,ColorLo);
  12986.      DeleteObject(SelectObject(FHandle,Pen));
  12987.      Line(rec.Right,rec.Bottom,rec.Right,rec.Top);
  12988.      Line(rec.Left,rec.Bottom,rec.Right,rec.Bottom);
  12989.      If FPenHandle<>0 Then DeleteObject(SelectObject(FHandle,FPenHandle))
  12990.      Else DeleteObject(SelectObject(FHandle,GetStockObject(BLACK_PEN)));
  12991.      If Pen <> 0 Then DeleteObject(Pen);
  12992.      {$ENDIF}
  12993. End;
  12994.  
  12995. Procedure TCanvas.RoundShadowedBorder(Const rec:TRect;ColorHi,ColorLo:TColor);
  12996. Var  I:LongInt;
  12997.      {$IFDEF Win32}
  12998.      Pen:HPEN;
  12999.      Pen1:HPEN;
  13000.      {$ENDIF}
  13001.      {$IFDEF OS2}
  13002.      OldPenColor:TColor;
  13003.      OldPenWidth:LongInt;
  13004.      {$ENDIF}
  13005. Begin
  13006.      If FHandle = 0 Then Exit;
  13007.      ColorHi := SysColorToRGB(ColorHi);
  13008.      ColorLo := SysColorToRGB(ColorLo);
  13009.      I := 2;
  13010.      {$IFDEF OS2}
  13011.      OldPenColor := Pen.color;
  13012.      OldPenWidth := Pen.Width;
  13013.      Pen.color := ColorHi;
  13014.      Line(rec.Left+I,rec.Bottom,rec.Left,rec.Bottom+I);
  13015.      Line(rec.Left,rec.Bottom+I,rec.Left,rec.Top-I);
  13016.      Pen.color := ColorLo;
  13017.      Line(rec.Right-I,rec.Top,rec.Right,rec.Top-2);
  13018.      Line(rec.Right,rec.Top-I,rec.Right,rec.Bottom+2);
  13019.      Pen.color := ColorHi;
  13020.      Line(rec.Left,rec.Top-I,rec.Left+I,rec.Top);
  13021.      Line(rec.Left+I,rec.Top,rec.Right-I,rec.Top);
  13022.      Pen.color := ColorLo;
  13023.      Line(rec.Right,rec.Bottom+I,rec.Right-I,rec.Bottom);
  13024.      Line(rec.Right-I,rec.Bottom,rec.Left+I,rec.Bottom);
  13025.      Pen.color := OldPenColor;
  13026.      Pen.Width := OldPenWidth;
  13027.      {$ENDIF}
  13028.  
  13029.      {$IFDEF Win32}
  13030.      ColorLo := RGBToWinColor(ColorLo);
  13031.      ColorHi := RGBToWinColor(ColorHi);
  13032.      Pen1 := CreatePen(PS_SOLID,1,ColorHi);
  13033.      SelectObject(FHandle,Pen1);
  13034.      Line(rec.Left+I,rec.Bottom,rec.Left,rec.Bottom+I);
  13035.      Line(rec.Left,rec.Bottom+I,rec.Left,rec.Top-I);
  13036.      Line(rec.Left,rec.Top-I,rec.Left+I,rec.Top);
  13037.      Line(rec.Left+I,rec.Top,rec.Right-I,rec.Top);
  13038.      Pen:=CreatePen(PS_SOLID,1,ColorLo);
  13039.      DeleteObject(SelectObject(FHandle,Pen));
  13040.      Line(rec.Right-I,rec.Top,rec.Right,rec.Top-I);
  13041.      Line(rec.Right,rec.Top-I,rec.Right,rec.Bottom+I);
  13042.      Line(rec.Right,rec.Bottom+I,rec.Right-I,rec.Bottom);
  13043.      Line(rec.Right-I,rec.Bottom,rec.Left+I,rec.Bottom);
  13044.      If FPenHandle<>0 Then DeleteObject(SelectObject(FHandle,FPenHandle))
  13045.      Else DeleteObject(SelectObject(FHandle,GetStockObject(BLACK_PEN)));
  13046.      If Pen <> 0 Then DeleteObject(Pen);
  13047.      {$ENDIF}
  13048. End;
  13049.  
  13050.  
  13051. Procedure TCanvas.Rectangle(Const rec:TRect);
  13052. {$IFDEF OS2}
  13053. Var  CurrentPoint,DiagPoint:TPoint;
  13054. {$ENDIF}
  13055. {$IFDEF Win32}
  13056. Var  rc:TRect;
  13057. {$ENDIF}
  13058. Begin
  13059.      {$IFDEF OS2}
  13060.      CurrentPoint.X:=rec.Left;
  13061.      CurrentPoint.Y:=rec.Bottom;
  13062.      DiagPoint.X:=CurrentPoint.X+(rec.Right-rec.Left);
  13063.      DiagPoint.Y:=CurrentPoint.Y+(rec.Top-rec.Bottom);
  13064.      GPIMove(FHandle,CurrentPoint);
  13065.      GPIBox(FHandle,DRO_OUTLINE,DiagPoint,0,0);
  13066.      {$ENDIF}
  13067.      {$IFDEF Win32}
  13068.      If Not FInPath Then
  13069.      Begin
  13070.           rc := rec;
  13071.           Dec(rc.Bottom);
  13072.           Inc(rc.Right);
  13073.           RectToWin32Rect(rc);
  13074.           TransformClientRect(rc,FControl,FGraphic);
  13075.           FrameRect(FHandle,RECTL(rc),FBrushHandle);
  13076.      End
  13077.      Else
  13078.      Begin
  13079.           PolyLine([Point(rec.Left,rec.Bottom-1),Point(rec.Right+1,rec.Bottom-1),
  13080.                     Point(rec.Right+1,rec.Top),Point(rec.Left,rec.Top),
  13081.                     Point(rec.Left,rec.Bottom-1)]);
  13082.      End;
  13083.      {$ENDIF}
  13084. End;
  13085.  
  13086. Procedure TCanvas.FilledRoundRect(Const rec:TRect;RoundWidth,RoundHeight:LongInt);
  13087. Begin
  13088.     BeginPath;
  13089.     RoundRect(rec,RoundWidth,RoundHeight);
  13090.     EndPath;
  13091.     FillPath;
  13092. End;
  13093.  
  13094. Procedure TCanvas.RoundRect(Const rec:TRect;RoundWidth,RoundHeight:LongInt);
  13095. {$IFDEF Win32}
  13096. Var rc:TRect;
  13097. {$ENDIF}
  13098. Begin
  13099.      {$IFDEF OS2}
  13100.      If RoundWidth>rec.Right-rec.Left Then RoundWidth:=(rec.Right-rec.Left) Div 2;
  13101.      If RoundHeight>rec.Top-rec.Bottom Then RoundHeight:=(rec.Top-rec.Bottom) Div 2;
  13102.  
  13103.      PenPos:=Point(rec.Left+RoundWidth,rec.Bottom);
  13104.      LineTo(rec.Right-RoundWidth,rec.Bottom);
  13105.      Arc(rec.Right-RoundWidth,rec.Bottom+RoundHeight,RoundWidth,RoundHeight,270,90);
  13106.  
  13107.      LineTo(rec.Right,rec.Top-RoundHeight);
  13108.      Arc(rec.Right-RoundWidth,rec.Top-RoundHeight,RoundWidth,RoundHeight,0,90);
  13109.  
  13110.      LineTo(rec.Left+RoundWidth,rec.Top);
  13111.      Arc(rec.Left+RoundWidth,rec.Top-RoundHeight,RoundWidth,RoundHeight,90,90);
  13112.  
  13113.      LineTo(rec.Left,rec.Bottom+RoundHeight);
  13114.      Arc(rec.Left+RoundWidth,rec.Bottom+RoundHeight,RoundWidth,RoundHeight,180,90);
  13115.      {$ENDIF}
  13116.      {$IFDEF Win32}
  13117.      rc := rec;
  13118.      Dec(rc.Bottom);
  13119.      Inc(rc.Right);
  13120.      RectToWin32Rect(rc);
  13121.      WinGDI.RoundRect(FHandle, rc.Left, rc.Top, rc.Right, rc.Bottom, RoundWidth, RoundHeight);
  13122.      {$ENDIF}
  13123. End;
  13124.  
  13125. Procedure TCanvas.DrawInvertRect(Const rec:TRect);
  13126. Var  rc:TRect;
  13127.      {$IFDEF OS2}
  13128.      SaveLineType:TPenStyle;
  13129.      {$ENDIF}
  13130. Begin
  13131.      rc := rec;
  13132.      {$IFDEF OS2}
  13133.      Inc(rc.Right);
  13134.      Inc(rc.Top);
  13135.      SaveLineType:=Pen.Style;
  13136.      Pen.Style:=psInsideFrame;
  13137.      WinDrawBorder(FHandle,RECTL(rc),1,1,clBlack,clBlack,DB_DESTINVERT);
  13138.      Pen.Style:=SaveLineType;
  13139.      {$ENDIF}
  13140.      {$IFDEF Win32}
  13141.      Dec(rc.Bottom);
  13142.      Inc(rc.Right);
  13143.      RectToWin32Rect(rc);
  13144.      TransformClientRect(rc,FControl,FGraphic);
  13145.      WinUser.DrawFocusRect(FHandle,RECTL(rc));
  13146.      {$ENDIF}
  13147. End;
  13148.  
  13149. Procedure TCanvas.Circle(X,Y:LongInt;Radius:LongInt);
  13150. Begin
  13151.      Ellipse(X,Y,Radius,Radius);
  13152. End;
  13153.  
  13154. Procedure TCanvas.BrushCopy(Const Dest:TRect;Bitmap:TGraphic;Const Source:TRect;Color:TColor);
  13155. Var Mask:TGraphic;
  13156. Begin
  13157.      Mask:=Bitmap.CreateMask(Color);
  13158.      Mask.Canvas.BitBlt(Self,Dest,Source,cmSrcAnd,bitfIgnore);
  13159.      Bitmap.Canvas.BitBlt(Self,Dest,Source,cmSrcPaint,bitfIgnore);
  13160.      Mask.Destroy;
  13161. End;
  13162.  
  13163. Procedure ChordPie(Canvas:TCanvas;X,Y:LongInt;RadiusX,RadiusY:LongInt;StartAngle,SweepAngle:ExtEndeD;
  13164.                    Var StartPoint:TPoint);
  13165. Var  pt:TPoint;
  13166.      {$IFDEF OS2}
  13167.      arcp:ARCPARAMS;
  13168.      sa,swa:FIXED;
  13169.      save:TPenStyle;
  13170.      {$ENDIF}
  13171. Begin
  13172.      pt:=Point(X,Y);
  13173.      Canvas.PenPos:=pt;
  13174.      {$IFDEF OS2}
  13175.      arcp.lp:=RadiusX;
  13176.      arcp.lQ:=RadiusY;
  13177.      arcp.lr:=0;
  13178.      arcp.lS:=0;
  13179.      GpiSetArcParams(Canvas.FHandle,arcp);
  13180.      sa:=MAKEFIXED(Trunc(StartAngle),Round(Frac(StartAngle)*100));
  13181.      swa:=MAKEFIXED(0,0);
  13182.      save:=Canvas.Pen.Style;
  13183.      Canvas.Pen.Style:=psClear;
  13184.      GpiPartialArc(Canvas.FHandle,pt,MAKEFIXED(1,0),sa,swa);
  13185.      Canvas.Pen.Style:=save;
  13186.      StartPoint:=Canvas.PenPos;
  13187.      Canvas.BeginPath;
  13188.      swa:=MAKEFIXED(Trunc(SweepAngle),Round(Frac(SweepAngle)*100));
  13189.      GpiPartialArc(Canvas.FHandle,pt,MAKEFIXED(1,0),sa,swa);
  13190.      {$ENDIF}
  13191.      {$IFDEF Win32}
  13192.      AngleArc(Canvas.FHandle,pt.X,pt.Y,RadiusX,StartAngle,0);
  13193.      StartPoint:=Canvas.PenPos;
  13194.      Canvas.PenPos:=pt;
  13195.      Canvas.BeginPath;
  13196.      AngleArc(Canvas.FHandle,pt.X,pt.Y,RadiusX,StartAngle,SweepAngle);
  13197.      {$ENDIF}
  13198. End;
  13199.  
  13200. Procedure TCanvas.Chord(X,Y:LongInt;RadiusX,RadiusY:LongInt;StartAngle,SweepAngle:Extended);
  13201. Var StartPoint:TPoint;
  13202.     SaveColor:TColor;
  13203. Begin
  13204.      SaveColor:=Pen.color;
  13205.      If Brush.Style=bsSolid Then Pen.color:=Brush.color;
  13206.      ChordPie(Self,X,Y,RadiusX,RadiusY,StartAngle,SweepAngle,StartPoint);
  13207.      LineTo(StartPoint.X,StartPoint.Y);
  13208.      EndPath;
  13209.      FillPath;
  13210.  
  13211.      Pen.color:=SaveColor;
  13212.      ChordPie(Self,X,Y,RadiusX,RadiusY,StartAngle,SweepAngle,StartPoint);
  13213.      LineTo(StartPoint.X,StartPoint.Y);
  13214.      EndPath;
  13215.      OutlinePath;
  13216. End;
  13217.  
  13218. Procedure TCanvas.Pie(X,Y:LongInt;RadiusX,RadiusY:LongInt;StartAngle,SweepAngle:Extended);
  13219. Var StartPoint:TPoint;
  13220.     SaveColor:TColor;
  13221. Begin
  13222.      SaveColor:=Pen.color;
  13223.      If Brush.Style=bsSolid Then Pen.color:=Brush.color;
  13224.      ChordPie(Self,X,Y,RadiusX,RadiusY,StartAngle,SweepAngle,StartPoint);
  13225.      LineTo(X,Y);
  13226.      LineTo(StartPoint.X,StartPoint.Y);
  13227.      EndPath;
  13228.      FillPath;
  13229.  
  13230.      Pen.color:=SaveColor;
  13231.      ChordPie(Self,X,Y,RadiusX,RadiusY,StartAngle,SweepAngle,StartPoint);
  13232.      LineTo(X,Y);
  13233.      LineTo(StartPoint.X,StartPoint.Y);
  13234.      EndPath;
  13235.      OutlinePath;
  13236. End;
  13237.  
  13238. Procedure TCanvas.Arc(X,Y:LongInt;RadiusX,RadiusY:LongInt;StartAngle,SweepAngle:Extended);
  13239. Var  pt:TPoint;
  13240.      {$IFDEF OS2}
  13241.      arcp:ARCPARAMS;
  13242.      sa,swa:FIXED;
  13243.      save:TPenStyle;
  13244.      {$ENDIF}
  13245. Begin
  13246.      pt:=Point(X,Y);
  13247.      {$IFDEF OS2}
  13248.      If SweepAngle>=0 Then //counterclockwise
  13249.      Begin
  13250.          arcp.lp:=RadiusX;
  13251.          arcp.lQ:=RadiusY;
  13252.          arcp.lr:=0;
  13253.          arcp.lS:=0;
  13254.      End
  13255.      Else
  13256.      Begin
  13257.          arcp.lr:=RadiusX;
  13258.          arcp.lS:=RadiusY;
  13259.          arcp.lp:=0;
  13260.          arcp.lQ:=0;
  13261.          If SweepAngle<0 Then SweepAngle:=-SweepAngle;
  13262.      End;
  13263.      If FUsePath Then GpiBeginPath(FHandle,1);
  13264.      GpiSetArcParams(FHandle,arcp);
  13265.      sa:=MAKEFIXED(Trunc(StartAngle),Round(Frac(StartAngle)*100));
  13266.      swa:=MAKEFIXED(0,0);
  13267.      save:=Pen.Style;
  13268.      Pen.Style:=psClear;
  13269.      GpiPartialArc(FHandle,pt,MAKEFIXED(1,0),sa,swa);
  13270.      Pen.Style:=save;
  13271.      swa:=MAKEFIXED(Trunc(SweepAngle),Round(Frac(SweepAngle)*100));
  13272.      GpiPartialArc(FHandle,pt,MAKEFIXED(1,0),sa,swa);
  13273.      If FUsePath Then
  13274.      Begin
  13275.           GpiEndPath(FHandle);
  13276.           GpiStrokePath(FHandle,1,0);
  13277.      End;
  13278.      {$ENDIF}
  13279.      {$IFDEF Win32}
  13280.      If SweepAngle<0 Then
  13281.      Begin
  13282.           SetArcDirection(FHandle,AD_CLOCKWISE);
  13283.           SweepAngle:=-SweepAngle;
  13284.      End
  13285.      Else SetArcDirection(FHandle,AD_COUNTERCLOCKWISE);
  13286.      PenPos:=pt;
  13287.      AngleArc(FHandle,pt.X,pt.Y,RadiusX,StartAngle,SweepAngle);
  13288.      SetArcDirection(FHandle,AD_COUNTERCLOCKWISE);
  13289.      {$ENDIF}
  13290. End;
  13291.  
  13292. Procedure TCanvas.FilledCircle(X,Y:LongInt;Radius:LongInt);
  13293. Begin
  13294.      FilledEllipse(X,Y,Radius,Radius);
  13295. End;
  13296.  
  13297. Procedure TCanvas.Ellipse(X,Y:LongInt;RadiusX,RadiusY:LongInt);
  13298. Var  pt:TPoint;
  13299.      {$IFDEF OS2}
  13300.      arcp:ARCPARAMS;
  13301.      {$ENDIF}
  13302. Begin
  13303.      pt:=Point(X,Y);
  13304.      {$IFDEF OS2}
  13305.      arcp.lp:=RadiusX;
  13306.      arcp.lQ:=RadiusY;
  13307.      arcp.lr:=0;
  13308.      arcp.lS:=0;
  13309.      If FUsePath Then GpiBeginPath(FHandle,1);
  13310.      GpiSetArcParams(FHandle,arcp);
  13311.      GPIMove(FHandle,pt);
  13312.      GpiFullArc(FHandle,DRO_OUTLINE,MAKEFIXED(1,0));
  13313.      If FUsePath Then
  13314.      Begin
  13315.           GpiEndPath(FHandle);
  13316.           GpiStrokePath(FHandle,1,0);
  13317.      End;
  13318.      {$ENDIF}
  13319.      {$IFDEF Win32}
  13320.      TransformClientPoint(pt,FControl,FGraphic);
  13321.      WinGDI.Arc(FHandle,pt.X-RadiusX,pt.Y+RadiusY,pt.X+RadiusX,pt.Y-RadiusY,
  13322.                 pt.X-RadiusX,pt.Y-RadiusY,pt.X-RadiusX,pt.Y-RadiusY);
  13323.      {$ENDIF}
  13324. End;
  13325.  
  13326. Procedure TCanvas.FilledEllipse(X,Y:LongInt;RadiusX,RadiusY:LongInt);
  13327. Var  pt:TPoint;
  13328.      {$IFDEF OS2}
  13329.      arcp:ARCPARAMS;
  13330.      {$ENDIF}
  13331. Begin
  13332.      pt:=Point(X,Y);
  13333.      {$IFDEF OS2}
  13334.      arcp.lp:=RadiusX;
  13335.      arcp.lQ:=RadiusY;
  13336.      arcp.lr:=0;
  13337.      arcp.lS:=0;
  13338.      If FUsePath Then GpiBeginPath(FHandle,1);
  13339.      GpiSetArcParams(FHandle,arcp);
  13340.      GPIMove(FHandle,pt);
  13341.      GpiFullArc(FHandle,DRO_FILL,MAKEFIXED(1,0));
  13342.      If FUsePath Then
  13343.      Begin
  13344.           GpiEndPath(FHandle);
  13345.           GpiStrokePath(FHandle,1,0);
  13346.      End;
  13347.      {$ENDIF}
  13348.      {$IFDEF Win32}
  13349.      TransformClientPoint(pt,FControl,FGraphic);
  13350.      WinGDI.Ellipse(FHandle,pt.X-RadiusX,pt.Y+RadiusY,pt.X+RadiusX,pt.Y-RadiusY);
  13351.      {$ENDIF}
  13352. End;
  13353.  
  13354. Procedure TCanvas.BezierSpline(X,Y:LongInt;Points:Array Of TPoint);
  13355. {$IFDEF Win32}
  13356. Var  T:LongInt;
  13357. {$ENDIF}
  13358. Begin
  13359.      MoveTo(X,Y);
  13360.      {$IFDEF OS2}
  13361.      GpiPolySpline(FHandle,High(Points)+1,Points[0]);
  13362.      {$ENDIF}
  13363.      {$IFDEF Win32}
  13364.      For T:=0 To High(Points)
  13365.         Do TransformClientPoint(Points[T],FControl,FGraphic);
  13366.      PolyBezierTo(FHandle,Points[0],High(Points)+1);
  13367.      {$ENDIF}
  13368. End;
  13369.  
  13370. Procedure TCanvas.Box(Const rec:TRect);
  13371. {$IFDEF OS2}
  13372. Var  CurrentPoint,DiagPoint:TPoint;
  13373. {$ENDIF}
  13374. {$IFDEF Win32}
  13375. Var  Pen:HPEN;
  13376.      rc:TRect;
  13377. {$ENDIF}
  13378. Begin
  13379.      {$IFDEF OS2}
  13380.      CurrentPoint.X:=rec.Left;
  13381.      CurrentPoint.Y:=rec.Bottom;
  13382.      DiagPoint.X:=CurrentPoint.X+(rec.Right-rec.Left);
  13383.      DiagPoint.Y:=CurrentPoint.Y+(rec.Top-rec.Bottom);
  13384.      GPIMove(FHandle,CurrentPoint);
  13385.      GPIBox(FHandle,DRO_FILL,DiagPoint,0,0);
  13386.      {$ENDIF}
  13387.      {$IFDEF Win32}
  13388.      rc := rec;
  13389.      Pen:=GetStockObject(NULL_PEN);
  13390.      If FHandle<>0 Then SelectObject(FHandle,Pen);
  13391.      TransformClientRect(rc,FControl,FGraphic);
  13392.      Inc(rc.Bottom,2);
  13393.      Inc(rc.Right,2);
  13394.      WinGDI.Rectangle(FHandle,rc.Left,rc.Bottom,rc.Right,rc.Top);
  13395.      If FHandle<>0 Then
  13396.      Begin
  13397.           If FPenHandle<>0 Then SelectObject(FHandle,FPenHandle)
  13398.           Else SelectObject(FHandle,GetStockObject(BLACK_PEN));
  13399.      End;
  13400.      If Pen<>0 Then DeleteObject(Pen);
  13401.      {$ENDIF}
  13402. End;
  13403.  
  13404. Procedure TCanvas.OutlineBox(Const rec:TRect);
  13405. {$IFDEF OS2}
  13406. Var  CurrentPoint,DiagPoint:TPoint;
  13407. {$ENDIF}
  13408. {$IFDEF Win32}
  13409. Var  rc:TRect;
  13410. {$ENDIF}
  13411. Begin
  13412.      {$IFDEF OS2}
  13413.      CurrentPoint.X:=rec.Left;
  13414.      CurrentPoint.Y:=rec.Bottom;
  13415.      DiagPoint.X:=CurrentPoint.X+(rec.Right-rec.Left);
  13416.      DiagPoint.Y:=CurrentPoint.Y+(rec.Top-rec.Bottom);
  13417.      GPIMove(FHandle,CurrentPoint);
  13418.      GPIBox(FHandle,DRO_OUTLINEFILL,DiagPoint,0,0);
  13419.      {$ENDIF}
  13420.      {$IFDEF Win32}
  13421.      rc := rec;
  13422.      TransformClientRect(rc,FControl,FGraphic);
  13423.      Inc(rc.Bottom);
  13424.      Inc(rc.Right);
  13425.      WinGDI.Rectangle(FHandle,rc.Left,rc.Bottom,rc.Right,rc.Top);
  13426.      {$ENDIF}
  13427. End;
  13428.  
  13429. Procedure TCanvas.DrawFocusRect(Const rec:TRect);
  13430. {$IFDEF OS2}
  13431. Var  SaveLineType:TPenStyle;
  13432. {$ENDIF}
  13433. {$IFDEF Win32}
  13434. Var  rc:TRect;
  13435. {$ENDIF}
  13436. Begin
  13437.      {$IFDEF OS2}
  13438.      SaveLineType:=Pen.Style;
  13439.      Pen.Style:=psInsideFrame;
  13440.      Rectangle(rec);
  13441.      Pen.Style:=SaveLineType;
  13442.      {$ENDIF}
  13443.      {$IFDEF Win32}
  13444.      rc := rec;
  13445.      Inc(rc.Right);
  13446.      Dec(rc.Bottom);
  13447.      RectToWin32Rect(rc);
  13448.      TransformClientRect(rc,FControl,FGraphic);
  13449.      WinUser.DrawFocusRect(FHandle,RECTL(rc));
  13450.      {$ENDIF}
  13451. End;
  13452.  
  13453.  
  13454. Procedure TCanvas.FloodFill(X,Y:LongInt;BorderColor:TColor;FillSurface:Boolean);
  13455. Var  RefPoint:TPoint;
  13456.      Options:LongWord;
  13457. Begin
  13458.      RefPoint := Point(X,Y);
  13459.      BorderColor := SysColorToRGB(BorderColor);
  13460.      {$IFDEF OS2}
  13461.      GPIMove(FHandle,RefPoint);
  13462.      If FillSurface Then Options:=FF_SURFACE
  13463.      Else Options:=FF_BOUNDARY;
  13464.      GPIFloodFill(FHandle,Options,BorderColor);
  13465.      {$ENDIF}
  13466.      {$IFDEF Win32}
  13467.      BorderColor:=RGBToWinColor(BorderColor);
  13468.      TransformClientPoint(RefPoint,FControl,FGraphic);
  13469.      If FillSurface Then Options:=FLOODFILLSURFACE
  13470.      Else Options:=FLOODFILLBORDER;
  13471.      WinGDI.ExtFloodFill(FHandle,RefPoint.X,RefPoint.Y,BorderColor,Options);
  13472.      {$ENDIF}
  13473. End;
  13474.  
  13475.  
  13476. Procedure TCanvas.DrawString(Const S:String);
  13477. Var  pp:TPoint;
  13478.      {$IFDEF OS2}
  13479.      CX,CY:LongInt;
  13480.      rc:TRect;
  13481.      {$ENDIF}
  13482.      {$IFDEF Win32}
  13483.      Align:LongWord;
  13484.      {$ENDIF}
  13485. Begin
  13486.      {$IFDEF OS2}
  13487.      {Some Fonts don't overpaint the the background}
  13488.      If Font.Attributes <> [] Then
  13489.        If Brush.Mode = bmOpaque Then
  13490.      Begin
  13491.           pp := PenPos;
  13492.           GetTextExtent(S,CX,CY);
  13493.           rc.Left := pp.X;
  13494.           rc.Bottom := pp.Y;
  13495.           rc.Right := rc.Left + CX -1;
  13496.           rc.Top := rc.Bottom + CY -1;
  13497.           FillRect(rc,Brush.color);
  13498.      End;
  13499.      GpiCharString(FHandle,Length(S),S[1]);
  13500.      {$ENDIF}
  13501.      {$IFDEF Win32}
  13502.      pp:=PenPos;
  13503.      Align:=GetTextAlign(FHandle);
  13504.      SetTextAlign(FHandle,Align Or TA_UPDATECP);
  13505.      WinGDI.TextOut(FHandle,pp.X,pp.Y,S[1],Length(S));
  13506.      SetTextAlign(FHandle,Align);
  13507.      {$ENDIF}
  13508. End;
  13509.  
  13510. Procedure TCanvas.TextOut(X,Y:LongInt;Const S:String);
  13511. Var  pt:TPoint;
  13512.      {$IFDEF OS2}
  13513.      CX,CY:LongInt;
  13514.      rc:TRect;
  13515.      {$ENDIF}
  13516.      {$IFDEF Win32}
  13517.      Align:LongWord;
  13518.      S1:String;
  13519.      {$ENDIF}
  13520. Begin
  13521.      pt := Point(X,Y);
  13522.      {$IFDEF OS2}
  13523.      {Some Fonts don't overpaint the the background}
  13524.      If Font.Attributes <> [] Then
  13525.        If Brush.Mode = bmOpaque Then
  13526.      Begin
  13527.           GetTextExtent(S,CX,CY);
  13528.           rc.Left := X;
  13529.           rc.Bottom := Y;
  13530.           rc.Right := rc.Left + CX -1;
  13531.           rc.Top := rc.Bottom + CY -1;
  13532.           FillRect(rc,Brush.color);
  13533.      End;
  13534.      Inc(pt.Y,FFont.FFontInfo.lMaxDescender);
  13535.      GpiCharStringAt(FHandle,pt,Length(S),S[1]);
  13536.      {$ENDIF}
  13537.      {$IFDEF Win32}
  13538.      Dec(pt.Y);
  13539.      PenPos:= pt;
  13540.      Align := GetTextAlign(FHandle);
  13541.      SetTextAlign(FHandle,Align Or TA_UPDATECP);
  13542.      TransformClientPoint(pt,FControl,FGraphic);
  13543.      S1:=S;
  13544.      StrOemToAnsi(S1);
  13545.      WinGDI.TextOut(FHandle,pt.X,pt.Y,S1[1],Length(S1));
  13546.      SetTextAlign(FHandle,Align);
  13547.      {$ENDIF}
  13548. End;
  13549.  
  13550. Procedure TCanvas.MnemoTextOut(X,Y:LongInt;Const S:String);
  13551. Var  OldFontAttr:TFontAttributes;
  13552.      CX,CY:LongInt;
  13553.      s1,s2:String;
  13554.      P:Integer;
  13555.      rc:TRect;
  13556. Begin
  13557.      P := Pos(MnemoChar,S);
  13558.      If (P > 0) And (P < Length(S)) Then
  13559.      Begin
  13560.           //OldClip := ClipRect;
  13561.  
  13562.           If FControl <> Nil Then FControl.IsFontChangeEnabled := False;  {dont call FontChange}
  13563.           s1 := S;
  13564.           {$IFDEF WIN32}
  13565.           StrOemToAnsi(s1);
  13566.           {$ENDIF}
  13567.           {Draw normal portion}
  13568.           s2 := Copy(s1,1,P-1);
  13569.           Delete(s1,1,P);   {incl. ~ }
  13570.           GetTextExtent(s2,CX,CY);
  13571.           rc.Left := X;
  13572.           rc.Bottom := Y;
  13573.           rc.Right := X + CX;
  13574.           rc.Top := Y + CY;
  13575.           //ClipRect := rc;
  13576.           TextOut(X,Y,s2);
  13577.           Inc(X,CX);
  13578.  
  13579.           {Draw underlines portion}
  13580.           OldFontAttr := FontAttributes;
  13581.           FontAttributes := OldFontAttr + [faUnderScore];
  13582.           s2 := Copy(s1,1,1);    {Mnemo}
  13583.           Delete(s1,1,1);
  13584.           GetTextExtent(s2,CX,CY);
  13585.           rc.Left := X;
  13586.           rc.Right := X + CX;
  13587.           rc.Top := Y + CY;
  13588.           //ClipRect := rc;
  13589.           TextOut(X,Y,s2);
  13590.           Inc(X,CX);
  13591.  
  13592.           {Draw rest portion}
  13593.           FontAttributes := OldFontAttr;
  13594.           s2 := s1;
  13595.           GetTextExtent(s2,CX,CY);
  13596.           rc.Left := X;
  13597.           rc.Right := X + CX;
  13598.           rc.Top := Y + CY;
  13599.           //ClipRect := rc;
  13600.           TextOut(X,Y,s2);
  13601.           If FControl <> Nil Then FControl.IsFontChangeEnabled := True;  {Default}
  13602.  
  13603.           //ClipRect := OldClip;
  13604.      End
  13605.      Else
  13606.      Begin
  13607.           GetTextExtent(S,CX,CY);
  13608.           rc.Left := X;
  13609.           rc.Bottom := Y;
  13610.           rc.Right := X + CX;
  13611.           rc.Top := Y + CY;
  13612.           TextOut(X,Y,S);
  13613.      End;
  13614. End;
  13615.  
  13616. Procedure TCanvas.Draw(X,Y:LongInt;Graphic:TGraphic);
  13617. Var  rec:TRect;
  13618. Begin
  13619.      If Graphic = Nil Then Exit;
  13620.      If Graphic.Empty Then Exit;  {Nothing To Draw}
  13621.  
  13622.      rec.Left:=X;
  13623.      rec.Right:=X+Graphic.Width;
  13624.      rec.Bottom:=Y;
  13625.      rec.Top:=Y+Graphic.Height;
  13626.      Graphic.Draw(Self,rec);
  13627. End;
  13628.  
  13629. Procedure TCanvas.PartialDraw(X,Y:LongInt;Const SourceRec:TRect;Graphic:TGraphic);
  13630. Var  rec:TRect;
  13631. Begin
  13632.      If Graphic = Nil Then Exit;
  13633.      If Graphic.Empty Then Exit;  {Nothing To Draw}
  13634.  
  13635.      rec.Left:=X;
  13636.      rec.Right:=X+Graphic.Width;
  13637.      rec.Bottom:=Y;
  13638.      rec.Top:=Y+Graphic.Height;
  13639.      Graphic.PartialDraw(Self,SourceRec,rec);
  13640. End;
  13641.  
  13642. Procedure TCanvas.StretchDraw(X,Y,Width,Height:LongInt;Graphic:TGraphic);
  13643. Var  rec:TRect;
  13644. Begin
  13645.      If Graphic = Nil Then Exit;
  13646.      If Graphic.Empty Then Exit;  {Nothing To Draw}
  13647.  
  13648.      rec.Left:=X;
  13649.      rec.Right:=X+Width;
  13650.      rec.Bottom:=Y;
  13651.      rec.Top:=Y+Height;
  13652.      Graphic.Draw(Self,rec);
  13653. End;
  13654.  
  13655. Procedure TCanvas.StretchPartialDraw(X,Y,Width,Height:LongInt;
  13656.                                      Const SourceRec:TRect;Graphic:TGraphic);
  13657. Var  rec:TRect;
  13658. Begin
  13659.      If Graphic = Nil Then Exit;
  13660.      If Graphic.Empty Then Exit;  {Nothing To Draw}
  13661.  
  13662.      rec.Left:=X;
  13663.      rec.Right:=X+Width;
  13664.      rec.Bottom:=Y;
  13665.      rec.Top:=Y+Height;
  13666.      Graphic.PartialDraw(Self,SourceRec,rec);
  13667. End;
  13668.  
  13669. {
  13670. ╔═══════════════════════════════════════════════════════════════════════════╗
  13671. ║                                                                           ║
  13672. ║ Speed-Pascal/2 Version 2.0                                                ║
  13673. ║                                                                           ║
  13674. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  13675. ║                                                                           ║
  13676. ║ This section: General FUNCTIONs Implementation                            ║
  13677. ║                                                                           ║
  13678. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  13679. ║                                                                           ║
  13680. ╚═══════════════════════════════════════════════════════════════════════════╝
  13681. }
  13682.  
  13683. Function OppositeRGB(color:TColor):TColor;
  13684. Var  R,G,B:Byte;
  13685. Begin
  13686.      RGBToValues(color,R,G,B);
  13687.      If R > $80 Then R := 0 Else R := $FF;
  13688.      If G > $80 Then G := 0 Else G := $FF;
  13689.      If B > $80 Then B := 0 Else B := $FF;
  13690.      Result := ValuesToRGB(R,G,B);
  13691. End;
  13692.  
  13693.  
  13694. Function ValuesToRGB(Red,Green,Blue:Byte):TColor;
  13695. Var  R,G,B:LongInt;
  13696. Begin
  13697.      R := Red;
  13698.      G := Green;
  13699.      B := Blue;
  13700.      Result := R Shl 16 + (G Shl 8) + B;
  13701. End;
  13702.  
  13703.  
  13704. Function RGBToValues(color:TColor;Var Red,Green,Blue:Byte):TColor;
  13705. Begin
  13706.      Result := SysColorToRGB(color);
  13707.      Red := (Result And $FFFFFF) Shr 16;
  13708.      Green := (Result And $FFFF) Shr 8;
  13709.      Blue := (Result And $FF);
  13710. End;
  13711.  
  13712.  
  13713. Const
  13714.     SysColors:Array[0..28] Of TColor = (
  13715.        {$IFDEF OS2}
  13716.        SYSCLR_SCROLLBAR, {clScrollbar}
  13717.        SYSCLR_BACKGROUND, {clBackGround}
  13718.        SYSCLR_ACTIVETITLE, {clActiveCaption}
  13719.        SYSCLR_INACTIVETITLE, {clInactiveCaption}
  13720.        SYSCLR_MENU, {clMenu}
  13721.        SYSCLR_WINDOW, {clWindow}
  13722.        SYSCLR_WINDOWFRAME, {clWindowFrame}
  13723.        SYSCLR_MENUTEXT, {clMenuText}
  13724.        SYSCLR_WINDOWTEXT, {clWindowText}
  13725.        SYSCLR_ACTIVETITLETEXT, {clCaptionText}
  13726.        SYSCLR_ACTIVEBORDER, {clActiveBorder}
  13727.        SYSCLR_INACTIVEBORDER, {clInactiveBorder}
  13728.        SYSCLR_APPWORKSPACE, {clAppWorkSpace}
  13729.        SYSCLR_HILITEBACKGROUND, {clHighlight}
  13730.        SYSCLR_HILITEFOREGROUND, {clHighlightText}
  13731.        SYSCLR_BUTTONMIDDLE, {clBtnFace}
  13732.        SYSCLR_BUTTONDARK, {clBtnShadow}
  13733.        clDkGray, {clGrayText}
  13734.        SYSCLR_MENUTEXT, {clBtnText}
  13735.        SYSCLR_INACTIVETITLETEXT, {clInactiveCaptionText}
  13736.        SYSCLR_BUTTONLIGHT, {clBtnHighlight}
  13737.        clBlack, {cl3DDkShadow}
  13738.        clWhite, {cl3DLight}
  13739.        clBlack, {clInfoText}
  13740.        clYellow,{clInfo}
  13741.        SYSCLR_BUTTONDEFAULT, {clBtnDefault}
  13742.        SYSCLR_DIALOGBACKGROUND, {clDlgWindow}
  13743.        SYSCLR_ENTRYFIELD, {clEntryField}
  13744.        SYSCLR_WINDOWSTATICTEXT {clStaticText}
  13745.        {$ENDIF}
  13746.        {$IFDEF Win95}
  13747.        COLOR_SCROLLBAR Or $80000000, {clScrollbar}
  13748.        COLOR_BACKGROUND Or $80000000, {clBackGround}
  13749.        COLOR_ACTIVECAPTION Or $80000000, {clActiveCaption}
  13750.        COLOR_INACTIVECAPTION Or $80000000, {clInactiveCaption}
  13751.        COLOR_MENU Or $80000000, {clMenu}
  13752.        COLOR_WINDOW Or $80000000, {clWindow}
  13753.        COLOR_WINDOWFRAME Or $80000000, {clWindowFrame}
  13754.        COLOR_MENUTEXT Or $80000000, {clMenuText}
  13755.        COLOR_WINDOWTEXT Or $80000000, {clWindowText}
  13756.        COLOR_CAPTIONTEXT Or $80000000, {clCaptionText}
  13757.        COLOR_ACTIVEBORDER Or $80000000, {clActiveBorder}
  13758.        COLOR_INACTIVEBORDER Or $80000000, {clInactiveBorder}
  13759.        COLOR_APPWORKSPACE Or $80000000, {clAppWorkSpace}
  13760.        COLOR_HIGHLIGHT Or $80000000, {clHighlight}
  13761.        COLOR_HIGHLIGHTTEXT Or $80000000, {clHighlightText}
  13762.        COLOR_BTNFACE Or $80000000, {clBtnFace}
  13763.        COLOR_BTNSHADOW Or $80000000, {clBtnShadow}
  13764.        COLOR_GRAYTEXT Or $80000000, {clGrayText}
  13765.        COLOR_BTNTEXT Or $80000000, {clBtnText}
  13766.        COLOR_INACTIVECAPTIONTEXT Or $80000000, {clInactiveCaptionText}
  13767.        COLOR_BTNHIGHLIGHT Or $80000000, {clBtnHighlight}
  13768.        COLOR_3DDKSHADOW Or $80000000, {cl3DDkShadow}
  13769.        COLOR_3DLIGHT Or $80000000, {cl3DLight}
  13770.        COLOR_INFOTEXT Or $80000000, {clInfoText}
  13771.        COLOR_INFOBK Or $80000000, {clInfo}
  13772.        clBlack, {clBtnDefault}
  13773.        clLtGray, {clDlgWindow}
  13774.        COLOR_WINDOW Or $80000000, {clEntryField}
  13775.        COLOR_WINDOWTEXT Or $80000000 {clStaticText}
  13776.        {$ENDIF}
  13777.     );
  13778.  
  13779.  
  13780. Function SysColorToRGB(color:TColor):TColor;
  13781. Var  Col:LongInt;
  13782. Begin
  13783.      If color < 0 Then {SPCC Portable System color}
  13784.      Begin
  13785.           Col := Color And $000000FF;
  13786.           If Col In [0..28] Then Color := SysColors[Col];
  13787.  
  13788.           If Color < 0 Then
  13789.           Begin
  13790.                {$IFDEF OS2}
  13791.                Result := WinQuerySysColor(HWND_DESKTOP,Color,0) {OS/2 System color -> SPCC RGB}
  13792.                {$ENDIF}
  13793.                {$IFDEF Win32}
  13794.                color := color And $000000FF;
  13795.                color := GetSysColor(Color);     {Win32 System color -> Win32 RGB}
  13796.                Result := WinColorToRGB(Color);  {SPCC RGB}
  13797.                {$ENDIF}
  13798.           End
  13799.           Else Result := Color; {normal RGB color}
  13800.      End
  13801.      Else Result := Color;
  13802. End;
  13803.  
  13804.  
  13805. {$HINTS OFF}
  13806. Function WinColorToRGB(color:TColor):TColor;Assembler;
  13807.      Asm
  13808.         //Swap Red And Blue values
  13809.         MOV AL,color     //Red Value
  13810.         MOV BL,color+2   //Blue Value
  13811.         MOV color+2,AL
  13812.         MOV color,BL
  13813.         MOV EAX,color
  13814.         CMP EAX,$00C0C0C0
  13815.         JNE !ex
  13816.         MOV EAX,$00CCCCCC
  13817. !ex:
  13818.         leave
  13819.         RETN32 4
  13820.      End;
  13821.  
  13822.  
  13823. Function RGBToWinColor(color:TColor):TColor;Assembler;
  13824.      Asm
  13825.         //Swap Red And Blue values
  13826.         MOV AL,color     //Red Value
  13827.         MOV BL,color+2   //Blue Value
  13828.         MOV color+2,AL
  13829.         MOV color,BL
  13830.         MOV EAX,color
  13831.         CMP EAX,$00CCCCCC
  13832.         JNE !ex2
  13833.         MOV EAX,$00C0C0C0
  13834. !ex2:
  13835.         leave
  13836.         RETN32 4
  13837.      End;
  13838. {$HINTS ON}
  13839.  
  13840.  
  13841. Function GetShortHint(Const Hint:String):String;
  13842. Var  I:Integer;
  13843. Begin
  13844.      I := Pos('|',Hint);
  13845.      If I = 0 Then Result := Hint
  13846.      Else Result := Copy(Hint, 1, I-1);
  13847. End;
  13848.  
  13849. Function GetLongHint(Const Hint:String):String;
  13850. Var  I:Integer;
  13851. Begin
  13852.      I := Pos('|',Hint);
  13853.      If I = 0 Then Result := Hint
  13854.      Else Result := Copy(Hint, I+1, MaxInt);
  13855. End;
  13856.  
  13857.  
  13858. Function Point(X,Y:LongInt):TPoint;
  13859. Begin
  13860.      Result.X := X;
  13861.      Result.Y := Y;
  13862. End;
  13863.  
  13864.  
  13865. Function Rect(Left,Bottom,Right,Top:LongInt):TRect;
  13866. Begin
  13867.      Result.Left := Left;
  13868.      Result.Bottom := Bottom;
  13869.      Result.Right := Right;
  13870.      Result.Top := Top;
  13871. End;
  13872.  
  13873.  
  13874. Function PointInRect(pt:TPoint; rec:TRect):Boolean;
  13875. Begin
  13876.      Result := False;
  13877.      If pt.X < rec.Left Then Exit;
  13878.      If pt.X > rec.Right Then Exit;
  13879.      If pt.Y < rec.Bottom Then Exit;
  13880.      If pt.Y > rec.Top Then Exit;
  13881.      Result := True;
  13882. End;
  13883.  
  13884.  
  13885. Function RectInRect(Const childrec,parentrec:TRect):Boolean;
  13886. Begin
  13887.      Result := False;
  13888.      If childrec.Left <= parentrec.Left Then Exit;
  13889.      If childrec.Right >= parentrec.Right Then Exit;
  13890.      If childrec.Bottom <= parentrec.Bottom Then Exit;
  13891.      If childrec.Top >= parentrec.Top Then Exit;
  13892.      Result := True;
  13893. End;
  13894.  
  13895.  
  13896. Procedure InflateRect(Var rec:TRect; X,Y:LongInt);
  13897. Begin
  13898.      Dec(rec.Left, X);
  13899.      Dec(rec.Bottom, Y);
  13900.      Inc(rec.Right, X);
  13901.      Inc(rec.Top, Y);
  13902. End;
  13903.  
  13904.  
  13905. Procedure OffsetRect(Var rec:TRect; X,Y:LongInt);
  13906. Begin
  13907.      Inc(rec.Left, X);
  13908.      Inc(rec.Bottom, Y);
  13909.      Inc(rec.Right, X);
  13910.      Inc(rec.Top, Y);
  13911. End;
  13912.  
  13913.  
  13914. Procedure CheckEmpty(Var rec:TRect);
  13915. Begin
  13916.      If (rec.Left > rec.Right) Or (rec.Bottom > rec.Top) Then
  13917.        FillChar(rec,SizeOf(TRect),0);
  13918. End;
  13919.  
  13920. {returns Rectangle that Is owned by both rectangles Or Empty rec}
  13921. Function IntersectRect(Const rec1,rec2:TRect):TRect;
  13922. Begin
  13923.      Result:=rec1;
  13924.      Asm
  13925.         MOV ESI,rec2
  13926.         MOV EDI,rec1
  13927.         MOV EBX,[EBP-4]
  13928.         CLD
  13929.  
  13930.         //process TRect.Left And yBottom
  13931.         LODSD
  13932.         SCASD
  13933.         JLE     !l11
  13934.         MOV [EBX].TRect.Left,EAX
  13935. !l11:
  13936.         LODSD
  13937.         SCASD
  13938.         JLE     !l12
  13939.         MOV [EBX].TRect.Bottom,EAX
  13940. !l12:
  13941.         //process TRect.Right,yBottom
  13942.         LODSD
  13943.         SCASD
  13944.         JGE     !l13
  13945.         MOV [EBX].TRect.Right,EAX
  13946. !l13:
  13947.         LODSD
  13948.         SCASD
  13949.         JGE     !l14
  13950.         MOV [EBX].TRect.Top,EAX
  13951. !l14:
  13952.         PUSH DWord Ptr [EBP-4]
  13953.         CALLN32 Forms.CheckEmpty
  13954.      End;
  13955. End;
  13956.  
  13957.  
  13958. {returns Rectangle that covers both rectangles}
  13959. Function UnionRect(Const rec1,rec2:TRect):TRect;
  13960. Begin
  13961.      Result:=rec1;
  13962.      Asm
  13963.         MOV ESI,rec2
  13964.         MOV EDI,rec1
  13965.         MOV EBX,[EBP-4]
  13966.         CLD
  13967.  
  13968.         //process TRect.Left,yBottom
  13969.         LODSD
  13970.         SCASD
  13971.         JGE     !l21
  13972.         MOV [EBX].TRect.Left,EAX
  13973. !l21:
  13974.         LODSD
  13975.         SCASD
  13976.         JGE     !l22
  13977.         MOV [EBX].TRect.Bottom,EAX
  13978. !l22:
  13979.         //process TRect.Right,yTop
  13980.         LODSD
  13981.         SCASD
  13982.         JLE     !l23
  13983.         MOV [EBX].TRect.Right,EAX
  13984. !l23:
  13985.         LODSD
  13986.         SCASD
  13987.         JLE     !l24
  13988.         MOV [EBX].TRect.Top,EAX
  13989. !l24:
  13990.      End;
  13991. End;
  13992.  
  13993.  
  13994. Function IsRectEmpty(Const rec:TRect):Boolean;
  13995. Begin
  13996.      Result := (rec.Left=0)And(rec.Right=0)And(rec.Bottom=0)And(rec.Top=0);
  13997. End;
  13998.  
  13999.  
  14000. Function IsControlLocked(Control:TControl):Boolean;
  14001. Var  AForm:TForm;
  14002. Begin
  14003.      Result := False;
  14004.      If Control <> Nil Then
  14005.      Begin
  14006.           AForm := Control.Form;
  14007.           If AForm Is TForm Then Result := AForm.FLocked;
  14008.      End;
  14009. End;
  14010.  
  14011.  
  14012. {
  14013. ╔═══════════════════════════════════════════════════════════════════════════╗
  14014. ║                                                                           ║
  14015. ║ Some drawing elements                                                     ║
  14016. ║                                                                           ║
  14017. ╚═══════════════════════════════════════════════════════════════════════════╝
  14018. }
  14019.  
  14020. {looks like TEdit}
  14021. Procedure DrawSystemBorder(Control:TControl;Var rec:TRect;Style:TBorderStyle);
  14022. Var  rc:TRect;
  14023.      OldColor:TColor;
  14024. Begin
  14025.      If Control = Nil Then Exit;
  14026.  
  14027.      If Style In [bsSingle] Then
  14028.      Case Application.Platform Of
  14029.        Win32,OS2Ver40:
  14030.        Begin
  14031.             Control.Canvas.ShadowedBorder(rec,clDkGray,clWhite);
  14032.             InflateRect(rec,-1,-1);
  14033.             Control.Canvas.ShadowedBorder(rec,clBlack,clLtGray);
  14034.             InflateRect(rec,-1,-1);
  14035.        End;
  14036.        Else
  14037.        Begin
  14038.             rc := rec;
  14039.             OldColor := Control.Canvas.Pen.color;
  14040.             Control.Canvas.Pen.color := clBtnHighlight;
  14041.             Inc(rc.Left);
  14042.             Dec(rc.Top);
  14043.             Control.Canvas.Rectangle(rc);
  14044.  
  14045.             Control.Canvas.Pen.color := clWindowFrame;
  14046.             OffsetRect(rc,-1,1);
  14047.             Control.Canvas.Rectangle(rc);
  14048.  
  14049.             If Control.Parent <> Nil
  14050.             Then Control.Canvas.Pen.color := Control.Parent.color
  14051.             Else Control.Canvas.Pen.color := clBackGround;
  14052.             Control.Canvas.SetPixel(rec.Left,rec.Bottom,Control.Canvas.Pen.color);
  14053.             Control.Canvas.SetPixel(rec.Right,rec.Top,Control.Canvas.Pen.color);
  14054.  
  14055.             Control.Canvas.Pen.color := OldColor;
  14056.             InflateRect(rec,-1,-1);
  14057.             InflateRect(rec,-1,-1);
  14058.        End;
  14059.      End;
  14060. End;
  14061.  
  14062.  
  14063. {looks like TGroupBox}
  14064. Procedure DrawSystemFrame(Control:TControl;Var rec:TRect;LightColor,DarkColor:TColor);
  14065. Var  rc1:TRect;
  14066. Begin
  14067.      If Control = Nil Then Exit;
  14068.      rc1 := rec;
  14069.      Control.Canvas.Pen.color := LightColor;
  14070.      Inc(rc1.Left);
  14071.      Dec(rc1.Top);
  14072.      Control.Canvas.Rectangle(rc1);
  14073.      Control.Canvas.Pen.color := DarkColor;
  14074.      OffsetRect(rc1,-1,1);
  14075.      Control.Canvas.Rectangle(rc1);
  14076.      Control.Canvas.Pen.color := Control.color;
  14077.      Control.Canvas.SetPixel(rec.Left,rec.Bottom,Control.Canvas.Pen.color);
  14078.      Control.Canvas.SetPixel(rec.Right,rec.Top,Control.Canvas.Pen.color);
  14079.      InflateRect(rec,-1,-1);
  14080.      InflateRect(rec,-1,-1);
  14081. End;
  14082.  
  14083.  
  14084. Function StandardFont(Control:TControl):TFont;
  14085. Begin
  14086.      Result := Screen.DefaultFont;
  14087.      If Control.Designed Then Exit;
  14088.      If Control.ComponentState * [csWriting] <> [] Then Exit;
  14089.      If Application = Nil Then Exit;
  14090.      IF Application.Font <> Nil Then Result := Application.Font;    {small}
  14091. End;
  14092.  
  14093. {
  14094. ╔═══════════════════════════════════════════════════════════════════════════╗
  14095. ║                                                                           ║
  14096. ║ Speed-Pascal/2 Version 2.0                                                ║
  14097. ║                                                                           ║
  14098. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  14099. ║                                                                           ║
  14100. ║ This section: TFrameControl Class Implementation                          ║
  14101. ║                                                                           ║
  14102. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  14103. ║                                                                           ║
  14104. ╚═══════════════════════════════════════════════════════════════════════════╝
  14105. }
  14106.  
  14107. {$IFDEF OS2}
  14108. Function StartWndProc(Win:HWND;Msg,para1,para2:ULONG):ULONG;CDECL;
  14109. Begin
  14110.      Result:=WinDefWindowProc(Win,Msg,para1,para2);
  14111. End;
  14112. {$ENDIF}
  14113.  
  14114. {$IFDEF Win32}
  14115. Function StartWndProc(Win:HWND;Msg:ULONG;para1:WParam;para2:LParam):LRESULT;APIENTRY;
  14116. Begin
  14117.      Result:=DefWindowProc(Win,Msg,para1,para2);
  14118. End;
  14119. {$ENDIF}
  14120.  
  14121. {$IFDEF OS2}
  14122. Type
  14123.     PStructureArray=^TStructureArray;
  14124.     TStructureArray=Array[0..65000] Of SWP;
  14125.  
  14126.     TFmtFrameMessage=Record
  14127.          Message: LongWord;
  14128.          ReceiverClass: TObject;
  14129.          Receiver: HWindow;
  14130.          Handled: LongBool;  {True If the Message was Handled}
  14131.          structure: PStructureArray;
  14132.          Rect: ^RECTL;
  14133.          Count: LongWord;     {Count Of elements In structure}
  14134.     End;
  14135.  
  14136.     TCalcFRectMessage=Record
  14137.          Message: LongWord;
  14138.          ReceiverClass: TObject;
  14139.          Receiver: HWindow;
  14140.          Handled: LongBool;  {True If the Message was Handled}
  14141.          Rect: ^RECTL;
  14142.          Frame: LongWord;     {Frame indicator}
  14143.          Result: LongBool;    {Rect calculated indicator}
  14144.     End;
  14145. {$ENDIF}
  14146.  
  14147.  
  14148. {$IFDEF OS2}
  14149. Procedure TFrameControl.WMActivate(Var Msg:TWMActivate);
  14150. Var  Win:HWND;
  14151.      AOwner:TForm;
  14152. Begin
  14153.      // Deactivate A MDIChild Is Not Handled
  14154.      If Not Msg.Active Then Exit;
  14155.  
  14156.      If Not (FChild Is TForm) Then Exit;
  14157.  
  14158.      {
  14159.      If FChild.FLocked Then
  14160.      Begin
  14161.           Msg.Handled := True;
  14162.           Msg.Result := 0;
  14163.           Exit;
  14164.      End;
  14165.      }
  14166.  
  14167.      If FChild.FFormStyle <> fsMDIChild Then Exit;
  14168.  
  14169.      Win := Msg.Receiver;
  14170.      If Msg.Active Then WinSetFocus(HWND_DESKTOP,FChild.Handle);
  14171.  
  14172.      If Parent = Nil Then Exit;
  14173.      AOwner := TForm(Parent);
  14174.      If Not (AOwner Is TForm) Then Exit;
  14175.  
  14176.      If AOwner.FTopMDIChild <> Nil
  14177.        Then AOwner.MDIDeactivate(AOwner.FTopMDIChild);
  14178.  
  14179.      AOwner.FTopMDIChild := FChild;
  14180.  
  14181.      AOwner.MDIActivate(FChild);
  14182. End;
  14183. {$ENDIF}
  14184.  
  14185.  
  14186. {$IFDEF Win32}
  14187. Procedure TFrameControl.WMClose(Var Msg:TWMClose);
  14188. Begin
  14189.      If FChild <> Nil Then FChild.Close;
  14190.  
  14191.      Msg.Handled := True;
  14192.      Msg.Result := 0;
  14193. End;
  14194.  
  14195.  
  14196. Procedure TFrameControl.WMChildActivate(Var Msg:TMessage);
  14197. Var Win:HWND;
  14198.     AOwner:TForm;
  14199.     TopChild:TForm;
  14200. Begin
  14201.      If Not (FChild Is TForm) Then Exit;
  14202.      If FChild.FFormStyle <> fsMDIChild Then Exit;
  14203.  
  14204.      If Parent = Nil Then Exit;
  14205.      AOwner := TForm(Parent);
  14206.      If Not (AOwner Is TForm) Then Exit;
  14207.  
  14208.      Win := GetTopWindow(AOwner.Handle);
  14209.      TopChild := TForm(HandleToControl(Win));    {Frame}
  14210.      If TControl(TopChild) Is TFrameControl
  14211.      Then TopChild := TFrameControl(TopChild).FChild;
  14212.  
  14213.      If AOwner.FTopMDIChild = TopChild Then
  14214.      Begin
  14215.           WinUser.SetFocus(Win);
  14216.           Exit;
  14217.      End;
  14218.  
  14219.      If AOwner.FTopMDIChild <> Nil Then
  14220.      Begin
  14221.           TopChild := AOwner.FTopMDIChild;
  14222.           SendMessage(TopChild.Frame.Handle,WM_NCACTIVATE,0,0);
  14223.           TopChild.Deactivate;
  14224.  
  14225.           AOwner.MDIDeactivate(TopChild);
  14226.      End;
  14227.  
  14228.      SendMessage(Win,WM_NCACTIVATE,1,0);
  14229.      WinUser.SetFocus(Win);
  14230.      TopChild := TForm(HandleToControl(Win));  {Frame}
  14231.      If TControl(TopChild) Is TFrameControl
  14232.      Then TopChild := TFrameControl(TopChild).FChild;
  14233.      AOwner.FTopMDIChild := TopChild;
  14234.  
  14235.      FChild.Activate;
  14236.  
  14237.      AOwner.MDIActivate(TopChild);
  14238.  
  14239.      Msg.Handled:=True;
  14240.      Msg.Result:=0;
  14241. End;
  14242. {$ENDIF}
  14243.  
  14244.  
  14245. {$IFDEF Win32}
  14246. Procedure TFrameControl.WMInitMenuPopup(Var Msg:TMessage);
  14247. Var  Win:LongWord;
  14248.      Menu:TMenu;
  14249.      entry:TMenuItem;
  14250. Begin
  14251.      If Application<>Nil Then Application.DestroyHintWindow;
  14252.  
  14253.      If Not (FChild Is TForm) Then Exit;
  14254.  
  14255.      Win := Msg.Param1;
  14256.      entry := TMenuItem(GetMenuHandleItem(FChild,Win));
  14257.  
  14258.      If entry Is TMenuItem Then Menu := entry.FMenu
  14259.      Else
  14260.      Begin
  14261.           Menu:=TMenu(entry);
  14262.           If Not (Menu Is TMenu) Then Menu := Nil;
  14263.           entry := Nil;
  14264.      End;
  14265.      FChild.FLastMenu := Menu;
  14266.      FChild.FLastEntry := entry;
  14267.  
  14268.      FChild.MenuInit(Menu,entry);
  14269. End;
  14270.  
  14271.  
  14272. Procedure TFrameControl.WMMenuSelect(Var Msg:TMessage);
  14273. Var  Win:LongWord;
  14274.      Menu:TMenu;
  14275.      entry:TMenuItem;
  14276.      AParent:TMenuItem;
  14277.      Flags:Word;
  14278.      Id:Word;
  14279. Begin
  14280.      If Not (FChild Is TForm) Then Exit;
  14281.  
  14282.      Id := Msg.Param1Lo;
  14283.      Flags := Msg.Param1Hi;
  14284.      Win := Msg.Param2;                          //Parent-Menu-Handle
  14285.      If (Flags = $0FFFF) And (Win = 0) Then
  14286.      Begin
  14287.           FChild.MenuEnd(FChild.FLastMenu,FChild.FLastEntry);
  14288.  
  14289.           Application.Hint := '';
  14290.           Exit;
  14291.      End;
  14292.  
  14293.      entry := TMenuItem(GetMenuHandleItem(FChild,Win));
  14294.      AParent := entry;
  14295.  
  14296.      If entry Is TMenuItem Then
  14297.      Begin
  14298.           Menu := entry.FMenu;
  14299.           If Menu = Nil Then Exit;
  14300.      End
  14301.      Else
  14302.      Begin
  14303.           Menu:=TMenu(entry);
  14304.           If Not (Menu Is TMenu) Then Exit;
  14305.      End;
  14306.      FChild.FLastMenu := Menu;
  14307.  
  14308.      If Flags And MF_POPUP = 0 Then  {Id Is Command}
  14309.      Begin
  14310.           entry := Menu.ItemFromInternalCommand(Id);
  14311.      End
  14312.      Else                            {Id Is Popup-Handle}
  14313.      Begin
  14314.           If AParent Is TMenuItem Then entry := TMenuItem(AParent.Items[Id])
  14315.           Else Exit;
  14316.      End;
  14317.      FChild.FLastEntry := entry;
  14318.  
  14319.      FChild.MenuItemFocus(Menu,entry);
  14320.  
  14321.      If entry <> Nil Then Application.Hint := GetLongHint(entry.Hint)
  14322.      Else Application.Hint := '';
  14323. End;
  14324.  
  14325.  
  14326. Procedure TFrameControl.WMMenuChar(Var Msg:TMessage);
  14327. Var  Win:LongWord;
  14328.      CH:Char;
  14329.      REP:Byte;
  14330.      Menu:TMenu;
  14331.      entry:TMenuItem;
  14332. Begin
  14333.      If Not (FChild Is TForm) Then Exit;
  14334.  
  14335.      Win := Msg.Param2;
  14336.      CH := Chr(Lo(Msg.Param1));
  14337.      REP := 1;
  14338.      entry := TMenuItem(GetMenuHandleItem(FChild,Win));
  14339.  
  14340.      If entry Is TMenuItem Then Menu := entry.FMenu
  14341.      Else
  14342.      Begin
  14343.           Menu:=TMenu(entry);
  14344.           If Not (Menu Is TMenu) Then Exit;
  14345.      End;
  14346.      entry := Menu.GetSelectedMenuItem;
  14347.  
  14348.      FChild.MenuCharEvent(Menu,entry,CH,REP);
  14349.  
  14350.      If CH = #0 Then
  14351.      Begin
  14352.           Msg.Handled := True;
  14353.           Msg.Result := 0;
  14354.      End;
  14355. End;
  14356. {$ENDIF}
  14357.  
  14358.  
  14359. {$IFDEF OS2}
  14360. {wird nicht aufgerufen}
  14361. Procedure TFrameControl.WMCalcFrameRect(Var Msg:TMessage);
  14362. Var aMsg:TCalcFRectMessage Absolute Msg;
  14363.     List:TList;
  14364.     T:LongInt;
  14365.     Toolbar:TToolbar;
  14366. Begin
  14367.      DefaultHandler(Msg);  {Do Default Action}
  14368.  
  14369.      If aMsg.Result Then
  14370.        If aMsg.Frame<>0 Then
  14371.      Begin
  14372.           List:=FChild.FToolBarLists[tbBottom];
  14373.           If List<>Nil Then For T:=0 To List.Count-1 Do
  14374.           Begin
  14375.                Toolbar:=TToolbar(List[T]);
  14376.                If Toolbar.FVisible Then Inc(aMsg.Rect^.yBottom,Toolbar.Size);
  14377.           End;
  14378.  
  14379.           List:=FChild.FToolBarLists[tbTop];
  14380.           If List<>Nil Then For T:=0 To List.Count-1 Do
  14381.           Begin
  14382.                Toolbar:=TToolbar(List[T]);
  14383.                If Toolbar.FVisible Then Dec(aMsg.Rect^.yTop,Toolbar.Size);
  14384.           End;
  14385.  
  14386.           List:=FChild.FToolBarLists[tbLeft];
  14387.           If List<>Nil Then For T:=0 To List.Count-1 Do
  14388.           Begin
  14389.                Toolbar:=TToolbar(List[T]);
  14390.                If Toolbar.FVisible Then Inc(aMsg.Rect^.XLeft,Toolbar.Size);
  14391.           End;
  14392.  
  14393.           List:=FChild.FToolBarLists[tbRight];
  14394.           If List<>Nil Then For T:=0 To List.Count-1 Do
  14395.           Begin
  14396.                Toolbar:=TToolbar(List[T]);
  14397.                If Toolbar.FVisible Then Dec(aMsg.Rect^.xRight,Toolbar.Size);
  14398.           End;
  14399.      End;
  14400. End;
  14401.  
  14402.  
  14403. Procedure TFrameControl.WMFormatFrame(Var Msg:TMessage);
  14404. Var aMsg:TFmtFrameMessage Absolute Msg;
  14405.     ClientIndex:Word;
  14406.     T:Word;
  14407.     TempSWP:SWP;
  14408.     t1:TToolbarAlign;
  14409.     ClientWin:HWND;
  14410.     List:TList;
  14411.     t2:LongInt;
  14412.     Toolbar:TToolbar;
  14413.     MaxLeft,MaxRight,MaxBottom,MaxTop:LongInt;
  14414. Begin
  14415.      DefaultHandler(Msg);  {Do Default Action}
  14416.  
  14417.      ClientIndex := 65535;
  14418.      // Locate SWP For client Window
  14419.      If FChild = Nil Then Exit;
  14420.      ClientWin := FChild.Handle;
  14421.      For T := 0 To aMsg.Count Do
  14422.      Begin
  14423.           If aMsg.structure^[T].HWND=ClientWin Then
  14424.           Begin
  14425.                ClientIndex:=T;
  14426.                break;
  14427.           End;
  14428.      End;
  14429.      If ClientIndex=65535 Then Exit;  {something Is wrong here}
  14430.  
  14431.      MaxLeft:=0;
  14432.      List:=FChild.FToolBarLists[tbLeft];
  14433.      If List<>Nil Then For T:=0 To List.Count-1 Do
  14434.      Begin
  14435.           Toolbar:=TToolbar(List[T]);
  14436.           If Toolbar.FVisible Then Inc(MaxLeft,Toolbar.Size);
  14437.      End;
  14438.  
  14439.      MaxRight:=0;
  14440.      List:=FChild.FToolBarLists[tbRight];
  14441.      If List<>Nil Then For T:=0 To List.Count-1 Do
  14442.      Begin
  14443.           Toolbar:=TToolbar(List[T]);
  14444.           If Toolbar.FVisible Then Inc(MaxRight,Toolbar.Size);
  14445.      End;
  14446.  
  14447.      MaxBottom:=0;
  14448.      List:=FChild.FToolBarLists[tbBottom];
  14449.      If List<>Nil Then For T:=0 To List.Count-1 Do
  14450.      Begin
  14451.           Toolbar:=TToolbar(List[T]);
  14452.           If Toolbar.FVisible Then Inc(MaxBottom,Toolbar.Size);
  14453.      End;
  14454.  
  14455.      MaxTop:=0;
  14456.      List:=FChild.FToolBarLists[tbTop];
  14457.      If List<>Nil Then For T:=0 To List.Count-1 Do
  14458.      Begin
  14459.           Toolbar:=TToolbar(List[T]);
  14460.           If Toolbar.FVisible Then Inc(MaxTop,Toolbar.Size);
  14461.      End;
  14462.  
  14463.      {Set up TopToolBar SWP}
  14464.      //zuerst Top und Bottom !
  14465.      For t1 := High(TToolbarAlign) Downto Low(TToolbarAlign) Do
  14466.      Begin
  14467.           List:=FChild.FToolBarLists[t1];
  14468.  
  14469.           If List<>Nil Then For t2:=0 To List.Count-1 Do
  14470.           Begin
  14471.                Toolbar:=TToolbar(List[t2]);
  14472.                If Toolbar.FVisible Then
  14473.                Begin
  14474.                     aMsg.structure^[aMsg.Count]:=aMsg.structure^[ClientIndex];
  14475.                     If t1 In [tbTop,tbBottom] Then aMsg.structure^[aMsg.Count].CY:=Toolbar.Size
  14476.                     Else aMsg.structure^[aMsg.Count].CX:=Toolbar.Size;
  14477.  
  14478.                     Case t1 Of
  14479.                         tbTop:
  14480.                         Begin
  14481.                              aMsg.structure^[aMsg.Count].Y:=aMsg.structure^[ClientIndex].Y+
  14482.                                                         (aMsg.structure^[ClientIndex].CY-Toolbar.SiZe);
  14483.                         End;
  14484.                         tbBottom:;
  14485.                         tbLeft:;
  14486.                         tbRight:
  14487.                         Begin
  14488.                              aMsg.structure^[aMsg.Count].X:=aMsg.structure^[ClientIndex].X+
  14489.                                                            (aMsg.structure^[ClientIndex].CX-Toolbar.Size);
  14490.                         End;
  14491.                     End; {Case}
  14492.  
  14493.                     aMsg.structure^[aMsg.Count].HWND:=Toolbar.Handle;
  14494.  
  14495.                     WinSendMsg(aMsg.structure^[aMsg.Count].HWND,
  14496.                                WM_ADJUSTWINDOWPOS,
  14497.                                LongWord(@aMsg.structure^[aMsg.Count]),
  14498.                                0);
  14499.  
  14500.                     Inc(aMsg.Count);
  14501.  
  14502.                     {Actualize client SWP}
  14503.                     Case t1 Of
  14504.                         tbTop:Dec(aMsg.structure^[ClientIndex].CY,Toolbar.Size);
  14505.                         tbLeft:
  14506.                         Begin
  14507.                              Dec(aMsg.structure^[ClientIndex].CX,Toolbar.Size);
  14508.                              Inc(aMsg.structure^[ClientIndex].X,Toolbar.Size);
  14509.                         End;
  14510.                         tbRight:Dec(aMsg.structure^[ClientIndex].CX,Toolbar.Size);
  14511.                         tbBottom:
  14512.                         Begin
  14513.                              Dec(aMsg.structure^[ClientIndex].CY,Toolbar.Size);
  14514.                              Inc(aMsg.structure^[ClientIndex].Y,Toolbar.Size);
  14515.                         End;
  14516.                     End; {Case}
  14517.                End; //If Visible
  14518.           End; //For
  14519.      End; {For}
  14520.  
  14521.      {Copy client To End Of List - For Speed}
  14522.      If aMsg.Count>0 Then
  14523.      Begin
  14524.           TempSWP:=aMsg.structure^[aMsg.Count-1];
  14525.           aMsg.structure^[aMsg.Count-1]:=aMsg.structure^[ClientIndex];
  14526.           aMsg.structure^[ClientIndex]:=TempSWP;
  14527.           ClientIndex:=aMsg.Count-1;
  14528.      End;
  14529.  
  14530.      {Set up client RECTL}
  14531.      If aMsg.Rect<>Nil Then
  14532.      Begin
  14533.           Dec(aMsg.Rect^.yTop,(aMsg.Rect^.yTop-aMsg.Rect^.yBottom)-
  14534.                                aMsg.structure^[ClientIndex].CY);
  14535.           Dec(aMsg.Rect^.xRight,(aMsg.Rect^.xRight-aMsg.Rect^.XLeft)-
  14536.                                  aMsg.structure^[ClientIndex].CX);
  14537.      End;
  14538.      Msg.Handled:=True;
  14539. End;
  14540.  
  14541.  
  14542. Procedure TFrameControl.WMQueryFrameCtlCount(Var Msg:TMessage);
  14543. Var T:TToolbarAlign;
  14544.     t1:LongInt;
  14545.     List:TList;
  14546.     Toolbar:TToolbar;
  14547. Begin
  14548.      DefaultHandler(Msg);  {Query Default Control Count In aMsg.Result}
  14549.  
  14550.      For T := Low(TToolbarAlign) To High(TToolbarAlign) Do
  14551.      Begin
  14552.           List:=FChild.FToolBarLists[T];
  14553.           If List<>Nil Then For t1:=0 To List.Count-1 Do
  14554.           Begin
  14555.                Toolbar:=TToolbar(List[t1]);
  14556.                If Toolbar.FVisible Then Inc(Msg.Result);
  14557.           End;
  14558.      End;
  14559. End;
  14560.  
  14561.  
  14562. Procedure TFrameControl.WMQueryTrackInfo(Var Msg:TMessage);
  14563. Var  pInfo:PTRACKINFO;
  14564.      Flags:Word;
  14565.      Bound:TRect;
  14566.      WinRect:TRect;
  14567. Begin
  14568.      If FChild = Nil Then Exit;
  14569.      pInfo := PTRACKINFO(Msg.Param2);
  14570.      Flags := Msg.Param1Lo;
  14571.  
  14572.      If Flags = TF_MOVE Then
  14573.      Begin
  14574.           Msg.Handled := Not FChild.Moveable;
  14575.      End
  14576.      Else
  14577.      If Flags And (TF_BOTTOM Or TF_LEFT) <> 0 Then
  14578.      Begin
  14579.           Msg.Handled := Not (FChild.Moveable And FChild.Sizeable);
  14580.      End
  14581.      Else
  14582.      If Flags And (TF_TOP Or TF_RIGHT) <> 0 Then
  14583.      Begin
  14584.           Msg.Handled := Not FChild.Sizeable;
  14585.      End;
  14586.  
  14587.      If Not Msg.Handled Then
  14588.      Begin
  14589.           Bound.Left := MinInt;
  14590.           Bound.Right := MaxInt;
  14591.           Bound.Bottom := MinInt;
  14592.           Bound.Top := MaxInt;
  14593.  
  14594.           WinRect := GetWindowRect;
  14595.           Inc(WinRect.Right);
  14596.           Inc(WinRect.Top);
  14597.  
  14598.           pInfo^.cxBorder := Screen.SystemMetrics(smCxSizeBorder);
  14599.           pInfo^.cyBorder := Screen.SystemMetrics(smCySizeBorder);
  14600.           pInfo^.cxGrid := 1;
  14601.           pInfo^.cyGrid := 1;
  14602.           pInfo^.cxKeyboard := 6;
  14603.           pInfo^.cyKeyboard := 16;
  14604.           pInfo^.rclTrack := RECTL(WinRect);
  14605.           pInfo^.rclBoundary := RECTL(Bound);
  14606.           pInfo^.ptlMinTrackSize := Point(FChild.FMinTrackWidth,FChild.FMinTrackHeight);
  14607.           pInfo^.ptlMaxTrackSize := Point(FChild.FMaxTrackWidth,FChild.FMaxTrackHeight);
  14608.           pInfo^.fs := Flags Or TF_ALLINBOUNDARY;
  14609.  
  14610.           Msg.Handled := True;
  14611.           Msg.Result := 1;
  14612.      End
  14613.      Else Msg.Result := 0;     {Disable Dragging}
  14614. End;
  14615.  
  14616.  
  14617. Procedure TFrameControl.WMMinMaxFrame(Var Msg:TMessage);
  14618. Var  pswp:^SWP;
  14619.      Flags:LongWord;
  14620. Begin
  14621.      pswp := Pointer(Msg.Param1);
  14622.      If pswp = Nil Then Exit;
  14623.  
  14624.      Flags := pswp^.fl And (SWP_RESTORE Or SWP_MINIMIZE Or SWP_MAXIMIZE);
  14625.      Case Flags Of
  14626.        SWP_RESTORE:
  14627.           If FChild.OnRestore <> Nil Then FChild.OnRestore(FChild);
  14628.        SWP_MINIMIZE:
  14629.           If FChild.OnMinimize <> Nil Then FChild.OnMinimize(FChild);
  14630.        SWP_MAXIMIZE:
  14631.           If FChild.OnMaximize <> Nil Then FChild.OnMaximize(FChild);
  14632.      End;
  14633. End;
  14634. {$ENDIF}
  14635.  
  14636.  
  14637. {$IFDEF Win32}
  14638. Procedure TFrameControl.WMGetMinMaxInfo(Var Msg:TMessage);
  14639. Var  pInfo:PMINMAXINFO;
  14640. Begin
  14641.      pInfo := PMINMAXINFO(Msg.Param2);
  14642.  
  14643.      pInfo^.ptMinTrackSize := Point(FChild.FMinTrackWidth,FChild.FMinTrackHeight);
  14644.      pInfo^.ptMaxTrackSize := Point(FChild.FMaxTrackWidth,FChild.FMaxTrackHeight);
  14645.      {Min/Max
  14646.      pInfo^.ptMaxPosition :=
  14647.      pInfo^.ptMaxSize :=}
  14648.  
  14649.      Msg.Handled := True;
  14650.      Msg.Result := 0;
  14651. End;
  14652.  
  14653.  
  14654. Procedure TFrameControl.WMSysCommand(Var Msg:TMessage); {untested}
  14655. Var  WParam,Flags:LongWord;
  14656. Begin
  14657.      WParam := Msg.Param1 And $FFF0;
  14658.  
  14659.      Flags := WParam;
  14660.      Case Flags Of
  14661.        SC_RESTORE:
  14662.           If FChild.OnRestore <> Nil Then FChild.OnRestore(FChild);
  14663.        SC_MINIMIZE:
  14664.           If FChild.OnMinimize <> Nil Then FChild.OnMinimize(FChild);
  14665.        SC_MAXIMIZE:
  14666.           If FChild.OnMaximize <> Nil Then FChild.OnMaximize(FChild);
  14667.      End;
  14668. End;
  14669. {$ENDIF}
  14670.  
  14671.  
  14672. Procedure TFrameControl.SetupComponent;
  14673. Begin
  14674.      Inherited SetupComponent;
  14675.  
  14676.      Name := 'FrameControl';
  14677.      FResourceModule := 0;
  14678.      FResourceId := 0;
  14679.      FWindowId := FResourceId;
  14680.      FOwnerDraw := False;
  14681.      FParentPenColor := False;
  14682.      FParentColor := False;
  14683.      Font := Screen.DefaultFrameFont;
  14684. End;
  14685.  
  14686.  
  14687. Procedure TFrameControl.SetResourceId(NewId:LongWord);
  14688. Begin
  14689.      If Handle <> 0 Then Exit;
  14690.  
  14691.      FResourceId := NewId;
  14692.      FWindowId := NewId; {!!}
  14693. End;
  14694.  
  14695.  
  14696. Procedure TFrameControl.CreateParams(Var Params:TCreateParams);
  14697. Begin
  14698.      Inherited CreateParams(Params);
  14699.  
  14700.      If FChild Is TForm Then
  14701.      Begin
  14702.           {$IFDEF Win32}
  14703.           If FChild.Parent <> Nil Then Params.Style := Params.Style Or WS_CHILD;
  14704.  
  14705.           If Not FChild.Designed Then
  14706.             If FChild.BorderStyle = bsDialog Then
  14707.               Params.ExStyle := WS_EX_DLGMODALFRAME Or WS_EX_WINDOWEDGE;
  14708.  
  14709.           If not FChild.Designed Then
  14710.             If FChild.FBorderIcons*[biHelp]<>[] Then
  14711.               Params.ExStyle:=Params.ExStyle Or WS_EX_CONTEXTHELP;
  14712.           {$ENDIF}
  14713.           Params.FrameStyle := FChild.GetFrameFlags;
  14714.      End;
  14715. End;
  14716.  
  14717.  
  14718. Procedure TFrameControl.CreateWnd;
  14719. Var Params:TCreateParams;
  14720.     FrameFlags:ULONG;
  14721.     WindowFlags:ULONG;
  14722.     WFlags:ULONG;
  14723.     {$IFDEF Win32}
  14724.     ExtendedFlags:ULONG;
  14725.     {$ENDIF}
  14726.     cCaption:Cstring;
  14727.     ParentWin,OwnerWin:HWND;
  14728.     ClassData:TClassData;
  14729.     rc:TRect;
  14730.     ShellPos:Boolean;
  14731.     {$IFDEF OS2}
  14732.     fcd:FRAMECDATA;
  14733.     {$ENDIF}
  14734.     {$IFDEF Win32}
  14735.     rc1:TRect;
  14736.     OldWndProc:Pointer;
  14737.     {$ENDIF}
  14738. Begin
  14739.      If Handle<>0 Then Exit;
  14740.  
  14741.      RegisterClass;
  14742.      GetClassData(ClassData);
  14743.  
  14744.      If FCaption=Nil Then cCaption:=''
  14745.      Else cCaption:=FCaption^;
  14746.  
  14747.      If ((FForm<>Nil)And(Not FForm.Designed)) Then
  14748.      Begin
  14749.           ShellPos := FForm.Position In [poDefault,poDefaultPosOnly,poDefaultSizeOnly];
  14750.  
  14751.           If (FForm.FormStyle = fsMDIChild) And (FForm.Position = poDefault)
  14752.           Then ShellPos := False;
  14753.  
  14754.           If FForm.Position=poScreenCenter Then
  14755.           Begin
  14756.                FLeft:=(Screen.Width-FWidth) Div 2;
  14757.                If FLeft<0 Then FLeft:=0;
  14758.                FBottom:=(Screen.Height-FHeight) Div 2;
  14759.                If FBottom<0 Then FBottom:=0;
  14760.                FForm.FLeft:=FLeft;
  14761.                FForm.FBottom:=FBottom;
  14762.           End;
  14763.      End
  14764.      Else ShellPos:=False;
  14765.  
  14766.      If (FWidth=0) Or (FHeight=0) Then
  14767.      Begin
  14768.           If (Parent<>Nil) And (Parent.Handle<>0) Then
  14769.           Begin
  14770.                rc:=Parent.GetClientRect;
  14771.                FWidth:=rc.Right-rc.Left+1;
  14772.                FHeight:=rc.Top-rc.Bottom+1;
  14773.                FLeft:=rc.Left;
  14774.                {$IFDEF OS2}
  14775.                FBottom:=rc.Bottom;
  14776.                {$ENDIF}
  14777.                {$IFDEF Win32}
  14778.                WinUser.GetClientRect(Parent.Handle,RECTL(rc1));
  14779.                FBottom:=((rc1.Bottom-rc1.Top)-FHeight)-rc.Bottom;
  14780.                {$ENDIF}
  14781.           End
  14782.           Else
  14783.           Begin
  14784.                ShellPos := True;
  14785.                FLeft:=0;
  14786.                FBottom:=0;
  14787.                FWidth:=0;
  14788.                FHeight:=0;
  14789.           End;
  14790.      End
  14791.      Else
  14792.      Begin
  14793.           {$IFDEF Win32}
  14794.           If Parent<>Nil Then FBottom:=Parent.FHeight-FBottom-FHeight
  14795.           Else FBottom:=Screen.Height-FBottom-FHeight;
  14796.           {$ENDIF}
  14797.      End;
  14798.  
  14799.      If Parent<>Nil Then
  14800.      Begin
  14801.           If Parent.Handle=0 Then ParentWin:=HWND_DESKTOP
  14802.           Else ParentWin:=Parent.Handle;
  14803.      End
  14804.      Else ParentWin:=HWND_DESKTOP;
  14805.  
  14806.      If FModalParent<>Nil Then OwnerWin:=FModalParent.Handle
  14807.      Else OwnerWin:=ParentWin;
  14808.  
  14809.      CreateParams(Params);
  14810.  
  14811.      WindowFlags := Params.Style;
  14812.      FrameFlags := Params.FrameStyle;
  14813.  
  14814.      {Create Frame Window}
  14815.      {$IFDEF OS2}
  14816.      If ShellPos Then FrameFlags := FrameFlags Or FCF_SHELLPOSITION;
  14817.  
  14818.      fcd.cb:=SizeOf(FRAMECDATA);
  14819.      fcd.flCreateFlags:=FrameFlags;
  14820.      fcd.hModResources:=FResourceModule;
  14821.      fcd.idResources:=FResourceId;
  14822.  
  14823.      FHandle:=WinCreateWCWindow(ParentWin,       //Parent
  14824.                                 WC_FRAME,
  14825.                                 cCaption,
  14826.                                 WindowFlags,     //flStyle
  14827.                                 0,0,             //leave This ON 0 - Set by .Show
  14828.                                 0,0,             //Position And Size
  14829.                                 ParentWin,       //Owner
  14830.                                 {OwnerWin,       //Owner erst unten setzen !}
  14831.                                 HWND_TOP,        //Insert behind
  14832.                                 FResourceId,     //Window Id
  14833.                                 @fcd,            //CtlData
  14834.                                 Nil);            //Presparams
  14835.  
  14836.      WinSetOwner(FHandle,OwnerWin);
  14837.      {$ENDIF}
  14838.  
  14839.      {$IFDEF Win32}
  14840.      If ClassData.ClassStyle * [wcsClipChildren] <> [] Then
  14841.        If Not Designed Then FrameFlags := FrameFlags Or WS_CLIPCHILDREN;
  14842.  
  14843.      If ClassData.ClassStyle * [wcsClipSiblings] <> []
  14844.      Then FrameFlags := FrameFlags Or WS_CLIPSIBLINGS;
  14845.  
  14846.      If ShellPos Then
  14847.      Begin
  14848.           If ((FForm<>Nil)And(Not FForm.Designed)) Then
  14849.           Begin
  14850.               If FForm.Position<>poDefaultSizeOnly Then
  14851.               Begin
  14852.                    FLeft := CW_USEDEFAULT;
  14853.                    FBottom := CW_USEDEFAULT;
  14854.               End;
  14855.               If FForm.Position<>poDefaultPosOnly Then
  14856.               Begin
  14857.                    FWidth := CW_USEDEFAULT;
  14858.                    FHeight := CW_USEDEFAULT;
  14859.               End;
  14860.           End
  14861.           Else
  14862.           Begin
  14863.               FLeft := CW_USEDEFAULT;
  14864.               FBottom := CW_USEDEFAULT;
  14865.               FWidth := CW_USEDEFAULT;
  14866.               FHeight := CW_USEDEFAULT;
  14867.           End;
  14868.      End;
  14869.  
  14870.      WindowFlags := WindowFlags Or FrameFlags;
  14871.      ExtendedFlags := Params.ExStyle;
  14872.  
  14873.      If ExtendedFlags=0
  14874.      Then FHandle:=CreateWindow(ClassData.ClassName,
  14875.                                 cCaption,
  14876.                                 WindowFlags,
  14877.                                 FLeft,FBottom,
  14878.                                 FWidth,FHeight,
  14879.                                 OwnerWin,
  14880.                                 FResourceId,
  14881.                                 DllModule,
  14882.                                 Nil)
  14883.      Else FHandle:=CreateWindowEx(ExtendedFlags,
  14884.                                   ClassData.ClassName,
  14885.                                   cCaption,
  14886.                                   WindowFlags,
  14887.                                   FLeft,FBottom,
  14888.                                   FWidth,FHeight,
  14889.                                   OwnerWin,
  14890.                                   FResourceId,
  14891.                                   DllModule,
  14892.                                   Nil);
  14893.      {$ENDIF}
  14894.  
  14895.      If FHandle=0 Then CreateError;
  14896.  
  14897.      {$IFDEF Win32}
  14898.      rc:=GetWindowRect;
  14899.      FLeft:=rc.Left;
  14900.      FBottom:=rc.Bottom;
  14901.      FWidth:=rc.Right-rc.Left +1;
  14902.      FHeight:=rc.Top-rc.Bottom +1;
  14903.      {$ENDIF}
  14904.  
  14905.      {$IFDEF OS2}
  14906.      If FForm<>Nil Then If Not FForm.Designed Then
  14907.        If FForm.Position In [poDefault,poDefaultPosOnly,poDefaultSizeOnly] Then
  14908.      Begin
  14909.           If FForm.Position In [poDefaultPosOnly,poDefaultSizeOnly] Then
  14910.           Begin
  14911.               WFlags:=SWP_ZORDER Or SWP_SHOW Or SWP_NOREDRAW;
  14912.               WinSetWindowPos(FHandle,HWND_TOP,0,0,0,0,WFlags);
  14913.           End;
  14914.  
  14915.           rc:=GetWindowRect;
  14916.           If FForm.Position In [poDefault,poDefaultPosOnly] Then
  14917.           Begin
  14918.                FLeft:=rc.Left;
  14919.                FBottom:=rc.Bottom;
  14920.                FForm.FLeft:=FLeft;
  14921.                FForm.FBottom:=FBottom;
  14922.           End;
  14923.  
  14924.           If FForm.Position In [poDefault,poDefaultSizeOnly] Then
  14925.           Begin
  14926.                FWidth:=rc.Right-rc.Left;
  14927.                FHeight:=rc.Top-rc.Bottom;
  14928.                FForm.FWidth:=FWidth;
  14929.                FForm.FHeight:=FHeight;
  14930.           End;
  14931.  
  14932.           If FForm.Position In [poDefaultPosOnly,poDefaultSizeOnly] Then
  14933.           Begin
  14934.               WinSetWindowPos(FHandle,HWND_TOP,FLeft,FBottom,FWidth,FHeight,SWP_SIZE Or SWP_MOVE Or
  14935.                               SWP_ZORDER Or SWP_HIDE);
  14936.           End;
  14937.      End;
  14938.      {$ENDIF}
  14939.  
  14940.      {FCanvas := CreateCanvas;}
  14941.  
  14942.      {$IFDEF OS2}
  14943.      WinSetWindowULong(Handle,QWL_USER,LongWord(Self));    {VMT Pointer}
  14944.      FDefWndProc:=Pointer(WinSubClassWindow(Handle,@SubclassedWndProc));
  14945.      {$ENDIF}
  14946.      {$IFDEF Win32}
  14947.      SetWindowLong(Handle,GWL_USERDATA,LongWord(Self));    {VMT Pointer}
  14948.      OldWndProc:=Pointer(SetWindowLong(Handle,GWL_WNDPROC,LongInt(@SubclassedWndProc)));
  14949.      If @FDefWndProc = Nil Then FDefWndProc := OldWndProc;    {WinNt !!!}
  14950.      {$ENDIF}
  14951.  
  14952.      FFirstShow := True;
  14953.  
  14954.      If (Not FEnabled) And (Not FForm.Designed) Then Disable;
  14955.      If (Not FVisible) And (Not FForm.Designed) Then Hide;
  14956.  
  14957.      If FFont = Nil Then FFont := StandardFont(Self);
  14958.      UpdateFont;
  14959.  
  14960.      SetupShow;
  14961.      If OnSetupShow<>Nil Then OnSetupShow(Self);
  14962. End;
  14963.  
  14964.  
  14965. Procedure TFrameControl.GetClassData(Var ClassData:TClassData);
  14966. Begin
  14967.      ClassData.StandardClass:=False;
  14968.      ClassData.ClassName:='Speed-Pascal Window';
  14969.      ClassData.WindowProc:=@StartWndProc;
  14970.      {!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
  14971.      ClassData.ClassStyle:=[wcsSizeRedraw,{wcsClipChildren,}wcsClipSiblings{,wcsSaveBits}];
  14972.      ClassData.DataCount:=4;
  14973.      ClassData.ClassULong:=0;
  14974. End;
  14975.  
  14976.  
  14977. Function TFrameControl.GetClientRect:TRect;
  14978. Var MaxLeft,MaxBottom,MaxRight,MaxTop:LongInt;
  14979.     List:TList;
  14980.     T:LongInt;
  14981.     Toolbar:TToolbar;
  14982. Begin
  14983.      Result := Inherited GetClientRect;
  14984.  
  14985.      If FChild=Nil Then Exit;
  14986.  
  14987.      MaxLeft:=0;
  14988.      List:=FChild.FToolBarLists[tbLeft];
  14989.      If List<>Nil Then For T:=0 To List.Count-1 Do
  14990.      Begin
  14991.           Toolbar:=TToolbar(List[T]);
  14992.           If Toolbar.FVisible Then Inc(MaxLeft,Toolbar.Size);
  14993.      End;
  14994.  
  14995.      MaxRight:=0;
  14996.      List:=FChild.FToolBarLists[tbRight];
  14997.      If List<>Nil Then For T:=0 To List.Count-1 Do
  14998.      Begin
  14999.           Toolbar:=TToolbar(List[T]);
  15000.           If Toolbar.FVisible Then Inc(MaxRight,Toolbar.Size);
  15001.      End;
  15002.  
  15003.      MaxBottom:=0;
  15004.      List:=FChild.FToolBarLists[tbBottom];
  15005.      If List<>Nil Then For T:=0 To List.Count-1 Do
  15006.      Begin
  15007.           Toolbar:=TToolbar(List[T]);
  15008.           If Toolbar.FVisible Then Inc(MaxBottom,Toolbar.Size);
  15009.      End;
  15010.  
  15011.      MaxTop:=0;
  15012.      List:=FChild.FToolBarLists[tbTop];
  15013.      If List<>Nil Then For T:=0 To List.Count-1 Do
  15014.      Begin
  15015.           Toolbar:=TToolbar(List[T]);
  15016.           If Toolbar.FVisible Then Inc(MaxTop,Toolbar.Size);
  15017.      End;
  15018.  
  15019.      Inc(Result.Left,MaxLeft);
  15020.      Inc(Result.Bottom,MaxBottom);
  15021.      Dec(Result.Right,MaxRight);
  15022.      Dec(Result.Top,MaxTop);
  15023. End;
  15024.  
  15025.  
  15026. Destructor TFrameControl.Destroy;
  15027. Begin
  15028.      Inherited Destroy;
  15029.  
  15030.      If FChild <> Nil Then
  15031.      Begin
  15032.           FChild.FFrame := Nil;
  15033.           FChild.Destroy;
  15034.      End;
  15035.      FChild := Nil;
  15036. End;
  15037.  
  15038. {
  15039. ╔═══════════════════════════════════════════════════════════════════════════╗
  15040. ║                                                                           ║
  15041. ║ Speed-Pascal/2 Version 2.0                                                ║
  15042. ║                                                                           ║
  15043. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  15044. ║                                                                           ║
  15045. ║ This section: TSizeBorder Class Implementation                            ║
  15046. ║                                                                           ║
  15047. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  15048. ║                                                                           ║
  15049. ╚═══════════════════════════════════════════════════════════════════════════╝
  15050. }
  15051.  
  15052. Procedure TSizeBorder.SetupComponent;
  15053. Begin
  15054.      Inherited SetupComponent;
  15055.  
  15056.      FZOrder := zoTop;
  15057.      ParentColor := True;
  15058.      FOwnerDraw:=True;
  15059.      FTabStop := False;
  15060.      FCursorTabStop := False;
  15061.      BorderAlign := baHorizontal;
  15062.      FSizing := False;
  15063.      Name:='SizeBorder';
  15064.      FWidth:=100;
  15065.      FHeight:=5;
  15066.      YStretch:=ysFixed;
  15067. End;
  15068.  
  15069.  
  15070. Procedure TSizeBorder.SetBorderAlign(Value:TSizeBorderAlign);
  15071. Var OldValue:TSizeBorderAlign;
  15072. Begin
  15073.      If Value = FBorderAlign Then Exit;
  15074.  
  15075.      OldValue:=FBorderAlign;
  15076.      FBorderAlign := Value;
  15077.      Case FBorderAlign Of
  15078.        baHorizontal:
  15079.        Begin
  15080.             If OldValue In [baVertical,baParentHeight,baLeft,baRight] Then
  15081.               FWidth:=FHeight;
  15082.             FHeight := 5;
  15083.             Align:=alNone;
  15084.             YStretch:=ysFixed;
  15085.             Visible:=True;
  15086.        End;
  15087.        baVertical:
  15088.        Begin
  15089.             If OldValue In [baHorizontal,baParentWidth,baBottom,baTop] Then
  15090.               FHeight:=FWidth;
  15091.             FWidth := 5;
  15092.             Align:=alNone;
  15093.             XStretch:=xsFixed;
  15094.             Visible:=True;
  15095.        End;
  15096.        baParentWidth:
  15097.        Begin
  15098.             FWidth := 0;
  15099.             FHeight := 5;
  15100.             FLeft:=0;
  15101.             Align:=alNone;
  15102.             XAlign:=xaLeft;
  15103.             XStretch:=xsParent;
  15104.             YStretch:=ysFixed;
  15105.             Visible:=True;
  15106.        End;
  15107.        baParentHeight:
  15108.        Begin
  15109.             FWidth := 5;
  15110.             FHeight := 0;
  15111.             FBottom:=0;
  15112.             Align:=alNone;
  15113.             YAlign:=yaBottom;
  15114.             YStretch:=ysParent;
  15115.             XStretch:=xsFixed;
  15116.             Visible:=True;
  15117.        End;
  15118.        baTop:
  15119.        Begin
  15120.             FWidth := 0;
  15121.             FHeight := 5;
  15122.             FCursor := crVSplit;
  15123.             Align := alTop;
  15124.             YStretch:=ysFixed;
  15125.             Visible := True;
  15126.        End;
  15127.        baBottom:
  15128.        Begin
  15129.             FWidth := 0;
  15130.             FHeight := 5;
  15131.             FCursor := crVSplit;
  15132.             Align := alBottom;
  15133.             YStretch:=ysFixed;
  15134.             Visible := True;
  15135.        End;
  15136.        baLeft:
  15137.        Begin
  15138.             FWidth := 5;
  15139.             FHeight := 0;
  15140.             FCursor := crHSplit;
  15141.             Align := alLeft;
  15142.             XStretch:=xsFixed;
  15143.             Visible := True;
  15144.        End;
  15145.        baRight:
  15146.        Begin
  15147.             FWidth := 5;
  15148.             FHeight := 0;
  15149.             FCursor := crHSplit;
  15150.             Align := alRight;
  15151.             XStretch:=xsFixed;
  15152.             Visible := True;
  15153.        End;
  15154.      End;
  15155. End;
  15156.  
  15157. {$HINTS OFF}
  15158. Procedure TSizeBorder.Redraw(Const rec:TRect);
  15159. Var  rc1:TRect;
  15160. Begin
  15161.      rc1 := ClientRect;
  15162.      Canvas.ShadowedBorder(rc1,clWhite,clBlack);
  15163.      InflateRect(rc1,-1,-1);
  15164.      Canvas.ShadowedBorder(rc1,clLtGray,clDkGray);
  15165.      InflateRect(rc1,-1,-1);
  15166.      Canvas.Pen.color := color;
  15167.      Canvas.Line(rc1.Left,rc1.Bottom,rc1.Right,rc1.Top);
  15168. End;
  15169. {$HINTS ON}
  15170.  
  15171.  
  15172. Procedure TSizeBorder.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
  15173. Begin
  15174.      Inherited MouseDown(Button,ShiftState,X,Y);
  15175.  
  15176.      If Parent = Nil Then Exit;
  15177.  
  15178.      Case FBorderAlign Of
  15179.        baLeft,baRight: FOffs := X;
  15180.        baBottom,baTop: FOffs := Y;
  15181.        Else Exit;
  15182.      End;
  15183.      FDelta := 0;
  15184.  
  15185.      OldFgMode := Screen.Canvas.Pen.Mode;
  15186.      OldLineWidth := Screen.Canvas.Pen.Width;
  15187.      OldLineType := Screen.Canvas.Pen.Style;
  15188.  
  15189.      Screen.Canvas.Pen.Mode := pmNot;
  15190.      Screen.Canvas.Pen.Width := 5;
  15191.      Screen.Canvas.Pen.Style := psSolid;
  15192.  
  15193.      DrawSizeLine;
  15194.      MouseCapture := True;
  15195.      FSizing := True;
  15196. End;
  15197.  
  15198. Procedure TSizeBorder.MouseMove(ShiftState:TShiftState;X,Y:LongInt);
  15199. Begin
  15200.      Inherited MouseMove(ShiftState,X,Y);
  15201.  
  15202.      If FSizing Then
  15203.      Begin
  15204.           DrawSizeLine;
  15205.           Case FBorderAlign Of
  15206.             baLeft,baRight: FDelta := X - FOffs;
  15207.             baBottom,baTop: FDelta := Y - FOffs;
  15208.             Else Exit;
  15209.           End;
  15210.           If FOnSizing <> Nil Then FOnSizing(Self,FDelta);
  15211.           DrawSizeLine;
  15212.      End;
  15213. End;
  15214.  
  15215. Procedure TSizeBorder.MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
  15216. Begin
  15217.      Inherited MouseUp(Button,ShiftState,X,Y);
  15218.  
  15219.      If FSizing Then
  15220.      Begin
  15221.           DrawSizeLine;
  15222.           MouseCapture := False;
  15223.           FSizing := False;
  15224.  
  15225.           Screen.Canvas.Pen.Mode := OldFgMode;
  15226.           Screen.Canvas.Pen.Width := OldLineWidth;
  15227.           Screen.Canvas.Pen.Style := OldLineType;
  15228.  
  15229.           Case FBorderAlign Of
  15230.             baLeft,baRight: FDelta := X - FOffs;
  15231.             baBottom,baTop: FDelta := Y - FOffs;
  15232.             Else Exit;
  15233.           End;
  15234.           If FOnSized <> Nil Then FOnSized(Self,FDelta);
  15235.      End;
  15236. End;
  15237.  
  15238. Procedure TSizeBorder.DrawSizeLine;
  15239. Var  pt:TPoint;
  15240. Begin
  15241.      Case FBorderAlign Of
  15242.        baLeft,baRight:
  15243.        Begin
  15244.             pt.X := FDelta + 2;
  15245.             pt.Y := 0;
  15246.             pt := ClientToScreen(pt);
  15247.             Screen.Canvas.Line(pt.X,pt.Y,pt.X,pt.Y+Height);
  15248.        End;
  15249.        baBottom,baTop:
  15250.        Begin
  15251.             pt.X := 0;
  15252.             pt.Y := FDelta + 2;
  15253.             pt := ClientToScreen(pt);
  15254.             Screen.Canvas.Line(pt.X,pt.Y,pt.X+Width,pt.Y);
  15255.        End;
  15256.      End;
  15257. End;
  15258.  
  15259.  
  15260. {
  15261. ╔═══════════════════════════════════════════════════════════════════════════╗
  15262. ║                                                                           ║
  15263. ║ Speed-Pascal/2 Version 2.0                                                ║
  15264. ║                                                                           ║
  15265. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  15266. ║                                                                           ║
  15267. ║ This section: TToolbar Class Implementation                               ║
  15268. ║                                                                           ║
  15269. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  15270. ║                                                                           ║
  15271. ╚═══════════════════════════════════════════════════════════════════════════╝
  15272. }
  15273.  
  15274.  
  15275. Procedure TToolbar.Hide;
  15276. Begin
  15277.      Inherited Hide;
  15278.      If (Owner Is TForm) Then TForm(Owner).AlignToolBars;
  15279. End;
  15280.  
  15281.  
  15282. Procedure TToolbar.Show;
  15283. Begin
  15284.      If Not FVisible Then
  15285.      Begin
  15286.          Inherited Show;
  15287.          If (Owner Is TForm) Then TForm(Owner).AlignToolBars;
  15288.      End
  15289.      Else Inherited Show;
  15290. End;
  15291.  
  15292. Procedure TToolbar.EnableCommands(Cmds:Array Of TCommand);
  15293. Var  T,t1:LongInt;
  15294.      Control:TControl;
  15295. Begin
  15296.      For T:=0 To ControlCount-1 Do
  15297.      Begin
  15298.           Control:=Controls[T];
  15299.           If Control.FCommand<>0 Then
  15300.           Begin
  15301.                For t1:=Low(Cmds) To High(Cmds) Do
  15302.                  If Control.FCommand=Cmds[t1] Then
  15303.                  Begin
  15304.                       Control.Enabled:=True;
  15305.                       break;
  15306.                  End;
  15307.           End;
  15308.      End;
  15309. End;
  15310.  
  15311. Procedure TToolbar.DisableCommands(Cmds:Array Of TCommand);
  15312. Var  T,t1:LongInt;
  15313.      Control:TControl;
  15314. Begin
  15315.      For T:=0 To ControlCount-1 Do
  15316.      Begin
  15317.           Control:=Controls[T];
  15318.           If Control.FCommand<>0 Then
  15319.           Begin
  15320.                For t1:=Low(Cmds) To High(Cmds) Do
  15321.                  If Control.FCommand=Cmds[t1] Then
  15322.                  Begin
  15323.                       Control.Enabled:=False;
  15324.                       break;
  15325.                  End;
  15326.           End;
  15327.      End;
  15328. End;
  15329.  
  15330. Procedure TToolbar.SetupComponent;
  15331. Begin
  15332.      Inherited SetupComponent;
  15333.  
  15334.      Name:='ToolBar';
  15335.      FHeight:=50;
  15336.      FWidth:=50;
  15337.      color:=clLtGray;
  15338.      FParentPenColor:=True;
  15339.      ParentColor:=False;
  15340.      CursorTabStop:=False;
  15341.      TabStop:=False;
  15342.      FAlignment:=tbTop;
  15343.      FBevelStyle:=tbRaised;
  15344.      Include(ComponentState, csAcceptsControls);
  15345.      FSizeable:=False;
  15346.      FIsToolBar:=True;
  15347.      FOrder:=-1;
  15348.      SizeBorderCtrl:=Nil;
  15349. End;
  15350.  
  15351.  
  15352. Procedure TToolbar.CreateWnd;
  15353. Begin
  15354.      SetOrder(FOrder);
  15355.  
  15356.      If FParent Is TForm Then FParent := FParent.FFrame;  {Frame}
  15357.      Inherited CreateWnd;
  15358.      FParent := TControl(Owner);         {Form}
  15359. End;
  15360.  
  15361.  
  15362. Procedure TToolbar.SetupShow;
  15363. Var  rc:TRect;
  15364. Begin
  15365.      rc := Parent.GetClientRect;
  15366.      Case FAlignment Of
  15367.          tbTop:
  15368.          Begin
  15369.               FLeft := 0;
  15370.               {$IFDEF OS2}
  15371.               FBottom := rc.Top-FHeight+1;
  15372.               {$ENDIF}
  15373.               {$IFDEF Win32}
  15374.               FBottom := 0;
  15375.               {$ENDIF}
  15376.               FWidth := rc.Right-rc.Left+1;
  15377.          End;
  15378.          tbBottom:
  15379.          Begin
  15380.               FLeft := 0;
  15381.               {$IFDEF OS2}
  15382.               FBottom := 0;
  15383.               {$ENDIF}
  15384.               {$IFDEF Win32}
  15385.               FBottom := rc.Top-rc.Bottom+1;
  15386.               {$ENDIF}
  15387.               FWidth := rc.Right-rc.Left+1;
  15388.          End;
  15389.          tbLeft:
  15390.          Begin
  15391.               FBottom := 0;
  15392.               FLeft := rc.Left-FWidth;
  15393.               FHeight := rc.Top-rc.Bottom+1;
  15394.          End;
  15395.          tbRight:
  15396.          Begin
  15397.               FBottom := 0;
  15398.               FLeft := rc.Right+1;
  15399.               FHeight := rc.Top-rc.Bottom+1;
  15400.          End;
  15401.      End; {Case}
  15402. End;
  15403.  
  15404.  
  15405. Procedure TToolbar.Redraw(Const rec:TRect);
  15406. Var  rc:TRect;
  15407. Begin
  15408.      If FCanvas = Nil Then Exit;
  15409.      FCanvas.FillRect(rec,color);
  15410.  
  15411.      If FBevelStyle <> tbNone Then
  15412.      Begin
  15413.           rc := GetClientRect;
  15414.           If FBevelStyle = tbRaised Then FCanvas.ShadowedBorder(rc,clWhite,clDkGray)
  15415.           Else FCanvas.ShadowedBorder(rc,clDkGray,clWhite);
  15416.      End;
  15417. End;
  15418.  
  15419.  
  15420. Procedure TToolbar.SetSize(NewSize:LongInt);
  15421. Begin
  15422.      If FAlignment In [tbTop,tbBottom] Then Height := NewSize
  15423.      Else Width := NewSize;
  15424. End;
  15425.  
  15426.  
  15427. Function TToolbar.GetSize:LongInt;
  15428. Begin
  15429.      If FAlignment In [tbTop,tbBottom] Then Result := Height
  15430.      Else Result := Width;
  15431. End;
  15432.  
  15433.  
  15434. Procedure TToolbar.SetAlignment(NewAlign:TToolbarAlign);
  15435. Var  Own:TForm;
  15436.      OldSize:LongInt;
  15437.      OldAlign:TToolbarAlign;
  15438. Begin
  15439.      If FAlignment = NewAlign Then Exit;
  15440.  
  15441.      Own := TForm(Owner);
  15442.      If Not (Own Is TForm) Then Exit;
  15443.  
  15444.      OldSize := Size;
  15445.      OldAlign := FAlignment;
  15446.  
  15447.      {++++++++++++++++++++++}
  15448.      ListRemove(Own.FToolBarLists[FAlignment], Self);
  15449.      ListAdd(Own.FToolBarLists[NewAlign], Self);
  15450.      {Move the Toolbar To the End Of the Controls List
  15451.       To guarantee To correct SCU order}
  15452.      If ListFind(Own.FControls, Self) >= 0 Then
  15453.      Begin
  15454.           ListRemove(Own.FControls, Self);
  15455.           ListAdd(Own.FControls, Self);
  15456.      End;
  15457.  
  15458.      FAlignment := NewAlign;
  15459.  
  15460.      {Update the sizeborder}
  15461.      If SizeBorderCtrl <> Nil Then
  15462.      Case FAlignment Of
  15463.        tbLeft: SizeBorderCtrl.BorderAlign := baRight;
  15464.        tbRight: SizeBorderCtrl.BorderAlign := baLeft;
  15465.        tbTop: SizeBorderCtrl.BorderAlign := baBottom;
  15466.        tbBottom:SizeBorderCtrl.BorderAlign := baTop;
  15467.      End;
  15468.  
  15469.      If Handle = 0 Then Exit;
  15470.  
  15471.      SetWindowPos(Left,Bottom,OldSize,OldSize);
  15472. End;
  15473.  
  15474.  
  15475. Procedure TToolbar.SetOrder(Value:LongInt);
  15476. Var  Own:TForm;
  15477.      List:TList;
  15478.      AToolbar:TToolbar;
  15479.      I:LongInt;
  15480. Begin
  15481.      FOrder := Value;
  15482.      If FOrder < 0 Then Exit; {auto Append}
  15483.  
  15484.      Own := TForm(Owner);
  15485.      If Not (Own Is TForm) Then Exit;
  15486.  
  15487.      List := Own.FToolBarLists[FAlignment];
  15488.  
  15489.      If ListFind(List, Self) < 0 Then Exit;  {noch nicht In der Liste}
  15490.      If List.Count = 1 Then Exit;            {nur Self In Liste}
  15491.  
  15492.      ListRemove(List, Self);
  15493.      If FOrder > List.Count Then FOrder := List.Count;
  15494.      ListInsert(List, FOrder, Self);
  15495.  
  15496.      {reorder the Own.Controls List}
  15497.      For I := 0 To List.Count-1 Do
  15498.      Begin
  15499.           AToolbar := TToolbar(List.Items[I]);
  15500.           If ListFind(Own.FControls, AToolbar) >= 0 Then
  15501.           Begin
  15502.                ListRemove(Own.FControls, AToolbar);
  15503.                ListAdd(Own.FControls, AToolbar);
  15504.           End;
  15505.      End;
  15506.  
  15507.      Own.AlignToolBars;
  15508. End;
  15509.  
  15510.  
  15511. Function TToolbar.GetOrder:LongInt;
  15512. Var  Own:TForm;
  15513. Begin
  15514.      Own := TForm(Owner);
  15515.      If Own Is TForm Then
  15516.      Begin
  15517.           Result := ListFind(Own.FToolBarLists[FAlignment], Self);
  15518.      End
  15519.      Else Result := -1;
  15520. End;
  15521.  
  15522.  
  15523. Procedure TToolbar.SetBevelStyle(NewStyle:TToolBarBevel);
  15524. Begin
  15525.      FBevelStyle := NewStyle;
  15526.      If Handle <> 0 Then Invalidate;
  15527. End;
  15528.  
  15529.  
  15530. Function TToolbar.GetLeft:LongInt;
  15531. Var  Own:TForm;
  15532.      List:TList;
  15533.      T:LongInt;
  15534.      Toolbar:TToolbar;
  15535.      MaxLeft,MaxRight:LongInt;
  15536. Label ex;
  15537. Begin
  15538.      Own := TForm(Owner);
  15539.      If Not (Own Is TForm) Then Exit;
  15540.  
  15541.      Case Alignment Of
  15542.         tbLeft:
  15543.         Begin
  15544.              MaxLeft:=0;
  15545.              List:=Own.FToolBarLists[tbLeft];
  15546.              If List<>Nil Then For T:=0 To List.Count-1 Do
  15547.              Begin
  15548.                   Toolbar:=TToolbar(List[T]);
  15549.                   If Toolbar.FVisible Then Inc(MaxLeft,Toolbar.Size);
  15550.              End;
  15551.              Result:=-MaxLeft;
  15552.              If List<>Nil Then For T:=0 To List.Count-1 Do
  15553.              Begin
  15554.                   Toolbar:=TToolbar(List[T]);
  15555.                   If Toolbar=Self Then Goto ex;
  15556.                   If Toolbar.FVisible Then Inc(Result,Toolbar.Size);
  15557.              End;
  15558.         End;
  15559.         tbRight:
  15560.         Begin
  15561.              MaxRight:=0;
  15562.              List:=Own.FToolBarLists[tbRight];
  15563.              If List<>Nil Then For T:=0 To List.Count-1 Do
  15564.              Begin
  15565.                   Toolbar:=TToolbar(List[T]);
  15566.                   If Toolbar.FVisible Then Inc(MaxRight,Toolbar.Size);
  15567.              End;
  15568.              Result:=Own.GetClientWidth+MaxRight;
  15569.              If List<>Nil Then For T:=0 To List.Count-1 Do
  15570.              Begin
  15571.                   Toolbar:=TToolbar(List[T]);
  15572.                   If Toolbar.FVisible Then Dec(Result,Toolbar.Size);
  15573.                   If Toolbar=Self Then Goto ex;
  15574.              End;
  15575.         End;
  15576.         tbBottom,tbTop:
  15577.         Begin
  15578.              Result:=0;
  15579.              List:=Own.FToolBarLists[tbLeft];
  15580.              If List<>Nil Then For T:=0 To List.Count-1 Do
  15581.              Begin
  15582.                   Toolbar:=TToolbar(List[T]);
  15583.                   If Toolbar.FVisible Then Dec(Result,Toolbar.Size);
  15584.              End;
  15585.         End;
  15586.      End;
  15587. ex:
  15588.      FLeft := Result;
  15589. End;
  15590.  
  15591.  
  15592. Function TToolbar.GetBottom:LongInt;
  15593. Var  Own:TForm;
  15594.      List:TList;
  15595.      T:LongInt;
  15596.      Toolbar:TToolbar;
  15597. Label ex;
  15598. Begin
  15599.      Own := TForm(Owner);
  15600.      If Not (Own Is TForm) Then Exit;
  15601.  
  15602.      Case Alignment Of
  15603.         tbLeft,tbRight:Result:=0;
  15604.         tbBottom:
  15605.         Begin
  15606.              Result:=0;
  15607.              List:=Own.FToolBarLists[tbBottom];
  15608.              If List<>Nil Then For T:=List.Count-1 Downto 0 Do
  15609.              Begin
  15610.                   Toolbar:=TToolbar(List[T]);
  15611.                   If Toolbar.FVisible Then Dec(Result,Toolbar.Size);
  15612.                   If Toolbar=Self Then Goto ex;;
  15613.              End;
  15614.         End;
  15615.         tbTop:
  15616.         Begin
  15617.              Result := Own.GetClientHeight;
  15618.  
  15619.              List:=Own.FToolBarLists[tbTop];
  15620.              If List<>Nil Then For T:=List.Count-1 Downto 0 Do
  15621.              Begin
  15622.                   Toolbar:=TToolbar(List[T]);
  15623.                   If Toolbar=Self Then Goto ex;
  15624.                   If Toolbar.FVisible Then Inc(Result,Toolbar.Size);
  15625.              End;
  15626.         End;
  15627.      End;
  15628. ex:
  15629.      FBottom := Result;
  15630. End;
  15631.  
  15632.  
  15633. {$HINTS OFF}
  15634. Procedure TToolbar.SetLeft(NewLeft:LongInt);
  15635. Begin
  15636. End;
  15637.  
  15638. Procedure TToolbar.SetBottom(NewBottom:LongInt);
  15639. Begin
  15640. End;
  15641.  
  15642. Procedure TToolbar.SetTop(NewTop:LongInt);
  15643. Begin
  15644. End;
  15645.  
  15646. Procedure TToolbar.SetRight(NewRight:LongInt);
  15647. Begin
  15648. End;
  15649.  
  15650. Procedure TToolbar.SetWindowPos(NewLeft,NewBottom,NewWidth,NewHeight:LongInt);
  15651. Var  Own:TForm;
  15652. Begin
  15653.      Own := TForm(Owner);
  15654.      If Not (Own Is TForm) Then Exit;
  15655.  
  15656.      If Alignment In [tbLeft,tbRight] Then FWidth := NewWidth
  15657.      Else FHeight := NewHeight;
  15658.  
  15659.      If DesignerState * [dsNoRealSizing] <> [] Then Exit;
  15660.      Own.AlignToolBars;
  15661.  
  15662.      Resize; {because Of no WMSize}
  15663. End;
  15664. {$HINTS ON}
  15665.  
  15666.  
  15667. Procedure TToolbar.SetSizeable(Value:Boolean);
  15668. Begin
  15669.      If Value = FSizeable Then Exit;
  15670.  
  15671.      FSizeable := Value;
  15672.      If FSizeable Then
  15673.      Begin
  15674.           SizeBorderCtrl.Create(Self);
  15675.           Include(SizeBorderCtrl.ComponentState,csDetail);
  15676.           SizeBorderCtrl.OnSizing := EvBorderSizing;
  15677.           SizeBorderCtrl.OnSized := EvBorderSized;
  15678.           InsertControl(SizeBorderCtrl);
  15679.  
  15680.           Case FAlignment Of
  15681.             tbLeft: SizeBorderCtrl.BorderAlign := baRight;
  15682.             tbRight: SizeBorderCtrl.BorderAlign := baLeft;
  15683.             tbTop: SizeBorderCtrl.BorderAlign := baBottom;
  15684.             tbBottom: SizeBorderCtrl.BorderAlign := baTop;
  15685.           End;
  15686.      End
  15687.      Else
  15688.      Begin
  15689.           SizeBorderCtrl.Destroy;
  15690.           SizeBorderCtrl := Nil;
  15691.      End;
  15692. End;
  15693.  
  15694.  
  15695. {$HINTS OFF}
  15696. Procedure TToolbar.EvBorderSizing(Sender:TObject;Var SizeDelta:LongInt);
  15697. Begin
  15698.      Case FAlignment Of
  15699.        tbLeft:
  15700.        Begin
  15701.             If Size + SizeDelta < 5 Then SizeDelta := 5 - Size;
  15702.             If SizeDelta > FForm.ClientWidth Then SizeDelta := FForm.ClientWidth;
  15703.        End;
  15704.        tbBottom:
  15705.        Begin
  15706.             If Size + SizeDelta < 5 Then SizeDelta := 5 - Size;
  15707.             If SizeDelta > FForm.ClientHeight Then SizeDelta := FForm.ClientHeight;
  15708.        End;
  15709.        tbRight:
  15710.        Begin
  15711.             If Size - SizeDelta < 5 Then SizeDelta := Size - 5;
  15712.             If -SizeDelta > FForm.ClientWidth Then SizeDelta := -FForm.ClientWidth;
  15713.        End;
  15714.        tbTop:
  15715.        Begin
  15716.             If Size - SizeDelta < 5 Then SizeDelta := Size - 5;
  15717.             If -SizeDelta > FForm.ClientHeight Then SizeDelta := -FForm.ClientHeight;
  15718.        End;
  15719.      End;
  15720. End;
  15721. {$HINTS ON}
  15722.  
  15723.  
  15724. {$HINTS OFF}
  15725. Procedure TToolbar.EvBorderSized(Sender:TObject;Var SizeDelta:LongInt);
  15726. Begin
  15727.      Case FAlignment Of
  15728.        tbLeft:
  15729.        Begin
  15730.             If Size + SizeDelta < 5 Then SizeDelta := 5 - Size;
  15731.             If SizeDelta > FForm.ClientWidth Then SizeDelta := FForm.ClientWidth;
  15732.             Size := Size + SizeDelta;
  15733.        End;
  15734.        tbBottom:
  15735.        Begin
  15736.             If Size + SizeDelta < 5 Then SizeDelta := 5 - Size;
  15737.             If SizeDelta > FForm.ClientHeight Then SizeDelta := FForm.ClientHeight;
  15738.             Size := Size + SizeDelta;
  15739.        End;
  15740.        tbRight:
  15741.        Begin
  15742.             If Size - SizeDelta < 5 Then SizeDelta := Size - 5;
  15743.             If -SizeDelta > FForm.ClientWidth Then SizeDelta := -FForm.ClientWidth;
  15744.             Size := Size - SizeDelta;
  15745.        End;
  15746.        tbTop:
  15747.        Begin
  15748.             If Size - SizeDelta < 5 Then SizeDelta := Size - 5;
  15749.             If -SizeDelta > FForm.ClientHeight Then SizeDelta := -FForm.ClientHeight;
  15750.             Size := Size - SizeDelta;
  15751.        End;
  15752.      End;
  15753. End;
  15754. {$HINTS ON}
  15755.  
  15756.  
  15757. {
  15758. ╔═══════════════════════════════════════════════════════════════════════════╗
  15759. ║                                                                           ║
  15760. ║ Speed-Pascal/2 Version 2.0                                                ║
  15761. ║                                                                           ║
  15762. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  15763. ║                                                                           ║
  15764. ║ This section: TControl Class Implementation                               ║
  15765. ║                                                                           ║
  15766. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  15767. ║                                                                           ║
  15768. ╚═══════════════════════════════════════════════════════════════════════════╝
  15769. }
  15770.  
  15771. Procedure SetControlHandle(Control:TControl;Handle:HWND);
  15772. Begin
  15773.      Control.FHandle:=Handle;
  15774. End;
  15775.  
  15776. Procedure SetDefWndProc(Control:TControl;Proc:Pointer);
  15777. Begin
  15778.      Control.FDefWndProc:=Proc;
  15779. End;
  15780.  
  15781. Function TControl.ContainsControl(Control: TControl):Boolean;
  15782. Begin
  15783.     While ((Control<>Nil)And(Control<>Self)) Do Control := Control.Parent;
  15784.     Result:=Control<>Nil;
  15785. End;
  15786.  
  15787. Function TControl.ControlAtPos(Const Pos:TPoint;AllowDisabled:Boolean):TControl;
  15788. Var t:LongInt;
  15789.     Control:TControl;
  15790.     p:TPoint;
  15791. Begin
  15792.     Result:=Nil;
  15793.     p:=Point(Pos.X-Left,Pos.Y-Bottom);
  15794.     For t:=0 To ControlCount-1 Do
  15795.     Begin
  15796.          Control:=Controls[t];
  15797.          If ((Pos.X>=Control.Left)And(Pos.X<=Control.Right)And
  15798.              (Pos.Y>=Control.Bottom)And(Pos.Y<=Control.Top)) Then
  15799.          Begin
  15800.               If not AllowDisabled Then If Control.Enabled=False Then Continue;
  15801.               Result:=Control;
  15802.               exit;
  15803.          End;
  15804.     End;
  15805. End;
  15806.  
  15807. Procedure TControl.ScrollBy(DeltaX, DeltaY:LongInt);
  15808. Var t:LongInt;
  15809.     Control:TControl;
  15810.     {$IFDEF OS2}
  15811.     aswp:SWP;
  15812.     {$ENDIF}
  15813. Begin
  15814.      If Handle=0 Then exit;
  15815.      {$IFDEF OS2}
  15816.      WinScrollWindow(Handle,DeltaX,DeltaY,Nil,Nil,0,Nil,SW_SCROLLCHILDREN);
  15817.      For t:=0 To ControlCount-1 Do
  15818.      Begin
  15819.           Control:=Controls[t];
  15820.           If Control.Handle<>0 Then
  15821.           Begin
  15822.              WinQueryWindowPos(Control.Handle,aswp);
  15823.              Control.FLeft:=aswp.x;
  15824.              Control.FBottom:=aswp.y;
  15825.              Control.Move;
  15826.           End
  15827.           Else
  15828.           Begin
  15829.              inc(Control.FLeft,DeltaX);
  15830.              inc(Control.FBottom,DeltaY);
  15831.           End;
  15832.      End;
  15833.      {$ENDIF}
  15834.  
  15835.      Invalidate;
  15836. End;
  15837.  
  15838. Procedure TControl.GetTabOrderList(List:TList);
  15839. Var t:LongInt;
  15840.     Control:TControl;
  15841. Begin
  15842.      If FTabList<>Nil Then
  15843.      Begin
  15844.           For t:=0 To FTabList.Count-1 Do
  15845.           Begin
  15846.               Control:=TControl(FTabList[t]);
  15847.               List.Add(Control);
  15848.               Control.GetTabOrderList(List);
  15849.           End;
  15850.      End;
  15851. End;
  15852.  
  15853. Procedure TControl.ScaleBy(CX,CY:LongInt);
  15854. Var t:LongInt;
  15855. Begin
  15856.      {$IFDEF OS2}
  15857.      WinEnableWindowUpdate(Handle,False);
  15858.      {$ENDIF}
  15859.      {$IFDEF Win95}
  15860.      SendMessage(Handle,WM_SETREDRAW,0,0);
  15861.      {$ENDIF}
  15862.  
  15863.      For t:=0 To ControlCount-1 Do Controls[t].ScaleBy(CX,CY);
  15864.  
  15865.      Width:=Width+CX;
  15866.      Height:=Height+CY;
  15867.  
  15868.      {$IFDEF OS2}
  15869.      WinEnableWindowUpdate(Handle,True);
  15870.      {$ENDIF}
  15871.      {$IFDEF Win95}
  15872.      SendMessage(Handle,WM_SETREDRAW,1,0);
  15873.      {$ENDIF}
  15874. End;
  15875.  
  15876. Function TControl.GetControlState:TControlState;
  15877. Begin
  15878.      Result:=FControlState;
  15879.      If ComponentState*[csReading]<>[] Then Include(Result,csReadingState);
  15880. End;
  15881.  
  15882. Function TControl.GetControlStyle:TControlStyle;
  15883. Begin
  15884.      Result:=FControlStyle;
  15885.      If MouseCapture Then Include(Result,csCaptureMouse);
  15886.      If Self Is TForm Then Include(Result,csFramed);
  15887. End;
  15888.  
  15889. Procedure TControl.SetControlState(NewValue:TControlState);
  15890. Begin
  15891.      If NewValue*[csReadingState]<>[] Then
  15892.      Begin
  15893.           Include(ComponentState,csReading);
  15894.           Exclude(NewValue,csReadingState);
  15895.      End
  15896.      Else Exclude(ComponentState,csReading);
  15897.      FControlState:=NewValue;
  15898. End;
  15899.  
  15900. Procedure TControl.SetControlStyle(NewValue:TControlStyle);
  15901. Begin
  15902.      If NewValue*[csCaptureMouse]<>[] Then
  15903.      Begin
  15904.           MouseCapture:=True;
  15905.           Exclude(NewValue,csCaptureMouse);
  15906.      End
  15907.      Else MouseCapture:=False;
  15908.      Exclude(NewValue,csFramed);
  15909.      FControlStyle:=NewValue;
  15910. End;
  15911.  
  15912. Procedure TControl.Notification(AComponent:TComponent;Operation:TOperation);
  15913. Begin
  15914.      Inherited Notification(AComponent,Operation);
  15915.  
  15916.      If Operation = opRemove Then
  15917.        If AComponent = FPopupMenu Then FPopupMenu := Nil;
  15918. End;
  15919.  
  15920.  
  15921. Procedure TControl.MapPoints(target:TControl;Var pt:Array Of TPoint);
  15922. Begin
  15923.      If ((target=Nil)Or(target.Handle=0)) Then Exit;
  15924.  
  15925.      {$IFDEF OS2}
  15926.      WinMapWindowPoints(Handle,target.Handle,pts[0],High(pts)+1);
  15927.      {$ENDIF}
  15928.      {$IFDEF Win32}
  15929.      {!!!!!!!!!!!!!!!!!!!11 evtl umrechnen}
  15930.      MapWindowPoints(Handle,target.Handle,pts[0],High(pts)+1);
  15931.      {$ENDIF}
  15932. End;
  15933.  
  15934. Procedure TControl.WMMeasureItem(Var Msg:TMessage);
  15935. Var
  15936.      Control:TControl;
  15937.      {$IFDEF OS2}
  15938.      Win:HWND;
  15939.      {$ENDIF}
  15940.      {$IFDEF Win32}
  15941.      MeasureItem:^MEASUREITEMSTRUCT;
  15942.  
  15943.      Function GetControlFromId(AParent:TControl;Id:LongWord):TControl;
  15944.      Var  I:LongInt;
  15945.      Begin
  15946.           If AParent <> Nil Then
  15947.             For I := 0 To AParent.ControlCount-1 Do
  15948.             Begin
  15949.                  Result := AParent.Controls[I];
  15950.                  If Result.FWindowId = Id Then Exit;
  15951.                  Result := GetControlFromId(Result,Id);
  15952.                  If Result <> Nil Then Exit;
  15953.             End;
  15954.           Result := Nil;
  15955.      End;
  15956.      {$ENDIF}
  15957. Begin
  15958.      {$IFDEF OS2}
  15959.      Win := WinWindowFromID(Handle,Msg.Param1Lo);
  15960.      If Win = 0 Then Exit;
  15961.      Control := HandleToControl(Win);
  15962.      {$ENDIF}
  15963.      {$IFDEF Win32}
  15964.      MeasureItem := Pointer(Msg.Param2);
  15965.      If MeasureItem = Nil Then Exit;
  15966.      {Win:=GetDlgItem(Handle,MeasureItem^.CtlId);
  15967.      If Win=0 Then Exit;
  15968.      Control:=HandleToControl(Win);}
  15969.      {GWL_USERDATA Is Not Set here - Search In Component List}
  15970.      Control := GetControlFromId(Self, MeasureItem^.CtlId);
  15971.      If Control = Nil Then {define Some defaults}
  15972.      Begin
  15973.           MeasureItem^.ItemHeight := 32;
  15974.           Msg.Handled := True;
  15975.           Msg.Result := 1;
  15976.           Exit;
  15977.      End;
  15978.      {$ENDIF}
  15979.  
  15980.      If not IsControl(Control) Then Control:=Nil;
  15981.      If Control <> Nil Then Control.ParentNotification(Msg);
  15982. End;
  15983.  
  15984.  
  15985. Procedure TControl.WMDrawItem(Var Msg:TMessage);
  15986. Var  Win:HWND;
  15987.      Control:TControl;
  15988.      {$IFDEF Win32}
  15989.      ItemStruct:^DRAWITEMSTRUCT;
  15990.      {$ENDIF}
  15991. Begin
  15992.      {$IFDEF OS2}
  15993.      Win := WinWindowFromID(Handle,Msg.Param1Lo);
  15994.      {$ENDIF}
  15995.      {$IFDEF Win32}
  15996.      ItemStruct := Pointer(Msg.Param2);
  15997.      If ItemStruct = Nil Then Exit;
  15998.      Win := ItemStruct^.hwndItem;
  15999.      {$ENDIF}
  16000.      If Win = 0 Then Exit;
  16001.      Control := HandleToControl(Win);
  16002.  
  16003.      If not IsControl(Control) Then Control:=Nil;
  16004.      If Control <> Nil Then Control.ParentNotification(Msg);
  16005. End;
  16006.  
  16007.  
  16008. Procedure TControl.ParentNotification(Var Msg:TMessage);
  16009. Begin
  16010.      DefaultHandler(Msg);
  16011. End;
  16012.  
  16013.  
  16014. Procedure TControl.SetupComponent;
  16015. Begin
  16016.      Inherited SetupComponent;
  16017.  
  16018.      If Designed Then Exclude(ComponentState, csReference);
  16019.      Name:='Control';
  16020.      FParent:=Nil;
  16021.      FFrame:=Nil;
  16022.      FCtl3d:=True;
  16023.      FControlState:=[];
  16024.      FControlStyle:=[];
  16025.      FCaption:=Nil;
  16026.      FCursor:=crDefault;
  16027.      FOwnerDraw:=True;
  16028.      FHandlesDesignMouse:=False;
  16029.      FHandlesDesignKey:=False;
  16030.      PenColor:=clWindowText;
  16031.      color:=clWindow;
  16032.      FEnabled:=True;
  16033.      FVisible:=True;
  16034.      {$IFDEF Win32}
  16035.      FClickTime:=GetDoubleClickTime Div 2;
  16036.      {$ENDIF}
  16037.      FXAlign:=xaNone;
  16038.      FYAlign:=yaNone;
  16039.      FXStretch:=xsNone;
  16040.      FYStretch:=ysNone;
  16041.      IsFontChangeEnabled:=True;
  16042.      FFont:=StandardFont(Self);
  16043.      FHint:=Nil;
  16044.      FShowHint:=False;
  16045.      FParentShowHint:=True;
  16046.      FParentFont:=True;
  16047.      FParentPenColor:=False;
  16048.      FParentColor:=False;
  16049.      FCursorTabStop:=True;
  16050.      FTabStop:=True;
  16051.      FTabOrder:=-1;
  16052.      FZOrder:=zoTop;
  16053.      FDragMode:=dmManual;
  16054.      FDragCursor:=crDrag;
  16055.      FDragState:=dsDragEnter;
  16056.      FUpdateEnabled:=True;
  16057.      Include(ComponentState, csHandleLinks);
  16058. End;
  16059.  
  16060.  
  16061. Function TControl.GetAlign:TAlign;
  16062. Begin
  16063.      If FFrame = Nil Then
  16064.      Begin
  16065.           If (FXAlign=xaLeft) And (FYAlign=yaTop) And
  16066.              (FXStretch=xsParent) And (FYStretch=ysNone) Then Result := alTop
  16067.           Else
  16068.           If (FXAlign=xaLeft) And (FYAlign=yaBottom) And
  16069.              (FXStretch=xsParent) And (FYStretch=ysNone) Then Result := alBottom
  16070.           Else
  16071.           If (FXAlign=xaLeft) And (FYAlign=yaBottom) And
  16072.              (FXStretch=xsNone) And (FYStretch=ysParent) Then Result := alLeft
  16073.           Else
  16074.           If (FXAlign=xaRight) And (FYAlign=yaBottom) And
  16075.              (FXStretch=xsNone) And (FYStretch=ysParent) Then Result := alRight
  16076.           Else
  16077.           If (FXAlign=xaParent) And (FYAlign=yaParent) And
  16078.              (FXStretch=xsParent) And (FYStretch=ysParent) Then Result := alClient
  16079.           Else
  16080.           If (FXAlign=xaLeft) And (FYAlign=yaBottom) And
  16081.              (FXStretch=xsFrame) And (FYStretch=ysFrame) Then Result := alFrame
  16082.           Else
  16083.           If (FXAlign=xaNone) And (FYAlign=yaNone) And
  16084.              (FXStretch=xsScale) And (FYStretch=ysScale) Then Result := alScale
  16085.           Else
  16086.           If (FXAlign=xaCenter) And (FYAlign=yaCenter) And
  16087.              (FXStretch=xsNone) And (FYStretch=ysNone) Then Result := alCenter
  16088.           Else
  16089.           If (FXAlign=xaCenter) And (FYAlign=yaNone) And
  16090.              (FXStretch=xsNone) And (FYStretch=ysNone) Then Result := alCenterX
  16091.           Else
  16092.           If (FXAlign=xaNone) And (FYAlign=yaCenter) And
  16093.              (FXStretch=xsNone) And (FYStretch=ysNone) Then Result := alCenterY
  16094.           Else
  16095.           If (FXAlign=xaLeft) And (FYAlign=yaTop) And
  16096.              (FXStretch=xsNone) And (FYStretch=ysNone) Then Result := alFixedLeftTop
  16097.           Else
  16098.           If (FXAlign=xaLeft) And (FYAlign=yaBottom) And
  16099.              (FXStretch=xsNone) And (FYStretch=ysNone) Then Result := alFixedLeftBottom
  16100.           Else
  16101.           If (FXAlign=xaRight) And (FYAlign=yaTop) And
  16102.              (FXStretch=xsNone) And (FYStretch=ysNone) Then Result := alFixedRightTop
  16103.           Else
  16104.           If (FXAlign=xaRight) And (FYAlign=yaBottom) And
  16105.              (FXStretch=xsNone) And (FYStretch=ysNone) Then Result := alFixedRightBottom
  16106.           Else Result := alNone;
  16107.      End
  16108.      Else Result := FFrame.GetAlign;
  16109. End;
  16110.  
  16111.  
  16112. Function TControl.GetXAlign:TXAlign;
  16113. Begin
  16114.      If FFrame = Nil Then Result := FXAlign
  16115.      Else Result := FFrame.FXAlign;
  16116. End;
  16117.  
  16118.  
  16119. Function TControl.GetYAlign:TYAlign;
  16120. Begin
  16121.      If FFrame = Nil Then Result := FYAlign
  16122.      Else Result := FFrame.FYAlign;
  16123. End;
  16124.  
  16125.  
  16126. Function TControl.GetXStretch:TXStretch;
  16127. Begin
  16128.      If FFrame = Nil Then Result := FXStretch
  16129.      Else Result := FFrame.FXStretch;
  16130. End;
  16131.  
  16132.  
  16133. Function TControl.GetYStretch:TYStretch;
  16134. Begin
  16135.      If FFrame = Nil Then Result := FYStretch
  16136.      Else Result := FFrame.FYStretch;
  16137. End;
  16138.  
  16139.  
  16140. Procedure TControl.SetAlign(NewAlign:TAlign);
  16141. Var  cw,CH:LongInt;
  16142. Begin
  16143.      If FFrame = Nil Then
  16144.      Begin
  16145.           Case NewAlign Of
  16146.             alNone:
  16147.             Begin
  16148.                  FXAlign := xaNone;
  16149.                  FYAlign := yaNone;
  16150.                  FXStretch := xsNone;
  16151.                  FYStretch := ysNone;
  16152.             End;
  16153.             alLeft:
  16154.             Begin
  16155.                  FXAlign := xaLeft;
  16156.                  FYAlign := yaBottom;
  16157.                  FXStretch := xsNone;
  16158.                  FYStretch := ysParent;
  16159.                  FLeft := 0;
  16160.                  FBottom := 0;
  16161.             End;
  16162.             alRight:
  16163.             Begin
  16164.                  FXAlign := xaRight;
  16165.                  FYAlign := yaBottom;
  16166.                  FXStretch := xsNone;
  16167.                  FYStretch := ysParent;
  16168.                  FBottom := 0;
  16169.                  If FAutoFrame = Nil Then New(FAutoFrame);
  16170.                  FAutoFrame^.Right := 0;
  16171.             End;
  16172.             alBottom:
  16173.             Begin
  16174.                  FXAlign := xaLeft;
  16175.                  FYAlign := yaBottom;
  16176.                  FXStretch := xsParent;
  16177.                  FYStretch := ysNone;
  16178.                  FLeft := 0;
  16179.                  FBottom := 0;
  16180.             End;
  16181.             alTop:
  16182.             Begin
  16183.                  FXAlign := xaLeft;
  16184.                  FYAlign := yaTop;
  16185.                  FXStretch := xsParent;
  16186.                  FYStretch := ysNone;
  16187.                  FLeft := 0;
  16188.                  If FAutoFrame = Nil Then New(FAutoFrame);
  16189.                  FAutoFrame^.Top := 0;
  16190.             End;
  16191.             alCenter:
  16192.             Begin
  16193.                  FXAlign := xaCenter;
  16194.                  FYAlign := yaCenter;
  16195.                  FXStretch := xsNone;
  16196.                  FYStretch := ysNone;
  16197.             End;
  16198.             alCenterX:
  16199.             Begin
  16200.                  FXAlign := xaCenter;
  16201.                  FYAlign := yaNone;
  16202.                  FXStretch := xsNone;
  16203.                  FYStretch := ysNone;
  16204.             End;
  16205.             alCenterY:
  16206.             Begin
  16207.                  FXAlign := xaNone;
  16208.                  FYAlign := yaCenter;
  16209.                  FXStretch := xsNone;
  16210.                  FYStretch := ysNone;
  16211.             End;
  16212.             alFixedLeftTop:
  16213.             Begin
  16214.                  FXAlign := xaLeft;
  16215.                  FYAlign := yaTop;
  16216.                  FXStretch := xsNone;
  16217.                  FYStretch := ysNone;
  16218.                  If FAutoFrame = Nil Then New(FAutoFrame);
  16219.                  If Parent = Nil Then CH:=Screen.Height
  16220.                  Else CH := GetParentClientHeight;
  16221.                  If CH <> 0 Then FAutoFrame^.Top := CH - FBottom - FHeight
  16222.                  Else FAutoFrame^.Top := 0;
  16223.             End;
  16224.             alFixedLeftBottom:
  16225.             Begin
  16226.                  FXAlign := xaLeft;
  16227.                  FYAlign := yaBottom;
  16228.                  FXStretch := xsNone;
  16229.                  FYStretch := ysNone;
  16230.             End;
  16231.             alFixedRightTop:
  16232.             Begin
  16233.                  FXAlign := xaRight;
  16234.                  FYAlign := yaTop;
  16235.                  FXStretch := xsNone;
  16236.                  FYStretch := ysNone;
  16237.                  If FAutoFrame = Nil Then New(FAutoFrame);
  16238.                  If Parent = Nil Then CH:=Screen.Height
  16239.                  Else CH := GetParentClientHeight;
  16240.                  If CH <> 0 Then FAutoFrame^.Top := CH - FBottom - FHeight
  16241.                  Else FAutoFrame^.Top := 0;
  16242.                  If Parent = Nil Then cw:=Screen.Width
  16243.                  Else cw := GetParentClientWidth;
  16244.                  If cw <> 0 Then FAutoFrame^.Right := cw - FLeft - FWidth
  16245.                  Else FAutoFrame^.Right := 0;
  16246.             End;
  16247.             alFixedRightBottom:
  16248.             Begin
  16249.                  FXAlign := xaRight;
  16250.                  FYAlign := yaBottom;
  16251.                  FXStretch := xsNone;
  16252.                  FYStretch := ysNone;
  16253.                  If FAutoFrame = Nil Then New(FAutoFrame);
  16254.                  If Parent = Nil Then cw:=Screen.Width
  16255.                  Else cw := GetParentClientWidth;
  16256.                  If cw <> 0 Then FAutoFrame^.Right := cw - FLeft - FWidth
  16257.                  Else FAutoFrame^.Right := 0;
  16258.             End;
  16259.             alClient:
  16260.             Begin
  16261.                  FXAlign := xaParent;
  16262.                  FYAlign := yaParent;
  16263.                  FXStretch := xsParent;
  16264.                  FYStretch := ysParent;
  16265.             End;
  16266.             alFrame: {Parent necessary}
  16267.             Begin
  16268.                  FXAlign := xaLeft;
  16269.                  FYAlign := yaBottom;
  16270.                  FXStretch := xsFrame;
  16271.                  FYStretch := ysFrame;
  16272.                  If Parent = Nil Then Exit;
  16273.                  If FAutoFrame = Nil Then New(FAutoFrame);
  16274.                  cw := GetParentClientWidth;
  16275.                  CH := GetParentClientHeight;
  16276.                  If cw <> 0 Then FAutoFrame^.Left := FLeft
  16277.                  Else FAutoFrame^.Left := 0;
  16278.                  If cw <> 0 Then FAutoFrame^.Right := cw - FLeft - FWidth
  16279.                  Else FAutoFrame^.Right := 0;
  16280.                  If CH <> 0 Then FAutoFrame^.Bottom := FBottom
  16281.                  Else FAutoFrame^.Bottom := 0;
  16282.                  If CH <> 0 Then FAutoFrame^.Top := CH - FBottom - FHeight
  16283.                  Else FAutoFrame^.Top := 0;
  16284.             End;
  16285.             alScale: {Parent necessary}
  16286.             Begin
  16287.                  FXAlign := xaNone;
  16288.                  FYAlign := yaNone;
  16289.                  FXStretch := xsScale;
  16290.                  FYStretch := ysScale;
  16291.                  If Parent = Nil Then Exit;
  16292.                  If FAutoScale = Nil Then New(FAutoScale);
  16293.                  cw := GetParentClientWidth;
  16294.                  CH := GetParentClientHeight;
  16295.                  If cw <> 0 Then FAutoScale^.Left := FLeft / cw
  16296.                  Else FAutoScale^.Left := 0;
  16297.                  If cw <> 0 Then FAutoScale^.Right := (FLeft+FWidth) / cw
  16298.                  Else FAutoScale^.Right := 1;
  16299.                  If CH <> 0 Then FAutoScale^.Bottom := FBottom / CH
  16300.                  Else FAutoScale^.Bottom := 0;
  16301.                  If CH <> 0 Then FAutoScale^.Top := (FBottom+FHeight) / CH
  16302.                  Else FAutoScale^.Top := 1;
  16303.             End;
  16304.           End;
  16305.           If Handle <> 0 Then SetWindowPos(Left,Bottom,Width,Height);
  16306.      End
  16307.      Else FFrame.SetAlign(NewAlign);
  16308. End;
  16309.  
  16310.  
  16311. Procedure TControl.SetXAlign(NewAlign:TXAlign);
  16312. Var  cw:LongInt;
  16313. Begin
  16314.      If FFrame = Nil Then
  16315.      Begin
  16316.           FXAlign := NewAlign;
  16317.           If FXAlign=xaRight Then
  16318.           Begin
  16319.                If Parent = Nil Then
  16320.                Begin
  16321.                     If ((Self Is TFrameControl) And
  16322.                         (TFrameControl(Self).Child<>Nil)And
  16323.                         (TFrameControl(Self).Child.FormStyle <> fsMDIChild))
  16324.                        Then cw := Screen.Width
  16325.                     Else Exit;
  16326.                End
  16327.                Else cw := GetParentClientWidth;
  16328.  
  16329.                If FAutoFrame = Nil Then New(FAutoFrame);
  16330.                If cw <> 0 Then FAutoFrame^.Right := cw - FLeft - FWidth
  16331.                Else FAutoFrame^.Right := 0;
  16332.           End;
  16333.           If Handle <> 0 Then Left := Left;
  16334.      End
  16335.      Else FFrame.SetXAlign(NewAlign);
  16336. End;
  16337.  
  16338.  
  16339. Procedure TControl.SetYAlign(NewAlign:TYAlign);
  16340. Var  CH:LongInt;
  16341. Begin
  16342.      If FFrame = Nil Then
  16343.      Begin
  16344.           FYAlign := NewAlign;
  16345.           If FYAlign=yaTop Then
  16346.           Begin
  16347.                If Parent = Nil Then
  16348.                Begin
  16349.                     If ((Self Is TFrameControl) And
  16350.                         (TFrameControl(Self).Child<>Nil)And
  16351.                         (TFrameControl(Self).Child.FormStyle <> fsMDIChild))
  16352.                       Then CH := Screen.Height
  16353.                     Else Exit;
  16354.                End
  16355.                Else CH := GetParentClientHeight;
  16356.  
  16357.                If FAutoFrame = Nil Then New(FAutoFrame);
  16358.                If CH <> 0 Then FAutoFrame^.Top := CH - FBottom - FHeight
  16359.                Else FAutoFrame^.Top := 0;
  16360.           End;
  16361.           If Handle <> 0 Then Bottom := Bottom;
  16362.      End
  16363.      Else FFrame.SetYAlign(NewAlign);
  16364. End;
  16365.  
  16366.  
  16367. Procedure TControl.SetXStretch(NewStretch:TXStretch);
  16368. Var  cw:LongInt;
  16369. Begin
  16370.      If FFrame = Nil Then
  16371.      Begin
  16372.           FXStretch := NewStretch;
  16373.           Case FXStretch Of
  16374.             xsFrame:
  16375.             Begin
  16376.                  If Parent = Nil Then
  16377.                  Begin
  16378.                       If ((Self Is TFrameControl) And
  16379.                         (TFrameControl(Self).Child<>Nil)And
  16380.                         (TFrameControl(Self).Child.FormStyle <> fsMDIChild))
  16381.                           Then cw := Screen.Width
  16382.                       Else Exit;
  16383.                  End
  16384.                  Else cw := GetParentClientWidth;
  16385.  
  16386.                  If FAutoFrame = Nil Then New(FAutoFrame);
  16387.                  If cw <> 0 Then FAutoFrame^.Left := FLeft
  16388.                  Else FAutoFrame^.Left := 0;
  16389.                  If cw <> 0 Then FAutoFrame^.Right := cw - FLeft - FWidth
  16390.                  Else FAutoFrame^.Right := 0;
  16391.             End;
  16392.             xsScale:
  16393.             Begin
  16394.                  If Parent = Nil Then
  16395.                  Begin
  16396.                       If ((Self Is TFrameControl) And
  16397.                         (TFrameControl(Self).Child<>Nil)And
  16398.                         (TFrameControl(Self).Child.FormStyle <> fsMDIChild))
  16399.                           Then cw := Screen.Width
  16400.                       Else Exit;
  16401.                  End
  16402.                  Else cw := GetParentClientWidth;
  16403.  
  16404.                  If FAutoScale = Nil Then New(FAutoScale);
  16405.                  If cw <> 0 Then FAutoScale^.Left := FLeft / cw
  16406.                  Else FAutoScale^.Left := 0;
  16407.                  If cw <> 0 Then FAutoScale^.Right := (FLeft+FWidth) / cw
  16408.                  Else FAutoScale^.Right := 1;
  16409.             End;
  16410.           End;
  16411.           If Handle <> 0 Then Width := Width;
  16412.      End
  16413.      Else FFrame.SetXStretch(NewStretch);
  16414. End;
  16415.  
  16416.  
  16417. Procedure TControl.SetYStretch(NewStretch:TYStretch);
  16418. Var  CH:LongInt;
  16419. Begin
  16420.      If FFrame = Nil Then
  16421.      Begin
  16422.           FYStretch := NewStretch;
  16423.           Case FYStretch Of
  16424.             ysFrame:
  16425.             Begin
  16426.                  If Parent = Nil Then
  16427.                  Begin
  16428.                       If ((Self Is TFrameControl) And
  16429.                         (TFrameControl(Self).Child<>Nil)And
  16430.                         (TFrameControl(Self).Child.FormStyle <> fsMDIChild))
  16431.                           Then CH := Screen.Height
  16432.                       Else Exit;
  16433.                  End
  16434.                  Else CH := GetParentClientHeight;
  16435.  
  16436.                  If FAutoFrame = Nil Then New(FAutoFrame);
  16437.                  If CH <> 0 Then FAutoFrame^.Bottom := FBottom
  16438.                  Else FAutoFrame^.Bottom := 0;
  16439.                  If CH <> 0 Then FAutoFrame^.Top := CH - FBottom - FHeight
  16440.                  Else FAutoFrame^.Top := 0;
  16441.             End;
  16442.             ysScale:
  16443.             Begin
  16444.                  If Parent = Nil Then
  16445.                  Begin
  16446.                       If ((Self Is TFrameControl) And
  16447.                         (TFrameControl(Self).Child<>Nil)And
  16448.                         (TFrameControl(Self).Child.FormStyle <> fsMDIChild))
  16449.                           Then CH := Screen.Height
  16450.                       Else Exit;
  16451.                  End
  16452.                  Else CH := GetParentClientHeight;
  16453.  
  16454.                  If FAutoScale = Nil Then New(FAutoScale);
  16455.                  If CH <> 0 Then FAutoScale^.Bottom := FBottom / CH
  16456.                  Else FAutoScale^.Bottom := 0;
  16457.                  If CH <> 0 Then FAutoScale^.Top := (FBottom+FHeight) / CH
  16458.                  Else FAutoScale^.Top := 1;
  16459.             End;
  16460.           End;
  16461.           If Handle <> 0 Then Height := Height;
  16462.      End
  16463.      Else FFrame.SetYStretch(NewStretch);
  16464. End;
  16465.  
  16466.  
  16467. Function TControl.GetControlCount:LongInt;
  16468. Begin
  16469.      If FControls = Nil Then Result := 0
  16470.      Else Result := FControls.Count;
  16471. End;
  16472.  
  16473.  
  16474. Function TControl.GetControl(AIndex:LongInt):TControl;
  16475. Begin
  16476.      If (FControls = Nil) Or (AIndex < 0) Or (AIndex >= FControls.Count)
  16477.      Then Result := Nil
  16478.      Else Result := FControls.Items[AIndex];
  16479. End;
  16480.  
  16481.  
  16482. Procedure TControl.SetPenColor(NewColor:TColor);
  16483. Begin
  16484.      FPenColor := NewColor;
  16485.      If ComponentState * [csReading] = [] Then FParentPenColor := False;
  16486.      {$IFDEF OS2}
  16487.      If Handle <> 0 Then SetPPForeGroundColor(NewColor);
  16488.      {$ENDIF}
  16489.      If Handle <> 0 Then Invalidate;
  16490.      NotifyControls(CM_PARENTPENCOLORCHANGED);
  16491. End;
  16492.  
  16493.  
  16494. Procedure TControl.SetColor(NewColor:TColor);
  16495. Begin
  16496.      FColor := NewColor;
  16497.      If ComponentState * [csReading] = [] Then FParentColor := False;
  16498.      {$IFDEF OS2}
  16499.      If Handle <> 0 Then SetPPBackGroundColor(NewColor);
  16500.      {$ENDIF}
  16501.      {$IFDEF Win32}
  16502.      If FCtlBrush <> 0 Then DeleteObject(FCtlBrush);
  16503.  
  16504.      If Not FOwnerDraw Then
  16505.      Begin
  16506.           NewColor := RGBToWinColor(SysColorToRGB(NewColor));
  16507.           FCtlBrush := CreateSolidBrush(NewColor);
  16508.      End
  16509.      Else FCtlBrush := 0;
  16510.      {$ENDIF}
  16511.      If Handle <> 0 Then Invalidate;
  16512.      NotifyControls(CM_PARENTCOLORCHANGED);
  16513. End;
  16514.  
  16515.  
  16516. {$HINTS OFF}
  16517. Procedure TControl.ParentFontChanged(Var Msg:TMessage);
  16518. Begin
  16519.      If FParentFont Then
  16520.        If FParent <> Nil Then
  16521.        Begin
  16522.             SetFont(FParent.FFont);
  16523.             FParentFont := True;
  16524.        End;
  16525. End;
  16526.  
  16527.  
  16528. Procedure TControl.ParentPenColorChanged(Var Msg:TMessage);
  16529. Begin
  16530.      If FParentPenColor Then
  16531.        If FParent <> Nil Then
  16532.        Begin
  16533.             SetPenColor(FParent.FPenColor);
  16534.             FParentPenColor := True;
  16535.        End;
  16536. End;
  16537.  
  16538.  
  16539. Procedure TControl.ParentColorChanged(Var Msg:TMessage);
  16540. Begin
  16541.      If FParentColor Then
  16542.        If FParent <> Nil Then
  16543.        Begin
  16544.             SetColor(FParent.FColor);
  16545.             FParentColor := True;
  16546.        End;
  16547. End;
  16548. {$HINTS ON}
  16549.  
  16550.  
  16551. Procedure TControl.SetParentFont(Value:Boolean);
  16552. Begin
  16553.      If FParentFont <> Value Then
  16554.      Begin
  16555.           If Value Then
  16556.             If FParent <> Nil Then Font := FParent.FFont;
  16557.           FParentFont := Value;
  16558.      End;
  16559. End;
  16560.  
  16561.  
  16562. Procedure TControl.SetParentPenColor(Value:Boolean);
  16563. Begin
  16564.      If FParentPenColor <> Value Then
  16565.      Begin
  16566.           If Value Then
  16567.             If FParent <> Nil Then PenColor := FParent.FPenColor;
  16568.           FParentPenColor := Value;
  16569.      End;
  16570. End;
  16571.  
  16572.  
  16573. Procedure TControl.SetParentColor(Value:Boolean);
  16574. Begin
  16575.      If FParentColor <> Value Then
  16576.      Begin
  16577.           If Value Then
  16578.             If FParent <> Nil Then color := FParent.FColor;
  16579.           FParentColor := Value;
  16580.      End;
  16581. End;
  16582.  
  16583.  
  16584. Procedure TControl.SetText(Const NewCaption:String);
  16585. Var  CS:Cstring;
  16586.      {$IFDEF WIN32}
  16587.      s:String;
  16588.      {$ENDIF}
  16589. Begin
  16590.      AssignStr(FCaption, NewCaption);
  16591.      If FFrame = Nil Then
  16592.      Begin
  16593.           If (Handle <> 0) And
  16594.              (IsStandardControl Or (Self Is TFrameControl)) Then
  16595.           Begin
  16596.                {$IFDEF OS2}
  16597.                If (NewCaption = '') And (Self Is TFrameControl) Then CS := ' '
  16598.                Else CS := ReplaceMnemo(NewCaption);
  16599.                WinSetWindowText(Handle,CS);
  16600.                {$ENDIF}
  16601.                {$IFDEF Win32}
  16602.                If Not FOwnerDraw Then CS := ReplaceMnemo(NewCaption)
  16603.                Else CS := NewCaption;
  16604.                S:=CS;
  16605.                StrOemToAnsi(S);
  16606.                CS:=S;
  16607.                SetWindowText(Handle,CS);
  16608.                {$ENDIF}
  16609.           End;
  16610.           Perform(CM_TEXTCHANGED,0,0);
  16611.      End
  16612.      Else FFrame.SetText(NewCaption);
  16613. End;
  16614.  
  16615.  
  16616. Function TControl.GetText:String;
  16617. Var  CS:Cstring;
  16618.      len:LongInt;
  16619. Begin
  16620.      If FFrame = Nil Then
  16621.      Begin
  16622.           If (Handle <> 0) And IsEditControl Then
  16623.           Begin
  16624.                {$IFDEF OS2}
  16625.                len := WinQueryWindowText(Handle,SizeOf(CS),CS);
  16626.                {$ENDIF}
  16627.                {$IFDEF Win32}
  16628.                len := GetWindowText(Handle,CS,SizeOf(CS));
  16629.                AnsiToOEM(CS,CS);
  16630.                {$ENDIF}
  16631.                Result := CS;
  16632.                SetLength(Result,len);
  16633.           End
  16634.           Else
  16635.           Begin
  16636.                If FCaption = Nil Then Result := ''
  16637.                Else Result := FCaption^;
  16638.           End;
  16639.      End
  16640.      Else Result := FFrame.GetText;
  16641. End;
  16642.  
  16643.  
  16644. Procedure TControl.SetZOrder(zo:TZOrder);
  16645. Begin
  16646.      If zo <> FZOrder Then
  16647.      Begin
  16648.           FZOrder := zo;
  16649.           If FZOrder <> zoNone Then
  16650.             If Handle <> 0 Then UpdateWindowPos(FLeft,FBottom,FWidth,FHeight);
  16651.      End;
  16652. End;
  16653.  
  16654.  
  16655. Procedure TControl.GetClassData(Var ClassData:TClassData);
  16656. Begin
  16657.      ClassData.StandardClass:=False;
  16658.      ClassData.ClassName:='Speed-Pascal Window';
  16659.      ClassData.WindowProc:=@StartWndProc;
  16660.      {!!!!!!!!!!!!!!!!!!!!!!!!!!}
  16661.      ClassData.ClassStyle:=[wcsSizeRedraw,{wcsClipChildren,}
  16662.                             wcsClipSiblings,wcsOwnDC{,wcsSaveBits}];
  16663.      ClassData.DataCount:=4;
  16664.      ClassData.ClassULong:=0;
  16665. End;
  16666.  
  16667.  
  16668. {$IFDEF Win32}
  16669. Procedure TControl.CreateSubClass(Var ClassData:TClassData;
  16670.                                   Const ControlClassName:Cstring);
  16671. Var  WindowClass:WNDCLASS;
  16672. Begin
  16673.      ClassData.ClassName := ControlClassName;
  16674.      ClassData.ClassStyle := ClassData.ClassStyle + [wcsSizeRedraw]
  16675.                              - [wcsOwnDC];
  16676.      ClassData.StandardClass := True;
  16677.      If @FDefWndProc = Nil Then
  16678.      Begin
  16679.           If Not WinUser.GetClassInfo(DllModule, ControlClassName, WindowClass)
  16680.           Then WinUser.GetClassInfo(0, ControlClassName, WindowClass);
  16681.  
  16682.           FDefWndProc := @WindowClass.lpfnWndProc; {Get original WindowProc}
  16683.      End;
  16684.  
  16685.      IsEditControl := ControlClassName = 'EDIT';
  16686. End;
  16687. {$ENDIF}
  16688.  
  16689.  
  16690. Procedure TControl.RegisterClass;
  16691. Var  ClassData:TClassData;
  16692.      ClassStyle:LongWord;
  16693.      {$IFDEF OS2}
  16694.      aClass:PmWin.ClassInfo;
  16695.      {$ENDIF}
  16696.      {$IFDEF Win32}
  16697.      aClass:WNDCLASS;
  16698.      {$ENDIF}
  16699. Begin
  16700.      GetClassData(ClassData);
  16701.      {$IFDEF OS2}
  16702.      IsStandardControl := ClassData.ClassULong <> 0;
  16703.      IsEditControl := ClassData.ClassULong = WC_ENTRYFIELD;
  16704.      {$ENDIF}
  16705.      {$IFDEF Win32}
  16706.      IsStandardControl := ClassData.StandardClass;  {Set In CreateSubClass}
  16707.      {$ENDIF}
  16708.  
  16709.      {$IFDEF OS2}
  16710.      If Not WinQueryClassInfo(AppHandle,ClassData.ClassName,aClass) Then
  16711.      Begin
  16712.           ClassStyle:=0;
  16713.           If ClassData.ClassStyle*[wcsSizeRedraw]<>[]
  16714.             Then ClassStyle:=ClassStyle Or CS_SIZEREDRAW;
  16715.           If ClassData.ClassStyle*[wcsHitTest]<>[]
  16716.             Then ClassStyle:=ClassStyle Or CS_HITTEST;
  16717.           If ClassData.ClassStyle*[wcsFrame]<>[]
  16718.             Then ClassStyle:=ClassStyle Or CS_FRAME;
  16719.           If ClassData.ClassStyle*[wcsClipChildren]<>[] Then
  16720.             If Not Designed Then ClassStyle:=ClassStyle Or CS_CLIPCHILDREN;
  16721.           If ClassData.ClassStyle*[wcsClipSiblings]<>[]
  16722.             Then ClassStyle:=ClassStyle Or CS_CLIPSIBLINGS;
  16723.           If ClassData.ClassStyle*[wcsParentClip]<>[]
  16724.             Then ClassStyle:=ClassStyle Or CS_PARENTCLIP;
  16725.           If ClassData.ClassStyle*[wcsSaveBits]<>[]
  16726.             Then ClassStyle:=ClassStyle Or CS_SAVEBITS;
  16727.           If ClassData.ClassStyle*[wcsSyncPaint]<>[]
  16728.             Then ClassStyle:=ClassStyle Or CS_SYNCPAINT;
  16729.           ClassStyle:=ClassStyle Or CS_MOVENOTIFY;
  16730.  
  16731.           WinRegisterClass(AppHandle,
  16732.                            ClassData.ClassName,
  16733.                            ClassData.WindowProc,
  16734.                            ClassStyle,
  16735.                            ClassData.DataCount);
  16736.      End;
  16737.      {$ENDIF}
  16738.      {$IFDEF Win32}
  16739.      If Not ClassData.StandardClass Then
  16740.        If Not WinUser.GetClassInfo(DllModule,ClassData.ClassName,aClass) Then
  16741.      Begin
  16742.           ClassStyle:=CS_DBLCLKS;
  16743.           If ClassData.ClassStyle*[wcsSizeRedraw]<>[]
  16744.             Then ClassStyle:=ClassStyle Or CS_HREDRAW Or CS_VREDRAW;
  16745.           If ClassData.ClassStyle*[wcsSaveBits]<>[]
  16746.             Then ClassStyle:=ClassStyle Or CS_SAVEBITS;
  16747.           If ClassData.ClassStyle*[wcsOwnDC]<>[]
  16748.             Then ClassStyle:=ClassStyle Or CS_OWNDC;
  16749.           //others ignored
  16750.  
  16751.           aClass.Style         := ClassStyle;
  16752.           aClass.lpfnWndProc   := ClassData.WindowProc;
  16753.           aClass.cbClsExtra    := ClassData.DataCount;
  16754.           aClass.cbWndExtra    := 0;
  16755.           aClass.hInstance     := DllModule;
  16756.           aClass.hIcon         := 0;
  16757.           aClass.HCursor       := LoadCursor(0,IDC_ARROW);
  16758.           aClass.hbrBackground := 0;
  16759.           aClass.lpszMenuName  := Nil;
  16760.           aClass.lpszClassName := @ClassData.ClassName;
  16761.  
  16762.           WinUser.RegisterClass(aClass);
  16763.      End;
  16764.      {$ENDIF}
  16765. End;
  16766.  
  16767.  
  16768. Procedure TControl.UpdateFont;
  16769. Var  {$IFDEF OS2}
  16770.      S:String;
  16771.      C:Cstring;
  16772.      {$ENDIF}
  16773.      {$IFDEF Win32}
  16774.      aFontInfo:LOGFONT;
  16775.      aFontAttr:TFontAttributes;
  16776.      {$ENDIF}
  16777. Begin
  16778.      If FFont = Nil Then Exit;
  16779.      {$IFDEF OS2}
  16780.      If FFont.FInternalPointSize<>0 Then
  16781.      Begin
  16782.           S:=tostr(FFont.FInternalPointSize)+'.';
  16783.           C:=FFont.FaceName;
  16784.      End
  16785.      Else
  16786.      Begin
  16787.           S:=tostr((FFont.FFontInfo.sNominalPointSize) Div 10)+'.';
  16788.           C:=FFont.FFontInfo.szFaceName;
  16789.      End;
  16790.  
  16791.      S:=S+C;
  16792.      S:=ModifyFontName(S,FFont.Attributes);
  16793.      SetPPFontNameSize(S);
  16794.      {$ENDIF}
  16795.  
  16796.      {$IFDEF Win32}
  16797.      If FFont.FHandle<>0 Then
  16798.      Begin
  16799.           If FDefFontHandle<>FFont.FHandle Then
  16800.           Begin
  16801.                FDefFontHandle:=FFont.FHandle;
  16802.                Inc(FFont.FRefCount);
  16803.           End;
  16804.      End
  16805.      Else
  16806.      Begin
  16807.           aFontInfo:=FFont.FFontInfo;
  16808.           aFontInfo.lfHeight:=FFont.FFontInfo.lfHeight;
  16809.           aFontInfo.lfWidth:=FFont.FFontInfo.lfWidth;
  16810.           aFontInfo.lfQuality:=DRAFT_QUALITY;
  16811.           aFontAttr:=FFont.Attributes;
  16812.           If aFontAttr*[faItalic]<>[] Then aFontInfo.lfItalic:=1
  16813.           Else aFontInfo.lfItalic:=0;
  16814.           If aFontAttr*[faUnderScore]<>[] Then aFontInfo.lfUnderline:=1
  16815.           Else aFontInfo.lfUnderline:=0;
  16816.           If aFontAttr*[faStrikeOut]<>[] Then aFontInfo.lfStrikeOut:=1
  16817.           Else aFontInfo.lfStrikeOut:=0;
  16818.           If aFontAttr*[faBold]<>[] Then aFontInfo.lfWeight:=FW_BOLD
  16819.           Else aFontInfo.lfWeight:=FW_NORMAL;
  16820.           FDefFontHandle:=CreateFontIndirect(aFontInfo);
  16821.           FFont.FHandle:=FDefFontHandle;
  16822.           FFont.FRefCount:=1;
  16823.      End;
  16824.      SendMessage(Handle,WM_SETFONT,FDefFontHandle,1);
  16825.      If IsFontChangeEnabled Then FontChange;
  16826.      {$ENDIF}
  16827. End;
  16828.  
  16829.  
  16830. Procedure TControl.SetFont(NewFont:TFont);
  16831. Begin
  16832.      If NewFont = FFont Then Exit;
  16833.  
  16834.      If NewFont=Nil Then NewFont:=StandardFont(Self);
  16835.      If ComponentState * [csReading] = [] Then FParentFont := False;
  16836.  
  16837.      If FFont<>NewFont Then
  16838.      Begin
  16839.           DereferenceFont(FFont);
  16840.           FFont:=NewFont;
  16841.           If FFont<>Nil Then Inc(FFont.FUseCount);
  16842.      End;
  16843.  
  16844.      If Handle <> 0 Then
  16845.      Begin
  16846.           If FCanvas <> Nil Then
  16847.           Begin
  16848.                //FCanvas.Font := NewFont; //MIST da dies den ControlFont nicht ändert !!
  16849.                FCanvas.FFontWidth:=0;
  16850.                FCanvas.FFontHeight:=0;
  16851.                FCanvas.FFontAttr:=[];
  16852.                {!!!! der ControlFont wird verändert !!!}
  16853.                FCanvas.CreateFont(NewFont,True); //!!
  16854.           End
  16855.           Else UpdateFont;
  16856.      End;
  16857.  
  16858. //     If FFrame <> Nil Then FFrame.Font := NewFont;
  16859.      NotifyControls(CM_PARENTFONTCHANGED);
  16860. End;
  16861.  
  16862.  
  16863. Function TControl.GetWindowFlags:LongWord;
  16864. Begin
  16865.      Result := WS_CLIPSIBLINGS;     {Win: + WS_CHILD .?.}
  16866.  
  16867.      If Not Designed Then
  16868.        If Not FEnabled Then Result := Result Or WS_DISABLED;
  16869.  
  16870.      If ComponentState * [csAcceptsControls] <> []
  16871.      Then Result := Result Or WS_CLIPCHILDREN;
  16872.  
  16873.      If Designed Then Result := Result And Not WS_CLIPCHILDREN;
  16874. End;
  16875.  
  16876.  
  16877. Procedure TControl.CreateParams(Var Params:TCreateParams);
  16878. Begin
  16879.      FillChar(Params, SizeOf(Params), 0);
  16880.      Params.Style := GetWindowFlags;
  16881. End;
  16882.  
  16883.  
  16884. Function TControl.CreateCanvas:TCanvas;
  16885. Begin
  16886.      If FCanvas = Nil Then
  16887.      Begin
  16888.           FCanvas.Create(Self);
  16889.           FInitCanvas := True;
  16890.      End;
  16891.      If (Handle <> 0) And FInitCanvas Then
  16892.      Begin
  16893.           FCanvas.Init;
  16894.           FInitCanvas := False; {Init only 1 Time}
  16895.      End;
  16896.      Result := FCanvas;
  16897. End;
  16898.  
  16899.  
  16900. Procedure TControl.CreateWnd;
  16901. Var  OwnerHandle:LongWord;
  16902.      ParentHandle:LongWord;
  16903.      Params:TCreateParams;
  16904.      WindowFlags:LongWord;
  16905.      ClassData:TClassData;
  16906.      cCaption:Cstring;
  16907.      sCaption:String;
  16908.      aLeft,aBottom,aWidth,aHeight:LongInt;
  16909.      {$IFDEF Win32}
  16910.      ExtendedFlags:LongWord;
  16911.      OldWndProc:Pointer;
  16912.      rc,rc1:TRect;
  16913.      P:Integer;
  16914.      {$ENDIF}
  16915. Begin
  16916.      If Handle <> 0 Then Exit;
  16917.  
  16918.      FForm := GetParentForm(Self);
  16919.      If FForm <> Nil Then FForm.CreateUniqueWindowId(Self);
  16920.  
  16921.      FFirstShow := True;
  16922.  
  16923.      RegisterClass;
  16924.      GetClassData(ClassData);
  16925.  
  16926.      If FCaption = Nil Then sCaption := ' '
  16927.      Else sCaption := FCaption^;
  16928.  
  16929.      aLeft := FLeft;
  16930.      aBottom := FBottom;
  16931.      aWidth := FWidth;
  16932.      aHeight := FHeight;
  16933.  
  16934.      If Self Is TForm Then  {Create Frame Class}
  16935.      Begin
  16936.           If FFrame = Nil Then FFrame := TFrameControl.Create(Nil);
  16937.           If FCaption <> Nil Then FFrame.Caption := sCaption;     {!}
  16938.           FFrame.FParent:=FParent;
  16939.           FFrame.FModalParent:=FModalParent;
  16940.           FFrame.FForm:=TForm(Self);
  16941.           FFrame.FZOrder:=FZOrder;
  16942.           {FFrame.FFont:=FFont; wegen DBCSStatusLine}
  16943.           FFrame.SetDesigning(Designed);
  16944.           FFrame.FVisible:=FVisible;
  16945.           FFrame.FEnabled:=FEnabled;
  16946.           FFrame.FXAlign:=FXAlign;
  16947.           FFrame.FYAlign:=FYAlign;
  16948.           FFrame.FXStretch:=FXStretch;
  16949.           FFrame.FYStretch:=FYStretch;
  16950.           FFrame.SetWindowPos(aLeft,aBottom,aWidth,aHeight);
  16951.           FYAlign:=yaNone;
  16952.           FXAlign:=xaNone;
  16953.           FXStretch:=xsNone;
  16954.           FYStretch:=ysNone;
  16955.           TFrameControl(FFrame).FChild:=TForm(Self);
  16956.           FFrame.CreateWnd;
  16957.  
  16958.           FWindowId:=widClient; {!!!}
  16959.  
  16960.           {$IFDEF OS2}
  16961.           {shrink Size Of client because Of Frame}
  16962.           Dec(aWidth,TForm(Self).GetAddWidth);
  16963.           Dec(aHeight,TForm(Self).GetAddHeight);
  16964.           {$ENDIF}
  16965.           {$IFDEF Win32}
  16966.           WinUser.GetClientRect(FFrame.Handle,RECTL(rc1));
  16967.           rc:=FFrame.GetClientRect;
  16968.           aWidth:=rc.Right-rc.Left+1;
  16969.           aHeight:=rc.Top-rc.Bottom+1;
  16970.           aLeft:=rc.Left;
  16971.           aBottom:=((rc1.Top-rc1.Bottom)-aHeight)-rc.Bottom;
  16972.           {$ENDIF}
  16973.           ParentHandle:=FFrame.Handle;
  16974.           OwnerHandle:=ParentHandle;
  16975.      End
  16976.      Else
  16977.      Begin
  16978.           If Parent<>Nil Then ParentHandle:=Parent.Handle
  16979.           Else ParentHandle:=HWND_DESKTOP;
  16980.           If FModalParent<>Nil Then OwnerHandle:=FModalParent.Handle
  16981.           Else OwnerHandle:=ParentHandle;
  16982.           {$IFDEF Win32}
  16983.           If Parent<>Nil Then aBottom:=Parent.FHeight-aBottom-aHeight
  16984.           Else aBottom:=Screen.Height-aBottom-aHeight;
  16985.           {$ENDIF}
  16986.      End;
  16987.  
  16988.      CreateParams(Params);
  16989.  
  16990.      WindowFlags := Params.Style;
  16991.  
  16992.      {$IFDEF OS2}
  16993.      {probably STD Control - replace Mnemo Char}
  16994.      If Not FOwnerDraw Then cCaption := ReplaceMnemo(sCaption)
  16995.      Else cCaption := sCaption;
  16996.  
  16997.      If ClassData.ClassULong<>0
  16998.      Then FHandle:=WinCreateWCWindow(ParentHandle,
  16999.                                      ClassData.ClassULong,
  17000.                                      cCaption,       //Caption
  17001.                                      WindowFlags,    //flStyle
  17002.                                      aLeft,aBottom,
  17003.                                      aWidth,aHeight, //Position And Size
  17004.                                      OwnerHandle,    //Owner
  17005.                                      HWND_TOP,       //Insert behind
  17006.                                      FWindowId,
  17007.                                      Nil,            //CtlData
  17008.                                      Nil)            //Presparams
  17009.      Else FHandle:=WinCreateWindow(ParentHandle,     //Parent
  17010.                                    ClassData.ClassName,
  17011.                                    cCaption,       //Caption
  17012.                                    WindowFlags,    //flStyle
  17013.                                    aLeft,aBottom,
  17014.                                    aWidth,aHeight, //Position And Size
  17015.                                    OwnerHandle,    //Owner
  17016.                                    HWND_TOP,       //Insert behind
  17017.                                    FWindowId,
  17018.                                    Nil,            //CtlData
  17019.                                    Nil);           //Presparams
  17020.  
  17021.      {$ENDIF}
  17022.  
  17023.      {$IFDEF Win32}
  17024.      If ParentHandle <> HWND_DESKTOP Then WindowFlags := WindowFlags Or WS_CHILD;
  17025.  
  17026.      ExtendedFlags := Params.ExStyle;
  17027.  
  17028.      {probably STD Control - replace Mnemo Char}
  17029.      If Not FOwnerDraw Then cCaption := ReplaceMnemo(sCaption)
  17030.      Else cCaption := sCaption;
  17031.      sCaption:=cCaption;
  17032.      StrOemToAnsi(sCaption);
  17033.      cCaption:=sCaption;
  17034.  
  17035.      If ExtendedFlags=0
  17036.      Then FHandle:=CreateWindow(ClassData.ClassName,
  17037.                                 cCaption,
  17038.                                 WindowFlags,
  17039.                                 aLeft,aBottom,
  17040.                                 aWidth,aHeight,
  17041.                                 ParentHandle,
  17042.                                 FWindowId,
  17043.                                 DllModule,
  17044.                                 Nil)
  17045.      Else FHandle:=CreateWindowEx(ExtendedFlags,
  17046.                                   ClassData.ClassName,
  17047.                                   cCaption,
  17048.                                   WindowFlags,
  17049.                                   aLeft,aBottom,
  17050.                                   aWidth,aHeight,
  17051.                                   ParentHandle,
  17052.                                   FWindowId,
  17053.                                   DllModule,
  17054.                                   Nil);
  17055.      {$ENDIF}
  17056.  
  17057.      If FHandle = 0 Then CreateError;
  17058.  
  17059.      If FFont = Nil Then FFont := StandardFont(Self);
  17060.  
  17061.      If FOwnerDraw Or FInitCanvas Then FCanvas := CreateCanvas;
  17062.      UpdateFont; //!! wird In Canvas.SetFont nicht mehr verändert !!
  17063.  
  17064.      {$IFDEF Win32}
  17065.      If Not FOwnerDraw
  17066.      Then FCtlBrush:=CreateSolidBrush(RGBToWinColor(SysColorToRGB(color)));
  17067.      {$ENDIF}
  17068.  
  17069.      {$IFDEF OS2}
  17070.      WinSetWindowULong(Handle,QWL_USER,LongWord(Self));    {VMT Pointer}
  17071.      FDefWndProc:=Pointer(WinSubClassWindow(Handle,@SubclassedWndProc));
  17072.      {$ENDIF}
  17073.      {$IFDEF Win32}
  17074.      SetWindowLong(Handle,GWL_USERDATA,LongWord(Self));    {VMT Pointer}
  17075.      OldWndProc:=Pointer(SetWindowLong(Handle,GWL_WNDPROC,LongInt(@SubclassedWndProc)));
  17076.      If @FDefWndProc = Nil Then FDefWndProc := OldWndProc;   {WinNt !!!}
  17077.      {$ENDIF}
  17078.  
  17079.  
  17080.      CreateControls;
  17081.      FInitControls:=False;
  17082.  
  17083.      If (Not FEnabled) And (Not Designed) Then Disable;
  17084.      If (Not FVisible) And (Not Designed) Then Hide;
  17085.  
  17086.      {$IFDEF Win32}
  17087.      rc:=GetWindowRect;
  17088.      FLeft:=rc.Left;
  17089.      FBottom:=rc.Bottom;
  17090.      FWidth:=rc.Right-rc.Left +1;
  17091.      FHeight:=rc.Top-rc.Bottom +1;
  17092.      {$ENDIF}
  17093.  
  17094.      SetupShow;
  17095.      If OnSetupShow<>Nil Then OnSetupShow(Self);
  17096. End;
  17097.  
  17098.  
  17099. Procedure TControl.CreateError;
  17100. Begin
  17101.      ErrorBox2(LoadNLSStr(SCouldNotCreateWindow)+'. '+LoadNLSStr(SProgramAborted)+'.');
  17102.      Halt(253);
  17103. End;
  17104.  
  17105.  
  17106. Procedure TControl.CreateControls;
  17107. Var  T:LongInt;
  17108.      Control:TControl;
  17109. Begin
  17110.      If Not FInitControls Then Exit;
  17111.  
  17112.      For T := 0 To ControlCount-1 Do
  17113.      Begin
  17114.           Control := Controls[T];
  17115.           If Control.ComponentState * [csReference] = [] Then
  17116.           Begin
  17117.                Control.CreateWnd;
  17118.                {$IFDEF Win32}
  17119.                If Control.FVisible Or Control.Designed Then Control.Show;
  17120.                {$ENDIF}
  17121.           End;
  17122.      End;
  17123. End;
  17124.  
  17125.  
  17126. Procedure TControl.Hide;
  17127. Var  WHandle:LongWord;
  17128. Begin
  17129.      If Not Designed Then FVisible := False;
  17130.      If Handle = 0 Then Exit;
  17131.  
  17132.      If FOnHide <> Nil Then FOnHide(Self);
  17133.  
  17134.      If FFrame <> Nil Then WHandle := FFrame.Handle
  17135.      Else WHandle := Handle;
  17136.      {$IFDEF OS2}
  17137.      WinShowWindow(WHandle,False);
  17138.      {$ENDIF}
  17139.      {$IFDEF Win32}
  17140.      ShowWindow(WHandle,SW_HIDE);
  17141.      {$ENDIF}
  17142. End;
  17143.  
  17144.  
  17145. Procedure TControl.Show;
  17146. Var  T:LongInt;
  17147.      Control:TControl;
  17148.      WHandle:LongWord;
  17149.      {$IFDEF Win32}
  17150.      TempMsg:TMessage;
  17151.      {$ENDIF}
  17152. Begin
  17153.      If Handle = 0 Then CreateWnd;
  17154.      If Handle = 0 Then Exit;
  17155.  
  17156.      If FOnShow <> Nil Then FOnShow(Self);
  17157.  
  17158.      If Not Designed Then FVisible := True;
  17159.  
  17160.      If FFirstShow Then
  17161.      Begin
  17162.           FFirstShow := False;
  17163.  
  17164.           {Show Controls}
  17165.           For T := 0 To ControlCount-1 Do
  17166.           Begin
  17167.                Control := Controls[T];
  17168.                If Control.ComponentState * [csReference] = [] Then {!}
  17169.                  If Control.FVisible Or Control.Designed Then Control.Show;
  17170.           End;
  17171.  
  17172.           If FFrame <> Nil Then
  17173.           Begin
  17174.                {$IFDEF Win32}
  17175.                If Parent <> Nil
  17176.                Then SendMessage(GetTopWindow(Parent.Handle),WM_NCACTIVATE,0,0);
  17177.                {$ENDIF}
  17178.  
  17179.                Move;
  17180.                Resize;
  17181.                FFrame.Show;
  17182.  
  17183.                If Self Is TForm Then
  17184.                   TForm(Self).SetWindowState(TForm(Self).FWindowState);
  17185.  
  17186.                Update;
  17187.                FFrame.Update;
  17188.  
  17189.                {$IFDEF Win32}
  17190.                If Parent <> Nil Then SendMessage(FFrame.Handle,WM_NCACTIVATE,1,0);
  17191.                {$ENDIF}
  17192.  
  17193.                {$IFDEF OS2}
  17194.                WinShowWindow(Handle,True);
  17195.                {$ENDIF}
  17196.  
  17197.                {$IFDEF Win32}
  17198.                ShowWindow(Handle,SW_SHOW);
  17199.                {$ENDIF}
  17200.  
  17201.                Exit;
  17202.           End;
  17203.  
  17204.           SetWindowPos(FLeft,FBottom,FWidth,FHeight);
  17205.      End;
  17206.  
  17207.      If FFrame <> Nil Then WHandle := FFrame.Handle
  17208.      Else WHandle := Handle;
  17209.      {$IFDEF OS2}
  17210.      WinShowWindow(WHandle,True);
  17211.      {$ENDIF}
  17212.      {$IFDEF Win32}
  17213.      If ControlStyle*[csHintWindow]<>[] Then ShowWindow(WHandle,SW_SHOWNA)
  17214.      Else ShowWindow(WHandle,SW_SHOW);
  17215.      {$ENDIF}
  17216.  
  17217.      If Not (Self Is TFrameControl) Then Update;
  17218. End;
  17219.  
  17220.  
  17221. Function TControl.GetControlFromPoint(pt:TPoint):TControl;
  17222. Var  ahwnd:LongWord;
  17223. Begin
  17224.      Result := Nil;
  17225.      If Handle = 0 Then Exit;
  17226.      {$IFDEF OS2}
  17227.      ahwnd := WinWindowFromPoint(Handle,pt,True);
  17228.      {$ENDIF}
  17229.      {$IFDEF Win32}
  17230.      TransformClientPoint(pt,Self,Nil);
  17231.      ahwnd := ChildWindowFromPoint(Handle,POINTL(pt));
  17232.      {$ENDIF}
  17233.      Result := HandleToControl(ahwnd);
  17234. End;
  17235.  
  17236.  
  17237. Function TControl.GetWindowRect:TRect;
  17238. {$IFDEF OS2}
  17239. Var  aswp:SWP;
  17240. {$ENDIF}
  17241. Begin
  17242.      If (Handle = 0) {$IFDEF OS2} Or FFirstShow {$ENDIF} Then
  17243.      Begin                       {OS2: Window With 0 created}
  17244.           Result.Left := FLeft;
  17245.           Result.Bottom := FBottom;
  17246.           Result.Right := FLeft + FWidth -1;
  17247.           Result.Top := FBottom + FHeight -1;
  17248.           Exit;
  17249.      End;
  17250.  
  17251.      {$IFDEF OS2}
  17252.      If FFrame <> Nil Then
  17253.      Begin
  17254.           Result := FFrame.GetWindowRect;
  17255.           Exit;
  17256.      End;
  17257.  
  17258.      WinQueryWindowPos(Handle,aswp);
  17259.      Result.Left := aswp.X;
  17260.      Result.Right := Result.Left + aswp.CX -1;
  17261.      Result.Bottom := aswp.Y;
  17262.      Result.Top := aswp.Y + aswp.CY -1;
  17263.      {$ENDIF}
  17264.  
  17265.      {$IFDEF Win32}
  17266.      WinUser.GetWindowRect(Handle,RECTL(Result));
  17267.      If FParent <> Nil Then
  17268.      Begin
  17269.           MapWindowPoints(HWND_DESKTOP,FParent.Handle,
  17270.                           WinDef.Point(Result.Left),2);
  17271.      End;
  17272.      TransformRectToOS2(Result,FParent,Nil);
  17273.      Win32RectToRect(Result);
  17274.      Dec(Result.Right);
  17275.      Dec(Result.Top);
  17276.      {$ENDIF}
  17277. End;
  17278.  
  17279.  
  17280. Procedure TControl.SetWindowRect(Const rec:TRect);
  17281. Begin
  17282.      SetWindowPos(rec.Left,rec.Bottom,rec.Right-rec.Left+1,rec.Top-rec.Bottom+1);
  17283. End;
  17284.  
  17285.  
  17286. Function TControl.GetBoundsRect:TRect;
  17287. Begin
  17288.      Result.Left := Left;
  17289.      Result.Right := Left + Width -1;
  17290.      Result.Bottom := Top + Height -1;
  17291.      Result.Top := Top;
  17292. End;
  17293.  
  17294.  
  17295. Procedure TControl.SetBoundsRect(Const rec:TRect);
  17296. Begin
  17297.      SetBounds(rec.Left,rec.Top,rec.Right-rec.Left+1,rec.Bottom-rec.Top+1);
  17298. End;
  17299.  
  17300.  
  17301. Function TControl.GetClientRect:TRect;
  17302. Begin
  17303.      If (Handle = 0) {$IFDEF OS2} Or FFirstShow {$ENDIF} Then
  17304.      Begin                       {OS2: Window With 0 created}
  17305.           Result.Left := 0;
  17306.           Result.Bottom := 0;
  17307.           Result.Right := FWidth;
  17308.           Result.Top := FHeight;
  17309.      End
  17310.      Else
  17311.      Begin
  17312.           {$IFDEF OS2}
  17313.           WinQueryWindowRect(Handle,RECTL(Result));
  17314.           {$ENDIF}
  17315.           {$IFDEF Win32}
  17316.           WinUser.GetClientRect(Handle,RECTL(Result));
  17317.           {$ENDIF}
  17318.      End;
  17319.  
  17320.      Dec(Result.Right);
  17321.      Dec(Result.Top);
  17322. End;
  17323.  
  17324.  
  17325. Function TControl.GetClientWidth:LongInt;
  17326. Var  rc:TRect;
  17327. Begin
  17328.      rc := GetClientRect;
  17329.      Result := rc.Right - rc.Left +1;
  17330. End;
  17331.  
  17332.  
  17333. Function TControl.GetClientHeight:LongInt;
  17334. Var  rc:TRect;
  17335. Begin
  17336.      rc := GetClientRect;
  17337.      Result := rc.Top - rc.Bottom +1;
  17338. End;
  17339.  
  17340.  
  17341. Procedure TControl.SetClientWidth(NewWidth:LongInt);
  17342. Begin
  17343.      Width := NewWidth;     {no border In TControl}
  17344. End;
  17345.  
  17346.  
  17347. Procedure TControl.SetClientHeight(NewHeight:LongInt);
  17348. Begin
  17349.      Height := NewHeight;   {no border In TControl}
  17350. End;
  17351.  
  17352.  
  17353. Function TControl.GetClientOrigin:TPoint;
  17354. Begin
  17355.      If IsControl(Parent) Then Result := Parent.ClientOrigin
  17356.      Else Result := Point(0,0);
  17357.      Inc(Result.X, Left);
  17358.      Inc(Result.Y, Bottom);
  17359. End;
  17360.  
  17361.  
  17362. Function TControl.GetParentClientWidth:LongInt;
  17363. Begin
  17364.      Result := 0;
  17365.      If IsControl(Parent) Then Result := Parent.ClientWidth
  17366.      Else If Self Is TFrameControl Then Result := Screen.Width
  17367.      Else If (Self Is TForm) And (TForm(Self).FormStyle <> fsMDIChild)
  17368.           Then Result := Screen.Width;
  17369. End;
  17370.  
  17371.  
  17372. Function TControl.GetParentClientHeight:LongInt;
  17373. Begin
  17374.      Result := 0;
  17375.      If IsControl(Parent) Then Result := Parent.ClientHeight
  17376.      Else If Self Is TFrameControl Then Result := Screen.Height
  17377.      Else If (Self Is TForm) And (TForm(Self).FormStyle <> fsMDIChild)
  17378.           Then Result := Screen.Height;
  17379. End;
  17380.  
  17381.  
  17382. Function TControl.ClientToScreen(Const Point:TPoint):TPoint;
  17383. Var  Origin:TPoint;
  17384. Begin
  17385.      Origin := ClientOrigin;
  17386.      Result.X := Point.X + Origin.X;
  17387.      Result.Y := Point.Y + Origin.Y;
  17388. End;
  17389.  
  17390.  
  17391. Function TControl.ScreenToClient(Const Point:TPoint):TPoint;
  17392. Var  Origin:TPoint;
  17393. Begin
  17394.      Origin := ClientOrigin;
  17395.      Result.X := Point.X - Origin.X;
  17396.      Result.Y := Point.Y - Origin.Y;
  17397. End;
  17398.  
  17399.  
  17400. Procedure TControl.WndProc(Var Msg:TMessage);
  17401. Var  OldLastMsgAdr:PMessage;
  17402.      Handled:Boolean;
  17403. Begin
  17404.      If ((Application<>Nil)And(Application.FOnMsgEvent<>Nil)) Then
  17405.      Begin
  17406.           Handled:=False;
  17407.           Application.FOnMsgEvent(Msg,Handled);
  17408.           Msg.Handled:=Msg.Handled Or Handled;
  17409.      End;
  17410.  
  17411.      {$IFDEF OS2}
  17412.      If Msg.Receiver<>Handle Then exit;
  17413.      {$ENDIF}
  17414.  
  17415.      {Store Last LastMsgAdr To Handle nested calls}
  17416.      OldLastMsgAdr := FLastMsgAdr;
  17417.      {Store the address Of the Current Msg To be able To Set Handled & Result
  17418.      Parameter In Some Methods, where This Parameter Is Not available}
  17419.      FLastMsgAdr := @Msg;
  17420.  
  17421.      If not Msg.Handled Then Dispatch(Msg);     {send Messages To Object}
  17422.      If Not Msg.Handled Then DefaultHandler(Msg);
  17423.  
  17424.      {Reset Last LastMsgAdr To Handle nested calls}
  17425.      {$IFDEF OS2}
  17426.      If Msg.Msg <> CM_RELEASE Then
  17427.        If IsControl(Self) Then FLastMsgAdr := OldLastMsgAdr;
  17428.      {$ENDIF}
  17429.      {$IFDEF WIN32}
  17430.  
  17431.      If Screen<>Nil Then If Screen.FCanvas.FHandle<>0 Then
  17432.      Begin
  17433.           SelectObject(Screen.FCanvas.FHandle,GetStockObject(BLACK_PEN));
  17434.           SelectObject(Screen.FCanvas.FHandle,GetStockObject(WHITE_BRUSH));
  17435.           DeleteObject(Screen.FCanvas.FPenHandle);
  17436.           Screen.FCanvas.FPenHandle:=0;
  17437.           DeleteObject(Screen.FCanvas.FBrushHandle);
  17438.           Screen.FCanvas.FBrushHandle:=0;
  17439.           DeleteDC(Screen.FCanvas.FHandle);
  17440.           Screen.FCanvas.FHandle:=0;
  17441.      End;
  17442.  
  17443.      If Msg.Msg <> CM_RELEASE Then
  17444.       If Msg.Msg<>WM_CLOSE Then
  17445.         If Msg.Msg<>WM_NCLBUTTONDOWN Then
  17446.           If not ((Msg.Msg=WM_SYSCOMMAND)And(Msg.Param1=SC_CLOSE)) Then
  17447.      Begin
  17448.            Try
  17449.               If IsControl(Self) Then
  17450.               Begin
  17451.                    FLastMsgAdr := OldLastMsgAdr;
  17452.                    If FCanvas<>Nil Then
  17453.                    Begin
  17454.                         If FCanvas.FPenHandle<>0 Then
  17455.                         Begin
  17456.                             If FCanvas.FHandle<>0 Then
  17457.                               SelectObject(FCanvas.FHandle,GetStockObject(BLACK_PEN));
  17458.                             DeleteObject(FCanvas.FPenHandle);
  17459.                             FCanvas.FPenHandle:=0;
  17460.                         End;
  17461.                         If FCanvas.FBrushHandle<>0 Then
  17462.                         Begin
  17463.                              If FCanvas.FHandle<>0 Then
  17464.                                SelectObject(FCanvas.FHandle,GetStockObject(WHITE_BRUSH));
  17465.                              DeleteObject(FCanvas.FBrushHandle);
  17466.                              FCanvas.FBrushHandle:=0;
  17467.                         End;
  17468.                    End;
  17469.               End;
  17470.            Except
  17471.            End;
  17472.      End;
  17473.      {$ENDIF}
  17474. End;
  17475.  
  17476.  
  17477. Function TControl.GetLastMsg:TLastMsg;
  17478. Begin
  17479.      If FLastMsg = Nil Then
  17480.      Begin
  17481.           FLastMsg.Create;
  17482.           FLastMsg.FControl := Self;
  17483.      End;
  17484.      Result := FLastMsg;
  17485. End;
  17486.  
  17487.  
  17488. Procedure TControl.RecreateWnd;
  17489. Var  SaveOnSetupShow:TNotifyEvent;
  17490.      WasVisible:Boolean;
  17491. Begin
  17492.      If Handle <> 0 Then
  17493.      Begin
  17494.           SaveOnSetupShow := FOnSetupShow;
  17495.           FOnSetupShow := Nil;              {don't call it again}
  17496.  
  17497.           WasVisible := Visible;
  17498.           DestroyHandle;
  17499.           CreateWnd;
  17500.           If WasVisible Then Show;
  17501.  
  17502.           FOnSetupShow := SaveOnSetupShow;
  17503.      End;
  17504. End;
  17505.  
  17506.  
  17507. Procedure TControl.DisposeWnd;
  17508. Begin
  17509.      If Handle <> 0 Then
  17510.      Begin
  17511.           {$IFDEF OS2}
  17512.           WinSubClassWindow(Handle,@FDefWndProc);
  17513.           WinSetWindowULong(Handle,QWL_USER,0);
  17514.           {$ENDIF}
  17515.           {$IFDEF Win32}
  17516.           SetWindowLong(Handle,GWL_WNDPROC,LongInt(@FDefWndProc));
  17517.           SetWindowLong(Handle,GWL_USERDATA,0);
  17518.           {$ENDIF}
  17519.      End;
  17520.  
  17521.      If FCanvas <> Nil Then FCanvas.Destroy;
  17522.      FCanvas := Nil;
  17523.  
  17524.      If Application<>Nil Then
  17525.      Begin
  17526.        If Application.FHintOwner = Self Then Application.DestroyHintWindow;
  17527.  
  17528.        If Application.FHintControl = Self Then
  17529.        Begin
  17530.           If Application.FHintTimer <> Nil Then Application.FHintTimer.Destroy;
  17531.           Application.FHintTimer := Nil;
  17532.           Application.FHintControl := Nil;
  17533.           Application.FHintParent := Nil;
  17534.        End;
  17535.      End;
  17536.  
  17537.      {$IFDEF OS2}
  17538.      DereferenceFont(FFont);
  17539.      {$ENDIF}
  17540.      {$IFDEF Win32}
  17541.      If FDefFontHandle <> 0 Then
  17542.      Begin
  17543.           If FDefFontHandle = FFont.FHandle Then
  17544.           Begin
  17545.               If FFont.FRefCount > 1 Then Dec(FFont.FRefCount)
  17546.               Else
  17547.               Begin
  17548.                    If FDefFontHandle <> 0 Then DeleteObject(FDefFontHandle);
  17549.                    FFont.FRefCount := 0;
  17550.                    FFont.FHandle := 0;
  17551.               End;
  17552.           End
  17553.           Else
  17554.           If FDefFontHandle <> 0 Then DeleteObject(FDefFontHandle);
  17555.      End;
  17556.      FDefFontHandle := 0;
  17557.      If FFont<>Nil Then
  17558.      Begin
  17559.         If FFont.FUseCount>0 Then Dec(FFont.FUseCount);
  17560.         If ((FFont.FCustom)And(FFont.AutoDestroy)And(FFont.FUseCount=0)) Then FFont.Destroy;
  17561.      End;
  17562.  
  17563.      If FCtlBrush <> 0 Then DeleteObject(FCtlBrush);
  17564.      FCtlBrush := 0;
  17565.      {$ENDIF}
  17566. End;
  17567.  
  17568.  
  17569. Procedure TControl.DestroyWnd;
  17570. Begin
  17571.      AssignStr(FCaption, Caption);
  17572.  
  17573.      If FFrame <> Nil Then FFrame.DestroyWnd;
  17574.  
  17575.      If Handle <> 0 Then
  17576.      Begin
  17577.           {$IFDEF OS2}
  17578.           WinDestroyWindow(Handle);
  17579.           {$ENDIF}
  17580.           {$IFDEF Win32}
  17581.           DestroyWindow(Handle);
  17582.           {$ENDIF}
  17583.      End;
  17584.      FHandle := 0;
  17585.  
  17586.      FInitControls := True;       {For [re]CreateWnd}
  17587.      FLeft := Left;                 {Get Value from Frame}
  17588.      FBottom := Bottom;
  17589.      FWidth := Width;
  17590.      FHeight := Height;
  17591. End;
  17592.  
  17593.  
  17594. Procedure TControl.DestroyHandle;
  17595. Var  I:LongInt;
  17596.      Control:TControl;
  17597. Begin
  17598.      If FHandle = 0 Then Exit;
  17599.  
  17600.      Include(ControlState,csWindowDestroying);
  17601.  
  17602.      If Self Is TForm Then
  17603.      Begin
  17604.           Hide;
  17605.           Screen.Update;
  17606.           If DDEMan_CloseClientLinks<>Nil Then DDEMan_CloseClientLinks(TForm(Self));
  17607.      End;
  17608.  
  17609.      DisposeWnd;
  17610.      For I := 0 To ControlCount-1 Do     {WinControls}
  17611.      Begin
  17612.           Control := Controls[I];
  17613.           Control.DestroyHandle;
  17614.      End;
  17615.      DestroyWnd;
  17616.  
  17617.      Exclude(ControlState,csWindowDestroying);
  17618. End;
  17619.  
  17620.  
  17621. Destructor TControl.Destroy;
  17622. Begin
  17623.      Include(ComponentState,csDestroying);
  17624.  
  17625.      If FHasFocus Then
  17626.        If FForm <> Nil Then
  17627.          If FForm.ComponentState*[csDestroying]=[] Then FForm.CaptureFocus;
  17628.  
  17629.      {Destroys the Window}
  17630.      If Parent <> Nil Then SetParent(Nil)
  17631.      Else DestroyHandle;  {no phys. Parent -> only Destroy the Handle}
  17632.  
  17633.      DestroyControls; {Destroy All Child Controls}
  17634.  
  17635.      DisposeStr(FHint);
  17636.      FHint := Nil;
  17637.  
  17638.      DisposeStr(FCaption);
  17639.      FCaption := Nil;
  17640.  
  17641.      If FAutoScale <> Nil Then Dispose(FAutoScale);
  17642.      FAutoScale := Nil;
  17643.      If FAutoFrame <> Nil Then Dispose(FAutoFrame);
  17644.      FAutoFrame := Nil;
  17645.  
  17646.      If FForm Is TForm Then
  17647.        If FForm.FActiveControl = Self Then FForm.FActiveControl := Nil;
  17648.      If Screen.FActiveControl = Self Then Screen.FActiveControl := Nil;
  17649.  
  17650.      If FLastMsg <> Nil Then FLastMsg.Destroy;
  17651.      FLastMsg := Nil;
  17652.      If FAlternateFontName<>Nil Then DisposeStr(FAlternateFontName);
  17653.      FAlternateFontName:=Nil;
  17654.  
  17655.      Inherited Destroy;
  17656.  
  17657.      Screen.UpdateLastActive;
  17658. End;
  17659.  
  17660.  
  17661. Procedure TControl.DestroyControls;
  17662. Var  I:LongInt;
  17663.      Control:TControl;
  17664. Begin
  17665.      If FControls <> Nil Then
  17666.      Begin
  17667.           I := ControlCount;
  17668.           While I > 0 Do
  17669.           Begin
  17670.                Control := Controls[I-1];
  17671.                RemoveControl(Control);
  17672.                Control.Destroy;
  17673.                I := ControlCount;
  17674.           End;
  17675.      End;
  17676. End;
  17677.  
  17678.  
  17679. Procedure TControl.WMDestroy(Var Msg:TWMDestroy);
  17680. Begin
  17681.      DisposeWnd;
  17682.  
  17683.      FHandle := 0;
  17684.      Msg.Handled := True;
  17685.      Msg.Result := 0;
  17686. End;
  17687.  
  17688.  
  17689. {$IFDEF Win32}
  17690. Procedure TControl.WMNCDestroy(Var Msg:TMessage);
  17691. Begin
  17692.      FHandle := 0;
  17693.      Msg.Handled := True;
  17694.      Msg.Result := 0;
  17695. End;
  17696. {$ENDIF}
  17697.  
  17698.  
  17699. Procedure TControl.DefaultHandler(Var Msg:TMessage);
  17700. Begin
  17701.      If Handle = 0 Then Exit; {because Of Perform}
  17702.      If TMessage(Msg).ReceiverClass <> Self Then Exit; {don't call it For other handles!}
  17703.      If TMessage(Msg).Receiver <> Handle Then Exit; {don't call it For other handles!}
  17704.      {$IFDEF OS2}
  17705.      TMessage(Msg).Result := FDefWndProc(TMessage(Msg).Receiver,
  17706.                                          TMessage(Msg).Msg,
  17707.                                          TMessage(Msg).Param1,
  17708.                                          TMessage(Msg).Param2);
  17709.      {$ENDIF}
  17710.      {$IFDEF Win32}
  17711.      TMessage(Msg).Result := CallWindowProc(@FDefWndProc,TMessage(Msg).Receiver,
  17712.                                             TMessage(Msg).Msg,
  17713.                                             TMessage(Msg).Param1,
  17714.                                             TMessage(Msg).Param2);
  17715.      {$ENDIF}
  17716.      If TMessage(Msg).Msg <> WM_COMMAND Then TMessage(Msg).Handled := True; {!!}
  17717. End;
  17718.  
  17719.  
  17720. Procedure TControl.RealignControls;
  17721. Var  Control:TControl;
  17722.      T:LongInt;
  17723. Begin
  17724.      {Align Controls again}
  17725.      For T := 0 To ControlCount-1 Do
  17726.      Begin
  17727.           Control := Controls[T];
  17728.           {$IFDEF OS2}
  17729.           If (Control.XAlign In [xaParent,xaLeft,xaRight,xaCenter]) Or
  17730.              (Control.YAlign In [yaParent,yaBottom,yaTop,yaCenter]) Or
  17731.              (Control.XStretch In [xsParent,xsFrame,xsScale]) Or
  17732.              (Control.YStretch In [ysParent,ysFrame,ysScale]) Or
  17733.              (Control.FIsToolBar) Then
  17734.           Begin
  17735.                Control.SetWindowPos(Control.Left,Control.Bottom,
  17736.                                     Control.Width,Control.Height);
  17737.           End;
  17738.           {$ENDIF}
  17739.           {$IFDEF WIN32}
  17740.           Control.SetWindowPos(Control.Left,Control.Bottom,
  17741.                                Control.Width,Control.Height);
  17742.           {$ENDIF}
  17743.      End;
  17744. End;
  17745.  
  17746.  
  17747. Procedure TControl.SetLeft(NewLeft:LongInt);
  17748. Begin
  17749.      If FFrame = Nil Then
  17750.      Begin
  17751.           If csReading In ComponentState Then FLeft := NewLeft
  17752.           Else SetWindowPos(NewLeft,Bottom,Width,Height);
  17753.      End
  17754.      Else FFrame.SetLeft(NewLeft);
  17755. End;
  17756.  
  17757.  
  17758. Function TControl.GetLeft:LongInt;
  17759. Begin
  17760.      If FFrame = Nil Then Result := FLeft
  17761.      Else Result := FFrame.GetLeft;
  17762. End;
  17763.  
  17764.  
  17765. Procedure TControl.SetBottom(NewBottom:LongInt);
  17766. Begin
  17767.      If FFrame = Nil Then
  17768.      Begin
  17769.           If csReading In ComponentState Then FBottom := NewBottom
  17770.           Else SetWindowPos(Left,NewBottom,Width,Height);
  17771.      End
  17772.      Else FFrame.SetBottom(NewBottom);
  17773. End;
  17774.  
  17775.  
  17776. Function TControl.GetBottom:LongInt;
  17777. Begin
  17778.      If FFrame = Nil Then Result := FBottom
  17779.      Else Result := FFrame.GetBottom;
  17780. End;
  17781.  
  17782.  
  17783. Procedure TControl.SetWidth(NewWidth:LongInt);
  17784. Begin
  17785.      If FFrame = Nil Then
  17786.      Begin
  17787.           If csReading In ComponentState Then FWidth := NewWidth
  17788.           Else SetWindowPos(Left,Bottom,NewWidth,Height);
  17789.      End
  17790.      Else FFrame.SetWidth(NewWidth);
  17791. End;
  17792.  
  17793.  
  17794. Function TControl.GetWidth:LongInt;
  17795. Begin
  17796.      If FFrame = Nil Then Result := FWidth
  17797.      Else Result := FFrame.GetWidth;
  17798. End;
  17799.  
  17800.  
  17801. Procedure TControl.SetHeight(NewHeight:LongInt);
  17802. Begin
  17803.      If FFrame = Nil Then
  17804.      Begin
  17805.           If csReading In ComponentState Then FHeight := NewHeight
  17806.           Else SetWindowPos(Left,Bottom,Width,NewHeight);
  17807.      End
  17808.      Else FFrame.SetHeight(NewHeight);
  17809. End;
  17810.  
  17811.  
  17812. Function TControl.GetHeight:LongInt;
  17813. Begin
  17814.      If FFrame = Nil Then Result := FHeight
  17815.      Else Result := FFrame.GetHeight;
  17816. End;
  17817.  
  17818.  
  17819. Procedure TControl.SetRight(NewRight:LongInt);
  17820. Var  _Width:LongInt;
  17821. Begin
  17822.      If FFrame = Nil Then
  17823.      Begin
  17824.           _Width := GetParentClientWidth;
  17825.           SetWindowPos(_Width-Width-NewRight,Bottom,Width,Height);
  17826.      End
  17827.      Else FFrame.SetRight(NewRight);
  17828. End;
  17829.  
  17830.  
  17831. Function TControl.GetRight:LongInt;
  17832. Var  _Width:LongInt;
  17833. Begin
  17834.      If FFrame = Nil Then
  17835.      Begin
  17836.           _Width := GetParentClientWidth;
  17837.           Result := _Width - FLeft - FWidth;
  17838.      End
  17839.      Else Result := FFrame.GetRight;
  17840. End;
  17841.  
  17842.  
  17843. Procedure TControl.SetTop(NewTop:LongInt);
  17844. Begin
  17845.      If FFrame = Nil Then
  17846.      Begin
  17847.           SetBounds(Left,NewTop,Width,Height);
  17848.      End
  17849.      Else FFrame.SetTop(NewTop);
  17850. End;
  17851.  
  17852.  
  17853. Function TControl.GetTop:LongInt;
  17854. Var  _Height:LongInt;
  17855. Begin
  17856.      If FFrame = Nil Then
  17857.      Begin
  17858.           _Height := GetParentClientHeight;
  17859.           Result := _Height - FBottom - FHeight;
  17860.      End
  17861.      Else Result := FFrame.GetTop;
  17862. End;
  17863.  
  17864.  
  17865. Procedure TControl.SetBounds(NewLeft,NewTop,NewWidth,NewHeight:LongInt);
  17866. Var  NewBottom:LongInt;
  17867. Begin
  17868.      If FFrame = Nil Then
  17869.      Begin
  17870.           NewBottom := GetParentClientHeight - NewHeight - NewTop;
  17871.           SetWindowPos(NewLeft,NewBottom,NewWidth,NewHeight);
  17872.      End
  17873.      Else FFrame.SetBounds(NewLeft,NewTop,NewWidth,NewHeight);
  17874. End;
  17875.  
  17876.  
  17877. Procedure TControl.SetWindowPos(NewLeft,NewBottom,NewWidth,NewHeight:LongInt);
  17878. Var  rc:TRect;
  17879.      cw,CH:LongInt;
  17880.      oldwidth,oldheight:LongInt;
  17881. Begin
  17882.      oldwidth := FWidth;
  17883.      oldheight := FHeight;
  17884.  
  17885.      Case FXStretch Of
  17886.        xsParent:
  17887.        Begin
  17888.             NewWidth := GetParentClientWidth;
  17889.        End;
  17890.        xsFrame:
  17891.        Begin {only relevant from A Parent WMSize call}
  17892.             If FAutoFrame <> Nil Then
  17893.             Begin
  17894.                  NewLeft := FAutoFrame^.Left;
  17895.                  NewWidth := GetParentClientWidth
  17896.                              - FAutoFrame^.Right - NewLeft;
  17897.             End;
  17898.        End;
  17899.        xsScale:
  17900.        Begin {only relevant from A Parent WMSize call}
  17901.             If FAutoScale <> Nil Then
  17902.             Begin
  17903.                  cw := GetParentClientWidth;
  17904.                  NewLeft := FAutoScale^.Left * cw;
  17905.                  NewWidth := FAutoScale^.Right * cw - NewLeft;
  17906.             End;
  17907.        End;
  17908.        xsFixed:
  17909.        Begin
  17910.             If Handle <> 0 Then NewWidth := Width;
  17911.        End;
  17912.      End;
  17913.  
  17914.      Case FYStretch Of
  17915.        ysParent:
  17916.        Begin
  17917.             NewHeight := GetParentClientHeight;
  17918.        End;
  17919.        ysFrame:
  17920.        Begin {only relevant from A Parent WMSize call}
  17921.             If FAutoFrame <> Nil Then
  17922.             Begin
  17923.                  NewBottom := FAutoFrame^.Bottom;
  17924.                  NewHeight := GetParentClientHeight
  17925.                               - FAutoFrame^.Top - NewBottom;
  17926.             End;
  17927.        End;
  17928.        ysScale:
  17929.        Begin {only relevant from A Parent WMSize call}
  17930.             If FAutoScale <> Nil Then
  17931.             Begin
  17932.                  CH := GetParentClientHeight;
  17933.                  NewBottom := FAutoScale^.Bottom * CH;
  17934.                  NewHeight := FAutoScale^.Top * CH - NewBottom;
  17935.             End;
  17936.        End;
  17937.        ysFixed:
  17938.        Begin
  17939.             If Handle <> 0 Then NewHeight := Height;
  17940.        End;
  17941.      End;
  17942.  
  17943.      Case FXAlign Of
  17944.        xaParent:
  17945.        Begin
  17946.             If Parent <> Nil Then
  17947.             Begin
  17948.                  rc := Parent.ClientRect;
  17949.                  NewLeft := rc.Left;
  17950.             End
  17951.             Else NewLeft := 0;
  17952.        End;
  17953.        xaLeft:
  17954.        Begin
  17955.             NewLeft := Left;
  17956.        End;
  17957.        xaRight:
  17958.        Begin
  17959.             If FAutoFrame <> Nil Then
  17960.             Begin
  17961.                  cw := GetParentClientWidth;
  17962.                  NewLeft := cw - FAutoFrame^.Right - NewWidth;
  17963.             End;
  17964.        End;
  17965.        xaCenter:
  17966.        Begin
  17967.             If Parent <> Nil Then
  17968.             Begin
  17969.                  rc := Parent.GetClientRect;
  17970.                  NewLeft := rc.Left+(rc.Right+1-rc.Left-NewWidth) Div 2;
  17971.             End
  17972.             Else NewLeft := (Screen.Width-NewWidth) Div 2;
  17973.        End;
  17974.      End;
  17975.  
  17976.      Case FYAlign Of
  17977.        yaParent:
  17978.        Begin
  17979.             If Parent <> Nil Then
  17980.             Begin
  17981.                  rc := Parent.ClientRect;
  17982.                  NewBottom := rc.Bottom;
  17983.             End
  17984.             Else NewBottom := 0;
  17985.        End;
  17986.        yaBottom:
  17987.        Begin
  17988.             NewBottom := Bottom;
  17989.        End;
  17990.        yaTop:
  17991.        Begin
  17992.             If FAutoFrame <> Nil Then
  17993.             Begin
  17994.                  CH := GetParentClientHeight;
  17995.                  NewBottom := CH - FAutoFrame^.Top - NewHeight;
  17996.             End;
  17997.        End;
  17998.        yaCenter:
  17999.        Begin
  18000.             If Parent <> Nil Then
  18001.             Begin
  18002.                  rc := Parent.GetClientRect;
  18003.                  NewBottom := rc.Bottom+(rc.Top+1-rc.Bottom-NewHeight) Div 2;
  18004.             End
  18005.             Else NewBottom := (Screen.Height-NewHeight) Div 2;
  18006.        End;
  18007.      End;
  18008.  
  18009.      FLeft := NewLeft;
  18010.      FBottom := NewBottom;
  18011.      FWidth := NewWidth;
  18012.      FHeight := NewHeight;
  18013.  
  18014.      If DesignerState * [dsNoRealSizing] <> [] Then Exit;
  18015.  
  18016.      If Handle <> 0 Then UpdateWindowPos(FLeft,FBottom,FWidth,FHeight);
  18017.  
  18018.      If Not (Self Is TForm) Then
  18019.      Begin
  18020.           If IsStandardControl Then
  18021.             If (oldwidth <> FWidth) Or (oldheight <> FHeight) Or Designed
  18022.             Then Resize; {because Of no WMSize}
  18023.      End;
  18024.  
  18025.  
  18026.      If Parent Is TScrollingWinControl Then
  18027.      Begin
  18028.           TScrollingwinControl(Parent).AdjustScrollbars;
  18029.           TScrollingwinControl(Parent).AlignScrollbars;
  18030.      End;
  18031. End;
  18032.  
  18033.  
  18034. {assume the Parameters are Dialog coordinates, transform it}
  18035. {Test only}
  18036. Procedure TransformToDialog(Var Left,Bottom,Width,Height:LongInt);
  18037. Var  DLGAspectX,DLGAspectY:Extended;
  18038.      CX:LongInt;
  18039. Begin
  18040.      CX := Screen.SystemMetrics(smCxScreen);
  18041.  
  18042.      If (CX = 640) Or (CX = 800) Then
  18043.      Begin
  18044.           {640x480 & 800x600}
  18045.           DLGAspectX := 1.5;
  18046.           DLGAspectY := 2;
  18047.      End
  18048.      Else
  18049.      Begin
  18050.           {1024x768 & 1280x1024}
  18051.           DLGAspectX := 2;
  18052.           DLGAspectY := 2.5;
  18053.      End;
  18054.  
  18055.      Left := Left * DLGAspectX;
  18056.      Bottom := Bottom * DLGAspectY;
  18057.      Width := Width * DLGAspectX;
  18058.      Height := Height * DLGAspectY;
  18059. End;
  18060.  
  18061.  
  18062. Procedure TControl.UpdateWindowPos(NewLeft,NewBottom,NewWidth,NewHeight:LongInt);
  18063. Var  Flags:LongInt;
  18064.      ZWin:HWND;
  18065.      {$IFDEF Win32}
  18066.      rc,rc1:TRect;
  18067.      NewTop:LongInt;
  18068.      {$ENDIF}
  18069. Begin
  18070.      ZWin := 0;
  18071.      Flags := 0;
  18072. (* Change
  18073.      If FForm Is TForm Then
  18074.        If FForm.FInternalId = iiDialog
  18075.        Then TransformToDialog(_Left,_Bottom,_Width,_Height);
  18076. *)
  18077.      {$IFDEF OS2}
  18078.      If Visible Then Flags := Flags Or SWP_SHOW;
  18079.      {Show flag nur setzen, wenn das Fenster schon sichtbar ist}
  18080.      Case FZOrder Of
  18081.        zoBottom: ZWin := HWND_BOTTOM;
  18082.        zoTop:    ZWin := HWND_TOP;
  18083.      End;
  18084.      If FZOrder <> zoNone Then Flags := Flags Or SWP_ZORDER;
  18085.  
  18086.      Flags := Flags Or SWP_SIZE Or SWP_MOVE;
  18087.  
  18088.      WinSetWindowPos(Handle,ZWin,NewLeft,NewBottom,NewWidth,NewHeight,Flags);
  18089.      {$ENDIF}
  18090.  
  18091.      {$IFDEF Win32}
  18092.      If Parent <> Nil Then
  18093.      Begin
  18094.           NewTop := Parent.FHeight - FBottom - FHeight;
  18095.           If Parent Is TFrameControl Then
  18096.           Begin
  18097.                // the origin of the frame is equal to the client origin of the form
  18098.                Dec(NewTop, Screen.SystemMetrics(smCyTitlebar));
  18099.                Dec(NewTop, GetBorderHeight(FForm));
  18100.                Dec(NewLeft, GetBorderWidth(FForm));
  18101.                {???}
  18102.                Dec(NewTop, GetBorderHeight(FForm));
  18103.           End;
  18104.      End
  18105.      Else NewTop := Screen.Height - FBottom - FHeight;
  18106.      If ControlStyle*[csHintWindow]<>[] Then Flags:=Flags Or SWP_NOACTIVATE;
  18107.      If Visible Then Flags := Flags Or SWP_SHOWWINDOW;
  18108.  
  18109.      Case FZOrder Of
  18110.        zoNone:   Flags := Flags Or SWP_NOZORDER;
  18111.        zoBottom: ZWin := HWND_BOTTOM;
  18112.        zoTop:    ZWin := HWND_TOP;
  18113.      End;
  18114.  
  18115.      WinUser.SetWindowPos(Handle,ZWin,NewLeft,NewTop,NewWidth,NewHeight,Flags);
  18116.  
  18117.      If Self Is TFrameControl Then
  18118.        If TFrameControl(Self).FChild <> Nil Then
  18119.      Begin
  18120.           WinUser.GetClientRect(Handle,RECTL(rc1));
  18121.           rc := GetClientRect;
  18122.           NewWidth := rc.Right-rc.Left +1;
  18123.           NewHeight := rc.Top-rc.Bottom +1;
  18124.           NewLeft := rc.Left;
  18125.           NewTop := ((rc1.Top-rc1.Bottom)-NewHeight)-rc.Bottom;
  18126.           Flags := 0;
  18127.           ZWin := 0;
  18128.           If TFrameControl(Self).FChild.Visible
  18129.           Then Flags := Flags Or SWP_SHOWWINDOW;
  18130.           Case FZOrder Of
  18131.             zoNone:   Flags := Flags Or SWP_NOZORDER;
  18132.             zoBottom: ZWin := HWND_BOTTOM;
  18133.             zoTop:    ZWin := HWND_TOP;
  18134.           End;
  18135.  
  18136.           WinUser.SetWindowPos(TFrameControl(Self).FChild.Handle,ZWin,
  18137.                                NewLeft,NewTop,NewWidth,NewHeight, Flags);
  18138.      End;
  18139.      {$ENDIF}
  18140. End;
  18141.  
  18142.  
  18143. Procedure TControl.SetupShow;
  18144. Begin
  18145.      {$IFDEF OS2}
  18146.      SetPPForeGroundColor(FPenColor);
  18147.      SetPPBackGroundColor(FColor);
  18148.      {$ENDIF}
  18149. End;
  18150.  
  18151.  
  18152. Procedure TControl.BringToFront;
  18153. Var  Win:LongWord;
  18154.      Flags:LongWord;
  18155. Begin
  18156.      If IsControlLocked(Self) Then Exit;
  18157.  
  18158.      If FFrame <> Nil Then Win := FFrame.Handle
  18159.      Else Win := Handle;
  18160.      {$IFDEF OS2}
  18161.      If Visible Then Flags := SWP_SHOW
  18162.      Else Flags := 0;
  18163.      WinSetWindowPos(Win,HWND_TOP,0,0,0,0,
  18164.                      Flags Or SWP_ZORDER {Or SWP_ACTIVATE});
  18165.      {$ENDIF}
  18166.      {$IFDEF Win32}
  18167.      If Visible Then Flags := SWP_SHOWWINDOW
  18168.      Else Flags := 0;
  18169.      WinUser.SetWindowPos(Win,HWND_TOP,0,0,0,0,
  18170.                           Flags Or SWP_NOMOVE Or SWP_NOSIZE);
  18171.      {$ENDIF}
  18172. End;
  18173.  
  18174.  
  18175. Procedure TControl.SendToBack;
  18176. Var  Win:LongWord;
  18177.      Flags:LongWord;
  18178. Begin
  18179.      If IsControlLocked(Self) Then Exit;
  18180.  
  18181.      If FFrame <> Nil Then Win := FFrame.Handle
  18182.      Else Win := Handle;
  18183.      {$IFDEF OS2}
  18184.      If Visible Then Flags := SWP_SHOW
  18185.      Else Flags := 0;
  18186.      WinSetWindowPos(Win,HWND_BOTTOM,0,0,0,0,
  18187.                      Flags Or SWP_ZORDER {Or SWP_ACTIVATE});
  18188.      {$ENDIF}
  18189.      {$IFDEF Win32}
  18190.      If Visible Then Flags := SWP_SHOWWINDOW
  18191.      Else Flags := 0;
  18192.      WinUser.SetWindowPos(Win,HWND_BOTTOM,0,0,0,0,
  18193.                           Flags Or SWP_NOMOVE Or SWP_NOSIZE);
  18194.      {$ENDIF}
  18195. End;
  18196.  
  18197.  
  18198. Procedure TControl.KillFocus;
  18199. Begin
  18200.      FHasFocus := False;
  18201.      If OnExit <> Nil Then OnExit(Self);
  18202. End;
  18203.  
  18204.  
  18205. Procedure TControl.SetFocus;
  18206. Begin
  18207.      If FForm Is TForm Then FForm.FActiveControl := Self;
  18208.      Screen.FActiveControl := Self;
  18209.  
  18210.      FHasFocus := True;
  18211.      If OnEnter <> Nil Then OnEnter(Self);
  18212.  
  18213.      Screen.UpdateLastActive;
  18214. End;
  18215.  
  18216.  
  18217. {$IFDEF Win32}
  18218. Procedure TControl.WMKillFocus(Var Msg:TMessage);
  18219. Begin
  18220.      If IsStandardControl Then DefaultHandler(Msg);
  18221.  
  18222.      If Not Designed Or (Self Is TForm) Then Msg.Handled := True;
  18223.  
  18224.      If Application <> Nil Then Application.FHasFocus := FALSE;
  18225.  
  18226.      KillFocus;
  18227.  
  18228.      If (Self Is TFrameControl) And (TFrameControl(Self).FChild <> Nil) Then
  18229.      Begin
  18230.           TFrameControl(Self).FChild.KillFocus;
  18231.      End;
  18232. End;
  18233.  
  18234.  
  18235. Procedure TControl.WMSetFocus(Var Msg:TWMSetFocus);
  18236. Begin
  18237.      If IsStandardControl Then DefaultHandler(Msg);
  18238.  
  18239.      If (Not Designed) Or (Self Is TForm) Then Msg.Handled := True;
  18240.  
  18241.      If Application <> Nil Then Application.FHasFocus := TRUE;
  18242.  
  18243.      SetFocus;
  18244.  
  18245.      If (Self Is TFrameControl) And (TFrameControl(Self).FChild <> Nil) Then
  18246.      Begin
  18247.           TFrameControl(Self).FChild.SetFocus;
  18248.      End;
  18249. End;
  18250. {$ENDIF}
  18251.  
  18252.  
  18253. {$IFDEF OS2}
  18254. Procedure TControl.WMSetFocus(Var Msg:TWMSetFocus);
  18255. Begin
  18256.      If IsStandardControl Then DefaultHandler(TMessage(Msg));
  18257.  
  18258.      If Msg.Focus=False Then {Window Is loosing Focus}
  18259.      Begin
  18260.           If Application <> Nil Then Application.FHasFocus := FALSE;
  18261.  
  18262.           KillFocus;
  18263.  
  18264.           If (Self Is TFrameControl) And (TFrameControl(Self).FChild <> Nil) Then
  18265.           Begin
  18266.                TFrameControl(Self).FChild.KillFocus;
  18267.           End;
  18268.      End
  18269.      Else  {Window Is getting Focus}
  18270.      Begin
  18271.           If Application <> Nil Then Application.FHasFocus := TRUE;
  18272.  
  18273.           SetFocus;
  18274.  
  18275.           If (Self Is TFrameControl) And (TFrameControl(Self).FChild <> Nil) Then
  18276.           Begin
  18277.                TFrameControl(Self).FChild.SetFocus;
  18278.           End;
  18279.      End;
  18280.      Msg.Handled := True;
  18281. End;
  18282. {$ENDIF}
  18283.  
  18284.  
  18285. Procedure TControl.Paint(Const rec:TRect);
  18286. Begin
  18287.      If FCanvas<>Nil Then FCanvas.ClipRect := rec;
  18288.      If OnBeforePaint<>Nil Then OnBeforePaint(Self,rec);
  18289.  
  18290.      If OnPaint <> Nil Then OnPaint(Self,rec)
  18291.      Else Redraw(rec);
  18292.  
  18293.      If OnAfterPaint<>Nil Then OnAfterPaint(Self,rec);
  18294.      If FCanvas<>Nil Then If FCanvas.ClipRect = rec Then FCanvas.DeleteClipRegion;
  18295. End;
  18296.  
  18297.  
  18298. Procedure TControl.SetUpdateEnabled(Value:Boolean);
  18299. Begin
  18300.      FUpdateEnabled := Value;
  18301.      If Handle = 0 Then Exit;
  18302.      If FUpdateEnabled Then
  18303.      Begin
  18304.           {$IFDEF OS2}
  18305.           WinLockWindowUpdate(HWND_DESKTOP,0);
  18306.           {$ENDIF}
  18307.           {$IFDEF Win32}
  18308.           WinUser.LockWindowUpdate(0);
  18309.           {$ENDIF}
  18310.           Invalidate;
  18311.      End
  18312.      Else
  18313.      Begin
  18314.           {$IFDEF OS2}
  18315.           WinLockWindowUpdate(HWND_DESKTOP,Handle);
  18316.           {$ENDIF}
  18317.           {$IFDEF Win32}
  18318.           WinUser.LockWindowUpdate(Handle);
  18319.           {$ENDIF}
  18320.      End;
  18321. End;
  18322.  
  18323.  
  18324. Function TControl.GetDesignerCoordinates(Var pt:TPoint):TControl;
  18325. Begin
  18326.      Result := Self;
  18327.      While (Result.Designed) And (Result.Parent <> Nil) Do
  18328.      Begin
  18329.           Inc(pt.X, Result.Left);
  18330.           Inc(pt.Y, Result.Bottom);
  18331.           Result := Result.Parent;
  18332.      End;
  18333. End;
  18334.  
  18335.  
  18336. Procedure TControl.DesignerNotification(Var DNS:TDesignerNotifyStruct);
  18337. Var  AForm:TForm;
  18338. Begin
  18339.      AForm := TForm(Parent);
  18340.      If AForm <> Nil Then
  18341.      Begin
  18342.           While (AForm.Designed) And (AForm.Parent <> Nil) Do
  18343.           Begin
  18344.                AForm := TForm(AForm.Parent);
  18345.           End;
  18346.      End;
  18347.      If AForm <> Nil Then AForm.DesignerNotification(DNS);
  18348. End;
  18349.  
  18350.  
  18351. Procedure TControl.WMPaint(Var Msg:TMessage);
  18352. Var  rec:TRect;
  18353.      relpt:TPoint;
  18354.      Control:TControl;
  18355.      DNS:TDesignerNotifyStruct;
  18356.      {$IFDEF OS2}
  18357.      FHPS:HPS;
  18358.      {$ENDIF}
  18359.      {$IFDEF Win32}
  18360.      FPS:PAINTSTRUCT;
  18361.      {$ENDIF}
  18362. Begin
  18363.      If Not IsWindowVisible Then Exit;
  18364.  
  18365.      If FOwnerDraw Then
  18366.        If FCanvas = Nil Then Exit;
  18367.  
  18368.      If Not FUpdateEnabled Then
  18369.      Begin
  18370.           Msg.Handled := True;
  18371.           Msg.Result := 0;
  18372.           Exit;
  18373.      End;
  18374.  
  18375.      If FOwnerDraw Then
  18376.      Begin
  18377.           {$IFDEF OS2}
  18378.           FHPS := WinBeginPaint(Handle,0,RECTL(rec));
  18379.           {$ENDIF}
  18380.           {$IFDEF Win32}
  18381.           BeginPaint(Msg.Receiver,FPS);
  18382.           rec := TRect(FPS.rcPaint);
  18383.           rec:=ClientRect;
  18384.           Win32RectToRect(rec);
  18385.           TransformRectToOS2(rec,Self,Nil);   {TransformClientRect?}
  18386.           Dec(rec.Bottom);
  18387.           Inc(rec.Top);
  18388.           {$ENDIF}
  18389.  
  18390.           If (rec.Top > rec.Bottom) Or (rec.Right > rec.Left) Then
  18391.           Begin
  18392.                Paint(rec);
  18393.                {$IFDEF Win32}
  18394.                FCanvas.DeleteClipRegion; {because FPS.rcPaint will be clipped}
  18395.                {$ENDIF}
  18396.           End;
  18397.  
  18398.           {$IFDEF OS2}
  18399.           WinEndPaint(FHPS);
  18400.           {$ENDIF}
  18401.           {$IFDEF Win32}
  18402.           EndPaint(Msg.Receiver,FPS);
  18403.           {$ENDIF}
  18404.      End
  18405.      Else
  18406.      Begin
  18407.           DefaultHandler(Msg);       {Do Default Action}
  18408.           rec := TControl.GetClientRect;
  18409.      End;
  18410.  
  18411.      If Designed Then
  18412.      Begin
  18413.           relpt.X := 0;
  18414.           relpt.Y := 0;
  18415.           Control := GetDesignerCoordinates(relpt);
  18416.           If Control <> Nil Then
  18417.           Begin
  18418.                Inc(rec.Left,relpt.X);
  18419.                Inc(rec.Right,relpt.X);
  18420.                Inc(rec.Bottom,relpt.Y);
  18421.                Inc(rec.Top,relpt.Y);
  18422.  
  18423.                DNS.Sender := Self;
  18424.                DNS.Code := dncPaint;
  18425.                DNS.return := 0;
  18426.                DNS.rec := rec;
  18427.                Control.DesignerNotification(DNS);
  18428.           End;
  18429.      End;
  18430.  
  18431.      Msg.Handled := True;
  18432.      Msg.Result := 0;
  18433. End;
  18434.  
  18435.  
  18436. Procedure TControl.SetPopupMenu(NewMenu:TPopupMenu);
  18437. Begin
  18438.      If NewMenu=FPopupMenu Then Exit;
  18439.  
  18440.      If FPopupMenu<>Nil Then FPopupMenu.Notification(Self,opRemove);
  18441.      FPopupMenu := NewMenu;
  18442.      If FPopupMenu <> Nil Then FPopupMenu.FreeNotification(Self);
  18443. End;
  18444.  
  18445.  
  18446. Procedure TControl.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
  18447. Var  Control:TControl;
  18448. Begin
  18449.      If FForm <> Nil Then FForm.BringToFront;
  18450.      If Button=mbLeft Then Include(ControlState,csLButtonDown);
  18451.  
  18452.      Control := Self;
  18453.      While True Do
  18454.      Begin
  18455.           If (Control.FOnMouseDown = Nil) And
  18456.              (Control.ComponentState * [csDetail] <> []) Then
  18457.           Begin
  18458.                Control := Control.Parent;
  18459.                If Control = Nil Then Exit;
  18460.                Inc(X, Control.Left);
  18461.                Inc(Y, Control.Bottom);
  18462.           End
  18463.           Else break;
  18464.      End;
  18465.  
  18466.      If Control.FOnMouseDown <> Nil
  18467.      Then Control.FOnMouseDown(Control,Button,ShiftState,X,Y);
  18468. End;
  18469.  
  18470.  
  18471. Procedure TControl.MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInT);
  18472. Var  Control:TControl;
  18473. Begin
  18474.      If Button = mbRight Then
  18475.        If Not Designed Then CheckMenuPopup(Point(X,Y));
  18476.  
  18477.      Control := Self;
  18478.      If Button=mbLeft Then
  18479.      Begin
  18480.           Exclude(ControlState,csLButtonDown);
  18481.           Exclude(ControlState,csClicked);
  18482.      End;
  18483.  
  18484.      While True Do
  18485.      Begin
  18486.           If (Control.FOnMouseUp = Nil) And
  18487.              (Control.ComponentState * [csDetail] <> []) Then
  18488.           Begin
  18489.                Control := Control.Parent;
  18490.                If Control = Nil Then Exit;
  18491.                Inc(X, Control.Left);
  18492.                Inc(Y, Control.Bottom);
  18493.           End
  18494.           Else break;
  18495.      End;
  18496.  
  18497.      If Control.FOnMouseUp <> Nil
  18498.      Then Control.FOnMouseUp(Control,Button,ShiftState,X,Y);
  18499. End;
  18500.  
  18501.  
  18502. Procedure TControl.MouseMove(ShiftState:TShiftState;X,Y:LongInt);
  18503. Var  Control:TControl;
  18504. Begin
  18505.      Control := Self;
  18506.      While True Do
  18507.      Begin
  18508.           If (Control.FOnMouseMove = Nil) And
  18509.              (Control.ComponentState * [csDetail] <> []) Then
  18510.           Begin
  18511.                Control := Control.Parent;
  18512.                If Control = Nil Then Exit;
  18513.                Inc(X, Control.Left);
  18514.                Inc(Y, Control.Bottom);
  18515.           End
  18516.           Else break;
  18517.      End;
  18518.  
  18519.      If Control.FOnMouseMove <> Nil
  18520.      Then Control.FOnMouseMove(Control,ShiftState,X,Y);
  18521. End;
  18522.  
  18523.  
  18524. Procedure TControl.MouseClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LonGInt);
  18525. Var  Control:TControl;
  18526. Begin
  18527.      If Button = mbRight Then
  18528.        If Not Designed Then CheckMenuPopup(Point(X,Y));
  18529.  
  18530.      Control := Self;
  18531.      While True Do
  18532.      Begin
  18533.           If (Control.FOnMouseClick = Nil) And
  18534.              (csDetail In Control.ComponentState) Then
  18535.           Begin
  18536.                Control := Control.Parent;
  18537.                If Control = Nil Then break;
  18538.                Inc(X, Control.Left);
  18539.                Inc(Y, Control.Bottom);
  18540.           End
  18541.           Else break;
  18542.      End;
  18543.  
  18544.      If Control <> Nil Then
  18545.        If Control.FOnMouseClick <> Nil
  18546.        Then Control.FOnMouseClick(Control,Button,ShiftState,X,Y);
  18547.  
  18548.  
  18549.      If Button = mbLeft Then
  18550.      Begin
  18551.           Control := Self;
  18552.           While True Do
  18553.           Begin
  18554.                If (Control.FOnClick = Nil) And
  18555.                   (csDetail In Control.ComponentState) Then
  18556.                Begin
  18557.                     Control := Control.Parent;
  18558.                     If Control = Nil Then break;
  18559.                End
  18560.                Else break;
  18561.           End;
  18562.  
  18563.           If Control <> Nil Then
  18564.             If Control.FOnClick <> Nil Then Control.FOnClick(Control);
  18565.      End;
  18566. End;
  18567.  
  18568.  
  18569. Procedure TControl.MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
  18570. Var  Control:TControl;
  18571. Begin
  18572.      Control := Self;
  18573.      While True Do
  18574.      Begin
  18575.           If (Control.FOnMouseDblClick = Nil) And
  18576.              (csDetail In Control.ComponentState) Then
  18577.           Begin
  18578.                Control := Control.Parent;
  18579.                If Control = Nil Then break;
  18580.                Inc(X, Control.Left);
  18581.                Inc(Y, Control.Bottom);
  18582.           End
  18583.           Else break;
  18584.      End;
  18585.  
  18586.      If Control <> Nil Then
  18587.        If Control.FOnMouseDblClick <> Nil
  18588.        Then Control.FOnMouseDblClick(Control,Button,ShiftState,X,Y);
  18589.  
  18590.  
  18591.      If Button = mbLeft Then
  18592.      Begin
  18593.           Control := Self;
  18594.           While True Do
  18595.           Begin
  18596.                If (Control.FOnDblClick = Nil) And
  18597.                   (csDetail In Control.ComponentState) Then
  18598.                Begin
  18599.                     Control := Control.Parent;
  18600.                     If Control = Nil Then break;
  18601.                End
  18602.                Else break;
  18603.           End;
  18604.  
  18605.           If Control <> Nil Then
  18606.             If FOnDblClick <> Nil Then FOnDblClick(Control);
  18607.      End;
  18608. End;
  18609.  
  18610.  
  18611. Function MausPosFromParam(msgparam:LongWord):TPoint;
  18612. Var  X,Y:Integer;
  18613. Begin
  18614.      X := Lo(msgparam);
  18615.      Y := Hi(msgparam);
  18616.      Result.X := X;
  18617.      Result.Y := Y;
  18618. End;
  18619.  
  18620.  
  18621. {$HINTS OFF}
  18622. Function ShiftStateFromParam(msgparam:LongWord):TShiftState;
  18623. Begin
  18624.      Result := [];
  18625.      {$IFDEF OS2}
  18626.      If WinGetKeyState(HWND_DESKTOP,VK_ALT) And $8000 <> 0
  18627.        Then Include(Result,ssAlt);
  18628.      If WinGetKeyState(HWND_DESKTOP,VK_SHIFT) And $8000 <> 0
  18629.        Then Include(Result,ssShift);
  18630.      If WinGetKeyState(HWND_DESKTOP,VK_CTRL) And $8000 <> 0
  18631.        Then Include(Result,ssCtrl);
  18632.      If WinGetKeyState(HWND_DESKTOP,VK_BUTTON1) And $8000 <> 0
  18633.        Then Include(Result,ssLeft);
  18634.      If WinGetKeyState(HWND_DESKTOP,VK_BUTTON2) And $8000 <> 0
  18635.        Then Include(Result,ssRight);
  18636.      If WinGetKeyState(HWND_DESKTOP,VK_BUTTON3) And $8000 <> 0
  18637.        Then Include(Result,ssMiddle);
  18638.      {$ENDIF}
  18639.      {$IFDEF Win32}
  18640.      If GetKeyState(VK_MENU) < 0 Then Include(Result,ssAlt);
  18641.      If msgparam And MK_SHIFT <> 0 Then Include(Result,ssShift);
  18642.      If msgparam And MK_CONTROL <> 0 Then Include(Result,ssCtrl);
  18643.      If msgparam And MK_LBUTTON <> 0 Then Include(Result,ssLeft);
  18644.      If msgparam And MK_RBUTTON <> 0 Then Include(Result,ssRight);
  18645.      If msgparam And MK_MBUTTON <> 0 Then Include(Result,ssMiddle);
  18646.      {$ENDIF}
  18647. End;
  18648. {$HINTS ON}
  18649.  
  18650.  
  18651. {$IFDEF OS2}
  18652. Procedure TControl.WMButton1Click(Var Msg:TWMButton1Click);
  18653. Var  pt:TPoint;
  18654.      ShiftState:TShiftState;
  18655.      Control:TControl;
  18656.      DNS:TDesignerNotifyStruct;
  18657. Begin
  18658.      If Application<>Nil Then Application.DestroyHintWindow;
  18659.  
  18660.      If ((IsControlLocked(Self))Or(ControlState*[csWindowDestroying]<>[])) Then
  18661.      Begin
  18662.           Msg.Handled := True;
  18663.           Exit;
  18664.      End;
  18665.  
  18666.      ShiftState := ShiftStateFromParam(Msg.keys);
  18667.      pt := Point(Msg.XPos,Msg.YPos);
  18668.      If Designed Then
  18669.      Begin
  18670.           If FHandlesDesignMouse Then
  18671.           Begin
  18672.                MouseClick(mbLeft,ShiftState,pt.X,pt.Y);
  18673.                If Msg.Handled Then Exit;  {Do Not send To Form Window}
  18674.           End;
  18675.  
  18676.           Control := GetDesignerCoordinates(pt);
  18677.           If Control <> Nil Then
  18678.           Begin
  18679.                DNS.Sender := Self;
  18680.                DNS.Code := dncMouseClick;
  18681.                DNS.return := 0;
  18682.                DNS.mouseparam.pt := pt;
  18683.                DNS.mouseparam.Button := mbLeft;
  18684.                DNS.mouseparam.ShiftState := ShiftState;
  18685.                Control.DesignerNotification(DNS);
  18686.                If DNS.return <> 0 Then
  18687.                Begin
  18688.                     Msg.Handled := True;
  18689.                     Msg.Result := 0;
  18690.                End;
  18691.           End;
  18692.      End
  18693.      Else
  18694.      Begin
  18695.           MouseClick(mbLeft,ShiftState,pt.X,pt.Y);
  18696.      End;
  18697. End;
  18698.  
  18699.  
  18700. Procedure TControl.WMButton2Click(Var Msg:TWMButton2Click);
  18701. Var  pt:TPoint;
  18702.      ShiftState:TShiftState;
  18703.      Control:TControl;
  18704.      DNS:TDesignerNotifyStruct;
  18705. Begin
  18706.      If Application<>Nil Then Application.DestroyHintWindow;
  18707.  
  18708.      If ((IsControlLocked(Self))Or(ControlState*[csWindowDestroying]<>[])) Then
  18709.      Begin
  18710.           Msg.Handled := True;
  18711.           Exit;
  18712.      End;
  18713.  
  18714.      ShiftState := ShiftStateFromParam(Msg.keys);
  18715.      pt := Point(Msg.XPos,Msg.YPos);
  18716.      If Designed Then
  18717.      Begin
  18718.           If FHandlesDesignMouse Then
  18719.           Begin
  18720.                MouseClick(mbRight,ShiftState,pt.X,pt.Y);
  18721.                If Msg.Handled Then Exit;  {Do Not send To Form Window}
  18722.           End;
  18723.  
  18724.           Control := GetDesignerCoordinates(pt);
  18725.           If Control <> Nil Then
  18726.           Begin
  18727.                DNS.Sender := Self;
  18728.                DNS.Code := dncMouseClick;
  18729.                DNS.return := 0;
  18730.                DNS.mouseparam.pt := pt;
  18731.                DNS.mouseparam.Button := mbRight;
  18732.                DNS.mouseparam.ShiftState := ShiftState;
  18733.                Control.DesignerNotification(DNS);
  18734.                If DNS.return <> 0 Then
  18735.                Begin
  18736.                     Msg.Handled := True;
  18737.                     Msg.Result := 0;
  18738.                End;
  18739.           End;
  18740.      End
  18741.      Else
  18742.      Begin
  18743.           MouseClick(mbRight,ShiftState,pt.X,pt.Y);
  18744.      End;
  18745. End;
  18746. {$ENDIF}
  18747.  
  18748.  
  18749. {$IFDEF Win32}
  18750. Const
  18751.     WinDragControl:TControl=Nil;
  18752.     WinLastDrag:TControl=Nil;
  18753. Var
  18754.     WinDragDropData:TDragDropData;
  18755.  
  18756. Function GetDragControl(Const pt:TPoint):TControl;
  18757. Var Win:HWND;
  18758.     P:Pointer;
  18759. Begin
  18760.      Result:=Nil;
  18761.      Win:=WinUser.WindowFromPoint(pt);
  18762.      If Win<>0 Then
  18763.      Begin
  18764.           P:=Pointer(GetWindowLong(Win,GWL_WNDPROC));
  18765.           If P<>@SubclassedWndProc Then Exit; //no Sibyl Window
  18766.           Result:=Pointer(GetWindowLong(Win,GWL_USERDATA));
  18767.      End;
  18768. End;
  18769. {$ENDIF}
  18770.  
  18771.  
  18772. {+++ Left Button ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  18773.  
  18774. Procedure TControl.WMButton1Down(Var Msg:TWMButton1Down);
  18775. Var  pt:TPoint;
  18776.      ShiftState:TShiftState;
  18777.      Control:TControl;
  18778.      DNS:TDesignerNotifyStruct;
  18779. Begin
  18780.      If Application<>Nil Then Application.DestroyHintWindow;
  18781.  
  18782.      If ((IsControlLocked(Self))Or(ControlState*[csWindowDestroying]<>[])) Then
  18783.      Begin
  18784.           Msg.Handled := True;
  18785.           Exit;
  18786.      End;
  18787.  
  18788.      {$IFDEF OS2}
  18789.      ShiftState := ShiftStateFromParam(Msg.keys);
  18790.      pt := Point(Msg.XPos,Msg.YPos);
  18791.      {$ENDIF}
  18792.      {$IFDEF Win32}
  18793.      FLastLButtonDownTime := GetMessageTime;
  18794.      pt := Point(Msg.XPos,Msg.YPos);
  18795.      If FCanvas <> Nil Then DPToLP(FCanvas.FHandle,pt,1);
  18796.      TransformPointToOS2(pt,Self,Nil);
  18797.      ShiftState := ShiftStateFromParam(Msg.keys);
  18798.      {$ENDIF}
  18799.      If Designed Then
  18800.      Begin
  18801.           If FHandlesDesignMouse Then
  18802.           Begin
  18803.                MouseDown(mbLeft,ShiftState,pt.X,pt.Y);
  18804.                If Msg.Handled Then Exit;  {Do Not send To Form Window}
  18805.           End;
  18806.  
  18807.           Control := GetDesignerCoordinates(pt);
  18808.           If Control <> Nil Then
  18809.           Begin
  18810.                DNS.Sender := Self;
  18811.                DNS.Code := dncMouseDown;
  18812.                DNS.return := 0;
  18813.                DNS.mouseparam.pt := pt;
  18814.                DNS.mouseparam.Button := mbLeft;
  18815.                DNS.mouseparam.ShiftState := ShiftState;
  18816.                Control.DesignerNotification(DNS);
  18817.                If DNS.return <> 0 Then
  18818.                Begin
  18819.                     Msg.Handled := True;
  18820.                     Msg.Result := 0;
  18821.                End;
  18822.           End;
  18823.      End
  18824.      Else
  18825.      Begin
  18826.           {$IFDEF Win32}
  18827.           If WinDragControl<>Nil Then DragFinished(Nil,pt.X,pt.Y,False);
  18828.           {$ENDIF}
  18829.           MouseDown(mbLeft,ShiftState,pt.X,pt.Y);
  18830.      End;
  18831.  
  18832.      If Not (IsStandardControl Or (Self Is TFrameControl)) Then
  18833.      Begin
  18834.           Msg.Handled := True; {!!}
  18835.           Msg.Result := 0;
  18836.      End;
  18837. End;
  18838.  
  18839.  
  18840. Procedure TControl.WMButton1Up(Var Msg:TWMButton1Up);
  18841. Var  pt:TPoint;
  18842.      ShiftState:TShiftState;
  18843.      Control:TControl;
  18844.      DNS:TDesignerNotifyStruct;
  18845.      {$IFDEF Win32}
  18846.      Success:Boolean;
  18847.      DragObject:TObject;
  18848.      DragControl:TControl;
  18849.      pt1:TPoint;
  18850.      {$ENDIF}
  18851. Begin
  18852.      If ((IsControlLocked(Self))Or(ControlState*[csWindowDestroying]<>[])) Then
  18853.      Begin
  18854.           Msg.Handled := True;
  18855.           Exit;
  18856.      End;
  18857.  
  18858.      {$IFDEF OS2}
  18859.      ShiftState := ShiftStateFromParam(Msg.keys);
  18860.      pt := Point(Msg.XPos,Msg.YPos);
  18861.      {$ENDIF}
  18862.      {$IFDEF Win32}
  18863.      pt := Point(Msg.XPos,Msg.YPos);
  18864.      If FCanvas <> Nil Then DPToLP(FCanvas.FHandle,pt,1);
  18865.      TransformPointToOS2(pt,Self,Nil);
  18866.      ShiftState := ShiftStateFromParam(Msg.keys);
  18867.      If GetMessageTime - FLastLButtonDownTime < FClickTime Then  {Click}
  18868.      Begin
  18869.           If Designed Then
  18870.           Begin
  18871.                If FHandlesDesignMouse Then
  18872.                Begin
  18873.                     MouseClick(mbLeft,ShiftState,pt.X,pt.Y);
  18874.                     If Msg.Handled Then Exit;  {Do Not send To Form Window}
  18875.                End;
  18876.  
  18877.                Control := GetDesignerCoordinates(pt);
  18878.                If Control <> Nil Then
  18879.                Begin
  18880.                     DNS.Sender := Self;
  18881.                     DNS.Code := dncMouseClick;
  18882.                     DNS.return := 0;
  18883.                     DNS.mouseparam.pt := pt;
  18884.                     DNS.mouseparam.Button := mbLeft;
  18885.                     DNS.mouseparam.ShiftState := ShiftState;
  18886.                     Control.DesignerNotification(DNS);
  18887.                     If DNS.return <> 0 Then
  18888.                     Begin
  18889.                          Msg.Handled := True;
  18890.                          Msg.Result := 0;
  18891.                     End;
  18892.                End;
  18893.           End
  18894.           Else
  18895.           Begin
  18896.                MouseClick(mbLeft,ShiftState,pt.X,pt.Y);
  18897.           End;
  18898.      End;
  18899.      {$ENDIF}
  18900.  
  18901.      If Designed Then
  18902.      Begin
  18903.           If FHandlesDesignMouse Then
  18904.           Begin
  18905.                MouseUp(mbLeft,ShiftState,pt.X,pt.Y);
  18906.                If Msg.Handled Then Exit;  {Do Not send To Form Window}
  18907.           End;
  18908.  
  18909.           Control := GetDesignerCoordinates(pt);
  18910.           If Control <> Nil Then
  18911.           Begin
  18912.                DNS.Sender := Self;
  18913.                DNS.Code := dncMouseUp;
  18914.                DNS.return := 0;
  18915.                DNS.mouseparam.pt := pt;
  18916.                DNS.mouseparam.Button := mbLeft;
  18917.                DNS.mouseparam.ShiftState := ShiftState;
  18918.                Control.DesignerNotification(DNS);
  18919.                If DNS.return <> 0 Then
  18920.                Begin
  18921.                     Msg.Handled := True;
  18922.                     Msg.Result := 0;
  18923.                End;
  18924.           End;
  18925.      End
  18926.      Else
  18927.      Begin
  18928.           {$IFDEF OS2}
  18929.           MouseUp(mbLeft,ShiftState,pt.X,pt.Y);
  18930.           {$ENDIF}
  18931.           {$IFDEF Win32}
  18932.           If WinDragControl<>Nil Then
  18933.           Begin
  18934.                Success:=False;
  18935.                If WinDragDropData.RenderType=drmSibylObject Then
  18936.                Begin
  18937.                     DragObject:=TObject(WinDragDropData.ItemId);
  18938.                End
  18939.                Else DragObject:=Nil;
  18940.                pt1:=Point(Msg.XPos,Msg.YPos);
  18941.                WinUser.ClientToScreen(Handle,pt1);
  18942.                DragControl:=GetDragControl(pt1);
  18943.                Success:=False;
  18944.                If DragControl<>Nil Then
  18945.                  If WinDragControl<>DragControl Then
  18946.                  Begin
  18947.                       pt:=pt1;
  18948.                       MapWindowPoints(HWND_DESKTOP,DragControl.Handle,pt,1);
  18949.                       DragControl.DragDrop(DragObject,pt.X,pt.Y);
  18950.                       Success:=True;
  18951.                  End;
  18952.                DragFinished(DragControl,pt.X,pt.Y, Success);
  18953.           End
  18954.           Else MouseUp(mbLeft,ShiftState,pt.X,pt.Y);
  18955.           {$ENDIF}
  18956.      End;
  18957. End;
  18958.  
  18959.  
  18960. Procedure TControl.WMButton1DblClk(Var Msg:TWMButton1DblClk);
  18961. Var  pt:TPoint;
  18962.      ShiftState:TShiftState;
  18963.      Control:TControl;
  18964.      DNS:TDesignerNotifyStruct;
  18965. Begin
  18966.      If Application<>Nil Then Application.DestroyHintWindow;
  18967.  
  18968.      If ((IsControlLocked(Self))Or(ControlState*[csWindowDestroying]<>[])) Then
  18969.      Begin
  18970.           Msg.Handled := True;
  18971.           Exit;
  18972.      End;
  18973.  
  18974.      {$IFDEF OS2}
  18975.      ShiftState := ShiftStateFromParam(Msg.keys);
  18976.      pt := Point(Msg.XPos,Msg.YPos);
  18977.      {$ENDIF}
  18978.      {$IFDEF Win32}
  18979.      pt := Point(Msg.XPos,Msg.YPos);
  18980.      If FCanvas <> Nil Then DPToLP(FCanvas.FHandle,pt,1);
  18981.      TransformPointToOS2(pt,Self,Nil);
  18982.      ShiftState := ShiftStateFromParam(Msg.keys);
  18983.      {$ENDIF}
  18984.      If Designed Then
  18985.      Begin
  18986.           If FHandlesDesignMouse Then
  18987.           Begin
  18988.                MouseDblClick(mbLeft,ShiftState+[ssDouble],pt.X,pt.Y);
  18989. //Buttons?               MouseDown(mbLeft,ShiftState+[ssDouble],pt.X,pt.Y); {VCL!}
  18990.                If Msg.Handled Then Exit;  {Do Not send To Form Window}
  18991.           End;
  18992.  
  18993.           Control := GetDesignerCoordinates(pt);
  18994.           If Control <> Nil Then
  18995.           Begin
  18996.                DNS.Sender := Self;
  18997.                DNS.Code := dncMouseDblClk;
  18998.                DNS.return := 0;
  18999.                DNS.mouseparam.pt := pt;
  19000.                DNS.mouseparam.Button := mbLeft;
  19001.                DNS.mouseparam.ShiftState := ShiftState;
  19002.                Control.DesignerNotification(DNS);
  19003.                If DNS.return <> 0 Then
  19004.                Begin
  19005.                     Msg.Handled := True;
  19006.                     Msg.Result := 0;
  19007.                End;
  19008.           End;
  19009.      End
  19010.      Else
  19011.      Begin
  19012.           MouseDblClick(mbLeft,ShiftState+[ssDouble],pt.X,pt.Y);
  19013. //Buttons?          MouseDown(mbLeft,ShiftState+[ssDouble],pt.X,pt.Y); {VCL!}
  19014.      End;
  19015. End;
  19016.  
  19017.  
  19018. {+++ Right Button +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  19019.  
  19020. {initiate Dragging Of A non detail Control}
  19021. Function DragInit(Control:TControl; pt:TPoint):Boolean;
  19022. Var  Ok:Boolean;
  19023. Begin
  19024.      Result := False;
  19025.  
  19026.      While Control.ComponentState * [csDetail] <> [] Do
  19027.      Begin
  19028.           Inc(pt.X, Control.Left);
  19029.           Inc(pt.Y, Control.Bottom);
  19030.           Control := Control.Parent;
  19031.           If Control = Nil Then Exit;
  19032.      End;
  19033.  
  19034.      If Control.FDragMode=dmAutomatic Then
  19035.      Begin
  19036.           Ok := True;
  19037.           Control.CanDrag(pt.X,pt.Y,Ok);
  19038.           If Ok Then Control.BeginDrag(True);
  19039.           Result := True;
  19040.      End;
  19041. End;
  19042.  
  19043.  
  19044. Procedure TControl.WMButton2Down(Var Msg:TWMButton2Down);
  19045. Var  pt:TPoint;
  19046.      ShiftState:TShiftState;
  19047.      Control:TControl;
  19048.      DNS:TDesignerNotifyStruct;
  19049.      IsForm:Boolean;
  19050. Begin
  19051.      If Application<>Nil Then Application.DestroyHintWindow;
  19052.  
  19053.      If ((IsControlLocked(Self))Or(ControlState*[csWindowDestroying]<>[])) Then
  19054.      Begin
  19055.           Msg.Handled := True;
  19056.           Exit;
  19057.      End;
  19058.  
  19059.      IsForm := Self Is TForm;
  19060.  
  19061.      {$IFDEF OS2}
  19062.      ShiftState := ShiftStateFromParam(Msg.keys);
  19063.      pt := Point(Msg.XPos,Msg.YPos);
  19064.      {$ENDIF}
  19065.      {$IFDEF Win32}
  19066.      FLastRButtonDownTime := GetMessageTime;
  19067.      pt := Point(Msg.XPos,Msg.YPos);
  19068.      If FCanvas <> Nil Then DPToLP(FCanvas.FHandle,pt,1);
  19069.      TransformPointToOS2(pt,Self,Nil);
  19070.      ShiftState := ShiftStateFromParam(Msg.keys);
  19071.      {$ENDIF}
  19072.      If Designed Then
  19073.      Begin
  19074.           If FHandlesDesignMouse Then
  19075.           Begin
  19076.                MouseDown(mbRight,ShiftState,pt.X,pt.Y);
  19077.                If Msg.Handled Then Exit;  {Do Not send To Form Window}
  19078.           End;
  19079.  
  19080.           Control := GetDesignerCoordinates(pt);
  19081.           If Control <> Nil Then
  19082.           Begin
  19083.                DNS.Sender := Self;
  19084.                DNS.Code := dncMouseDown;
  19085.                DNS.return := 0;
  19086.                DNS.mouseparam.pt := pt;
  19087.                DNS.mouseparam.Button := mbRight;
  19088.                DNS.mouseparam.ShiftState := ShiftState;
  19089.                Control.DesignerNotification(DNS);
  19090.                If DNS.return <> 0 Then
  19091.                Begin
  19092.                     Msg.Handled := True;
  19093.                     Msg.Result := 0;
  19094.                End;
  19095.           End;
  19096.      End
  19097.      Else
  19098.      Begin
  19099.           {$IFDEF OS2}
  19100.           MouseDown(mbRight,ShiftState,pt.X,pt.Y);
  19101.           {$ENDIF}
  19102.           {$IFDEF Win32}
  19103.           If WinDragControl=Nil Then
  19104.           Begin
  19105.                If DragInit(Self,pt) Then
  19106.                Begin
  19107.                     Msg.Handled:=True;
  19108.                     Msg.Result:=0;
  19109.                End
  19110.                Else MouseDown(mbRight,ShiftState,pt.X,pt.Y);
  19111.           End
  19112.           Else
  19113.           Begin
  19114.                If WinDragControl<>Nil Then DragFinished(Nil,pt.X,pt.Y,False);
  19115.                MouseDown(mbRight,ShiftState,pt.X,pt.Y);
  19116.           End;
  19117.           {$ENDIF}
  19118.      End;
  19119.  
  19120.      //If IsForm Then
  19121.      If Not (IsStandardControl Or (Self Is TFrameControl)) Then
  19122.      Begin
  19123.           Msg.Handled := True; {!!}
  19124.           Msg.Result := 0;
  19125.      End;
  19126. End;
  19127.  
  19128.  
  19129. Procedure TControl.WMButton2Up(Var Msg:TWMButton2Up);
  19130. Var  pt:TPoint;
  19131.      ShiftState:TShiftState;
  19132.      Control:TControl;
  19133.      DNS:TDesignerNotifyStruct;
  19134.      {$IFDEF Win32}
  19135.      Success:Boolean;
  19136.      DragObject:TObject;
  19137.      DragControl:TControl;
  19138.      pt1:TPoint;
  19139.      {$ENDIF}
  19140. Begin
  19141.      If ((IsControlLocked(Self))Or(ControlState*[csWindowDestroying]<>[])) Then
  19142.      Begin
  19143.           Msg.Handled := True;
  19144.           Exit;
  19145.      End;
  19146.  
  19147.      {$IFDEF OS2}
  19148.      ShiftState := ShiftStateFromParam(Msg.keys);
  19149.      pt := Point(Msg.XPos,Msg.YPos);
  19150.      {$ENDIF}
  19151.      {$IFDEF Win32}
  19152.      pt := Point(Msg.XPos,Msg.YPos);
  19153.      If FCanvas <> Nil Then DPToLP(FCanvas.FHandle,pt,1);
  19154.      TransformPointToOS2(pt,Self,Nil);
  19155.      ShiftState := ShiftStateFromParam(Msg.keys);
  19156.      If GetMessageTime - FLastRButtonDownTime < FClickTime Then  {Click}
  19157.      Begin
  19158.           If Designed Then
  19159.           Begin
  19160.                If FHandlesDesignMouse Then
  19161.                Begin
  19162.                     MouseClick(mbRight,ShiftState,pt.X,pt.Y);
  19163.                     If Msg.Handled Then Exit;  {Do Not send To Form Window}
  19164.                End;
  19165.  
  19166.                Control := GetDesignerCoordinates(pt);
  19167.                If Control <> Nil Then
  19168.                Begin
  19169.                     DNS.Sender := Self;
  19170.                     DNS.Code := dncMouseClick;
  19171.                     DNS.return := 0;
  19172.                     DNS.mouseparam.pt := pt;
  19173.                     DNS.mouseparam.Button := mbRight;
  19174.                     DNS.mouseparam.ShiftState := ShiftState;
  19175.                     Control.DesignerNotification(DNS);
  19176.                     If DNS.return <> 0 Then
  19177.                     Begin
  19178.                          Msg.Handled := True;
  19179.                          Msg.Result := 0;
  19180.                     End;
  19181.                End;
  19182.           End
  19183.           Else
  19184.           Begin
  19185.                MouseClick(mbRight,ShiftState,pt.X,pt.Y);
  19186.           End;
  19187.      End;
  19188.      {$ENDIF}
  19189.  
  19190.      If Designed Then
  19191.      Begin
  19192.           If FHandlesDesignMouse Then
  19193.           Begin
  19194.                MouseUp(mbRight,ShiftState,pt.X,pt.Y);
  19195.                If Msg.Handled Then Exit;  {Do Not send To Form Window}
  19196.           End;
  19197.  
  19198.           Control := GetDesignerCoordinates(pt);
  19199.           If Control <> Nil Then
  19200.           Begin
  19201.                DNS.Sender := Self;
  19202.                DNS.Code := dncMouseUp;
  19203.                DNS.return := 0;
  19204.                DNS.mouseparam.pt := pt;
  19205.                DNS.mouseparam.Button := mbRight;
  19206.                DNS.mouseparam.ShiftState := ShiftState;
  19207.                Control.DesignerNotification(DNS);
  19208.                If DNS.return <> 0 Then
  19209.                Begin
  19210.                     Msg.Handled := True;
  19211.                     Msg.Result := 0;
  19212.                End;
  19213.           End;
  19214.      End
  19215.      Else
  19216.      Begin
  19217.           {$IFDEF OS2}
  19218.           MouseUp(mbRight,ShiftState,pt.X,pt.Y);
  19219.           {$ENDIF}
  19220.           {$IFDEF Win32}
  19221.           If WinDragControl<>Nil Then
  19222.           Begin
  19223.                Success:=False;
  19224.                If WinDragDropData.RenderType=drmSibylObject Then
  19225.                Begin
  19226.                     DragObject:=TObject(WinDragDropData.ItemId);
  19227.                End
  19228.                Else DragObject:=Nil;
  19229.                pt1:=Point(Msg.XPos,Msg.YPos);
  19230.                WinUser.ClientToScreen(Handle,pt1);
  19231.                DragControl:=GetDragControl(pt1);
  19232.                Success:=False;
  19233.                If ((DragControl<>Nil)And(WinDragControl<>DragControl)) Then
  19234.                Begin
  19235.                     pt:=pt1;
  19236.                     MapWindowPoints(HWND_DESKTOP,DragControl.Handle,pt,1);
  19237.                     TransformPointToOS2(pt,DragControl,Nil);
  19238.                     DragControl.DragDrop(DragObject,pt.X,pt.Y);
  19239.                     Success:=True;
  19240.                End;
  19241.                DragFinished(DragControl,pt.X,pt.Y, Success);
  19242.           End
  19243.           Else MouseUp(mbRight,ShiftState,pt.X,pt.Y);
  19244.           {$ENDIF}
  19245.      End;
  19246. End;
  19247.  
  19248.  
  19249. Procedure TControl.WMButton2DblClk(Var Msg:TWMButton2DblClk);
  19250. Var  pt:TPoint;
  19251.      ShiftState:TShiftState;
  19252.      Control:TControl;
  19253.      DNS:TDesignerNotifyStruct;
  19254. Begin
  19255.      If Application<>Nil Then Application.DestroyHintWindow;
  19256.  
  19257.      If ((IsControlLocked(Self))Or(ControlState*[csWindowDestroying]<>[])) Then
  19258.      Begin
  19259.           Msg.Handled := True;
  19260.           Exit;
  19261.      End;
  19262.  
  19263.      {$IFDEF OS2}
  19264.      ShiftState := ShiftStateFromParam(Msg.keys);
  19265.      pt := Point(Msg.XPos,Msg.YPos);
  19266.      {$ENDIF}
  19267.      {$IFDEF Win32}
  19268.      pt := Point(Msg.XPos,Msg.YPos);
  19269.      If FCanvas <> Nil Then DPToLP(FCanvas.FHandle,pt,1);
  19270.      TransformPointToOS2(pt,Self,Nil);
  19271.      ShiftState := ShiftStateFromParam(Msg.keys);
  19272.      {$ENDIF}
  19273.      If Designed Then
  19274.      Begin
  19275.           If FHandlesDesignMouse Then
  19276.           Begin
  19277.                MouseDblClick(mbRight,ShiftState+[ssDouble],pt.X,pt.Y);
  19278. //Buttons?               MouseDown(mbRight,ShiftState+[ssDouble],pt.X,pt.Y); {VCL!}
  19279.                If Msg.Handled Then Exit;  {Do Not send To Form Window}
  19280.           End;
  19281.  
  19282.           Control := GetDesignerCoordinates(pt);
  19283.           If Control <> Nil Then
  19284.           Begin
  19285.                DNS.Sender := Self;
  19286.                DNS.Code := dncMouseDblClk;
  19287.                DNS.return := 0;
  19288.                DNS.mouseparam.pt := pt;
  19289.                DNS.mouseparam.Button := mbRight;
  19290.                DNS.mouseparam.ShiftState := ShiftState;
  19291.                Control.DesignerNotification(DNS);
  19292.                If DNS.return <> 0 Then
  19293.                Begin
  19294.                     Msg.Handled := True;
  19295.                     Msg.Result := 0;
  19296.                End;
  19297.           End;
  19298.      End
  19299.      Else
  19300.      Begin
  19301.           MouseDblClick(mbRight,ShiftState+[ssDouble],pt.X,pt.Y);
  19302. //Buttons?          MouseDown(mbRight,ShiftState+[ssDouble],pt.X,pt.Y); {VCL!}
  19303.      End;
  19304. End;
  19305.  
  19306.  
  19307. {Query the actually Visible mouse Cursor Handle}
  19308. Function CurrentMouseHandle(Control:TControl):HCursor;
  19309. Begin
  19310.      If Screen.Cursor <> crDefault
  19311.      Then Result := Screen.Cursors[Screen.FCursor]
  19312.      Else Result := Screen.Cursors[Control.FCursor];
  19313. End;
  19314.  
  19315.  
  19316. Procedure TControl.WMMouseMove(Var Msg:TWMMouseMove);
  19317. Var  pt:TPoint;
  19318.      ShiftState:TShiftState;
  19319.      Control:TControl;
  19320.      DNS:TDesignerNotifyStruct;
  19321.      OldHandled:Boolean;
  19322.      CanHint:Boolean;
  19323.      HintParent:TControl;
  19324.      HintOwner:TControl;
  19325.      {$IFDEF Win32}
  19326.      Accept:Boolean;
  19327.      DragControl:TControl;
  19328.      pt1:TPoint;
  19329.      DragObject:TObject;
  19330.      Win:HWND;
  19331.      {$ENDIF}
  19332. Begin
  19333.      {$IFDEF OS2}
  19334.      ShiftState := ShiftStateFromParam(Msg.keys);
  19335.      pt := Point(Msg.XPos,Msg.YPos);
  19336.      If IsControlLocked(Self) Then
  19337.      Begin
  19338.           WinSetPointer(HWND_DESKTOP,Screen.Cursors[FCursor]);
  19339.           Msg.Handled := True;
  19340.           Msg.Result := 0;
  19341.           Exit;
  19342.      End
  19343.      Else
  19344.      Begin
  19345.           If FCursor <> crDefault Then
  19346.           Begin
  19347.                If WinQueryPointer(HWND_DESKTOP) <> CurrentMouseHandle(Self)
  19348.                Then SetCursor(FCursor);
  19349.                Msg.Handled := True;
  19350.                Msg.Result := 0;
  19351.           End;
  19352.      End;
  19353.      {$ENDIF}
  19354.      {$IFDEF Win32}
  19355.      pt := Point(Msg.XPos,Msg.YPos);
  19356.      If FCanvas <> Nil Then DPToLP(FCanvas.FHandle,pt,1);
  19357.      TransformPointToOS2(pt,Self,Nil);
  19358.      ShiftState := ShiftStateFromParam(Msg.keys);
  19359.      If IsControlLocked(Self) Then
  19360.      Begin
  19361.           Msg.Handled := True;
  19362.           Msg.Result := 0;
  19363.           Exit;
  19364.      End
  19365.      Else
  19366.      Begin
  19367.           If FCursor <> crDefault Then
  19368.           Begin
  19369.                If WinUser.GetCursor <> CurrentMouseHandle(Self)
  19370.                Then SetCursor(FCursor);
  19371.                Msg.Handled := True;
  19372.                Msg.Result := 0;
  19373.           End;
  19374.      End;
  19375.      {$ENDIF}
  19376.  
  19377.      If Designed Then
  19378.      Begin
  19379.           If FHandlesDesignMouse Then
  19380.           Begin
  19381.                OldHandled := Msg.Handled;
  19382.                Msg.Handled := False;
  19383.  
  19384.                MouseMove(ShiftState,pt.X,pt.Y);
  19385.  
  19386.                If Msg.Handled Then Exit;  {Do Not send To Form Window}
  19387.                Msg.Handled := OldHandled;
  19388.           End;
  19389.  
  19390.           Control := GetDesignerCoordinates(pt);
  19391.           If Control <> Nil Then
  19392.           Begin
  19393.                DNS.Sender := Self;
  19394.                DNS.Code := dncMouseMove;
  19395.                DNS.return := 0;
  19396.                DNS.mouseparam.pt := pt;
  19397.                DNS.mouseparam.ShiftState := ShiftState;
  19398.                Control.DesignerNotification(DNS);
  19399.                If DNS.return <> 0 Then
  19400.                Begin
  19401.                     Msg.Handled := True;
  19402.                     Msg.Result := 0;
  19403.                End;
  19404.           End;
  19405.      End
  19406.      Else
  19407.      Begin
  19408.           {$IFDEF Win32}
  19409.           If WinDragControl<>Nil Then //we are Dragging
  19410.           Begin
  19411.                pt1:=Point(Msg.XPos,Msg.YPos);
  19412.                WinUser.ClientToScreen(Handle,pt1);
  19413.                DragControl:=GetDragControl(pt1);
  19414.                Accept:=False;
  19415.  
  19416.                If WinDragDropData.RenderType=drmSibylObject Then
  19417.                Begin
  19418.                     DragObject:=TObject(WinDragDropData.ItemId);
  19419.                End
  19420.                Else DragObject:=Nil;
  19421.  
  19422.                If DragControl<>WinDragControl Then
  19423.                Begin
  19424.                     If DragControl<>WinLastDrag Then
  19425.                     Begin
  19426.                          If WinLastDrag<>Nil Then
  19427.                          Begin
  19428.                               WinLastDrag.FDragState:=dsDragEnter;
  19429.                               TransformPointToOS2(pt,WinLastDrag,Nil);
  19430.                               WinLastDrag.DragOver(DragObject,
  19431.                                                    pt.X,pt.Y,
  19432.                                                    dsDragLeave,
  19433.                                                    Accept);
  19434.                          End;
  19435.                          WinLastDrag:=DragControl;
  19436.                          If DragControl<>Nil
  19437.                          Then DragControl.FDragState:=dsDragEnter;
  19438.                     End
  19439.                     Else If DragControl<>Nil
  19440.                          Then DragControl.FDragState:=dsDragMove;
  19441.  
  19442.                     If DragControl<>Nil Then
  19443.                     Begin
  19444.                          pt:=pt1;
  19445.                          MapWindowPoints(HWND_DESKTOP,DragControl.Handle,pt,1);
  19446.                          TransformPointToOS2(pt,DragControl,Nil);
  19447.                          DragControl.DragOver(DragObject,pt.X,pt.Y,FDragState,
  19448.                                               Accept);
  19449.                     End;
  19450.                End;
  19451.                If Accept
  19452.                Then WinUser.SetCursor(Screen.Cursors[WinDragControl.FDragCursor])
  19453.                Else WinUser.SetCursor(Screen.Cursors[crNo]);
  19454.           End
  19455.           Else MouseMove(ShiftState,pt.X,pt.Y);
  19456.           {$ENDIF}
  19457.           {$IFDEF OS2}
  19458.           MouseMove(ShiftState,pt.X,pt.Y);
  19459.           {$ENDIF}
  19460.      End;
  19461.  
  19462.      {Bubble}
  19463.      If Application = Nil Then Exit;
  19464.  
  19465.      If Application.FHintWindow = Self Then Exit;
  19466.      If Application.FHintOwner = Self Then Exit;
  19467.  
  19468.      {Destroy Bubble If Not from Self}
  19469.      If Application.FHintOwner <> Nil Then
  19470.        If Application.FHintOwner <> Self Then
  19471.        Begin
  19472.             HintOwner := Application.FHintOwner;
  19473.             HintParent := Application.FHintParent;
  19474.             Application.DestroyHintWindow;
  19475.             Application.FHintParent := HintParent;  {Enable Immediate Showing}
  19476.  
  19477.             While HintOwner <> Nil Do
  19478.             Begin
  19479.                HintOwner.Update;
  19480.                HintOwner := HintOwner.Parent;
  19481.             End;
  19482.        End;
  19483.  
  19484.      CanHint := (FHint <> Nil) And GetShowHint And (Not Designed);
  19485.  
  19486.      {If Timer Is Running, Stop it Or Destroy it}
  19487.      If Application.FHintTimer <> Nil Then
  19488.      Begin
  19489.           Application.FHintTimer.Stop;
  19490.           If (Application.FHintControl <> Self) Or (Not CanHint) Then
  19491.           Begin
  19492.                Application.FHintTimer.Destroy;
  19493.                Application.FHintTimer := Nil;
  19494.                Application.FHintParent := Nil;
  19495.           End;
  19496.      End;
  19497.  
  19498.      {Show Own Bubble Or Start Timer}
  19499.      Application.FHintControl := Self;
  19500.  
  19501.      If CanHint Then
  19502.      Begin
  19503.           If (Application.FHintParent = Parent) And (Parent <> Nil) Then
  19504.           Begin {Immediate Showing}
  19505.                If Application.FHintOwner = Nil
  19506.                Then Application.HintTimerExpired;
  19507.           End
  19508.           Else
  19509.           Begin {Start Timer}
  19510.                If Application.FHintTimer = Nil
  19511.                Then Application.FHintTimer.Create(Nil);
  19512.                Include(Application.FHintTimer.ComponentState, csDetail);
  19513.                Application.FHintTimer.Interval := Application.FHintPause;
  19514.                Application.FHintTimer.Start;
  19515.           End;
  19516.      End;
  19517.  
  19518.      If (Application.FHintParent <> Parent) And
  19519.         (Application.FHintParent <> Self) Then Application.FHintParent := Nil;
  19520. End;
  19521.  
  19522.  
  19523. Procedure TControl.CheckMenuPopup(pt:TPoint);
  19524. Var  AControl:TControl;
  19525.      APopup:TPopupMenu;
  19526. Begin
  19527.      If Designed Then Exit;
  19528.  
  19529.      AControl := Self;
  19530.      While AControl <> Nil Do
  19531.      Begin
  19532.           APopup := AControl.PopupMenu;
  19533.           If APopup <> Nil Then
  19534.             If APopup.AutoPopup Then //Popup found
  19535.             Begin
  19536.                  APopup.PopupComponent := AControl;
  19537.                  pt := ClientToScreen(pt);
  19538.                  APopup.Popup(pt.X,pt.Y);
  19539.                  Exit;
  19540.             End;
  19541.           AControl := AControl.Parent;
  19542.      End;
  19543. End;
  19544.  
  19545.  
  19546. {$IFDEF Win32}
  19547. Procedure TControl.WMSetCursor(Var Msg:TMessage);
  19548. Begin
  19549.      If Self Is TFrameControl Then Exit;
  19550.  
  19551.      If WinUser.GetCursor <> CurrentMouseHandle(Self)
  19552.      Then SetCursor(FCursor);
  19553.  
  19554.      Msg.Handled := True;
  19555.      Msg.Result := 0;
  19556. End;
  19557. {$ENDIF}
  19558.  
  19559.  
  19560. Procedure TControl.SetCursor(Index:TCursor);
  19561. Begin
  19562.      FCursor := Index;
  19563.      If Designed Then Exit;
  19564.      {$IFDEF OS2}
  19565.      WinSetPointer(HWND_DESKTOP, CurrentMouseHandle(Self));
  19566.      {$ENDIF}
  19567.      {$IFDEF Win32}
  19568.      SetClassLong(Handle,GCL_HCURSOR,0);
  19569.      WinUser.SetCursor(CurrentMouseHandle(Self));
  19570.      {$ENDIF}
  19571. End;
  19572.  
  19573.  
  19574. Procedure TControl.Resize;
  19575. Begin
  19576.      RealignControls;
  19577.  
  19578.      If OnResize <> Nil Then OnResize(Self);
  19579. End;
  19580.  
  19581.  
  19582. Procedure TControl.Move;
  19583. Begin
  19584.      If OnMove<>Nil Then OnMove(Self);
  19585. End;
  19586.  
  19587.  
  19588. {unter Win95 nicht Die Msg.Parameter verwenden}
  19589. {$HINTS OFF}
  19590. Procedure TControl.WMMove(Var Msg:TWMMove);
  19591. Var  rc:TRect;
  19592.      {$IFDEF Win32}
  19593.      Child:TControl;
  19594.      {$ENDIF}
  19595. Begin
  19596.      If Self Is TForm Then
  19597.        If TForm(Self).WindowState = wsMinimized Then
  19598.          If Not TForm(Self).Designed Then Exit;
  19599.  
  19600.      rc := GetWindowRect;
  19601.      FLeft := rc.Left;
  19602.      FBottom := rc.Bottom;
  19603.      Move;
  19604.  
  19605.      {$IFDEF Win32}
  19606.      If (Self Is TFrameControl) And (TFrameControl(Self).FChild <> Nil) Then
  19607.      Begin
  19608.           Child := TFrameControl(Self).FChild;
  19609.           Child.Move;
  19610.      End;
  19611.      {$ENDIF}
  19612. End;
  19613. {$HINTS ON}
  19614.  
  19615. {unter Win95 nicht Die Msg.Parameter verwenden}
  19616. Procedure TControl.WMSize(Var Msg:TWMSize);
  19617. Var  rc:TRect;
  19618.      {$IFDEF Win32}
  19619.      rc1:TRect;
  19620.      _Left,_Bottom,_Width,_Height:LongInt;
  19621.      T:LongInt;
  19622.      Control:TControl;
  19623.      {$ENDIF}
  19624. Begin
  19625.      If Self Is TForm Then
  19626.        If TForm(Self).WindowState = wsMinimized Then
  19627.          If Not TForm(Self).Designed Then Exit;
  19628.  
  19629.      {$IFDEF Win32}
  19630.      For T:=0 To ControlCount-1 Do
  19631.      Begin
  19632.           Control:=Controls[T];
  19633.           If Not (Control.FIsToolBar) Then
  19634.             If Control.FFirstShow Then
  19635.               If Control.FVisible Or Control.Designed Then Control.Show;
  19636.      End;
  19637.      {$ENDIF}
  19638.  
  19639.      {$IFDEF OS2}
  19640.      rc:=GetWindowRect;
  19641.      FLeft:=rc.Left;
  19642.      FBottom:=rc.Bottom;
  19643.      FWidth:=Msg.Width;
  19644.      FHeight:=Msg.Height;
  19645. //FWidth:=rc.Right-rc.Left +1;
  19646. //FHeight:=rc.Top-rc.Bottom +1;
  19647.      If FFrame<>Nil Then
  19648.      Begin
  19649.           rc:=FFrame.GetWindowRect;
  19650.           FFrame.FLeft:=rc.Left;
  19651.           FFrame.FBottom:=rc.Bottom;
  19652.           FFrame.FWidth:=rc.Right-rc.Left +1;
  19653.           FFrame.FHeight:=rc.Top-rc.Bottom +1;
  19654.      End;
  19655.      {$ENDIF}
  19656.  
  19657.      {$IFDEF Win32}
  19658.      {CX:=Lo(Msg.Param2);
  19659.      CY:=Hi(Msg.Param2);}
  19660.      rc:=GetWindowRect;
  19661.      FWidth:=rc.Right-rc.Left +1;
  19662.      FHeight:=rc.Top-rc.Bottom +1;
  19663.  
  19664.      If (Self Is TFrameControl) And (TFrameControl(Self).FChild <> Nil) Then
  19665.      Begin
  19666.           WinUser.GetClientRect(Handle,RECTL(rc1));
  19667.           rc:=GetClientRect;
  19668.           _Width:=rc.Right-rc.Left+1;
  19669.           _Height:=rc.Top-rc.Bottom+1;
  19670.           _Left:=rc.Left;
  19671.           _Bottom:=((rc1.Top-rc1.Bottom)-_Height)-rc.Bottom;
  19672.  
  19673.           WinUser.SetWindowPos(TFrameControl(Self).FChild.Handle,0,
  19674.                                _Left,_Bottom,_Width,_Height, SWP_SHOWWINDOW);
  19675.  
  19676.           TFrameControl(Self).FChild.RealignControls;
  19677.      End;
  19678.      {$ENDIF}
  19679.  
  19680.      {$IFDEF Win32}
  19681.      {If..?} WMMove(TWMMove(Msg));   {track Bottom Frame border}
  19682.      {$ENDIF}
  19683.  
  19684.      Resize;
  19685. End;
  19686.  
  19687.  
  19688. Procedure TControl.WMEraseBackGround(Var Msg:TMessage);
  19689. Begin
  19690.      If Not FOwnerDraw Then Exit;
  19691.      {$IFDEF OS2}
  19692.      Msg.Result:=0;          {don't Do any Action}
  19693.      Msg.Handled:=True;
  19694.      {$ENDIF}
  19695.      {$IFDEF Win32}
  19696.      Msg.Result:=1;
  19697.      Msg.Handled:=True;
  19698.      {$ENDIF}
  19699. End;
  19700.  
  19701.  
  19702. Procedure TControl.FontChange;
  19703. Begin
  19704.      If FOnFontChange <> Nil Then FOnFontChange(Self)
  19705.      Else If (Handle <> 0) And IsWindowVisible Then Invalidate;
  19706. End;
  19707.  
  19708.  
  19709. {$IFDEF OS2}
  19710. Function TControl.SetPPFontNameSize(Const FNS:String):Boolean;
  19711. Var  CS:Cstring;
  19712. Begin
  19713.      FUpdatingPP := True;
  19714.      CS := FNS;
  19715.  
  19716.      Result := WinSetPresParam(Handle,PP_FONTNAMESIZE,Length(CS)+1,CS);
  19717.      FUpdatingPP := False;
  19718.  
  19719.      If IsFontChangeEnabled Then FontChange;
  19720. End;
  19721.  
  19722.  
  19723. Function TControl.SetPPForeGroundColor(AColor:TColor):Boolean;
  19724. Begin
  19725.      FUpdatingPP := True;
  19726.      AColor := SysColorToRGB(AColor);
  19727.      Result := WinSetPresParam(Handle,PP_FOREGROUNDCOLOR,4,AColor);
  19728.      FUpdatingPP := False;
  19729. End;
  19730.  
  19731.  
  19732. Function TControl.SetPPBackGroundColor(AColor:TColor):Boolean;
  19733. Begin
  19734.      FUpdatingPP := True;
  19735.      AColor := SysColorToRGB(AColor);
  19736.      Result := WinSetPresParam(Handle,PP_BACKGROUNDCOLOR,4,AColor);
  19737.      WinSetPresParam(Handle,PP_DISABLEDBACKGROUNDCOLOR,4,AColor);
  19738.      FUpdatingPP := False;
  19739. End;
  19740.  
  19741.  
  19742. Procedure TControl.WMPresParamChanged(Var Msg:TMessage);
  19743. Var  PPid:LongWord;
  19744.      cFNS:Cstring;
  19745.      FNS:String;
  19746.      Size,P:Byte;
  19747.      C:Integer;
  19748.      aFont:TFont;
  19749.      NewColor:TColor;
  19750. Begin
  19751.      If (Self = Screen.FFontWindow) Or FUpdatingPP Then Exit;
  19752.  
  19753.      {drag & drop von der SystemPalette auf Details weiterleiten an Parent}
  19754.      If ComponentState * [csDetail] <> [] Then
  19755.        If Parent <> Nil Then
  19756.        Begin
  19757.             Parent.WMPresParamChanged(Msg);
  19758.             Exit;
  19759.        End;
  19760.  
  19761.      PPid := Msg.Param1;
  19762.      Case PPid Of
  19763.        PP_FONTNAMESIZE:
  19764.        Begin
  19765.             {wichtig: verwende Msg.Receiver wegen umgeleiteten Nachrichten!}
  19766.             WinQueryPresParam(Msg.Receiver{Handle},
  19767.                               PPid,
  19768.                               0,
  19769.                               Nil,
  19770.                               SizeOf(cFNS),
  19771.                               cFNS,
  19772.                               QPF_NOINHERIT);
  19773.             FNS := cFNS;
  19774.             P := Pos('.',FNS);
  19775.             If P = 0 Then Exit;
  19776.             Val(Copy(FNS,1,P-1),Size,C);
  19777.             If C <> 0 Then Exit;
  19778.             Delete(FNS,1,P);
  19779.  
  19780.             aFont := Screen.GetFontFromPointSize(FNS,Size);
  19781.             If aFont <> Nil Then Font := aFont;
  19782.        End;
  19783.        PP_FOREGROUNDCOLOR:
  19784.        Begin
  19785.             {wichtig: verwende Msg.Receiver wegen umgeleiteten Nachrichten!}
  19786.             WinQueryPresParam(Msg.Receiver{Handle},
  19787.                               PPid,
  19788.                               0,
  19789.                               Nil,
  19790.                               4,
  19791.                               NewColor,
  19792.                               QPF_NOINHERIT);
  19793.             PenColor := NewColor;
  19794.        End;
  19795.        PP_BACKGROUNDCOLOR:
  19796.        Begin
  19797.             {wichtig: verwende Msg.Receiver wegen umgeleiteten Nachrichten!}
  19798.             WinQueryPresParam(Msg.Receiver{Handle},
  19799.                               PPid,
  19800.                               0,
  19801.                               Nil,
  19802.                               4,
  19803.                               NewColor,
  19804.                               QPF_NOINHERIT);
  19805.             color := NewColor;
  19806.        End;
  19807.      End;
  19808. End;
  19809. {$ENDIF}
  19810.  
  19811.  
  19812. Procedure TControl.WMCommand(Var Msg:TWMCommand);
  19813. Var  cmd:TCommand;
  19814.      Control:TControl;
  19815.      Button:TControl;
  19816.      FrameChild:TForm;
  19817.      entry:TMenuItem;
  19818.      aMsg:TMessage;
  19819.      Win:HWindow;
  19820.  
  19821.      s:String;
  19822.      Control1:TControl;
  19823. Begin
  19824.      If Application<>Nil Then Application.DestroyHintWindow;
  19825.  
  19826.      {$IFDEF Win32}
  19827.      Control := HandleToControl(Msg.Ctl);
  19828.      Try
  19829.         If Not (IsControl(Control)) Then Control := Nil;
  19830.      Except
  19831.         Exit;
  19832.      End;
  19833.      If Control <> Nil Then Control.ParentNotification(TMessage(Msg));
  19834.      If Msg.Handled Then Exit;
  19835.      {$ENDIF}
  19836.  
  19837.      If (Self Is TFrameControl) And (TFrameControl(Self).FChild <> Nil)
  19838.      Then Control := TFrameControl(Self).FChild
  19839.      Else Control := Self;
  19840.      FrameChild := TForm(Control);
  19841.  
  19842.      cmd := Msg.ItemId;
  19843.  
  19844.      {$IFDEF OS2}
  19845.      Case Msg.NotifyCode Of
  19846.        CMDSRC_PUSHBUTTON: {internal Button Command = FWindowId}
  19847.        Begin
  19848.             Win := WinWindowFromID(Handle,cmd);
  19849.             Button := HandleToControl(Win);
  19850.             If not IsControl(Button) Then Button:=Nil;
  19851.             If Button <> Nil Then
  19852.             Begin
  19853.                  FillChar(aMsg,SizeOf(aMsg),0);
  19854.                  {ReceiverClass = 0 -> no Default handler Is called}
  19855.                  aMsg.Msg := WM_CONTROL;
  19856.                  aMsg.Param1Lo := cmd;
  19857.                  aMsg.Param1Hi := BN_CLICKED;
  19858.                  Button.ParentNotification(aMsg);    {causes Click!}
  19859.                  If aMsg.Handled Then
  19860.                  Begin
  19861.                       Msg.Handled := True;
  19862.                       Exit;
  19863.                  End;
  19864.             End;
  19865.             Exit; {! because kbEsc destroyes the client Window}
  19866.        End;
  19867.        CMDSRC_MENU: {internal Menu Command}
  19868.        Begin
  19869.             entry := Application.GetMenuItem(cmd);
  19870.             If entry <> Nil Then
  19871.             Begin
  19872.                  If Not entry.Designed Then entry.Click;
  19873.                  Msg.Handled := True;
  19874.                  Exit;
  19875.             End;
  19876.        End;
  19877.        CMDSRC_ACCELERATOR: {internal Menu Command Or Real user Command}
  19878.        Begin
  19879.             entry := Application.GetMenuItem(cmd);
  19880.             If entry <> Nil Then
  19881.             Begin
  19882.                  If Not entry.Designed Then entry.Click;
  19883.                  Msg.Handled := True;
  19884.                  Exit;
  19885.             End;
  19886.             {Else - no Special Handling Of user Commands}
  19887.        End;
  19888.      End;
  19889.      {$ENDIF}
  19890.  
  19891.      {$IFDEF Win32}
  19892.      If (cmd >= cmInternalMenuItemBase) And (cmd < cmUser) Then
  19893.      Begin {probably an internal Menu Command}
  19894.           entry := Application.GetMenuItem(cmd);
  19895.           If entry <> Nil Then
  19896.           Begin
  19897.                Entry.Click;
  19898.                Msg.Handled := True;
  19899.                Exit;
  19900.           End;
  19901.      End;
  19902.      {$ENDIF}
  19903.  
  19904.  
  19905.      If Not Msg.Handled Then
  19906.      Begin
  19907.           If FrameChild.OnCommand <> Nil Then FrameChild.OnCommand(FrameChild,cmd);
  19908.           If cmd <> cmNull Then FrameChild.CommandEvent(cmd);
  19909.           If cmd <> cmNull Then FrameChild.DispatchCommand(Msg,cmd);
  19910.  
  19911.           If Not Msg.Handled Then
  19912.             If FrameChild Is TForm Then
  19913.               If FrameChild.FIsModal
  19914.                 Then FrameChild.DismissDlg(FrameChild.ModalResult);
  19915.  
  19916.           If cmd = cmNull Then Msg.Handled := True;
  19917.  
  19918.           If FrameChild <> Self Then Msg.Handled := True; {!!}
  19919.      End;
  19920. End;
  19921.  
  19922.  
  19923. {$HINTS OFF}
  19924. Procedure TControl.CommandEvent(Var Command:TCommand);
  19925. Begin
  19926.      Update;
  19927. End;
  19928. {$HINTS ON}
  19929.  
  19930.  
  19931. {$IFDEF Win32}
  19932. Procedure TControl.WMNotify(Var Msg:TMessage);
  19933. Var Header:^NMHDR;
  19934.     Control:TControl;
  19935. Begin
  19936.      Header:=Pointer(Msg.Param2);
  19937.      If Header=Nil Then Exit;
  19938.      Control := HandleToControl(Header^.hwndFrom);
  19939.      If not IsControl(Control) Then Control:=Nil;
  19940.      If Control<>Nil Then Control.ParentNotification(Msg);
  19941. End;
  19942. {$ENDIF}
  19943.  
  19944. {$IFDEF OS2}
  19945. Procedure TControl.WMControl(Var Msg:TMessage);
  19946. Var  Win:LongWord;
  19947.      Control:TControl;
  19948. Begin
  19949.      Win := WinWindowFromID(Handle,Msg.Param1Lo);
  19950.      Control := HandleToControl(Win);
  19951.      If not IsControl(Control) Then Control:=Nil;
  19952.      If Control <> Nil Then Control.ParentNotification(Msg);
  19953. End;
  19954. {$ENDIF}
  19955.  
  19956.  
  19957. Function TControl.GetNextTabControl:TControl;
  19958. Var  I,idx:LongInt;
  19959.      AChild:TControl;
  19960.      AParent:TControl;
  19961. Begin
  19962.      {Try First Child}
  19963.      If FTabList <> Nil Then
  19964.      For I := 0 To FTabList.Count-1 Do
  19965.      Begin
  19966.           Result := TControl(FTabList.Items[I]);
  19967.           If IsControl(Result) Then
  19968.             If Result.Enabled Then
  19969.               If Result.Visible Then Exit; {found}
  19970.      End;
  19971.      Result := Nil;
  19972.  
  19973.      {Try Next sibling}
  19974.      AChild := Self;
  19975.      While AChild <> Nil Do
  19976.      Begin
  19977.           AParent := AChild.FParent;
  19978.           If AParent = Nil Then Exit;
  19979.           If AParent.FTabList = Nil Then Exit;
  19980.  
  19981.           idx := AParent.FTabList.IndexOf(AChild);
  19982.           If idx < 0 Then Exit; {AChild Is Not In the tab List Of the Parent}
  19983.           While idx < AParent.FTabList.Count-1 Do
  19984.           Begin
  19985.                Result := AParent.FTabList.Items[idx+1];
  19986.                If Result.Enabled Then
  19987.                  If Result.Visible Then Exit;
  19988.                Inc(idx);
  19989.           End;
  19990.           Result := Nil;
  19991.           {no sibling available}
  19992.  
  19993.           If AParent Is TForm Then
  19994.           Begin
  19995.                Result := AParent.FTabList.First;
  19996.                If Result.Enabled Then
  19997.                  If Result.Visible Then Exit;
  19998.                Result := Nil;
  19999.           End;
  20000.  
  20001.           AChild := AParent;   {Try Next sibling Of the Parent}
  20002.      End;
  20003. End;
  20004.  
  20005.  
  20006. Function TControl.GetPrevTabControl:TControl;
  20007. Var  I,idx:LongInt;
  20008.      AChild:TControl;
  20009.      AParent:TControl;
  20010. Begin
  20011.      {Try Last Child}
  20012.      If FTabList <> Nil Then
  20013.      For I := FTabList.Count-1 Downto 0 Do
  20014.      Begin
  20015.           Result := TControl(FTabList.Items[I]);
  20016.           If IsControl(Result) Then
  20017.             If Result.Enabled Then
  20018.               If Result.Visible Then Exit; {found}
  20019.      End;
  20020.      Result := Nil;
  20021.  
  20022.      {Try Prev sibling}
  20023.      AChild := Self;
  20024.      While AChild <> Nil Do
  20025.      Begin
  20026.           AParent := AChild.FParent;
  20027.           If AParent = Nil Then Exit;
  20028.           If AParent.FTabList = Nil Then Exit;
  20029.  
  20030.           idx := AParent.FTabList.IndexOf(AChild);
  20031.           If idx < 0 Then Exit; {Self Is Not In the tab List Of the Parent}
  20032.           While idx > 0 Do
  20033.           Begin
  20034.                Result := AParent.FTabList.Items[idx-1];
  20035.                If Result.Enabled Then
  20036.                  If Result.Visible Then Exit;
  20037.                Dec(idx);
  20038.           End;
  20039.           Result := Nil;
  20040.           {no Prev sibling available}
  20041.  
  20042.           If AParent Is TForm Then
  20043.           Begin
  20044.                Result := AParent.FTabList.Last;
  20045.                If Result.Enabled Then
  20046.                  If Result.Visible Then Exit;
  20047.                Result := Nil;
  20048.           End;
  20049.  
  20050.           AChild := AParent;   {Try Next sibling Of the Parent}
  20051.      End;
  20052. End;
  20053.  
  20054.  
  20055. Procedure TControl.FocusTabControl(Next:Boolean);
  20056. Var  Control:TControl;
  20057.      Last:TControl;
  20058. Begin
  20059.      Control := Self;
  20060.      While True Do
  20061.      Begin
  20062.           Last := Control;
  20063.           If Next Then Control := Last.GetNextTabControl
  20064.           Else Control := Last.GetPrevTabControl;
  20065.  
  20066.           If IsControl(Control) Then
  20067.           Begin
  20068.                If Control = Self Then Exit;   {Test Max 1 Round}
  20069.                If Control = Last Then Exit;   {Nothing To Do}
  20070.                If Control.TabStop Then
  20071.                Begin
  20072.                     Control.Focus;
  20073.                     Exit;
  20074.                End;
  20075.           End
  20076.           Else Exit;
  20077.      End;
  20078. End;
  20079.  
  20080.  
  20081. Procedure TControl.FocusKeyControl(KeyCode:TKeyCode);
  20082. Var  Comp:TControl;
  20083.      ASelf:TControl;
  20084.      AParent:TControl;
  20085.      Nearest:TControl;
  20086.      I:LongInt;
  20087. Begin
  20088.      ASelf := Self;
  20089.      While ASelf.ComponentState * [csDetail] <> [] Do
  20090.      Begin
  20091.           If ASelf.Parent = Nil Then Exit;
  20092.           ASelf := ASelf.Parent;
  20093.      End;
  20094.      AParent := ASelf.Parent;
  20095.      If AParent = Nil Then Exit;
  20096.  
  20097.      Nearest := Nil;
  20098.      Case KeyCode Of
  20099.        kbCUp:
  20100.        Begin
  20101.             For I := 0 To AParent.ControlCount-1 Do
  20102.             Begin
  20103.                  Comp := AParent.Controls[I];
  20104.                  If Comp.Enabled Then
  20105.                    If Comp.FTabStop Then
  20106.                      If Comp.FCursorTabStop Then
  20107.                        If Comp.Visible Then
  20108.                          If Comp.Left < ASelf.Left + ASelf.Width Then
  20109.                            If Comp.Left + Comp.Width > ASelf.Left Then
  20110.                              If Comp.Bottom > ASelf.Bottom Then
  20111.                                If Nearest <> Nil Then
  20112.                                Begin
  20113.                                     If Comp.Bottom < Nearest.Bottom
  20114.                                     Then Nearest := Comp;
  20115.                                End
  20116.                                Else Nearest := Comp;
  20117.             End;
  20118.        End;
  20119.        kbCDown:
  20120.        Begin
  20121.             For I := 0 To AParent.ControlCount-1 Do
  20122.             Begin
  20123.                  Comp := AParent.Controls[I];
  20124.                  If Comp.Enabled Then
  20125.                    If Comp.FTabStop Then
  20126.                      If Comp.FCursorTabStop Then
  20127.                        If Comp.Visible Then
  20128.                          If Comp.Left < ASelf.Left + ASelf.Width Then
  20129.                            If Comp.Left + Comp.Width > ASelf.Left Then
  20130.                              If Comp.Bottom + Comp.Height < ASelf.Bottom + ASelf.Height Then
  20131.                                If Nearest <> Nil Then
  20132.                                Begin
  20133.                                     If Comp.Bottom + Comp.Height >
  20134.                                        Nearest.Bottom + Nearest.Height
  20135.                                     Then Nearest := Comp;
  20136.                                End
  20137.                                Else Nearest := Comp;
  20138.             End;
  20139.        End;
  20140.        kbCLeft:
  20141.        Begin
  20142.             For I := 0 To AParent.ControlCount-1 Do
  20143.             Begin
  20144.                  Comp := AParent.Controls[I];
  20145.                  If Comp.Enabled Then
  20146.                    If Comp.FTabStop Then
  20147.                      If Comp.FCursorTabStop Then
  20148.                        If Comp.Visible Then
  20149.                          If Comp.Bottom < ASelf.Bottom + ASelf.Height Then
  20150.                            If Comp.Bottom + Comp.Height > ASelf.Bottom Then
  20151.                              If Comp.Left + Comp.Width < ASelf.Left + ASelf.Width Then
  20152.                                If Nearest <> Nil Then
  20153.                                Begin
  20154.                                     If Comp.Left + Comp.Width >
  20155.                                        Nearest.Left + Nearest.Width
  20156.                                     Then Nearest := Comp;
  20157.                                End
  20158.                                Else Nearest := Comp;
  20159.             End;
  20160.        End;
  20161.        kbCRight:
  20162.        Begin
  20163.             For I := 0 To AParent.ControlCount-1 Do
  20164.             Begin
  20165.                  Comp := AParent.Controls[I];
  20166.                  If Comp.Enabled Then
  20167.                    If Comp.FTabStop Then
  20168.                      If Comp.FCursorTabStop Then
  20169.                        If Comp.Visible Then
  20170.                          If Comp.Bottom < ASelf.Bottom + ASelf.Height Then
  20171.                            If Comp.Bottom + Comp.Height > ASelf.Bottom Then
  20172.                              If Comp.Left > ASelf.Left Then
  20173.                                If Nearest <> Nil Then
  20174.                                Begin
  20175.                                     If Comp.Left < Nearest.Left
  20176.                                     Then Nearest := Comp;
  20177.                                End
  20178.                                Else Nearest := Comp;
  20179.             End;
  20180.        End;
  20181.        Else Exit;
  20182.      End;
  20183.      If Nearest <> Nil Then Nearest.CaptureFocus;
  20184. End;
  20185.  
  20186.  
  20187. Function TControl.EvaluateShortCut(KeyCode:TKeyCode):Boolean;
  20188. Var  Control:TControl;
  20189.      I:LongInt;
  20190. Begin
  20191.      For I := 0 To ControlCount-1 Do
  20192.      Begin
  20193.           Control := Controls[I];
  20194.           If Control.Enabled Then
  20195.             If Control.Visible Then
  20196.             Begin
  20197.                  Result := Control.EvaluateShortCut(KeyCode);
  20198.                  If Result Then Exit; {found}
  20199.             End;
  20200.      End;
  20201.      Result := False;
  20202. End;
  20203.  
  20204.  
  20205. {$HINTS OFF}
  20206. Procedure TControl.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
  20207. Begin
  20208.      Case KeyCode Of
  20209.        kbTab:
  20210.        Begin
  20211.             FocusTabControl(True);
  20212.             KeyCode := kbNull;
  20213.        End;
  20214.        kbShiftTab:
  20215.        Begin
  20216.             FocusTabControl(False);
  20217.             KeyCode := kbNull;
  20218.        End;
  20219.        kbCLeft,kbCRight,kbCUp,kbCDown:
  20220.        Begin
  20221.             FocusKeyControl(KeyCode);
  20222.             KeyCode := kbNull;
  20223.        End;
  20224.      End;
  20225.  
  20226.      {Mnemo}
  20227.      If KeyCode And kb_Alt <> 0 Then
  20228.        If KeyCode <> kbAlt Then
  20229.          If FForm Is TForm Then
  20230.            If FForm.EvaluateShortCut(KeyCode) Then KeyCode := kbNull;
  20231. End;
  20232.  
  20233.  
  20234. Procedure TControl.CharEvent(Var key:Char;RepeatCount:Byte);
  20235. Var  KeyCode:TKeyCode;
  20236. Begin
  20237.      If key = #0 Then Exit;
  20238.  
  20239.      {Mnemo}
  20240.      If FForm Is TForm Then
  20241.      Begin
  20242.           KeyCode := Ord(key) + kb_Char + kb_Alt;
  20243.           If FForm.EvaluateShortCut(KeyCode) Then key := #0;
  20244.      End;
  20245. End;
  20246. {$HINTS ON}
  20247.  
  20248.  
  20249. {$IFDEF OS2}
  20250. Procedure TControl.WMHelp(Var Msg:TMessage);
  20251. Var  HelpControl:TControl;
  20252. Begin
  20253.      Msg.Handled := True;
  20254.  
  20255.      HelpControl := Self;
  20256.      While HelpControl <> Nil Do
  20257.      Begin
  20258.           If HelpControl.HelpContext <> 0 Then
  20259.           Begin
  20260.                Application.Help(HelpControl.HelpContext);
  20261.                exit;
  20262.           End;
  20263.           HelpControl := HelpControl.Parent;
  20264.      End;
  20265.  
  20266.      Application.HelpContents;
  20267. End;
  20268. {$ENDIF}
  20269.  
  20270.  
  20271. Procedure TControl.SendScanMessage(Var Msg:TWMChar;Var KeyCode:TKeyCode;RepeatCounT:Byte);
  20272. Var  DNS:TDesignerNotifyStruct;
  20273. Begin
  20274.      If Self Is TFrameControl Then
  20275.        If TFrameControl(Self).FChild <> Nil Then
  20276.        Begin
  20277.             TFrameControl(Self).FChild.SendScanMessage(Msg,KeyCode,RepeatCount);
  20278.             Exit;
  20279.        End;
  20280.  
  20281.      If Designed Then
  20282.      Begin
  20283.           If FHandlesDesignKey Then
  20284.           Begin
  20285.                ScanEvent(KeyCode,RepeatCount);
  20286.  
  20287.                If KeyCode = kbNull Then
  20288.                Begin
  20289.                     Msg.Handled := True;
  20290.                     Msg.Result := 0;
  20291.                     Exit;  {Do Not send To Form Window}
  20292.                End;
  20293.           End;
  20294.  
  20295.           DNS.Sender := Self;
  20296.           DNS.Code := dncScan;
  20297.           DNS.return := 0;
  20298.           DNS.keyparam.KeyCode := KeyCode;
  20299.           DNS.keyparam.RepeatCount := RepeatCount;
  20300.           DesignerNotification(DNS);
  20301.           If DNS.return <> 0 Then
  20302.           Begin
  20303.                Msg.Handled := True;
  20304.                Msg.Result := 0;
  20305.           End;
  20306.      End
  20307.      Else
  20308.      Begin
  20309.           If OnScan <> Nil Then OnScan(Self,KeyCode);
  20310.           If KeyCode <> kbNull Then ScanEvent(KeyCode,RepeatCount);
  20311.  
  20312.           If KeyCode = kbNull Then
  20313.           Begin
  20314.                Msg.Handled := True;
  20315.                Msg.Result := 0;
  20316.           End;
  20317.      End;
  20318. End;
  20319.  
  20320.  
  20321. Procedure TControl.SendCharMessage(Var Msg:TWMChar;Var CH:Char;RepeatCount:Byte);
  20322. Var  DNS:TDesignerNotifyStruct;
  20323.      {$IFDEF OS2}
  20324.      dbcs:Byte;
  20325.      {$ENDIF}
  20326. Begin
  20327.      If Self Is TFrameControl Then
  20328.        If TFrameControl(Self).FChild <> Nil Then
  20329.        Begin
  20330.             TFrameControl(Self).FChild.SendCharMessage(Msg,CH,RepeatCount);
  20331.             Exit;
  20332.        End;
  20333.  
  20334.      If Designed Then
  20335.      Begin
  20336.           If FHandlesDesignKey Then
  20337.           Begin
  20338.                CharEvent(CH,RepeatCount);
  20339.                {$IFDEF OS2}
  20340.                dbcs := Hi(Msg.CharCode);
  20341.                If dbcs > 0 Then CharEvent(Char(dbcs),RepeatCount);
  20342.                {$ENDIF}
  20343.  
  20344.                If CH = #0 Then
  20345.                Begin
  20346.                     Msg.Handled := True;
  20347.                     Msg.Result := 0;
  20348.                     Exit;  {Do Not send To Form Window}
  20349.                End;
  20350.           End;
  20351.  
  20352.           DNS.Sender := Self;
  20353.           DNS.Code := dncChar;
  20354.           DNS.return := 0;
  20355.           DNS.keyparam.KeyCode := Ord(CH);
  20356.           DNS.keyparam.RepeatCount := RepeatCount;
  20357.           DesignerNotification(DNS);
  20358.           If DNS.return <> 0 Then
  20359.           Begin
  20360.                Msg.Handled := True;
  20361.                Msg.Result := 0;
  20362.           End;
  20363.      End
  20364.      Else
  20365.      Begin
  20366.           If OnKeyPress <> Nil Then OnKeyPress(Self,CH);
  20367.           If CH <> #0 Then CharEvent(CH,RepeatCount);
  20368.           {$IFDEF OS2}
  20369.           dbcs := Hi(Msg.CharCode);
  20370.           If dbcs > 0 Then {Insert the 2nd Byte of the dbcs Char}
  20371.           Begin
  20372.                If OnKeyPress <> Nil Then OnKeyPress(Self,Char(dbcs));
  20373.                If Char(dbcs) <> #0 Then CharEvent(Char(dbcs),RepeatCount);
  20374.  
  20375.                If Char(dbcs) = #0 Then
  20376.                Begin
  20377.                     Msg.Handled := True;
  20378.                     Msg.Result := 0;
  20379.                End;
  20380.           End;
  20381.           {$ENDIF}
  20382.  
  20383.           If CH = #0 Then
  20384.           Begin
  20385.                Msg.Handled := True;
  20386.                Msg.Result := 0;
  20387.           End;
  20388.      End;
  20389. End;
  20390.  
  20391.  
  20392. {$IFDEF Win32}
  20393. Procedure TControl.WMKeyDown(Var Msg:TMessage);
  20394. Var KeyCode:TKeyCode;
  20395.     RepeatCount:LongInt;
  20396. Begin
  20397.      If Application<>Nil Then Application.DestroyHintWindow;
  20398.  
  20399.      If IsControlLocked(Self) Then
  20400.      Begin
  20401.           Msg.Handled := True;
  20402.           Exit;
  20403.      End;
  20404.  
  20405.      KeyCode := Msg.Param1;
  20406.      RepeatCount := Msg.Param2 And 15;
  20407.  
  20408.      If KeyCode In [VK_LEFT,VK_RIGHT,VK_UP,VK_DOWN,VK_DELETE,VK_INSERT,
  20409.                     VK_END,VK_HOME,VK_NEXT,VK_PRIOR,VK_BACK,VK_RETURN,
  20410.                     VK_ESCAPE,VK_CAPITAL,VK_SCROLL,VK_PRINT,VK_CONTROL,
  20411.                     VK_MENU,VK_TAB,VK_NUMLOCK,VK_PAUSE,VK_SHIFT,
  20412.                     VK_F1..VK_F24] Then
  20413.      Begin
  20414.           {Real Virtual Code}
  20415.           Inc(KeyCode,kb_VK);
  20416.  
  20417.           If GetKeyState(VK_CONTROL) < 0 Then Inc(KeyCode,kb_Ctrl);
  20418.           If GetKeyState(VK_SHIFT) < 0 Then Inc(KeyCode,kb_Shift);
  20419.           If GetKeyState(VK_MENU) < 0 Then Inc(KeyCode,kb_Alt);
  20420.  
  20421.           SendScanMessage(TWMChar(Msg),KeyCode,RepeatCount);
  20422.  
  20423.           {Send Clicks for dialog buttons}
  20424.           If not Msg.Handled Then
  20425.             If not (Self Is TForm) Then
  20426.               If Form<>Nil Then If KeyCode In [kbEsc,kbCR] Then
  20427.                 Form.ScanEvent(KeyCode,RepeatCount);
  20428.  
  20429.           If KeyCode = kbEsc Then
  20430.           Begin
  20431.                Msg.Handled := True;
  20432.                Msg.Result := 0;
  20433.           End;
  20434.  
  20435.           Exit; {!!}
  20436.      End;
  20437.  
  20438.      {normal key}
  20439.      Inc(KeyCode,kb_Char);
  20440.  
  20441.      {check whether Control was Pressed}
  20442.      If GetKeyState(VK_CONTROL) < 0 Then
  20443.      Begin
  20444.           Inc(KeyCode,kb_Ctrl);
  20445.           If GetKeyState(VK_SHIFT) < 0 Then Inc(KeyCode,kb_Shift);
  20446.  
  20447.           SendScanMessage(TWMChar(Msg),KeyCode,RepeatCount);
  20448.      End;
  20449. End;
  20450.  
  20451.  
  20452. Procedure TControl.WMSysKeyDown(Var Msg:TMessage);
  20453. Var KeyCode:TKeyCode;
  20454.     RepeatCount:LongInt;
  20455. Begin
  20456.      If Application<>Nil Then Application.DestroyHintWindow;
  20457.  
  20458.      If IsControlLocked(Self) Then
  20459.      Begin
  20460.           Msg.Handled := True;
  20461.           Exit;
  20462.      End;
  20463.  
  20464.      KeyCode := Msg.Param1;
  20465.      RepeatCount := Msg.Param2 And 15;
  20466.  
  20467.      If KeyCode In [VK_LEFT,VK_RIGHT,VK_UP,VK_DOWN,VK_DELETE,VK_INSERT,
  20468.                     VK_END,VK_HOME,VK_NEXT,VK_PRIOR,VK_BACK,VK_RETURN,
  20469.                     VK_ESCAPE,VK_CAPITAL,VK_SCROLL,VK_PRINT,VK_CONTROL,
  20470.                     VK_MENU,VK_TAB,VK_NUMLOCK,VK_PAUSE,VK_SHIFT,
  20471.                     VK_F1..VK_F24] Then
  20472.      Begin
  20473.           {Real Virtual Code}
  20474.           Inc(KeyCode,kb_VK);
  20475.  
  20476.           If GetKeyState(VK_CONTROL) < 0 Then Inc(KeyCode,kb_Ctrl);
  20477.           If GetKeyState(VK_SHIFT) < 0 Then Inc(KeyCode,kb_Shift);
  20478.           If GetKeyState(VK_MENU) < 0 Then Inc(KeyCode,kb_Alt);
  20479.  
  20480.           SendScanMessage(TWMChar(Msg),KeyCode,RepeatCount);
  20481.      End;
  20482. End;
  20483. {$ENDIF}
  20484.  
  20485.  
  20486. Procedure TControl.WMChar(Var Msg:TWMChar);
  20487. Var  CH:Char;
  20488.      fsFlags:Word;
  20489.      ascii:Word;
  20490.      virtkey:Word;
  20491.      REP:Byte;
  20492.      scan:TKeyCode;
  20493.      Param:TKeyCode;
  20494. {$IFDEF OS2}
  20495. Label lsc;
  20496. {$ENDIF}
  20497. Begin
  20498.      If Application<>Nil Then Application.DestroyHintWindow;
  20499.  
  20500.      If IsControlLocked(Self) Then
  20501.      Begin
  20502.           Msg.Handled := True;
  20503.           Exit;
  20504.      End;
  20505.  
  20506.      {$IFDEF OS2}
  20507.      fsFlags := Msg.KeyData;
  20508.      REP := GetKeyRepeat(TMessage(Msg));
  20509.      scan := Msg.ScanCode;
  20510.      ascii := Lo(Msg.CharCode);
  20511.      virtkey := Msg.VirtualKeyCode;
  20512.  
  20513.      If Self Is TFrameControl Then Exit;  {send To client by DefWindowProc}
  20514.  
  20515.      If fsFlags And KC_KEYUP <> 0 Then Exit;
  20516.  
  20517.      If fsFlags And KC_DEADKEY <> 0 Then  {wait For composite}
  20518.      Begin
  20519.           FLastDeadKey := ascii;
  20520.           Exit;
  20521.      End;
  20522.  
  20523.      If fsFlags And KC_INVALIDCOMP <> 0 Then
  20524.      Begin {invalid composite after deadkey}
  20525.           CH := Chr(FLastDeadKey);
  20526.           SendCharMessage(Msg,CH,1);
  20527.           If fsFlags And KC_CHAR = 0 Then Exit;  {ignore scan Or Virtual key}
  20528.      End;
  20529.  
  20530.      If fsFlags And KC_CHAR <> 0 Then
  20531.      Begin
  20532.           If (ascii < 32) Or (fsFlags And KC_CTRL <> 0) Then Goto lsc;
  20533.           If (fsFlags And KC_VIRTUALKEY <> 0) And (fsFlags And KC_SHIFT <> 0)
  20534.           Then Goto lsc;    {numerical block}
  20535.  
  20536.           CH := Chr(ascii);
  20537.           SendCharMessage(Msg,CH,REP);
  20538.           Msg.CharCode := Ord(CH)+256*(Msg.CharCode Shr 8);
  20539.      End
  20540.      Else
  20541.      Begin
  20542. lsc:
  20543.           Param := 0;
  20544.           If fsFlags And KC_VIRTUALKEY <> 0 Then Param := virtkey Or kb_VK
  20545.           Else Param := ascii Or kb_Char;       {E.G. Ctrl-J}
  20546.  
  20547.           If fsFlags And KC_ALT <> 0 Then Param := Param Or kb_Alt;
  20548.           If fsFlags And KC_SHIFT <> 0 Then Param := Param Or kb_Shift;
  20549.           If fsFlags And KC_CTRL <> 0 Then Param := Param Or kb_Ctrl;
  20550.  
  20551.           SendScanMessage(Msg,Param,REP);
  20552.      End;
  20553.      {$ENDIF}
  20554.  
  20555.      {$IFDEF Win32}
  20556.      CH := Chr(Msg.CharCode);
  20557.      //Ansi to oem conversion for Σ,÷,ⁿ,─,╓,▄,▀
  20558.      Case ord(CH) Of
  20559.         $E4:ch:=chr(132);
  20560.         $F6:ch:=chr(148);
  20561.         $FC:ch:=chr(129);
  20562.         $C4:ch:=chr(142);
  20563.         $D6:ch:=chr(153);
  20564.         $DC:ch:=chr(154);
  20565.         $DF:ch:=chr(225);
  20566.      End; //case
  20567.      REP := Msg.KeyData And 15;
  20568.  
  20569.      If CH < #32 Then Exit;  {Not printable}
  20570.  
  20571.      SendCharMessage(Msg,CH,REP);
  20572.      Msg.CharCode := Ord(CH);
  20573.      {$ENDIF}
  20574.  
  20575.      Try {maybe Self Is destroyed}
  20576.         If Self Is TForm Then Msg.Handled := True; {don't Dispatch it further}
  20577.      Except
  20578.         Msg.Handled := True;
  20579.      End;
  20580. End;
  20581.  
  20582.  
  20583. {$IFDEF OS2}
  20584. Procedure TControl.WMQueryConvertPos(Var Msg:TMessage);
  20585. Var  prec:PRect;
  20586.      pt:TPoint;
  20587. Begin
  20588.      If IsStandardControl Then Exit;
  20589.  
  20590.      {Param1 Points To A Rectangle}
  20591.      prec := PRect(Msg.Param1);
  20592.  
  20593.      pt.X := -1;
  20594.      pt.Y := -1;
  20595.      If QueryConvertPos(pt) Then
  20596.      Begin
  20597.           prec^.Left := pt.X;
  20598.           prec^.Bottom := pt.Y;
  20599.           prec^.Right := 0;
  20600.           prec^.Top := 0;
  20601.           Msg.Result := QCP_CONVERT;
  20602.      End
  20603.      Else Msg.Result := QCP_NOCONVERT;
  20604.      Msg.Handled := True;
  20605. End;
  20606. {$ENDIF}
  20607.  
  20608.  
  20609. {$HINTS OFF}
  20610. Function TControl.QueryConvertPos(Var Pos:TPoint):Boolean;
  20611. Begin
  20612.      Result := True; {Use Standard Position}
  20613. End;
  20614. {$HINTS ON}
  20615.  
  20616.  
  20617. {$HINTS OFF}
  20618. Procedure TControl.Scroll(Sender:TScrollBar;ScrollCode:TScrollCode;Var ScrollPos:LOnGint);
  20619. Begin
  20620. End;
  20621. {$HINTS ON}
  20622.  
  20623.  
  20624. Procedure TControl.WMHScroll(Var Msg:TWMScroll);
  20625. Var  target:TControl;
  20626.      ScrollBar:TScrollBar;
  20627.      ScrollCode:TScrollCode;
  20628.      ScrollPos:LongInt;
  20629.      {$IFDEF OS2}
  20630.      Win:LongWord;
  20631.      {$ENDIF}
  20632. Begin
  20633.      If Application<>Nil Then Application.DestroyHintWindow;
  20634.  
  20635.      target := Self;
  20636.      If Self Is TFrameControl Then
  20637.        If TFrameControl(Self).FChild <> Nil
  20638.        Then target := TFrameControl(Self).FChild;
  20639.  
  20640.      {$IFDEF OS2}
  20641.      Win := WinWindowFromID(Handle,Msg.ScrollBarId);
  20642.      ScrollBar := TScrollBar(HandleToControl(Win));
  20643.      If Not (ScrollBar Is TScrollBar) Then Exit;
  20644.  
  20645.      Case Msg.ScrollCode Of
  20646.          SB_LINERIGHT:
  20647.          Begin
  20648.               ScrollCode := scColumnRight;
  20649.               ScrollPos := ScrollBar.Position + ScrollBar.SmallChange;
  20650.          End;
  20651.          SB_LINELEFT:
  20652.          Begin
  20653.               ScrollCode := scColumnLeft;
  20654.               ScrollPos := ScrollBar.Position - ScrollBar.SmallChange;
  20655.          End;
  20656.          SB_PAGERIGHT:
  20657.          Begin
  20658.               ScrollCode := scPageRight;
  20659.               ScrollPos := ScrollBar.Position + ScrollBar.LargeChange;
  20660.          End;
  20661.          SB_PAGELEFT:
  20662.          Begin
  20663.               ScrollCode := scPageLeft;
  20664.               ScrollPos := ScrollBar.Position - ScrollBar.LargeChange;
  20665.          End;
  20666.          SB_SLIDERTRACK:
  20667.          Begin
  20668.               ScrollCode := scHorzTrack;
  20669.               ScrollPos := Msg.Pos;
  20670.               {transform}
  20671.               ScrollPos := Round(ScrollPos * ScrollBar.FScale);
  20672.               ScrollPos := ScrollPos + ScrollBar.Min;
  20673.          End;
  20674.          SB_SLIDERPOSITION:
  20675.          Begin
  20676.               ScrollCode := scHorzPosition;
  20677.               ScrollPos := Msg.Pos;
  20678.               {transform}
  20679.               ScrollPos := Round(ScrollPos * ScrollBar.FScale);
  20680.               ScrollPos := ScrollPos + ScrollBar.Min;
  20681.          End;
  20682.          SB_ENDSCROLL:
  20683.          Begin
  20684.               ScrollCode := scHorzEndScroll;
  20685.               ScrollPos := ScrollBar.Position;
  20686.          End;
  20687.      End; {Case}
  20688.      {$ENDIF}
  20689.  
  20690.      {$IFDEF Win32}
  20691.      ScrollBar := TScrollBar(HandleToControl(Msg.ScrollBar));
  20692.      If Not (ScrollBar Is TScrollBar) Then Exit;
  20693.  
  20694.      Case Msg.ScrollCode Of
  20695.          SB_LINERIGHT:
  20696.          Begin
  20697.               ScrollCode := scColumnRight;
  20698.               ScrollPos := ScrollBar.Position + ScrollBar.SmallChange;
  20699.          End;
  20700.          SB_LINELEFT:
  20701.          Begin
  20702.               ScrollCode := scColumnLeft;
  20703.               ScrollPos := ScrollBar.Position - ScrollBar.SmallChange;
  20704.          End;
  20705.          SB_PAGERIGHT:
  20706.          Begin
  20707.               ScrollCode := scPageRight;
  20708.               ScrollPos := ScrollBar.Position + ScrollBar.LargeChange;
  20709.          End;
  20710.          SB_PAGELEFT:
  20711.          Begin
  20712.               ScrollCode := scPageLeft;
  20713.               ScrollPos := ScrollBar.Position - ScrollBar.LargeChange;
  20714.          End;
  20715.          SB_THUMBTRACK:
  20716.          Begin
  20717.               ScrollCode := scHorzTrack;
  20718.               ScrollPos := Msg.Pos;
  20719.               {transform}
  20720.               ScrollPos := Round(ScrollPos * ScrollBar.FScale);
  20721.               ScrollPos := ScrollPos + ScrollBar.Min;
  20722.          End;
  20723.          SB_THUMBPOSITION:
  20724.          Begin
  20725.               ScrollCode := scHorzPosition;
  20726.               ScrollPos := Msg.Pos;
  20727.               {transform}
  20728.               ScrollPos := Round(ScrollPos * ScrollBar.FScale);
  20729.               ScrollPos := ScrollPos + ScrollBar.Min;
  20730.          End;
  20731.          SB_ENDSCROLL:
  20732.          Begin
  20733.               ScrollCode := scHorzEndScroll;
  20734.               ScrollPos := ScrollBar.Position;
  20735.          End;
  20736.          SB_BOTTOM: Exit;
  20737.          SB_TOP: Exit;
  20738.      End;
  20739.      {$ENDIF}
  20740.  
  20741.      If ScrollPos < ScrollBar.Min Then ScrollPos := ScrollBar.Min;
  20742.      If ScrollPos > ScrollBar.FCalcRange Then ScrollPos := ScrollBar.FCalcRange;
  20743.  
  20744.      If ScrollCode <> scHorzEndScroll Then
  20745.        If ScrollCode <> scHorzPosition Then
  20746.          If ScrollPos = ScrollBar.Position Then Exit;
  20747.  
  20748.      target.Scroll(ScrollBar,ScrollCode,ScrollPos);
  20749.      If ScrollBar.OnScroll <> Nil
  20750.      Then ScrollBar.OnScroll(ScrollBar,ScrollCode,ScrollPos);
  20751.  
  20752.      ScrollBar.Position := ScrollPos; {Set the final Position}
  20753.  
  20754.      If ScrollBar.FOnChange<>Nil Then ScrollBar.FOnChange(Self);
  20755.  
  20756.      Msg.Handled := True; {!!}
  20757.      Msg.Result := 0;
  20758. End;
  20759.  
  20760.  
  20761. Procedure TControl.WMVScroll(Var Msg:TWMScroll);
  20762. Var  target:TControl;
  20763.      ScrollBar:TScrollBar;
  20764.      ScrollCode:TScrollCode;
  20765.      ScrollPos:LongInt;
  20766.      {$IFDEF OS2}
  20767.      Win:LongWord;
  20768.      {$ENDIF}
  20769. Begin
  20770.      If Application<>Nil Then Application.DestroyHintWindow;
  20771.  
  20772.      target := Self;
  20773.      If Self Is TFrameControl Then
  20774.        If TFrameControl(Self).FChild <> Nil
  20775.        Then target := TFrameControl(Self).FChild;
  20776.  
  20777.      {$IFDEF OS2}
  20778.      Win := WinWindowFromID(Handle,Msg.ScrollBarId);
  20779.      ScrollBar := TScrollBar(HandleToControl(Win));
  20780.      If Not (ScrollBar Is TScrollBar) Then Exit;
  20781.  
  20782.      Case Msg.ScrollCode Of
  20783.          SB_LINEUP:
  20784.          Begin
  20785.               ScrollCode := scLineUp;
  20786.               ScrollPos := ScrollBar.Position - ScrollBar.SmallChange;
  20787.          End;
  20788.          SB_LINEDOWN:
  20789.          Begin
  20790.               ScrollCode := scLineDown;
  20791.               ScrollPos := ScrollBar.Position + ScrollBar.SmallChange;
  20792.          End;
  20793.          SB_PAGEUP:
  20794.          Begin
  20795.               ScrollCode := scPageUp;
  20796.               ScrollPos := ScrollBar.Position - ScrollBar.LargeChange;
  20797.          End;
  20798.          SB_PAGEDOWN:
  20799.          Begin
  20800.               ScrollCode := scPageDown;
  20801.               ScrollPos := ScrollBar.Position + ScrollBar.LargeChange;
  20802.          End;
  20803.          SB_SLIDERTRACK:
  20804.          Begin
  20805.               ScrollCode := scVertTrack;
  20806.               ScrollPos := Msg.Pos;
  20807.               {transform}
  20808.               ScrollPos := Round(ScrollPos * ScrollBar.FScale);
  20809.               ScrollPos := ScrollPos + ScrollBar.Min;
  20810.          End;
  20811.          SB_SLIDERPOSITION:
  20812.          Begin
  20813.               ScrollCode := scVertPosition;
  20814.               ScrollPos := Msg.Pos;
  20815.               {transform}
  20816.               ScrollPos := Round(ScrollPos * ScrollBar.FScale);
  20817.               ScrollPos := ScrollPos + ScrollBar.Min;
  20818.          End;
  20819.          SB_ENDSCROLL:
  20820.          Begin
  20821.               ScrollCode := scVertEndScroll;
  20822.               ScrollPos := ScrollBar.Position;
  20823.          End;
  20824.      End; {Case}
  20825.      {$ENDIF}
  20826.  
  20827.      {$IFDEF Win32}
  20828.      ScrollBar := TScrollBar(HandleToControl(Msg.ScrollBar));
  20829.      If Not (ScrollBar Is TScrollBar) Then Exit;
  20830.  
  20831.      Case Msg.ScrollCode Of
  20832.          SB_LINEUP:
  20833.          Begin
  20834.               ScrollCode := scLineUp;
  20835.               ScrollPos := ScrollBar.Position - ScrollBar.SmallChange;
  20836.          End;
  20837.          SB_LINEDOWN:
  20838.          Begin
  20839.               ScrollCode := scLineDown;
  20840.               ScrollPos := ScrollBar.Position + ScrollBar.SmallChange;
  20841.          End;
  20842.          SB_PAGEUP:
  20843.          Begin
  20844.               ScrollCode := scPageUp;
  20845.               ScrollPos := ScrollBar.Position - ScrollBar.LargeChange;
  20846.          End;
  20847.          SB_PAGEDOWN:
  20848.          Begin
  20849.               ScrollCode := scPageDown;
  20850.               ScrollPos := ScrollBar.Position + ScrollBar.LargeChange;
  20851.          End;
  20852.          SB_THUMBTRACK:
  20853.          Begin
  20854.               ScrollCode := scVertTrack;
  20855.               ScrollPos := Msg.Pos;
  20856.               {transform}
  20857.               ScrollPos := Round(ScrollPos * ScrollBar.FScale);
  20858.               ScrollPos := ScrollPos + ScrollBar.Min;
  20859.          End;
  20860.          SB_THUMBPOSITION:
  20861.          Begin
  20862.               ScrollCode := scVertPosition;
  20863.               ScrollPos := Msg.Pos;
  20864.               {transform}
  20865.               ScrollPos := Round(ScrollPos * ScrollBar.FScale);
  20866.               ScrollPos := ScrollPos + ScrollBar.Min;
  20867.          End;
  20868.          SB_ENDSCROLL:
  20869.          Begin
  20870.               ScrollCode := scVertEndScroll;
  20871.               ScrollPos := ScrollBar.Position;
  20872.          End;
  20873.          SB_BOTTOM: Exit;
  20874.          SB_TOP: Exit;
  20875.      End;
  20876.      {$ENDIF}
  20877.  
  20878.      If ScrollPos < ScrollBar.Min Then ScrollPos := ScrollBar.Min;
  20879.      If ScrollPos > ScrollBar.FCalcRange Then ScrollPos := ScrollBar.FCalcRange;
  20880.  
  20881.      If ScrollCode <> scVertEndScroll Then
  20882.        If ScrollCode <> scVertPosition Then
  20883.          If ScrollPos = ScrollBar.Position Then Exit;
  20884.  
  20885.      target.Scroll(ScrollBar,ScrollCode,ScrollPos);
  20886.      If ScrollBar.OnScroll <> Nil
  20887.      Then ScrollBar.OnScroll(ScrollBar,ScrollCode,ScrollPos);
  20888.  
  20889.      ScrollBar.Position := ScrollPos; {Set the final Position}
  20890.  
  20891.      If ScrollBar.FOnChange<>Nil Then ScrollBar.FOnChange(Self);
  20892.  
  20893.      Msg.Handled := True; {!!}
  20894.      Msg.Result := 0;
  20895. End;
  20896.  
  20897.  
  20898. {$IFDEF Win32}
  20899. Procedure TControl.SetCtlColor(Var Msg:TMessage);
  20900. Var  Control:TControl;
  20901. Begin
  20902.      Control := HandleToControl(Msg.Param2); {Get VMT Pointer}
  20903.      If IsControl(Control) Then
  20904.      Begin
  20905.           WinGDI.SetTextColor(Msg.Param1,
  20906.                               RGBToWinColor(SysColorToRGB(Control.PenColor)));
  20907.           WinGDI.SetBkColor(Msg.Param1,
  20908.                             RGBToWinColor(SysColorToRGB(Control.color)));
  20909.           Msg.Result := Control.FCtlBrush;
  20910.      End
  20911.      Else {Set Standard}
  20912.      Begin
  20913.           WinGDI.SetTextColor(Msg.Param1,
  20914.                               RGBToWinColor(SysColorToRGB(PenColor)));
  20915.           WinGDI.SetBkColor(Msg.Param1,
  20916.                             RGBToWinColor(SysColorToRGB(color)));
  20917.           Msg.Result := FCtlBrush;
  20918.      End;
  20919.      Msg.Handled := True;
  20920. End;
  20921.  
  20922.  
  20923. Procedure TControl.WMCtlColorBtn(Var Msg:TMessage);
  20924. Begin
  20925.      SetCtlColor(Msg);
  20926. End;
  20927.  
  20928. Procedure TControl.WMCtlColorEdit(Var Msg:TMessage);
  20929. Begin
  20930.      SetCtlColor(Msg);
  20931. End;
  20932.  
  20933. Procedure TControl.WMCtlColorListBox(Var Msg:TMessage);
  20934. Begin
  20935.      SetCtlColor(Msg);
  20936. End;
  20937.  
  20938. Procedure TControl.WMCtlColorStatic(Var Msg:TMessage);
  20939. Begin
  20940.      SetCtlColor(Msg);
  20941. End;
  20942.  
  20943. Procedure TControl.WMCtlColorDlg(Var Msg:TMessage);
  20944. Begin
  20945.      SetCtlColor(Msg);
  20946. End;
  20947.  
  20948. Procedure TControl.WMCtlColorScrollBar(Var Msg:TMessage);
  20949. Var  Control:TControl;
  20950. Begin
  20951.      Control := HandleToControl(Msg.Param2); {VMT Pointer}
  20952.      If IsControl(Control) Then
  20953.        If Control.color = clScrollbar Then Exit;      {DefWndProc!}
  20954.        {dont Change Default brush! (Pattern will Get lost)}
  20955.  
  20956.      SetCtlColor(Msg);
  20957. End;
  20958. {$ENDIF}
  20959.  
  20960.  
  20961. {captive = True -> Capture ON}
  20962. Procedure TControl.SetMouseCapture(captive:Boolean);
  20963. Begin
  20964.      If Handle = 0 Then Exit;
  20965.      FMouseCapture := captive;
  20966.      {$IFDEF OS2}
  20967.      If captive Then WinSetCapture(HWND_DESKTOP,Handle)
  20968.      Else WinSetCapture(HWND_DESKTOP,0);
  20969.      {$ENDIF}
  20970.      {$IFDEF Win32}
  20971.      If captive Then SetCapture(Handle)
  20972.      Else ReleaseCapture;
  20973.      {$ENDIF}
  20974. End;
  20975.  
  20976.  
  20977. {$HINTS OFF}
  20978. Procedure TControl.WMCaptureFocus(Var Msg:TMessage);
  20979. Begin
  20980.      Focus;
  20981. End;
  20982. {$HINTS ON}
  20983.  
  20984.  
  20985. Procedure TControl.Focus;
  20986. Begin
  20987.      If IsControlLocked(Self) Then Exit;
  20988.  
  20989.      If Handle <> 0 Then
  20990.      Begin
  20991.           {$IFDEF OS2}
  20992.           WinSetFocus(HWND_DESKTOP,Handle);
  20993.           {$ENDIF}
  20994.           {$IFDEF Win32}
  20995.           WinUser.SetFocus(Handle);
  20996.           {$ENDIF}
  20997.      End;
  20998.  
  20999.      If FForm Is TForm Then FForm.FActiveControl := Self;
  21000.      Screen.FActiveControl := Self;
  21001.  
  21002.      Screen.UpdateLastActive;
  21003. End;
  21004.  
  21005.  
  21006. {Use This Function within SetFocus notify method To redirect the Focus}
  21007. {Otherwise Is it Not possible To Change the Focus}
  21008. Procedure TControl.CaptureFocus;
  21009. Begin
  21010.      If Handle <> 0 Then
  21011.      Begin
  21012.           {$IFDEF OS2}
  21013.           PostMsg(Handle,WM_CAPTUREFOCUS,0,0);
  21014.           {$ENDIF}
  21015.           {$IFDEF Win32}
  21016.           WinUser.SetFocus(Handle);
  21017.           {$ENDIF}
  21018.      End
  21019.      Else Focus;
  21020. End;
  21021.  
  21022.  
  21023. Function TControl.Focused:Boolean;
  21024. Begin
  21025.      Result := FHasFocus;
  21026. End;
  21027.  
  21028.  
  21029. Function TControl.GetEnabled:Boolean;
  21030. Begin
  21031.      {$IFDEF OS2}
  21032.      If (Handle = 0) Or Designed Then Result := FEnabled
  21033.      Else Result := WinIsWindowEnabled(Handle);
  21034.      {$ENDIF}
  21035.      {$IFDEF Win32}
  21036.      If (Handle = 0) Or Designed Then Result := FEnabled
  21037.      Else Result := IsWindowEnabled(Handle);
  21038.      {$ENDIF}
  21039. End;
  21040.  
  21041.  
  21042. Procedure TControl.SetEnabled(NewState:Boolean);
  21043. Var  i:LongInt;
  21044. Begin
  21045.      FEnabled := NewState;
  21046.      If (Handle = 0) Or Designed Then
  21047.      Begin
  21048.           If Handle<>0 Then Invalidate;
  21049.           Exit;
  21050.      End;
  21051.  
  21052.      If FEnabled Then Enable
  21053.      Else Disable;
  21054.  
  21055.      For i := 0 To ControlCount-1 Do
  21056.      Begin
  21057.           Controls[i].Enabled := FEnabled;
  21058.      End;
  21059. End;
  21060.  
  21061.  
  21062. Procedure TControl.Enable;
  21063. Begin
  21064.      If Handle = 0 Then Exit;
  21065.      {$IFDEF OS2}
  21066.      WinEnableWindow(Handle,True);
  21067.      {$ENDIF}
  21068.      {$IFDEF Win32}
  21069.      EnableWindow(Handle,True);
  21070.      If not ((Self Is TForm)Or(Self Is TFrameControl)) Then Invalidate;
  21071.      {$ENDIF}
  21072. End;
  21073.  
  21074.  
  21075. Procedure TControl.Disable;
  21076. Begin
  21077.      If Handle = 0 Then Exit;
  21078.      {$IFDEF OS2}
  21079.      WinEnableWindow(Handle,False);
  21080.      {$ENDIF}
  21081.      {$IFDEF Win32}
  21082.      EnableWindow(Handle,False);
  21083.      If not ((Self Is TForm)Or(Self Is TFrameControl)) Then Invalidate;
  21084.      {$ENDIF}
  21085. End;
  21086.  
  21087.  
  21088. Function TControl.IsWindowVisible:Boolean;
  21089. Begin
  21090.      {$IFDEF OS2}
  21091.      If FFrame <> Nil Then Result := WinIsWindowVisible(FFrame.Handle)
  21092.      Else Result := WinIsWindowVisible(Handle);
  21093.      {$ENDIF}
  21094.      {$IFDEF Win32}
  21095.      If FFrame <> Nil Then Result := WinUser.IsWindowVisible(FFrame.Handle)
  21096.      Else Result := WinUser.IsWindowVisible(Handle);
  21097.      {$ENDIF}
  21098. End;
  21099.  
  21100.  
  21101. Function TControl.GetShowing;
  21102. Begin
  21103.      If Handle=0 Then Result:=False
  21104.      Else Result:=GetVisible;
  21105. End;
  21106.  
  21107.  
  21108. Function TControl.GetVisible:Boolean;
  21109. Begin
  21110.      If (Handle = 0) Or Designed Then Result := FVisible
  21111.      Else Result := IsWindowVisible;
  21112. End;
  21113.  
  21114.  
  21115. Procedure TControl.SetVisible(NewState:Boolean);
  21116. Begin
  21117.      If NewState Then
  21118.      Begin
  21119.           FVisible := True;
  21120.           If (Handle = 0) Or Designed Then Exit;
  21121.           Show;
  21122.      End
  21123.      Else
  21124.      Begin
  21125.           FVisible := False;
  21126.           If (Handle = 0) Or Designed Then Exit;
  21127.           Hide;
  21128.      End;
  21129. End;
  21130.  
  21131.  
  21132. Function TControl.GetTabOrder:LongInt;
  21133. Begin
  21134.      Result := -1;
  21135.      If FParent <> Nil Then
  21136.        If FParent.FTabList <> Nil
  21137.        Then Result := FParent.FTabList.IndexOf(Self);
  21138. End;
  21139.  
  21140.  
  21141. Procedure TControl.SetTabOrder(Value:LongInt);
  21142. Var  idx:LongInt;
  21143.      ACount:LongInt;
  21144. Begin
  21145.      If Value < 0 Then Exit;
  21146.  
  21147.      If ComponentState * [csReading] <> [] Then
  21148.      Begin
  21149.           FTabOrder := Value;
  21150.           Exit;
  21151.      End;
  21152.  
  21153.      If FParent <> Nil Then
  21154.        If FParent.FTabList <> Nil Then
  21155.        Begin
  21156.             ACount := FParent.FTabList.Count;
  21157.             If Value >= ACount Then Value := ACount - 1;
  21158.             idx := FParent.FTabList.IndexOf(Self);
  21159.             If idx >= 0 Then FParent.FTabList.Move(idx,Value);
  21160.        End;
  21161. End;
  21162.  
  21163. Procedure TControl.LoadedFromSCU(SCUParent:TComponent);
  21164. Var  Control:TControl;
  21165.      NewList:TList;
  21166.      I:LongInt;
  21167.      ControlTabOrder:LongInt;
  21168. Begin
  21169.      Inherited LoadedFromSCU(SCUParent);
  21170.  
  21171.      If IsControl(TControl(SCUParent)) Then SetParent(TControl(SCUParent));
  21172.  
  21173.      {Update Special Alignment, Parent Is Valid now}
  21174.      If Align In [alFrame,alScale,alFixedRightBottom,
  21175.                   alFixedRightTop,alFixedLeftTop] Then SetAlign(Align);
  21176.  
  21177.      {reorder the tablist}
  21178.      If FTabList = Nil Then Exit;
  21179.      If FTabList.Count < 2 Then Exit; {Nothing To Do}
  21180.  
  21181.      NewList.Create;
  21182.      NewList.Count := FTabList.Count; {Fill With Nil}
  21183.      For I := 0 To FTabList.Count-1 Do
  21184.      Begin
  21185.           Control := FTabList.Items[I];
  21186.           If Not (IsControl(Control)) Then continue;
  21187.           If Control.ComponentState * [csLoaded] <> []
  21188.           Then ControlTabOrder := Control.FTabOrder
  21189.           Else ControlTabOrder := I;
  21190.  
  21191.           If ControlTabOrder < 0 Then continue; {was Not In the list?}
  21192.           If ControlTabOrder >= FTabList.Count Then continue;
  21193.  
  21194.           NewList.Items[ControlTabOrder] := Control;
  21195.      End;
  21196.  
  21197.      NewList.Pack; {Remove NILs}
  21198.      FTabList.Destroy;
  21199.      FTabList := NewList;
  21200. End;
  21201.  
  21202.  
  21203. Procedure TControl.Redraw(Const rec:TRect);
  21204. Begin
  21205.      If FCanvas = Nil Then Exit;
  21206.      FCanvas.FillRect(rec,color);
  21207. End;
  21208.  
  21209.  
  21210. Procedure TControl.Refresh;
  21211. Begin
  21212.      Invalidate;
  21213.      Update;
  21214. End;
  21215.  
  21216.  
  21217. Procedure TControl.Repaint;
  21218. Begin
  21219.      Refresh;
  21220. End;
  21221.  
  21222.  
  21223. Procedure TControl.Update;
  21224. Begin
  21225.      If Handle = 0 Then Exit;
  21226.      If Not FUpdateEnabled Then Exit;
  21227.      {$IFDEF OS2}
  21228.      WinUpdateWindow(Handle);
  21229.      {$ENDIF}
  21230.      {$IFDEF Win32}
  21231.      WinUser.UpdateWindow(Handle);
  21232.      {$ENDIF}
  21233. End;
  21234.  
  21235.  
  21236. Procedure TControl.Invalidate;
  21237. {$IFDEF WIN32}
  21238. Var
  21239.     t:LongInt;
  21240. {$ENDIF}
  21241. Begin
  21242.      If Handle = 0 Then Exit;
  21243.      If Not FUpdateEnabled Then Exit;
  21244.      If FCanvas <> Nil Then FCanvas.DeleteClipRegion;
  21245.      If Application<>Nil Then Application.DestroyHintWindow;
  21246.  
  21247.      {$IFDEF OS2}
  21248.      WinInvalidateRect(Handle,Nil,True);
  21249.      {$ENDIF}
  21250.      {$IFDEF Win32}
  21251.      WinUser.InvalidateRect(Handle,Nil,True);
  21252.      For t:=0 To ControlCount-1 Do Controls[t].Invalidate;
  21253.      {$ENDIF}
  21254. End;
  21255.  
  21256.  
  21257. Procedure TControl.InvalidateRect(Const rec:TRect);
  21258. Var  rc:TRect;
  21259. Begin
  21260.      If Handle = 0 Then Exit;
  21261.      If Not FUpdateEnabled Then Exit;
  21262.      If Application<>Nil Then Application.DestroyHintWindow;
  21263.  
  21264.      rc := rec;
  21265.      {$IFDEF OS2}
  21266.      WinInvalidateRect(Handle,RECTL(rc),True);
  21267.      {$ENDIF}
  21268.      {$IFDEF Win32}
  21269.      RectToWin32Rect(rc);
  21270.      TransformClientRect(rc,Self,Nil);
  21271.      WinUser.InvalidateRect(Handle,RECTL(rc),True);
  21272.      {$ENDIF}
  21273. End;
  21274.  
  21275.  
  21276. Function TControl.Perform(MsgId:ULONG;mp1,mp2:LONG):LONG;
  21277. Var  Msg:TMessage;
  21278. Begin
  21279.      FillChar(Msg,SizeOf(Msg),0);
  21280.      Msg.Msg := MsgId;
  21281.      Msg.ReceiverClass := Self;
  21282.      Msg.Receiver := Handle;
  21283.      Msg.Handled := False;
  21284.      Msg.Param1 := mp1;
  21285.      Msg.Param2 := mp2;
  21286.      Msg.Result := 0;
  21287.      If Self <> Nil Then WndProc(Msg);
  21288.      Result := Msg.Result;
  21289. End;
  21290.  
  21291.  
  21292. Procedure TControl.NotifyControls(MsgId:ULONG);
  21293. Var  Msg:TMessage;
  21294. Begin
  21295.      Msg.Msg := MsgId;
  21296.      Msg.ReceiverClass := Self;
  21297.      Msg.Receiver := Handle;
  21298.      Msg.Handled := False;
  21299.      Msg.Param1 := 0;
  21300.      Msg.Param1 := 0;
  21301.      Msg.Result := 0;
  21302.      BroadCast(Msg);
  21303. End;
  21304.  
  21305.  
  21306. Procedure TControl.BroadCast(Var Msg:TMessage);
  21307. Var  I:LongInt;
  21308.      Control:TControl;
  21309. Begin
  21310.      For I := 0 To ControlCount-1 Do
  21311.      Begin
  21312.           Control := Controls[I];
  21313.           Msg.Receiver := Control.Handle;  //!!!
  21314.           Control.WndProc(Msg);
  21315.           If Msg.Result <> 0 Then Exit;
  21316.      End;
  21317. End;
  21318.  
  21319.  
  21320. Procedure TControl.GetChildren(Proc:TGetChildProc);
  21321. Var  T:LongInt;
  21322.      Child:TComponent;
  21323.      Control:TControl;
  21324. Begin
  21325.      Inherited GetChildren(Proc);
  21326.  
  21327.      If ComponentState * [csReference] = [] Then
  21328.      Begin
  21329.           For T := 0 To ControlCount-1 Do
  21330.           Begin
  21331.                Control := Controls[T];
  21332.                If Control.Designed Then
  21333.                  If Control.ComponentState * [csDetail,csReference] = [] Then
  21334.                  Begin
  21335.                       Proc(Control);
  21336.                  End;
  21337.           End;
  21338.  
  21339.           For T := 0 To ComponentCount-1 Do
  21340.           Begin
  21341.                Child := Components[T];
  21342.                If Child.Designed Then
  21343.                  If (Not Child.HasParent) Then
  21344.                    If Child.ComponentState *
  21345.                       [csDetail,csReference,csReferenceControl] = [] Then
  21346.                    Begin
  21347.                         Proc(Child);
  21348.                    End;
  21349.           End;
  21350.      End;
  21351. End;
  21352.  
  21353.  
  21354. Function TControl.HasParent:Boolean;
  21355. Begin
  21356.      Result := Parent <> Nil;
  21357. End;
  21358.  
  21359.  
  21360. Procedure TControl.SetHint(Const NewText:String);
  21361. Begin
  21362.      AssignStr(FHint,NewText);
  21363. End;
  21364.  
  21365.  
  21366. Function TControl.GetHint:String;
  21367. Begin
  21368.      If FHint = Nil Then Result := ''
  21369.      Else Result := FHint^;
  21370. End;
  21371.  
  21372.  
  21373. Procedure TControl.SetShowHint(Value:Boolean);
  21374. Begin
  21375.      If FShowHint <> Value Then
  21376.      Begin
  21377.           FShowHint := Value;
  21378.           If ComponentState * [csReading] = [] Then FParentShowHint := False;
  21379.      End;
  21380. End;
  21381.  
  21382.  
  21383. Function TControl.GetShowHint:Boolean; {internal used}
  21384. Begin
  21385.      If FParentShowHint Then
  21386.      Begin
  21387.           If Parent <> Nil Then Result := Parent.GetShowHint
  21388.           Else Result := FShowHint;
  21389.      End
  21390.      Else Result := FShowHint;
  21391. End;
  21392.  
  21393.  
  21394. Procedure TControl.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LoNgInt);
  21395. Begin
  21396.      If ResName = rnFont Then
  21397.      Begin
  21398.           If DataLen <> 0 Then
  21399.           Begin
  21400.                Font := ReadSCUFont(Data,DataLen);
  21401.                If ((Font<>Nil)And(Font.FAlternateName<>Nil)) Then
  21402.                Begin
  21403.                    AssignStr(FAlternateFontName,Font.FAlternateName^);
  21404.                    DisposeStr(Font.FAlternateName);
  21405.                    Font.FAlternateName:=Nil;
  21406.                End;
  21407.           End;
  21408.      End
  21409.      Else Inherited ReadSCUResource(ResName,Data,DataLen)
  21410. End;
  21411.  
  21412.  
  21413. Function TControl.WriteSCUResource(Stream:TResourceStream):Boolean;
  21414. Begin
  21415.      Result := Inherited WriteSCUResource(Stream);
  21416.      If Not Result Then Exit;
  21417.  
  21418.      If (Font <> Nil) And (ComponentState * [csDetail] = [])
  21419.      Then
  21420.      Begin
  21421.           DisposeStr(Font.FAlternateName);
  21422.           Font.FAlternateName:=FAlternateFontName;
  21423.           Result := Font.WriteSCUResourceName(Stream,rnFont);
  21424.           Font.FAlternateName:=Nil;
  21425.      End;
  21426. End;
  21427.  
  21428.  
  21429. Procedure TControl.DoStartDrag(Var DragData:TDragDropData);
  21430. Begin
  21431.      With DragData Do
  21432.      Begin
  21433.           SourceWindow := Handle;
  21434.           SourceType := drtSibylObject;
  21435.           SourceString:='';
  21436.           RenderType := drmSibylObject;
  21437.           RenderString:='';
  21438.           SourceFileName := '';
  21439.           TargetFileName := '';
  21440.           ContainerName := '';
  21441.           SupportedOps := [doCopyable,doMoveable,doLinkable];
  21442.           DragOperation := doDefault;
  21443.           ItemId := LongWord(Self);
  21444.      End;
  21445.  
  21446.      If FOnStartDrag <> Nil Then FOnStartDrag(Self,DragData);
  21447. End;
  21448.  
  21449.  
  21450. {$IFDEF OS2}
  21451. Function FlagsFromDragSupport(SupportedOps:TDragDropSupportedOps):LongWord;
  21452. Begin
  21453.      Result := 0;
  21454.      If SupportedOps * [doCopyable] <> [] Then Result := Result Or DO_COPYABLE;
  21455.      If SupportedOps * [doMoveable] <> [] Then Result := Result Or DO_MOVEABLE;
  21456.      If SupportedOps * [doLinkable] <> [] Then Result := Result Or DO_LINKABLE;
  21457. End;
  21458.  
  21459.  
  21460. Function DragSupportFromFlags(Flags:LongWord):TDragDropSupportedOps;
  21461. Begin
  21462.      Result := [];
  21463.      If Flags And DO_COPYABLE <> 0 Then Include(Result, doCopyable);
  21464.      If Flags And DO_MOVEABLE <> 0 Then Include(Result, doMoveable);
  21465.      If Flags And DO_LINKABLE <> 0 Then Include(Result, doLinkable);
  21466. End;
  21467.  
  21468.  
  21469. Function FlagFromDragOperation(Operation:TDragDropOperation):LongWord;
  21470. Const
  21471.     DragOps:Array[TDragDropOperation] Of LongWord=
  21472.         (DO_DEFAULT,DO_COPY,DO_MOVE,DO_LINK,DO_UNKNOWN);
  21473. Begin
  21474.      Result := DragOps[Operation];
  21475. End;
  21476.  
  21477.  
  21478. Function DragOperationFromFlag(flag:LongWord):TDragDropOperation;
  21479. Begin
  21480.      Case flag Of
  21481.        DO_DEFAULT: Result := doDefault;
  21482.        DO_COPY: Result := doCopy;
  21483.        DO_MOVE: Result := doMove;
  21484.        DO_LINK: Result := doLink;
  21485.        Else Result := doUnknown;
  21486.      End;
  21487. End;
  21488. {$ENDIF}
  21489.  
  21490. {$HINTS OFF}
  21491. Procedure TControl.BeginDrag(Immediate:Boolean); {zZ dummy Parameter}
  21492. {$IFDEF OS2}
  21493. Var DItem:DRAGITEM;
  21494.     DImg:DRAGIMAGE;
  21495.     apsz:Cstring;
  21496.     hwndDrop:HWND;
  21497.     DrgData:TDragDropData;
  21498.     RMF:Cstring;
  21499.     Typ:Cstring;
  21500.     ContainerName,SourceName,TargetName:LongWord;
  21501.     DragControl:TControl;
  21502.     Accepted:Boolean;
  21503.     pt:TPoint;
  21504.     apid,adrgpid:PID;
  21505.     atid,adrgtid:TID;
  21506. {$ENDIF}
  21507. Begin
  21508.      {$IFDEF OS2}
  21509.      {Do Not allow drag inside Of drag}
  21510.      If ((Form.FDragControl<>Nil)Or(Form.FDragInfo<>Nil)) Then Exit;
  21511.      Form.FDragControl:=Self;
  21512.      Form.FDragControl.FDragging:=True;
  21513.  
  21514.      //allocate drag Info With one DRAGITEM
  21515.      Form.FDragInfo:=DrgAllocDragInfo(1);
  21516.  
  21517.      DoStartDrag(DrgData);
  21518.  
  21519.      Form.FDragInfo^.usOperation := FlagFromDragOperation(DrgData.DragOperation);
  21520.  
  21521.      Case DrgData.RenderType Of
  21522.         drmSibylObject:
  21523.         Begin
  21524.              Typ:='DRT_SIBYLOBJECT'+tohex(AppHandle);
  21525.              RMF:='<DRM_SIBYLOBJECT'+tohex(AppHandle)+',DRF_SIBYLOBJECT'+tohex(AppHaNdle)+'>';
  21526.         End;
  21527.         drmFile,drmPrint,drmSibyl,drmString:
  21528.         Begin
  21529.              If DrgData.SourceType=drtString Then Typ:=DrgData.SourceString
  21530.              Else If DrgData.SourceType=drtText Then Typ:='DRT_TEXT'
  21531.              Else If DrgData.SourceType=drtSibyl Then Typ:='DRT_SIBYL'
  21532.              Else Typ:='DRT_BINDATA';
  21533.  
  21534.              If DrgData.RenderType=drmString Then RMF:='<'+DrgData.RenderString+','
  21535.              Else If DrgData.RenderType=drmPrint Then RMF:='<DRM_PRINT,'
  21536.              Else If DrgData.RenderType=drmSibyl Then RMF:='<DRM_SIBYL,'
  21537.              Else RMF:='<DRM_OS2FILE,';
  21538.              If DrgData.SourceType=drtText Then RMF:=RMF+'DRF_TEXT>'
  21539.              Else RMF:=RMF+'DRF_UNKNOWN>';
  21540.         End;
  21541.      End;
  21542.  
  21543.      If DrgData.ContainerName<>'' Then
  21544.      Begin
  21545.           apsz:=DrgData.ContainerName;
  21546.           ContainerName:=DrgAddStrHandle(apsz);
  21547.      End
  21548.      Else ContainerName:=0;
  21549.      If DrgData.SourceFileName<>'' Then
  21550.      Begin
  21551.           apsz:=DrgData.SourceFileName;
  21552.           SourceName:=DrgAddStrHandle(apsz);
  21553.      End
  21554.      Else SourceName:=0;
  21555.      If DrgData.TargetFileName<>'' Then
  21556.      Begin
  21557.           apsz:=DrgData.TargetFileName;
  21558.           TargetName:=DrgAddStrHandle(apsz);
  21559.      End
  21560.      Else TargetName:=0;
  21561.  
  21562.      //Setup DRAGITEM structure
  21563.      DItem.hwndItem:=Handle;
  21564.      DItem.ulItemID:=DrgData.ItemId;
  21565.      DItem.hstrType:=DrgAddStrHandle(Typ);
  21566.      DItem.hstrRMF:=DrgAddStrHandle(RMF);
  21567.      DItem.hstrContainerName:=ContainerName;
  21568.      DItem.hstrSourceName:=SourceName;
  21569.      DItem.hstrTargetName:=TargetName;
  21570.      DItem.cxOffset:=0;
  21571.      DItem.cyOffset:=0;
  21572.      DItem.fsControl:=0;
  21573.      DItem.fsSupportedOps:=FlagsFromDragSupport(DrgData.SupportedOps);
  21574.  
  21575.      //Set First drag Item (Index 0)
  21576.      DrgSetDragItem(Form.FDragInfo^,DItem,SizeOf(DRAGITEM),0);
  21577.  
  21578.       //initialize DRAGIMAGE structure
  21579.      DImg.cb:=SizeOf(DRAGIMAGE);
  21580.      DImg.cptl:=0;
  21581.      DImg.hImage:=Screen.Cursors[DragCursor];
  21582.      DImg.sizlStretch.CX:=20;
  21583.      DImg.sizlStretch.CY:=20;
  21584.      DImg.fl:=DRG_ICON {Or DRG_STRETCH};
  21585.      DImg.cxOffset:=0;
  21586.      DImg.cyOffset:=0;
  21587.  
  21588.      //Perform drag Operation
  21589.      hwndDrop:=DrgDrag(Handle,Form.FDragInfo^,DImg,1,VK_ENDDRAG,Nil);
  21590.      {DrgDrag returns If drag Operation Is completed}
  21591.  
  21592.      (* Store final drag Operation *)
  21593.      FLastDragOperation:=DragOperationFromFlag(Form.FDragInfo^.usOperation);
  21594.  
  21595.      WinQueryWindowProcess(Handle,apid,atid);
  21596.      WinQueryWindowProcess(hwndDrop,adrgpid,adrgtid);
  21597.      If apid=adrgpid Then //the same Application
  21598.         DragControl:=HandleToControl(hwndDrop)
  21599.      Else
  21600.         DragControl:=Nil;  //other Application
  21601.  
  21602.      pt:=Screen.MousePos;
  21603.      Accepted:=hwndDrop<>0;
  21604.  
  21605.      If Not Accepted Then
  21606.      Begin
  21607.           FLastDragOperation:=doUnknown;
  21608.           DragControl:=Nil;
  21609.      End
  21610.      Else If DragControl=Nil Then DragControl:=TControl(ExternalDragDropObject);
  21611.  
  21612.      DragFinished(DragControl, pt.X,pt.Y, Accepted);
  21613.      {$ENDIF}
  21614.  
  21615.      {$IFDEF Win32}
  21616.      DoStartDrag(WinDragDropData);
  21617.      Case WinDragDropData.RenderType Of
  21618.         drmSibylObject,drmSibyl:
  21619.         Begin
  21620.              WinDragControl:=Self;
  21621.              FDragState:=dsDragEnter;
  21622.              WinLastDrag:=Nil;
  21623.              MouseCapture:=True;
  21624.              WinUser.SetCursor(Screen.Cursors[crNoDrop{DragCursor}]);
  21625.         End;
  21626.         Else WinDragControl:=Nil;
  21627.      End; //Case
  21628.      {$ENDIF}
  21629. End;
  21630. {$HINTS ON}
  21631.  
  21632. Procedure TControl.DragFree;
  21633. Begin
  21634.      {$IFDEF Win32}
  21635.      WinDragControl:=Nil;
  21636.      MouseCapture:=False;
  21637.      WinUser.SetCursor(Screen.Cursors[Cursor]);
  21638.      {$ENDIF}
  21639.      {$IFDEF OS2}
  21640.      If Form.FDragControl=Nil Then Exit;  //no previous drag
  21641.      Form.FDragControl.FDragging:=False;
  21642.      Form.FDragControl.FDragState:=dsDragEnter;
  21643.  
  21644.      //Free DragInfo structure
  21645.      DrgDeleteDragInfoStrHandles(Form.FDragInfo^);
  21646.      DrgFreeDragInfo(Form.FDragInfo);
  21647.      Form.FDragInfo:=Nil;
  21648.      {$ENDIF}
  21649.      Form.FDragControl:=Nil;
  21650. End;
  21651.  
  21652.  
  21653. Procedure TControl.DragFinished(target:TObject; X,Y:LongInt; Accepted:Boolean);
  21654. Begin
  21655.      If Not Accepted Then DragCanceled;
  21656.      DoEndDrag(target, X,Y);
  21657.  
  21658.      DragFree;
  21659. End;
  21660.  
  21661.  
  21662. Procedure TControl.CanDrag(X,Y:LongInt;Var Accept:Boolean);
  21663. Begin
  21664.      If OnCanDrag <> Nil Then OnCanDrag(Self,X,Y,Accept);
  21665. End;
  21666.  
  21667.  
  21668. Procedure TControl.DoEndDrag(target:TObject; X,Y:LongInt);
  21669. Begin
  21670.      {target Koord. aufbereiten}
  21671.      If FOnEndDrag <> Nil Then FOnEndDrag(Self, target, X,Y);
  21672. End;
  21673.  
  21674.  
  21675. Procedure TControl.DragOver(Source:TObject;X,Y:LongInt;State:TDragState;Var Accept:BOolean);
  21676. Begin
  21677.      Accept := True;
  21678.      If OnDragOver <> Nil Then OnDragOver(Self,Source,X,Y,State,Accept)
  21679.      Else Accept := False;
  21680. End;
  21681.  
  21682.  
  21683. Procedure TControl.DragDrop(Source:TObject;X,Y:LongInt);
  21684. Begin
  21685.      If OnDragDrop <> Nil Then OnDragDrop(Self,Source,X,Y);
  21686. End;
  21687.  
  21688.  
  21689. Procedure TControl.DragCanceled;
  21690. Begin
  21691. End;
  21692.  
  21693.  
  21694. Procedure TControl.CreateDragCanvas;
  21695. Begin
  21696.      {$IFDEF OS2}
  21697.      FDragCanvas:=FCanvas;
  21698.      FCanvas.Create(Self);
  21699.      FCanvas.FHandle:=DrgGetPS(Handle);
  21700.      GpiCreateLogColorTable(FCanvas.FHandle,LCOL_RESET,LCOLF_RGB,0,0,Nil);
  21701.  
  21702.      //FCanvas.Font := FDragCanvas.Font; !!
  21703.  
  21704.      FCanvas.Pen.color:=clBlack;
  21705.      FCanvas.Brush.color:=clWhite;
  21706.      FCanvas.Brush.Mode:=bmOpaque;
  21707.      FCanvas.Pen.Mode:=pmCopy;
  21708.      {$ENDIF}
  21709. End;
  21710.  
  21711.  
  21712. Procedure TControl.DeleteDragCanvas;
  21713. Begin
  21714.      {$IFDEF OS2}
  21715.      DrgReleasePS(FCanvas.FHandle);
  21716.      FCanvas.FHandle:=0;
  21717.      FCanvas.Destroy;
  21718.      FCanvas:=FDragCanvas;
  21719.      {$ENDIF}
  21720. End;
  21721.  
  21722.  
  21723. {$IFDEF OS2}
  21724. Procedure TControl.WMBeginDrag(Var Msg:TMessage);
  21725. Begin
  21726.      DragInit(Self, MausPosFromParam(Msg.Param1));
  21727.  
  21728.      Msg.Handled:=True;
  21729.      Msg.Result:=1;
  21730. End;
  21731.  
  21732. Procedure TControl.WMEndDrag(Var Msg:TMessage);
  21733. Var  pt:TPoint;
  21734. Begin
  21735.      If FDragMode=dmAutomatic Then
  21736.      Begin
  21737.           pt:=Screen.MousePos;
  21738.           DragFinished(Nil,pt.X,pt.Y,False);
  21739.      End;
  21740.      Msg.Handled:=True;
  21741.      Msg.Result:=1;
  21742. End;
  21743.  
  21744. Function GetDragSource(Var Msg:TMessage;Var DragInfo:PDRAGINFO;
  21745.                        Var DragDropData:TDragDropData;Var DragSource:TObject;
  21746.                        ItemIndex:LongInt):Boolean;
  21747. Var
  21748.    DRAGITEM:PDragItem;
  21749.    apsz:Cstring;
  21750.    flResult:Boolean;
  21751. Label ex;
  21752. Begin
  21753.      Result:=False;
  21754.      DragSource:=Nil;
  21755.      DragInfo:=Pointer(Msg.Param1);
  21756.      If Not DrgAccessDragInfo(DragInfo) Then Exit;
  21757.      If DragInfo^.cdItem=0 Then Goto ex;
  21758.      DRAGITEM:=DrgQueryDragitemPtr(DragInfo^,ItemIndex);
  21759.      If DRAGITEM=Nil Then Goto ex;
  21760.  
  21761.      FillChar(DragDropData,SizeOf(DragDropData),0);
  21762.      DragDropData.SourceWindow:=DragInfo^.HwndSource;
  21763.      apsz:='DRT_SIBYLOBJECT'+tohex(AppHandle);
  21764.      flResult:=DrgVerifyTrueType(DRAGITEM^,apsz);
  21765.      If flResult Then
  21766.      Begin
  21767.           DragSource:=TObject(DRAGITEM^.ulItemID);
  21768.           With DragDropData Do
  21769.           Begin
  21770.                SourceType:=drtSibylObject;
  21771.                RenderType:=drmSibylObject;
  21772.                DragSource:=TControl(DRAGITEM^.ulItemID);
  21773.           End;
  21774.      End
  21775.      Else
  21776.      Begin
  21777.           apsz:='DRT_SIBYL';
  21778.           DragDropData.SourceString:=apsz;
  21779.           flResult:=DrgVerifyTrueType(DRAGITEM^,apsz);
  21780.           If flResult Then
  21781.           Begin
  21782.                With DragDropData Do
  21783.                Begin
  21784.                    SourceType:=drtSibyl;
  21785.                    RenderType:=drmSibyl;
  21786.                    DragDropData.RenderString:='DRM_SIBYL';
  21787.                End;
  21788.           End
  21789.           Else
  21790.           Begin
  21791.                flResult:=DrgQueryNativeRMF(DRAGITEM^,255,apsz);
  21792.                DragDropData.RenderString:=apsz;
  21793.                If ((flResult)And(Pos('DRM_OS2FILE',apsz) <> 0)) Then
  21794.                Begin
  21795.                     DragDropData.RenderType:=drmFile;
  21796.                     apsz:='DRT_TEXT'; {oder Plain Text, ...}
  21797.                     If DrgVerifyTrueType(DRAGITEM^,apsz) Then
  21798.                     Begin
  21799.                          DragDropData.SourceType:=drtText;
  21800.                          DragDropData.SourceString:=apsz;
  21801.                     End
  21802.                     Else DragDropData.SourceType:=drtBinData;
  21803.                End
  21804.                Else If ((flResult)And(Pos('DRM_OS2FILE',apsz) <> 0)) Then
  21805.                Begin
  21806.                     DragDropData.RenderType:=drmPrint;
  21807.                     apsz:='DRT_TEXT';
  21808.                     If DrgVerifyTrueType(DRAGITEM^,apsz) Then
  21809.                     Begin
  21810.                          DragDropData.SourceType:=drtText;
  21811.                          DragDropData.SourceString:=apsz;
  21812.                     End
  21813.                     Else DragDropData.SourceType:=drtBinData;
  21814.                End
  21815.                Else If flResult Then
  21816.                Begin
  21817.                     With DragDropData Do
  21818.                     Begin
  21819.                          RenderType:=drmString;
  21820.                          DragDropData.RenderString:=apsz;
  21821.                          If DrgQueryTrueType(DRAGITEM^,255,apsz) Then
  21822.                          Begin
  21823.                               SourceType:=drtString;
  21824.                               SourceString:=apsz;
  21825.                          End
  21826.                          Else flResult:=False;
  21827.                     End;
  21828.                End;
  21829.           End;
  21830.      End;
  21831.  
  21832.      Result:=flResult;
  21833.  
  21834.      If Result Then With DragDropData Do
  21835.      Begin
  21836.           DrgQueryStrName(DRAGITEM^.hstrContainerName,255,apsz);
  21837.           ContainerName:=apsz;
  21838.           DrgQueryStrName(DRAGITEM^.hstrSourceName,255,apsz);
  21839.           SourceFileName:=apsz;
  21840.           DrgQueryStrName(DRAGITEM^.hstrTargetName,255,apsz);
  21841.           TargetFileName:=apsz;
  21842.           SupportedOps:=DragSupportFromFlags(DRAGITEM^.fsSupportedOps);
  21843.           DragOperation:=DragOperationFromFlag(DragInfo^.usOperation);
  21844.           ItemId:=DRAGITEM^.ulItemID;
  21845.      End;
  21846. ex:
  21847.      DrgFreeDragInfo(DragInfo);
  21848. End;
  21849.  
  21850. Procedure TControl.DMDragOver(Var Msg:TMessage);
  21851. Var
  21852.    Accept:Boolean;
  21853.    DragSource:TObject;
  21854.    pt:TPoint;
  21855.    DragInfo:PDRAGINFO;
  21856.    DragDropData:TDragDropData;
  21857.    Ok:Boolean;
  21858. Begin
  21859.      Ok:=GetDragSource(Msg,DragInfo,DragDropData,DragSource,0);
  21860.      pt:=MausPosFromParam(Msg.Param2);
  21861.      WinMapWindowPoints(HWND_DESKTOP,Handle,pt,1);
  21862.  
  21863.      Msg.Handled:=True;
  21864.      Accept:=False;
  21865.  
  21866.      If Ok Then  //Rendering Type Accepted
  21867.      Begin
  21868.           If DragSource=Nil Then
  21869.           Begin
  21870.                ExternalDragDropObject.FDragDropData:=DragDropData;
  21871.                DragSource:=TObject(ExternalDragDropObject);
  21872.           End;
  21873.           DragOver(DragSource,pt.X,pt.Y,FDragState,Accept);
  21874.           FDragState:=dsDragMove;
  21875.      End;
  21876.  
  21877.      If Accept Then Msg.Result:=MRFROM2SHORT(DOR_DROP,DO_UNKNOWN)
  21878.      Else Msg.Result:=MPFROM2SHORT(DOR_NODROP,DO_UNKNOWN);
  21879.      //If we return DOR_NEVERDROP, the Window will Not Get DragOver Messages anymore
  21880. End;
  21881.  
  21882. Procedure TControl.DMDragLeave(Var Msg:TMessage);
  21883. Var
  21884.    Accept:Boolean;
  21885.    DragSource:TObject;
  21886.    pt:TPoint;
  21887.    DragInfo:PDRAGINFO;
  21888.    DragDropData:TDragDropData;
  21889.    Ok:Boolean;
  21890. Begin
  21891.      Ok:=GetDragSource(Msg,DragInfo,DragDropData,DragSource,0);
  21892.      pt:=Screen.MousePos;
  21893.      WinMapWindowPoints(HWND_DESKTOP,Handle,pt,1);
  21894.  
  21895.      Msg.Handled:=True;
  21896.      Accept:=False;
  21897.  
  21898.      If Ok Then  //Rendering Type Accepted
  21899.      Begin
  21900.           If DragSource=Nil Then
  21901.           Begin
  21902.                ExternalDragDropObject.FDragDropData:=DragDropData;
  21903.                DragSource:=TObject(ExternalDragDropObject);
  21904.           End;
  21905.  
  21906.           FDragState:=dsDragEnter;
  21907.           DragOver(DragSource,pt.X,pt.Y,dsDragLeave,Accept);
  21908.      End;
  21909.  
  21910.      If Accept Then Msg.Result:=MRFROM2SHORT(DOR_DROP,DO_COPY)
  21911.      Else Msg.Result:=MPFROM2SHORT(DOR_NEVERDROP,DO_UNKNOWN);
  21912. End;
  21913.  
  21914. Procedure TControl.DMDrop(Var Msg:TMessage);
  21915. Var
  21916.    DragSource:TObject;
  21917.    pt:TPoint;
  21918.    DragInfo:PDRAGINFO;
  21919.    DRAGITEM:PDragItem;
  21920.    DragDropData:TDragDropData;
  21921.    Ok:Boolean;
  21922.    hwndItem:HWND;
  21923.    ulItemID:LongWord;
  21924.    ItemCount,T:LongWord;
  21925. Begin
  21926.      Ok:=GetDragSource(Msg,DragInfo,DragDropData,DragSource,0);
  21927.      pt:=Screen.MousePos;
  21928.      WinMapWindowPoints(HWND_DESKTOP,Handle,pt,1);
  21929.  
  21930.      Msg.Handled:=True;
  21931.  
  21932.      If DragInfo<>Nil Then
  21933.      Begin
  21934.           If DrgAccessDragInfo(DragInfo) Then
  21935.           Begin
  21936.                If DragInfo^.cdItem>0 Then
  21937.                Begin
  21938.                     ItemCount:=DragInfo^.cdItem;
  21939.                     DRAGITEM:=DrgQueryDragitemPtr(DragInfo^,0);
  21940.                     hwndItem:=DRAGITEM^.hwndItem;
  21941.                     ulItemID:=DRAGITEM^.ulItemID;
  21942.                End
  21943.                Else DRAGITEM:=Nil;
  21944.                DrgFreeDragInfo(DragInfo);
  21945.           End
  21946.           Else DRAGITEM:=Nil;
  21947.      End
  21948.      Else DRAGITEM:=Nil;
  21949.      If DRAGITEM=Nil Then Exit;
  21950.  
  21951.      If Ok Then  {Rendering Type Accepted}
  21952.      Begin
  21953.           FDragState:=dsDragEnter;
  21954.           For T:=1 To ItemCount Do
  21955.           Begin
  21956.                If GetDragSource(Msg,DragInfo,DragDropData,DragSource,T-1) Then
  21957.                Begin
  21958.                     If DragSource=Nil Then
  21959.                     Begin
  21960.                          ExternalDragDropObject.FDragDropData:=DragDropData;
  21961.                          DragSource:=TObject(ExternalDragDropObject);
  21962.                     End;
  21963.  
  21964.                     DragDrop(DragSource,pt.X,pt.Y);
  21965.  
  21966.                     If DrgAccessDragInfo(DragInfo) Then
  21967.                     Begin
  21968.                          DRAGITEM:=DrgQueryDragitemPtr(DragInfo^,T-1);
  21969.                          If DRAGITEM<>Nil Then
  21970.                          Begin
  21971.                               hwndItem:=DRAGITEM^.hwndItem;
  21972.                               {If Ok Then}
  21973.                               DrgSendTransferMsg(hwndItem,
  21974.                                                  DM_ENDCONVERSATION,
  21975.                                                  MPFROMLONG(ulItemID),
  21976.                                                  MPFROMLONG(DMFL_TARGETSUCCESSFUL));
  21977.                               {Else
  21978.                               DrgSendTransferMsg(hwndItem,
  21979.                                                  DM_ENDCONVERSATION,
  21980.                                                  MPFROMLONG(ulItemID),
  21981.                                                  MPFROMLONG(DMFL_TARGETFAIL));}
  21982.                          End;
  21983.                          DrgFreeDragInfo(DragInfo);
  21984.                     End;
  21985.                End;
  21986.           End;
  21987.      End
  21988.      Else
  21989.      Begin
  21990.           DrgSendTransferMsg(hwndItem,
  21991.                              DM_ENDCONVERSATION,
  21992.                              MPFROMLONG(ulItemID),
  21993.                              MPFROMLONG(DMFL_TARGETFAIL));
  21994.      End;
  21995. End;
  21996. {$ENDIF}
  21997.  
  21998.  
  21999. {creates AChild Window If its phys. Parent Is created}
  22000. Procedure TControl.InsertControl(AChild:TControl);
  22001. Begin
  22002.      Insert(AChild); {Insert AChild In Some lists}
  22003.  
  22004.      AChild.Perform(CM_PARENTFONTCHANGED,0,0);
  22005.      AChild.Perform(CM_PARENTPENCOLORCHANGED,0,0);
  22006.      AChild.Perform(CM_PARENTCOLORCHANGED,0,0);
  22007.  
  22008.      If Handle <> 0 Then
  22009.      Begin
  22010.           If Not (AChild.FIsToolBar) Then
  22011.           Begin
  22012.                AChild.CreateWnd;
  22013.                If AChild.FVisible Or AChild.Designed Then AChild.Show;
  22014.           End;
  22015.      End
  22016.      Else FInitControls := True;
  22017. End;
  22018.  
  22019.  
  22020. Procedure TControl.Insert(AChild:TControl);
  22021. Begin
  22022.      ListAdd(FControls, AChild);
  22023.      If Not (csReferenceControl In AChild.ComponentState) Then ListAdd(FTabList, AChild);
  22024.      AChild.FParent := Self;
  22025.  
  22026.      AChild.FForm := GetParentForm(Self);  {allows fast access To the Form}
  22027. End;
  22028.  
  22029.  
  22030. Procedure TControl.RemoveControl(AChild:TControl);  {call by SetParent(Nil)}
  22031. Begin
  22032.      {removefocus}
  22033.      AChild.DestroyHandle;
  22034.  
  22035.      Remove(AChild);  {Delete AChild from Some lists}
  22036. End;
  22037.  
  22038.  
  22039. Procedure TControl.Remove(AChild:TControl);
  22040. Begin
  22041.      ListRemove(FTabList, AChild);
  22042.      ListRemove(FControls, AChild);
  22043.      AChild.FParent := Nil;
  22044. End;
  22045.  
  22046.  
  22047. Procedure TControl.SetParent(AParent:TControl);
  22048. Begin
  22049.      If FParent <> AParent Then
  22050.      Begin
  22051.           If AParent = Self Then Exit;
  22052.           If FParent <> Nil Then FParent.RemoveControl(Self);
  22053.           If AParent <> Nil Then AParent.InsertControl(Self);
  22054.      End;
  22055. End;
  22056.  
  22057.  
  22058. {
  22059. ╔═══════════════════════════════════════════════════════════════════════════╗
  22060. ║                                                                           ║
  22061. ║ Speed-Pascal/2 Version 2.0                                                ║
  22062. ║                                                                           ║
  22063. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  22064. ║                                                                           ║
  22065. ║ This section: TScrollBar Class Implementation                             ║
  22066. ║                                                                           ║
  22067. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  22068. ║                                                                           ║
  22069. ╚═══════════════════════════════════════════════════════════════════════════╝
  22070. }
  22071.  
  22072. Procedure TScrollBar.GetClassData(Var ClassData:TClassData);
  22073. Begin
  22074.      Inherited GetClassData(ClassData);
  22075.  
  22076.      {$IFDEF Win32}
  22077.      CreateSubClass(ClassData,'SCROLLBAR');
  22078.      {$ENDIF}
  22079.      {$IFDEF OS2}
  22080.      ClassData.ClassULong := WC_SCROLLBAR;
  22081.      {$ENDIF}
  22082. End;
  22083.  
  22084. Procedure TScrollBar.SetupComponent;
  22085. Begin
  22086.      Inherited SetupComponent;
  22087.  
  22088.      Name := 'ScrollBar';
  22089.      Height := Screen.SystemMetrics(smCyHScroll);
  22090.      Width := 100;
  22091.      FOwnerDraw := False;
  22092.      color := clScrollbar;
  22093.      ParentFont := False;
  22094.      ParentPenColor := False;
  22095.      ParentColor := False;
  22096.  
  22097.      FKind := sbHorizontal;
  22098.      FSmallChange := 1;
  22099.      FLargeChange := 1;
  22100.      FMin := 0;
  22101.      FMax := 100;
  22102.      FSliderSize := 1;
  22103.      FPosition := 0;
  22104.      FCalcRange := FMax - FSliderSize + 1;
  22105. End;
  22106.  
  22107.  
  22108. Procedure TScrollBar.CreateParams(Var Params:TCreateParams);
  22109. Begin
  22110.      Inherited CreateParams(Params);
  22111.  
  22112.      If FKind = sbHorizontal
  22113.      Then Params.Style := Params.Style Or SBS_HORZ
  22114.      Else Params.Style := Params.Style Or SBS_VERT;
  22115. End;
  22116.  
  22117. Procedure TScrollBar.SetupShow;
  22118. Begin
  22119.      Inherited SetupShow;
  22120.  
  22121.      SetScrollRange(FMin,FMax,FSliderSize);
  22122. End;
  22123.  
  22124. Procedure TScrollBar.SetPenColor(NewColor:TColor);
  22125. Begin
  22126.      TControl.SetPenColor(NewColor);
  22127.      TControl.SetColor(NewColor);
  22128. End;
  22129.  
  22130. Procedure TScrollBar.SetColor(NewColor:TColor);
  22131. Begin
  22132.      TControl.SetPenColor(NewColor);
  22133.      TControl.SetColor(NewColor);
  22134. End;
  22135.  
  22136. Procedure TScrollBar.SetKind(NewKind:TScrollBarKind);
  22137. Begin
  22138.      If FKind <> NewKind Then
  22139.      Begin
  22140.           If NewKind = sbHorizontal Then
  22141.           Begin
  22142.                FWidth := FHeight;
  22143.                FHeight := Screen.SystemMetrics(smCyHScroll)
  22144.           End
  22145.           Else
  22146.           Begin
  22147.                FHeight := FWidth;
  22148.                FWidth := Screen.SystemMetrics(smCxVScroll);
  22149.           End;
  22150.           FKind := NewKind;
  22151.           RecreateWnd;
  22152.      End;
  22153. End;
  22154.  
  22155. Procedure TScrollBar.SetPosition(NewPosition:LongInt);
  22156. Begin
  22157.      If NewPosition < FMin Then NewPosition := FMin;
  22158.      If NewPosition > FCalcRange Then NewPosition := FCalcRange;
  22159.  
  22160.      FPosition := NewPosition;
  22161.  
  22162.      If Handle = 0 Then Exit;
  22163.      {transform}
  22164.      NewPosition := Round((NewPosition - FMin) / FScale);
  22165.  
  22166.      If FScale > 1 Then  {Handle Special cases}
  22167.      Begin
  22168.           If FPosition = FMin Then NewPosition := 0
  22169.           Else
  22170.           If NewPosition = 0 Then NewPosition := 1  {still Enable Left Scroll}
  22171.           Else
  22172.           If FPosition = FCalcRange Then NewPosition := lastpos
  22173.           Else
  22174.           If NewPosition = lastpos Then NewPosition := lastpos - 1;
  22175.      End;
  22176.  
  22177.      {$IFDEF OS2}
  22178.      If WinSendMsg(Handle,SBM_QUERYPOS,0,0) <> NewPosition
  22179.      Then WinSendMsg(Handle,SBM_SETPOS,NewPosition,0);
  22180.      {$ENDIF}
  22181.      {$IFDEF Win32}
  22182.      If WinUser.GetScrollPos(Handle,SB_CTL) <> NewPosition
  22183.      Then  WinUser.SetScrollPos(Handle,SB_CTL,NewPosition,True);
  22184.      {$ENDIF}
  22185. End;
  22186.  
  22187. Procedure TScrollBar.SetMin(NewMin:LongInt);
  22188. Begin
  22189.      If NewMin > FMax Then Exit;
  22190.      SetScrollRange(NewMin,FMax,FSliderSize);
  22191.      If FControl<>Nil Then
  22192.        If FControl.AutoScroll Then
  22193.        Begin
  22194.             If Min<0 Then
  22195.               If FHandle<>0 Then Show;
  22196.        End;
  22197. End;
  22198.  
  22199. Procedure TScrollBar.SetMax(NewMax:LongInt);
  22200. Begin
  22201.      If NewMax < FMin Then Exit;
  22202.      SetScrollRange(FMin,NewMax,FSliderSize);
  22203.      If FControl<>Nil Then
  22204.        If FControl.AutoScroll Then
  22205.        Begin
  22206.             If Kind=sbHorizontal Then
  22207.             Begin
  22208.                  If Max>FControl.ClientWidth Then
  22209.                    If FHandle<>0 Then Show;
  22210.             End
  22211.             Else
  22212.             Begin
  22213.                  If Max>FControl.ClientHeight Then
  22214.                    If FHandle<>0 Then Show;
  22215.             End;
  22216.        End;
  22217. End;
  22218.  
  22219. Procedure TScrollBar.SetSliderSize(NewSliderSize:LongInt);
  22220. Begin
  22221.      If NewSliderSize < 1 Then Exit;
  22222.      SetScrollRange(FMin,FMax,NewSliderSize);
  22223. End;
  22224.  
  22225. Procedure TScrollBar.SetScrollRange(aMin,aMax,aSliderSize:LongInt);
  22226. Var  APos:LongInt;
  22227.      {$IFDEF Win32}
  22228.      ScrollInfo:TScrollInfo;
  22229.      {$ENDIF}
  22230. Begin
  22231.      If aMin > aMax Then Exit;
  22232.      If aSliderSize < 1 Then Exit;
  22233.  
  22234.      FMin := aMin;
  22235.      FMax := aMax;
  22236.      FSliderSize := aSliderSize;
  22237.      FCalcRange := FMax - FSliderSize + 1;
  22238.      If FCalcRange < 0 Then FCalcRange := 0;
  22239.      FScale := 1;
  22240.  
  22241.      If Handle = 0 Then Exit;
  22242.      {transform}
  22243.      If FMax - FMin > MaxInt Then FScale := (FMax - FMin) / (MaxInt - 1);
  22244.      APos := Round((FPosition - FMin) / FScale);
  22245.      aMin := Round((FMin - FMin) / FScale);
  22246.      aMax := Trunc((FMax - FMin) / FScale);
  22247.      aSliderSize := Round(FSliderSize / FScale);
  22248.  
  22249.      lastpos := aMax - aSliderSize + 1;
  22250.      {$IFDEF OS2}
  22251.      WinSendMsg(Handle,SBM_SETSCROLLBAR, APos, MAKELONG(aMin,lastpos));
  22252.      WinSendMsg(Handle,SBM_SETTHUMBSIZE, MAKELONG(aSliderSize,aMax-aMin+1), 0);
  22253.      {$ENDIF}
  22254.      {$IFDEF Win32}
  22255.      ScrollInfo.cbSize := SizeOf(ScrollInfo);
  22256.      ScrollInfo.fMask := SIF_ALL;
  22257.      ScrollInfo.nMin := aMin;
  22258.      ScrollInfo.nMax := aMax;
  22259.      ScrollInfo.nPage := aSliderSize;
  22260.      ScrollInfo.nPos := APos;
  22261.      ScrollInfo.nTrackPos := APos;
  22262.      SetScrollInfo(Handle, SB_CTL, ScrollInfo, True);
  22263.      {$ENDIF}
  22264.  
  22265.      SetPosition(FPosition);
  22266. End;
  22267.  
  22268. Procedure TScrollBar.SetParams(aPosition,aMin,aMax:LongInt);
  22269. Begin
  22270.      SetScrollRange(aMin,aMax,FSliderSize);
  22271.      SetPosition(aPosition);
  22272. End;
  22273.  
  22274. {
  22275. ╔═══════════════════════════════════════════════════════════════════════════╗
  22276. ║                                                                           ║
  22277. ║ Speed-Pascal/2 Version 2.0                                                ║
  22278. ║                                                                           ║
  22279. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  22280. ║                                                                           ║
  22281. ║ This section: TControlScrollBar Class Implementation                      ║
  22282. ║                                                                           ║
  22283. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  22284. ║                                                                           ║
  22285. ╚═══════════════════════════════════════════════════════════════════════════╝
  22286. }
  22287.  
  22288. Procedure TControlScrollBar.SetupComponent;
  22289. Begin
  22290.     Inherited SetupComponent;
  22291.     Exclude(ComponentState,csHandleLinks);
  22292.     SmallChange:=5;
  22293.     LargeChange:=10;
  22294. End;
  22295.  
  22296. {
  22297. ╔═══════════════════════════════════════════════════════════════════════════╗
  22298. ║                                                                           ║
  22299. ║ Speed-Pascal/2 Version 2.0                                                ║
  22300. ║                                                                           ║
  22301. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  22302. ║                                                                           ║
  22303. ║ This section: TScrollingWinControl Class Implementation                   ║
  22304. ║                                                                           ║
  22305. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  22306. ║                                                                           ║
  22307. ╚═══════════════════════════════════════════════════════════════════════════╝
  22308. }
  22309.  
  22310. Procedure TScrollingWinControl.SetupComponent;
  22311. Begin
  22312.      Inherited SetupComponent;
  22313.  
  22314.      FScrollBars := ssNone;
  22315.      FAutoScroll := True;
  22316.      FHorzScrollBar := Nil;
  22317.      FVertScrollBar := Nil;
  22318.      FHMin:=0;
  22319.      FHMax:=Width;
  22320.      FHPos:=0;
  22321.      FHLargeChange:=10;
  22322.      FHSmallChange:=5;
  22323.      FHColor:=clScrollBar;
  22324.      FHSliderSize:=1;
  22325.      FVMin:=0;
  22326.      FVMax:=Height;
  22327.      FVPos:=0;
  22328.      FVLargeChange:=10;
  22329.      FVSmallChange:=5;
  22330.      FVColor:=clScrollBar;
  22331.      FVSliderSize:=1;
  22332. End;
  22333.  
  22334.  
  22335. Procedure TScrollingWinControl.SetupShow;
  22336. Begin
  22337.      Inherited SetupShow;
  22338.  
  22339.      SetScrollBars(FScrollBars);
  22340. End;
  22341.  
  22342.  
  22343. Procedure TScrollingWinControl.ScrollInView(AControl:TControl);
  22344. Var rc:TRect;
  22345. Begin
  22346.      If ((AControl=Nil)Or(AControl.Parent<>Self)) Then exit;
  22347.      rc:=AControl.ClientRect;
  22348.  
  22349.      If rc.Left<0 Then
  22350.      Begin
  22351.           If FHorzScrollBar<>Nil Then
  22352.             FHorzScrollBar.Position:=FHorzScrollBar.Position-rc.Left;
  22353.           AControl.Left:=0;
  22354.      End
  22355.      Else If rc.Right>ClientWidth Then
  22356.      Begin
  22357.           If FHorzScrollBar<>Nil Then
  22358.             FHorzScrollBar.Position:=FHorzScrollBar.Position-(ClientWidth-rc.Right);
  22359.           rc.Left:=rc.Left-(ClientWidth-rc.Right);
  22360.      End;
  22361.  
  22362.      If rc.Bottom<0 Then
  22363.      Begin
  22364.           If FVertScrollBar<>Nil Then
  22365.             FVertScrollBar.Position:=FVertScrollBar.Position-rc.Bottom;
  22366.           AControl.Bottom:=0;
  22367.      End
  22368.      Else If rc.Top>ClientHeight Then
  22369.      Begin
  22370.           If FVertScrollBar<>Nil Then
  22371.             FVertScrollBar.Position:=FVertScrollBar.Position-(ClientHeight-rc.Top);
  22372.           rc.Bottom:=rc.Bottom-(ClientHeight-rc.Top);
  22373.      End;
  22374. End;
  22375.  
  22376.  
  22377. Procedure TScrollingWinControl.Resize;
  22378. Begin
  22379.      Inherited Resize;
  22380.  
  22381.      AdjustScrollbars;
  22382.      AlignScrollbars;
  22383. End;
  22384.  
  22385.  
  22386. Destructor TScrollingWinControl.Destroy;
  22387. Begin
  22388.      If FHorzScrollBar <> Nil Then
  22389.      Begin
  22390.           FHorzScrollBar.Destroy;
  22391.           FHorzScrollBar := Nil;
  22392.      End;
  22393.      If FVertScrollBar <> Nil Then
  22394.      Begin
  22395.           FVertScrollBar.Destroy;
  22396.           FVertScrollBar := Nil;
  22397.      End;
  22398.  
  22399.      Inherited Destroy;
  22400. End;
  22401.  
  22402.  
  22403. Procedure TScrollingWinControl.Paint(Const rec:TRect);
  22404. Var  rc:TRect;
  22405. Begin
  22406.      Inherited Paint(rec);
  22407.  
  22408.      If (FHorzScrollBar <> Nil) And (FVertScrollBar <> Nil) Then
  22409.        If ((FHorzScrollBar.Visible)And(FVertScrollBar.Visible)) Then
  22410.      Begin
  22411.           rc := GetClientRect;
  22412.           rc.Left := rc.Right - FVertScrollBar.Width +1;
  22413.           rc.Top := rc.Bottom + FHorzScrollBar.Height -1;
  22414.           FCanvas.FillRect(rc, clLtGray);
  22415.      End;
  22416. End;
  22417.  
  22418.  
  22419. Procedure TScrollingWinControl.SetAutoScroll(NewValue:Boolean);
  22420. Begin
  22421.      If FAutoScroll <> NewValue Then
  22422.      Begin
  22423.           FAutoScroll := NewValue;
  22424.           If Not FAutoScroll Then
  22425.           Begin
  22426.                AlignScrollbars;
  22427.                If FHorzScrollbar <> Nil Then FHorzScrollbar.Show;
  22428.                If FVertScrollbar <> Nil Then FVertScrollbar.Show;
  22429.           End
  22430.           Else SetScrollBars(ssBoth);
  22431.      End;
  22432. End;
  22433.  
  22434.  
  22435. Procedure TScrollingWinControl.SetScrollBars(NewValue:TScrollStyle);
  22436. Var  t:LongInt;
  22437.      Control:TControl;
  22438. Begin
  22439.      If FAutoScroll Then NewValue := ssBoth;
  22440.  
  22441.      FScrollBars := NewValue;
  22442.      If Handle = 0 Then Exit;
  22443.  
  22444.      {Delete}
  22445.      If NewValue In [ssNone,ssHorizontal] Then
  22446.      Begin
  22447.           If FVertScrollBar <> Nil Then
  22448.           Begin
  22449.                FVertScrollBar.Destroy;
  22450.                FVertScrollBar := Nil;
  22451.           End;
  22452.      End;
  22453.  
  22454.      If NewValue In [ssNone,ssVertical] Then
  22455.      Begin
  22456.           If FHorzScrollBar <> Nil Then
  22457.           Begin
  22458.                FHorzScrollBar.Destroy;
  22459.                FHorzScrollBar := Nil;
  22460.           End;
  22461.      End;
  22462.  
  22463.      If NewValue <> ssNone Then
  22464.      Begin
  22465.           For t:=0 To ControlCount-1 Do
  22466.           Begin
  22467.                Control:=Controls[t];
  22468.                If Control<>FVertScrollBar Then
  22469.                  If Control<>FHorzScrollBar Then Control.ZOrder:=zoBottom;
  22470.           End;
  22471.      End;
  22472.  
  22473.      {Create}
  22474.      If NewValue In [ssHorizontal,ssBoth] Then
  22475.        If FHorzScrollBar = Nil Then
  22476.        Begin
  22477.             FHorzScrollBar.Create(Self);
  22478.             FHorzScrollBar.FControl:=Self;
  22479.             Exclude(FHorzScrollBar.ComponentState, csHandleLinks);
  22480.             FHorzScrollBar.HandlesDesignMouse:=True;
  22481.             FHorzScrollBar.Min:=FHMin;
  22482.             FHorzScrollBar.Max:=FHMax;
  22483.             FHorzScrollBar.Position:=FHPos;
  22484.             FHorzScrollBar.LargeChange:=FHLargeChange;
  22485.             FHorzScrollBar.SmallChange:=FHSmallChange;
  22486.             FHorzScrollBar.Color:=FHColor;
  22487.             FHorzScrollBar.SliderSize:=FHSliderSize;
  22488.             FHorzScrollBar.Kind := sbHorizontal;
  22489.             Include(FHorzScrollBar.ComponentState, csDetail);
  22490.             FHorzScrollBar.SetDesigning(False); {!}
  22491.             If AutoScroll Then FHorzScrollBar.Hide;
  22492.             //FHorzScrollBar.SetDesigning(Designed);
  22493.             FHorzScrollBar.Parent := Self;
  22494.        End;
  22495.  
  22496.      If NewValue In [ssVertical,ssBoth] Then
  22497.        If FVertScrollBar = Nil Then
  22498.        Begin
  22499.             FVertScrollBar.Create(Self);
  22500.             FVertScrollBar.FControl:=Self;
  22501.             FVertScrollBar.HandlesDesignMouse:=True;
  22502.             FVertScrollBar.Min:=FVMin;
  22503.             FVertScrollBar.Max:=FVMax;
  22504.             FVertScrollBar.Position:=FVPos;
  22505.             FVertScrollBar.LargeChange:=FVLargeChange;
  22506.             FVertScrollBar.SmallChange:=FVSmallChange;
  22507.             FVertScrollBar.Color:=FVColor;
  22508.             FVertScrollBar.SliderSize:=FVSliderSize;
  22509.             FVertScrollBar.Kind := sbVertical;
  22510.             Include(FVertScrollBar.ComponentState, csDetail);
  22511.             FVertScrollBar.SetDesigning(False); {!}
  22512.             If AutoScroll Then FVertScrollBar.Hide;
  22513.             //FVertScrollBar.SetDesigning(Designed);
  22514.             FVertScrollBar.Parent := Self;
  22515.        End;
  22516.  
  22517.      AdjustScrollbars;
  22518.      AlignScrollbars;
  22519.  
  22520.      {Update Children}
  22521.      If Not FFirstShow Then RealignControls;
  22522. End;
  22523.  
  22524.  
  22525. {$HINTS OFF}
  22526. Procedure TScrollingWinControl.Scroll(Sender:TScrollBar;ScrollCode:TScrollCode;Var ScrollPos:LongInt);
  22527. Var  Control:TControl;
  22528.      t:Longint;
  22529. Begin
  22530.      If (Sender = FVertScrollBar) Or (Sender = FHorzScrollBar) Then
  22531.        If ScrollCode In [scHorzEndScroll,scVertEndScroll,scHorzPosition,scVertPosition] Then
  22532.      Begin
  22533.           If FAutoScroll Then
  22534.           Begin
  22535.                {$IFDEF OS2}
  22536.                WinEnableWindowUpdate(Handle,False);
  22537.                {$ENDIF}
  22538.                {$IFDEF Win95}
  22539.                SendMessage(Handle,WM_SETREDRAW,0,0);
  22540.                {$ENDIF}
  22541.  
  22542.                FIgnoreAdjust := True;
  22543.                If Sender=FVertScrollBar Then
  22544.                Begin
  22545.                     For t:=0 To ControlCount-1 Do
  22546.                     Begin
  22547.                         Control:=Controls[t];
  22548.                         If Control<>FVertScrollBar Then
  22549.                           If Control<>FHorzScrollBar Then
  22550.                           Begin
  22551.                                Control.ZOrder:=zoBottom;
  22552.                                Control.Bottom:=Control.Bottom+(ScrollPos-FVPos);
  22553.                           End;
  22554.                     End;
  22555.                     FVPos:=ScrollPos;
  22556.                End;
  22557.  
  22558.                If Sender=FHorzScrollBar Then
  22559.                Begin
  22560.                     For t:=0 To ControlCount-1 Do
  22561.                     Begin
  22562.                         Control:=Controls[t];
  22563.                         If Control<>FVertScrollBar Then
  22564.                           If Control<>FHorzScrollBar Then
  22565.                           Begin
  22566.                                Control.ZOrder:=zoBottom;
  22567.                                Control.Left:=Control.Left-(ScrollPos-FHPos);
  22568.                           End;
  22569.                     End;
  22570.                     FHPos:=ScrollPos;
  22571.                End;
  22572.                FIgnoreAdjust := False;
  22573.  
  22574.                {$IFDEF OS2}
  22575.                WinEnableWindowUpdate(Handle,True);
  22576.                {$ENDIF}
  22577.                {$IFDEF Win95}
  22578.                SendMessage(Handle,WM_SETREDRAW,1,0);
  22579.                {$ENDIF}
  22580.                Invalidate;
  22581.  
  22582.                If Designed Then Form.Invalidate;
  22583.           End;
  22584.  
  22585.           CaptureFocus;
  22586.      End;
  22587. End;
  22588. {$HINTS ON}
  22589.  
  22590.  
  22591. Procedure TScrollingWinControl.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  22592. Type TScrollExtents=Record
  22593.                          VMin,VMax:LongInt;
  22594.                          HMin,HMax:LongInt;
  22595.                          VPos,HPos:LongInt;
  22596.                          VLargeChange,VSmallChange:LongInt;
  22597.                          HLargeChange,HSmallChange:LongInt;
  22598.                          VColor,HColor:TColor;
  22599.                          VSliderSize,HSliderSize:LongInt;
  22600.                    End;
  22601.      PScrollExtents=^TScrollExtents;
  22602. Var ScrollExtents:PScrollExtents;
  22603. Begin
  22604.      If ResName = rnScrollExtents Then
  22605.      Begin
  22606.           If DataLen <> 0 Then
  22607.           Begin
  22608.                ScrollExtents:=@Data;
  22609.                If FVertScrollBar<>Nil Then
  22610.                Begin
  22611.                     FVertScrollBar.Min:=ScrollExtents^.VMin;
  22612.                     FVertScrollBar.Max:=ScrollExtents^.VMax;
  22613.                     FVertScrollBar.Position:=ScrollExtents^.VPos;
  22614.                     FVertScrollBar.LargeChange:=ScrollExtents^.VLargeChange;
  22615.                     FVertScrollBar.SmallChange:=ScrollExtents^.VSmallChange;
  22616.                     FVertScrollBar.Color:=ScrollExtents^.VColor;
  22617.                     FVertScrollBar.SliderSize:=ScrollExtents^.VSliderSize;
  22618.                End
  22619.                Else
  22620.                Begin
  22621.                     FVMin:=ScrollExtents^.VMin;
  22622.                     FVMax:=ScrollExtents^.VMax;
  22623.                     FVPos:=ScrollExtents^.VPos;
  22624.                     FVLargeChange:=ScrollExtents^.VLargeChange;
  22625.                     FVSmallChange:=ScrollExtents^.VSmallChange;
  22626.                     FVColor:=ScrollExtents^.VColor;
  22627.                     FVSliderSize:=ScrollExtents^.VSliderSize;
  22628.                End;
  22629.                If FHorzScrollBar<>Nil Then
  22630.                Begin
  22631.                     FHorzScrollBar.Min:=ScrollExtents^.HMin;
  22632.                     FHorzScrollBar.Max:=ScrollExtents^.HMax;
  22633.                     FHorzScrollBar.Position:=ScrollExtents^.HPos;
  22634.                     FHorzScrollBar.LargeChange:=ScrollExtents^.HLargeChange;
  22635.                     FHorzScrollBar.SmallChange:=ScrollExtents^.HSmallChange;
  22636.                     FHorzScrollBar.Color:=ScrollExtents^.HColor;
  22637.                     FHorzScrollBar.SliderSize:=ScrollExtents^.HSliderSize;
  22638.                End
  22639.                Else
  22640.                Begin
  22641.                     FHMin:=ScrollExtents^.HMin;
  22642.                     FHMax:=ScrollExtents^.HMax;
  22643.                     FHPos:=ScrollExtents^.HPos;
  22644.                     FHLargeChange:=ScrollExtents^.HLargeChange;
  22645.                     FHSmallChange:=ScrollExtents^.HSmallChange;
  22646.                     FHColor:=ScrollExtents^.HColor;
  22647.                     FHSliderSize:=ScrollExtents^.HSliderSize;
  22648.                End;
  22649.           End;
  22650.      End
  22651.      Else Inherited ReadSCUResource(ResName,Data,DataLen)
  22652. End;
  22653.  
  22654.  
  22655. Function TScrollingWinControl.WriteSCUResource(Stream:TResourceStream):Boolean;
  22656. Var ScrollExtents:Record
  22657.                          VMin,VMax:LongInt;
  22658.                          HMin,HMax:LongInt;
  22659.                          VPos,HPos:LongInt;
  22660.                          VLargeChange,VSmallChange:LongInt;
  22661.                          HLargeChange,HSmallChange:LongInt;
  22662.                          VColor,HColor:TColor;
  22663.                          VSliderSize,HSliderSize:LongInt;
  22664.                   End;
  22665. Begin
  22666.      Result := Inherited WriteSCUResource(Stream);
  22667.  
  22668.      If Not Result Then Exit;
  22669.      If ((FVertScrollBar=Nil)And(FHorzScrollBar=Nil)) Then exit;
  22670.  
  22671.      If FVertScrollBar<>Nil Then
  22672.      Begin
  22673.           ScrollExtents.VMin:=FVertScrollBar.Min;
  22674.           ScrollExtents.VMax:=FVertScrollBar.Max;
  22675.           ScrollExtents.VPos:=FVertScrollBar.Position;
  22676.           ScrollExtents.VLargeChange:=FVertScrollBar.LargeChange;
  22677.           ScrollExtents.VSmallChange:=FVertScrollBar.SmallChange;
  22678.           ScrollExtents.VColor:=FVertScrollBar.Color;
  22679.           ScrollExtents.VSliderSize:=FVertScrollBar.SliderSize;
  22680.      End
  22681.      Else
  22682.      Begin
  22683.           ScrollExtents.VMin:=0;
  22684.           ScrollExtents.VMax:=100;
  22685.           ScrollExtents.VPos:=0;
  22686.           ScrollExtents.VLargeChange:=10;
  22687.           ScrollExtents.VSmallChange:=5;
  22688.           ScrollExtents.VColor:=clScrollBar;
  22689.           ScrollExtents.VSliderSize:=1;
  22690.      End;
  22691.  
  22692.      If FHorzScrollBar<>Nil Then
  22693.      Begin
  22694.           ScrollExtents.HMin:=FHorzScrollBar.Min;
  22695.           ScrollExtents.HMax:=FHorzScrollBar.Max;
  22696.           ScrollExtents.HPos:=FHorzScrollBar.Position;
  22697.           ScrollExtents.HLargeChange:=FHorzScrollBar.LargeChange;
  22698.           ScrollExtents.HSmallChange:=FHorzScrollBar.SmallChange;
  22699.           ScrollExtents.HColor:=FHorzScrollBar.Color;
  22700.           ScrollExtents.HSliderSize:=FHorzScrollBar.SliderSize;
  22701.      End
  22702.      Else
  22703.      Begin
  22704.           ScrollExtents.HMin:=0;
  22705.           ScrollExtents.HMax:=100;
  22706.           ScrollExtents.HPos:=0;
  22707.           ScrollExtents.HLargeChange:=10;
  22708.           ScrollExtents.HSmallChange:=5;
  22709.           ScrollExtents.HColor:=clScrollBar;
  22710.           ScrollExtents.HSliderSize:=1;
  22711.      End;
  22712.  
  22713.      Result := Stream.NewResourceEntry(rnScrollExtents,ScrollExtents,sizeof(ScrollExtents));
  22714. End;
  22715.  
  22716.  
  22717. Procedure TScrollingWinControl.RemoveControl(AChild:TControl);
  22718. Begin
  22719.      Inherited RemoveControl(AChild);
  22720.  
  22721.      If AChild <> FHorzScrollbar Then
  22722.        If AChild <> FVertScrollbar Then
  22723.        Begin
  22724.             AdjustScrollbars;
  22725.             AlignScrollbars;
  22726.        End;
  22727. End;
  22728.  
  22729.  
  22730. Procedure TScrollingWinControl.InsertControl(AChild:TControl);
  22731. Begin
  22732.      Inherited InsertControl(AChild);
  22733.  
  22734.      If AChild <> FHorzScrollbar Then
  22735.        If AChild <> FVertScrollbar Then
  22736.        Begin
  22737.             AdjustScrollbars;
  22738.             AlignScrollbars;
  22739.        End;
  22740. End;
  22741.  
  22742.  
  22743. Procedure TScrollingWinControl.AdjustScrollbars;
  22744. Var  i,horzmax,vertmax:Longint;
  22745.      Control:TControl;
  22746.      OldIgnoreAdjust:Boolean;
  22747.      HorzIsVisible,VertIsVisible:Boolean;
  22748.      hpos,vpos:Longint;
  22749. Begin
  22750.      If FIgnoreAdjust Then exit;
  22751.  
  22752.      OldIgnoreAdjust := FIgnoreAdjust;
  22753.      FIgnoreAdjust := True;
  22754.  
  22755.      If FAutoScroll And
  22756.        (FHorzScrollBar <> Nil) And (FVertScrollBar <> Nil) Then
  22757.      Begin
  22758.           horzmax := 0;
  22759.           vertmax := ClientHeight;
  22760.  
  22761.           hpos := FHorzScrollbar.Position;
  22762.           vpos := FVertScrollbar.Position;
  22763.  
  22764.           For i := 0 To ControlCount-1 Do
  22765.           Begin
  22766.                Control := Controls[i];
  22767.                If Control <> FHorzScrollBar Then
  22768.                  If Control <> FVertScrollBar Then
  22769.                  Begin
  22770.                       If Control.Left + Control.Width + hpos > horzmax
  22771.                         Then horzmax := Control.Left + Control.Width + hpos;
  22772.                       If Control.Bottom - vpos < vertmax
  22773.                         Then vertmax := Control.Bottom - vpos;
  22774.                  End;
  22775.           End;
  22776.  
  22777.           If vertmax < 0 Then // vertscroll is visible
  22778.           Begin
  22779.                inc(horzmax, FVertScrollbar.Width);
  22780.                If horzmax > ClientWidth Then dec(vertmax, FHorzScrollbar.Height);
  22781.           End
  22782.           Else
  22783.           Begin
  22784.                If horzmax > ClientWidth Then // horzscroll is visible
  22785.                Begin
  22786.                     dec(vertmax, FHorzScrollbar.Height);
  22787.                     If vertmax < 0 Then inc(horzmax, FVertScrollbar.Width);
  22788.                End;
  22789.           End;
  22790.  
  22791.  
  22792.           //show or hide Scrollbars
  22793.           FHorzScrollBar.SetScrollRange(0,horzmax,ClientWidth);
  22794.           //FHPos := FHorzScrollBar.Position;
  22795.  
  22796.           HorzIsVisible := horzmax > ClientWidth;
  22797.           If HorzIsVisible Then FHorzScrollBar.Show
  22798.           Else FHorzScrollBar.Hide;
  22799.  
  22800.  
  22801.           FVertScrollBar.SetScrollRange(0,ClientHeight-vertmax,ClientHeight);
  22802.           //FVPos := FVertScrollBar.Position;
  22803.  
  22804.           VertIsVisible := vertmax < 0;
  22805.           If VertIsVisible Then FVertScrollBar.Show
  22806.           Else FVertScrollBar.Hide;
  22807.  
  22808.  
  22809.           If horzmax - hpos < ClientWidth Then
  22810.           Begin
  22811.                hpos := FHorzScrollBar.Position;
  22812.                Scroll(FHorzScrollbar, scHorzPosition, hpos);
  22813.           End;
  22814.  
  22815.           If vertmax + vpos > 0 Then
  22816.           Begin
  22817.                vpos := FVertScrollBar.Position;
  22818.                Scroll(FVertScrollbar, scVertPosition, vpos);
  22819.           End;
  22820.      End;
  22821.  
  22822.      FIgnoreAdjust := OldIgnoreAdjust;
  22823. End;
  22824.  
  22825.  
  22826. Procedure TScrollingWinControl.AlignScrollbars;
  22827. Var  HorzIsVisible,VertIsVisible:Boolean;
  22828.      OldIgnoreAdjust:Boolean;
  22829.      rc:TRect;
  22830. Begin
  22831.      If FIgnoreAdjust Then exit;
  22832.  
  22833.      OldIgnoreAdjust := FIgnoreAdjust;
  22834.      FIgnoreAdjust := True;
  22835.  
  22836.      If FAutoScroll Then
  22837.      Begin
  22838.           If FHorzScrollBar = Nil Then HorzIsVisible := False
  22839.           Else HorzIsVisible := FHorzScrollBar.Max > ClientWidth;
  22840.  
  22841.           If FVertScrollBar = Nil Then VertIsVisible := False
  22842.           Else VertIsVisible := FVertScrollBar.Max > ClientHeight;
  22843.      End
  22844.      Else
  22845.      Begin
  22846.           HorzIsVisible := FHorzScrollBar <> Nil;
  22847.           VertIsVisible := FVertScrollBar <> Nil;
  22848.      End;
  22849.  
  22850.      If FHorzScrollBar <> Nil Then
  22851.      Begin
  22852.           rc := GetClientRect;
  22853.  
  22854.           If VertIsVisible Then dec(rc.Right,FVertScrollBar.Width-1);
  22855.  
  22856.           FHorzScrollBar.SetWindowPos(rc.Left,rc.Bottom,
  22857.                             rc.Right-rc.Left+1,FHorzScrollBar.Height);
  22858.           FHorzScrollBar.FFirstShow := False;
  22859.      End;
  22860.  
  22861.      If FVertScrollBar <> Nil Then
  22862.      Begin
  22863.           rc := GetClientRect;
  22864.  
  22865.           If HorzIsVisible Then inc(rc.Bottom,FHorzScrollBar.Height);
  22866.  
  22867.           FVertScrollBar.SetWindowPos(rc.Right+1-FVertScrollBar.Width,rc.Bottom,
  22868.                             FVertScrollBar.Width,rc.Top-rc.Bottom+1);
  22869.           FVertScrollBar.FFirstShow := False;
  22870.      End;
  22871.  
  22872.      FIgnoreAdjust := OldIgnoreAdjust;
  22873. End;
  22874.  
  22875.  
  22876. Procedure TScrollingWinControl.Loaded;
  22877. Begin
  22878.      Inherited Loaded;
  22879.  
  22880.      If FHorzScrollbar <> Nil Then FHPos := FHorzScrollbar.Position;
  22881.      If FVertScrollbar <> Nil Then FVPos := FVertScrollbar.Position;
  22882. End;
  22883.  
  22884.  
  22885. {
  22886. ╔═══════════════════════════════════════════════════════════════════════════╗
  22887. ║                                                                           ║
  22888. ║ Speed-Pascal/2 Version 2.0                                                ║
  22889. ║                                                                           ║
  22890. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  22891. ║                                                                           ║
  22892. ║ This section: TScrollBox Class Implementation                             ║
  22893. ║                                                                           ║
  22894. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  22895. ║                                                                           ║
  22896. ╚═══════════════════════════════════════════════════════════════════════════╝
  22897. }
  22898.  
  22899. Procedure TScrollBox.SetBorderStyle(NewValue:TBorderStyle);
  22900. Begin
  22901.      If NewValue=FBorderStyle Then exit;
  22902.      FBorderStyle:=NewValue;
  22903.      Invalidate;
  22904. End;
  22905.  
  22906. {$HINTS OFF}
  22907. Procedure TScrollBox.Redraw(Const rec:TRect);
  22908. Var rc:TRect;
  22909. Begin
  22910.      rc:=ClientRect;
  22911.      If FHorzScrollBar<>Nil Then
  22912.        If FHorzScrollBar.Visible Then inc(rc.Bottom,FHorzScrollBar.Height);
  22913.      If FVertScrollBar<>Nil Then
  22914.        If FVertScrollBar.Visible Then dec(rc.Right,FVertScrollBar.Width);
  22915.      If BorderStyle=bsSingle Then
  22916.      Begin
  22917.           FCanvas.ShadowedBorder(rc,clDkGray,clWhite);
  22918.           InflateRect(rc,-1,-1);
  22919.      End;
  22920.      Inherited Redraw(rc);
  22921. End;
  22922. {$HINTS ON}
  22923.  
  22924.  
  22925. Procedure TScrollBox.SetupComponent;
  22926. Begin
  22927.      Inherited SetupComponent;
  22928.  
  22929.      Name:='ScrollBox';
  22930.      AutoScroll:=True;
  22931.      Color:=clLtGray;
  22932.      FBorderStyle:=bsSingle;
  22933.      Width:=300;
  22934.      Height:=300;
  22935.      ScrollBars:=ssBoth;
  22936.      Include(ComponentState, csAcceptsControls);
  22937. End;
  22938.  
  22939.  
  22940. {
  22941. ╔═══════════════════════════════════════════════════════════════════════════╗
  22942. ╚═══════════════════════════════════════════════════════════════════════════╝
  22943. }
  22944.  
  22945. Procedure SetupCompLib(Var Data:TCompLibData);
  22946. Begin
  22947.      Asm
  22948.         MOVB System.InheritsSoftMode,1  {!!! wegen complib.dll !!!}
  22949.         MOVB Classes.InsideDesigner,1
  22950.         MOVB Classes.InsideCompLib,1
  22951.         MOV EDI,Data
  22952.         MOV EAX,[EDI].TCompLibData.InsideWriteSCUAdr
  22953.         MOV Classes.InsideWriteSCUAdr,EAX
  22954.      End;
  22955.      HeapOrg:=Data.NewHeapOrg;
  22956.      HeapEnd:=Data.NewHeapEnd;
  22957.      HeapPtr:=Data.NewHeapPtr;
  22958.      System.HeapSize:=Data.NewHeapSize;
  22959.      {$IFDEF OS2}
  22960.      Asm
  22961.         MOV EDI,Data
  22962.         MOV EAX,[EDI].TCompLibData.NewLastHeapPage
  22963.         MOV System.LastHeapPage,EAX
  22964.         MOV EAX,[EDI].TCompLibData.NewLastHeapPageAdr
  22965.         MOV System.LastHeapPageAdr,EAX
  22966.         MOV EAX,[EDI].TCompLibData.NewHeapMutex;
  22967.         MOV System.HeapMutex,EAX
  22968.      End;
  22969.      {$ENDIF}
  22970.      Screen:=Data.Screen;
  22971.      Clipboard:=Data.Clipboard;
  22972.      Application:=Data.Application;
  22973.      NullStr:=Data.NullStr;
  22974.      If RegisterToolsAPIProc<>Nil Then
  22975.      Begin
  22976.           RegisterToolsAPIProc(Data.ToolsAPI);
  22977.           Data.ToolsAPIRequired:=True;
  22978.      End
  22979.      Else Data.ToolsAPIRequired:=False;
  22980. End;
  22981.  
  22982.  
  22983. {$IFDEF OS2}
  22984. Var
  22985.     DBCSFirstBytes:Array[0..255] Of Boolean;
  22986.  
  22987. Function IsDBCSFirstByte(CH:Char):Boolean;
  22988. Begin
  22989.      Result := DBCSFirstBytes[Ord(CH)];
  22990. End;
  22991.  
  22992.  
  22993. Procedure InitDBCSHandling;
  22994. Var  MemBuf:Array[0..11] Of Byte;
  22995.      cc:COUNTRYCODE;
  22996.      I,First,Second:Byte;
  22997.      Font:TFont;
  22998.      dbcs:Boolean;
  22999. Begin
  23000.      dbcs := False;
  23001.      FillChar(DBCSFirstBytes[0], SizeOf(DBCSFirstBytes), 0);
  23002.      cc.country := 0;
  23003.      cc.codepage := 0;
  23004.      If DosQueryDBCSEnv(12,cc,MemBuf) = 0 Then
  23005.      Begin
  23006.           For I := 0 To 5 Do
  23007.           Begin
  23008.                First := MemBuf[2*I];
  23009.                Second := MemBuf[(2*I)+1];
  23010.                If (First = 0) And (Second = 0) Then break;
  23011.                FillChar(DBCSFirstBytes[First], Second-First+1, 1);
  23012.                dbcs := True;
  23013.           End;
  23014.      End;
  23015.  
  23016.      If Not dbcs Then Exit;
  23017.  
  23018.      {initialize DBCSStatusLineHeight}
  23019.      Font := Screen.DefaultFrameFont;
  23020.      If Font <> Nil
  23021.      Then DBCSStatusLineHeight := Font.FFontInfo.lMaxbaseLineExt +2;
  23022. End;
  23023. {$ENDIF}
  23024.  
  23025. {$IFDEF WIN32}
  23026. Var SA:SECURITY_ATTRIBUTES;
  23027. {$ENDIF}
  23028.  
  23029. Begin
  23030.      {$IFDEF OS2}
  23031.      NewStyleControls:=False;
  23032.      {$ENDIF}
  23033.      {$IFDEF WIN32}
  23034.      NewStyleControls:=Lo(GetVersion)>=4;
  23035.      {$ENDIF}
  23036.  
  23037.      RegisterClasses([TControl]);
  23038.  
  23039.      @DdeMan_WMDDEDestroy:=Nil;
  23040.      @DdeMan_WMDdeInitiate:=Nil;
  23041.      @DdeMan_OpenClientLinks:=Nil;
  23042.      @DdeMan_CloseClientLinks:=Nil;
  23043.      @DdeMan_CloseAllLinks:=Nil;
  23044.  
  23045.      IconClass:=Nil;
  23046.      If ApplicationType=1 Then
  23047.      Begin
  23048.          Screen.Create(Nil);
  23049.          Clipboard.Create(Nil);
  23050.          TimerList.Create;
  23051.          New(TimerArray);
  23052.          ExternalDragDropObject.Create(Nil);
  23053.      End
  23054.      Else
  23055.      Begin
  23056.          Screen:=Nil;
  23057.          Clipboard:=Nil;
  23058.          TimerList:=Nil;
  23059.          TimerArray:=Nil;
  23060.          ExternalDragDropObject:=Nil;
  23061.      End;
  23062.  
  23063.      {$IFDEF OS2}
  23064.      DosCreateMutexSem(Nil,TimerMutex,DC_SEM_SHARED,False);
  23065.      InitDBCSHandling;
  23066.      {$ENDIF}
  23067.      {$IFDEF Win32}
  23068.      SA.nLength:=sizeof(SA);
  23069.      SA.lpSecurityDescriptor:=Nil;
  23070.      SA.bInheritHandle:=True;
  23071.      TimerMutex:=CreateMutex(SA,False,Nil);
  23072.      InitCommonControls;
  23073.      {$ENDIF}
  23074. End.
  23075.  
  23076.  
  23077.