bgracustomdrawn.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026
  1. // SPDX-License-Identifier: LGPL-3.0-linking-exception
  2. {******************************* CONTRIBUTOR(S) ******************************
  3. - Edivando S. Santos Brasil | [email protected]
  4. (Compatibility with delphi VCL 11/2018)
  5. ***************************** END CONTRIBUTOR(S) *****************************}
  6. unit BGRACustomDrawn;
  7. {$I bgracontrols.inc}
  8. interface
  9. uses
  10. Classes, Types, FPCanvas, Graphics, Controls, Math, LazUTF8, Forms, ExtCtrls,
  11. {$IFNDEF FPC}BGRAGraphics, GraphType, FPImage, {$ENDIF}
  12. BCThemeManager,
  13. { CustomDrawn }
  14. CustomDrawnControls, CustomDrawnDrawers, CustomDrawn_Common,
  15. { BGRABitmap }
  16. BGRABitmap, BGRABitmapTypes, BGRAGradients;
  17. type
  18. { TBCDButton }
  19. TBCDButton = class(TCDButton)
  20. private
  21. FBCThemeManager: TBCThemeManager;
  22. procedure SetFBCThemeManager(AValue: TBCThemeManager);
  23. published
  24. property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager;
  25. end;
  26. { TBCDEdit }
  27. TBCDEdit = class(TCDEdit)
  28. private
  29. FBCThemeManager: TBCThemeManager;
  30. procedure SetFBCThemeManager(AValue: TBCThemeManager);
  31. published
  32. property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager;
  33. end;
  34. { TBCDStaticText }
  35. TBCDStaticText = class(TCDStaticText)
  36. private
  37. FBCThemeManager: TBCThemeManager;
  38. procedure SetFBCThemeManager(AValue: TBCThemeManager);
  39. published
  40. property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager;
  41. end;
  42. { TBCDProgressBar }
  43. TBCDProgressBar = class(TCDProgressBar)
  44. private
  45. FBCThemeManager: TBCThemeManager;
  46. procedure SetFBCThemeManager(AValue: TBCThemeManager);
  47. public
  48. constructor Create(AOwner: TComponent); override;
  49. published
  50. property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager;
  51. end;
  52. { TBCDSpinEdit }
  53. TBCDSpinEdit = class(TCDSpinEdit)
  54. private
  55. FBCThemeManager: TBCThemeManager;
  56. procedure SetFBCThemeManager(AValue: TBCThemeManager);
  57. published
  58. property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager;
  59. end;
  60. { TBCDCheckBox }
  61. TBCDCheckBox = class(TCDCheckBox)
  62. private
  63. FBCThemeManager: TBCThemeManager;
  64. procedure SetFBCThemeManager(AValue: TBCThemeManager);
  65. published
  66. property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager;
  67. end;
  68. { TBCDRadioButton }
  69. TBCDRadioButton = class(TCDRadioButton)
  70. private
  71. FBCThemeManager: TBCThemeManager;
  72. procedure SetFBCThemeManager(AValue: TBCThemeManager);
  73. published
  74. property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager;
  75. end;
  76. { TBCDPanel }
  77. TBCDPanel = class(TPanel)
  78. private
  79. FBCThemeManager: TBCThemeManager;
  80. FDarkTheme: boolean;
  81. procedure SetFBCThemeManager(AValue: TBCThemeManager);
  82. procedure SetFDarkTheme(AValue: boolean);
  83. protected
  84. procedure Paint; override;
  85. public
  86. constructor Create(TheOwner: TComponent); override;
  87. published
  88. property DarkTheme: boolean read FDarkTheme write SetFDarkTheme default True;
  89. published
  90. property Align;
  91. property Alignment;
  92. property Anchors;
  93. property AutoSize;
  94. property BorderSpacing;
  95. property BevelInner;
  96. property BevelOuter;
  97. property BevelWidth;
  98. property BidiMode;
  99. property BorderWidth;
  100. property BorderStyle;
  101. property Caption;
  102. property ChildSizing;
  103. property ClientHeight;
  104. property ClientWidth;
  105. property Color;
  106. property Constraints;
  107. property DockSite;
  108. property DragCursor;
  109. property DragKind;
  110. property DragMode;
  111. property Enabled;
  112. property Font;
  113. property FullRepaint;
  114. property ParentBidiMode;
  115. property ParentColor;
  116. property ParentFont;
  117. property ParentShowHint;
  118. property PopupMenu;
  119. property ShowHint;
  120. property TabOrder;
  121. property TabStop;
  122. property UseDockManager default True;
  123. property Visible;
  124. property OnClick;
  125. property OnContextPopup;
  126. property OnDockDrop;
  127. property OnDockOver;
  128. property OnDblClick;
  129. property OnDragDrop;
  130. property OnDragOver;
  131. property OnEndDock;
  132. property OnEndDrag;
  133. property OnEnter;
  134. property OnExit;
  135. property OnGetSiteInfo;
  136. property OnGetDockCaption;
  137. property OnMouseDown;
  138. property OnMouseEnter;
  139. property OnMouseLeave;
  140. property OnMouseMove;
  141. property OnMouseUp;
  142. property OnMouseWheel;
  143. property OnMouseWheelDown;
  144. property OnMouseWheelUp;
  145. property OnPaint;
  146. property OnResize;
  147. property OnStartDock;
  148. property OnStartDrag;
  149. property OnUnDock;
  150. published
  151. property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager;
  152. end;
  153. { TBGRADrawer }
  154. TBGRADrawer = class(TCDDrawerCommon)
  155. private
  156. FRandSeed: integer;
  157. protected
  158. procedure AssignFont(Bitmap: TBGRABitmap; Font: TFont);
  159. public
  160. constructor Create; override;
  161. { General }
  162. function GetMeasures(AMeasureID: integer): integer; override;
  163. procedure DrawTickmark(ADest: TFPCustomCanvas; ADestPos: TPoint;
  164. AState: TCDControlState); override;
  165. function DPIAdjustment(const AValue: integer): integer;
  166. { Button }
  167. procedure DrawButton(ADest: TFPCustomCanvas; ADestPos: TPoint;
  168. ASize: TSize; AState: TCDControlState; AStateEx: TCDButtonStateEx); override;
  169. { Edit }
  170. procedure DrawEditBackground(ADest: TCanvas; ADestPos: TPoint;
  171. ASize: TSize; AState: TCDControlState; {%H-}AStateEx: TCDEditStateEx); override;
  172. procedure DrawEditFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
  173. AState: TCDControlState; {%H-}AStateEx: TCDEditStateEx); override;
  174. procedure DrawCaret(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
  175. AState: TCDControlState; AStateEx: TCDEditStateEx); override;
  176. procedure DrawEdit(ADest: TCanvas; ASize: TSize; AState: TCDControlState;
  177. AStateEx: TCDEditStateEx); override;
  178. { Panel }
  179. procedure DrawPanel(ADest: TCanvas; ASize: TSize; {%H-}AState: TCDControlState;
  180. {%H-}AStateEx: TCDPanelStateEx); override;
  181. { Static Text }
  182. procedure DrawStaticText(ADest: TCanvas; ASize: TSize;
  183. AState: TCDControlState; AStateEx: TCDControlStateEx); override;
  184. { Progress Bar }
  185. procedure DrawProgressBar(ADest: TCanvas; ASize: TSize;
  186. {%H-}AState: TCDControlState; AStateEx: TCDProgressBarStateEx); override;
  187. { CheckBox }
  188. procedure DrawCheckBoxSquare(ADest: TCanvas; ADestPos: TPoint;
  189. ASize: TSize; AState: TCDControlState; {%H-}AStateEx: TCDControlStateEx); override;
  190. procedure DrawCheckBox(ADest: TCanvas; ASize: TSize;
  191. AState: TCDControlState; AStateEx: TCDControlStateEx); override;
  192. { RadioButton }
  193. procedure DrawRadioButtonCircle(ADest: TCanvas; {%H-}ADestPos: TPoint;
  194. {%H-}ASize: TSize; AState: TCDControlState; {%H-}AStateEx: TCDControlStateEx); override;
  195. procedure DrawRadioButton(ADest: TCanvas; ASize: TSize;
  196. AState: TCDControlState; AStateEx: TCDControlStateEx); override;
  197. end;
  198. {$IFDEF FPC}procedure Register;{$ENDIF}
  199. implementation
  200. {$IFDEF FPC}procedure Register;
  201. begin
  202. RegisterComponents('BGRA Custom Drawn', [TBCDButton, TBCDEdit,
  203. TBCDStaticText, TBCDProgressBar, TBCDSpinEdit, TBCDCheckBox,
  204. TBCDRadioButton, TBCDPanel]);
  205. end;
  206. {$ENDIF}
  207. { TBCDRadioButton }
  208. procedure TBCDRadioButton.SetFBCThemeManager(AValue: TBCThemeManager);
  209. begin
  210. if FBCThemeManager = AValue then
  211. Exit;
  212. FBCThemeManager := AValue;
  213. end;
  214. { TBCDCheckBox }
  215. procedure TBCDCheckBox.SetFBCThemeManager(AValue: TBCThemeManager);
  216. begin
  217. if FBCThemeManager = AValue then
  218. Exit;
  219. FBCThemeManager := AValue;
  220. end;
  221. { TBCDSpinEdit }
  222. procedure TBCDSpinEdit.SetFBCThemeManager(AValue: TBCThemeManager);
  223. begin
  224. if FBCThemeManager = AValue then
  225. Exit;
  226. FBCThemeManager := AValue;
  227. end;
  228. { TBCDStaticText }
  229. procedure TBCDStaticText.SetFBCThemeManager(AValue: TBCThemeManager);
  230. begin
  231. if FBCThemeManager = AValue then
  232. Exit;
  233. FBCThemeManager := AValue;
  234. end;
  235. { TBCDEdit }
  236. procedure TBCDEdit.SetFBCThemeManager(AValue: TBCThemeManager);
  237. begin
  238. if FBCThemeManager = AValue then
  239. Exit;
  240. FBCThemeManager := AValue;
  241. end;
  242. { TBCDButton }
  243. procedure TBCDButton.SetFBCThemeManager(AValue: TBCThemeManager);
  244. begin
  245. if FBCThemeManager = AValue then
  246. Exit;
  247. FBCThemeManager := AValue;
  248. end;
  249. { TBCDPanel }
  250. procedure TBCDPanel.SetFDarkTheme(AValue: boolean);
  251. begin
  252. if FDarkTheme = AValue then
  253. Exit;
  254. FDarkTheme := AValue;
  255. Invalidate;
  256. end;
  257. procedure TBCDPanel.SetFBCThemeManager(AValue: TBCThemeManager);
  258. begin
  259. if FBCThemeManager = AValue then
  260. Exit;
  261. FBCThemeManager := AValue;
  262. end;
  263. procedure TBCDPanel.Paint;
  264. begin
  265. if DarkTheme then
  266. begin
  267. if BevelOuter <> bvNone then
  268. begin
  269. Canvas.Pen.Color := RGBToColor(40, 40, 40);
  270. Canvas.Brush.Color := RGBToColor(83, 83, 83);
  271. Canvas.Rectangle(0, 0, Width, Height);
  272. Canvas.Pen.Color := RGBToColor(106, 106, 106);
  273. Canvas.Line(1, 1, Width - 1, 1);
  274. end
  275. else
  276. begin
  277. Canvas.Pen.Color := RGBToColor(83, 83, 83);
  278. Canvas.Brush.Color := RGBToColor(83, 83, 83);
  279. Canvas.Rectangle(0, 0, Width, Height);
  280. end;
  281. end
  282. else
  283. inherited Paint;
  284. end;
  285. constructor TBCDPanel.Create(TheOwner: TComponent);
  286. begin
  287. inherited Create(TheOwner);
  288. FDarkTheme := True;
  289. end;
  290. { TBCDProgressBar }
  291. procedure TBCDProgressBar.SetFBCThemeManager(AValue: TBCThemeManager);
  292. begin
  293. if FBCThemeManager = AValue then
  294. Exit;
  295. FBCThemeManager := AValue;
  296. end;
  297. constructor TBCDProgressBar.Create(AOwner: TComponent);
  298. begin
  299. inherited Create(AOwner);
  300. Color := BGRA(102, 163, 226);
  301. end;
  302. { TBGRADrawer }
  303. procedure TBGRADrawer.AssignFont(Bitmap: TBGRABitmap; Font: TFont);
  304. begin
  305. Bitmap.FontName := Font.Name;
  306. Bitmap.FontStyle := Font.Style;
  307. Bitmap.FontHeight := Font.Height;
  308. Bitmap.FontQuality := fqSystemClearType;
  309. end;
  310. constructor TBGRADrawer.Create;
  311. begin
  312. inherited Create;
  313. randomize;
  314. FRandSeed := randseed;
  315. end;
  316. function TBGRADrawer.GetMeasures(AMeasureID: integer): integer;
  317. begin
  318. case AMeasureID of
  319. TCDEDIT_LEFT_TEXT_SPACING: Result := 6;
  320. TCDEDIT_RIGHT_TEXT_SPACING: Result := 3;
  321. TCDEDIT_TOP_TEXT_SPACING: Result := 3;
  322. TCDEDIT_BOTTOM_TEXT_SPACING: Result := 3;
  323. TCDCHECKBOX_SQUARE_HALF_HEIGHT: Result :=
  324. Floor(GetMeasures(TCDCHECKBOX_SQUARE_HEIGHT) / 2);
  325. TCDCHECKBOX_SQUARE_HEIGHT: Result := DPIAdjustment(13);
  326. TCDCOMBOBOX_DEFAULT_HEIGHT: Result := 21;
  327. TCDRADIOBUTTON_CIRCLE_HEIGHT: Result := DPIAdjustment(13);
  328. TCDSCROLLBAR_BUTTON_WIDTH: Result := 17;
  329. TCDSCROLLBAR_LEFT_SPACING: Result := 17;
  330. TCDSCROLLBAR_RIGHT_SPACING: Result := 17;
  331. TCDSCROLLBAR_LEFT_BUTTON_POS: Result := 0;
  332. TCDSCROLLBAR_RIGHT_BUTTON_POS: Result := -17;
  333. TCDTRACKBAR_LEFT_SPACING: Result := 9;
  334. TCDTRACKBAR_RIGHT_SPACING: Result := 9;
  335. TCDTRACKBAR_TOP_SPACING: Result := 5;
  336. TCDTRACKBAR_FRAME_HEIGHT: Result := DPIAdjustment(17);
  337. TCDLISTVIEW_COLUMN_LEFT_SPACING: Result := 10;
  338. TCDLISTVIEW_COLUMN_RIGHT_SPACING: Result := 10;
  339. TCDLISTVIEW_COLUMN_TEXT_LEFT_SPACING: Result := 5;
  340. TCDLISTVIEW_LINE_TOP_SPACING: Result := 3;
  341. TCDLISTVIEW_LINE_BOTTOM_SPACING: Result := 3;
  342. TCDTOOLBAR_ITEM_SPACING: Result := 2;
  343. TCDTOOLBAR_ITEM_ARROW_WIDTH: Result := 7;
  344. TCDTOOLBAR_ITEM_BUTTON_DEFAULT_WIDTH: Result := 23;
  345. TCDTOOLBAR_ITEM_ARROW_RESERVED_WIDTH: Result := 35 - 23;
  346. TCDTOOLBAR_ITEM_SEPARATOR_DEFAULT_WIDTH: Result := 8;
  347. TCDTOOLBAR_DEFAULT_HEIGHT: Result := 26;
  348. TCDCTABCONTROL_CLOSE_TAB_BUTTON_WIDTH: Result := 10;
  349. TCDCTABCONTROL_CLOSE_TAB_BUTTON_EXTRA_SPACING: Result := 10;
  350. else
  351. Result := 0;
  352. end;
  353. ;
  354. end;
  355. procedure TBGRADrawer.DrawTickmark(ADest: TFPCustomCanvas; ADestPos: TPoint;
  356. AState: TCDControlState);
  357. var
  358. i: integer;
  359. lSpacing5, lFirstLinesEnd, lSecondLinesEnd: integer;
  360. begin
  361. if csfPartiallyOn in AState then
  362. ADest.Pen.FPColor := TColorToFPColor($00AAAAAA)
  363. else
  364. ADest.Pen.FPColor := TColorToFPColor($00E5E5E5);
  365. ADest.Pen.Style := psSolid;
  366. if Screen.PixelsPerInch <= 125 then
  367. begin
  368. // 4 lines going down and to the right
  369. for i := 0 to 3 do
  370. ADest.Line(ADestPos.X + 1 + i, ADestPos.Y + 2 + i, ADestPos.X +
  371. 1 + i, ADestPos.Y + 5 + i);
  372. // Now 5 lines going up and to the right
  373. for i := 4 to 8 do
  374. ADest.Line(ADestPos.X + 1 + i, ADestPos.Y + 2 + 6 - i, ADestPos.X +
  375. 1 + i, ADestPos.Y + 5 + 6 - i);
  376. Exit;
  377. end;
  378. lSpacing5 := DPIAdjustment(5);
  379. lFirstLinesEnd := DPIAdjustment(4) - 1;
  380. lSecondLinesEnd := DPIAdjustment(9) - 1;
  381. // 4 lines going down and to the right
  382. for i := 0 to lFirstLinesEnd do
  383. ADest.Line(ADestPos.X + 2 + i, ADestPos.Y + 2 + i, ADestPos.X +
  384. 2 + i, ADestPos.Y + lSpacing5 + i);
  385. // Now 5 lines going up and to the right
  386. for i := lFirstLinesEnd + 1 to lSecondLinesEnd do
  387. ADest.Line(ADestPos.X + 2 + i, ADestPos.Y + 2 + lFirstLinesEnd * 2 - i,
  388. ADestPos.X + 2 + i, ADestPos.Y + 2 + lFirstLinesEnd * 2 + lSpacing5 - i);
  389. end;
  390. function TBGRADrawer.DPIAdjustment(const AValue: integer): integer;
  391. begin
  392. { Adjustment that works under Windows }
  393. Result := ScaleY(AValue, 96);
  394. end;
  395. procedure TBGRADrawer.DrawButton(ADest: TFPCustomCanvas; ADestPos: TPoint;
  396. ASize: TSize; AState: TCDControlState; AStateEx: TCDButtonStateEx);
  397. var
  398. Bitmap: TBGRABitmap;
  399. ts: TSize;
  400. begin
  401. Bitmap := TBGRABitmap.Create(ASize.cx, ASize.cy);
  402. if csfEnabled in AState then
  403. begin
  404. if csfSunken in AState then
  405. begin
  406. { Button Down }
  407. Bitmap.Rectangle(0, 0, ASize.cx, ASize.cy - 1, BGRA(48, 48, 48),
  408. BGRA(61, 61, 61), dmSet);
  409. Bitmap.Rectangle(1, 1, ASize.cx - 1, ASize.cy - 2, BGRA(55, 55, 55),
  410. BGRA(61, 61, 61), dmSet);
  411. Bitmap.SetHorizLine(0, ASize.cy - 1, ASize.cx - 1, BGRA(115, 115, 115));
  412. end
  413. else
  414. begin
  415. if csfMouseOver in AState then
  416. begin
  417. { Button Hovered }
  418. Bitmap.GradientFill(0, 0, ASize.cx, ASize.cy, BGRA(132, 132, 132),
  419. BGRA(109, 109, 109), gtLinear, PointF(0, 0), PointF(0, ASize.cy), dmSet);
  420. Bitmap.Rectangle(0, 0, ASize.cx, ASize.cy - 1, BGRA(48, 48, 48), dmSet);
  421. Bitmap.SetHorizLine(1, 1, ASize.cx - 2, BGRA(160, 160, 160));
  422. Bitmap.SetHorizLine(0, ASize.cy - 1, ASize.cx - 1, BGRA(115, 115, 115));
  423. end
  424. else
  425. begin
  426. { Button Normal }
  427. Bitmap.GradientFill(0, 0, ASize.cx, ASize.cy, BGRA(107, 107, 107),
  428. BGRA(84, 84, 84), gtLinear, PointF(0, 0), PointF(0, ASize.cy), dmSet);
  429. Bitmap.Rectangle(0, 0, ASize.cx, ASize.cy - 1, BGRA(48, 48, 48), dmSet);
  430. Bitmap.SetHorizLine(1, 1, ASize.cx - 2, BGRA(130, 130, 130));
  431. Bitmap.SetHorizLine(0, ASize.cy - 1, ASize.cx - 1, BGRA(115, 115, 115));
  432. { Button Focused }
  433. if csfHasFocus in AState then
  434. Bitmap.Rectangle(1, 2, ASize.cx - 1, ASize.cy - 2, BGRA(80, 111, 172), dmSet);
  435. end;
  436. end;
  437. end
  438. else
  439. begin
  440. { Button Disabled }
  441. Bitmap.Rectangle(0, 0, ASize.cx, ASize.cy - 1, BGRA(66, 66, 66),
  442. BGRA(71, 71, 71), dmSet);
  443. Bitmap.SetHorizLine(0, ASize.cy - 1, ASize.cx - 1, BGRA(94, 94, 94));
  444. end;
  445. AssignFont(Bitmap, AStateEx.Font);
  446. ts := Bitmap.TextSize(AStateEx.Caption);
  447. if csfEnabled in AState then
  448. begin
  449. { Text Enabled }
  450. Bitmap.TextOut((ASize.cx - ts.cx) div 2, ((ASize.cy - ts.cy) div 2) -
  451. 1, AStateEx.Caption, BGRA(47, 47, 47));
  452. Bitmap.TextOut((ASize.cx - ts.cx) div 2, (ASize.cy - ts.cy) div 2,
  453. AStateEx.Caption, BGRA(229, 229, 229));
  454. end
  455. else
  456. { Text Disabled }
  457. Bitmap.TextOut((ASize.cx - ts.cx) div 2, (ASize.cy - ts.cy) div 2,
  458. AStateEx.Caption, BGRA(170, 170, 170));
  459. Bitmap.Draw(TCanvas(ADest), ADestPos.x, ADestPos.y, True);
  460. Bitmap.Free;
  461. end;
  462. procedure TBGRADrawer.DrawEditBackground(ADest: TCanvas; ADestPos: TPoint;
  463. ASize: TSize; AState: TCDControlState; AStateEx: TCDEditStateEx);
  464. var
  465. Bitmap: TBGRABitmap;
  466. begin
  467. Bitmap := TBGRABitmap.Create(ASize.cx, ASize.cy);
  468. if csfEnabled in AState then
  469. if csfHasFocus in AState then
  470. { Focused }
  471. Bitmap.Fill(BGRAWhite)
  472. else
  473. { Normal }
  474. Bitmap.Rectangle(1, 1, ASize.cx - 1, ASize.cy - 1, BGRA(41, 41, 41),
  475. BGRA(58, 58, 58), dmSet)
  476. else
  477. { Disabled }
  478. Bitmap.Rectangle(1, 1, ASize.cx - 1, ASize.cy - 1, BGRA(66, 66, 66),
  479. BGRA(71, 71, 71), dmSet);
  480. Bitmap.Draw(TCanvas(ADest), ADestPos.x, ADestPos.y, True);
  481. Bitmap.Free;
  482. end;
  483. procedure TBGRADrawer.DrawEditFrame(ADest: TCanvas; ADestPos: TPoint;
  484. ASize: TSize; AState: TCDControlState; AStateEx: TCDEditStateEx);
  485. var
  486. Bitmap: TBGRABitmap;
  487. begin
  488. Bitmap := TBGRABitmap.Create(ASize.cx, ASize.cy);
  489. if csfEnabled in AState then
  490. begin
  491. if csfHasFocus in AState then
  492. begin
  493. { Focused }
  494. Bitmap.Rectangle(0, 0, ASize.cx, ASize.cy, BGRA(80, 111, 172), dmSet);
  495. Bitmap.Rectangle(1, 1, ASize.cx - 1, ASize.cy - 1, BGRA(41, 41, 41), dmSet);
  496. end
  497. else
  498. begin
  499. { Normal }
  500. Bitmap.Rectangle(0, 0, ASize.cx, ASize.cy, BGRA(83, 83, 83), dmSet);
  501. Bitmap.Rectangle(1, 1, ASize.cx - 1, ASize.cy - 1, BGRA(41, 41, 41), dmSet);
  502. Bitmap.SetHorizLine(1, ASize.cy - 1, ASize.cx - 2, BGRA(105, 105, 105));
  503. end;
  504. end
  505. else
  506. begin
  507. { Disabled }
  508. Bitmap.Rectangle(0, 0, ASize.cx, ASize.cy, BGRA(83, 83, 83), dmSet);
  509. Bitmap.Rectangle(1, 1, ASize.cx - 1, ASize.cy - 1, BGRA(66, 66, 66), dmSet);
  510. Bitmap.SetHorizLine(1, ASize.cy - 1, ASize.cx - 2, BGRA(94, 94, 94));
  511. end;
  512. Bitmap.Draw(TCanvas(ADest), ADestPos.x, ADestPos.y, False);
  513. Bitmap.Free;
  514. end;
  515. procedure TBGRADrawer.DrawCaret(ADest: TCanvas; ADestPos: TPoint;
  516. ASize: TSize; AState: TCDControlState; AStateEx: TCDEditStateEx);
  517. begin
  518. inherited DrawCaret(ADest, ADestPos, ASize, AState, AStateEx);
  519. end;
  520. procedure TBGRADrawer.DrawEdit(ADest: TCanvas; ASize: TSize;
  521. AState: TCDControlState; AStateEx: TCDEditStateEx);
  522. var
  523. lVisibleText, lControlText: TCaption;
  524. lSelLeftPos, lSelLeftPixelPos, lSelLength, lSelRightPos: integer;
  525. lTextWidth, lLineHeight, lLineTop: integer;
  526. lControlTextLen: PtrInt;
  527. lTextLeftSpacing, lTextTopSpacing, lTextBottomSpacing: integer;
  528. lTextColor: TColor;
  529. i, lVisibleLinesCount: integer;
  530. begin
  531. // Background
  532. DrawEditBackground(ADest, Point(0, 0), ASize, AState, AStateEx);
  533. // General text configurations which apply to all lines
  534. // Configure the text color
  535. if csfEnabled in AState then
  536. lTextColor := $00E5E5E5
  537. else
  538. lTextColor := $00AAAAAA;
  539. if csfHasFocus in AState then
  540. lTextColor := clBlack;
  541. ADest.Brush.Style := bsClear;
  542. ADest.Font.Assign(AStateEx.Font);
  543. ADest.Font.Color := lTextColor;
  544. lTextLeftSpacing := GetMeasures(TCDEDIT_LEFT_TEXT_SPACING);
  545. //lTextRightSpacing := GetMeasures(TCDEDIT_RIGHT_TEXT_SPACING);
  546. lTextTopSpacing := GetMeasures(TCDEDIT_TOP_TEXT_SPACING);
  547. lTextBottomSpacing := GetMeasures(TCDEDIT_BOTTOM_TEXT_SPACING);
  548. lLineHeight := ADest.TextHeight(cddTestStr) + 2;
  549. lLineHeight := Min(ASize.cy - lTextBottomSpacing, lLineHeight);
  550. // Fill this to be used in other parts
  551. AStateEx.LineHeight := lLineHeight;
  552. AStateEx.FullyVisibleLinesCount := ASize.cy - lTextTopSpacing - lTextBottomSpacing;
  553. AStateEx.FullyVisibleLinesCount := AStateEx.FullyVisibleLinesCount div lLineHeight;
  554. AStateEx.FullyVisibleLinesCount :=
  555. Min(AStateEx.FullyVisibleLinesCount, AStateEx.Lines.Count);
  556. // Calculate how many lines to draw
  557. if AStateEx.Multiline then
  558. lVisibleLinesCount := AStateEx.FullyVisibleLinesCount + 1
  559. else
  560. lVisibleLinesCount := 1;
  561. lVisibleLinesCount := Min(lVisibleLinesCount, AStateEx.Lines.Count);
  562. // Now draw each line
  563. for i := 0 to lVisibleLinesCount - 1 do
  564. begin
  565. lControlText := AStateEx.Lines.Strings[AStateEx.VisibleTextStart.Y + i];
  566. lControlText := VisibleText(lControlText, AStateEx.PasswordChar);
  567. lControlTextLen := UTF8Length(lControlText);
  568. lLineTop := lTextTopSpacing + i * lLineHeight;
  569. // The text
  570. ADest.Pen.Style := psClear;
  571. ADest.Brush.Style := bsClear;
  572. // ToDo: Implement multi-line selection
  573. if (AStateEx.SelLength = 0) or (AStateEx.SelStart.Y <>
  574. AStateEx.VisibleTextStart.Y + i) then
  575. begin
  576. lVisibleText := UTF8Copy(lControlText, AStateEx.VisibleTextStart.X,
  577. lControlTextLen);
  578. ADest.TextOut(lTextLeftSpacing, lLineTop, lVisibleText);
  579. end
  580. // Text and Selection
  581. else
  582. begin
  583. lSelLeftPos := AStateEx.SelStart.X;
  584. if AStateEx.SelLength < 0 then
  585. lSelLeftPos := lSelLeftPos + AStateEx.SelLength;
  586. lSelRightPos := AStateEx.SelStart.X;
  587. if AStateEx.SelLength > 0 then
  588. lSelRightPos := lSelRightPos + AStateEx.SelLength;
  589. lSelLength := AStateEx.SelLength;
  590. if lSelLength < 0 then
  591. lSelLength := lSelLength * -1;
  592. // Text left of the selection
  593. lVisibleText := UTF8Copy(lControlText, AStateEx.VisibleTextStart.X,
  594. lSelLeftPos - AStateEx.VisibleTextStart.X + 1);
  595. ADest.TextOut(lTextLeftSpacing, lLineTop, lVisibleText);
  596. lSelLeftPixelPos := ADest.TextWidth(lVisibleText) + lTextLeftSpacing;
  597. // The selection background
  598. lVisibleText := UTF8Copy(lControlText, lSelLeftPos + 1, lSelLength);
  599. lTextWidth := ADest.TextWidth(lVisibleText);
  600. ADest.Brush.Color := $00C3C3C3;
  601. ADest.Brush.Style := bsSolid;
  602. ADest.Rectangle(Bounds(lSelLeftPixelPos, lLineTop, lTextWidth, lLineHeight));
  603. ADest.Brush.Style := bsClear;
  604. // The selection text
  605. ADest.Font.Color := clWhite;
  606. ADest.TextOut(lSelLeftPixelPos, lLineTop, lVisibleText);
  607. lSelLeftPixelPos := lSelLeftPixelPos + lTextWidth;
  608. // Text right of the selection
  609. ADest.Brush.Color := clWhite;
  610. ADest.Font.Color := lTextColor;
  611. lVisibleText := UTF8Copy(lControlText, lSelLeftPos + lSelLength +
  612. 1, lControlTextLen);
  613. ADest.TextOut(lSelLeftPixelPos, lLineTop, lVisibleText);
  614. end;
  615. end;
  616. // And the caret
  617. DrawCaret(ADest, Point(0, 0), ASize, AState, AStateEx);
  618. // In the end the frame, because it must be on top of everything
  619. DrawEditFrame(ADest, Point(0, 0), ASize, AState, AStateEx);
  620. end;
  621. procedure TBGRADrawer.DrawPanel(ADest: TCanvas; ASize: TSize;
  622. AState: TCDControlState; AStateEx: TCDPanelStateEx);
  623. var
  624. Bitmap: TBGRABitmap;
  625. begin
  626. Bitmap := TBGRABitmap.Create(ASize.cx, ASize.cy);
  627. Bitmap.Rectangle(0, 0, ASize.cx, ASize.cy, BGRA(40, 40, 40), BGRA(83, 83, 83), dmSet);
  628. Bitmap.SetHorizLine(1, 1, ASize.cx - 2, BGRA(106, 106, 106));
  629. Bitmap.Draw(TCanvas(ADest), ASize.cx, ASize.cy, True);
  630. Bitmap.Free;
  631. end;
  632. procedure TBGRADrawer.DrawStaticText(ADest: TCanvas; ASize: TSize;
  633. AState: TCDControlState; AStateEx: TCDControlStateEx);
  634. var
  635. lColor: TColor;
  636. begin
  637. // Background
  638. lColor := $00535353; //AStateEx.ParentRGBColor;
  639. ADest.Brush.Color := lColor;
  640. ADest.Brush.Style := bsSolid;
  641. ADest.Pen.Style := psClear;
  642. ADest.FillRect(0, 0, ASize.cx, ASize.cy);
  643. // Now the text
  644. ADest.Brush.Style := bsClear;
  645. ADest.Font.Assign(AStateEx.Font);
  646. if csfEnabled in AState then
  647. ADest.Font.Color := $00E5E5E5
  648. else
  649. ADest.Font.Color := $00AAAAAA;
  650. ADest.TextOut(0, 0, AStateEx.Caption);
  651. end;
  652. procedure TBGRADrawer.DrawProgressBar(ADest: TCanvas; ASize: TSize;
  653. AState: TCDControlState; AStateEx: TCDProgressBarStateEx);
  654. function ApplyLightness(c: TBGRAPixel; lightness: word): TBGRAPixel;
  655. begin
  656. Result := GammaCompression(SetLightness(GammaExpansion(c), lightness));
  657. end;
  658. procedure DrawBar(Bitmap: TBGRABitmap; bounds: TRect);
  659. var
  660. lCol: TBGRAPixel;
  661. begin
  662. lCol := AStateEx.RGBColor;
  663. DoubleGradientAlphaFill(Bitmap, bounds,
  664. ApplyLightness(lCol, 37000), ApplyLightness(lCol, 29000),
  665. ApplyLightness(lCol, 26000), ApplyLightness(lCol, 18000),
  666. gdVertical, gdVertical, gdVertical, 0.53);
  667. InflateRect(bounds, -1, -1);
  668. DoubleGradientAlphaFill(Bitmap, bounds,
  669. ApplyLightness(lCol, 28000), ApplyLightness(lCol, 22000),
  670. ApplyLightness(lCol, 19000), ApplyLightness(lCol, 11000),
  671. gdVertical, gdVertical, gdVertical, 0.53);
  672. end;
  673. var
  674. content: TRect;
  675. xpos, y, tx, ty: integer;
  676. grayValue: integer;
  677. Bitmap: TBGRABitmap;
  678. begin
  679. Bitmap := TBGRABitmap.Create(ASize.cx, ASize.cy);
  680. tx := ASize.cx;
  681. ty := ASize.cy;
  682. Bitmap.Fill(BGRA(83, 83, 83));
  683. Bitmap.Rectangle(0, 0, tx, ty, BGRA(255, 255, 255, 6), dmDrawWithTransparency);
  684. if (tx > 2) and (ty > 2) then
  685. Bitmap.Rectangle(1, 1, tx - 1, ty - 1, BGRA(29, 29, 29), dmSet);
  686. if (tx > 4) and (ty > 4) then
  687. begin
  688. content := Rect(2, 2, tx - 2, ty - 2);
  689. randseed := FRandSeed;
  690. for y := content.Top to content.Bottom - 1 do
  691. begin
  692. if y = content.Top then
  693. grayValue := 33
  694. else
  695. if y = content.Top + 1 then
  696. grayValue := 43
  697. else
  698. grayValue := 47 + random(50 - 47 + 1);
  699. Bitmap.SetHorizLine(content.Left, y, content.Right - 1, BGRA(
  700. grayValue, grayValue, grayValue));
  701. end;
  702. if tx >= 6 then
  703. Bitmap.DrawVertLine(content.Right - 1, content.Top, content.Bottom - 1,
  704. BGRA(0, 0, 0, 32));
  705. xpos := round(AStateEx.PercentPosition * (content.right - content.left)) +
  706. content.left;
  707. if xpos > content.left then
  708. begin
  709. DrawBar(Bitmap, rect(content.left, content.top, xpos, content.bottom));
  710. if xpos < content.right then
  711. begin
  712. Bitmap.SetPixel(xpos, content.top, BGRA(62, 62, 62));
  713. Bitmap.SetVertLine(xpos, content.top + 1, content.bottom -
  714. 1, BGRA(40, 40, 40));
  715. end;
  716. end;
  717. end;
  718. Bitmap.Draw(TCanvas(ADest), 0, 0, True);
  719. Bitmap.Free;
  720. end;
  721. procedure TBGRADrawer.DrawCheckBoxSquare(ADest: TCanvas; ADestPos: TPoint;
  722. ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx);
  723. var
  724. lHalf, lSquareHalf, lSquareHeight: integer;
  725. Bitmap: TBGRABitmap;
  726. r: TRect;
  727. begin
  728. Bitmap := TBGRABitmap.Create(ASize.cx, ASize.cy);
  729. lHalf := ASize.cy div 2;
  730. lSquareHalf := GetMeasures(TCDCHECKBOX_SQUARE_HALF_HEIGHT);
  731. lSquareHeight := GetMeasures(TCDCHECKBOX_SQUARE_HEIGHT);
  732. r := Bounds(1, lHalf - lSquareHalf, lSquareHeight, lSquareHeight);
  733. if csfEnabled in AState then
  734. begin
  735. if csfSunken in AState then
  736. begin
  737. { Down }
  738. Bitmap.Rectangle(r.Left, r.Top, r.Right, r.Bottom - 1, BGRA(48, 48, 48),
  739. BGRA(61, 61, 61), dmSet);
  740. Bitmap.Rectangle(r.Left + 1, r.Top + 1, r.Right - 1, r.Bottom -
  741. 2, BGRA(55, 55, 55),
  742. BGRA(61, 61, 61), dmSet);
  743. Bitmap.SetHorizLine(r.Left, r.Bottom - 1, r.Right - 1, BGRA(115, 115, 115));
  744. end
  745. else
  746. begin
  747. if csfMouseOver in AState then
  748. begin
  749. { Hovered }
  750. Bitmap.GradientFill(r.Left, r.Top, r.Right, r.Bottom, BGRA(132, 132, 132),
  751. BGRA(109, 109, 109), gtLinear, PointF(0, 0), PointF(0, ASize.cy), dmSet);
  752. Bitmap.Rectangle(r.Left, r.Top, r.Right, r.Bottom - 1, BGRA(48, 48, 48), dmSet);
  753. Bitmap.SetHorizLine(r.Left + 1, r.Top + 1, r.Right - 2, BGRA(160, 160, 160));
  754. Bitmap.SetHorizLine(r.Left, r.Bottom - 1, r.Right - 1, BGRA(115, 115, 115));
  755. end
  756. else
  757. begin
  758. { Normal }
  759. Bitmap.GradientFill(r.Left, r.Top, r.Right, r.Bottom, BGRA(107, 107, 107),
  760. BGRA(84, 84, 84), gtLinear, PointF(0, 0), PointF(0, r.Bottom), dmSet);
  761. Bitmap.Rectangle(r.Left, r.Top, r.Right, r.Bottom - 1, BGRA(48, 48, 48), dmSet);
  762. Bitmap.SetHorizLine(r.Left + 1, r.Top + 1, r.Right - 2, BGRA(130, 130, 130));
  763. Bitmap.SetHorizLine(r.Left, r.Bottom - 1, r.Right - 1, BGRA(115, 115, 115));
  764. end;
  765. end;
  766. end
  767. else
  768. begin
  769. { Disabled }
  770. Bitmap.Rectangle(r.Left, r.Top, r.Right, r.Bottom - 1, BGRA(66, 66, 66),
  771. BGRA(71, 71, 71), dmSet);
  772. Bitmap.SetHorizLine(r.Left, r.Bottom - 1, r.Right - 1, BGRA(94, 94, 94));
  773. end;
  774. Bitmap.Draw(TCanvas(ADest), ADestPos.x, ADestPos.y, False);
  775. Bitmap.Free;
  776. end;
  777. procedure TBGRADrawer.DrawCheckBox(ADest: TCanvas; ASize: TSize;
  778. AState: TCDControlState; AStateEx: TCDControlStateEx);
  779. var
  780. lColor: TColor;
  781. lSquareHeight, lValue3: integer;
  782. lTextHeight, lTextY: integer;
  783. begin
  784. lSquareHeight := GetMeasures(TCDCHECKBOX_SQUARE_HEIGHT);
  785. lValue3 := DPIAdjustment(3);
  786. // Background
  787. lColor := $00535353; //AStateEx.ParentRGBColor;
  788. ADest.Brush.Color := lColor;
  789. ADest.Brush.Style := bsSolid;
  790. ADest.Pen.Style := psClear;
  791. ADest.FillRect(0, 0, ASize.cx, ASize.cy);
  792. // The checkbox item itself
  793. DrawCheckBoxSquare(ADest, Point(0, 0), ASize, AState, AStateEx);
  794. // The Tickmark
  795. if (csfOn in AState) or (csfPartiallyOn in AState) then
  796. DrawTickmark(ADest, Point(lValue3, ASize.cy div 2 -
  797. GetMeasures(TCDCHECKBOX_SQUARE_HALF_HEIGHT) + lValue3), AState);
  798. // The text selection
  799. //if csfHasFocus in AState then
  800. // DrawFocusRect(ADest, Point(lSquareHeight+4, 0),
  801. // Size(ASize.cx-lSquareHeight-4, ASize.cy));
  802. // Now the text
  803. ADest.Brush.Style := bsClear;
  804. ADest.Pen.Style := psClear;
  805. ADest.Font.Assign(AStateEx.Font);
  806. if csfEnabled in AState then
  807. ADest.Font.Color := $00E5E5E5
  808. else
  809. ADest.Font.Color := $00AAAAAA;
  810. lTextHeight := ADest.TextHeight(cddTestStr);
  811. // put the text in the center
  812. if lSquareHeight > lTextHeight then
  813. lTextY := (lSquareHeight - ADest.TextHeight(cddTestStr)) div 2
  814. else
  815. lTextY := 0;
  816. lTextY := Max(0, lTextY - 1);
  817. ADest.TextOut(lSquareHeight + 5, lTextY, AStateEx.Caption);
  818. end;
  819. procedure TBGRADrawer.DrawRadioButtonCircle(ADest: TCanvas; ADestPos: TPoint;
  820. ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx);
  821. var
  822. lCircleHeight, lCircleMid: integer;
  823. Bitmap: TBGRABitmap;
  824. bColor: TBGRAPixel;
  825. begin
  826. lCircleHeight := GetMeasures(TCDRADIOBUTTON_CIRCLE_HEIGHT);
  827. lCircleMid := lCircleHeight div 2;
  828. Bitmap := TBGRABitmap.Create(lCircleHeight, lCircleHeight);
  829. if csfEnabled in AState then
  830. begin
  831. if csfSunken in AState then
  832. bColor := BGRA(61, 61, 61)
  833. else
  834. begin
  835. if csfMouseOver in AState then
  836. bColor := BGRA(109, 109, 109)
  837. else
  838. bColor := BGRA(84, 84, 84);
  839. end;
  840. end
  841. else
  842. bColor := BGRA(71, 71, 71);
  843. if csfOn in AState then
  844. begin
  845. if csfEnabled in AState then
  846. Bitmap.EllipseAntialias(lCircleMid, lCircleMid, lCircleMid - 1,
  847. lCircleMid - 1, BGRA(48, 48, 48), 1, BGRA(229, 229, 229))
  848. else
  849. Bitmap.EllipseAntialias(lCircleMid, lCircleMid, lCircleMid - 1,
  850. lCircleMid - 1, BGRA(48, 48, 48), 1, BGRA(170, 170, 170));
  851. end
  852. else
  853. begin
  854. Bitmap.EllipseAntialias(lCircleMid, lCircleMid, lCircleMid - 1,
  855. lCircleMid - 1, BGRA(48, 48, 48), 1, bColor);
  856. end;
  857. Bitmap.Draw(TCanvas(ADest), 0, (ADest.Font.GetTextHeight('a') - lCircleHeight) div
  858. 2, False);
  859. Bitmap.Free;
  860. end;
  861. procedure TBGRADrawer.DrawRadioButton(ADest: TCanvas; ASize: TSize;
  862. AState: TCDControlState; AStateEx: TCDControlStateEx);
  863. var
  864. lColor: TColor;
  865. lCircleHeight: integer;
  866. lTextHeight, lTextY: integer;
  867. begin
  868. lCircleHeight := GetMeasures(TCDRADIOBUTTON_CIRCLE_HEIGHT);
  869. // Background
  870. lColor := $00535353; //AStateEx.ParentRGBColor;
  871. ADest.Brush.Color := lColor;
  872. ADest.Brush.Style := bsSolid;
  873. ADest.Pen.Style := psClear;
  874. ADest.FillRect(0, 0, ASize.cx, ASize.cy);
  875. // The radiobutton circle itself
  876. DrawRadioButtonCircle(ADest, Point(0, 0), ASize, AState, AStateEx);
  877. // The text selection
  878. //if csfHasFocus in AState then
  879. // DrawFocusRect(ADest, Point(lCircleHeight+3, 0),
  880. // Size(ASize.cx-lCircleHeight-3, ASize.cy));
  881. // Now the text
  882. ADest.Brush.Style := bsClear;
  883. ADest.Font.Assign(AStateEx.Font);
  884. if csfEnabled in AState then
  885. ADest.Font.Color := $00E5E5E5
  886. else
  887. ADest.Font.Color := $00AAAAAA;
  888. lTextHeight := ADest.TextHeight(cddTestStr);
  889. // put the text in the center
  890. if lCircleHeight > lTextHeight then
  891. lTextY := (lCircleHeight - ADest.TextHeight(cddTestStr)) div 2
  892. else
  893. lTextY := 0;
  894. lTextY := Max(0, lTextY - 1);
  895. ADest.TextOut(lCircleHeight + 5, lTextY, AStateEx.Caption);
  896. end;
  897. initialization
  898. RegisterDrawer(TBGRADrawer.Create, dsCommon);
  899. end.