PageRenderTime 51ms CodeModel.GetById 18ms RepoModel.GetById 1ms app.codeStats 0ms

/Components/EhLib 4.2/Common/ToolCtrlsEh.pas

http://github.com/mitshel/tech-inv
Pascal | 1897 lines | 1560 code | 183 blank | 154 comment | 174 complexity | 10995667b0549dc887a299b27712be12 MD5 | raw file
Possible License(s): AGPL-3.0

Large files files are truncated, but you can click here to view the full file

    

  1. {*******************************************************}
    2. 

  2. {                                                       }
    3. 

  3. {                      EhLib v4.2                       }
    4. 

  4. {                     Tool controls                     }
    5. 

  5. {                    (Build 4.2.05)                     }
    6. 

  6. {                                                       }
    7. 

  7. {      Copyright (c) 2001-2006 by Dmitry V. Bolshakov   }
    8. 

  8. {                                                       }
    9. 

  9. {*******************************************************}
    10. 

  10. 

  11. {$I EhLib.Inc}
    12. 

  12. 

  13. {$IFDEF EH_LIB_VCL}
    14. 

  14. unit ToolCtrlsEh {$IFDEF CIL} platform {$ENDIF};
    15. 

  15. {$ELSE}
    16. 

  16. unit QToolCtrlsEh;
    17. 

  17. {$ENDIF}
    18. 

  18. 

  19. interface
    20. 

  20. 

  21. {$IFDEF EH_LIB_VCL}
    22. 

  22. uses
    23. 

  23.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    24. 

  24. {$IFDEF EH_LIB_5} Contnrs, ActnList, {$ENDIF}
    25. 

  25. {$IFDEF EH_LIB_6} Variants, {$ENDIF}
    26. 

  26. {$IFDEF CIL}
    27. 

  27.   EhLibVCLNET,
    28. 

  28. {$ELSE}
    29. 

  29.   EhLibVCL,
    30. 

  30. {$ENDIF}
    31. 

  31.   StdCtrls, Mask, Db, DBCtrls, Buttons, ExtCtrls, Menus, ComCtrls, CommCtrl,
    32. 

  32.   Imglist;
    33. 

  33. {$ELSE}
    34. 

  34. uses
    35. 

  35.   QGraphics, QControls, QForms, QDialogs, Variants, QStdCtrls, QMask,
    36. 

  36.   QDBCtrls, QButtons, QExtCtrls, QMenus, QComCtrls, QImglist,
    37. 

  37.   Db, SysUtils, Classes;
    38. 

  38. {$ENDIF}
    39. 

  39. 

  40. const
    41. 

  41.   CM_IGNOREEDITDOWN = WM_USER + 102;
    42. 

  42. 

  43. type
    44. 

  44. 

  45.   TLocateTextOptionEh = (ltoCaseInsensitiveEh, ltoAllFieldsEh, ltoMatchFormatEh, ltoIgnoteCurrentPosEh);
    46. 

  46.   TLocateTextOptionsEh = set of TLocateTextOptionEh;
    47. 

  47.   TLocateTextDirectionEh = (ltdUpEh, ltdDownEh, ltdAllEh);
    48. 

  48.   TLocateTextMatchingEh = (ltmAnyPartEh, ltmWholeEh, ltmFromBegingEh);
    49. 

  49.   TLocateTextTreeFindRangeEh = (lttInAllNodesEh, lttInExpandedNodesEh,
    50. 

  50.     lttInCurrentLevelEh, lttInCurrentNodeEh);
    51. 

  51. 

  52.   IMemTableDataFieldValueListEh = interface
    53. 

  53.     ['{28F8194C-5FF3-42C4-87A6-8B3E06210FA6}']
    54. 

  54.     function GetValues: TStrings;
    55. 

  55.   end;
    56. 

  56. 

  57.   IMemTableEh = interface
    58. 

  58.     ['{A8C3C87A-E556-4BDB-B8A7-5B33497D1624}']
    59. 

  59. //    property TreeViewMode: Boolean read GetTreeViewMode write SetTreeViewMode;
    60. 

  60.     function FetchRecords(Count: Integer): Integer;
    61. 

  61.     function GetInstantReadCurRowNum: Integer;
    62. 

  62.     function GetTreeNodeExpanded(RowNum: Integer): Boolean; overload;
    63. 

  63.     function GetTreeNodeExpanded: Boolean; overload;
    64. 

  64.     function GetTreeNodeHasChields: Boolean;
    65. 

  65.     function GetTreeNodeLevel: Integer;
    66. 

  66.     function GetPrevVisibleTreeNodeLevel: Integer;
    67. 

  67.     function GetNextVisibleTreeNodeLevel: Integer;
    68. 

  68.     function GetRecObject: TObject;
    69. 

  69.     function InstantReadIndexOfBookmark(Bookmark: TBookmarkStr): Integer;
    70. 

  70.     function InstantReadRowCount: Integer;
    71. 

  71.     function MemTableIsTreeList: Boolean;
    72. 

  72.     function ParentHasNextSibling(ParenLevel: Integer): Boolean;
    73. 

  73.     function SetToRec(Rec: TObject): Boolean;
    74. 

  74.     function SetTreeNodeExpanded(RowNum: Integer; Value: Boolean): Integer;
    75. 

  75.     function GetFieldValueList(FieldName: String): IMemTableDataFieldValueListEh;
    76. 

  76.     function MoveRecords(BookmarkList: TStrings; ToRecNo: Longint; TreeLevel: Integer; CheckOnly: Boolean): Boolean;
    77. 

  77.     procedure InstantReadEnter(RowNum: Integer);
    78. 

  78.     procedure InstantReadLeave;
    79. 

  79.     property InstantReadCurRowNum: Integer read GetInstantReadCurRowNum;
    80. 

  80. //    property TreeNodeCollapsed: Boolean read GetTreeNodeCollapsed write SetTreeNodeCollapsed;
    81. 

  81.   end;
    82. 

  82. 

  83.   IComboEditEh = interface
    84. 

  84.     ['{B64255B5-386A-4524-8BC7-7F49DDB410F4}']
    85. 

  85.     procedure CloseUp(Accept: Boolean);
    86. 

  86.   end;
    87. 

  87. 

  88.   TFieldsArrEh = array of TField;
    89. 

  89. 

  90. { Standard events }
    91. 

  91. 

  92.   TButtonClickEventEh = procedure(Sender: TObject; var Handled: Boolean) of object;
    93. 

  93.   TButtonDownEventEh = procedure(Sender: TObject; TopButton: Boolean;
    94. 

  94.     var AutoRepeat: Boolean; var Handled: Boolean) of object;
    95. 

  95.   TCloseUpEventEh = procedure(Sender: TObject; Accept: Boolean) of object;
    96. 

  96.   TAcceptEventEh = procedure(Sender: TObject; var Accept: Boolean) of object;
    97. 

  97.   TNotInListEventEh = procedure(Sender: TObject; NewText: String;
    98. 

  98.     var RecheckInList: Boolean) of object;
    99. 

  99.   TUpdateDataEventEh = procedure(Sender: TObject; var Handled: Boolean) of object;
    100. 

  100. 

  101. { TBMListEh }
    102. 

  102. 

  103.   TBMListEh = class
    104. 

  104.   private
    105. 

  105.     FCache: TBookmarkStr;
    106. 

  106.     FCacheFind: Boolean;
    107. 

  107.     FCacheIndex: Integer;
    108. 

  108.     FLinkActive:boolean;
    109. 

  109.     function GetCount: Integer;
    110. 

  110.     function GetCurrentRowSelected: Boolean;
    111. 

  111.     function GetItem(Index: Integer): TBookmarkStr;
    112. 

  112.   protected
    113. 

  113.     FList: TStringList;
    114. 

  114.     function Compare(const Item1, Item2: TBookmarkStr): Integer;
    115. 

  115.     function CurrentRow: TBookmarkStr;
    116. 

  116.     function GetDataSet:TDataSet; virtual; abstract;
    117. 

  117.     procedure Invalidate; virtual;
    118. 

  118.     procedure LinkActive(Value: Boolean);
    119. 

  119.     procedure RaiseBMListError(const S: string); virtual;
    120. 

  120.     procedure SetCurrentRowSelected(Value: Boolean); virtual;
    121. 

  121.     procedure StringsChanged(Sender: TObject); virtual;
    122. 

  122.     procedure UpdateState; virtual;
    123. 

  123.   public
    124. 

  124.     constructor Create;
    125. 

  125.     destructor Destroy; override;
    126. 

  126.     function Find(const Item: TBookmarkStr; var Index: Integer): Boolean;
    127. 

  127.     function IndexOf(const Item: TBookmarkStr): Integer;
    128. 

  128.     function Refresh: Boolean;
    129. 

  129.     procedure Clear; virtual;
    130. 

  130.     procedure Delete;
    131. 

  131.     procedure SelectAll;
    132. 

  132.     property Count: Integer read GetCount;
    133. 

  133.     property CurrentRowSelected: Boolean read GetCurrentRowSelected write SetCurrentRowSelected;
    134. 

  134.     property DataSet:TDataSet read GetDataSet;
    135. 

  135.     property Items[Index: Integer]: TBookmarkStr read GetItem; default;
    136. 

  136.   end;
    137. 

  137. 

  138. { TEditButtonControlEh }
    139. 

  139. 

  140.   TEditButtonStyleEh = (ebsDropDownEh, ebsEllipsisEh, ebsGlyphEh, ebsUpDownEh,
    141. 

  141.     ebsPlusEh, ebsMinusEh);
    142. 

  142. 

  143.   TEditButtonControlEh = class(TSpeedButton)
    144. 

  144.   private
    145. 

  145.     FActive: Boolean;
    146. 

  146.     FAlwaysDown: Boolean;
    147. 

  147.     FButtonNum: Integer;
    148. 

  148.     FNoDoClick: Boolean;
    149. 

  149.     FOnDown: TButtonDownEventEh;
    150. 

  150.     FStyle: TEditButtonStyleEh;
    151. 

  151.     FTimer: TTimer;
    152. 

  152.     function GetTimer: TTimer;
    153. 

  153.     procedure ResetTimer(Interval: Cardinal);
    154. 

  154.     procedure SetActive(const Value: Boolean);
    155. 

  155.     procedure SetAlwaysDown(const Value: Boolean);
    156. 

  156.     procedure SetStyle(const Value: TEditButtonStyleEh);
    157. 

  157.     procedure TimerEvent(Sender: TObject);
    158. 

  158.     procedure UpdateDownButtonNum(X, Y: Integer);
    159. 

  159.   protected
    160. 

  160.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    161. 

  161.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    162. 

  162.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    163. 

  163.     procedure Paint; override;
    164. 

  164.     property Timer: TTimer read GetTimer;
    165. 

  165.   public
    166. 

  166.     procedure Click; override;
    167. 

  167.     procedure EditButtonDown(TopButton: Boolean; var AutoRepeat: Boolean);
    168. 

  168.     procedure SetState(NewState: TButtonState; IsActive: Boolean; ButtonNum: Integer);
    169. 

  169.     procedure SetWidthNoNotify(AWidth: Integer);
    170. 

  170.     property Active: Boolean read FActive write SetActive;
    171. 

  171.     property AlwaysDown: Boolean read FAlwaysDown write SetAlwaysDown;
    172. 

  172.     property Style: TEditButtonStyleEh read FStyle write SetStyle default ebsDropDownEh;
    173. 

  173.     property OnDown: TButtonDownEventEh read FOnDown write FOnDown;
    174. 

  174.   end;
    175. 

  175. 

  176.   TSpeedButtonEh = class(TEditButtonControlEh)
    177. 

  177.   published
    178. 

  178.     property Active;
    179. 

  179.     property Style;
    180. 

  180.   end;
    181. 

  181. 

  182.   TEditButtonControlLineRec = record
    183. 

  183.     ButtonLine: TShape;
    184. 

  184.     EditButtonControl: TEditButtonControlEh;
    185. 

  185.   end;
    186. 

  186. 

  187.   TEditButtonControlList = array of TEditButtonControlLineRec;
    188. 

  188. 

  189.   TEditButtonEh = class;
    190. 

  190. 

  191.   TEditButtonActionLinkEh = class(TActionLink)
    192. 

  192.   protected
    193. 

  193.     FClient: TEditButtonEh;
    194. 

  194.     procedure AssignClient(AClient: TObject); override;
    195. 

  195.     function IsEnabledLinked: Boolean; override;
    196. 

  196.     function IsHintLinked: Boolean; override;
    197. 

  197.     function IsShortCutLinked: Boolean; override;
    198. 

  198.     function IsVisibleLinked: Boolean; override;
    199. 

  199.     procedure SetEnabled(Value: Boolean); override;
    200. 

  200.     procedure SetHint(const Value: string); override;
    201. 

  201.     procedure SetShortCut(Value: TShortCut); override;
    202. 

  202.     procedure SetVisible(Value: Boolean); override;
    203. 

  203.   end;
    204. 

  204. 

  205.   TEditButtonActionLinkEhClass = class of TEditButtonActionLinkEh;
    206. 

  206. 

  207. { TEditButtonEh }
    208. 

  208. 

  209.   TEditButtonEh = class(TCollectionItem)
    210. 

  210.   private
    211. 

  211.     FActionLink: TEditButtonActionLinkEh;
    212. 

  212.     FDropdownMenu: TPopupMenu;
    213. 

  213.     FEditControl: TWinControl;
    214. 

  214.     FEnabled: Boolean;
    215. 

  215.     FGlyph: TBitmap;
    216. 

  216.     FHint: String;
    217. 

  217.     FNumGlyphs: Integer;
    218. 

  218.     FOnButtonClick: TButtonClickEventEh;
    219. 

  219.     FOnButtonDown: TButtonDownEventEh;
    220. 

  220.     FOnChanged: TNotifyEvent;
    221. 

  221.     FShortCut: TShortCut;
    222. 

  222.     FStyle: TEditButtonStyleEh;
    223. 

  223.     FVisible: Boolean;
    224. 

  224.     FWidth: Integer;
    225. 

  225.     function GetAction: TBasicAction;
    226. 

  226.     function GetGlyph: TBitmap;
    227. 

  227.     function IsEnabledStored: Boolean;
    228. 

  228.     function IsHintStored: Boolean;
    229. 

  229.     function IsShortCutStored: Boolean;
    230. 

  230.     function IsVisibleStored: Boolean;
    231. 

  231.     procedure DoActionChange(Sender: TObject);
    232. 

  232.     procedure SetAction(const Value: TBasicAction);
    233. 

  233.     procedure SetEnabled(const Value: Boolean);
    234. 

  234.     procedure SetGlyph(const Value: TBitmap);
    235. 

  235.     procedure SetHint(const Value: String);
    236. 

  236.     procedure SetNumGlyphs(Value: Integer);
    237. 

  237.     procedure SetStyle(const Value: TEditButtonStyleEh);
    238. 

  238.     procedure SetVisible(const Value: Boolean);
    239. 

  239.     procedure SetWidth(const Value: Integer);
    240. 

  240.   protected
    241. 

  241.     function CreateEditButtonControl: TEditButtonControlEh; virtual;
    242. 

  242.     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic;
    243. 

  243.     procedure Changed; overload;
    244. 

  244.     property ActionLink: TEditButtonActionLinkEh read FActionLink write FActionLink;
    245. 

  245.   public
    246. 

  246.     constructor Create(Collection: TCollection); overload; override;
    247. 

  247.     constructor Create(EditControl: TWinControl); reintroduce; overload;
    248. 

  248.     destructor Destroy; override;
    249. 

  249.     function GetActionLinkClass: TEditButtonActionLinkEhClass; dynamic;
    250. 

  250.     procedure Assign(Source: TPersistent); override;
    251. 

  251.     procedure Click(Sender: TObject; var Handled: Boolean); virtual;
    252. 

  252.     procedure InitiateAction; virtual;
    253. 

  253.     property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
    254. 

  254.   published
    255. 

  255.     property Action: TBasicAction read GetAction write SetAction;
    256. 

  256.     property DropdownMenu: TPopupMenu read FDropdownMenu write FDropdownMenu;
    257. 

  257.     property Enabled: Boolean read FEnabled write SetEnabled stored IsEnabledStored default True;
    258. 

  258.     property Glyph: TBitmap read GetGlyph write SetGlyph;
    259. 

  259.     property Hint: String read FHint write SetHint stored IsHintStored;
    260. 

  260.     property NumGlyphs: Integer read FNumGlyphs write SetNumGlyphs default 1;
    261. 

  261.     property ShortCut: TShortCut read FShortCut write FShortCut stored IsShortCutStored default scNone;
    262. 

  262.     //property ShortCut: TShortCut read FShortCut write FShortCut default 32808; //Menus.ShortCut(VK_DOWN, [ssAlt]);
    263. 

  263.     property Style: TEditButtonStyleEh read FStyle write SetStyle default ebsDropDownEh;
    264. 

  264.     property Visible: Boolean read FVisible write SetVisible stored IsVisibleStored default False;
    265. 

  265.     property Width: Integer read FWidth write SetWidth default 0;
    266. 

  266.     property OnClick: TButtonClickEventEh read FOnButtonClick write FOnButtonClick;
    267. 

  267.     property OnDown: TButtonDownEventEh read FOnButtonDown write FOnButtonDown;
    268. 

  268.   end;
    269. 

  269. 

  270.   TEditButtonEhClass = class of TEditButtonEh;
    271. 

  271. 

  272. { TDropDownEditButtonEh }
    273. 

  273. 

  274.   TDropDownEditButtonEh = class(TEditButtonEh)
    275. 

  275.   public
    276. 

  276.     constructor Create(Collection: TCollection); overload; override;
    277. 

  277.     constructor Create(EditControl: TWinControl); overload;
    278. 

  278.   published
    279. 

  279.     property ShortCut default 32808; //Menus.ShortCut(VK_DOWN, [ssAlt]);
    280. 

  280.   end;
    281. 

  281. 

  282. 

  283. { TVisibleEditButtonEh }
    284. 

  284. 

  285.   TVisibleEditButtonEh = class(TEditButtonEh)
    286. 

  286.   public
    287. 

  287.     constructor Create(Collection: TCollection); overload; override;
    288. 

  288.     constructor Create(EditControl: TWinControl); overload;
    289. 

  289.   published
    290. 

  290.     property ShortCut default 32808; //Menus.ShortCut(VK_DOWN, [ssAlt]);
    291. 

  291.     property Visible default True;
    292. 

  292.   end;
    293. 

  293. 

  294. { TEditButtonsEh }
    295. 

  295. 

  296.   TEditButtonsEh = class(TCollection)
    297. 

  297.   private
    298. 

  298.     FOnChanged: TNotifyEvent;
    299. 

  299.     function GetEditButton(Index: Integer): TEditButtonEh;
    300. 

  300.     procedure SetEditButton(Index: Integer; Value: TEditButtonEh);
    301. 

  301.   protected
    302. 

  302.     FOwner: TPersistent;
    303. 

  303.     function GetOwner: TPersistent; override;
    304. 

  304.     procedure Update(Item: TCollectionItem); override;
    305. 

  305.   public
    306. 

  306.     constructor Create(Owner: TPersistent; EditButtonClass: TEditButtonEhClass);
    307. 

  307.     function Add: TEditButtonEh;
    308. 

  308.     property Items[Index: Integer]: TEditButtonEh read GetEditButton write SetEditButton; default;
    309. 

  309.     property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
    310. 

  310.   end;
    311. 

  311. 

  312. { TSpecRowEh }
    313. 

  313. 

  314.   TSpecRowEh = class(TPersistent)
    315. 

  315.   private
    316. 

  316.     FCellsStrings: TStrings;
    317. 

  317.     FCellsText: String;
    318. 

  318.     FColor: TColor;
    319. 

  319.     FFont: TFont;
    320. 

  320.     FOnChanged: TNotifyEvent;
    321. 

  321.     FOwner: TPersistent;
    322. 

  322.     FSelected: Boolean;
    323. 

  323.     FShortCut: TShortCut;
    324. 

  324.     FShowIfNotInKeyList: Boolean;
    325. 

  325.     FUpdateCount: Integer;
    326. 

  326.     FValue: Variant;
    327. 

  327.     FVisible: Boolean;
    328. 

  328.     function GetCellText(Index: Integer): String;
    329. 

  329.     function GetColor: TColor;
    330. 

  330.     function GetFont: TFont;
    331. 

  331.     function IsColorStored: Boolean;
    332. 

  332.     function IsFontStored: Boolean;
    333. 

  333.     function IsValueStored: Boolean;
    334. 

  334.     procedure FontChanged(Sender: TObject);
    335. 

  335.     procedure SetCellsText(const Value: String);
    336. 

  336.     procedure SetColor(const Value: TColor);
    337. 

  337.     procedure SetFont(const Value: TFont);
    338. 

  338.     procedure SetShowIfNotInKeyList(const Value: Boolean);
    339. 

  339.     procedure SetValue(const Value: Variant);
    340. 

  340.     procedure SetVisible(const Value: Boolean);
    341. 

  341.   protected
    342. 

  342.     FColorAssigned: Boolean;
    343. 

  343.     FFontAssigned: Boolean;
    344. 

  344.     function GetOwner: TPersistent; override;
    345. 

  345.     procedure Changed;
    346. 

  346.   public
    347. 

  347.     constructor Create(Owner: TPersistent);
    348. 

  348.     destructor Destroy; override;
    349. 

  349.     function DefaultColor: TColor;
    350. 

  350.     function DefaultFont: TFont;
    351. 

  351.     function LocateKey(KeyValue: Variant): Boolean;
    352. 

  352.     procedure Assign(Source: TPersistent); override;
    353. 

  353.     procedure BeginUpdate;
    354. 

  354.     procedure EndUpdate;
    355. 

  355.     property CellText[Index: Integer]: String read GetCellText;
    356. 

  356.     property Selected: Boolean read FSelected write FSelected;
    357. 

  357.     property UpdateCount: Integer read FUpdateCount;
    358. 

  358.     property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
    359. 

  359.   published
    360. 

  360.     property CellsText: String read FCellsText write SetCellsText;
    361. 

  361.     property Color: TColor read GetColor write SetColor stored IsColorStored;
    362. 

  362.     property Font: TFont read GetFont write SetFont stored IsFontStored;
    363. 

  363.     property ShortCut: TShortCut read FShortCut write FShortCut default 32814; //Menus.ShortCut(VK_DOWN, [ssAlt]);
    364. 

  364.     property ShowIfNotInKeyList: Boolean read FShowIfNotInKeyList write SetShowIfNotInKeyList default True;
    365. 

  365.     property Value: Variant read FValue write SetValue stored IsValueStored;
    366. 

  366.     property Visible: Boolean read FVisible write SetVisible default False;
    367. 

  367.   end;
    368. 

  368. 

  369. { TSizeGripEh }
    370. 

  370. 

  371.   TSizeGripPostion = (sgpTopLeft, sgpTopRight, sgpBottomRight, sgpBottomLeft);
    372. 

  372.   TSizeGripChangePosition = (sgcpToLeft, sgcpToRight, sgcpToTop, sgcpToBottom);
    373. 

  373. 

  374.   TSizeGripEh = class(TCustomControl)
    375. 

  375.   private
    376. 

  376.     FInitScreenMousePos: TPoint;
    377. 

  377.     FInternalMove: Boolean;
    378. 

  378.     FOldMouseMovePos: TPoint;
    379. 

  379.     FParentRect: TRect;
    380. 

  380.     FParentResized: TNotifyEvent;
    381. 

  381.     FPosition: TSizeGripPostion;
    382. 

  382.     FTriangleWindow: Boolean;
    383. 

  383.     function GetVisible: Boolean;
    384. 

  384.     procedure SetPosition(const Value: TSizeGripPostion);
    385. 

  385.     procedure SetTriangleWindow(const Value: Boolean);
    386. 

  386.     procedure SetVisible(const Value: Boolean);
    387. 

  387.     procedure WMMove(var Message: TWMMove); message WM_MOVE;
    388. 

  388.   protected
    389. 

  389.     procedure CreateWnd; override;
    390. 

  390.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    391. 

  391.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    392. 

  392.     procedure Paint; override;
    393. 

  393.     procedure ParentResized; dynamic;
    394. 

  394.   public
    395. 

  395.     constructor Create(AOwner: TComponent); override;
    396. 

  396.     procedure ChangePosition(NewPosition: TSizeGripChangePosition);
    397. 

  397.     procedure UpdatePosition;
    398. 

  398.     procedure UpdateWindowRegion;
    399. 

  399.     property Position: TSizeGripPostion read FPosition write SetPosition default sgpBottomRight;
    400. 

  400.     property TriangleWindow: Boolean read FTriangleWindow write SetTriangleWindow default True;
    401. 

  401.     property Visible: Boolean read GetVisible write SetVisible;
    402. 

  402.     property OnParentResized: TNotifyEvent read FParentResized write FParentResized;
    403. 

  403.   end;
    404. 

  404. 

  405. const
    406. 

  406.   cm_SetSizeGripChangePosition = WM_USER + 100;
    407. 

  407. 

  408. { TPopupMonthCalendarEh }
    409. 

  409. 

  410. const
    411. 

  411.   CM_CLOSEUPEH = WM_USER + 101;
    412. 

  412. 

  413. type
    414. 

  414. 

  415.   TPopupMonthCalendarEh = class(TMonthCalendar)
    416. 

  416.   private
    417. 

  417.     FBorderWidth: Integer;
    418. 

  418.     procedure CMCloseUpEh(var Message: TMessage); message CM_CLOSEUPEH;
    419. 

  419.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    420. 

  420.     procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
    421. 

  421.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    422. 

  422.     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    423. 

  423.     procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    424. 

  424.     procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
    425. 

  425.   protected
    426. 

  426.     function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
    427. 

  427.     function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    428. 

  428.     function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    429. 

  429.     function MsgSetDateTime(Value: TSystemTime): Boolean; override;
    430. 

  430.     procedure CreateParams(var Params: TCreateParams); override;
    431. 

  431.     procedure CreateWnd; override;
    432. 

  432.     procedure DrawBorder; virtual;
    433. 

  433.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    434. 

  434.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    435. 

  435.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    436. 

  436.     procedure PostCloseUp(Accept: Boolean);
    437. 

  437.     procedure UpdateBorderWidth;
    438. 

  438.   public
    439. 

  439.     constructor Create(AOwner: TComponent); override;
    440. 

  440.     property Color;
    441. 

  441.     property Ctl3D;
    442. 

  442.   end;
    443. 

  443. 

  444.   TListGetImageIndexEventEh = procedure(Sender: TObject; ItemIndex: Integer; var ImageIndex: Integer) of object;
    445. 

  445. 

  446. { TPopupListboxEh }
    447. 

  447. 

  448.   TPopupListboxEh = class(TCustomListbox)
    449. 

  449.   private
    450. 

  450.     FBorderWidth: Integer;
    451. 

  451.     FImageList: TCustomImageList;
    452. 

  452.     FMousePos: TPoint;
    453. 

  453.     FRowCount: Integer;
    454. 

  454.     FSearchText: String;
    455. 

  455.     FSearchTickCount: Longint;
    456. 

  456.     FSizeGrip: TSizeGripEh;
    457. 

  457.     FSizeGripResized: Boolean;
    458. 

  458.     FOnGetImageIndex: TListGetImageIndexEventEh;
    459. 

  459.     FExtItems: TStrings;
    460. 

  460.     function CheckNewSize(var NewWidth, NewHeight: Integer): Boolean;
    461. 

  461.     function GetBorderSize: Integer;
    462. 

  462.     function GetExtItems: TStrings;
    463. 

  463.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    464. 

  464.     procedure CMSetSizeGripChangePosition(var Message: TMessage); message cm_SetSizeGripChangePosition;
    465. 

  465.     procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    466. 

  466.     procedure SetExtItems(Value: TStrings);
    467. 

  467.     procedure SetImageList(const Value: TCustomImageList);
    468. 

  468.     procedure SetRowCount(Value: Integer);
    469. 

  469.     procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    470. 

  470.     procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
    471. 

  471.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
    472. 

  472.     procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
    473. 

  473.   protected
    474. 

  474.     function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    475. 

  475.     function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    476. 

  476.     procedure CreateParams(var Params: TCreateParams); override;
    477. 

  477.     procedure CreateWnd; override;
    478. 

  478.     procedure DrawBorder; virtual;
    479. 

  479.     procedure DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); override;
    480. 

  480.     procedure KeyPress(var Key: Char); override;
    481. 

  481.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    482. 

  482.     procedure UpdateBorderWidth;
    483. 

  483.     procedure SelfOnGetData(Control: TWinControl; Index: Integer; var Data: string); virtual;
    484. 

  484.   public
    485. 

  485.     constructor Create(Owner: TComponent); override;
    486. 

  486.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    487. 

  487.     function CanFocus: Boolean; {$IFDEF EH_LIB_5} override; {$ENDIF}
    488. 

  488.     function GetTextHeight: Integer;
    489. 

  489.     property Color;
    490. 

  490.     property Ctl3D;
    491. 

  491.     property Font;
    492. 

  492.     property ImageList: TCustomImageList read FImageList write SetImageList;
    493. 

  493.     property IntegralHeight;
    494. 

  494.     property ItemHeight;
    495. 

  495.     property RowCount: Integer read FRowCount write SetRowCount;
    496. 

  496.     property ExtItems: TStrings read GetExtItems write SetExtItems;
    497. 

  497.     property SizeGrip: TSizeGripEh read FSizeGrip;
    498. 

  498.     property SizeGripResized: Boolean read FSizeGripResized write FSizeGripResized;
    499. 

  499.     property OnMouseUp;
    500. 

  500.     property OnGetImageIndex: TListGetImageIndexEventEh read FOnGetImageIndex write FOnGetImageIndex;
    501. 

  501.   end;
    502. 

  502. 

  503. { TMRUList }
    504. 

  504.   TFilterMRUItemEventEh = procedure (Sender: TObject; var Accept: Boolean) of object;
    505. 

  505.   TSetDropDownEventEh = procedure (Sender: TObject) of object;
    506. 

  506.   TSetCloseUpEventEh = procedure (Sender: TObject; Accept: Boolean) of object;
    507. 

  507. 

  508.   TMRUListEh = class(TPersistent)
    509. 

  509.   private
    510. 

  510.     FActive: Boolean;
    511. 

  511.     FAutoAdd: Boolean;
    512. 

  512.     FCaseSensitive: Boolean;
    513. 

  513.     FItems: TStrings;
    514. 

  514.     FLimit: Integer;
    515. 

  515.     FOnActiveChanged: TNotifyEvent;
    516. 

  516.     FOnFilterItem: TFilterMRUItemEventEh;
    517. 

  517.     FOnSetCloseUpEvent: TSetCloseUpEventEh;
    518. 

  518.     FOnSetDropDown: TSetDropDownEventEh;
    519. 

  519.     FOwner: TPersistent;
    520. 

  520.     FRows: Integer;
    521. 

  521.     FWidth: Integer;
    522. 

  522.     FCancelIfKeyInQueue: Boolean;
    523. 

  523.     procedure SetActive(const Value: Boolean);
    524. 

  524.     procedure SetItems(const Value: TStrings);
    525. 

  525.     procedure SetLimit(const Value: Integer);
    526. 

  526.     procedure SetRows(const Value: Integer);
    527. 

  527.   protected
    528. 

  528.     FDroppedDown: Boolean;
    529. 

  529.     procedure UpdateLimit;
    530. 

  530.   public
    531. 

  531.     constructor Create(AOwner: TPersistent);
    532. 

  532.     destructor Destroy; override;
    533. 

  533.     procedure Add(s: String);
    534. 

  534.     procedure Assign(Source: TPersistent); override;
    535. 

  535.     procedure CloseUp(Accept: Boolean); virtual;
    536. 

  536.     procedure DropDown; virtual;
    537. 

  537.     function FilterItemsTo(FilteredItems: TStrings; MaskText: String): Boolean;
    538. 

  538.     property DroppedDown: Boolean read FDroppedDown write FDroppedDown;
    539. 

  539.     property Width: Integer read FWidth write FWidth;
    540. 

  540.     property OnActiveChanged: TNotifyEvent read FOnActiveChanged write FOnActiveChanged;
    541. 

  541.     property OnSetCloseUp: TSetCloseUpEventEh read FOnSetCloseUpEvent write FOnSetCloseUpEvent;
    542. 

  542.     property OnSetDropDown: TSetDropDownEventEh read FOnSetDropDown write FOnSetDropDown;
    543. 

  543.     property OnFilterItem: TFilterMRUItemEventEh read FOnFilterItem write FOnFilterItem;
    544. 

  544.     property CancelIfKeyInQueue: Boolean read FCancelIfKeyInQueue write FCancelIfKeyInQueue default True;
    545. 

  545.   published
    546. 

  546.     property AutoAdd: Boolean read FAutoAdd write FAutoAdd default True;
    547. 

  547.     property Active: Boolean read FActive write SetActive default False;
    548. 

  548.     property CaseSensitive: Boolean read FCaseSensitive write FCaseSensitive default False;
    549. 

  549.     property Items: TStrings read FItems write SetItems;
    550. 

  550.     property Limit: Integer read FLimit write SetLimit default 100;
    551. 

  551.     property Rows: Integer read FRows write SetRows default 7;
    552. 

  552.   end;
    553. 

  553. 

  554. { TMRUListboxEh }
    555. 

  555. 

  556.   TMRUListboxEh = class(TPopupListboxEh)
    557. 

  557.   private
    558. 

  558.     FScrollBar: TScrollBar;
    559. 

  559.     FScrollBarLockMove: Boolean;
    560. 

  560.     procedure CMChanged(var Message: TCMChanged); message CM_CHANGED;
    561. 

  561.     procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL;
    562. 

  562.     procedure CMSetSizeGripChangePosition(var Message: TMessage); message cm_SetSizeGripChangePosition;
    563. 

  563.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
    564. 

  564.   protected
    565. 

  565.     procedure CreateParams(var Params: TCreateParams); override;
    566. 

  566.     procedure ScrollBarScrolled(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
    567. 

  567.     procedure ScrollBarWindowProc(var Message: TMessage);
    568. 

  568.   public
    569. 

  569.     constructor Create(Owner: TComponent); override;
    570. 

  570.     procedure UpdateScrollBar;
    571. 

  571.     procedure UpdateScrollBarPos;
    572. 

  572.     property ParentCtl3D;
    573. 

  573.     property ScrollBar: TScrollBar read FScrollBar;
    574. 

  574.     property Sorted;
    575. 

  575.     property OnMouseUp;
    576. 

  576.   end;
    577. 

  577. 

  578. {$IFNDEF EH_LIB_5} // Delphi 4 doesn't have TObjectList but Delphi 8 required
    579. 

  579. 

  580. { TObjectList class }
    581. 

  581. 

  582.   TObjectList = class(TList)
    583. 

  583.   private
    584. 

  584.     FOwnsObjects: Boolean;
    585. 

  585.   protected
    586. 

  586.     function GetItem(Index: Integer): TObject;
    587. 

  587.     procedure SetItem(Index: Integer; AObject: TObject);
    588. 

  588.   public
    589. 

  589.     constructor Create; overload;
    590. 

  590.     constructor Create(AOwnsObjects: Boolean); overload;
    591. 

  591. 

  592.     function Add(AObject: TObject): Integer;
    593. 

  593.     function Remove(AObject: TObject): Integer;
    594. 

  594.     function IndexOf(AObject: TObject): Integer;
    595. 

  595.     function FindInstanceOf(AClass: TClass; AExact: Boolean = True; AStartAt: Integer = 0): Integer;
    596. 

  596.     procedure Insert(Index: Integer; AObject: TObject);
    597. 

  597.     property OwnsObjects: Boolean read FOwnsObjects write FOwnsObjects;
    598. 

  598.     property Items[Index: Integer]: TObject read GetItem write SetItem; default;
    599. 

  599.   end;
    600. 

  600. 

  601. {$ENDIF}
    602. 

  602. 

  603. {$IFNDEF EH_LIB_5}
    604. 

  604.   TStringListSortCompare = function(List: TStringList; Index1, Index2: Integer): Integer;
    605. 

  605. {$ENDIF}
    606. 

  606. 

  607.    TStringListEh = class(TStringList)
    608. 

  608. {$IFNDEF EH_LIB_6}
    609. 

  609.   private
    610. 

  610.     FCaseSensitive: Boolean;
    611. 

  611.     function CompareStrings(const S1, S2: string): Integer;
    612. 

  612.     procedure SetCaseSensitive(const Value: Boolean);
    613. 

  613.   public
    614. 

  614. {$IFNDEF EH_LIB_5}
    615. 

  615.     procedure CustomSort(Compare: TStringListSortCompare);
    616. 

  616.     procedure QuickSort(L, R: Integer; SCompare: TStringListSortCompare);
    617. 

  617. {$ENDIF}
    618. 

  618.     procedure Sort; override;
    619. 

  619.     property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
    620. 

  620. {$ENDIF}
    621. 

  621.    end;
    622. 

  622. { TDataLinkEh }
    623. 

  623. 

  624. {$IFDEF CIL}
    625. 

  625.   TDataEventEh = procedure (Event: TDataEvent; Info: TObject) of object;
    626. 

  626. {$ELSE}
    627. 

  627.   TDataEventEh = procedure (Event: TDataEvent; Info: Longint) of object;
    628. 

  628. {$ENDIF}
    629. 

  629. 

  630.   TDataLinkEh = class(TDataLink)
    631. 

  631.   private
    632. 

  632.     FOnDataEvent: TDataEventEh;
    633. 

  633.   protected
    634. 

  634. {$IFDEF CIL}
    635. 

  635.     procedure DataEvent(Event: TDataEvent; Info: TObject); virtual;
    636. 

  636. {$ELSE}
    637. 

  637.     procedure DataEvent(Event: TDataEvent; Info: Integer); override;
    638. 

  638. {$ENDIF}
    639. 

  639.   public
    640. 

  640.     property OnDataEvent: TDataEventEh read FOnDataEvent write FOnDataEvent;
    641. 

  641.   end;
    642. 

  642. 

  643. { TDatasetFieldValueListEh }
    644. 

  644. 

  645.   TDatasetFieldValueListEh = class(TInterfacedObject, IMemTableDataFieldValueListEh)
    646. 

  646.   private
    647. 

  647.     FValues: TStringList;
    648. 

  648.     FDataObsoleted: Boolean;
    649. 

  649.     FFieldName: String;
    650. 

  650.     FDataLink: TDataLinkEh;
    651. 

  651.     FDataSource: TDataSource;
    652. 

  652.     function GetValues: TStrings;
    653. 

  653.     procedure SetFieldName(const Value: String);
    654. 

  654.     procedure SetDataSet(const Value: TDataSet);
    655. 

  655.     function GetDataSet: TDataSet;
    656. 

  656.   protected
    657. 

  657.     procedure RefreshValues;
    658. 

  658. {$IFDEF CIL}
    659. 

  659.     procedure DataSetEvent(Event: TDataEvent; Info: TObject); virtual;
    660. 

  660. {$ELSE}
    661. 

  661.     procedure DataSetEvent(Event: TDataEvent; Info: Integer); virtual;
    662. 

  662. {$ENDIF}
    663. 

  663.   public
    664. 

  664.     constructor Create;
    665. 

  665.     destructor Destroy; override;
    666. 

  666.     property FieldName: String read FFieldName write SetFieldName;
    667. 

  667.     property DataSet: TDataSet read GetDataSet write SetDataSet;
    668. 

  668.     property Values: TStrings read GetValues;
    669. 

  669.   end;
    670. 

  670. 

  671.   TLocateTextEventEh = function (Sender: TObject;
    672. 

  672.     const FieldName: string; const Text: String; Options: TLocateTextOptionsEh;
    673. 

  673.     Direction: TLocateTextDirectionEh; Matching: TLocateTextMatchingEh;
    674. 

  674.     TreeFindRange: TLocateTextTreeFindRangeEh): Boolean of object;
    675. 

  675. 

  676.   TDrawButtonControlStyleEh = (bcsDropDownEh, bcsEllipsisEh, bcsUpDownEh,
    677. 

  677.     bcsCheckboxEh, bcsPlusEh, bcsMinusEh);
    678. 

  678.   TTreeElementEh = (tehMinusUpDown, tehMinusUp, tehMinusDown,
    679. 

  679.                    tehPlusUpDown, tehPlusUp, tehPlusDown,
    680. 

  680.                    tehCrossUpDown, tehCrossUp, tehCrossDown,
    681. 

  681.                    tehVLine);
    682. 

  682. 

  683. 

  684. procedure PaintButtonControlEh(DC: HDC; ARect: TRect; ParentColor: TColor;
    685. 

  685.   Style: TDrawButtonControlStyleEh; DownButton: Integer;
    686. 

  686.   Flat, Active, Enabled: Boolean; State: TCheckBoxState);
    687. 

  687. 

  688. function GetDefaultFlatButtonWidth: Integer;
    689. 

  689. 

  690. var
    691. 

  691.   FlatButtonWidth: Integer;
    692. 

  692. 

  693. type
    694. 

  694.  TFieldTypes = set of TFieldType;
    695. 

  695. 

  696. const
    697. 

  697.   ftNumberFieldTypes: TFieldTypes = [ftSmallint, ftInteger, ftWord, ftFloat, ftCurrency,
    698. 

  698.     ftBCD{$IFDEF EH_LIB_6}, ftFMTBcd{$ENDIF}];
    699. 

  699. 

  700. procedure GetFieldsProperty(List: TList; DataSet: TDataSet;
    701. 

  701.   Control: TComponent; const FieldNames: String); overload;
    702. 

  702. 

  703. function GetFieldsProperty(DataSet: TDataSet; Control: TComponent;
    704. 

  704.   const FieldNames: String): TFieldsArrEh; overload;
    705. 

  705. 

  706. procedure DataSetSetFieldValues(DataSet: TDataSet; Fields: String; Value: Variant);
    707. 

  707. 

  708. function VarEquals(const V1, V2: Variant): Boolean;
    709. 

  709. 

  710. {$IFNDEF EH_LIB_6}
    711. 

  711. type
    712. 

  712.   TVariantRelationship = (vrEqual, vrLessThan, vrGreaterThan, vrNotEqual);
    713. 

  713. {$ENDIF}
    714. 

  714. 

  715. function DBVarCompareValue(const A, B: Variant): TVariantRelationship;
    716. 

  716. 

  717. var UseButtonsBitmapCache: Boolean = True;
    718. 

  718. 

  719. procedure ClearButtonsBitmapCache;
    720. 

  720. 

  721. procedure DrawImage(DC: HDC; ARect: TRect; Images: TCustomImageList;
    722. 

  722.   ImageIndex: Integer; Selected: Boolean);
    723. 

  723. procedure DrawTreeElement(Canvas: TCanvas; ARect: TRect;
    724. 

  724.   TreeElement: TTreeElementEh; BackDot: Boolean; ScaleX, ScaleY: Double;
    725. 

  725.   RightToLeft: Boolean);
    726. 

  726. 

  727. function AlignDropDownWindowRect(MasterAbsRect: TRect; DropDownWin: TWinControl; Align: TDropDownAlign): TPoint;
    728. 

  728. function AlignDropDownWindow(MasterWin, DropDownWin: TWinControl; Align: TDropDownAlign): TPoint;
    729. 

  729. 

  730. {$IFNDEF EH_LIB_5}
    731. 

  731. function Supports(const Instance: IUnknown; const IID: TGUID; out Intf): Boolean; overload;
    732. 

  732. function Supports(const Instance: TObject; const IID: TGUID; out Intf): Boolean; overload;
    733. 

  733. {$ENDIF}
    734. 

  734. 

  735. var
    736. 

  736.   DefaultCheckBoxWidth, DefaultCheckBoxHeight: Integer;
    737. 

  737. 

  738. function AdjustCheckBoxRect(ClientRect: TRect;  Alignment: TAlignment; Layout: TTextLayout): TRect;
    739. 

  739. 

  740. function IsDoubleClickMessage(OldPos, NewPos: TPoint; Interval: Longint): Boolean;
    741. 

  741. function DefaultEditButtonHeight(EditButtonWidth: Integer; Flat: Boolean): Integer;
    742. 

  742. 

  743. function KillMouseUp(Control: TControl): Boolean; overload;
    744. 

  744. function KillMouseUp(Control: TControl; Area: TRect): Boolean; overload;
    745. 

  745. 

  746. implementation
    747. 

  747. 

  748. uses DBConsts, Math,
    749. 

  749.   {$IFDEF EH_LIB_6} VDBConsts, Types, {$ENDIF}
    750. 

  750.   {$IFDEF EH_LIB_7} Themes, UxTheme, {$ENDIF}
    751. 

  751.   MultiMon;
    752. 

  752. 

  753. type
    754. 

  754.   TWinControlCracker = class(TWinControl) end;
    755. 

  755.   TControlCracker = class(TControl) end;
    756. 

  756. 

  757. {$IFNDEF EH_LIB_5}
    758. 

  758. 

  759. function Supports(const Instance: IUnknown; const IID: TGUID; out Intf): Boolean; overload;
    760. 

  760. begin
    761. 

  761.   Result := (Instance <> nil) and (Instance.QueryInterface(IID, Intf) = 0);
    762. 

  762. end;
    763. 

  763. 

  764. function Supports(const Instance: TObject; const IID: TGUID; out Intf): Boolean; overload;
    765. 

  765. var
    766. 

  766.   LUnknown: IUnknown;
    767. 

  767. begin
    768. 

  768.   Result := (Instance <> nil) and
    769. 

  769.     ((Instance.GetInterface(IUnknown, LUnknown) and Supports(LUnknown, IID, Intf)) or
    770. 

  770.     Instance.GetInterface(IID, Intf));
    771. 

  771. end;
    772. 

  772. 

  773. {$ENDIF}
    774. 

  774. 

  775. function IsDoubleClickMessage(OldPos, NewPos: TPoint; Interval: Longint): Boolean;
    776. 

  776. begin
    777. 

  777.   Result := (Interval <= Longint(GetDoubleClickTime)) and
    778. 

  778.             (Abs(OldPos.X - NewPos.X) <= GetSystemMetrics(SM_CXDOUBLECLK)) and
    779. 

  779.             (Abs(OldPos.Y - NewPos.Y) <= GetSystemMetrics(SM_CYDOUBLECLK));
    780. 

  780. end;
    781. 

  781. 

  782. procedure GetCheckSize;
    783. 

  783. begin
    784. 

  784.   with TBitmap.Create do
    785. 

  785.     try
    786. 

  786.       Handle := LoadBitmapEh(0, OBM_CHECKBOXES);
    787. 

  787.       DefaultCheckBoxWidth := Width div 4;
    788. 

  788.       DefaultCheckBoxHeight := Height div 3;
    789. 

  789.     finally
    790. 

  790.       Free;
    791. 

  791.     end;
    792. 

  792. end;
    793. 

  793. 

  794. function AdjustCheckBoxRect(ClientRect: TRect;  Alignment: TAlignment; Layout: TTextLayout): TRect;
    795. 

  795. var
    796. 

  796.   CheckWidth, CheckHeight: Integer;
    797. 

  797. begin
    798. 

  798.   if (ClientRect.Right - ClientRect.Left) > DefaultCheckBoxWidth
    799. 

  799.     then CheckWidth := DefaultCheckBoxWidth
    800. 

  800.     else CheckWidth := ClientRect.Right - ClientRect.Left;
    801. 

  801. 

  802.   if (ClientRect.Bottom - ClientRect.Top) > DefaultCheckBoxHeight
    803. 

  803.     then CheckHeight := DefaultCheckBoxHeight
    804. 

  804.     else CheckHeight := ClientRect.Bottom - ClientRect.Top;
    805. 

  805. 

  806. 

  807.   Result := ClientRect;
    808. 

  808. 

  809.   if (ClientRect.Right - ClientRect.Left) > DefaultCheckBoxWidth then
    810. 

  810.     case Alignment of
    811. 

  811.       taRightJustify: Result.Left := Result.Right - CheckWidth;
    812. 

  812.       taCenter: Result.Left := Result.Left + (ClientRect.Right - ClientRect.Left) shr 1 - CheckWidth shr 1;
    813. 

  813.     end;
    814. 

  814.   Result.Right := Result.Left + CheckWidth;
    815. 

  815. 

  816.   if (ClientRect.Bottom - ClientRect.Top) > DefaultCheckBoxHeight then
    817. 

  817.     case Layout of
    818. 

  818.       tlBottom: Result.Top := Result.Bottom - CheckWidth;
    819. 

  819.       tlCenter: Result.Top := Result.Top + (ClientRect.Bottom - ClientRect.Top) shr 1 - CheckHeight shr 1;
    820. 

  820.     end;
    821. 

  821.   Result.Bottom := Result.Top + CheckHeight;
    822. 

  822. end;
    823. 

  823. 

  824. procedure DrawCheck(DC: HDC; R: TRect; AState: TCheckBoxState; AEnabled, AFlat, ADown, AActive: Boolean);
    825. 

  825. var
    826. 

  826.   DrawState, oldRgn: Integer;
    827. 

  827.   DrawRect: TRect;
    828. 

  828. //  OldBrushColor: TColor;
    829. 

  829. //  OldBrushStyle: TBrushStyle;
    830. 

  830. //  OldPenColor: TColor;
    831. 

  831.   Rgn, SaveRgn: HRgn;
    832. 

  832. {$IFDEF EH_LIB_7}
    833. 

  833.   ElementDetails: TThemedElementDetails;
    834. 

  834. {$ENDIF}
    835. 

  835. //  Brush,SaveBrush: HBRUSH;
    836. 

  836. begin
    837. 

  837.   SaveRgn := 0;
    838. 

  838.   oldRgn := 0;
    839. 

  839.   DrawRect := R;
    840. 

  840.   with DrawRect do
    841. 

  841.     if (Right - Left) > (Bottom - Top) then
    842. 

  842.     begin
    843. 

  843.       Left := Left + ((Right - Left) - (Bottom - Top)) div 2;
    844. 

  844.       Right := Left + (Bottom - Top);
    845. 

  845.     end else if (Right - Left) < (Bottom - Top) then
    846. 

  846.     begin
    847. 

  847.       Top := Top + ((Bottom - Top) - (Right - Left)) div 2;
    848. 

  848.       Bottom := Top + (Right - Left);
    849. 

  849.     end;
    850. 

  850.   case AState of
    851. 

  851.     cbChecked:
    852. 

  852.       DrawState := DFCS_BUTTONCHECK or DFCS_CHECKED;
    853. 

  853.     cbUnchecked:
    854. 

  854.       DrawState := DFCS_BUTTONCHECK;
    855. 

  855.   else // cbGrayed
    856. 

  856.     DrawState := DFCS_BUTTON3STATE or DFCS_CHECKED;
    857. 

  857.   end;
    858. 

  858.   if not AEnabled then
    859. 

  859.     DrawState := DrawState or DFCS_INACTIVE;
    860. 

  860.   if ADown then
    861. 

  861.     DrawState := DrawState or DFCS_PUSHED;
    862. 

  862. //  with Canvas do
    863. 

  863. //  begin
    864. 

  864.   if AFlat then
    865. 

  865.   begin
    866. 

  866.       { Remember current clipping region }
    867. 

  867.     SaveRgn := CreateRectRgn(0, 0, 0, 0);
    868. 

  868.     oldRgn := GetClipRgn(DC, SaveRgn);
    869. 

  869.       { Clip 3d-style checkbox to prevent flicker }
    870. 

  870.     with DrawRect do
    871. 

  871.       Rgn := CreateRectRgn(Left + 1, Top + 1, Right - 1, Bottom - 1);
    872. 

  872.     SelectClipRgn(DC, Rgn);
    873. 

  873.     DeleteObject(Rgn);
    874. 

  874.   end;
    875. 

  875.   if AFlat then InflateRect(DrawRect, 1, 1);
    876. 

  876. 

  877. {$IFDEF EH_LIB_7}
    878. 

  878.   if ThemeServices.ThemesEnabled then
    879. 

  879.   begin
    880. 

  880.     case AState of
    881. 

  881.       cbChecked:
    882. 

  882.         if AEnabled then
    883. 

  883.           ElementDetails := ThemeServices.GetElementDetails(tbCheckBoxCheckedNormal)
    884. 

  884.         else
    885. 

  885.           ElementDetails := ThemeServices.GetElementDetails(tbCheckBoxCheckedDisabled);
    886. 

  886.       cbUnchecked:
    887. 

  887.         if AEnabled then
    888. 

  888.           ElementDetails := ThemeServices.GetElementDetails(tbCheckBoxUncheckedNormal)
    889. 

  889.         else
    890. 

  890.           ElementDetails := ThemeServices.GetElementDetails(tbCheckBoxUncheckedDisabled)
    891. 

  891.       else // cbGrayed
    892. 

  892.         if AEnabled then
    893. 

  893.           ElementDetails := ThemeServices.GetElementDetails(tbCheckBoxMixedNormal)
    894. 

  894.         else
    895. 

  895.           ElementDetails := ThemeServices.GetElementDetails(tbCheckBoxMixedDisabled);
    896. 

  896.     end;
    897. 

  897.     ThemeServices.DrawElement(DC, ElementDetails, R);
    898. 

  898.   end
    899. 

  899.   else
    900. 

  900. {$ENDIF}
    901. 

  901.     DrawFrameControl(DC, DrawRect, DFC_BUTTON, DrawState);
    902. 

  902. 

  903.   if AFlat then
    904. 

  904.   begin
    905. 

  905.       //SelectClipRgn(Handle, SaveRgn);
    906. 

  906.     if oldRgn = 0 then
    907. 

  907.       SelectClipRgn(DC, 0)
    908. 

  908.     else
    909. 

  909.       SelectClipRgn(DC, SaveRgn);
    910. 

  910.     DeleteObject(SaveRgn);
    911. 

  911.       { Draw flat rectangle in-place of clipped 3d checkbox above }
    912. 

  912.     InflateRect(DrawRect, -1, -1);
    913. 

  913.     if AActive
    914. 

  914.       then FrameRect(DC, DrawRect, GetSysColorBrush(COLOR_BTNFACE))
    915. 

  915.       else FrameRect(DC, DrawRect, GetSysColorBrush(COLOR_BTNSHADOW));
    916. 

  916. 

  917.     { Caller drow in flat mode
    918. 

  918.     InflateRect(DrawRect, 1, 1);
    919. 

  919.     if AActive
    920. 

  920.       then DrawEdge(DC, DrawRect, BDR_SUNKENOUTER, BF_RECT)
    921. 

  921.       else FrameRect(DC, DrawRect, GetCurrentObject(DC, OBJ_BRUSH));}
    922. 

  922.   end;
    923. 

  923. //  end;
    924. 

  924. end;
    925. 

  925. 

  926. const
    927. 

  927.   DownFlags: array[Boolean] of Integer = (0, DFCS_PUSHED {? or DFCS_FLAT});
    928. 

  928.   FlatFlags: array[Boolean] of Integer = (0, DFCS_FLAT);
    929. 

  929.   EnabledFlags: array[Boolean] of Integer = (DFCS_INACTIVE, 0);
    930. 

  930.   IsDownFlags: array[Boolean] of Integer = (DFCS_SCROLLUP, DFCS_SCROLLDOWN);
    931. 

  931.   PressedFlags: array[Boolean] of Integer = (EDGE_RAISED, EDGE_SUNKEN);
    932. 

  932. 

  933. procedure DrawEllipsisButton(DC: HDC; ARect: TRect; Enabled, Active, Flat, Pressed: Boolean);
    934. 

  934. var
    935. 

  935.   InterP, PWid, W, H: Integer;
    936. 

  936.   ElRect: TRect;
    937. 

  937.   Brush, SaveBrush: HBRUSH;
    938. 

  938. {$IFDEF EH_LIB_7}
    939. 

  939.   Button: TThemedButton;
    940. 

  940.   ToolButton: TThemedToolBar;
    941. 

  941.   Details: TThemedElementDetails;
    942. 

  942. {$ENDIF}
    943. 

  943. begin
    944. 

  944.   ElRect := ARect;
    945. 

  945. 

  946. {$IFDEF EH_LIB_7}
    947. 

  947.   if ThemeServices.ThemesEnabled then
    948. 

  948.   begin
    949. 

  949.     if not Enabled then
    950. 

  950.       Button := tbPushButtonDisabled
    951. 

  951.     else
    952. 

  952.       if Pressed then
    953. 

  953.         Button := tbPushButtonPressed
    954. 

  954.       else
    955. 

  955.         if Active
    956. 

  956.           then Button := tbPushButtonHot
    957. 

  957.           else Button := tbPushButtonNormal;
    958. 

  958. 

  959.     ToolButton := ttbToolbarDontCare;
    960. 

  960.     if Flat then
    961. 

  961.     begin
    962. 

  962.       case Button of
    963. 

  963.         tbPushButtonDisabled:
    964. 

  964.           Toolbutton := ttbButtonDisabled;
    965. 

  965.         tbPushButtonPressed:
    966. 

  966.           Toolbutton := ttbButtonPressed;
    967. 

  967.         tbPushButtonHot:
    968. 

  968.           Toolbutton := ttbButtonHot;
    969. 

  969.         tbPushButtonNormal:
    970. 

  970.           Toolbutton := ttbButtonNormal;
    971. 

  971.       end;
    972. 

  972.     end;
    973. 

  973. 

  974.     if ToolButton = ttbToolbarDontCare then
    975. 

  975.     begin
    976. 

  976.       Details := ThemeServices.GetElementDetails(Button);
    977. 

  977.       ThemeServices.DrawElement(DC, Details, ARect);
    978. 

  978. 

  979. //      ARect := ThemeServices.ContentRect(DC, Details, ARect);
    980. 

  980.       InflateRect(ElRect, -2, -2);
    981. 

  981.     end else
    982. 

  982.     begin
    983. 

  983.       Details := ThemeServices.GetElementDetails(ToolButton);
    984. 

  984.       ThemeServices.DrawElement(DC, Details, ARect);
    985. 

  985.       InflateRect(ElRect, -1, -1)
    986. 

  986. //      ARect := ThemeServices.ContentRect(DC, Details, ARect);
    987. 

  987.     end;
    988. 

  988.   end else
    989. 

  989. {$ENDIF}
    990. 

  990.   begin
    991. 

  991.     Brush := GetSysColorBrush(COLOR_BTNFACE);
    992. 

  992.     if Flat then
    993. 

  993.     begin
    994. 

  994.       Windows.FillRect(DC, ElRect, Brush);
    995. 

  995.       InflateRect(ElRect, -1, -1)
    996. 

  996.     end else
    997. 

  997.     begin
    998. 

  998.       DrawEdge(DC, ElRect, PressedFlags[Pressed], BF_RECT or BF_MIDDLE);
    999. 

  999.       InflateRect(ElRect, -2, -2);
    1000. 

  1000.       //Windows.FillRect(DC, ElRect, Brush);
    1001. 

  1001.     end;
    1002. 

  1002.   end;
    1003. 

  1003. 

  1004.   InterP := 2;
    1005. 

  1005.   PWid := 2;
    1006. 

  1006.   W := ElRect.Right - ElRect.Left; //+ Ord(not Active and Flat);
    1007. 

  1007.   if W < 12 then InterP := 1;
    1008. 

  1008.   if W < 8 then PWid := 1;
    1009. 

  1009.   W := ElRect.Left + W div 2 - PWid div 2 + Ord(Pressed); //- Ord(not Active and Flat);
    1010. 

  1010.   H := ElRect.Top + (ElRect.Bottom - ElRect.Top) div 2 - PWid div 2 + Ord(Pressed);
    1011. 

  1011. 

  1012.   if not Enabled then
    1013. 

  1013.   begin
    1014. 

  1014.     Inc(W); Inc(H);
    1015. 

  1015.     Brush := GetSysColorBrush(COLOR_BTNHILIGHT);
    1016. 

  1016.     SaveBrush := SelectObject(DC, Brush);
    1017. 

  1017.     PatBlt(DC, W, H, PWid, PWid, PATCOPY);
    1018. 

  1018.     PatBlt(DC, W - InterP - PWid, H, PWid, PWid, PATCOPY);
    1019. 

  1019.     PatBlt(DC, W + InterP + PWid, H, PWid, PWid, PATCOPY);
    1020. 

  1020.     Dec(W); Dec(H);
    1021. 

  1021.     SelectObject(DC, SaveBrush);
    1022. 

  1022.     Brush := GetSysColorBrush(COLOR_BTNSHADOW);
    1023. 

  1023.   end else
    1024. 

  1024.     Brush := GetSysColorBrush(COLOR_BTNTEXT);
    1025. 

  1025. 

  1026.   SaveBrush := SelectObject(DC, Brush);
    1027. 

  1027.   PatBlt(DC, W, H, PWid, PWid, PATCOPY);
    1028. 

  1028.   PatBlt(DC, W - InterP - PWid, H, PWid, PWid, PATCOPY);
    1029. 

  1029.   PatBlt(DC, W + InterP + PWid, H, PWid, PWid, PATCOPY);
    1030. 

  1030.   SelectObject(DC, SaveBrush);
    1031. 

  1031. end;
    1032. 

  1032. 

  1033. procedure DrawPlusMinusButton(DC: HDC; ARect: TRect; Enabled, Active, Flat, Pressed, Plus: Boolean);
    1034. 

  1034. var PWid, PHet, W, H, PlusInd, MinWH: Integer;
    1035. 

  1035.   ElRect: TRect;
    1036. 

  1036.   Brush, SaveBrush: HBRUSH;
    1037. 

  1037. {$IFDEF EH_LIB_7}
    1038. 

  1038.   Button: TThemedButton;
    1039. 

  1039.   ToolButton: TThemedToolBar;
    1040. 

  1040.   Details: TThemedElementDetails;
    1041. 

  1041. {$ENDIF}
    1042. 

  1042. begin
    1043. 

  1043.   ElRect := ARect;
    1044. 

  1044. 

  1045. {$IFDEF EH_LIB_7}
    1046. 

  1046.   if ThemeServices.ThemesEnabled then
    1047. 

  1047.   begin
    1048. 

  1048.     if not Enabled then
    1049. 

  1049.       Button := tbPushButtonDisabled
    1050. 

  1050.     else
    1051. 

  1051.       if Pressed then
    1052. 

  1052.         Button := tbPushButtonPressed
    1053. 

  1053.       else
    1054. 

  1054.         if Active
    1055. 

  1055.           then Button := tbPushButtonHot
    1056. 

  1056.           else Button := tbPushButtonNormal;
    1057. 

  1057. 

  1058.     ToolButton := ttbToolbarDontCare;
    1059. 

  1059.     if Flat then
    1060. 

  1060.     begin
    1061. 

  1061.       case Button of
    1062. 

  1062.         tbPushButtonDisabled:
    1063. 

  1063.           Toolbutton := ttbButtonDisabled;
    1064. 

  1064.         tbPushButtonPressed:
    1065. 

  1065.           Toolbutton := ttbButtonPressed;
    1066. 

  1066.         tbPushButtonHot:
    1067. 

  1067.           Toolbutton := ttbButtonHot;
    1068. 

  1068.         tbPushButtonNormal:
    1069. 

  1069.           Toolbutton := ttbButtonNormal;
    1070. 

  1070.       end;
    1071. 

  1071.     end;
    1072. 

  1072. 

  1073.     if ToolButton = ttbToolbarDontCare then
    1074. 

  1074.     begin
    1075. 

  1075.       Details := ThemeServices.GetElementDetails(Button);
    1076. 

  1076.       ThemeServices.DrawElement(DC, Details, ARect);
    1077. 

  1077. //      ARect := ThemeServices.ContentRect(DC, Details, ARect);
    1078. 

  1078.       InflateRect(ElRect, -2, -2);
    1079. 

  1079.     end else
    1080. 

  1080.     begin
    1081. 

  1081.       Details := ThemeServices.GetElementDetails(ToolButton);
    1082. 

  1082.       ThemeServices.DrawElement(DC, Details, ARect);
    1083. 

  1083.       InflateRect(ElRect, -1, -1)
    1084. 

  1084. //      ARect := ThemeServices.ContentRect(DC, Details, ARect);
    1085. 

  1085.     end;
    1086. 

  1086.   end else
    1087. 

  1087. {$ENDIF}
    1088. 

  1088.   begin
    1089. 

  1089.     Brush := GetSysColorBrush(COLOR_BTNFACE);
    1090. 

  1090.     if Flat then
    1091. 

  1091.     begin
    1092. 

  1092.       Windows.FillRect(DC, ElRect, Brush);
    1093. 

  1093.       InflateRect(ElRect, -1, -1)
    1094. 

  1094.     end else
    1095. 

  1095.     begin
    1096. 

  1096.       DrawEdge(DC, ElRect, PressedFlags[Pressed], BF_RECT or BF_MIDDLE);
    1097. 

  1097.       InflateRect(ElRect, -2, -2);
    1098. 

  1098.       Windows.FillRect(DC, ElRect, Brush);
    1099. 

  1099.     end;
    1100. 

  1100.   end;
    1101. 

  1101. 

  1102.   MinWH := ElRect.Right - ElRect.Left; //+ Ord(not Active and Flat);
    1103. 

  1103.   if ElRect.Bottom - ElRect.Top < MinWH then
    1104. 

  1104.     MinWH := ElRect.Bottom - ElRect.Top;
    1105. 

  1105.   PWid := MinWH * 4 div 7;
    1106. 

  1106.   if PWid = 0 then PWid := 1;
    1107. 

  1107.   PHet := PWid div 3;
    1108. 

  1108.   if PHet = 0 then PHet := 1;
    1109. 

  1109.   if Flat then Dec(PWid);
    1110. 

  1110.   if PWid mod 2 <> MinWH mod 2 then Inc(PWid);
    1111. 

  1111.   if Plus and (PWid mod 2 <> PHet mod 2) then
    1112. 

  1112.     if (MinWH < 12) then Inc(PWid) else Dec(PWid);
    1113. 

  1113.   PlusInd := PWid div 2 - PHet div 2;
    1114. 

  1114. 

  1115.   W := ElRect.Left + (ElRect.Right - ElRect.Left - PWid) div 2; //- Ord(not Active and Flat);
    1116. 

  1116.   //if W * 2 + PWid > (ElRect.Right - ElRect.Left) then Dec(W);
    1117. 

  1117.   Inc(W, Ord(Pressed));
    1118. 

  1118.   H := ElRect.Top + (ElRect.Bottom - ElRect.Top - PHet) div 2 + Ord(Pressed);
    1119. 

  1119. 

  1120.   if not Enabled then
    1121. 

  1121.   begin
    1122. 

  1122.     Inc(W); Inc(H);
    1123. 

  1123.     Brush := GetSysColorBrush(COLOR_BTNHILIGHT);
    1124. 

  1124.     SaveBrush := SelectObject(DC, Brush);
    1125. 

  1125.     PatBlt(DC, W, H, PWid, PHet, PATCOPY);
    1126. 

  1126.     if Plus then PatBlt(DC, W + PlusInd, H - PlusInd, PHet, PWid, PATCOPY);
    1127. 

  1127.     Dec(W); Dec(H);
    1128. 

  1128.     SelectObject(DC, SaveBrush);
    1129. 

  1129.     Brush := GetSysColorBrush(COLOR_BTNSHADOW);
    1130. 

  1130.   end else
    1131. 

  1131.     Brush := GetSysColorBrush(COLOR_BTNTEXT);
    1132. 

  1132. 

  1133.   SaveBrush := SelectObject(DC, Brush);
    1134. 

  1134.   PatBlt(DC, W, H, PWid, PHet, PATCOPY);
    1135. 

  1135.   if Plus then PatBlt(DC, W + PlusInd, H - PlusInd, PHet, PWid, PATCOPY);
    1136. 

  1136.   SelectObject(DC, SaveBrush);
    1137. 

  1137. end;
    1138. 

  1138. 

  1139. procedure DrawDropDownButton(DC: HDC; ARect: TRect; Enabled, Flat, Active, Down: Boolean);
    1140. 

  1140. var
    1141. 

  1141.   Flags: Integer;
    1142. 

  1142. {$IFDEF EH_LIB_7}
    1143. 

  1143.   Details: TThemedElementDetails;
    1144. 

  1144. {$ENDIF}
    1145. 

  1145. //  Rgn, SaveRgn: HRGN;
    1146. 

  1146. //  r: Integer;
    1147. 

  1147. //  IsClip: Boolean;
    1148. 

  1148. begin
    1149. 

  1149. {$IFDEF EH_LIB_7}
    1150. 

  1150.   if ThemeServices.ThemesEnabled then
    1151. 

  1151.   begin
    1152. 

  1152.     if not Enabled then
    1153. 

  1153.       Details := ThemeServices.GetElementDetails(tcDropDownButtonDisabled)
    1154. 

  1154.     else
    1155. 

  1155.       if Down then
    1156. 

  1156.         Details := ThemeServices.GetElementDetails(tcDropDownButtonPressed)
    1157. 

  1157.       else
    1158. 

  1158.         if Active
    1159. 

  1159.           then Details := ThemeServices.GetElementDetails(tcDropDownButtonHot)
    1160. 

  1160.           else Details := ThemeServices.GetElementDetails(tcDropDownButtonNormal);
    1161. 

  1161. 

  1162. {      with Details do
    1163. 

  1163.         GetThemeBackgroundRegion(ThemeServices.Theme[Element], DC, Part, State, ARect, Rgn);
    1164. 

  1164.       IsClip := False;
    1165. 

  1165.       SaveRgn := 0;
    1166. 

  1166.       r := 0;
    1167. 

  1167.       if Rgn <> 0 then
    1168. 

  1168.       begin
    1169. 

  1169.         IsClip := True;
    1170. 

  1170.         SaveRgn := CreateRectRgn(0, 0, 0, 0);
    1171. 

  1171.         r := GetClipRgn(DC, SaveRgn);
    1172. 

  1172.         SelectClipRgn(DC, Rgn);
    1173. 

  1173.         DeleteObject(Rgn);
    1174. 

  1174.       end;}
    1175. 

  1175. 

  1176.     ThemeServices.DrawElement(DC, Details, ARect);
    1177. 

  1177. 

  1178. {      if IsClip = True then
    1179. 

  1179.       begin
    1180. 

  1180.         if r = 0
    1181. 

  1181.           then SelectClipRgn(DC, 0)
    1182. 

  1182.           else SelectClipRgn(DC, SaveRgn);
    1183. 

  1183.         DeleteObject(SaveRgn);
    1184. 

  1184.       end;}
    1185. 

  1185. 

  1186.   end else
    1187. 

  1187. {$ENDIF}
    1188. 

  1188.   begin
    1189. 

  1189.     Flags := DownFlags[Down] or FlatFlags[Flat] or EnabledFlags[Enabled];
    1190. 

  1190.     DrawFrameControl(DC, ARect, DFC_SCROLL, Flags or DFCS_SCROLLCOMBOBOX);
    1191. 

  1191.   end;
    1192. 

  1192. end;
    1193. 

  1193. 

  1194. procedure DrawUpDownButton(DC: HDC; ARect: TRect; Enabled, Flat, Active, Down, DownDirection: Boolean);
    1195. 

  1195. var
    1196. 

  1196.   Flags: Integer;
    1197. 

  1197. {$IFDEF EH_LIB_7}
    1198. 

  1198.   Details: TThemedElementDetails;
    1199. 

  1199. {$ENDIF}
    1200. 

  1200. begin
    1201. 

  1201. {$IFDEF EH_LIB_7}
    1202. 

  1202.   if ThemeServices.ThemesEnabled then
    1203. 

  1203.   begin
    1204. 

  1204.     if DownDirection then
    1205. 

  1205.       if not Enabled then
    1206. 

  1206.         Details := ThemeServices.GetElementDetails(tsDownDisabled)
    1207. 

  1207.       else
    1208. 

  1208.         if Down then
    1209. 

  1209.           Details := ThemeServices.GetElementDetails(tsDownPressed)
    1210. 

  1210.         else
    1211. 

  1211.           if Active
    1212. 

  1212.             then Details := ThemeServices.GetElementDetails(tsDownHot)
    1213. 

  1213.             else Details := ThemeServices.GetElementDetails(tsDownNormal)
    1214. 

  1214.     else
    1215. 

  1215.       if not Enabled then
    1216. 

  1216.         Details := ThemeServices.GetElementDetails(tsUpDisabled)
    1217. 

  1217.       else
    1218. 

  1218.         if Down then
    1219. 

  1219.           Details := ThemeServices.GetElementDetails(tsUpPressed)
    1220. 

  1220.         else
    1221. 

  1221.           if Active
    1222. 

  1222.             then Details := ThemeServices.GetElementDetails(tsUpHot)
    1223. 

  1223.             else Details := ThemeServices.GetElementDetails(tsUpNormal);
    1224. 

  1224.     ThemeServices.DrawElement(DC, Details, ARect);
    1225. 

  1225.   end else
    1226. 

  1226. {$ENDIF}
    1227. 

  1227.   begin
    1228. 

  1228.     Flags := DownFlags[Down] or FlatFlags[Flat] or EnabledFlags[Enabled];
    1229. 

  1229.     DrawFrameControl(DC, ARect, DFC_SCROLL, Flags or IsDownFlags[DownDirection]);
    1230. 

  1230.   end;
    1231. 

  1231. end;
    1232. 

  1232. 

  1233. procedure DrawOneButton(DC: HDC; Style: TDrawButtonControlStyleEh;
    1234. 

  1234.   ARect: TRect; Enabled, Flat, Active, Down, DownDirection: Boolean);
    1235. 

  1235. var
    1236. 

  1236.   Rgn, SaveRgn: HRgn;
    1237. 

  1237.   r: Integer;
    1238. 

  1238.   IsClipRgn: Boolean;
    1239. 

  1239.   DRect: TRect;
    1240. 

  1240. //    Brush: HBRUSH;
    1241. 

  1241. begin
    1242. 

  1242.   DRect := ARect;
    1243. 

  1243. //  LPtoDP(DC, DRect, 2);
    1244. 

  1244.   WindowsLPtoDP(DC, DRect);
    1245. 

  1245. 

  1246. {$IFDEF EH_LIB_7}
    1247. 

  1247.   IsClipRgn := Flat and Active and not ThemeServices.ThemesEnabled;
    1248. 

  1248. {$ELSE}
    1249. 

  1249.   IsClipRgn := Flat and Active;
    1250. 

  1250. {$ENDIF}
    1251. 

  1251.   r := 0; SaveRgn := 0;
    1252. 

  1252.   if IsClipRgn then
    1253. 

  1253.   begin
    1254. 

  1254.     SaveRgn := CreateRectRgn(0, 0, 0, 0);
    1255. 

  1255.     r := GetClipRgn(DC, SaveRgn);
    1256. 

  1256.     with DRect do
    1257. 

  1257.       Rgn := CreateRectRgn(Left + 1, Top + 1, Right - 1, Bottom - 1);
    1258. 

  1258.     SelectClipRgn(DC, Rgn);
    1259. 

  1259.     DeleteObject(Rgn);
    1260. 

  1260.   end;
    1261. 

  1261. 

  1262.   if Flat {$IFDEF EH_LIB_7} and not ThemeServices.ThemesEnabled {$ENDIF} then
    1263. 

  1263.     if not Active {and not (Style=bcsUpDownEh)}
    1264. 

  1264.       then InflateRect(ARect, 2, 2)
    1265. 

  1265.       else InflateRect(ARect, 1, 1);
    1266. 

  1266.   case Style of
    1267. 

  1267.     bcsDropDownEh: DrawDropDownButton(DC, ARect, Enabled, Flat, Active, Down);
    1268. 

  1268.     bcsEllipsisEh: DrawEllipsisButton(DC, ARect, Enabled, Active, Flat, Down);
    1269. 

  1269.     bcsUpDownEh: DrawUpDownButton(DC, ARect, Enabled, Flat, Active, Down, DownDirection);
    1270. 

  1270.     bcsMinusEh, bcsPlusEh: DrawPlusMinusButton(DC, ARect, Enabled, Active, Flat, Down, bcsPlusEh = Style);
    1271. 

  1271.   end;
    1272. 

  1272.   if Flat then
    1273. 

  1273.     if not Active {and not (Style=bcsUpDownEh)}
    1274. 

  1274.       then InflateRect(ARect, -2, -2)
    1275. 

  1275.       else InflateRect(ARect, -1, -1);
    1276. 

  1276. 

  1277.   if IsClipRgn then
    1278. 

  1278.   begin
    1279. 

  1279.     if r = 0
    1280. 

  1280.       then SelectClipRgn(DC, 0)
    1281. 

  1281.       else SelectClipRgn(DC, SaveRgn);
    1282. 

  1282.     DeleteObject(SaveRgn);
    1283. 

  1283.     if Down
    1284. 

  1284.       then DrawEdge(DC, ARect, BDR_SUNKENOUTER, BF_RECT)
    1285. 

  1285.       else DrawEdge(DC, ARect, BDR_RAISEDINNER, BF_RECT)
    1286. 

  1286.   end;
    1287. 

  1287. end;
    1288. 

  1288. 

  1289. type
    1290. 

  1290.   PPoints = ^TPoints;
    1291. 

  1291.   TPoints = array[0..0] of TPoint;
    1292. 

  1292. 

  1293.   TButtonBitmapInfoEh = record
    1294. 

  1294.     Size: TPoint;
    1295. 

  1295.     BitmapType: TDrawButtonControlStyleEh;
    1296. 

  1296.     Flat: Boolean;
    1297. 

  1297.     Pressed: Boolean;
    1298. 

  1298.     Active: Boolean;
    1299. 

  1299.     Enabled: Boolean;
    1300. 

  1300.     DownDirect: Boolean;
    1301. 

  1301.     CheckState: TCheckBoxState;
    1302. 

  1302.   end;
    1303. 

  1303. 

  1304.   function CompareButtonBitmapInfo(Info1, Info2: TButtonBitmapInfoEh): Boolean;
    1305. 

  1305.   begin
    1306. 

  1306.     Result := (Info1.Size.X = Info2.Size.X) and (Info1.Size.Y = Info2.Size.Y)
    1307. 

  1307.       and (Info1.BitmapType = Info2.BitmapType)
    1308. 

  1308.       and (Info1.Flat = Info2.Flat)
    1309. 

  1309.       and (Info1.Pressed = Info2.Pressed)
    1310. 

  1310.       and (Info1.Active = Info2.Active)
    1311. 

  1311.       and (Info1.Enabled = Info2.Enabled)
    1312. 

  1312.       and (Info1.DownDirect = Info2.DownDirect)
    1313. 

  1313.       and (Info1.CheckState = Info2.CheckState);
    1314. 

  1314.   end;
    1315. 

  1315. 

  1316. type
    1317. 

  1317. 

  1318.   { TButtonsBitmapCache }
    1319. 

  1319. 

  1320.   TButtonBitmapInfoBitmapEh = class(TObject)
    1321. 

  1321.   public
    1322. 

  1322.     BitmapInfo: TButtonBitmapInfoEh;
    1323. 

  1323.     Bitmap: TBitmap;
    1324. 

  1324.   end;
    1325. 

  1325. 

  1326. //  PButtonBitmapInfoBitmapEh = ^TButtonBitmapInfoBitmapEh;
    1327. 

  1327. 

  1328.   TButtonsBitmapCache = class(TObjectList)
    1329. 

  1329.   private
    1330. 

  1330.     function Get(Index: Integer): TButtonBitmapInfoBitmapEh;
    1331. 

  1331. //    procedure Put(Index: Integer; const Value: PButtonBitmapInfoBitmapEh);
    1332. 

  1332.   public
    1333. 

  1333.     constructor Create; overload;
    1334. 

  1334.     procedure Clear; override;
    1335. 

  1335.     function GetButtonBitmap(ButtonBitmapInfo: TButtonBitmapInfoEh): TBitmap;
    1336. 

  1336.     property Items[Index: Integer]: TButtonBitmapInfoBitmapEh read Get {write Put}; default;
    1337. 

  1337.   end;
    1338. 

  1338. 

  1339. var ButtonsBitmapCache: TButtonsBitmapCache;
    1340. 

  1340. 

  1341. procedure ClearButtonsBitmapCache;
    1342. 

  1342. begin
    1343. 

  1343.   ButtonsBitmapCache.Clear;
    1344. 

  1344. end;
    1345. 

  1345. 

  1346. function RectSize(ARect: TRect): TSize;
    1347. 

  1347. begin
    1348. 

  1348.   Result.cx := ARect.Right - ARect.Left;
    1349. 

  1349.   Result.cy := ARect.Bottom - ARect.Top;
    1350. 

  1350. end;
    1351. 

  1351. 

  1352. procedure PaintButtonControlEh(DC: HDC; ARect: TRect; ParentColor: TColor;
    1353. 

  1353.   Style: TDrawButtonControlStyleEh; DownButton: Integer;
    1354. 

  1354.   Flat, Active, Enabled: Boolean; State: TCheckBoxState);
    1355. 

  1355. var
    1356. 

  1356.   Rgn, SaveRgn: HRgn;
    1357. 

  1357.   HalfRect, DRect: TRect;
    1358. 

  1358.   ASize: TSize;
    1359. 

  1359.   r: Integer;
    1360. 

  1360.   Brush: HBRUSH;
    1361. 

  1361.   IsClipRgn: Boolean;
    1362. 

  1362.   BitmapInfo: TButtonBitmapInfoEh;
    1363. 

  1363.   Bitmap: TBitmap;
    1364. 

  1364. begin
    1365. 

  1365.   SaveRgn := 0; r := 0;
    1366. 

  1366. //  FillChar(BitmapInfo, Sizeof(BitmapInfo), #0);
    1367. 

  1367.   BitmapInfo.BitmapType := Style;
    1368. 

  1368.   BitmapInfo.Flat := Flat;
    1369. 

  1369. 

  1370.   if Style = bcsCheckboxEh then
    1371. 

  1371.   begin
    1372. 

  1372.     ASize := RectSize(ARect);
    1373. 

  1373.     if ASize.cx < ASize.cy then
    1374. 

  1374.     begin
    1375. 

  1375.       ARect.Top := ARect.Top + (ASize.cy - ASize.cx) div 2;
    1376. 

  1376.       ARect.Bottom := ARect.Bottom - (ASize.cy - ASize.cx) div 2 - (ASize.cy - ASize.cx) mod 2;
    1377. 

  1377.     end else if ASize.cx > ASize.cy then
    1378. 

  1378.     begin
    1379. 

  1379.       ARect.Left := ARect.Left + (ASize.cx - ASize.cy) div 2;
    1380. 

  1380.       ARect.Right := ARect.Right - (ASize.cx - ASize.cy) div 2 - (ASize.cx - ASize.cy) mod 2;
    1381. 

  1381.     end;
    1382. 

  1382. 

  1383.     if Flat then InflateRect(ARect, -1, -1);
    1384. 

  1384.     if UseButtonsBitmapCache then
    1385. 

  1385.     begin
    1386. 

  1386.       BitmapInfo.Size := Point(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top);
    1387. 

  1387.       BitmapInfo.CheckState := State;
    1388. 

  1388.       BitmapInfo.Pressed := DownButton <> 0;
    1389. 

  1389.       BitmapInfo.Active := Active;
    1390. 

  1390.       BitmapInfo.Enabled := Enabled;
    1391. 

  1391.       Bitmap := ButtonsBitmapCache.GetButtonBitmap(BitmapInfo);
    1392. 

  1392. 

  1393.       StretchBlt(DC, ARect.Left, ARect.Top, ARect.Right - ARect.Left,
    1394. 

  1394.         ARect.Bottom - ARect.Top, Bitmap.Canvas.Handle, 0, 0,
    1395. 

  1395.         Bitmap.Width, Bitmap.Height, cmSrcCopy);
    1396. 

  1396.     end else
    1397. 

  1397.       DrawCheck(DC, ARect, State, Enabled, Flat, DownButton <> 0, Active);
    1398. 

  1398. 

  1399.     if Flat then
    1400. 

  1400.     begin
    1401. 

  1401.       InflateRect(ARect, 1, 1);
    1402. 

  1402.       if Active then
    1403. 

  1403.         DrawEdge(DC, ARect, BDR_SUNKENOUTER, BF_RECT)
    1404. 

  1404.       else
    1405. 

  1405.       begin
    1406. 

  1406. //        FrameRect(DC, ARect, GetCurrentObject(DC, OBJ_BRUSH));
    1407. 

  1407.         Brush := CreateSolidBrush(ColorToRGB(ParentColor));
    1408. 

  1408.         FrameRect(DC, ARect, Brush);
    1409. 

  1409.         DeleteObject(Brush);
    1410. 

  1410.       end;
    1411. 

  1411.     end;
    1412. 

  1412.   end else
    1413. 

  1413.   begin
    1414. 

  1414.     BitmapInfo.Active := Active;
    1415. 

  1415.     BitmapInfo.Enabled := Enabled;
    1416. 

  1416. 

  1417. {$IFDEF EH_LIB_7}
    1418. 

  1418.     IsClipRgn := Flat and not Active and not ThemeServices.ThemesEnabled;
    1419. 

  1419. {$ELSE}
    1420. 

  1420.     IsClipRgn := Flat and not Active;
    1421. 

  1421. {$ENDIF}
    1422. 

  1422.     if IsClipRgn then
    1423. 

  1423.     begin
    1424. 

  1424.       DRect := ARect;
    1425. 

  1425.       WindowsLPtoDP(DC, DRect);
    1426. 

  1426.       InflateRect(ARect, -1, -1);
    1427. 

  1427.       if not UseButtons…
    1428.

Large files files are truncated, but you can click here to view the full file