~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to lcl/customdrawndrawers.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

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