1 unit CustomDrawnDrawers;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, Types, fpcanvas, fpimage,
9 // LCL for types
10 Controls, Graphics, ComCtrls, ExtCtrls, LazUTF8;
11
12 const
13 CDDRAWSTYLE_COUNT = 19;
14
15 cddTestStr = 'ŹÇ'; // Used for testing text height
16
17 // Measures
18 TCDEDIT_LEFT_TEXT_SPACING = $400; // The space between the start of the text and the left end of the control
19 TCDEDIT_RIGHT_TEXT_SPACING = $401; // The space between the end of the text and the right end of the control
20 TCDEDIT_TOP_TEXT_SPACING = $402;
21 TCDEDIT_BOTTOM_TEXT_SPACING= $403;
22
23 TCDCHECKBOX_SQUARE_HALF_HEIGHT = $500;
24 TCDCHECKBOX_SQUARE_HEIGHT = $501;
25
26 TCDRADIOBUTTON_CIRCLE_HEIGHT = $601;
27
28 TCDCOMBOBOX_DEFAULT_HEIGHT = $801;
29
30 TCDSCROLLBAR_BUTTON_WIDTH = $900;
31 TCDSCROLLBAR_LEFT_SPACING = $901; // Left and right are only read left and right for horizontal orientation
32 TCDSCROLLBAR_RIGHT_SPACING= $902; // in vertical orientation they are respectively top and bottom
33 TCDSCROLLBAR_LEFT_BUTTON_POS =$903; // Positive Pos means it relative to the left margin,
34 TCDSCROLLBAR_RIGHT_BUTTON_POS=$904; // negative that it is relative to the right margin
35
36 TCDTRACKBAR_LEFT_SPACING = $1000;
37 TCDTRACKBAR_RIGHT_SPACING = $1001;
38 TCDTRACKBAR_TOP_SPACING = $1002;
39 TCDTRACKBAR_FRAME_HEIGHT = $1003;
40
41 TCDLISTVIEW_COLUMN_LEFT_SPACING = $1200;
42 TCDLISTVIEW_COLUMN_RIGHT_SPACING = $1201;
43 TCDLISTVIEW_COLUMN_TEXT_LEFT_SPACING = $1202;
44 TCDLISTVIEW_LINE_TOP_SPACING = $1203;
45 TCDLISTVIEW_LINE_BOTTOM_SPACING = $1204;
46
47 TCDTOOLBAR_ITEM_SPACING = $1300;
48 TCDTOOLBAR_ITEM_ARROW_WIDTH = $1301;
49 TCDTOOLBAR_ITEM_BUTTON_DEFAULT_WIDTH = $1303;
50 TCDTOOLBAR_ITEM_ARROW_RESERVED_WIDTH = $1304;
51 TCDTOOLBAR_ITEM_SEPARATOR_DEFAULT_WIDTH = $1305;
52 TCDTOOLBAR_DEFAULT_HEIGHT = $1306;
53
54 TCDCTABCONTROL_CLOSE_TAB_BUTTON_WIDTH = $2600;
55 TCDCTABCONTROL_CLOSE_TAB_BUTTON_EXTRA_SPACING = $2601;
56
57 // Measures Ex
58 TCDCONTROL_CAPTION_WIDTH = $100;
59 TCDCONTROL_CAPTION_HEIGHT = $101;
60
61 TCDCTABCONTROL_TAB_HEIGHT = $2600;
62 TCDCTABCONTROL_TAB_WIDTH = $2601;
63 TCDCTABCONTROL_TAB_LEFT_POS = $2602;
64 TCDCTABCONTROL_CLOSE_BUTTON_POS_X = $2603;
65 TCDCTABCONTROL_CLOSE_BUTTON_POS_Y = $2604;
66
67 // Colors
68 TCDEDIT_BACKGROUND_COLOR = $400;
69 TCDEDIT_TEXT_COLOR = $401;
70 TCDEDIT_SELECTED_BACKGROUND_COLOR = $402;
71 TCDEDIT_SELECTED_TEXT_COLOR = $403;
72
73 // Default Colors
74 TCDBUTTON_DEFAULT_COLOR = $10000;
75
76 type
77
78 TCDDrawStyle = (
79 // The default is given by the DefaultStyle global variable
80 // Don't implement anything for this drawer
81 dsDefault = 0,
82 // This is a common drawer, with a minimal implementation on which other
83 // drawers base on
84 dsCommon,
85 // Operating system styles
86 dsWinCE, dsWin2000, dsWinXP, dsWindows7,
87 dsKDEPlastique, dsGNOME, dsMacOSX,
88 dsAndroid,
89 // Other special styles for the user
90 dsExtra1, dsExtra2, dsExtra3, dsExtra4, dsExtra5,
91 dsExtra6, dsExtra7, dsExtra8, dsExtra9, dsExtra10
92 );
93
94 // Inspired by http://doc.qt.nokia.com/stable/qstyle.html#StateFlag-enum
95 TCDControlStateFlag = (
96 // Basic state flags
97 csfEnabled,
98 csfRaised, // Raised beyond the normal state, unlike Qt for buttons
99 csfSunken,
100 csfHasFocus,
101 csfReadOnly,
102 csfMouseOver,
103 // for TCDCheckBox, TCDRadioButton
104 csfOn,
105 csfOff,
106 csfPartiallyOn,
107 // for TCDScrollBar, TCDProgressBar
108 csfHorizontal,
109 csfVertical,
110 csfRightToLeft,
111 csfTopDown,
112 // for TCDProgressBar, TCDScrollBar, TCDComboBox
113 csfLeftArrow,
114 csfRightArrow,
115 csfDownArrow,
116 csfUpArrow
117 { // for tool button
118 csfAutoRaise,
119 csfTop,
120 csfBottom,
121 csfFocusAtBorder,
122 csfSelected,
123 csfActive,
124 csfWindow,
125 csfOpen,
126 csfChildren,
127 csfItem,
128 csfSibling,
129 csfEditing,
130 csfKeyboardFocusChange,
131 // For Mac OS X
132 csfSmall,
133 csfMini}
134 );
135
136 TCDControlState = set of TCDControlStateFlag;
137
138 TCDControlStateEx = class
139 public
140 ParentRGBColor: TColor;
141 FPParentRGBColor: TFPColor;
142 RGBColor: TColor;
143 FPRGBColor: TFPColor;
144 Caption: string;
145 Font: TFont; // Just a reference, never Free
146 AutoSize: Boolean;
147 end;
148
149 TCDButtonStateEx = class(TCDControlStateEx)
150 public
151 Glyph: TBitmap; // Just a reference, never Free
152 end;
153
154 TCDEditStateEx = class(TCDControlStateEx)
155 public
156 CaretIsVisible: Boolean;
157 CaretPos: TPoint; // X and Y are zero-based positions
158 SelStart: TPoint; // X and Y are zero-based positions
159 SelLength: Integer; // zero means no selection. Negative numbers selection to the left from the start and positive ones to the right
160 VisibleTextStart: TPoint; // X is 1-based, Y is 0-based
161 EventArrived: Boolean; // Added by event handlers and used by the caret so that it stops blinking while events are incoming
162 MultiLine: Boolean;
163 Lines: TStrings; // Just a reference, never Free
164 FullyVisibleLinesCount, LineHeight: Integer; // Filled on drawing to be used in customdrawncontrols.pas
165 PasswordChar: Char;
166 // customizable extra margins, zero is the base value
167 LeftTextMargin, RightTextMargin: Integer;
168 // For the combo box for example
169 ExtraButtonState: TCDControlState;
170 end;
171
172 TCDPanelStateEx = class(TCDControlStateEx)
173 public
174 BevelInner: TPanelBevel;
175 BevelOuter: TPanelBevel;
176 BevelWidth: TBevelWidth;
177 end;
178
179 TCDPositionedCStateEx = class(TCDControlStateEx)
180 public
181 PosCount: integer; // The number of positions, calculated as Max - Min + 1
182 Position: integer; // A zero-based position, therefore it is = Position - Min
183 FloatPos: Double; // The same position, but as a float between 0.0 and 1.0
184 FloatPageSize: Double; // The page size as a float between 0.0 and 1.0
185 end;
186
187 TCDProgressBarStateEx = class(TCDControlStateEx)
188 public
189 BarShowText: Boolean;
190 PercentPosition: Double; // a float between 0.0 and 1.0 (1=full)
191 Smooth: Boolean;
192 Style: TProgressBarStyle;
193 end;
194
195 // TCDListItems are implemented as a tree with 2 levels beyond the first node
196 TCDListItems = class
197 private
198 procedure DoFreeItem(data,arg:pointer);
199 public
200 // These fields are not used in the first node of the tree
201 Caption: string;
202 ImageIndex: Integer;
203 StateIndex: Integer;
204 //
205 Childs: TFPList;
206 constructor Create;
207 destructor Destroy; override;
208 function Add(ACaption: string; AImageIndex, AStateIndex: Integer): TCDListItems;
209 function GetItem(AIndex: Integer): TCDListItems;
210 function GetItemCount: Integer;
211 end;
212
213 TCDListViewStateEx = class(TCDControlStateEx)
214 public
215 Columns: TListColumns; // just a reference, never free
216 Items: TCDListItems; // just a reference, never free
217 ViewStyle: TViewStyle;
218 FirstVisibleColumn: Integer; // 0-based index
219 FirstVisibleLine: Integer; // 0-based index, remember that the header is always visible or always invisible
220 ShowColumnHeader: Boolean;
221 end;
222
223 // ToolBar Start
224
225 TCDToolbarItemKind = (tikButton, tikCheckButton, tikDropDownButton,
226 tikSeparator, tikDivider);
227
228 TCDToolbarItemSubpartKind = (tiskMain, tiskArrow);
229
230 TCDToolBarItem = class
231 Kind: TCDToolbarItemKind;
232 SubpartKind: TCDToolbarItemSubpartKind;
233 Image: TBitmap;
234 Caption: string;
235 Width: Integer;
236 Down: Boolean;
237 // filled for drawing
238 State: TCDControlState;
239 end;
240
241 TCDToolBarStateEx = class(TCDControlStateEx)
242 ShowCaptions: Boolean;
243 IsVertical: Boolean;
244 Items: TFPList; // of TCDToolBarItem
245 ToolBarHeight: Integer;
246 end;
247
248 // ToolBar End
249
250 TCDCTabControlStateEx = class(TCDControlStateEx)
251 public
252 LeftmostTabVisibleIndex: Integer;
253 Tabs: TStringList; // Just a reference, don't Free
254 TabIndex: Integer;
255 TabCount: Integer;
256 Options: TCTabControlOptions;
257 // Used internally by the drawers
258 CurTabIndex: Integer;// For Tab routines, obtain the index
259 CurStartLeftPos: Integer;
260 end;
261
262 TCDSpinStateEx = class(TCDPositionedCStateEx)
263 public
264 Min: integer;
265 Increment: integer;
266 FloatMin: Double;
267 FloatIncrement: Double;
268 end;
269
270 TCDControlID = (
271 cidControl,
272 // Standard
273 cidMenu, cidPopUp, cidButton, cidEdit, cidCheckBox, cidRadioButton,
274 cidListBox, cidComboBox, cidScrollBar, cidGroupBox, cidPanel,
275 // Additional
276 cidStaticText,
277 // Common Controls
278 cidTrackBar, cidProgressBar, cidListView, cidToolBar, cidCTabControl
279 );
280
281 { TCDColorPalette }
282
283 TCDColorPalette = class
284 public
285 ScrollBar, Background, ActiveCaption, InactiveCaption,
286 Menu, Window, WindowFrame, MenuText, WindowText, CaptionText,
287 ActiveBorder, InactiveBorder, AppWorkspace, Highlight, HighlightText,
288 BtnFace, BtnShadow, GrayText, BtnText, InactiveCaptionText,
289 BtnHighlight, color3DDkShadow, color3DLight, InfoText, InfoBk,
290 //
291 HotLight, GradientActiveCaption, GradientInactiveCaption,
292 MenuHighlight, MenuBar, Form: TColor;
293 procedure Assign(AFrom: TCDColorPalette);
294 end;
295
296 { There are 5 possible sources of input for color palettes:
297 palDefault - Uses palNative when the operating system matches the drawer style,
298 palFallback otherwise
299 palNative - Obtain from the operating system
300 palFallback - Use the fallback colors of the drawer
301 palUserConfig-Load it from the user configuration files, ToDo
302 palCustom - The user application has set its own palette
303 }
304 TCDPaletteKind = (palDefault, palNative, palFallback, palUserConfig, palCustom);
305
306 { TCDDrawer }
307
308 TCDDrawer = class
309 protected
310 public
311 Palette: TCDColorPalette;
312 FallbackPalette: TCDColorPalette;
313 PaletteKind: TCDPaletteKind;
314 constructor Create; virtual;
315 destructor Destroy; override;
316 procedure CreateResources; virtual;
317 procedure LoadResources; virtual;
318 procedure FreeResources; virtual;
319 procedure ScaleRasterImage(ARasterImage: TRasterImage; ASourceDPI, ADestDPI: Word);
320 procedure LoadPalette;
321 procedure LoadNativePaletteColors;
322 procedure LoadFallbackPaletteColors; virtual;
PalDefaultUsesNativePalettenull323 function PalDefaultUsesNativePalette: Boolean; virtual;
GetDrawStylenull324 function GetDrawStyle: TCDDrawStyle; virtual;
VisibleTextnull325 class function VisibleText(const aVisibleText: TCaption; const APasswordChar: Char): TCaption;
326 // GetControlDefaultColor is used by customdrawncontrols to resolve clDefault
GetControlDefaultColornull327 function GetControlDefaultColor(AControlId: TCDControlID): TColor;
328 // General
GetMeasuresnull329 function GetMeasures(AMeasureID: Integer): Integer; virtual; abstract;
GetMeasuresExnull330 function GetMeasuresEx(ADest: TCanvas; AMeasureID: Integer;
331 AState: TCDControlState; AStateEx: TCDControlStateEx): Integer; virtual; abstract;
332 procedure CalculatePreferredSize(ADest: TCanvas; AControlId: TCDControlID;
333 AState: TCDControlState; AStateEx: TCDControlStateEx;
334 var PreferredWidth, PreferredHeight: integer; WithThemeSpace, AAllowUseOfMeasuresEx: Boolean); virtual; abstract;
GetColornull335 function GetColor(AColorID: Integer): TColor; virtual; abstract;
GetClientAreanull336 function GetClientArea(ADest: TCanvas; ASize: TSize; AControlId: TCDControlID;
337 AState: TCDControlState; AStateEx: TCDControlStateEx): TRect; virtual; abstract;
338 // To set a different position to draw the control then (0, 0) use the window org of the canvas
339 procedure DrawControl(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
340 AControl: TCDControlID; AState: TCDControlState; AStateEx: TCDControlStateEx);
341 // General drawing routines. The ones using TFPCustomCanvas are reusable in LCL-CustomDrawn
342 procedure DrawFocusRect(ADest: TFPCustomCanvas; ADestPos: TPoint; ASize: TSize); virtual; abstract;
343 procedure DrawRaisedFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize); virtual; abstract;
344 procedure DrawFrame3D(ADest: TFPCustomCanvas; ADestPos: TPoint; ASize: TSize;
345 const FrameWidth : integer; const Style : TBevelCut); virtual; abstract;
346 procedure DrawSunkenFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize); virtual; abstract;
347 procedure DrawShallowSunkenFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize); virtual; abstract;
348 procedure DrawTickmark(ADest: TFPCustomCanvas; ADestPos: TPoint; AState: TCDControlState); virtual; abstract;
349 procedure DrawSlider(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState); virtual; abstract;
350 procedure DrawArrow(ADest: TCanvas; ADestPos: TPoint; ADirection: TCDControlState; ASize: Integer = 7); virtual; abstract;
351 // Extra buttons drawing routines
352 procedure DrawSmallCloseButton(ADest: TCanvas; ADestPos: TPoint); virtual; abstract;
353 procedure DrawButtonWithArrow(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState); virtual; abstract;
354 // TCDControl
355 procedure DrawControl(ADest: TCanvas; ASize: TSize;
356 AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
357 // TCDButton
358 procedure DrawButton(ADest: TFPCustomCanvas; ADestPos: TPoint; ASize: TSize;
359 AState: TCDControlState; AStateEx: TCDButtonStateEx); virtual; abstract;
360 // TCDEdit
361 procedure DrawEditBackground(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
362 AState: TCDControlState; AStateEx: TCDEditStateEx); virtual; abstract;
363 procedure DrawEditFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
364 AState: TCDControlState; AStateEx: TCDEditStateEx); virtual; abstract;
365 procedure DrawCaret(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
366 AState: TCDControlState; AStateEx: TCDEditStateEx); virtual; abstract;
367 procedure DrawEdit(ADest: TCanvas; ASize: TSize;
368 AState: TCDControlState; AStateEx: TCDEditStateEx); virtual; abstract;
369 // TCDCheckBox
370 procedure DrawCheckBoxSquare(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
371 AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
372 procedure DrawCheckBox(ADest: TCanvas; ASize: TSize;
373 AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
374 // TCDRadioButton
375 procedure DrawRadioButtonCircle(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
376 AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
377 procedure DrawRadioButton(ADest: TCanvas; ASize: TSize;
378 AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
379 // TCDComboBox
380 procedure DrawComboBox(ADest: TCanvas; ASize: TSize;
381 AState: TCDControlState; AStateEx: TCDEditStateEx); virtual; abstract;
382 // TCDScrollBar
383 procedure DrawScrollBar(ADest: TCanvas; ASize: TSize;
384 AState: TCDControlState; AStateEx: TCDPositionedCStateEx); virtual; abstract;
385 // TCDGroupBox
386 procedure DrawGroupBox(ADest: TFPCustomCanvas; ADestPos: TPoint; ASize: TSize;
387 AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
388 // TCDPanel
389 procedure DrawPanel(ADest: TCanvas; ASize: TSize;
390 AState: TCDControlState; AStateEx: TCDPanelStateEx); virtual; abstract;
391 // ===================================
392 // Additional Tab
393 // ===================================
394 procedure DrawStaticText(ADest: TCanvas; ASize: TSize;
395 AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
396 // ===================================
397 // Common Controls Tab
398 // ===================================
399 // TCDTrackBar
400 procedure DrawTrackBar(ADest: TCanvas; ASize: TSize;
401 AState: TCDControlState; AStateEx: TCDPositionedCStateEx); virtual; abstract;
402 // TCDProgressBar
403 procedure DrawProgressBar(ADest: TCanvas; ASize: TSize;
404 AState: TCDControlState; AStateEx: TCDProgressBarStateEx); virtual; abstract;
405 // TCDListView
406 procedure DrawListView(ADest: TCanvas; ASize: TSize;
407 AState: TCDControlState; AStateEx: TCDListViewStateEx); virtual; abstract;
408 procedure DrawReportListView(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
409 AState: TCDControlState; AStateEx: TCDListViewStateEx); virtual; abstract;
410 procedure DrawReportListViewItem(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
411 ACurItem: TCDListItems; AState: TCDControlState; AStateEx: TCDListViewStateEx); virtual; abstract;
412 // TCDToolBar
413 procedure DrawToolBar(ADest: TCanvas; ASize: TSize;
414 AState: TCDControlState; AStateEx: TCDToolBarStateEx); virtual; abstract;
415 procedure DrawToolBarItem(ADest: TCanvas; ASize: TSize;
416 ACurItem: TCDToolBarItem; AX, AY: Integer;
417 AState: TCDControlState; AStateEx: TCDToolBarStateEx); virtual; abstract;
418 // TCDCustomTabControl
419 procedure DrawCTabControl(ADest: TCanvas; ASize: TSize;
420 AState: TCDControlState; AStateEx: TCDCTabControlStateEx); virtual; abstract;
421 procedure DrawCTabControlFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
422 AState: TCDControlState; AStateEx: TCDCTabControlStateEx); virtual; abstract;
423 procedure DrawTabSheet(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
424 AState: TCDControlState; AStateEx: TCDCTabControlStateEx); virtual; abstract;
425 procedure DrawTabs(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
426 AState: TCDControlState; AStateEx: TCDCTabControlStateEx); virtual; abstract;
427 procedure DrawTab(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
428 AState: TCDControlState; AStateEx: TCDCTabControlStateEx); virtual; abstract;
429 // ===================================
430 // Misc Tab
431 // ===================================
432 procedure DrawSpinEdit(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
433 AState: TCDControlState; AStateEx: TCDSpinStateEx); virtual; abstract;
434 end;
435
436 procedure RegisterDrawer(ADrawer: TCDDrawer; AStyle: TCDDrawStyle);
GetDefaultDrawernull437 function GetDefaultDrawer: TCDDrawer;
GetDrawernull438 function GetDrawer(AStyle: TCDDrawStyle): TCDDrawer;
439
440 var
441 DefaultStyle: TCDDrawStyle = dsCommon; // For now default to the most complete one, later per platform
442
443 implementation
444
445 var
446 RegisteredDrawers: array[TCDDrawStyle] of TCDDrawer
447 = (nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil);
448
449 procedure RegisterDrawer(ADrawer: TCDDrawer; AStyle: TCDDrawStyle);
450 begin
451 if RegisteredDrawers[AStyle] <> nil then RegisteredDrawers[AStyle].Free;
452 RegisteredDrawers[AStyle] := ADrawer;
453 end;
454
GetDefaultDrawernull455 function GetDefaultDrawer: TCDDrawer;
456 begin
457 Result := GetDrawer(dsDefault);
458 end;
459
GetDrawernull460 function GetDrawer(AStyle: TCDDrawStyle): TCDDrawer;
461 var
462 lDrawStyle: TCDDrawStyle;
463 begin
464 if AStyle = dsDefault then lDrawStyle := DefaultStyle
465 else lDrawStyle := AStyle;
466 Result := RegisteredDrawers[lDrawStyle];
467 end;
468
469 var
470 i: Integer;
471
472 { TCDColorPalette }
473
474 procedure TCDColorPalette.Assign(AFrom: TCDColorPalette);
475 begin
476 ScrollBar := AFrom.ScrollBar;
477 Background := AFrom.Background;
478 ActiveCaption := AFrom.ActiveCaption;
479 InactiveCaption := AFrom.InactiveCaption;
480 Menu := AFrom.Menu;
481 Window := AFrom.Window;
482 WindowFrame := AFrom.WindowFrame;
483 MenuText := AFrom.MenuText;
484 WindowText := AFrom.WindowText;
485 CaptionText := AFrom.CaptionText;
486 ActiveBorder := AFrom.ActiveBorder;
487 InactiveBorder := AFrom.InactiveBorder;
488 AppWorkspace := AFrom.AppWorkspace;
489 Highlight := AFrom.Highlight;
490 HighlightText := AFrom.HighlightText;
491 BtnFace := AFrom.BtnFace;
492 BtnShadow := AFrom.BtnShadow;
493 GrayText := AFrom.GrayText;
494 BtnText := AFrom.BtnText;
495 InactiveCaptionText := AFrom.InactiveCaptionText;
496 BtnHighlight := AFrom.BtnHighlight;
497 color3DDkShadow := AFrom.color3DDkShadow;
498 color3DLight := AFrom.color3DLight;
499 InfoText := AFrom.InfoText;
500 InfoBk := AFrom.InfoBk;
501 //
502 HotLight := AFrom.HotLight;
503 GradientActiveCaption := AFrom.GradientActiveCaption;
504 GradientInactiveCaption := AFrom.GradientInactiveCaption;
505 MenuHighlight := AFrom.MenuHighlight;
506 MenuBar := AFrom.MenuBar;
507 Form := AFrom.Form;
508 end;
509
510 { TCDListItems }
511
512 procedure TCDListItems.DoFreeItem(data, arg: pointer);
513 begin
514 TCDListItems(data).Free;
515 end;
516
517 constructor TCDListItems.Create;
518 begin
519 inherited Create;
520 Childs := TFPList.Create;
521 end;
522
523 destructor TCDListItems.Destroy;
524 begin
525 Childs.ForEachCall(@DoFreeItem, nil);
526 Childs.Free;
527 inherited Destroy;
528 end;
529
Addnull530 function TCDListItems.Add(ACaption: string; AImageIndex, AStateIndex: Integer
531 ): TCDListItems;
532 begin
533 Result := TCDListItems.Create;
534 Result.Caption := ACaption;
535 Result.ImageIndex := AImageIndex;
536 Result.StateIndex := AStateIndex;
537 Childs.Add(Pointer(Result));
538 end;
539
GetItemnull540 function TCDListItems.GetItem(AIndex: Integer): TCDListItems;
541 begin
542 Result := TCDListItems(Childs.Items[AIndex]);
543 end;
544
GetItemCountnull545 function TCDListItems.GetItemCount: Integer;
546 begin
547 Result := Childs.Count;
548 end;
549
550 { TCDDrawer }
551
552 constructor TCDDrawer.Create;
553 begin
554 inherited Create;
555
556 // We never load the system palette at creation because we might get created
557 // before the Widgetset is constructed
558 Palette := TCDColorPalette.Create;
559 LoadFallbackPaletteColors();
560 FallbackPalette := TCDColorPalette.Create;
561 FallbackPalette.Assign(Palette);
562 PaletteKind := palDefault;
563
564 CreateResources;
565 LoadResources;
566 end;
567
568 destructor TCDDrawer.Destroy;
569 begin
570 FreeResources;
571 Palette.Free;
572 FallbackPalette.Free;
573
574 inherited Destroy;
575 end;
576
577 procedure TCDDrawer.CreateResources;
578 begin
579
580 end;
581
582 procedure TCDDrawer.LoadResources;
583 begin
584
585 end;
586
587 procedure TCDDrawer.FreeResources;
588 begin
589
590 end;
591
592 procedure TCDDrawer.ScaleRasterImage(ARasterImage: TRasterImage; ASourceDPI, ADestDPI: Word);
593 var
594 lNewWidth, lNewHeight: Int64;
595 lTmpBmp: TBitmap;
596 begin
597 lNewWidth := Round(ARasterImage.Width * ADestDPI / ASourceDPI);
598 lNewHeight := Round(ARasterImage.Height * ADestDPI / ASourceDPI);
599 lTmpBmp := TBitmap.Create;
600 try
601 lTmpBmp.Width := ARasterImage.Width;
602 lTmpBmp.Height := ARasterImage.Height;
603 lTmpBmp.Canvas.Draw(0, 0, ARasterImage);
604 ARasterImage.Canvas.StretchDraw(Bounds(0, 0, lNewWidth, lNewHeight), lTmpBmp);
605 finally
606 lTmpBmp.Free;
607 end;
608 ARasterImage.Width := lNewWidth;
609 ARasterImage.Height := lNewHeight;
610 end;
611
612 procedure TCDDrawer.LoadPalette;
613 begin
614 case PaletteKind of
615 palDefault:
616 begin
617 if PalDefaultUsesNativePalette() then LoadNativePaletteColors()
618 else LoadFallbackPaletteColors();
619 end;
620 palNative: LoadNativePaletteColors();
621 palFallback: LoadFallbackPaletteColors();
622 //palUserConfig:
623 end;
624 end;
625
626 procedure TCDDrawer.LoadNativePaletteColors;
627 begin
628 Palette.ScrollBar := ColorToRGB(clScrollBar);
629 Palette.Background := ColorToRGB(clBackground);
630 Palette.ActiveCaption := ColorToRGB(clActiveCaption);
631 Palette.InactiveCaption := ColorToRGB(clInactiveCaption);
632 Palette.Menu := ColorToRGB(clMenu);
633 Palette.Window := ColorToRGB(clWindow);
634 Palette.WindowFrame := ColorToRGB(clWindowFrame);
635 Palette.MenuText := ColorToRGB(clMenuText);
636 Palette.WindowText := ColorToRGB(clWindowText);
637 Palette.CaptionText := ColorToRGB(clCaptionText);
638 Palette.ActiveBorder := ColorToRGB(clActiveBorder);
639 Palette.InactiveBorder := ColorToRGB(clInactiveBorder);
640 Palette.AppWorkspace := ColorToRGB(clAppWorkspace);
641 Palette.Highlight := ColorToRGB(clHighlight);
642 Palette.HighlightText := ColorToRGB(clHighlightText);
643 Palette.BtnFace := ColorToRGB(clBtnFace);
644 Palette.BtnShadow := ColorToRGB(clBtnShadow);
645 Palette.GrayText := ColorToRGB(clGrayText);
646 Palette.BtnText := ColorToRGB(clBtnText);
647 Palette.InactiveCaptionText := ColorToRGB(clInactiveCaptionText);
648 Palette.BtnHighlight := ColorToRGB(clBtnHighlight);
649 Palette.color3DDkShadow := ColorToRGB(cl3DDkShadow);
650 Palette.color3DLight := ColorToRGB(cl3DLight);
651 Palette.InfoText := ColorToRGB(clInfoText);
652 Palette.InfoBk := ColorToRGB(clInfoBk);
653
654 Palette.HotLight := ColorToRGB(clHotLight);
655 Palette.GradientActiveCaption := ColorToRGB(clGradientActiveCaption);
656 Palette.GradientInactiveCaption := ColorToRGB(clGradientInactiveCaption);
657 Palette.MenuHighlight := ColorToRGB(clMenuHighlight);
658 Palette.MenuBar := ColorToRGB(clMenuBar);
659 Palette.Form := ColorToRGB(clForm);
660 end;
661
662 procedure TCDDrawer.LoadFallbackPaletteColors;
663 begin
664
665 end;
666
PalDefaultUsesNativePalettenull667 function TCDDrawer.PalDefaultUsesNativePalette: Boolean;
668 begin
669 Result := False;
670 end;
671
TCDDrawer.GetDrawStylenull672 function TCDDrawer.GetDrawStyle: TCDDrawStyle;
673 begin
674 Result := dsCommon;
675 end;
676
TCDDrawer.VisibleTextnull677 class function TCDDrawer.VisibleText(const aVisibleText: TCaption; const APasswordChar: Char): TCaption;
678 begin
679 if aPasswordChar = #0 then
680 result := aVisibleText
681 else
682 result := StringOfChar( aPasswordChar, UTF8Length(aVisibleText) );
683 end;
684
685 { Control colors can refer to their background or foreground }
TCDDrawer.GetControlDefaultColornull686 function TCDDrawer.GetControlDefaultColor(AControlId: TCDControlID): TColor;
687 begin
688 case AControlId of
689 cidControl: Result := Palette.Form;
690 cidButton: Result := Palette.BtnFace;// foreground color
691 cidEdit: Result := Palette.Window; // foreground color
692 cidCheckBox: Result := Palette.Form; // background color
693 cidGroupBox: Result := Palette.Form; // ...
694 //
695 cidStaticText: Result := Palette.Form; // ...
696 //
697 cidTrackBar: Result := Palette.Form; // ...
698 cidProgressBar: Result := Palette.Form; // foreground color
699 cidListView: Result := Palette.Window; // foreground color
700 cidCTabControl: Result := Palette.Form; // foreground color
701 else
702 Result := Palette.Form;
703 end;
704 end;
705
706 procedure TCDDrawer.DrawControl(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
707 AControl: TCDControlID; AState: TCDControlState; AStateEx: TCDControlStateEx
708 );
709 begin
710 case AControl of
711 cidControl: DrawControl(ADest, ASize, AState, AStateEx);
712 //
713 cidButton: DrawButton(ADest, ADestPos, ASize, AState, TCDButtonStateEx(AStateEx));
714 cidEdit: DrawEdit(ADest, ASize, AState, TCDEditStateEx(AStateEx));
715 cidCheckBox: DrawCheckBox(ADest, ASize, AState, AStateEx);
716 cidRadioButton:DrawRadioButton(ADest, ASize, AState, AStateEx);
717 cidComboBox: DrawComboBox(ADest, ASize, AState, TCDEditStateEx(AStateEx));
718 cidScrollBar: DrawScrollBar(ADest, ASize, AState, TCDPositionedCStateEx(AStateEx));
719 cidGroupBox: DrawGroupBox(ADest, ADestPos, ASize, AState, AStateEx);
720 cidPanel: DrawPanel(ADest, ASize, AState, TCDPanelStateEx(AStateEx));
721 //
722 cidStaticText: DrawStaticText(ADest, ASize, AState, AStateEx);
723 //
724 cidTrackBar: DrawTrackBar(ADest, ASize, AState, TCDPositionedCStateEx(AStateEx));
725 cidProgressBar:DrawProgressBar(ADest, ASize, AState, TCDProgressBarStateEx(AStateEx));
726 cidListView: DrawListView(ADest, ASize, AState, TCDListViewStateEx(AStateEx));
727 cidToolBar: DrawToolBar(ADest, ASize, AState, TCDToolBarStateEx(AStateEx));
728 cidCTabControl:DrawCTabControl(ADest, ASize, AState, TCDCTabControlStateEx(AStateEx));
729 end;
730 end;
731
732 finalization
733 // Free all drawers
734 for i := 0 to CDDRAWSTYLE_COUNT-1 do
735 begin
736 if RegisteredDrawers[TCDDrawStyle(i)] <> nil then
737 begin
738 RegisteredDrawers[TCDDrawStyle(i)].Free;
739 RegisteredDrawers[TCDDrawStyle(i)] := nil;
740 end;
741 end;
742 end.
743
744