TBXOfficeXPTheme.pas 61 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716
  1. unit TBXOfficeXPTheme;
  2. // TBX Package
  3. // Copyright 2001-2004 Alex A. Denisov. All Rights Reserved
  4. // See TBX.chm for license and installation instructions
  5. //
  6. // Id: TBXOfficeXPTheme.pas 16 2004-05-26 02:02:55Z Alex@ZEISS
  7. interface
  8. {$I TB2Ver.inc}
  9. {$I TBX.inc}
  10. uses
  11. Windows, Messages, Graphics, TBXThemes, ImgList;
  12. {$DEFINE ALTERNATIVE_DISABLED_STYLE} // remove the asterisk to change appearance of disabled images
  13. {$DEFINE NO_IMAGE_DIMMING}
  14. type
  15. TItemPart = (ipBody, ipText, ipFrame);
  16. TBtnItemState = (bisNormal, bisDisabled, bisSelected, bisPressed, bisHot,
  17. bisDisabledHot, bisSelectedHot, bisPopupParent);
  18. TMenuItemState = (misNormal, misDisabled, misHot, misDisabledHot);
  19. TWinFramePart = (wfpBorder, wfpCaption, wfpCaptionText);
  20. TWinFrameState = (wfsActive, wfsInactive);
  21. TTBXOfficeXPTheme = class(TTBXTheme)
  22. private
  23. procedure TBXSysCommand(var Message: TMessage); message TBX_SYSCOMMAND;
  24. protected
  25. { View/Window Colors }
  26. MenubarColor: TColor;
  27. ToolbarColor: TColor;
  28. PopupColor: TColor;
  29. DockPanelColor: TColor;
  30. PopupFrameColor: TColor;
  31. WinFrameColors: array [TWinFrameState, TWinFramePart] of TColor;
  32. PnlFrameColors: array [TWinFrameState, TWinFramePart] of TColor;
  33. MenuItemColors: array [TMenuItemState, TItemPart] of TColor;
  34. BtnItemColors: array [TBtnItemState, TItemPart] of TColor;
  35. { Other Colors }
  36. DragHandleColor: TColor;
  37. PopupSeparatorColor: TColor;
  38. ToolbarSeparatorColor: TColor;
  39. IconShadowColor: TColor;
  40. StatusPanelFrameColor: TColor;
  41. procedure SetupColorCache; virtual;
  42. protected
  43. { Internal Methods }
  44. function GetPartColor(const ItemInfo: TTBXItemInfo; ItemPart: TItemPart): TColor;
  45. function GetBtnColor(const ItemInfo: TTBXItemInfo; ItemPart: TItemPart): TColor;
  46. public
  47. constructor Create(const AName: string); override;
  48. destructor Destroy; override;
  49. { Metrics access}
  50. function GetBooleanMetrics(Index: Integer): Boolean; override;
  51. function GetIntegerMetrics(Index: Integer): Integer; override;
  52. procedure GetMargins(MarginID: Integer; out Margins: TTBXMargins); override;
  53. function GetImageOffset(Canvas: TCanvas; const ItemInfo: TTBXItemInfo; ImageList: TCustomImageList): TPoint; override;
  54. function GetItemColor(const ItemInfo: TTBXItemInfo): TColor; override;
  55. function GetItemTextColor(const ItemInfo: TTBXItemInfo): TColor; override;
  56. function GetItemImageBackground(const ItemInfo: TTBXItemInfo): TColor; override;
  57. function GetPopupShadowType: Integer; override;
  58. procedure GetViewBorder(ViewType: Integer; out Border: TPoint); override;
  59. function GetViewColor(AViewType: Integer): TColor; override;
  60. procedure GetViewMargins(ViewType: Integer; out Margins: TTBXMargins); override;
  61. { Painting routines }
  62. procedure PaintBackgnd(Canvas: TCanvas; const ADockRect, ARect, AClipRect: TRect; AColor: TColor; Transparent: Boolean; AViewType: Integer); override;
  63. procedure PaintButton(Canvas: TCanvas; const ARect: TRect; const ItemInfo: TTBXItemInfo); override;
  64. procedure PaintCaption(Canvas: TCanvas; const ARect: TRect; const ItemInfo: TTBXItemInfo; const ACaption: string; AFormat: Cardinal; Rotated: Boolean); override;
  65. procedure PaintCheckMark(Canvas: TCanvas; ARect: TRect; const ItemInfo: TTBXItemInfo); override;
  66. procedure PaintChevron(Canvas: TCanvas; ARect: TRect; const ItemInfo: TTBXItemInfo); override;
  67. procedure PaintDock(Canvas: TCanvas; const ClientRect, DockRect: TRect; DockPosition: Integer); override;
  68. procedure PaintDockPanelNCArea(Canvas: TCanvas; R: TRect; const DockPanelInfo: TTBXDockPanelInfo); override;
  69. procedure PaintDropDownArrow(Canvas: TCanvas; const ARect: TRect; const ItemInfo: TTBXItemInfo); override;
  70. procedure PaintEditButton(Canvas: TCanvas; const ARect: TRect; var ItemInfo: TTBXItemInfo; ButtonInfo: TTBXEditBtnInfo); override;
  71. procedure PaintEditFrame(Canvas: TCanvas; const ARect: TRect; var ItemInfo: TTBXItemInfo; const EditInfo: TTBXEditInfo); override;
  72. procedure PaintFloatingBorder(Canvas: TCanvas; const ARect: TRect; const WindowInfo: TTBXWindowInfo); override;
  73. procedure PaintFrame(Canvas: TCanvas; const ARect: TRect; const ItemInfo: TTBXItemInfo); override;
  74. procedure PaintImage(Canvas: TCanvas; ARect: TRect; const ItemInfo: TTBXItemInfo; ImageList: TCustomImageList; ImageIndex: Integer); override;
  75. procedure PaintMDIButton(Canvas: TCanvas; ARect: TRect; const ItemInfo: TTBXItemInfo; ButtonKind: Cardinal); override;
  76. procedure PaintMenuItem(Canvas: TCanvas; const ARect: TRect; var ItemInfo: TTBXItemInfo); override;
  77. procedure PaintMenuItemFrame(Canvas: TCanvas; const ARect: TRect; const ItemInfo: TTBXItemInfo); override;
  78. procedure PaintPageScrollButton(Canvas: TCanvas; const ARect: TRect; ButtonType: Integer; Hot: Boolean); override;
  79. procedure PaintPopupNCArea(Canvas: TCanvas; R: TRect; const PopupInfo: TTBXPopupInfo); override;
  80. procedure PaintSeparator(Canvas: TCanvas; ARect: TRect; ItemInfo: TTBXItemInfo; Horizontal, LineSeparator: Boolean); override;
  81. procedure PaintToolbarNCArea(Canvas: TCanvas; R: TRect; const ToolbarInfo: TTBXToolbarInfo); override;
  82. procedure PaintFrameControl(Canvas: TCanvas; R: TRect; Kind, State: Integer; Params: Pointer); override;
  83. procedure PaintStatusBar(Canvas: TCanvas; R: TRect; Part: Integer); override;
  84. end;
  85. implementation
  86. uses
  87. TBXUtils, TB2Common, TB2Item, Classes, Controls, Commctrl, Forms, SysUtils,
  88. Types, UITypes, UxTheme;
  89. var
  90. StockImgList: TImageList;
  91. CounterLock: Integer;
  92. procedure InitializeStock;
  93. begin
  94. StockImgList := TImageList.Create(nil);
  95. StockImgList.Handle := ImageList_LoadBitmap(HInstance, 'TBXGLYPHS', 16, 0, clWhite);
  96. end;
  97. procedure FinalizeStock;
  98. begin
  99. StockImgList.Free;
  100. end;
  101. { TTBXOfficeXPTheme }
  102. function TTBXOfficeXPTheme.GetBooleanMetrics(Index: Integer): Boolean;
  103. begin
  104. case Index of
  105. TMB_OFFICEXPPOPUPALIGNMENT: Result := True;
  106. TMB_EDITMENUFULLSELECT: Result := True;
  107. TMB_EDITHEIGHTEVEN: Result := False;
  108. TMB_SOLIDTOOLBARNCAREA: Result := False;
  109. TMB_SOLIDTOOLBARCLIENTAREA: Result := True;
  110. else
  111. Result := False;
  112. end;
  113. end;
  114. function TTBXOfficeXPTheme.GetIntegerMetrics(Index: Integer): Integer;
  115. const
  116. DEFAULT = -1;
  117. begin
  118. case Index of
  119. TMI_SPLITBTN_ARROWWIDTH: Result := 12;
  120. TMI_DROPDOWN_ARROWWIDTH: Result := 8;
  121. TMI_DROPDOWN_ARROWMARGIN: Result := 3;
  122. TMI_MENU_IMGTEXTSPACE: Result := 5;
  123. TMI_MENU_LCAPTIONMARGIN: Result := 3;
  124. TMI_MENU_RCAPTIONMARGIN: Result := 3;
  125. TMI_MENU_SEPARATORSIZE: Result := 3;
  126. TMI_MENU_MDI_DW: Result := 2;
  127. TMI_MENU_MDI_DH: Result := 2;
  128. TMI_TLBR_SEPARATORSIZE: Result := 6;
  129. TMI_EDIT_FRAMEWIDTH: Result := 1;
  130. TMI_EDIT_TEXTMARGINHORZ: Result := 2;
  131. TMI_EDIT_TEXTMARGINVERT: Result := 2;
  132. TMI_EDIT_BTNWIDTH: Result := 14;
  133. TMI_EDIT_MENURIGHTINDENT: Result := 1;
  134. else
  135. Result := DEFAULT;
  136. end;
  137. if Result > 0 then
  138. begin
  139. // DPI-scaling for a lack of better choice here
  140. Result := MulDiv(Result, Screen.PixelsPerInch, USER_DEFAULT_SCREEN_DPI);
  141. end;
  142. end;
  143. function TTBXOfficeXPTheme.GetViewColor(AViewType: Integer): TColor;
  144. begin
  145. Result := clBtnFace;
  146. if (AViewType and VT_TOOLBAR) = VT_TOOLBAR then
  147. begin
  148. if (AViewType and TVT_MENUBAR) = TVT_MENUBAR then Result := MenubarColor
  149. else Result := ToolbarColor;
  150. end
  151. else if (AViewType and VT_POPUP) = VT_POPUP then
  152. begin
  153. if (AViewType and PVT_LISTBOX) = PVT_LISTBOX then Result := clWindow
  154. else Result := PopupColor;
  155. end
  156. else if (AViewType and VT_DOCKPANEL) = VT_DOCKPANEL then Result := DockPanelColor
  157. else if (AViewType and VT_SECTIONHEADER) = VT_SECTIONHEADER then Result := ToolbarColor;
  158. end;
  159. function TTBXOfficeXPTheme.GetBtnColor(const ItemInfo: TTBXItemInfo; ItemPart: TItemPart): TColor;
  160. const
  161. BFlags1: array [Boolean] of TBtnItemState = (bisDisabled, bisDisabledHot);
  162. BFlags2: array [Boolean] of TBtnItemState = (bisSelected, bisSelectedHot);
  163. BFlags3: array [Boolean] of TBtnItemState = (bisNormal, bisHot);
  164. var
  165. B: TBtnItemState;
  166. Embedded: Boolean;
  167. begin
  168. with ItemInfo do
  169. begin
  170. Embedded := (ViewType and VT_TOOLBAR = VT_TOOLBAR) and
  171. (ViewType and TVT_EMBEDDED = TVT_EMBEDDED);
  172. if not Enabled then B := BFlags1[HoverKind = hkKeyboardHover]
  173. else if ItemInfo.IsPopupParent then B := bisPopupParent
  174. else if Pushed then B := bisPressed
  175. else if Selected then B := BFlags2[HoverKind <> hkNone]
  176. else B := BFlags3[HoverKind <> hkNone];
  177. Result := BtnItemColors[B, ItemPart];
  178. if Embedded then
  179. begin
  180. if (ItemPart = ipBody) and (Result = clNone) then Result := ToolbarColor;
  181. if ItemPart = ipFrame then
  182. begin
  183. if Selected then Result := clWindowFrame
  184. else if (Result = clNone) then Result := clBtnShadow;
  185. end;
  186. end;
  187. end;
  188. end;
  189. function TTBXOfficeXPTheme.GetPartColor(const ItemInfo: TTBXItemInfo; ItemPart: TItemPart): TColor;
  190. const
  191. MFlags1: array [Boolean] of TMenuItemState = (misDisabled, misDisabledHot);
  192. MFlags2: array [Boolean] of TMenuItemState = (misNormal, misHot);
  193. BFlags1: array [Boolean] of TBtnItemState = (bisDisabled, bisDisabledHot);
  194. BFlags2: array [Boolean] of TBtnItemState = (bisSelected, bisSelectedHot);
  195. BFlags3: array [Boolean] of TBtnItemState = (bisNormal, bisHot);
  196. var
  197. IsMenuItem, Embedded: Boolean;
  198. M: TMenuItemState;
  199. B: TBtnItemState;
  200. begin
  201. with ItemInfo do
  202. begin
  203. IsMenuItem := ((ViewType and PVT_POPUPMENU) = PVT_POPUPMENU) and
  204. ((ItemOptions and IO_TOOLBARSTYLE) = 0);
  205. Embedded := ((ViewType and VT_TOOLBAR) = VT_TOOLBAR) and
  206. ((ViewType and TVT_EMBEDDED) = TVT_EMBEDDED);
  207. if IsMenuItem then
  208. begin
  209. if not Enabled then M := MFlags1[HoverKind = hkKeyboardHover]
  210. else M := MFlags2[HoverKind <> hkNone];
  211. Result := MenuItemColors[M, ItemPart];
  212. end
  213. else
  214. begin
  215. if not Enabled then B := BFlags1[HoverKind = hkKeyboardHover]
  216. else if ItemInfo.IsPopupParent then B := bisPopupParent
  217. else if Pushed then B := bisPressed
  218. else if Selected then B := BFlags2[HoverKind <> hkNone]
  219. else B := BFlags3[HoverKind <> hkNone];
  220. Result := BtnItemColors[B, ItemPart];
  221. if Embedded and (Result = clNone) then
  222. begin
  223. if ItemPart = ipBody then Result := ToolbarColor;
  224. if ItemPart = ipFrame then Result := clBtnShadow;
  225. end;
  226. end;
  227. end;
  228. end;
  229. function TTBXOfficeXPTheme.GetItemColor(const ItemInfo: TTBXItemInfo): TColor;
  230. begin
  231. Result := GetPartColor(ItemInfo, ipBody);
  232. if Result = clNone then Result := GetViewColor(ItemInfo.ViewType);
  233. end;
  234. function TTBXOfficeXPTheme.GetItemTextColor(const ItemInfo: TTBXItemInfo): TColor;
  235. begin
  236. Result := GetPartColor(ItemInfo, ipText);
  237. end;
  238. function TTBXOfficeXPTheme.GetItemImageBackground(const ItemInfo: TTBXItemInfo): TColor;
  239. begin
  240. Result := GetBtnColor(ItemInfo, ipBody);
  241. if Result = clNone then Result := GetViewColor(ItemInfo.ViewType);
  242. end;
  243. procedure TTBXOfficeXPTheme.GetViewBorder(ViewType: Integer; out Border: TPoint);
  244. const
  245. XMetrics: array [Boolean] of Integer = (SM_CXDLGFRAME, SM_CXFRAME);
  246. YMetrics: array [Boolean] of Integer = (SM_CYDLGFRAME, SM_CYFRAME);
  247. var
  248. Resizable: Boolean;
  249. procedure SetBorder(X, Y: Integer);
  250. begin
  251. Border.X := X;
  252. Border.Y := Y;
  253. end;
  254. begin
  255. if (ViewType and VT_TOOLBAR) = VT_TOOLBAR then
  256. begin
  257. if (ViewType and TVT_FLOATING) = TVT_FLOATING then
  258. begin
  259. Resizable := (ViewType and TVT_RESIZABLE) = TVT_RESIZABLE;
  260. Border.X := GetSystemMetrics(XMetrics[Resizable]) - 1;
  261. Border.Y := GetSystemMetrics(YMetrics[Resizable]) - 1;
  262. end
  263. else SetBorder(2, 2);
  264. end
  265. else if (ViewType and VT_POPUP) = VT_POPUP then
  266. begin
  267. if (ViewType and PVT_POPUPMENU) = PVT_POPUPMENU then Border.X := 1
  268. else Border.X := 2;
  269. Border.Y := 2;
  270. end
  271. else if (ViewType and VT_DOCKPANEL) = VT_DOCKPANEL then
  272. begin
  273. if (ViewType and DPVT_FLOATING) = DPVT_FLOATING then
  274. begin
  275. Resizable := (ViewType and DPVT_RESIZABLE) = DPVT_RESIZABLE;
  276. Border.X := GetSystemMetrics(XMetrics[Resizable]) - 1;
  277. Border.Y := GetSystemMetrics(YMetrics[Resizable]) - 1;
  278. end
  279. else SetBorder(2, 2);
  280. end
  281. else SetBorder(0, 0);
  282. end;
  283. procedure TTBXOfficeXPTheme.GetMargins(MarginID: Integer; out Margins: TTBXMargins);
  284. begin
  285. with Margins do
  286. case MarginID of
  287. MID_TOOLBARITEM:
  288. begin
  289. LeftWidth := 2; RightWidth := 2;
  290. TopHeight := 2; BottomHeight := 2;
  291. end;
  292. MID_MENUITEM:
  293. begin
  294. LeftWidth := 1; RightWidth := 1;
  295. TopHeight := 3; BottomHeight := 3;
  296. end;
  297. MID_STATUSPANE:
  298. begin
  299. LeftWidth := 1; RightWidth := 3;
  300. TopHeight := 1; BottomHeight := 1;
  301. end;
  302. else
  303. LeftWidth := 0;
  304. RightWidth := 0;
  305. TopHeight := 0;
  306. BottomHeight := 0;
  307. end;
  308. end;
  309. procedure TTBXOfficeXPTheme.PaintBackgnd(Canvas: TCanvas; const ADockRect, ARect, AClipRect: TRect;
  310. AColor: TColor; Transparent: Boolean; AViewType: Integer);
  311. var
  312. DC: HDC;
  313. R: TRect;
  314. begin
  315. DC := Canvas.Handle;
  316. if not Transparent then
  317. begin
  318. IntersectRect(R, ARect, AClipRect);
  319. FillRectEx(DC, R, AColor);
  320. end;
  321. end;
  322. procedure TTBXOfficeXPTheme.PaintCaption(Canvas: TCanvas;
  323. const ARect: TRect; const ItemInfo: TTBXItemInfo; const ACaption: string;
  324. AFormat: Cardinal; Rotated: Boolean);
  325. var
  326. R: TRect;
  327. begin
  328. with ItemInfo, Canvas do
  329. begin
  330. R := ARect;
  331. Brush.Style := bsClear;
  332. if Font.Color = clNone then Font.Color := GetPartColor(ItemInfo, ipText);
  333. if not Rotated then Windows.DrawText(Handle, PChar(ACaption), Length(ACaption), R, AFormat)
  334. else DrawRotatedText(Handle, ACaption, R, AFormat);
  335. Brush.Style := bsSolid;
  336. end;
  337. end;
  338. procedure TTBXOfficeXPTheme.PaintCheckMark(Canvas: TCanvas; ARect: TRect; const ItemInfo: TTBXItemInfo);
  339. var
  340. DC: HDC;
  341. X, Y: Integer;
  342. C: TColor;
  343. Two, Three, Four: Integer;
  344. Diag: Integer;
  345. I: Integer;
  346. begin
  347. Two := ScaleByTextHeightRunTime(Canvas, 2);
  348. Three := ScaleByTextHeightRunTime(Canvas, 3);
  349. Four := ScaleByTextHeightRunTime(Canvas, 4);
  350. DC := Canvas.Handle;
  351. X := (ARect.Left + ARect.Right) div 2 - 1;
  352. Y := (ARect.Top + ARect.Bottom) div 2 + 1;
  353. C := GetBtnColor(ItemInfo, ipText);
  354. if ItemInfo.ItemOptions and IO_RADIO > 0 then
  355. begin
  356. // Should we use SM_CXMENUCHECK to determine the size?
  357. // 10 div 14 is approximation of division by square root of 2 (pythagorean theorem)
  358. Diag := (Three * 10 div 14) + 1;
  359. RoundRectEx(DC, X-Diag+1, Y-Diag-1, X+Diag+1, Y+Diag-1, Four div 2, Four div 2,
  360. MixColors(C, ToolbarColor, 200), C);
  361. // Using Ellipse instead of RoundRect to draw circle was an attempt to draw it nicely on
  362. // high DPI. It didn't work. But using ellipse seems better anyway, so we kept it.
  363. EllipseEx(DC, X-Three+1, Y-Three-1, X+Three+1, Y+Three-1,
  364. C, C);
  365. end
  366. else
  367. begin
  368. for I := 1 to Two do
  369. begin
  370. PolyLineEx(DC, [Point(X-Two, Y-Two+I), Point(X, Y+I), Point(X+Four+1, Y-Four-1+I)], C);
  371. end;
  372. end;
  373. end;
  374. procedure TTBXOfficeXPTheme.PaintChevron(Canvas: TCanvas; ARect: TRect; const ItemInfo: TTBXItemInfo);
  375. const
  376. Pattern: array[Boolean, 0..15] of Byte = (
  377. ($CC, 0, $66, 0, $33, 0, $66, 0, $CC, 0, 0, 0, 0, 0, 0, 0),
  378. ($88, 0, $D8, 0, $70, 0, $20, 0, $88, 0, $D8, 0, $70, 0, $20, 0));
  379. var
  380. R2: TRect;
  381. W, H: Integer;
  382. begin
  383. R2 := ARect;
  384. PaintButton(Canvas, ARect, ItemInfo);
  385. if not ItemInfo.IsVertical then
  386. begin
  387. Inc(R2.Top, 4);
  388. R2.Bottom := R2.Top + 5;
  389. W := 8;
  390. H := 5;
  391. end
  392. else
  393. begin
  394. R2.Left := R2.Right - 9;
  395. R2.Right := R2.Left + 5;
  396. W := 5;
  397. H := 8;
  398. end;
  399. DrawGlyph(Canvas.Handle, R2, W, H, Pattern[ItemInfo.IsVertical][0], GetPartColor(ItemInfo, ipText));
  400. end;
  401. procedure TTBXOfficeXPTheme.PaintEditButton(Canvas: TCanvas; const ARect: TRect;
  402. var ItemInfo: TTBXItemInfo; ButtonInfo: TTBXEditBtnInfo);
  403. var
  404. DC: HDC;
  405. BtnDisabled, BtnHot, BtnPressed, Embedded: Boolean;
  406. R, BR: TRect;
  407. X, Y: Integer;
  408. SaveItemInfoPushed: Boolean;
  409. C: TColor;
  410. begin
  411. DC := Canvas.Handle;
  412. R := ARect;
  413. Embedded := ((ItemInfo.ViewType and VT_TOOLBAR) = VT_TOOLBAR) and
  414. ((ItemInfo.ViewType and TVT_EMBEDDED) = TVT_EMBEDDED);
  415. InflateRect(R, 1, 1);
  416. Inc(R.Left);
  417. with Canvas do
  418. if ButtonInfo.ButtonType = EBT_DROPDOWN then
  419. begin
  420. BtnDisabled := (ButtonInfo.ButtonState and EBDS_DISABLED) <> 0;
  421. BtnHot := (ButtonInfo.ButtonState and EBDS_HOT) <> 0;
  422. BtnPressed := (ButtonInfo.ButtonState and EBDS_PRESSED) <> 0;
  423. if not BtnDisabled then
  424. begin
  425. if BtnPressed or BtnHot or Embedded then PaintButton(Canvas, R, ItemInfo)
  426. else if (ItemInfo.ViewType and VT_TOOLBAR) = VT_TOOLBAR then
  427. begin
  428. R := ARect;
  429. if not Embedded then
  430. begin
  431. FrameRectEx(DC, R, clWindow, False);
  432. C := clWindow;
  433. end
  434. else C := GetBtnColor(ItemInfo, ipFrame);
  435. DrawLineEx(DC, R.Left - 1, R.Top, R.Left - 1, R.Bottom, C);
  436. end;
  437. end;
  438. PaintDropDownArrow(Canvas, R, ItemInfo);
  439. end
  440. else if ButtonInfo.ButtonType = EBT_SPIN then
  441. begin
  442. BtnDisabled := (ButtonInfo.ButtonState and EBSS_DISABLED) <> 0;
  443. BtnHot := (ButtonInfo.ButtonState and EBSS_HOT) <> 0;
  444. { Upper button }
  445. BR := R;
  446. BR.Bottom := (R.Top + R.Bottom + 1) div 2;
  447. BtnPressed := (ButtonInfo.ButtonState and EBSS_UP) <> 0;
  448. SaveItemInfoPushed := ItemInfo.Pushed;
  449. ItemInfo.Pushed := BtnPressed;
  450. if not BtnDisabled then
  451. begin
  452. if BtnPressed or BtnHot or Embedded then PaintButton(Canvas, BR, ItemInfo)
  453. else if (ItemInfo.ViewType and VT_TOOLBAR) = VT_TOOLBAR then
  454. begin
  455. BR.Left := ARect.Left; BR.Top := ARect.Top; BR.Right := ARect.Right;
  456. if not Embedded then
  457. begin
  458. FrameRectEx(DC, BR, clWindow, False);
  459. C := clWindow;
  460. end
  461. else C := GetBtnColor(ItemInfo, ipFrame);
  462. DrawLineEx(DC, BR.Left - 1, BR.Top, BR.Left - 1, BR.Bottom, C);
  463. end;
  464. end;
  465. X := (BR.Left + BR.Right) div 2;
  466. Y := (BR.Top + BR.Bottom - 1) div 2;
  467. Pen.Color := GetPartColor(ItemInfo, ipText);
  468. Brush.Color := Pen.Color;
  469. Polygon([Point(X - 2, Y + 1), Point(X + 2, Y + 1), Point(X, Y - 1)]);
  470. { Lower button }
  471. BR := R;
  472. BR.Top := (R.Top + R.Bottom) div 2;
  473. BtnPressed := (ButtonInfo.ButtonState and EBSS_DOWN) <> 0;
  474. ItemInfo.Pushed := BtnPressed;
  475. if not BtnDisabled then
  476. begin
  477. if BtnPressed or BtnHot or Embedded then PaintButton(Canvas, BR, ItemInfo)
  478. else if (ItemInfo.ViewType and VT_TOOLBAR) = VT_TOOLBAR then
  479. begin
  480. BR.Left := ARect.Left; BR.Bottom := ARect.Bottom; BR.Right := ARect.Right;
  481. if not Embedded then
  482. begin
  483. FrameRectEx(DC, BR, clWindow, False);
  484. C := clWindow;
  485. end
  486. else C := GetBtnColor(ItemInfo, ipFrame);
  487. DrawLineEx(DC, BR.Left - 1, BR.Top, BR.Left - 1, BR.Bottom, C);
  488. end;
  489. end;
  490. X := (BR.Left + BR.Right) div 2;
  491. Y := (BR.Top + BR.Bottom) div 2;
  492. C := GetPartColor(ItemInfo, ipText);
  493. PolygonEx(DC, [Point(X - 2, Y - 1), Point(X + 2, Y - 1), Point(X, Y + 1)], C, C);
  494. ItemInfo.Pushed := SaveItemInfoPushed;
  495. end;
  496. end;
  497. procedure TTBXOfficeXPTheme.PaintEditFrame(Canvas: TCanvas;
  498. const ARect: TRect; var ItemInfo: TTBXItemInfo; const EditInfo: TTBXEditInfo);
  499. var
  500. DC: HDC;
  501. R: TRect;
  502. W: Integer;
  503. Embedded: Boolean;
  504. begin
  505. DC := Canvas.Handle;
  506. R := ARect;
  507. PaintFrame(Canvas, R, ItemInfo);
  508. W := EditFrameWidth;
  509. InflateRect(R, -W, -W);
  510. Embedded := ((ItemInfo.ViewType and VT_TOOLBAR) = VT_TOOLBAR) and
  511. ((ItemInfo.ViewType and TVT_EMBEDDED) = TVT_EMBEDDED);
  512. if not (ItemInfo.Enabled or Embedded) then
  513. FrameRectEx(DC, R, BtnItemColors[bisDisabled, ipText], False);
  514. with EditInfo do if RightBtnWidth > 0 then Dec(R.Right, RightBtnWidth - 2);
  515. if ItemInfo.Enabled then
  516. begin
  517. if ((ItemInfo.ViewType and VT_TOOLBAR) <> VT_TOOLBAR) and (GetPartColor(ItemInfo, ipFrame) = clNone) then
  518. FrameRectEx(DC, R, ToolbarColor, False)
  519. else
  520. FrameRectEx(DC, R, clWindow, False);
  521. InflateRect(R, -1, -1);
  522. FillRectEx(DC, R, clWindow);
  523. if ((ItemInfo.ViewType and VT_TOOLBAR) <> VT_TOOLBAR) and (GetPartColor(ItemInfo, ipFrame) = clNone) then
  524. begin
  525. R := ARect;
  526. InflateRect(R, -1, -1);
  527. FrameRectEx(DC, R, ToolbarColor, False);
  528. end;
  529. end
  530. else InflateRect(R, -1, -1);
  531. with EditInfo do if LeftBtnWidth > 0 then Inc(R.Left, LeftBtnWidth - 2);
  532. if EditInfo.RightBtnWidth > 0 then
  533. begin
  534. R := ARect;
  535. InflateRect(R, -W, -W);
  536. R.Left := R.Right - EditInfo.RightBtnWidth;
  537. PaintEditButton(Canvas, R, ItemInfo, EditInfo.RightBtnInfo);
  538. end;
  539. end;
  540. procedure TTBXOfficeXPTheme.PaintDropDownArrow(Canvas: TCanvas;
  541. const ARect: TRect; const ItemInfo: TTBXItemInfo);
  542. var
  543. X, Y: Integer;
  544. Two: Integer;
  545. begin
  546. with ARect, Canvas do
  547. begin
  548. X := (Left + Right) div 2;
  549. Y := (Top + Bottom) div 2 - 1;
  550. Pen.Color := GetPartColor(ItemInfo, ipText);
  551. Brush.Color := Pen.Color;
  552. Two := ScaleByTextHeightRunTime(Canvas, 2);
  553. if ItemInfo.IsVertical then Polygon([Point(X, Y + Two), Point(X, Y - Two), Point(X - Two, Y)])
  554. else Polygon([Point(X - Two, Y), Point(X + Two, Y), Point(X, Y + Two)]);
  555. end;
  556. end;
  557. procedure TTBXOfficeXPTheme.PaintButton(Canvas: TCanvas; const ARect: TRect; const ItemInfo: TTBXItemInfo);
  558. var
  559. DC: HDC;
  560. R: TRect;
  561. begin
  562. DC := Canvas.Handle;
  563. with ItemInfo do
  564. begin
  565. R := ARect;
  566. if ((ItemOptions and IO_DESIGNING) <> 0) and not Selected then
  567. begin
  568. if ComboPart = cpSplitRight then Dec(R.Left);
  569. FrameRectEx(DC, R, GetNearestColor(DC, MixColors(clBtnShadow, clBtnFace, 100)), False);
  570. end
  571. else
  572. begin
  573. FrameRectEx(DC, R, GetBtnColor(ItemInfo, ipFrame), True);
  574. if (ComboPart = cpSplitLeft) and IsPopupParent then Inc(R.Right);
  575. if ComboPart = cpSplitRight then Dec(R.Left);
  576. FillRectEx(DC, R, GetBtnColor(ItemInfo, ipBody));
  577. end;
  578. if ComboPart = cpSplitRight then PaintDropDownArrow(Canvas, R, ItemInfo);
  579. end;
  580. end;
  581. procedure TTBXOfficeXPTheme.PaintFloatingBorder(Canvas: TCanvas; const ARect: TRect;
  582. const WindowInfo: TTBXWindowInfo);
  583. const
  584. WinStates: array [Boolean] of TWinFramestate = (wfsInactive, wfsActive);
  585. function GetBtnItemState(BtnState: Integer): TBtnItemState;
  586. begin
  587. if not WindowInfo.Active then Result := bisDisabled
  588. else if (BtnState and CDBS_PRESSED) <> 0 then Result := bisPressed
  589. else if (BtnState and CDBS_HOT) <> 0 then Result := bisHot
  590. else Result := bisNormal;
  591. end;
  592. var
  593. WinState: TWinFrameState;
  594. BtnItemState: TBtnItemState;
  595. SaveIndex, X, Y: Integer;
  596. Sz: TPoint;
  597. R: TRect;
  598. BodyColor, CaptionColor, CaptionText: TColor;
  599. IsDockPanel: Boolean;
  600. begin
  601. with Canvas do
  602. begin
  603. WinState := WinStates[WindowInfo.Active];
  604. IsDockPanel := (WindowInfo.ViewType and VT_DOCKPANEL) = VT_DOCKPANEL;
  605. BodyColor := Brush.Color;
  606. if (WRP_BORDER and WindowInfo.RedrawPart) <> 0 then
  607. begin
  608. R := ARect;
  609. if not IsDockPanel then Brush.Color := WinFrameColors[WinState, wfpBorder]
  610. else Brush.Color := PnlFrameColors[WinState, wfpBorder];
  611. SaveIndex := SaveDC(Canvas.Handle);
  612. Sz := WindowInfo.FloatingBorderSize;
  613. with R, Sz do ExcludeClipRect(Canvas.Handle, Left + X, Top + Y, Right - X, Bottom - Y);
  614. FillRect(R);
  615. RestoreDC(Canvas.Handle, SaveIndex);
  616. InflateRect(R, -Sz.X, -Sz.Y);
  617. Pen.Color := BodyColor;
  618. with R do
  619. if not IsDockPanel then
  620. Canvas.Polyline([
  621. Point(Left, Top - 1), Point(Right - 1, Top - 1),
  622. Point(Right, Top), Point(Right, Bottom - 1),
  623. Point(Right - 1, Bottom),
  624. Point(Left, Bottom), Point(Left - 1, Bottom - 1),
  625. Point(Left - 1, Top), Point(Left, Top - 1)
  626. ])
  627. else
  628. Canvas.Polyline([
  629. Point(Left, Top - 1), Point(Right - 1, Top - 1),
  630. Point(Right, Top), Point(Right, Bottom),
  631. Point(Left - 1, Bottom),
  632. Point(Left - 1, Top), Point(Left, Top - 1)
  633. ]);
  634. end;
  635. if not WindowInfo.ShowCaption then Exit;
  636. if (WindowInfo.ViewType and VT_TOOLBAR) = VT_TOOLBAR then
  637. begin
  638. CaptionColor := WinFrameColors[WinState, wfpCaption];
  639. CaptionText := WinFrameColors[WinState, wfpCaptionText];
  640. end
  641. else
  642. begin
  643. CaptionColor := PnlFrameColors[WinState, wfpCaption];
  644. CaptionText := PnlFrameColors[WinState, wfpCaptionText];
  645. end;
  646. { Caption }
  647. if (WRP_CAPTION and WindowInfo.RedrawPart) <> 0 then
  648. begin
  649. R := Rect(0, 0, WindowInfo.ClientWidth, GetSystemMetrics(SM_CYSMCAPTION) - 1);
  650. with WindowInfo.FloatingBorderSize do OffsetRect(R, X, Y);
  651. DrawLineEx(Canvas.Handle, R.Left, R.Bottom, R.Right, R.Bottom, BodyColor);
  652. if ((CDBS_VISIBLE and WindowInfo.CloseButtonState) <> 0) and
  653. ((WRP_CLOSEBTN and WindowInfo.RedrawPart) <> 0) then
  654. Dec(R.Right, GetSystemMetrics(SM_CYSMCAPTION) - 1);
  655. Brush.Color := CaptionColor;
  656. FillRect(R);
  657. InflateRect(R, -2, 0);
  658. Font.Assign(SmCaptionFont);
  659. Font.Color := CaptionText;
  660. DrawText(Canvas.Handle, WindowInfo.Caption, -1, R,
  661. DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS or DT_NOPREFIX);
  662. end;
  663. { Close button }
  664. if (CDBS_VISIBLE and WindowInfo.CloseButtonState) <> 0 then
  665. begin
  666. R := Rect(0, 0, WindowInfo.ClientWidth, GetSystemMetrics(SM_CYSMCAPTION) - 1);
  667. with WindowInfo.FloatingBorderSize do OffsetRect(R, X, Y);
  668. R.Left := R.Right - (R.Bottom - R.Top);
  669. DrawLineEx(Canvas.Handle, R.Left - 1, R.Bottom, R.Right, R.Bottom, BodyColor);
  670. Brush.Color := CaptionColor;
  671. FillRect(R);
  672. with R do
  673. begin
  674. X := (Left + Right - StockImgList.Width + 1) div 2;
  675. Y := (Top + Bottom - StockImgList.Height) div 2;
  676. end;
  677. BtnItemState := GetBtnItemState(WindowInfo.CloseButtonState);
  678. FrameRectEx(Canvas.Handle, R, BtnItemColors[BtnItemState, ipFrame], True);
  679. if FillRectEx(Canvas.Handle, R, BtnItemColors[BtnItemState, ipBody]) then
  680. DrawGlyph(Canvas.Handle, X, Y, StockImgList, 0, BtnItemColors[BtnItemState, ipText])
  681. else
  682. DrawGlyph(Canvas.Handle, X, Y, StockImgList, 0, CaptionText);
  683. end;
  684. end;
  685. end;
  686. procedure TTBXOfficeXPTheme.PaintFrame(Canvas: TCanvas; const ARect: TRect;
  687. const ItemInfo: TTBXItemInfo);
  688. var
  689. DC: HDC;
  690. R: TRect;
  691. begin
  692. DC := Canvas.Handle;
  693. R := ARect;
  694. FrameRectEx(DC, R, GetPartColor(ItemInfo, ipFrame), True);
  695. FillRectEx(DC, R, GetPartColor(ItemInfo, ipBody));
  696. end;
  697. function TTBXOfficeXPTheme.GetImageOffset(Canvas: TCanvas;
  698. const ItemInfo: TTBXItemInfo; ImageList: TCustomImageList): TPoint;
  699. begin
  700. Result.X := 0;
  701. if not (ImageList is TTBCustomImageList) then
  702. with ItemInfo do
  703. if Enabled and (HoverKind <> hkNone) and
  704. not (Selected or Pushed and not IsPopupParent) then
  705. Result.X := -1;
  706. Result.Y := Result.X
  707. end;
  708. procedure TTBXOfficeXPTheme.PaintImage(Canvas: TCanvas; ARect: TRect;
  709. const ItemInfo: TTBXItemInfo; ImageList: TCustomImageList; ImageIndex: Integer);
  710. var
  711. HiContrast: Boolean;
  712. begin
  713. with ItemInfo do
  714. begin
  715. if ImageList is TTBCustomImageList then
  716. begin
  717. TTBCustomImageList(ImageList).DrawState(Canvas, ARect.Left, ARect.Top,
  718. ImageIndex, Enabled, (HoverKind <> hkNone), Selected);
  719. Exit;
  720. end;
  721. {$IFNDEF ALTERNATIVE_DISABLED_STYLE}
  722. HiContrast := IsDarkColor(GetItemImageBackground(ItemInfo), 64);
  723. if not Enabled then
  724. begin
  725. DrawTBXIconFlatShadow(Canvas, ARect, ImageList, ImageIndex,
  726. BtnItemColors[bisDisabled, ipText]);
  727. end
  728. else if Selected or Pushed or (HoverKind <> hkNone) then
  729. begin
  730. if not (Selected or Pushed and not IsPopupParent) then
  731. begin
  732. OffsetRect(ARect, 1, 1);
  733. DrawTBXIconFullShadow(Canvas, ARect, ImageList, ImageIndex, IconShadowColor);
  734. OffsetRect(ARect, -2, -2);
  735. end;
  736. DrawTBXIcon(Canvas, ARect, ImageList, ImageIndex, HiContrast);
  737. end
  738. else if HiContrast or TBXHiContrast or TBXLoColor then
  739. DrawTBXIcon(Canvas, ARect, ImageList, ImageIndex, HiContrast)
  740. else
  741. HighlightTBXIcon(Canvas, ARect, ImageList, ImageIndex, clWindow, 178);
  742. {$ELSE}
  743. HiContrast := ColorIntensity(GetItemImageBackground(ItemInfo)) < 80;
  744. if not Enabled then
  745. begin
  746. if not HiContrast then
  747. DrawTBXIconShadow(Canvas, ARect, ImageList, ImageIndex, 0)
  748. else
  749. DrawTBXIconFlatShadow(Canvas, ARect, ImageList, ImageIndex, clBtnShadow);
  750. end
  751. else if Selected or Pushed or (HoverKind <> hkNone) then
  752. begin
  753. if not (Selected or Pushed and not IsPopupParent) then
  754. begin
  755. DrawTBXIconShadow(Canvas, ARect, ImageList, ImageIndex, 1);
  756. OffsetRect(ARect, 1, 1);
  757. DrawTBXIconShadow(Canvas, ARect, ImageList, ImageIndex, 1);
  758. OffsetRect(ARect, -2, -2);
  759. end;
  760. DrawTBXIcon(Canvas, ARect, ImageList, ImageIndex, HiContrast);
  761. end
  762. else
  763. {$IFNDEF NO_IMAGE_DIMMING}
  764. if HiContrast or TBXHiContrast or TBXLoColor then
  765. {$ENDIF}
  766. DrawTBXIcon(Canvas, ARect, ImageList, ImageIndex, HiContrast)
  767. {$IFNDEF NO_IMAGE_DIMMING}
  768. else
  769. HighlightTBXIcon(Canvas, ARect, ImageList, ImageIndex, clWindow, 178)
  770. {$ENDIF}
  771. ;
  772. {$ENDIF}
  773. end;
  774. end;
  775. procedure TTBXOfficeXPTheme.PaintMDIButton(Canvas: TCanvas; ARect: TRect;
  776. const ItemInfo: TTBXItemInfo; ButtonKind: Cardinal);
  777. var
  778. Index: Integer;
  779. begin
  780. PaintButton(Canvas, ARect, ItemInfo);
  781. Dec(ARect.Bottom);
  782. case ButtonKind of
  783. DFCS_CAPTIONMIN: Index := 2;
  784. DFCS_CAPTIONRESTORE: Index := 3;
  785. DFCS_CAPTIONCLOSE: Index := 0;
  786. else
  787. Exit;
  788. end;
  789. DrawGlyph(Canvas.Handle, ARect, StockImgList, Index, GetPartColor(ItemInfo, ipText));
  790. end;
  791. procedure TTBXOfficeXPTheme.PaintMenuItemFrame(Canvas: TCanvas;
  792. const ARect: TRect; const ItemInfo: TTBXItemInfo);
  793. var
  794. R: TRect;
  795. begin
  796. R := ARect;
  797. if (ItemInfo.ViewType and PVT_TOOLBOX) <> PVT_TOOLBOX then with Canvas do
  798. begin
  799. R.Right := R.Left + ItemInfo.PopupMargin + 2;
  800. Brush.Color := ToolbarColor;
  801. FillRect(R);
  802. Inc(R.Left);
  803. R.Right := ARect.Right - 1;
  804. end;
  805. PaintFrame(Canvas, R, ItemInfo);
  806. end;
  807. procedure TTBXOfficeXPTheme.PaintMenuItem(Canvas: TCanvas; const ARect: TRect; var ItemInfo: TTBXItemInfo);
  808. var
  809. DC: HDC;
  810. R: TRect;
  811. X, Y: Integer;
  812. ArrowWidth: Integer;
  813. C, ClrText: TColor;
  814. begin
  815. DC := Canvas.Handle;
  816. with ItemInfo do
  817. begin
  818. ArrowWidth := GetSystemMetrics(SM_CXMENUCHECK);
  819. PaintMenuItemFrame(Canvas, ARect, ItemInfo);
  820. ClrText := GetPartColor(ItemInfo, ipText);
  821. R := ARect;
  822. if (ItemOptions and IO_COMBO) <> 0 then
  823. begin
  824. // WinSCP: One pixel to the right (+ 1) to make combos with keyboard accelerator look better.
  825. // This moves the line into hitarea of the arrow (while it was in hitarea of the command originally)
  826. // Further move would require changes in hitarea testing.
  827. X := R.Right - ArrowWidth - 1 + 1;
  828. if not ItemInfo.Enabled then C := ClrText
  829. else if HoverKind = hkMouseHover then C := GetPartColor(ItemInfo, ipFrame)
  830. else C := PopupSeparatorColor;
  831. DrawLineEx(DC, X, R.Top + 1, X, R.Bottom - 1, C);
  832. end;
  833. if (ItemOptions and IO_SUBMENUITEM) <> 0 then
  834. begin
  835. Y := ARect.Bottom div 2;
  836. X := ARect.Right - ArrowWidth * 2 div 3 - 1;
  837. PolygonEx(DC, [Point(X, Y - (ArrowWidth div 5)), Point(X, Y + (ArrowWidth div 5)), Point(X + (ArrowWidth div 5), Y)], ClrText, ClrText);
  838. end;
  839. if Selected and Enabled then
  840. begin
  841. R := ARect;
  842. R.Left := ARect.Left + 1;
  843. R.Right := R.Left + ItemInfo.PopupMargin;
  844. InflateRect(R, -1, -1);
  845. FrameRectEx(DC, R, GetBtnColor(ItemInfo, ipFrame), True);
  846. FillRectEx(DC, R, GetBtnColor(ItemInfo, ipBody));
  847. end;
  848. end;
  849. end;
  850. procedure TTBXOfficeXPTheme.PaintPopupNCArea(Canvas: TCanvas; R: TRect; const PopupInfo: TTBXPopupInfo);
  851. var
  852. PR: TRect;
  853. begin
  854. with Canvas do
  855. begin
  856. Brush.Color := PopupFrameColor;
  857. FrameRect(R);
  858. InflateRect(R, -1, -1);
  859. Brush.Color := PopupColor;
  860. FillRect(R);
  861. if not IsRectEmpty(PopupInfo.ParentRect) then
  862. begin
  863. PR := PopupInfo.ParentRect;
  864. if not IsRectEmpty(PR) then with PR do
  865. begin
  866. Pen.Color := ToolbarColor;
  867. if Bottom = R.Top then
  868. begin
  869. if Left <= R.Left then Left := R.Left - 1;
  870. if Right >= R.Right then Right := R.Right + 1;
  871. MoveTo(Left + 1, Bottom - 1); LineTo(Right - 1, Bottom- 1);
  872. end
  873. else if Top = R.Bottom then
  874. begin
  875. if Left <= R.Left then Left := R.Left - 1;
  876. if Right >= R.Right then Right := R.Right + 1;
  877. MoveTo(Left + 1, Top); LineTo(Right - 1, Top);
  878. end;
  879. if Right = R.Left then
  880. begin
  881. if Top <= R.Top then Top := R.Top - 1;
  882. if Bottom >= R.Bottom then Bottom := R.Bottom + 1;
  883. MoveTo(Right - 1, Top + 1); LineTo(Right - 1, Bottom - 1);
  884. end
  885. else if Left = R.Right then
  886. begin
  887. if Top <= R.Top then Top := R.Top - 1;
  888. if Bottom >= R.Bottom then Bottom := R.Bottom + 1;
  889. MoveTo(Left, Top + 1); LineTo(Left, Bottom - 1);
  890. end;
  891. end;
  892. end;
  893. end;
  894. end;
  895. procedure TTBXOfficeXPTheme.PaintSeparator(Canvas: TCanvas; ARect: TRect;
  896. ItemInfo: TTBXItemInfo; Horizontal, LineSeparator: Boolean);
  897. var
  898. DC: HDC;
  899. IsToolbox: Boolean;
  900. R: TRect;
  901. C: TColor;
  902. begin
  903. { Note: for blank separators, Enabled = False }
  904. DC := Canvas.Handle;
  905. with ItemInfo, ARect do
  906. begin
  907. if Horizontal then
  908. begin
  909. IsToolbox := (ViewType and PVT_TOOLBOX) = PVT_TOOLBOX;
  910. if ((ItemOptions and IO_TOOLBARSTYLE) = 0) and not IsToolBox then
  911. begin
  912. R := ARect;
  913. R.Right := ItemInfo.PopupMargin + 2;
  914. FillRectEx(DC, R, ToolbarColor);
  915. Inc(Left, ItemInfo.PopupMargin + 9);
  916. C := PopupSeparatorColor;
  917. end
  918. else
  919. C := ToolbarSeparatorColor;
  920. Top := (Top + Bottom) div 2;
  921. if Enabled then DrawLineEx(DC, Left, Top, Right, Top, C);
  922. end
  923. else if Enabled then
  924. begin
  925. Left := (Left + Right) div 2;
  926. DrawLineEx(DC, Left, Top, Left, Bottom, ToolbarSeparatorColor);
  927. end;
  928. end;
  929. end;
  930. procedure DrawButtonBitmap(DC: HDC; R: TRect; Color: TColor);
  931. const
  932. {$IFNDEF SMALL_CLOSE_BUTTON}
  933. Pattern: array [0..15] of Byte =
  934. ($C3, 0, $66, 0, $3C, 0, $18, 0, $3C, 0, $66, 0, $C3, 0, 0, 0);
  935. {$ELSE}
  936. Pattern: array [0..15] of Byte =
  937. (0, 0, $63, 0, $36, 0, $1C, 0, $1C, 0, $36, 0, $63, 0, 0, 0);
  938. {$ENDIF}
  939. begin
  940. DrawGlyph(DC, R, 8, 7, Pattern[0], Color);
  941. end;
  942. procedure TTBXOfficeXPTheme.PaintToolbarNCArea(Canvas: TCanvas; R: TRect; const ToolbarInfo: TTBXToolbarInfo);
  943. const
  944. DragHandleOffsets: array [Boolean, DHS_DOUBLE..DHS_SINGLE] of Integer = ((2, 0, 1), (5, 0, 5));
  945. function GetBtnItemState(BtnState: Integer): TBtnItemState;
  946. begin
  947. if (BtnState and CDBS_PRESSED) <> 0 then Result := bisPressed
  948. else if (BtnState and CDBS_HOT) <> 0 then Result := bisHot
  949. else Result := bisNormal;
  950. end;
  951. var
  952. DC: HDC;
  953. Sz: Integer;
  954. R2: TRect;
  955. SaveColor: TColor;
  956. SaveStyle: TBrushStyle;
  957. I: Integer;
  958. BtnVisible, Horz: Boolean;
  959. BtnItemState: TBtnItemState;
  960. Two, Three: Integer;
  961. begin
  962. DC := Canvas.Handle;
  963. with Canvas do
  964. begin
  965. SaveColor := Brush.Color;
  966. SaveStyle := Brush.Style;
  967. if ToolbarInfo.BorderStyle = bsSingle then
  968. begin
  969. I := ColorIntensity(clBtnFace);
  970. if not (TBXLoColor or not (I in [50..254])) or
  971. ((ToolbarInfo.ViewType and TVT_MENUBAR) = TVT_MENUBAR) then
  972. begin
  973. InflateRect(R, -1, -1);
  974. Dec(R.Right); Dec(R.Bottom);
  975. Pen.Color := SaveColor;
  976. Pen.Style := psSolid;
  977. Brush.Color := SaveColor;
  978. Brush.Style := SaveStyle; // should be either bsSolid or bsClear
  979. with R do
  980. Polygon([Point(Left + 1, Top), Point(Right - 1, Top), Point(Right, Top + 1),
  981. Point(Right, Bottom - 1), Point(Right - 1, Bottom), Point(Left + 1, Bottom),
  982. Point(Left, Bottom - 1), Point(Left, Top + 1)]);
  983. Brush.Style := bsSolid;
  984. Inc(R.Left);
  985. Inc(R.Top);
  986. end
  987. else
  988. begin
  989. Brush.Bitmap := AllocPatternBitmap(ToolbarColor, BtnItemColors[bisDisabled, ipText]);
  990. with R do
  991. begin
  992. FillRect(Rect(Left + 1, Top, Right - 1, Top + 1));
  993. FillRect(Rect(Left + 1, Bottom - 1, Right - 1, Bottom));
  994. FillRect(Rect(Left, Top + 1, Left + 1, Bottom - 1));
  995. FillRect(Rect(Right - 1, Top + 1, Right, Bottom - 1));
  996. end;
  997. InflateRect(R, -1, -1);
  998. Brush.Color := SaveColor;
  999. FillRect(R);
  1000. end;
  1001. end
  1002. else
  1003. InflateRect(R, -1, -1);
  1004. InflateRect(R, -1, -1);
  1005. if not ToolbarInfo.AllowDrag then Exit;
  1006. BtnVisible := (ToolbarInfo.CloseButtonState and CDBS_VISIBLE) <> 0;
  1007. Sz := GetTBXDragHandleSize(ToolbarInfo);
  1008. Horz := not ToolbarInfo.IsVertical;
  1009. if Horz then R.Right := R.Left + Sz
  1010. else R.Bottom := R.Top + Sz;
  1011. { Drag Handle }
  1012. if ToolbarInfo.DragHandleStyle <> DHS_NONE then
  1013. begin
  1014. R2 := R;
  1015. // Using DPI scaling instead of text-height scaling because
  1016. // toolbar NC area pieces are already DPI-scaled in
  1017. // TB2Dock initialization section
  1018. Two := MulDiv(2, Screen.PixelsPerInch, USER_DEFAULT_SCREEN_DPI);
  1019. Three := MulDiv(3, Screen.PixelsPerInch, USER_DEFAULT_SCREEN_DPI);
  1020. if Horz then
  1021. begin
  1022. Inc(R2.Left, DragHandleOffsets[BtnVisible, ToolbarInfo.DragHandleStyle]);
  1023. if BtnVisible then Inc(R2.Top, Sz - 2);
  1024. R2.Right := R2.Left + Three;
  1025. end
  1026. else
  1027. begin
  1028. Inc(R2.Top, DragHandleOffsets[BtnVisible, ToolbarInfo.DragHandleStyle]);
  1029. if BtnVisible then Dec(R2.Right, Sz - 2);
  1030. R2.Bottom := R2.Top + Three;
  1031. end;
  1032. Pen.Color := DragHandleColor;
  1033. if Horz then
  1034. begin
  1035. I := R2.Top + Three;
  1036. while I < R2.Bottom - Three do
  1037. begin
  1038. MoveTo(R2.Left, I); LineTo(R2.Right, I);
  1039. Inc(I, Two);
  1040. end;
  1041. end
  1042. else
  1043. begin
  1044. I := R2.Left + Three;
  1045. while I < R2.Right - Three do
  1046. begin
  1047. MoveTo(I, R2.Top); LineTo(I, R2.Bottom);
  1048. Inc(I, Two);
  1049. end;
  1050. end;
  1051. end;
  1052. { Close button }
  1053. if BtnVisible then
  1054. begin
  1055. R2 := R;
  1056. if Horz then
  1057. begin
  1058. Dec(R2.Right);
  1059. R2.Bottom := R2.Top + R2.Right - R2.Left;
  1060. end
  1061. else
  1062. begin
  1063. Dec(R2.Bottom);
  1064. R2.Left := R2.Right - R2.Bottom + R2.Top;
  1065. end;
  1066. BtnItemState := GetBtnItemState(ToolbarInfo.CloseButtonState);
  1067. FrameRectEx(DC, R2, BtnItemColors[BtnItemState, ipFrame], True);
  1068. FillRectEx(DC, R2, BtnItemColors[BtnItemState, ipBody]);
  1069. DrawButtonBitmap(DC, R2, BtnItemColors[BtnItemState, ipText]);
  1070. end;
  1071. end;
  1072. end;
  1073. procedure TTBXOfficeXPTheme.PaintDock(Canvas: TCanvas; const ClientRect,
  1074. DockRect: TRect; DockPosition: Integer);
  1075. begin
  1076. // this theme does not support dock painting
  1077. end;
  1078. procedure TTBXOfficeXPTheme.PaintDockPanelNCArea(Canvas: TCanvas; R: TRect; const DockPanelInfo: TTBXDockPanelInfo);
  1079. function GetBtnItemState(BtnState: Integer): TBtnItemState;
  1080. begin
  1081. if (BtnState and CDBS_PRESSED) <> 0 then Result := bisPressed
  1082. else if (BtnState and CDBS_HOT) <> 0 then Result := bisHot
  1083. else Result := bisNormal;
  1084. end;
  1085. var
  1086. DC: HDC;
  1087. C, HeaderColor: TColor;
  1088. I, Sz, Flags: Integer;
  1089. R2: TRect;
  1090. BtnItemState: TBtnItemState;
  1091. B: HBrush;
  1092. OldBkMode: Cardinal;
  1093. OldFont: HFont;
  1094. OldTextColor: TColorRef;
  1095. begin
  1096. DC := Canvas.Handle;
  1097. with DockPanelInfo do
  1098. begin
  1099. I := ColorIntensity(ColorToRGB(clBtnFace));
  1100. R2 := R;
  1101. if not TBXLoColor and (I in [64..250]) then
  1102. begin
  1103. FrameRectEx(DC, R, clBtnFace, True);
  1104. FrameRectEx(DC, R, EffectiveColor, False);
  1105. with R do
  1106. begin
  1107. C := GetSysColor(COLOR_BTNFACE);
  1108. SetPixelV(DC, Left, Top, C);
  1109. if IsVertical then SetPixelV(DC, Right - 1, Top, C)
  1110. else SetPixelV(DC, Left, Bottom - 1, C);
  1111. end;
  1112. end
  1113. else
  1114. begin
  1115. FrameRectEx(DC, R, EffectiveColor, True);
  1116. if I < 64 then B := CreateDitheredBrush(EffectiveColor, clWhite)
  1117. else B := CreateDitheredBrush(EffectiveColor, clBtnShadow);
  1118. Windows.FrameRect(DC, R, B);
  1119. DeleteObject(B);
  1120. with R do
  1121. begin
  1122. SetPixelV(DC, Left, Top, EffectiveColor);
  1123. if IsVertical then SetPixelV(DC, Right - 1, Top, EffectiveColor)
  1124. else SetPixelV(DC, Left, Bottom - 1, EffectiveColor);
  1125. end;
  1126. InflateRect(R, -1, -1);
  1127. FrameRectEx(DC, R, EffectiveColor, False);
  1128. end;
  1129. R := R2;
  1130. InflateRect(R, -BorderSize.X, -BorderSize.Y);
  1131. Sz := GetSystemMetrics(SM_CYSMCAPTION);
  1132. if IsVertical then
  1133. begin
  1134. R.Bottom := R.Top + Sz - 1;
  1135. DrawLineEx(DC, R.Left, R.Bottom, R.Right, R.Bottom, EffectiveColor);
  1136. end
  1137. else
  1138. begin
  1139. R.Right := R.Left + Sz - 1;
  1140. DrawLineEx(DC, R.Right, R.Top, R.Right, R.Bottom, EffectiveColor);
  1141. end;
  1142. HeaderColor := clBtnFace;
  1143. FillRectEx(DC, R, HeaderColor);
  1144. if (CDBS_VISIBLE and CloseButtonState) <> 0 then
  1145. begin
  1146. R2 := R;
  1147. if IsVertical then
  1148. begin
  1149. R2.Left := R2.Right - Sz + 1;
  1150. R.Right := R2.Left;
  1151. end
  1152. else
  1153. begin
  1154. R2.Top := R2.Bottom - Sz + 1;
  1155. R.Bottom := R2.Top;
  1156. end;
  1157. BtnItemState := GetBtnItemState(CloseButtonState);
  1158. FrameRectEx(DC, R2, BtnItemColors[BtnItemState, ipFrame], True);
  1159. FillRectEx(DC, R2, BtnItemColors[BtnItemState, ipBody]);
  1160. DrawButtonBitmap(DC, R2, BtnItemColors[BtnItemState, ipText]);
  1161. end;
  1162. if IsVertical then InflateRect(R, -4, 0)
  1163. else InflateRect(R, 0, -4);
  1164. OldFont := SelectObject(DC, SmCaptionFont.Handle);
  1165. OldBkMode := SetBkMode(DC, TRANSPARENT);
  1166. OldTextColor := SetTextColor(DC, ColorToRGB(SmCaptionFont.Color));
  1167. Flags := DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS or DT_NOPREFIX;
  1168. if IsVertical then DrawText(DC, Caption, -1, R, Flags)
  1169. else DrawRotatedText(DC, string(Caption), R, Flags);
  1170. SetTextColor(DC, OldTextColor);
  1171. SetBkMode(DC, OldBkMode);
  1172. SelectObject(DC, OldFont);
  1173. end;
  1174. end;
  1175. procedure TTBXOfficeXPTheme.SetupColorCache;
  1176. var
  1177. DC: HDC;
  1178. HotBtnFace, DisabledText: TColor;
  1179. procedure Undither(var C: TColor);
  1180. begin
  1181. if C <> clNone then C := GetNearestColor(DC, ColorToRGB(C));
  1182. end;
  1183. begin
  1184. DC := StockCompatibleBitmap.Canvas.Handle;
  1185. if TBXLoColor then
  1186. begin
  1187. { View/Window Colors }
  1188. MenubarColor := clBtnFace;
  1189. ToolbarColor := clBtnFace;
  1190. PopupColor := clWindow;
  1191. DockPanelColor := clWindow;
  1192. StatusPanelFrameColor := clBtnShadow;
  1193. PopupFrameColor := clBtnText;
  1194. WinFrameColors[wfsActive, wfpBorder] := clBtnShadow;
  1195. WinFrameColors[wfsActive, wfpCaption] := clBtnShadow;
  1196. WinFrameColors[wfsActive, wfpCaptionText] := clBtnHighlight;
  1197. WinFrameColors[wfsInactive, wfpBorder] := clBtnShadow;
  1198. WinFrameColors[wfsInactive, wfpCaption] := clBtnShadow;
  1199. WinFrameColors[wfsInactive, wfpCaptionText] := clBtnHighlight;
  1200. PnlFrameColors[wfsActive, wfpBorder] := clBtnShadow;
  1201. PnlFrameColors[wfsActive, wfpCaption] := clBtnFace;
  1202. PnlFrameColors[wfsActive, wfpCaptionText] := clBtnText;
  1203. PnlFrameColors[wfsInactive, wfpBorder] := clBtnShadow;
  1204. PnlFrameColors[wfsInactive, wfpCaption] := clBtnFace;
  1205. PnlFrameColors[wfsInactive, wfpCaptionText] := clBtnText;
  1206. MenuItemColors[misNormal, ipBody] := clNone;
  1207. MenuItemColors[misNormal, ipText] := clWindowText;
  1208. MenuItemColors[misNormal, ipFrame] := clNone;
  1209. MenuItemColors[misDisabled, ipBody] := clNone;
  1210. MenuItemColors[misDisabled, ipText] := clGrayText;
  1211. MenuItemColors[misDisabled, ipFrame] := clNone;
  1212. MenuItemColors[misHot, ipBody] := clWindow;
  1213. MenuItemColors[misHot, ipText] := clWindowtext;
  1214. MenuItemColors[misHot, ipFrame] := clHighlight;
  1215. MenuItemColors[misDisabledHot, ipBody] := clWindow;
  1216. MenuItemColors[misDisabledHot, ipText] := clGrayText;
  1217. MenuItemColors[misDisabledHot, ipFrame] := clHighlight;
  1218. BtnItemColors[bisNormal, ipBody] := clNone;
  1219. BtnItemColors[bisNormal, ipText] := clBtnText;
  1220. BtnItemColors[bisNormal, ipFrame] := clNone;
  1221. BtnItemColors[bisDisabled, ipBody] := clNone;
  1222. BtnItemColors[bisDisabled, ipText] := clBtnShadow;
  1223. BtnItemColors[bisDisabled, ipFrame] := clNone;
  1224. BtnItemColors[bisSelected, ipBody] := clWindow;
  1225. BtnItemColors[bisSelected, ipText] := clWindowText;
  1226. BtnItemColors[bisSelected, ipFrame] := clHighlight;
  1227. BtnItemColors[bisPressed, ipBody] := clHighlight;
  1228. BtnItemColors[bisPressed, ipText] := clHighlightText;
  1229. BtnItemColors[bisPressed, ipFrame] := clHighlight;
  1230. BtnItemColors[bisHot, ipBody] := clWindow;
  1231. BtnItemColors[bisHot, ipText] := clWindowText;
  1232. BtnItemColors[bisHot, ipFrame] := clHighlight;
  1233. BtnItemColors[bisDisabledHot, ipBody] := clWindow;
  1234. BtnItemColors[bisDisabledHot, ipText] := clBtnShadow;
  1235. BtnItemColors[bisDisabledHot, ipFrame] := clHighlight;
  1236. BtnItemColors[bisSelectedHot, ipBody] := clHighlight;
  1237. BtnItemColors[bisSelectedHot, ipText] := clHighlightText;
  1238. BtnItemColors[bisSelectedHot, ipFrame] := clHighlight;
  1239. BtnItemColors[bisPopupParent, ipBody] := clBtnFace;
  1240. BtnItemColors[bisPopupParent, ipText] := clBtnText;
  1241. BtnItemColors[bisPopupParent, ipFrame] := PopupFrameColor;
  1242. { Other Colors }
  1243. DragHandleColor := clBtnText;
  1244. IconShadowColor := clBtnFace;
  1245. PopupSeparatorColor := clBtnShadow;
  1246. ToolbarSeparatorColor := clBtnShadow;
  1247. end
  1248. else
  1249. begin
  1250. { View/Window Colors }
  1251. MenubarColor := clBtnFace;
  1252. ToolbarColor := Blend(clWindow, clBtnFace, 165);
  1253. PopupColor := Blend(clBtnFace, clWindow, 143);
  1254. DockPanelColor := PopupColor;
  1255. PopupFrameColor := Blend(clBtnText, clBtnShadow, 20);
  1256. SetContrast(PopupFrameColor, PopupColor, 100);
  1257. HotBtnFace := Blend(clHighlight, clWindow, 30);
  1258. SetContrast(HotBtnFace, ToolbarColor, 50);
  1259. DisabledText := Blend(clBtnshadow, clWindow, 90);
  1260. WinFrameColors[wfsActive, wfpBorder] := Blend(clBtnText, clBtnShadow, 15);
  1261. SetContrast(WinFrameColors[wfsActive, wfpBorder], ToolbarColor, 120);
  1262. WinFrameColors[wfsActive, wfpCaption] := clBtnShadow;
  1263. WinFrameColors[wfsActive, wfpCaptionText] := clBtnHighlight;
  1264. SetContrast(WinFrameColors[wfsActive, wfpCaptionText], clBtnShadow, 180);
  1265. WinFrameColors[wfsInactive, wfpBorder] := WinFrameColors[wfsActive, wfpBorder];
  1266. WinFrameColors[wfsInactive, wfpCaption] := clBtnFace;
  1267. WinFrameColors[wfsInactive, wfpCaptionText] := DisabledText;
  1268. SetContrast(WinFrameColors[wfsInactive, wfpCaptionText], clBtnFace, 120);
  1269. PnlFrameColors[wfsActive, wfpBorder] := clBtnShadow;
  1270. PnlFrameColors[wfsActive, wfpCaption] := clBtnFace;
  1271. PnlFrameColors[wfsActive, wfpCaptionText] := clBtnText;
  1272. PnlFrameColors[wfsInactive, wfpBorder] := clBtnShadow;
  1273. PnlFrameColors[wfsInactive, wfpCaption] := clBtnFace;
  1274. PnlFrameColors[wfsInactive, wfpCaptionText] := DisabledText;
  1275. SetContrast(PnlFrameColors[wfsInactive, wfpCaptionText], clBtnFace, 120);
  1276. BtnItemColors[bisNormal, ipBody] := clNone;
  1277. BtnItemColors[bisNormal, ipText] := clBtnText;
  1278. SetContrast(BtnItemColors[bisNormal, ipText], ToolbarColor, 180);
  1279. BtnItemColors[bisNormal, ipFrame] := clNone;
  1280. BtnItemColors[bisDisabled, ipBody] := clNone;
  1281. BtnItemColors[bisDisabled, ipText] := DisabledText;
  1282. SetContrast(BtnItemColors[bisDisabled, ipText], ToolbarColor, 80);
  1283. BtnItemColors[bisDisabled, ipFrame] := clNone;
  1284. BtnItemColors[bisSelected, ipBody] := Blend(clHighlight, Blend(clBtnFace, clWindow, 50), 10);
  1285. SetContrast(BtnItemColors[bisSelected, ipBody], ToolbarColor, 5);
  1286. BtnItemColors[bisSelected, ipText] := BtnItemColors[bisNormal, ipText];
  1287. BtnItemColors[bisSelected, ipFrame] := clHighlight;
  1288. BtnItemColors[bisPressed, ipBody] := Blend(clHighlight, clWindow, 50);
  1289. BtnItemColors[bisPressed, ipText] := clHighlightText;
  1290. BtnItemColors[bisPressed, ipFrame] := clHighlight;
  1291. BtnItemColors[bisHot, ipBody] := HotBtnFace;
  1292. BtnItemColors[bisHot, ipText] := clMenuText;
  1293. SetContrast(BtnItemColors[bisHot, ipText], BtnItemColors[bisHot, ipBody], 180);
  1294. BtnItemColors[bisHot, ipFrame] := clHighlight;
  1295. SetContrast(BtnItemColors[bisHot, ipFrame], ToolbarColor, 100);
  1296. BtnItemColors[bisDisabledHot, ipBody] := HotBtnFace;
  1297. BtnItemColors[bisDisabledHot, ipText] := DisabledText;
  1298. BtnItemColors[bisDisabledHot, ipFrame] := clHighlight;
  1299. BtnItemColors[bisSelectedHot, ipBody] := Blend(clHighlight, clWindow, 50);
  1300. SetContrast(BtnItemColors[bisSelectedHot, ipBody], ToolbarColor, 30);
  1301. BtnItemColors[bisSelectedHot, ipText] := clHighlightText;
  1302. SetContrast(BtnItemColors[bisSelectedHot, ipText], BtnItemColors[bisSelectedHot, ipBody], 180);
  1303. BtnItemColors[bisSelectedHot, ipFrame] := clHighlight;
  1304. SetContrast(BtnItemColors[bisSelectedHot, ipFrame], BtnItemColors[bisSelectedHot, ipBody], 100);
  1305. BtnItemColors[bisPopupParent, ipBody] := ToolbarColor;
  1306. BtnItemColors[bisPopupParent, ipText] := BtnItemColors[bisNormal, ipText];
  1307. BtnItemColors[bisPopupParent, ipFrame] := PopupFrameColor;
  1308. MenuItemColors[misNormal, ipBody] := clNone;
  1309. MenuItemColors[misNormal, ipText] := clWindowText;
  1310. SetContrast(MenuItemColors[misNormal, ipText], PopupColor, 180);
  1311. MenuItemColors[misNormal, ipFrame] := clNone;
  1312. MenuItemColors[misDisabled, ipBody] := clNone;
  1313. MenuItemColors[misDisabled, ipText] := Blend(clGrayText, clWindow, 70);
  1314. SetContrast(MenuItemColors[misDisabled, ipText], PopupColor, 80); // 145?
  1315. MenuItemColors[misDisabled, ipFrame] := clNone;
  1316. MenuItemColors[misHot, ipBody] := BtnItemColors[bisHot, ipBody];
  1317. MenuItemColors[misHot, ipText] := BtnItemColors[bisHot, ipText];
  1318. MenuItemColors[misHot, ipFrame] := BtnItemColors[bisHot, ipFrame];
  1319. MenuItemColors[misDisabledHot, ipBody] := PopupColor;
  1320. MenuItemColors[misDisabledHot, ipText] := Blend(clGrayText, clWindow, 70);
  1321. MenuItemColors[misDisabledHot, ipFrame] := clHighlight;
  1322. { Other Colors }
  1323. DragHandleColor := Blend(clBtnShadow, clWindow, 75);
  1324. SetContrast(DragHandleColor, ToolbarColor, 85);
  1325. IconShadowColor := Blend(clBlack, HotBtnFace, 25);
  1326. ToolbarSeparatorColor := Blend(clBtnShadow, clWindow, 70);
  1327. SetContrast(ToolbarSeparatorColor, ToolbarColor, 50);
  1328. PopupSeparatorColor := ToolbarSeparatorColor;
  1329. StatusPanelFrameColor := Blend(clWindow, clBtnFace, 30);
  1330. SetContrast(StatusPanelFrameColor, clBtnFace, 30);
  1331. Undither(MenubarColor);
  1332. Undither(ToolbarColor);
  1333. Undither(PopupColor);
  1334. Undither(DockPanelColor);
  1335. Undither(PopupFrameColor);
  1336. Undither(WinFrameColors[wfsActive, wfpBorder]);
  1337. Undither(WinFrameColors[wfsActive, wfpCaption]);
  1338. Undither(WinFrameColors[wfsActive, wfpCaptionText]);
  1339. Undither(WinFrameColors[wfsInactive, wfpBorder]);
  1340. Undither(WinFrameColors[wfsInactive, wfpCaption]);
  1341. Undither(WinFrameColors[wfsInactive, wfpCaptionText]);
  1342. Undither(PnlFrameColors[wfsActive, wfpBorder]);
  1343. Undither(PnlFrameColors[wfsActive, wfpCaption]);
  1344. Undither(PnlFrameColors[wfsActive, wfpCaptionText]);
  1345. Undither(PnlFrameColors[wfsInactive, wfpBorder]);
  1346. Undither(PnlFrameColors[wfsInactive, wfpCaption]);
  1347. Undither(PnlFrameColors[wfsInactive, wfpCaptionText]);
  1348. Undither(BtnItemColors[bisNormal, ipBody]);
  1349. Undither(BtnItemColors[bisNormal, ipText]);
  1350. Undither(BtnItemColors[bisNormal, ipFrame]);
  1351. Undither(BtnItemColors[bisDisabled, ipBody]);
  1352. Undither(BtnItemColors[bisDisabled, ipText]);
  1353. Undither(BtnItemColors[bisDisabled, ipFrame]);
  1354. Undither(BtnItemColors[bisSelected, ipBody]);
  1355. Undither(BtnItemColors[bisSelected, ipText]);
  1356. Undither(BtnItemColors[bisSelected, ipFrame]);
  1357. Undither(BtnItemColors[bisPressed, ipBody]);
  1358. Undither(BtnItemColors[bisPressed, ipText]);
  1359. Undither(BtnItemColors[bisPressed, ipFrame]);
  1360. Undither(BtnItemColors[bisHot, ipBody]);
  1361. Undither(BtnItemColors[bisHot, ipText]);
  1362. Undither(BtnItemColors[bisHot, ipFrame]);
  1363. Undither(BtnItemColors[bisDisabledHot, ipBody]);
  1364. Undither(BtnItemColors[bisDisabledHot, ipText]);
  1365. Undither(BtnItemColors[bisDisabledHot, ipFrame]);
  1366. Undither(BtnItemColors[bisSelectedHot, ipBody]);
  1367. Undither(BtnItemColors[bisSelectedHot, ipText]);
  1368. Undither(BtnItemColors[bisSelectedHot, ipFrame]);
  1369. Undither(BtnItemColors[bisPopupParent, ipBody]);
  1370. Undither(BtnItemColors[bisPopupParent, ipText]);
  1371. Undither(BtnItemColors[bisPopupParent, ipFrame]);
  1372. Undither(MenuItemColors[misNormal, ipBody]);
  1373. Undither(MenuItemColors[misNormal, ipText]);
  1374. Undither(MenuItemColors[misNormal, ipFrame]);
  1375. Undither(MenuItemColors[misDisabled, ipBody]);
  1376. Undither(MenuItemColors[misDisabled, ipText]);
  1377. Undither(MenuItemColors[misDisabled, ipFrame]);
  1378. Undither(MenuItemColors[misHot, ipBody]);
  1379. Undither(MenuItemColors[misHot, ipText]);
  1380. Undither(MenuItemColors[misHot, ipFrame]);
  1381. Undither(MenuItemColors[misDisabledHot, ipBody]);
  1382. Undither(MenuItemColors[misDisabledHot, ipText]);
  1383. Undither(MenuItemColors[misDisabledHot, ipFrame]);
  1384. Undither(DragHandleColor);
  1385. Undither(IconShadowColor);
  1386. Undither(ToolbarSeparatorColor);
  1387. Undither(PopupSeparatorColor);
  1388. Undither(StatusPanelFrameColor);
  1389. end;
  1390. end;
  1391. function TTBXOfficeXPTheme.GetPopupShadowType: Integer;
  1392. begin
  1393. Result := PST_OFFICEXP;
  1394. end;
  1395. constructor TTBXOfficeXPTheme.Create(const AName: string);
  1396. begin
  1397. inherited;
  1398. if CounterLock = 0 then InitializeStock;
  1399. Inc(CounterLock);
  1400. AddTBXSysChangeNotification(Self);
  1401. SetupColorCache;
  1402. end;
  1403. destructor TTBXOfficeXPTheme.Destroy;
  1404. begin
  1405. RemoveTBXSysChangeNotification(Self);
  1406. Dec(CounterLock);
  1407. if CounterLock = 0 then FinalizeStock;
  1408. inherited;
  1409. end;
  1410. procedure TTBXOfficeXPTheme.GetViewMargins(ViewType: Integer; out Margins: TTBXMargins);
  1411. begin
  1412. Margins.LeftWidth := 0;
  1413. Margins.TopHeight := 0;
  1414. Margins.RightWidth := 0;
  1415. Margins.BottomHeight := 0;
  1416. end;
  1417. procedure TTBXOfficeXPTheme.PaintPageScrollButton(Canvas: TCanvas;
  1418. const ARect: TRect; ButtonType: Integer; Hot: Boolean);
  1419. var
  1420. DC: HDC;
  1421. R: TRect;
  1422. X, Y, Sz: Integer;
  1423. C: TColor;
  1424. begin
  1425. DC := Canvas.Handle;
  1426. R := ARect;
  1427. if Hot then C := BtnItemColors[bisHot, ipFrame]
  1428. else C := clBtnShadow;
  1429. FrameRectEx(DC, R, C, False);
  1430. InflateRect(R, -1, -1);
  1431. if Hot then C := BtnItemColors[bisHot, ipBody]
  1432. else C := clBtnFace;
  1433. FillRectEx(DC, R, C);
  1434. X := (R.Left + R.Right) div 2;
  1435. Y := (R.Top + R.Bottom) div 2;
  1436. Sz := Min(X - R.Left, Y - R.Top) * 3 div 4;
  1437. if Hot then C := BtnItemColors[bisHot, ipText]
  1438. else C := BtnItemColors[bisNormal, ipText];
  1439. case ButtonType of
  1440. PSBT_UP:
  1441. begin
  1442. Inc(Y, Sz div 2);
  1443. PolygonEx(DC, [Point(X + Sz, Y), Point(X, Y - Sz), Point(X - Sz, Y)], C, C);
  1444. end;
  1445. PSBT_DOWN:
  1446. begin
  1447. Y := (R.Top + R.Bottom - 1) div 2;
  1448. Dec(Y, Sz div 2);
  1449. PolygonEx(DC, [Point(X + Sz, Y), Point(X, Y + Sz), Point(X - Sz, Y)], C, C);
  1450. end;
  1451. PSBT_LEFT:
  1452. begin
  1453. Inc(X, Sz div 2);
  1454. PolygonEx(DC, [Point(X, Y + Sz), Point(X - Sz, Y), Point(X, Y - Sz)], C, C);
  1455. end;
  1456. PSBT_RIGHT:
  1457. begin
  1458. X := (R.Left + R.Right - 1) div 2;
  1459. Dec(X, Sz div 2);
  1460. PolygonEx(DC, [Point(X, Y + Sz), Point(X + Sz, Y), Point(X, Y - Sz)], C, C);
  1461. end;
  1462. end;
  1463. end;
  1464. procedure TTBXOfficeXPTheme.PaintFrameControl(Canvas: TCanvas; R: TRect; Kind, State: Integer; Params: Pointer);
  1465. var
  1466. DC: HDC;
  1467. X, Y: Integer;
  1468. Pen, OldPen: HPen;
  1469. Brush, OldBrush: HBrush;
  1470. C: TColor;
  1471. function GetPenColor: TColor;
  1472. begin
  1473. if Boolean(State and PFS_DISABLED) then Result := clBtnShadow
  1474. else if Boolean(State and PFS_PUSHED) then Result := BtnItemColors[bisPressed, ipFrame]
  1475. else if Boolean(State and PFS_HOT) then Result := BtnItemColors[bisHot, ipFrame]
  1476. else Result := clBtnShadow;
  1477. end;
  1478. function GetBrush: HBrush;
  1479. begin
  1480. if Boolean(State and PFS_DISABLED) then Result := CreateBrushEx(clNone)
  1481. else if Boolean(State and PFS_PUSHED) then Result := CreateBrushEx(BtnItemColors[bisPressed, ipBody])
  1482. else if Boolean(State and PFS_HOT) then Result := CreateBrushEx(BtnItemColors[bisHot, ipBody])
  1483. else if Boolean(State and PFS_MIXED) then Result := CreateDitheredBrush(clWindow, clBtnFace)
  1484. else Result := CreateBrushEx(clNone);
  1485. end;
  1486. function GetTextColor: TColor;
  1487. begin
  1488. if Boolean(State and PFS_DISABLED) then Result := BtnItemColors[bisDisabled, ipText]
  1489. else if Boolean(State and PFS_PUSHED) then Result := BtnItemColors[bisPressed, ipText]
  1490. else if Boolean(State and PFS_MIXED) then Result := clBtnShadow
  1491. else if Boolean(State and PFS_HOT) then Result := BtnItemColors[bisHot, ipText]
  1492. else Result := BtnItemColors[bisNormal, ipText];
  1493. end;
  1494. begin
  1495. DC := Canvas.Handle;
  1496. case Kind of
  1497. PFC_CHECKBOX:
  1498. begin
  1499. InflateRect(R, -1, -1);
  1500. FrameRectEx(DC, R, GetPenColor, True);
  1501. Brush := GetBrush;
  1502. Windows.FillRect(DC, R, Brush);
  1503. DeleteObject(Brush);
  1504. InflateRect(R, 1, 1);
  1505. if Boolean(State and (PFS_CHECKED or PFS_MIXED)) then
  1506. begin
  1507. X := (R.Left + R.Right) div 2 - 1;
  1508. Y := (R.Top + R.Bottom) div 2 + 1;
  1509. C := GetTextColor;
  1510. PolygonEx(DC, [Point(X-2, Y), Point(X, Y+2), Point(X+4, Y-2),
  1511. Point(X+4, Y-4), Point(X, Y), Point(X-2, Y-2), Point(X-2, Y)], C, C);
  1512. end;
  1513. end;
  1514. PFC_RADIOBUTTON:
  1515. begin
  1516. InflateRect(R, -1, -1);
  1517. with R do
  1518. begin
  1519. Brush := GetBrush;
  1520. OldBrush := SelectObject(DC, Brush);
  1521. Pen := CreatePenEx(GetPenColor);
  1522. OldPen := SelectObject(DC, Pen);
  1523. Windows.Ellipse(DC, Left, Top, Right, Bottom);
  1524. SelectObject(DC, OldPen);
  1525. DeleteObject(Pen);
  1526. SelectObject(DC, OldBrush);
  1527. DeleteObject(Brush);
  1528. end;
  1529. if Boolean(State and PFS_CHECKED) then
  1530. begin
  1531. InflateRect(R, -3, -3);
  1532. C := GetTextColor;
  1533. Brush := CreateBrushEx(C);
  1534. OldBrush := SelectObject(DC, Brush);
  1535. Pen := CreatePenEx(C);
  1536. OldPen := SelectObject(DC, Pen);
  1537. with R do Windows.Ellipse(DC, Left, Top, Right, Bottom);
  1538. SelectObject(DC, OldPen);
  1539. DeleteObject(Pen);
  1540. SelectObject(DC, OldBrush);
  1541. DeleteObject(Brush);
  1542. end;
  1543. end;
  1544. end;
  1545. end;
  1546. procedure TTBXOfficeXPTheme.PaintStatusBar(Canvas: TCanvas; R: TRect; Part: Integer);
  1547. var
  1548. D: Integer;
  1549. DC: HDC;
  1550. procedure DiagLine(C: TColor);
  1551. begin
  1552. with R do
  1553. DrawLineEx(DC, Right - 1 - D, Bottom - 1, Right, Bottom - D - 2, C);
  1554. Inc(D);
  1555. end;
  1556. begin
  1557. DC := Canvas.Handle;
  1558. case Part of
  1559. SBP_BODY:
  1560. begin
  1561. FillRectEx(DC, R, clBtnFace);
  1562. end;
  1563. SBP_PANE, SBP_LASTPANE:
  1564. begin
  1565. if Part = SBP_PANE then Dec(R.Right, 2);
  1566. FrameRectEx(DC, R, StatusPanelFrameColor, False);
  1567. end;
  1568. SBP_GRIPPER:
  1569. begin
  1570. Inc(R.Right);
  1571. DrawThemeBackground(STATUSBAR_THEME, DC, SP_GRIPPER, 0, R, nil)
  1572. end;
  1573. end;
  1574. end;
  1575. procedure TTBXOfficeXPTheme.TBXSysCommand(var Message: TMessage);
  1576. begin
  1577. if Message.WParam = TSC_VIEWCHANGE then SetupColorCache;
  1578. end;
  1579. end.