FlatSkins.pas 18 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557
  1. unit FlatSkins;
  2. interface
  3. {$I FlatStyle.inc}
  4. uses Classes, Messages, Graphics, Controls, FlatUtils, Forms;
  5. Type
  6. { TFlatSkin }
  7. TFlatSkin = class(TGraphicsObject)
  8. private
  9. FBarStartColor: TColor;
  10. FBarStopColor: TColor;
  11. FBackStartColor: TColor;
  12. FBackStopColor: TColor;
  13. FItemStartColor: TColor;
  14. FItemStopColor: TColor;
  15. FBarOrien: TStyleOrien;
  16. FBackdropOrien: TStyleOrien;
  17. FItemOrien: TStyleOrien;
  18. FNotify: IChangeNotifier;
  19. FItemRectColor: TColor;
  20. FBorderColor: TColor;
  21. FItemSelectColor: TColor;
  22. FBarColor: TColor;
  23. FTransparent: TTransparentMode;
  24. FBarArrowColor: TColor;
  25. FItemFrameColor: TColor;
  26. FBackdropColor: TColor;
  27. FTitleColor: TColor;
  28. FTitleStartColor: TColor;
  29. FTitleStopColor: TColor;
  30. FTitleOrien: TStyleOrien;
  31. FTitleAlignment: TAlignmentText;
  32. FBarTopBitmap: TBitmap;
  33. FBarDownBitmap: TBitmap;
  34. FBackBitmap: TBitmap;
  35. FTitleBitmap: TBitmap;
  36. FBarUseBitmap: boolean;
  37. FBackUseBitmap: boolean;
  38. FTitleUseBitmap: boolean;
  39. FItemLineHas: boolean;
  40. FItemLineColor: TColor;
  41. FUserFace: TStyleFace;
  42. FBarsHeight: integer;
  43. FItemHeight: integer;
  44. FTitleHeight: integer;
  45. FTitlePosition: TTitlePosition;
  46. FTitleHas: boolean;
  47. FScrollBars: Boolean;
  48. FTitleFont: TFont;
  49. FParentFont: boolean;
  50. FParent: TControl;
  51. FBackFocusColor: TColor;
  52. procedure SetColors(const Index: Integer; const Value: TColor);
  53. procedure SetOriens(const Index: Integer; const Value: TStyleOrien);
  54. procedure SetTransparent(const Value: TTransparentMode);
  55. procedure SetTitleAlignment(const Value: TAlignmentText);
  56. procedure SetBitmaps(const Index: Integer; const Value: TBitmap);
  57. procedure SetUseBitmap(const Index: Integer; const Value: boolean);
  58. procedure SetUserFace(const Value: TStyleFace);
  59. procedure SetHeights(Index, Value: integer);
  60. procedure SetTitlePosition(const Value: TTitlePosition);
  61. procedure SetTitleHas(const Value: boolean);
  62. procedure SetScrollBars(const Value: Boolean);
  63. procedure SetTitleFont(const Value: TFont);
  64. procedure FontChanged(Sender: TObject);
  65. procedure SetParentFont(const Value: boolean);
  66. function GetParent: TControl;
  67. protected
  68. property StyleNotify: IChangeNotifier read FNotify write FNotify;
  69. public
  70. procedure Changed; override;
  71. procedure Assign(Source: TPersistent); override;
  72. constructor Create;
  73. destructor Destroy;override;
  74. property Parent: TControl read GetParent write FParent;
  75. published
  76. property BarStopColor: TColor index 0 read FBarStopColor write SetColors default DefaultColorStop;
  77. property BarStartColor: TColor index 1 read FBarStartColor write SetColors default DefaultColorStart;
  78. property BackStopColor: TColor index 2 read FBackStopColor write SetColors default DefaultColorStop;
  79. property BackStartColor: TColor index 3 read FBackStartColor write SetColors default DefaultColorStart;
  80. property ItemStopColor: TColor index 4 read FItemStopColor write SetColors default DefaultItemColorStop;
  81. property ItemStartColor: TColor index 5 read FItemStartColor write SetColors default DefaultItemColorStart;
  82. property ItemSelectColor: TColor index 7 read FItemSelectColor write SetColors default $009CDEF7;
  83. property BorderColor: TColor index 8 read FBorderColor write SetColors default DefaultBorderColor;
  84. property BarColor: TColor index 9 read FBarColor write SetColors default DefaultBarColor;
  85. property BarArrowColor: TColor index 10 read FBarArrowColor write SetColors default clBlack;
  86. property ItemFrameColor: TColor index 11 read FItemFrameColor write SetColors default DefaultBorderColor;
  87. property BackdropColor: TColor index 12 read FBackdropColor write SetColors default DefaultBackdropColor;
  88. property TitleStartColor: TColor index 13 read FTitleStartColor write SetColors default DefaultColorStart;
  89. property TitleStopColor: TColor index 14 read FTitleStopColor write SetColors default DefaultColorStop;
  90. property TitleColor: TColor index 15 read FTitleColor write SetColors default defaultTitleColor;
  91. property ItemLineColor: TColor index 16 read FItemLineColor write SetColors default DefaultItemLineColor;
  92. property BackFocusColor: TColor index 17 read FBackFocusColor write SetColors default DefaultFlatColor;
  93. property BarOrien: TStyleOrien index 0 read FBarOrien write SetOriens default DefaultStyleVertical;
  94. property BackdropOrien:TStyleOrien index 1 read FBackdropOrien write SetOriens default DefaultStyleHorizontal;
  95. property ItemOrien: TStyleOrien index 2 read FItemOrien write SetOriens default DefaultStyleVertical;
  96. property TitleOrien: TStyleOrien index 3 read FTitleOrien write SetOriens default bsVertical;
  97. property BarTopBitmap: TBitmap index 0 read FBarTopBitmap write SetBitmaps;
  98. property BarDownBitmap: TBitmap index 1 read FBarDownBitmap write SetBitmaps;
  99. property BackBitmap: TBitmap index 2 read FBackBitmap write SetBitmaps;
  100. property TitleBitmap: TBitmap index 3 read FTitleBitmap write SetBitmaps;
  101. property BarUseBitmap: boolean index 0 read FBarUseBitmap write SetUseBitmap default false;
  102. property BackUseBitmap: boolean index 1 read FBackUseBitmap write SetUseBitmap default false;
  103. property TitleUseBitmap: boolean index 2 read FTitleUseBitmap write SetUseBitmap default false;
  104. property ItemLineHas: boolean index 3 read FItemLineHas write SetUseBitmap default false;
  105. property TitleAlignment: TAlignmentText read FTitleAlignment write SetTitleAlignment default stCenter;
  106. property Transparent: TTransparentMode read FTransparent write SetTransparent default tmNone;
  107. property UserFace: TStyleFace read FUserFace write SetUserFace default DefaultStyleFace;
  108. property TitlePosition: TTitlePosition read FTitlePosition write SetTitlePosition default tsTop;
  109. property BarsHeight: integer index 0 read FBarsHeight write SetHeights default DefaultBarsHeight;
  110. property ItemHeight: integer index 1 read FItemHeight write SetHeights default DefaultItemHeight;
  111. property TitleHeight: integer index 2 read FTitleHeight write SetHeights default DefaultTitleHeight;
  112. property TitleHas: boolean read FTitleHas write SetTitleHas default true;
  113. property ScrollBars: Boolean read FScrollBars write SetScrollBars default True;
  114. property TitleFont: TFont read FTitleFont write SetTitleFont;
  115. property ParentFont: boolean read FParentFont write SetParentFont default true;
  116. end;
  117. { TListStyle }
  118. TListStyle = class(TFlatSkin)
  119. private
  120. FItemAlignment: TAlignmentText;
  121. procedure SetItemAlignment(const Value: TAlignmentText);
  122. public
  123. procedure Assign(Source: TPersistent); override;
  124. constructor Create;
  125. published
  126. property ItemAlignment: TAlignmentText read FItemAlignment write SetItemAlignment default stLeft;
  127. end;
  128. { TCheckStyle }
  129. TCheckStyle = class(TFlatSkin)
  130. private
  131. FSelectPosition: TCheckPosition;
  132. FSelectColor: TColor;
  133. FSelectBackdropColor: TColor;
  134. FSelectBorderColor: TColor;
  135. FSelectSize: Integer;
  136. FSelectStartColor: TColor;
  137. FSelectStopColor: TColor;
  138. FSelectOrien: TStyleOrien;
  139. FSelectCheckColor: TColor;
  140. procedure SetColors(const Index: Integer; const Value: TColor);
  141. procedure SetSelectPosition(const Value: TCheckPosition);
  142. procedure SetSelectSize(Value: Integer);
  143. procedure SetSelectOrien(const Value: TStyleOrien);
  144. public
  145. procedure Assign(Source: TPersistent); override;
  146. constructor Create;
  147. published
  148. property SelectPosition: TCheckPosition read FSelectPosition write SetSelectPosition default bpLeft;
  149. property SelectColor: TColor index 0 read FSelectColor write SetColors default clPurple;
  150. property SelectBackdropColor: TColor index 1 read FSelectBackdropColor write SetColors default DefaultCheckBackColor;
  151. property SelectBorderColor: TColor index 2 read FSelectBorderColor write SetColors default DefaultCheckBorderColor;
  152. property SelectStartColor: TColor index 3 read FSelectStartColor write SetColors default DefaultSelectStartColor;
  153. property SelectStopColor: TColor index 4 read FSelectStopColor write SetColors default DefaultSelectStopColor;
  154. property SelectCheckColor: TColor index 5 read FSelectCheckColor write SetColors default DefaultFlatColor;
  155. property SelectOrien: TStyleOrien read FSelectOrien write SetSelectOrien default bsVertical;
  156. property SelectSize: Integer read FSelectSize write SetSelectSize default 12;
  157. end;
  158. implementation
  159. { TFlatSkin }
  160. procedure TFlatSkin.Assign(Source: TPersistent);
  161. begin
  162. if Source is TFlatSkin then
  163. begin
  164. FBarTopBitmap := TFlatSkin(Source).BarTopBitmap;
  165. FBarDownBitmap := TFlatSkin(Source).BarDownBitmap;
  166. FBackBitmap := TFlatSkin(Source).BackBitmap;
  167. FTitleBitmap := TFlatSkin(Source).TitleBitmap;
  168. FTitleFont := TFlatSkin(Source).TitleFont;
  169. fBarStopColor := TFlatSkin(Source).BarStopColor;
  170. fBarStartColor := TFlatSkin(Source).BarStartColor;
  171. fBarOrien := TFlatSkin(Source).BarOrien;
  172. fBarColor := TFlatSkin(Source).BarColor;
  173. FBarArrowColor := TFlatSkin(Source).BarArrowColor;
  174. fBackStopColor := TFlatSkin(Source).BackStopColor;
  175. fBackStartColor := TFlatSkin(Source).BackStartColor;
  176. fBackdropOrien := TFlatSkin(Source).BackdropOrien;
  177. FBackdropColor := TFlatSkin(Source).BackdropColor;
  178. FBackFocusColor := TFlatSkin(Source).BackFocusColor;
  179. FItemStopColor := TFlatSkin(Source).ItemStopColor;
  180. fItemStartColor := TFlatSkin(Source).ItemStartColor;
  181. fItemOrien := TFlatSkin(Source).ItemOrien;
  182. FItemSelectColor := TFlatSkin(Source).ItemSelectColor;
  183. FItemFrameColor := TFlatSkin(Source).ItemFrameColor;
  184. FItemLineColor := TFlatSkin(Source).ItemLineColor;
  185. FItemLineHas := TFlatSkin(Source).ItemLineHas;
  186. FTitleOrien := TFlatSkin(Source).TitleOrien;
  187. FTitleStartColor := TFlatSkin(Source).TitleStartColor;
  188. FTitleStopColor := TFlatSkin(Source).TitleStopColor;
  189. FTitleColor := TFlatSkin(Source).TitleColor;
  190. FTitleAlignment := TFlatSkin(Source).TitleAlignment;
  191. FBarUseBitmap := TFlatSkin(Source).BarUseBitmap;
  192. FBackUseBitmap := TFlatSkin(Source).BackUseBitmap;
  193. FTitleUseBitmap := TFlatSkin(Source).TitleUseBitmap;
  194. FTransparent := TFlatSkin(Source).Transparent;
  195. FUserFace := TFlatSkin(Source).UserFace;
  196. FBarsHeight := TFlatSkin(Source).BarsHeight;
  197. FItemHeight := TFlatSkin(Source).ItemHeight;
  198. FTitleHeight := TFlatSkin(Source).TitleHeight;
  199. FTitlePosition := TFlatSkin(Source).TitlePosition;
  200. FTitleHas := TFlatSkin(Source).TitleHas;
  201. FScrollBars := TFlatSkin(Source).ScrollBars;
  202. FParentFont := TFlatSkin(Source).ParentFont;
  203. Changed;
  204. Exit;
  205. end;
  206. inherited Assign(Source);
  207. end;
  208. procedure TFlatSkin.Changed;
  209. begin
  210. inherited Changed;
  211. if FNotify <> nil then FNotify.Changed;
  212. end;
  213. procedure TFlatSkin.FontChanged(Sender: TObject);
  214. begin
  215. Changed;
  216. end;
  217. constructor TFlatSkin.Create;
  218. begin
  219. inherited Create;
  220. FBarTopBitmap := TBitmap.Create;
  221. FBarDownBitmap := TBitmap.Create;
  222. FBackBitmap := TBitmap.Create;
  223. FTitleBitmap := TBitmap.Create;
  224. FTitleFont := TFont.Create;
  225. FTitleFont.OnChange := FontChanged;
  226. FBarStopColor := DefaultColorStop;
  227. FBarStartColor := DefaultColorStart;
  228. FBarColor := DefaultBarColor;
  229. FBarArrowColor := clBlack;
  230. FBarOrien := DefaultStyleVertical;
  231. FBackStopColor := DefaultColorStop;
  232. FBackStartColor := DefaultColorStart;
  233. FBackdropOrien := DefaultStyleHorizontal;
  234. FBackdropColor := DefaultBackdropColor;
  235. FBackFocusColor := DefaultFlatColor;
  236. FItemStopColor := DefaultItemColorStop;
  237. FItemStartColor := DefaultItemColorStart;
  238. FItemRectColor := DefaultItemRectColor;
  239. FItemSelectColor := $009CDEF7;
  240. FItemOrien := DefaultStyleVertical;
  241. FItemFrameColor := DefaultBorderColor;
  242. FItemLineColor := DefaultItemLineColor;
  243. FItemLineHas := False;
  244. FTitleOrien := bsVertical;
  245. FTitleStartColor := DefaultColorStart;
  246. FTitleStopColor := DefaultColorStop;
  247. FTitleColor := defaultTitleColor;
  248. FTitleAlignment := stCenter;
  249. FTitlePosition := tsTop;
  250. FBorderColor := DefaultBorderColor;
  251. FBarUseBitmap := false;
  252. FBackUseBitmap := false;
  253. FTitleUseBitmap := false;
  254. FUserFace := DefaultStyleFace;
  255. FTransparent := tmNone;
  256. FBarsHeight := DefaultBarsHeight;
  257. FItemHeight := DefaultItemHeight;
  258. FTitleHeight := DefaultTitleHeight;
  259. FTitleHas := true;
  260. FScrollBars := True;
  261. FParentFont := True;
  262. end;
  263. destructor TFlatSkin.Destroy;
  264. begin
  265. FTitleFont.Free;
  266. FTitleBitmap.Free;
  267. FBarTopBitmap.Free;
  268. FBarDownBitmap.Free;
  269. FBackBitmap.Free;
  270. inherited Destroy;
  271. end;
  272. procedure TFlatSkin.SetBitmaps(const Index: Integer; const Value: TBitmap);
  273. begin
  274. case index of
  275. 0:FBarTopBitmap.Assign(Value);
  276. 1:FBarDownBitmap.Assign(Value);
  277. 2:FBackBitmap.Assign(Value);
  278. 3:FTitleBitmap.Assign(Value);
  279. end;
  280. Changed;
  281. end;
  282. procedure TFlatSkin.SetColors(const Index: Integer; const Value: TColor);
  283. begin
  284. case index of
  285. 0:FBarStopColor := Value;
  286. 1:FBarStartColor := Value;
  287. 2:FBackStopColor := Value;
  288. 3:FBackStartColor := Value;
  289. 4:FItemStopColor := Value;
  290. 5:FItemStartColor := Value;
  291. 6:FItemRectColor := Value;
  292. 7:FItemSelectColor := Value;
  293. 8:FBorderColor := Value;
  294. 9:FBarColor := Value;
  295. 10:FBarArrowColor := Value;
  296. 11:FItemFrameColor := Value;
  297. 12:FBackdropColor := Value;
  298. 13:FTitleStartColor := Value;
  299. 14:FTitleStopColor := Value;
  300. 15:FTitleColor := Value;
  301. 16:FItemLineColor := Value;
  302. 17:FBackFocusColor := Value;
  303. end;
  304. Changed;
  305. end;
  306. procedure TFlatSkin.SetHeights(Index, Value: integer);
  307. begin
  308. case index of
  309. 0:begin
  310. if Value < 12 then
  311. Value := 12;
  312. FBarsHeight := value;
  313. end;
  314. 1:begin
  315. if Value < 17 then
  316. Value := 17;
  317. FItemHeight := value;
  318. end;
  319. 2:begin
  320. if Value < 18 then
  321. value := 18;
  322. FTitleHeight := Value;
  323. end;
  324. end;
  325. Changed;
  326. end;
  327. procedure TFlatSkin.SetOriens(const Index: Integer; const Value: TStyleOrien);
  328. begin
  329. case index of
  330. 0:FBarOrien := Value;
  331. 1:FBackdropOrien := Value;
  332. 2:FItemOrien := Value;
  333. 3:FTitleOrien := Value;
  334. end;
  335. Changed;
  336. end;
  337. procedure TFlatSkin.SetScrollBars(const Value: Boolean);
  338. begin
  339. if FScrollBars <> value then begin
  340. FScrollBars := Value;
  341. Changed;
  342. end;
  343. end;
  344. procedure TFlatSkin.SetTitleAlignment(const Value: TAlignmentText);
  345. begin
  346. if FTitleAlignment <> value then begin
  347. FTitleAlignment := Value;
  348. Changed;
  349. end;
  350. end;
  351. procedure TFlatSkin.SetTitleFont(const Value: TFont);
  352. begin
  353. if FTitleFont <> Value then
  354. begin
  355. FTitleFont.Assign(Value);
  356. FParentFont := false;
  357. end;
  358. end;
  359. procedure TFlatSkin.SetTitleHas(const Value: boolean);
  360. begin
  361. if FTitleHas <> value then begin
  362. FTitleHas := Value;
  363. Changed;
  364. end;
  365. end;
  366. procedure TFlatSkin.SetTitlePosition(const Value: TTitlePosition);
  367. begin
  368. if FTitlePosition <> Value then begin
  369. FTitlePosition := Value;
  370. Changed;
  371. end;
  372. end;
  373. procedure TFlatSkin.SetTransparent(const Value: TTransparentMode);
  374. begin
  375. if FTransparent <> Value then begin
  376. FTransparent := Value;
  377. Changed;
  378. end;
  379. end;
  380. procedure TFlatSkin.SetUseBitmap(const Index: Integer; const Value: boolean);
  381. begin
  382. case index of
  383. 0:FBarUseBitmap := Value;
  384. 1:FBackUseBitmap := Value;
  385. 2:FTitleUseBitmap := Value;
  386. 3:FItemLineHas := Value;
  387. end;
  388. Changed;
  389. end;
  390. procedure TFlatSkin.SetUserFace(const Value: TStyleFace);
  391. begin
  392. if FUserFace <> Value then begin
  393. FUserFace := Value;
  394. Changed;
  395. end;
  396. end;
  397. procedure TFlatSkin.SetParentFont(const Value: boolean);
  398. begin
  399. if FParentFont <> Value then begin
  400. FParentFont := Value;
  401. if (FParentFont)and(FParent<>nil) then begin
  402. FTitleFont.Assign(TVersionControl(Parent).Font);
  403. end;
  404. Changed;
  405. end;
  406. end;
  407. function TFlatSkin.GetParent: TControl;
  408. begin
  409. Result := FParent;
  410. end;
  411. { TCheckStyle }
  412. procedure TCheckStyle.Assign(Source: TPersistent);
  413. begin
  414. if Source is TCheckStyle then
  415. begin
  416. FSelectColor := TCheckStyle(Source).SelectColor;
  417. FSelectBackdropColor := TCheckStyle(Source).SelectBackdropColor;
  418. FSelectBorderColor := TCheckStyle(Source).SelectBorderColor;
  419. FSelectPosition := TCheckStyle(Source).SelectPosition;
  420. FSelectSize := TCheckStyle(Source).SelectSize;
  421. FSelectCheckColor := TCheckStyle(Source).SelectCheckColor;
  422. FSelectStartColor := TCheckStyle(Source).SelectStartColor;
  423. FSelectStopColor := TCheckStyle(Source).SelectStopColor;
  424. FSelectOrien := TCheckStyle(Source).SelectOrien;
  425. Changed;
  426. Exit;
  427. end;
  428. inherited Assign(Source);
  429. end;
  430. constructor TCheckStyle.Create;
  431. begin
  432. inherited Create;
  433. FSelectColor := DefaultCheckSelectColor;
  434. FSelectBackdropColor := DefaultCheckBackColor;
  435. FSelectBorderColor := DefaultCheckBorderColor;
  436. FSelectStartColor := DefaultSelectStartColor;
  437. FSelectStopColor := DefaultSelectStopColor;
  438. FSelectOrien := bsVertical;
  439. FSelectSize := 12;
  440. FSelectCheckColor := DefaultFlatColor;
  441. end;
  442. procedure TCheckStyle.SetColors(const Index: Integer; const Value: TColor);
  443. begin
  444. case index of
  445. 0:FSelectColor := Value;
  446. 1:FSelectBackdropColor := Value;
  447. 2:FSelectBorderColor := Value;
  448. 3:FSelectStartColor := Value;
  449. 4:FSelectStopColor := Value;
  450. 5:FSelectCheckColor := Value;
  451. end;
  452. Changed;
  453. end;
  454. procedure TCheckStyle.SetSelectPosition(const Value: TCheckPosition);
  455. begin
  456. if FSelectPosition <> value then begin
  457. FSelectPosition := Value;
  458. Changed;
  459. end;
  460. end;
  461. procedure TCheckStyle.SetSelectOrien(const Value: TStyleOrien);
  462. begin
  463. if FSelectOrien <> value then begin
  464. FSelectOrien := Value;
  465. Changed;
  466. end;
  467. end;
  468. procedure TCheckStyle.SetSelectSize(Value: Integer);
  469. begin
  470. if FSelectSize <> value then begin
  471. if Value < 12 then
  472. Value := 12;
  473. FSelectSize := Value;
  474. Changed;
  475. end;
  476. end;
  477. { TListStyle }
  478. procedure TListStyle.Assign(Source: TPersistent);
  479. begin
  480. if Source is TListStyle then
  481. begin
  482. FItemAlignment := TListStyle(Source).ItemAlignment;
  483. Changed;
  484. exit;
  485. end;
  486. inherited Assign(Source);
  487. end;
  488. constructor TListStyle.Create;
  489. begin
  490. inherited Create;
  491. FItemAlignment := stLeft;
  492. end;
  493. procedure TListStyle.SetItemAlignment(const Value: TAlignmentText);
  494. begin
  495. if FItemAlignment <> Value then begin
  496. FItemAlignment := Value;
  497. Changed;
  498. end;
  499. end;
  500. end.