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

« back to all changes in this revision

Viewing changes to components/customdrawn/customdrawnextras.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:
4
4
  License: The same modifying LGPL with static linking exception as the LCL
5
5
 
6
6
  This unit should be a repository for various custom drawn components,
7
 
  such as a custom drawn version of TButton, of TEdit, of TPageControl, etc,
8
 
  eventually forming a full set of custom drawn components.
 
7
  which are not in the unit customdrawncontrols,
 
8
  and also property editors for the customdrawnextras
9
9
}
10
10
unit customdrawnextras;
11
11
 
15
15
 
16
16
uses
17
17
  Classes, SysUtils, Graphics, Controls, LCLType, LCLIntf, IntfGraphics,
18
 
  Math, customdrawnutils, contnrs, componenteditors, LMessages, Messages,
19
 
  LCLProc, PropEdits,
 
18
  Math, types, contnrs, componenteditors, LMessages, Messages,
 
19
  LCLProc, PropEdits, ExtCtrls, ImgList, Forms, Menus,
 
20
  customdrawncontrols,
20
21
  // fpimage
21
22
  fpcanvas, fpimgcanv, fpimage
22
23
  {$ifdef CUSTOMDRAWN_USE_FREETYPE}
33
34
 
34
35
  TBitmappedButtonOptions = set of TBitmappedButtonOption;
35
36
 
36
 
  // commented items are not yet supported
37
 
  TBitmappedButtonState = (bbsNormal, bbsDown, bbsMouseOver, bbsFocused
38
 
    (* bbsChecked, bbsCheckedSelected, bbsCheckedDown { is going to be unchecked }*));
39
 
 
40
 
  TCDDrawStyle = (dsWinCE, dsAndroid, dsXPTaskBar, dsCustom);
 
37
  TBitmappedButtonState = (bbsNormal, bbsDown, bbsFocused, bbsMouseOver);
41
38
 
42
39
  { TCustomBitmappedButton }
43
40
 
154
151
    property Options;
155
152
  end;
156
153
 
157
 
 
158
 
  TCDButtonDrawer = class;
159
 
  TCDButtonDrawerWinCE = class;
160
 
  TCDButtonDrawerAndroid = class;
161
 
  TCDButtonDrawerXPTB = class;
162
 
 
163
 
  TCDButton = class(TCustomControl)
164
 
  private
165
 
    FDrawStyle: TCDDrawStyle;
166
 
    FCurrentDrawer: TCDButtonDrawer;
167
 
    FDrawerWinCE: TCDButtonDrawerWinCE;
168
 
    FDrawerAndroid: TCDButtonDrawerAndroid;
169
 
    FDrawerXPTB: TCDButtonDrawerXPTB;
170
 
    procedure PrepareCurrentDrawer();
171
 
    procedure SetDrawStyle(const AValue: TCDDrawStyle);
172
 
  protected
173
 
    FState: TBitmappedButtonState;
174
 
    // keyboard
175
 
    procedure DoEnter; override;
176
 
    procedure DoExit; override;
177
 
    procedure KeyDown(var Key: word; Shift: TShiftState); override;
178
 
    procedure KeyUp(var Key: word; Shift: TShiftState); override;
179
 
    // mouse
180
 
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
181
 
      X, Y: integer); override;
182
 
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
183
 
    procedure MouseEnter; override;
184
 
    procedure MouseLeave; override;
185
 
    // button state change
186
 
    procedure DoButtonDown();
187
 
    procedure DoButtonUp();
188
 
    procedure RealSetText(const Value: TCaption); override;
189
 
  public
190
 
    CustomDrawer: TCDButtonDrawer;
191
 
    constructor Create(AOwner: TComponent); override;
192
 
    destructor Destroy; override;
193
 
    procedure EraseBackground(DC: HDC); override;
194
 
    procedure Paint; override;
195
 
  published
196
 
    property Action;
197
 
    property Anchors;
198
 
    property Caption;
199
 
    property Color;
200
 
    property Constraints;
201
 
    property DrawStyle: TCDDrawStyle read FDrawStyle write SetDrawStyle;
202
 
    property Enabled;
203
 
    property Font;
204
 
    property OnChangeBounds;
205
 
    property OnClick;
206
 
    property OnContextPopup;
207
 
    property OnDragDrop;
208
 
    property OnDragOver;
209
 
    property OnEndDrag;
210
 
    property OnEnter;
211
 
    property OnExit;
212
 
    property OnKeyDown;
213
 
    property OnKeyPress;
214
 
    property OnKeyUp;
215
 
    property OnMouseDown;
216
 
    property OnMouseEnter;
217
 
    property OnMouseLeave;
218
 
    property OnMouseMove;
219
 
    property OnMouseUp;
220
 
    property OnResize;
221
 
    property OnStartDrag;
222
 
    property OnUTF8KeyPress;
223
 
    property ParentFont;
224
 
    property ParentShowHint;
225
 
    property PopupMenu;
226
 
    property ShowHint;
227
 
    property TabOrder;
228
 
    property TabStop;
229
 
    property Visible;
230
 
  end;
231
 
 
232
 
  { TCDButtonDrawer }
233
 
 
234
 
  TCDButtonDrawer = class
235
 
  public
236
 
    procedure SetClientRectPos(CDButton: TCDButton); virtual; abstract;
237
 
    procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton);
238
 
      virtual; abstract;
239
 
    procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
240
 
      FState: TBitmappedButtonState); virtual; abstract;
241
 
  end;
242
 
 
243
 
  { TCDButtonDrawerWinCE }
244
 
 
245
 
  TCDButtonDrawerWinCE = class(TCDButtonDrawer)
246
 
  public
247
 
    procedure SetClientRectPos(CDButton: TCDButton); override;
248
 
    procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override;
249
 
    procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
250
 
      FState: TBitmappedButtonState); override;
251
 
  end;
252
 
 
253
 
  { TCDButtonDrawerAndroid }
254
 
  TCDButtonDrawerAndroid = class(TCDButtonDrawer)
255
 
  public
256
 
    procedure SetClientRectPos(CDButton: TCDButton); override;
257
 
    procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override;
258
 
    procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
259
 
      FState: TBitmappedButtonState); override;
260
 
  end;
261
 
 
262
 
  TCDButtonDrawerXPTB = class(TCDButtonDrawer)
263
 
  public
264
 
    procedure SetClientRectPos(CDButton: TCDButton); override;
265
 
    procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override;
266
 
    procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
267
 
      FState: TBitmappedButtonState); override;
268
 
  end;
269
 
 
270
 
  {@@
271
 
    TCDGroupBox is a custom-drawn group box control
272
 
  }
273
 
 
274
 
  TCDGroupBoxDrawer = class;
275
 
  TCDGroupBoxDrawerWinCE = class;
276
 
 
277
 
  { TCDGroupBox }
278
 
 
279
 
  TCDGroupBox = class(TCustomControl)
280
 
  private
281
 
    FDrawStyle: TCDDrawStyle;
282
 
    FCurrentDrawer: TCDGroupBoxDrawer;
283
 
    FDrawerWinCE: TCDGroupBoxDrawerWinCE;
284
 
    procedure PrepareCurrentDrawer();
285
 
    procedure SetDrawStyle(const AValue: TCDDrawStyle);
286
 
  public
287
 
    CustomDrawer: TCDGroupBoxDrawer; // Fill the field to use the dsCustom draw mode
288
 
    constructor Create(AOwner: TComponent); override;
289
 
    destructor Destroy; override;
290
 
    procedure EraseBackground(DC: HDC); override;
291
 
    procedure Paint; override;
292
 
  published
293
 
    property DrawStyle: TCDDrawStyle read FDrawStyle write SetDrawStyle;
294
 
    property Caption;
295
 
    property TabStop default False;
296
 
  end;
297
 
 
298
 
  { TCDGroupBoxDrawer }
299
 
 
300
 
  TCDGroupBoxDrawer = class
301
 
  public
302
 
    procedure SetClientRectPos(CDGroupBox: TCDGroupBox); virtual; abstract;
303
 
    procedure DrawToIntfImage(ADest: TFPImageCanvas; CDGroupBox: TCDGroupBox);
304
 
      virtual; abstract;
305
 
    procedure DrawToCanvas(ADest: TCanvas; CDGroupBox: TCDGroupBox); virtual; abstract;
306
 
  end;
307
 
 
308
 
  { TCDGroupBoxDrawerWinCE }
309
 
 
310
 
  TCDGroupBoxDrawerWinCE = class(TCDGroupBoxDrawer)
311
 
  public
312
 
    FCaptionMiddle: integer;
313
 
    procedure SetClientRectPos(CDGroupBox: TCDGroupBox); override;
314
 
    procedure DrawToIntfImage(ADest: TFPImageCanvas; CDGroupBox: TCDGroupBox); override;
315
 
    procedure DrawToCanvas(ADest: TCanvas; CDGroupBox: TCDGroupBox); override;
316
 
  end;
317
 
 
318
 
  {@@
319
 
    TCDTrackBar is a custom-drawn trackbar control
320
 
  }
321
 
 
322
 
  TCDTrackBarDrawer = class;
323
 
 
324
 
  { TCDTrackBar }
325
 
 
326
 
  TCDTrackBar = class(TCustomControl)
327
 
  private
328
 
    FMDown: boolean;
329
 
    FMin: integer;
330
 
    FMax: integer;
331
 
    FPosition: integer;
332
 
    FOnChange: TNotifyEvent;
333
 
    FCurrentDrawer: TCDTrackBarDrawer;
334
 
    FFromColor, FToColor: TColor;
335
 
    FStepWidth: integer;
336
 
    procedure SetMax(Value: integer);
337
 
    procedure SetMin(Value: integer);
338
 
    procedure SetPosition(Value: integer);
339
 
    procedure SetFromColor(Value: TColor);
340
 
    procedure SetToColor(Value: TColor);
341
 
    procedure SetStepWidth(Value: integer);
342
 
  protected
343
 
    procedure Changed; virtual;
344
 
    // keyboard
345
 
    procedure DoEnter; override;
346
 
    procedure DoExit; override;
347
 
    procedure KeyDown(var Key: word; Shift: TShiftState); override;
348
 
    procedure KeyUp(var Key: word; Shift: TShiftState); override;
349
 
    // mouse
350
 
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
351
 
      X, Y: integer); override;
352
 
    procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
353
 
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
354
 
    procedure MouseEnter; override;
355
 
    procedure MouseLeave; override;
356
 
  public
357
 
    xPosition: integer;
358
 
    constructor Create(AOwner: TComponent); override;
359
 
    destructor Destroy; override;
360
 
    procedure EraseBackground(DC: HDC); override;
361
 
    procedure Paint; override;
362
 
  published
363
 
    property Color;
364
 
    property Max: integer read FMax write SetMax default 10;
365
 
    property Min: integer read FMin write SetMin default 0;
366
 
    property ColorFrom: TColor read FFromColor write SetFromColor;
367
 
    property StepWidth: integer read FStepWidth write SetStepWidth;
368
 
    property ColorTo: TColor read FToColor write SetToColor;
369
 
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
370
 
    property Position: integer read FPosition write SetPosition;
371
 
    property TabStop default True;
372
 
  end;
373
 
 
374
 
  { TCDTrackBarDrawer }
375
 
 
376
 
  TCDTrackBarDrawer = class
377
 
  public
378
 
    procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
379
 
      CDTrackBar: TCDTrackBar; FromColor, ToColor: TColor; pWidth: integer);
380
 
      virtual; abstract;
381
 
  end;
382
 
 
383
 
  TCDTrackBarDrawerGraph = class(TCDTrackBarDrawer)
384
 
  public
385
 
    procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
386
 
      CDTrackBar: TCDTrackBar; FromColor, ToColor: TColor; pWidth: integer); override;
387
 
  end;
388
 
 
389
 
  { TCDTabSheet }
390
 
 
391
 
  TCDTabSheetDrawerGraph = class;
392
 
  TCDPageControl = class;
393
 
 
394
 
  TCDTabSheet = class(TCustomControl)
395
 
  private
396
 
    FCurrentDrawer: TCDTabSheetDrawerGraph;
397
 
  public
398
 
    constructor Create(AOwner: TComponent); override;
399
 
    destructor Destroy; override;
400
 
    procedure EraseBackground(DC: HDC); override;
401
 
    procedure Paint; override;
402
 
  published
403
 
    property Caption;
404
 
    property Color;
405
 
    property Font;
406
 
  end;
407
 
 
408
 
  { TCDTabSheetDrawer }
409
 
 
410
 
  TCDTabSheetDrawer = class
411
 
  public
412
 
    procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
413
 
      CDTrackBar: TCDTabSheet); virtual; abstract;
414
 
  end;
415
 
 
416
 
  TCDTabSheetDrawerGraph = class(TCDTabSheetDrawer)
417
 
  public
418
 
    procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
419
 
      CDTabSheet: TCDTabSheet); override;
420
 
  end;
421
 
 
422
 
  { TCDPageControl }
423
 
 
424
 
  TCDPageControlDrawer = class;
425
 
  TCDPageControlDrawerWinCE = class;
 
154
  { TCDPageControlEditor }
426
155
 
427
156
  TCDPageControlEditor = class(TDefaultComponentEditor)
 
157
  private
 
158
    procedure ShowPageMenuItemClick(Sender: TObject);
428
159
  public
429
160
    procedure ExecuteVerb(Index: integer); override;
430
161
    function GetVerb(Index: integer): string; override;
431
162
    function GetVerbCount: integer; override;
432
 
  end;
433
 
 
434
 
  TCDPageControl = class(TCustomControl)
435
 
  private
436
 
    FDrawStyle: TCDDrawStyle;
437
 
    FCaptionHeight: integer;
438
 
    FActivePage: TCDTabSheet;
439
 
    FCurrentDrawer: TCDPageControlDrawer;
440
 
    FDrawerWinCE: TCDPageControlDrawerWinCE;
441
 
    FGrad: boolean;
442
 
    FShowTabs: boolean;
443
 
    FPages: TList;
444
 
    FMDownL, FMDownR: Boolean;
445
 
    FMEnterL, FMEnterR: Boolean;
446
 
    FPageIndex: integer;
447
 
    procedure SetMouseUP;
448
 
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
449
 
      X, Y: integer); override;
450
 
    procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
451
 
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
452
 
    procedure MouseEnter; override;
453
 
    procedure MouseLeave; override;
454
 
    //procedure CNNotify(var Message: TLMNotify); message CN_NOTIFY;
455
 
    procedure PrepareCurrentDrawer();
456
 
    procedure SetDrawStyle(const AValue: TCDDrawStyle);
457
 
    procedure SetCaptionHeight(Value: integer);
458
 
    procedure DrawCaptionBar(ADest: TFPImageCanvas; FPImg: TLazIntfImage; lRect: TRect);
459
 
    procedure SetPageGradient(Value: boolean);
460
 
    procedure SetShowTabs(Value: boolean);
461
 
    procedure SetActivePage(Value: TCDTabSheet);
462
 
    procedure SetPageIndex(Value: integer);
463
 
    procedure UpdateAllDesignerFlags;
464
 
    procedure UpdateDesignerFlags(APageIndex: integer);
465
 
  protected
466
 
    procedure Loaded; override;
467
 
  public
468
 
    CustomDrawer: TCDPageControlDrawer; // Fill the field to use the dsCustom draw mode
469
 
    constructor Create(AOwner: TComponent); override;
470
 
    destructor Destroy; override;
471
 
    procedure EraseBackground(DC: HDC); override;
472
 
    procedure Paint; override;
473
 
    procedure DoOnResize; override;
474
 
    function FindNextPage(CurPage: TCDTabSheet;
475
 
      GoForward, CheckTabVisible: boolean): TCDTabSheet;
476
 
    procedure SelectNextPage(GoForward: boolean; CheckTabVisible: boolean = True);
477
 
    procedure SetCDPages(Value: TList);
478
 
  published
479
 
    property ActivePage: TCDTabSheet read FActivePage write SetActivePage;
480
 
    property DrawStyle: TCDDrawStyle read FDrawStyle write SetDrawStyle;
481
 
    property Caption;
482
 
    property CaptionHeight: integer read FCaptionHeight write SetCaptionHeight;
483
 
    property Color;
484
 
    property Font;
485
 
    property Gradient: boolean read FGrad write SetPageGradient;
486
 
    property Pages: TList read FPages write SetCDPages;
487
 
    property ParentColor;
488
 
    property ParentFont;
489
 
    property ShowTabs: boolean read FShowTabs write SetShowTabs;
490
 
    property TabStop default True;
491
 
  end;
492
 
 
493
 
  { TCDTrackBarDrawer }
494
 
 
495
 
  TCDPageControlDrawer = class
496
 
  public
497
 
    procedure SetClientRectPos(CDPageControl: TCDPageControl); virtual; abstract;
498
 
    procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
499
 
      CDPageControl: TCDPageControl); virtual; abstract;
500
 
    procedure DrawToCanvas(ADest: TCanvas; CDPageControl: TCDPageControl);
501
 
      virtual; abstract;
502
 
  end;
503
 
 
504
 
  TCDPageControlDrawerWinCE = class(TCDPageControlDrawer)
505
 
  public
506
 
    procedure SetClientRectPos(CDPageControl: TCDPageControl); override;
507
 
    procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
508
 
      CDPageControl: TCDPageControl); override;
509
 
    procedure DrawToCanvas(ADest: TCanvas; CDPageControl: TCDPageControl); override;
 
163
    procedure PrepareItem(Index: integer; const AnItem: TMenuItem); override;
 
164
    procedure AddMenuItemsForPages(ParentMenuItem: TMenuItem); virtual;
 
165
    function PControl: TCDPageControl; virtual;
510
166
  end;
511
167
 
512
168
procedure Register;
513
169
 
514
170
implementation
515
171
 
 
172
uses
 
173
  ObjInspStrConsts;
 
174
 
516
175
const
517
176
  INT_BitmappedButton_LineSpacing = 2;
 
177
  MaskBaseColor = $00111111;
518
178
 
519
179
resourcestring
520
 
  sTABSHEET_DEFAULT_NAME = 'CTabSheet';
521
 
  sNEW_PAGE = 'Ne&w Page';
522
 
  sDEL_PAGE = '&Delete Page';
523
180
  sNEXT_PAGE = 'Ne&xt Page';
524
181
  sPREV_PAGE = '&Previouse Page';
525
182
 
526
183
procedure Register;
527
184
begin
528
 
  RegisterComponents('Common Controls', [TCDButton]);
529
 
  RegisterComponents('Common Controls', [TCDTrackBar]);
530
 
  RegisterComponents('Common Controls', [TCDPageControl]);
531
 
  RegisterComponents('Common Controls', [TCDGroupBox]);
 
185
  RegisterComponents('Custom Drawn', [
 
186
    // Standard tab
 
187
    TCDButton, TCDEdit, TCDCheckBox, TCDRadioButton, TCDComboBox, TCDScrollBar, TCDGroupBox,
 
188
    // Additional
 
189
    TCDStaticText,
 
190
    // Common Controls
 
191
    TCDTrackBar, TCDProgressBar, TCDListView, TCDPageControl, TCDTabControl,
 
192
    // Misc
 
193
    TCDSpinEdit]);
532
194
  RegisterComponentEditor(TCDPageControl, TCDPageControlEditor);
533
195
  RegisterComponentEditor(TCDTabSheet, TCDPageControlEditor);
534
196
  RegisterNoIcon([TCDTabSheet]);
746
408
  end;
747
409
end;
748
410
 
749
 
procedure TCDButton.DoEnter;
750
 
begin
751
 
  DoButtonUp();
752
 
 
753
 
  inherited DoEnter;
754
 
end;
755
 
 
756
 
procedure TCDButton.DoExit;
757
 
begin
758
 
  DoButtonUp();
759
 
 
760
 
  inherited DoExit;
761
 
end;
762
 
 
763
 
procedure TCDButton.KeyDown(var Key: word; Shift: TShiftState);
764
 
begin
765
 
  inherited KeyDown(Key, Shift);
766
 
 
767
 
  if (Key = VK_SPACE) or (Key = VK_RETURN) then
768
 
    DoButtonDown();
769
 
end;
770
 
 
771
 
procedure TCDButton.KeyUp(var Key: word; Shift: TShiftState);
772
 
begin
773
 
  DoButtonUp();
774
 
 
775
 
  inherited KeyUp(Key, Shift);
776
 
end;
777
 
 
778
 
procedure TCDButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
779
 
begin
780
 
  if not Focused then
781
 
    SetFocus;
782
 
  DoButtonDown();
783
 
 
784
 
  inherited MouseDown(Button, Shift, X, Y);
785
 
end;
786
 
 
787
 
procedure TCDButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
788
 
begin
789
 
  DoButtonUp();
790
 
 
791
 
  inherited MouseUp(Button, Shift, X, Y);
792
 
end;
793
 
 
794
 
procedure TCDButton.MouseEnter;
795
 
begin
796
 
  inherited MouseEnter;
797
 
end;
798
 
 
799
 
procedure TCDButton.MouseLeave;
800
 
begin
801
 
  inherited MouseLeave;
802
 
end;
803
 
 
804
 
procedure TCDButton.DoButtonDown();
805
 
var
806
 
  NewState: TBitmappedButtonState;
807
 
begin
808
 
  NewState := bbsDown;
809
 
 
810
 
  case FState of
811
 
    bbsNormal, bbsFocused: NewState := bbsDown;
812
 
  end;
813
 
 
814
 
  if NewState <> FState then
815
 
  begin
816
 
    FState := NewState;
817
 
    Invalidate;
818
 
  end;
819
 
end;
820
 
 
821
 
procedure TCDButton.DoButtonUp();
822
 
var
823
 
  NewState: TBitmappedButtonState;
824
 
begin
825
 
  if Focused then
826
 
    NewState := bbsFocused
827
 
  else
828
 
    NewState := bbsNormal;
829
 
 
830
 
  if NewState <> FState then
831
 
  begin
832
 
    FState := NewState;
833
 
    Invalidate;
834
 
  end;
835
 
end;
836
 
 
837
 
procedure TCDButton.PrepareCurrentDrawer();
838
 
begin
839
 
  case DrawStyle of
840
 
    dsWince: FCurrentDrawer := FDrawerWinCE;
841
 
    dsCustom: FCurrentDrawer := CustomDrawer;
842
 
    dsAndroid: FCurrentDrawer := FDrawerAndroid;
843
 
    dsXPTaskbar: FCurrentDrawer := FDrawerXPTB;
844
 
  end;
845
 
end;
846
 
 
847
 
procedure TCDButton.SetDrawStyle(const AValue: TCDDrawStyle);
848
 
begin
849
 
  if FDrawStyle = AValue then
850
 
    exit;
851
 
  FDrawStyle := AValue;
852
 
 
853
 
  Invalidate;
854
 
 
855
 
  PrepareCurrentDrawer();
856
 
  //  FCurrentDrawer.SetClientRectPos(Self); the button shouldn't receive controls inside it
857
 
end;
858
 
 
859
 
procedure TCDButton.RealSetText(const Value: TCaption);
860
 
begin
861
 
  inherited RealSetText(Value);
862
 
  Invalidate;
863
 
end;
864
 
 
865
 
constructor TCDButton.Create(AOwner: TComponent);
866
 
begin
867
 
  inherited Create(AOwner);
868
 
  TabStop := True;
869
 
  FDrawerWinCE := TCDButtonDrawerWinCE.Create;
870
 
  FDrawerAndroid := TCDButtonDrawerAndroid.Create;
871
 
  FDrawerXPTB := TCDButtonDrawerXPTB.Create;
872
 
  Width := 120;
873
 
  Height := 43;
874
 
  //Color := clTeal;
875
 
  ParentFont := True;
876
 
  FDrawStyle := dsAndroid;
877
 
  Color := $00F1F5F5;
878
 
end;
879
 
 
880
 
destructor TCDButton.Destroy;
881
 
begin
882
 
  inherited Destroy;
883
 
end;
884
 
 
885
 
procedure TCDButton.EraseBackground(DC: HDC);
886
 
begin
887
 
 
888
 
end;
889
 
 
890
 
procedure DrawCDButtonDown(Canvas: TCanvas; CDButton: TCDButton);
891
 
begin
892
 
  with Canvas do
893
 
  begin
894
 
    Brush.Style := bsSolid;
895
 
    Brush.Color := CDButton.Color;
896
 
    Pen.Color := Brush.Color;
897
 
    Rectangle(0, 0, Width, Height);
898
 
    FillRect(0, 0, Width, Height);
899
 
    Brush.Color := GetAColor(CDButton.Color, 93);
900
 
    Pen.Color := GetAColor(Brush.Color, 76);
901
 
    RoundRect(0, 0, Width, Height, 8, 8);
902
 
  end;
903
 
end;
904
 
 
905
 
procedure TCDButton.Paint;
906
 
var
907
 
  AImage: TLazIntfImage = nil;
908
 
  ABmp: TBitmap = nil;
909
 
  lCanvas: TFPImageCanvas = nil;
910
 
  pColor: TColor;
911
 
begin
912
 
  //  inherited Paint;
913
 
 
914
 
  PrepareCurrentDrawer();
915
 
 
916
 
  ABmp := TBitmap.Create;
917
 
  try
918
 
    ABmp.Width := Width;
919
 
    ABmp.Height := Height;
920
 
    AImage := ABmp.CreateIntfImage;
921
 
    lCanvas := TFPImageCanvas.Create(AImage);
922
 
    // First step of the drawing: FCL TFPCustomCanvas for fast pixel access
923
 
    FCurrentDrawer.DrawToIntfImage(lCanvas, Self);
924
 
    ABmp.LoadFromIntfImage(AImage);
925
 
    // Second step of the drawing: LCL TCustomCanvas for easy font access
926
 
    FCurrentDrawer.DrawToCanvas(ABmp.Canvas, Self, FState);
927
 
 
928
 
    with ABmp.Canvas do
929
 
    begin
930
 
      Brush.Style := bsClear;
931
 
      if FState <> bbsDown then
932
 
      begin
933
 
        Pen.Color := GetAColor(Color, 86);
934
 
        RoundRect(0, 0, Width, Height, 8, 8);
935
 
      end;
936
 
      Pen.Style := psSolid;
937
 
      Pen.Color := Parent.Color;
938
 
      Line(0, 2, 0, 0);
939
 
      Line(0, 0, 2, 0);
940
 
      Pixels[2, 0] := Pen.Color;
941
 
      Line(Width - 3, 0, Width - 1, 0);
942
 
      Line(Width - 1, 0, Width - 1, 2);
943
 
      Line(0, Height - 3, 0, Height - 1);
944
 
      Line(0, Height - 1, 2, Height - 1);
945
 
      Line(Width - 1, Height - 3, Width - 1, Height - 1);
946
 
      Line(Width - 1, Height - 1, Width - 3, Height - 1);
947
 
      Pixels[Width - 1, 2] := Pen.Color;
948
 
      Pixels[Width - 3, Height - 1] := Pen.Color;
949
 
      Pixels[2, Height - 1] := Pen.Color;
950
 
      pColor := Parent.Color; //GetAColor(Parent.Color, 96);
951
 
      Pixels[1, 1] := pColor;
952
 
      Pixels[Width - 2, 1] := pColor;
953
 
      Pixels[Width - 2, Height - 2] := pColor;
954
 
      Pixels[1, Height - 2] := pColor;
955
 
    end;
956
 
    Canvas.Draw(0, 0, ABmp);
957
 
  finally
958
 
    if lCanvas <> nil then
959
 
      lCanvas.Free;
960
 
    if AImage <> nil then
961
 
      AImage.Free;
962
 
    ABmp.Free;
963
 
  end;
964
 
end;
965
 
 
966
 
{ TCDButtonDrawerWinCE }
967
 
 
968
 
procedure TCDButtonDrawerWinCE.SetClientRectPos(CDButton: TCDButton);
969
 
var
970
 
  lRect: TRect;
971
 
begin
972
 
  lRect := Rect(1, 1, CDButton.Width - 1, CDButton.Height - 1);
973
 
  CDButton.AdjustClientRect(lRect);
974
 
end;
975
 
 
976
 
procedure TCDButtonDrawerWinCE.DrawToIntfImage(ADest: TFPImageCanvas;
977
 
  CDButton: TCDButton);
978
 
begin
979
 
 
980
 
end;
981
 
 
982
 
procedure TCDButtonDrawerWinCE.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
983
 
  FState: TBitmappedButtonState);
984
 
var
985
 
  TmpB: TBitmap;
986
 
  Str: string;
987
 
begin
988
 
  // Button shape -> This crashes in Gtk2
989
 
  TmpB := TBitmap.Create;
990
 
  TmpB.Width := CDButton.Width;
991
 
  TmpB.Height := CDButton.Height;
992
 
  TmpB.Canvas.Brush.Color := CDButton.Color;
993
 
  TmpB.Canvas.Brush.Style := bsSolid;
994
 
  TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8);
995
 
  //  CDButton.SetShape(TmpB);
996
 
 
997
 
  with TmpB.Canvas do
998
 
  begin
999
 
    Brush.Style := bsSolid;
1000
 
    Brush.Color := CDButton.Parent.Color;
1001
 
    Pen.Color := Brush.Color;
1002
 
    Rectangle(0, 0, Width, Height);
1003
 
    FillRect(0, 0, Width, Height);
1004
 
    Brush.Color := GetAColor(CDButton.Color, 90);
1005
 
  end;
1006
 
 
1007
 
  // Button image
1008
 
  case FState of
1009
 
    bbsDown:
1010
 
    begin
1011
 
      DrawCDButtonDown(TmpB.Canvas, CDButton);
1012
 
    end;
1013
 
    bbsFocused:
1014
 
      //GradientFill(GetUColor(CDButton.Color, 50), GetAColor(CDButton.Color, 60), TmpB.Canvas);
1015
 
      GradientFill(clWhite, GetAColor(CDButton.Color, 96), TmpB.Canvas);
1016
 
    else
1017
 
      //GradientFill(GetUColor(CDButton.Color, 10), GetAColor(CDButton.Color, 20), TmpB.Canvas);
1018
 
      GradientFill(clWhite, CDButton.Color, TmpB.Canvas);
1019
 
  end;
1020
 
 
1021
 
  ADest.Draw(0, 0, TmpB);
1022
 
 
1023
 
  TmpB.Free;
1024
 
 
1025
 
  // Button text
1026
 
  {$ifndef CUSTOMDRAWN_USE_FREETYPE}
1027
 
  ADest.Font.Assign(CDButton.Font);
1028
 
  ADest.Brush.Style := bsClear;
1029
 
  ADest.Pen.Style := psSolid;
1030
 
  Str := CDButton.Caption;
1031
 
  ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2,
1032
 
    (CDButton.Height - ADest.TextHeight(Str)) div 2, Str);
1033
 
  {$endif}
1034
 
end;
1035
 
 
1036
 
procedure TCDButtonDrawerAndroid.SetClientRectPos(CDButton: TCDButton);
1037
 
var
1038
 
  lRect: TRect;
1039
 
begin
1040
 
  lRect := Rect(1, 1, CDButton.Width - 1, CDButton.Height - 1);
1041
 
  CDButton.AdjustClientRect(lRect);
1042
 
end;
1043
 
 
1044
 
procedure TCDButtonDrawerAndroid.DrawToIntfImage(ADest: TFPImageCanvas;
1045
 
  CDButton: TCDButton);
1046
 
begin
1047
 
 
1048
 
end;
1049
 
 
1050
 
procedure TCDButtonDrawerAndroid.DrawToCanvas(ADest: TCanvas;
1051
 
  CDButton: TCDButton; FState: TBitmappedButtonState);
1052
 
var
1053
 
  //TmpB: TBitmap;
1054
 
  Str: string;
1055
 
begin
1056
 
  // Button shape -> This crashes in Gtk2
1057
 
{  TmpB.Canvas.Brush.Color := CDButton.Color;
1058
 
  TmpB.Canvas.Brush.Style := bsSolid;
1059
 
  TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8);
1060
 
  CDButton.SetShape(TmpB);
1061
 
  ADest.Draw(0, 0, TmpB);
1062
 
  TmpB.Free;
1063
 
  }
1064
 
 
1065
 
  ADest.Brush.Color := CDButton.Parent.Color;
1066
 
  ADest.Brush.Style := bsSolid;
1067
 
  ADest.Pen.Color := ADest.Brush.Color;
1068
 
  ADest.RecTangle(0, 0, CDButton.Width, CDButton.Height);
1069
 
 
1070
 
  // Button image
1071
 
  case FState of
1072
 
    bbsDown:
1073
 
    begin
1074
 
      DrawCDButtonDown(ADest, CDButton);
1075
 
    end;
1076
 
    bbsFocused:
1077
 
    begin
1078
 
      DrawAndroidButton(ADest, GetAColor(CDButton.Color, 98));
1079
 
    end;
1080
 
    else
1081
 
      DrawAndroidButton(ADest, GetAColor(CDButton.Color, 96));
1082
 
  end;
1083
 
 
1084
 
  // Button text
1085
 
  {$ifndef CUSTOMDRAWN_USE_FREETYPE}
1086
 
  ADest.Font.Assign(CDButton.Font);
1087
 
  ADest.Brush.Style := bsClear;
1088
 
  ADest.Pen.Style := psSolid;
1089
 
  Str := CDButton.Caption;
1090
 
  ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2,
1091
 
    (CDButton.Height - ADest.TextHeight(Str)) div 2, Str);
1092
 
  {$endif}
1093
 
end;
1094
 
 
1095
 
procedure TCDButtonDrawerXPTB.SetClientRectPos(CDButton: TCDButton);
1096
 
var
1097
 
  lRect: TRect;
1098
 
begin
1099
 
  lRect := Rect(1, 1, CDButton.Width - 1, CDButton.Height - 1);
1100
 
  CDButton.AdjustClientRect(lRect);
1101
 
end;
1102
 
 
1103
 
procedure TCDButtonDrawerXPTB.DrawToIntfImage(ADest: TFPImageCanvas;
1104
 
  CDButton: TCDButton);
1105
 
begin
1106
 
 
1107
 
end;
1108
 
 
1109
 
procedure TCDButtonDrawerXPTB.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
1110
 
  FState: TBitmappedButtonState);
1111
 
var
1112
 
  Str: string;
1113
 
begin
1114
 
  case FState of
1115
 
    bbsDown:
1116
 
    begin
1117
 
      DrawCDButtonDown(ADest, CDButton);
1118
 
    end;
1119
 
    bbsFocused:
1120
 
    begin
1121
 
      DrawXPTaskbarButton(ADest, GetAColor(CDButton.Color, 98));
1122
 
    end;
1123
 
    else
1124
 
      DrawXPTaskbarButton(ADest, CDButton.Color);
1125
 
  end;
1126
 
 
1127
 
  // Button text
1128
 
  {$ifndef CUSTOMDRAWN_USE_FREETYPE}
1129
 
  ADest.Font.Assign(CDButton.Font);
1130
 
  ADest.Brush.Style := bsClear;
1131
 
  ADest.Pen.Style := psSolid;
1132
 
  Str := CDButton.Caption;
1133
 
  ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2,
1134
 
    (CDButton.Height - ADest.TextHeight(Str)) div 2, Str);
1135
 
  {$endif}
1136
 
end;
1137
 
 
1138
 
{ TCDGroupBox }
1139
 
 
1140
 
procedure TCDGroupBox.PrepareCurrentDrawer();
1141
 
begin
1142
 
  case DrawStyle of
1143
 
    dsWince: FCurrentDrawer := FDrawerWinCE;
1144
 
    dsCustom: FCurrentDrawer := CustomDrawer;
1145
 
  end;
1146
 
end;
1147
 
 
1148
 
procedure TCDGroupBox.SetDrawStyle(const AValue: TCDDrawStyle);
1149
 
begin
1150
 
  if FDrawStyle = AValue then
1151
 
    exit;
1152
 
  FDrawStyle := AValue;
1153
 
 
1154
 
  Invalidate;
1155
 
 
1156
 
  PrepareCurrentDrawer();
1157
 
  FCurrentDrawer.SetClientRectPos(Self);
1158
 
end;
1159
 
 
1160
 
constructor TCDGroupBox.Create(AOwner: TComponent);
1161
 
begin
1162
 
  inherited Create(AOwner);
1163
 
  Width := 100;
1164
 
  Height := 100;
1165
 
  TabStop := False;
1166
 
  FDrawerWinCE := TCDGroupBoxDrawerWinCE.Create;
1167
 
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
1168
 
    csDoubleClicks, csReplicatable];
1169
 
end;
1170
 
 
1171
 
destructor TCDGroupBox.Destroy;
1172
 
begin
1173
 
  inherited Destroy;
1174
 
end;
1175
 
 
1176
 
procedure TCDGroupBox.EraseBackground(DC: HDC);
1177
 
begin
1178
 
 
1179
 
end;
1180
 
 
1181
 
procedure TCDGroupBox.Paint;
1182
 
var
1183
 
  AImage: TLazIntfImage = nil;
1184
 
  ABmp: TBitmap = nil;
1185
 
  lCanvas: TFPImageCanvas = nil;
1186
 
begin
1187
 
  inherited Paint;
1188
 
 
1189
 
  PrepareCurrentDrawer();
1190
 
 
1191
 
  ABmp := TBitmap.Create;
1192
 
  try
1193
 
    ABmp.Width := Width;
1194
 
    ABmp.Height := Height;
1195
 
    AImage := ABmp.CreateIntfImage;
1196
 
    lCanvas := TFPImageCanvas.Create(AImage);
1197
 
    // First step of the drawing: FCL TFPCustomCanvas for fast pixel access
1198
 
    FCurrentDrawer.DrawToIntfImage(lCanvas, Self);
1199
 
    ABmp.LoadFromIntfImage(AImage);
1200
 
    // Second step of the drawing: LCL TCustomCanvas for easy font access
1201
 
    FCurrentDrawer.DrawToCanvas(ABmp.Canvas, Self);
1202
 
    Canvas.Draw(0, 0, ABmp);
1203
 
  finally
1204
 
    if lCanvas <> nil then
1205
 
      lCanvas.Free;
1206
 
    if AImage <> nil then
1207
 
      AImage.Free;
1208
 
    ABmp.Free;
1209
 
  end;
1210
 
end;
1211
 
 
1212
 
{ TCDGroupBoxDrawerWinCE }
1213
 
 
1214
 
procedure TCDGroupBoxDrawerWinCE.SetClientRectPos(CDGroupBox: TCDGroupBox);
1215
 
var
1216
 
  lRect: TRect;
1217
 
  lCaptionHeight: integer;
1218
 
begin
1219
 
  lCaptionHeight := 10;
1220
 
  lRect := Rect(1, lCaptionHeight, CDGroupBox.Width - 1, CDGroupBox.Height - 1);
1221
 
  CDGroupBox.AdjustClientRect(lRect);
1222
 
end;
1223
 
 
1224
 
procedure TCDGroupBoxDrawerWinCE.DrawToIntfImage(ADest: TFPImageCanvas;
1225
 
  CDGroupBox: TCDGroupBox);
1226
 
{$ifdef CUSTOMDRAWN_USE_FREETYPE}
1227
 
var
1228
 
  AFont: TFreeTypeFont = nil;
1229
 
{$endif}
1230
 
begin
1231
 
  FCaptionMiddle := CDGroupBox.Canvas.TextHeight('Ź') div 2;
1232
 
 
1233
 
  // Background
1234
 
  if CDGroupBox.Parent = nil then
1235
 
    ADest.Brush.FPColor := colLtGray
1236
 
  else
1237
 
    ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CDGroupBox.Parent.Color));
1238
 
  ADest.Brush.Style := bsSolid;
1239
 
  ADest.Pen.Style := psClear;
1240
 
  ADest.Rectangle(0, 0, CDGroupBox.Width, CDGroupBox.Height);
1241
 
 
1242
 
  // frame
1243
 
  ADest.Pen.FPColor := colBlack;
1244
 
  ADest.Pen.Style := psSolid;
1245
 
  ADest.Brush.Style := bsClear;
1246
 
  ADest.Rectangle(0, FCaptionMiddle, CDGroupBox.Width - 1, CDGroupBox.Height - 1);
1247
 
 
1248
 
  {$ifdef CUSTOMDRAWN_USE_FREETYPE}
1249
 
  // Caption background and caption
1250
 
 
1251
 
  // initialize free type font manager
1252
 
  opcftfont.InitEngine;
1253
 
  //  FontMgr.SearchPath:='/usr/share/fonts/truetype/';
1254
 
  AFont := TFreeTypeFont.Create;
1255
 
  try
1256
 
    // Text background
1257
 
    ADest.Pen.Style := psClear;
1258
 
    ADest.Brush.Style := bsSolid;
1259
 
    // The brush color was already set previously and is already correct
1260
 
    //    ADest.Rectangle(5, 0, AFont.GetTextWidth(CDGroupBox.Caption) + 5, 10);
1261
 
 
1262
 
    // paint text
1263
 
    ADest.Pen.Style := psSolid;
1264
 
    ADest.Brush.Style := bsClear;
1265
 
    ADest.Font := AFont;
1266
 
    ADest.Font.Name := 'Arial';
1267
 
    ADest.Font.Size := 10;
1268
 
    ADest.TextOut(5, 10, CDGroupBox.Caption);
1269
 
  finally
1270
 
    AFont.Free;
1271
 
  end;
1272
 
  {$endif}
1273
 
end;
1274
 
 
1275
 
procedure TCDGroupBoxDrawerWinCE.DrawToCanvas(ADest: TCanvas; CDGroupBox: TCDGroupBox);
1276
 
begin
1277
 
  {$ifndef CUSTOMDRAWN_USE_FREETYPE}
1278
 
  if CDGroupBox.Parent = nil then
1279
 
    ADest.Brush.Color := clLtGray
1280
 
  else
1281
 
    ADest.Brush.Color := ColorToRGB(CDGroupBox.Parent.Color);
1282
 
 
1283
 
  // Text background
1284
 
  ADest.Pen.Style := psClear;
1285
 
  ADest.Brush.Style := bsSolid;
1286
 
  ADest.Rectangle(FCaptionMiddle, 0, ADest.GetTextWidth(CDGroupBox.Caption) +
1287
 
    FCaptionMiddle, 10);
1288
 
 
1289
 
  // paint text
1290
 
  ADest.Pen.Style := psSolid;
1291
 
  ADest.Brush.Style := bsClear;
1292
 
  ADest.Font.Size := 10;
1293
 
  ADest.TextOut(FCaptionMiddle, 0, CDGroupBox.Caption);
1294
 
  {$endif}
1295
 
end;
1296
 
 
1297
 
{ TCDTrackBar }
1298
 
 
1299
 
procedure TCDTrackBar.SetMax(Value: integer);
1300
 
begin
1301
 
  if Value = FMax then
1302
 
    Exit;
1303
 
  FMax := Value;
1304
 
  Invalidate;
1305
 
end;
1306
 
 
1307
 
procedure TCDTrackBar.SetMin(Value: integer);
1308
 
begin
1309
 
  if Value = FMin then
1310
 
    Exit;
1311
 
  FMin := Value;
1312
 
  Invalidate;
1313
 
end;
1314
 
 
1315
 
procedure TCDTrackBar.SetPosition(Value: integer);
1316
 
begin
1317
 
  if Value = FPosition then
1318
 
    Exit;
1319
 
  FPosition := Value;
1320
 
  Invalidate;
1321
 
end;
1322
 
 
1323
 
procedure TCDTrackBar.Changed;
1324
 
begin
1325
 
 
1326
 
end;
1327
 
 
1328
 
procedure TCDTrackBar.DoEnter;
1329
 
begin
1330
 
  inherited DoEnter;
1331
 
end;
1332
 
 
1333
 
procedure TCDTrackBar.DoExit;
1334
 
begin
1335
 
  inherited DoExit;
1336
 
end;
1337
 
 
1338
 
procedure TCDTrackBar.KeyDown(var Key: word; Shift: TShiftState);
1339
 
begin
1340
 
  inherited KeyDown(Key, Shift);
1341
 
  if (Key = 37) or (Key = 40) then
1342
 
    Position := Position - (FMax - FMin) div 10;
1343
 
  if (Key = 38) or (Key = 39) then
1344
 
    Position := Position + (FMax - FMin) div 10;
1345
 
  if Position > FMax then
1346
 
    Position := FMax;
1347
 
  if Position < FMin then
1348
 
    Position := FMin;
1349
 
end;
1350
 
 
1351
 
procedure TCDTrackBar.KeyUp(var Key: word; Shift: TShiftState);
1352
 
begin
1353
 
  inherited KeyUp(Key, Shift);
1354
 
end;
1355
 
 
1356
 
procedure TCDTrackBar.MouseDown(Button: TMouseButton; Shift: TShiftState;
1357
 
  X, Y: integer);
1358
 
begin
1359
 
  SetFocus;
1360
 
  FPosition := FMin + (X - 8) * (FMax - FMin) div (Width - 14);
1361
 
  if X > Width - 14 then
1362
 
    FPosition := FMax;
1363
 
  if X < 13 then
1364
 
    FPosition := 0;
1365
 
  xPosition := X;
1366
 
  if X > Width - 14 then
1367
 
    xPosition := Width - 14;
1368
 
  if X < 13 then
1369
 
    xPosition := 13;
1370
 
  invalidate;
1371
 
  FMDown := True;
1372
 
  inherited MouseDown(Button, Shift, X, Y);
1373
 
end;
1374
 
 
1375
 
procedure TCDTrackBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
1376
 
begin
1377
 
  FMDown := False;
1378
 
  inherited MouseUp(Button, Shift, X, Y);
1379
 
end;
1380
 
 
1381
 
procedure TCDTrackBar.MouseMove(Shift: TShiftState; X, Y: integer);
1382
 
begin
1383
 
  if FMDown then
1384
 
  begin
1385
 
    FPosition := FMin + (X - 8) * (FMax - FMin) div (Width - 14);
1386
 
    if X > Width - 14 then
1387
 
      FPosition := FMax;
1388
 
    if X < 13 then
1389
 
      FPosition := 0;
1390
 
    xPosition := X;
1391
 
    if X > Width - 14 then
1392
 
      xPosition := Width - 14;
1393
 
    if X < 13 then
1394
 
      xPosition := 13;
1395
 
    invalidate;
1396
 
  end;
1397
 
  inherited MouseMove(Shift, X, Y);
1398
 
end;
1399
 
 
1400
 
procedure TCDTrackBar.MouseEnter;
1401
 
begin
1402
 
  inherited MouseEnter;
1403
 
end;
1404
 
 
1405
 
procedure TCDTrackBar.MouseLeave;
1406
 
begin
1407
 
  inherited MouseLeave;
1408
 
end;
1409
 
 
1410
 
constructor TCDTrackBar.Create(AOwner: TComponent);
1411
 
begin
1412
 
  inherited Create(AOwner);
1413
 
  Height := 25;
1414
 
  Width := 100;
1415
 
  FCurrentDrawer := TCDTrackBarDrawerGraph.Create;
1416
 
  Color := clBtnFace;
1417
 
  FMax := 100;
1418
 
  FMin := 0;
1419
 
  TabStop := True;
1420
 
  FFromColor := clWhite;
1421
 
  FToColor := clGray;
1422
 
  FStepWidth := 11;
1423
 
  TabStop := True;
1424
 
  xPosition := 13;
1425
 
end;
1426
 
 
1427
 
destructor TCDTrackBar.Destroy;
1428
 
begin
1429
 
  FCurrentDrawer.Free;
1430
 
  inherited Destroy;
1431
 
end;
1432
 
 
1433
 
procedure TCDTrackBar.EraseBackground(DC: HDC);
1434
 
begin
1435
 
  inherited EraseBackground(DC);
1436
 
end;
1437
 
 
1438
 
procedure TCDTrackBar.Paint;
1439
 
var
1440
 
  AImage: TLazIntfImage = nil;
1441
 
  ABmp: TBitmap = nil;
1442
 
  lCanvas: TFPImageCanvas = nil;
1443
 
begin
1444
 
  inherited Paint;
1445
 
  ABmp := TBitmap.Create;
1446
 
  try
1447
 
    ABmp.Width := Width;
1448
 
    ABmp.Height := Height;
1449
 
    AImage := ABmp.CreateIntfImage;
1450
 
    lCanvas := TFPImageCanvas.Create(AImage);
1451
 
    // First step of the drawing: FCL TFPCustomCanvas for fast pixel access
1452
 
    FCurrentDrawer.DrawToIntfImage(lCanvas, AImage, Self, FFromColor,
1453
 
      FToColor, FStepWidth);
1454
 
    ABmp.LoadFromIntfImage(AImage);
1455
 
    Canvas.Draw(0, 0, ABmp);
1456
 
  finally
1457
 
    if lCanvas <> nil then
1458
 
      lCanvas.Free;
1459
 
    if AImage <> nil then
1460
 
      AImage.Free;
1461
 
    ABmp.Free;
1462
 
  end;
1463
 
end;
1464
 
 
1465
 
procedure TCDTrackBar.SetFromColor(Value: TColor);
1466
 
begin
1467
 
  FFromColor := Value;
1468
 
  invalidate;
1469
 
end;
1470
 
 
1471
 
procedure TCDTrackBar.SetToColor(Value: TColor);
1472
 
begin
1473
 
  FToColor := Value;
1474
 
  invalidate;
1475
 
end;
1476
 
 
1477
 
procedure TCDTrackBar.SetStepWidth(Value: integer);
1478
 
begin
1479
 
  FStepWidth := Value;
1480
 
  invalidate;
1481
 
end;
1482
 
 
1483
 
{ TCDTrackBarDrawer }
1484
 
 
1485
 
procedure TCDTrackBarDrawerGraph.DrawToIntfImage(ADest: TFPImageCanvas;
1486
 
  FPImg: TLazIntfImage; CDTrackBar: TCDTrackBar; FromColor, ToColor: TColor;
1487
 
  pWidth: integer);
1488
 
var
1489
 
  aStart, RNum, i, pStart: integer;
1490
 
  dRect: TRect;
1491
 
  TempB: TLazIntfImage;
1492
 
  BCanvas: TFPImageCanvas;
1493
 
  ABmp: TBitmap = nil;
1494
 
begin
1495
 
  // Background
1496
 
  if CDTrackBar.Parent = nil then
1497
 
    ADest.Brush.FPColor := colLtGray
1498
 
  else
1499
 
    ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CDTrackBar.Color));
1500
 
  ADest.Brush.Style := bsSolid;
1501
 
  ADest.Pen.Style := psClear;
1502
 
  ADest.Rectangle(0, 0, CDTrackBar.Width, CDTrackBar.Height);
1503
 
  ADest.Brush.FPColor := TColorToFPColor(ColorToRGB($006BB6E6));
1504
 
  //aStart := CDTrackBar.Height div 2 + 1;
1505
 
  aStart := CDTrackBar.Height - 10;
1506
 
  ADest.Pen.Style := psSolid;
1507
 
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($006BB6E6));
1508
 
  //ADest.Rectangle(0, aStart, CDTrackBar.Width, aStart);
1509
 
  ADest.Line(0, aStart, CDTrackBar.Width, aStart);
1510
 
  ADest.Line(3, aStart - 1, 6, aStart - 1);
1511
 
  ADest.Line(5, aStart - 2, 6, aStart - 2);
1512
 
  ADest.Line(3, aStart + 1, 6, aStart + 1);
1513
 
  ADest.Line(5, aStart + 2, 6, aStart + 2);
1514
 
  //pStart := ((CDTrackBar.Position - CDTrackBar.Min) * (CDTrackBar.Width - 32)) div
1515
 
  //  (CDTrackBar.Max - CDTrackBar.Min) + 2;
1516
 
  pStart := CDTrackBar.xPosition;
1517
 
  ADest.Rectangle(pStart - 5, aStart + 1, pStart + 5, aStart + 6);
1518
 
  ADest.Line(CDTrackBar.Width - 1 - 3, aStart - 1, CDTrackBar.Width - 1 - 6, aStart - 1);
1519
 
  ADest.Line(CDTrackBar.Width - 1 - 5, aStart - 2, CDTrackBar.Width - 1 - 6, aStart - 2);
1520
 
  ADest.Line(CDTrackBar.Width - 1 - 3, aStart + 1, CDTrackBar.Width - 1 - 6, aStart + 1);
1521
 
  ADest.Line(CDTrackBar.Width - 1 - 5, aStart + 2, CDTrackBar.Width - 1 - 6, aStart + 2);
1522
 
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($005BA6C6));
1523
 
  ADest.RecTangle(pStart - 5, aStart + 2, pStart + 5, aStart + 7);
1524
 
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($006BB6E6));
1525
 
  ADest.RecTangle(pStart - 5, aStart, pStart + 5, aStart + 2);
1526
 
  RNum := (CDTrackBar.Width - 15) div pWidth;
1527
 
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(clGray));
1528
 
  ADest.Brush.FPColor := TColorToFPColor(ColorToRGB($00F0F0F0));
1529
 
  ABmp := TBitmap.Create;
1530
 
  ABmp.Width := CDTrackBar.Width;
1531
 
  ABmp.Height := CDTrackBar.Height;
1532
 
  TempB := ABmp.CreateIntfImage;
1533
 
  //TempB := TLazIntfImage.Create(0, 0);
1534
 
  //TempB.UsePalette := False;
1535
 
  //TempB.Width := CDTrackBar.Width;
1536
 
  //TempB.Height := CDTrackBar.Height;
1537
 
  BCanvas := TFPImageCanvas.Create(TempB);
1538
 
  //BCanvas.Brush.FPColor := TColorToFPColor(ColorToRGB(clRed));
1539
 
  BCanvas.Brush.Style := bsSolid;
1540
 
  //GradHFill(BCanvas, Rect(0, 0, CDTrackBar.Width, CDTrackBar.Height),
1541
 
  //  GetAColor(FromColor, 70 + i), GetAColor(ToColor, 90 + i));
1542
 
  GradCenterFill(BCanvas, Rect(0, 0, CDTrackBar.Width, CDTrackBar.Height),
1543
 
    FromColor, ToColor, CDTrackBar.Position / (CDTrackBar.Max - CDTrackBar.Min));
1544
 
  for i := 0 to RNum - 1 do
1545
 
  begin
1546
 
    dRect := Rect(10 + i * pWidth, aStart - 5 - i, 10 + i * pWidth +
1547
 
      pWidth - 3, aStart - 1);
1548
 
    ADest.Brush.Style := bsSolid;
1549
 
    //  GradHFill(ADest, dRect, GetAColor(FromColor, 70 + i), GetAColor(ToColor, 90 + i));
1550
 
    if aStart - 5 - i > 0 then
1551
 
    begin
1552
 
      FPImgCloneRect(TempB, FPImg, Rect(10 + i * pWidth, aStart - 5 -
1553
 
        i, 10 + i * pWidth + pWidth - 3, aStart - 1), False);
1554
 
      ADest.Brush.Style := bsClear;
1555
 
      ADest.RecTangle(10 + i * pWidth, aStart - 5 - i, 10 + i * pWidth +
1556
 
        pWidth - 3, aStart - 1);
1557
 
    end;
1558
 
  end;
1559
 
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($007BC6F6));
1560
 
  ADest.Line(7, aStart - 1, CDTrackBar.Width - 8, aStart - 1);
1561
 
  ADest.Line(7, aStart + 1, CDTrackBar.Width - 8, aStart + 1);
1562
 
  ADest.Colors[2, aStart - 1] := ADest.Pen.FPColor;
1563
 
  ADest.Colors[4, aStart - 2] := ADest.Pen.FPColor;
1564
 
  ADest.Colors[2, aStart + 1] := ADest.Pen.FPColor;
1565
 
  ADest.Colors[4, aStart + 2] := ADest.Pen.FPColor;
1566
 
  ADest.Colors[6, aStart - 3] := ADest.Pen.FPColor;
1567
 
  ADest.Colors[6, aStart + 3] := ADest.Pen.FPColor;
1568
 
  ADest.Colors[CDTrackBar.Width - 1 - 2, aStart - 1] := ADest.Pen.FPColor;
1569
 
  ADest.Colors[CDTrackBar.Width - 1 - 4, aStart - 2] := ADest.Pen.FPColor;
1570
 
  ADest.Colors[CDTrackBar.Width - 1 - 2, aStart + 1] := ADest.Pen.FPColor;
1571
 
  ADest.Colors[CDTrackBar.Width - 1 - 4, aStart + 2] := ADest.Pen.FPColor;
1572
 
  ADest.Colors[CDTrackBar.Width - 1 - 6, aStart - 3] := ADest.Pen.FPColor;
1573
 
  ADest.Colors[CDTrackBar.Width - 1 - 6, aStart + 3] := ADest.Pen.FPColor;
1574
 
  //ADest.Draw(0,0,TempB);
1575
 
  //ADest.CopyRect(0, 0, BCanvas, Rect(0, 0, CDTrackBar.Width, CDTrackBar.Height));
1576
 
  //FPIMGCopyRect(TempB, FPImg, Rect(10, 10, CDTrackBar.Width - 11, CDTrackBar.Height - 11));
1577
 
  BCanvas.Free;
1578
 
  TempB.Free;
1579
 
  ABmp.Free;
1580
 
end;
1581
 
 
1582
 
{ TCDTabSheet }
1583
 
 
1584
 
constructor TCDTabSheet.Create(AOwner: TComponent);
1585
 
begin
1586
 
  inherited Create(AOwner);
1587
 
  //Parent := TCDPageControl(AOwner);
1588
 
  TabStop := False;
1589
 
  ParentColor := True;
1590
 
  parentFont := True;
1591
 
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
1592
 
    csDoubleClicks, csReplicatable];
1593
 
  FCurrentDrawer := TCDTabSheetDrawerGraph.Create;
1594
 
end;
1595
 
 
1596
 
destructor TCDTabSheet.Destroy;
1597
 
begin
1598
 
  FCurrentDrawer.Free;
1599
 
  inherited Destroy;
1600
 
end;
1601
 
 
1602
 
procedure TCDTabSheet.EraseBackground(DC: HDC);
1603
 
begin
1604
 
 
1605
 
end;
1606
 
 
1607
 
procedure TCDTabSheet.Paint;
1608
 
var
1609
 
  AImage: TLazIntfImage = nil;
1610
 
  ABmp: TBitmap = nil;
1611
 
  lCanvas: TFPImageCanvas = nil;
1612
 
begin
1613
 
  inherited Paint;
1614
 
 
1615
 
  ABmp := TBitmap.Create;
1616
 
  try
1617
 
    ABmp.Width := Width;
1618
 
    ABmp.Height := Height;
1619
 
    AImage := ABmp.CreateIntfImage;
1620
 
    lCanvas := TFPImageCanvas.Create(AImage);
1621
 
    FCurrentDrawer.DrawToIntfImage(lCanvas, AImage, Self);
1622
 
    ABmp.LoadFromIntfImage(AImage);
1623
 
    Canvas.Draw(0, 0, ABmp);
1624
 
  finally
1625
 
    if lCanvas <> nil then
1626
 
      lCanvas.Free;
1627
 
    if AImage <> nil then
1628
 
      AImage.Free;
1629
 
    ABmp.Free;
1630
 
  end;
1631
 
end;
1632
 
 
1633
 
procedure TCDTabSheetDrawerGraph.DrawToIntfImage(ADest: TFPImageCanvas;
1634
 
  FPImg: TLazIntfImage; CDTabSheet: TCDTabSheet);
1635
 
begin
1636
 
  if TCDPageControl(CDTabSheet.Parent).Gradient then
1637
 
    GradientFillFP(clWhite, GetUColor(CDTabSheet.Color, 96), ADest,
1638
 
      Rect(0, 0, CDTabSheet.Width - 1, CDTabSheet.Height - 1))
1639
 
  else
1640
 
    ADest.Rectangle(0, 0, CDTabSheet.Width - 1, CDTabSheet.Height - 1);
1641
 
end;
1642
 
 
1643
411
{ TCDPageControlEditor }
1644
412
 
 
413
procedure TCDPageControlEditor.ShowPageMenuItemClick(Sender: TObject);
 
414
var
 
415
  AMenuItem: TMenuItem;
 
416
  NewPageIndex: integer;
 
417
begin
 
418
  AMenuItem := TMenuItem(Sender);
 
419
  if (AMenuItem = nil) or (not (AMenuItem is TMenuItem)) then
 
420
    exit;
 
421
  NewPageIndex := AMenuItem.MenuIndex;
 
422
  if (NewPageIndex < 0) or (NewPageIndex >= PControl.PageCount) then
 
423
    exit;
 
424
  PControl.PageIndex := NewPageIndex;
 
425
  GetDesigner.SelectOnlyThisComponent(TComponent(PControl.Tabs.Objects[PControl.PageIndex]));
 
426
end;
 
427
 
1645
428
procedure TCDPageControlEditor.ExecuteVerb(Index: integer);
1646
429
var
1647
430
  NewPage: TCDTabSheet;
1648
 
  PControl: TCDPageControl;
1649
431
  Hook: TPropertyEditorHook;
1650
432
  PageComponent: TPersistent;
 
433
  OldPage: longint;
 
434
  lPageName: String;
1651
435
begin
1652
 
  if Component is TCDPageControl then
1653
 
    PControl := TCDPageControl(Component)
1654
 
  else
1655
 
    if Component is TCDTabSheet then
1656
 
      PControl := TCDPageControl(TCDTabSheet(Component).Parent);
1657
 
  Hook:=nil;
 
436
  if not GetHook(Hook) then exit;
 
437
 
1658
438
  case Index of
1659
439
    0:
1660
440
    begin  //  New Page
1661
 
      if not GetHook(Hook) then exit;
1662
 
      NewPage := TCDTabSheet.Create(PControl.Owner);
1663
 
      NewPage.Parent := PControl;
1664
 
      with NewPage do
1665
 
      begin
1666
 
        Name := Designer.CreateUniqueComponentName(ClassName);
1667
 
        //GetUniqueName(sTABSHEET_DEFAULT_NAME, PControl);
1668
 
        Caption := Name;
1669
 
        {Left := 0;
1670
 
        Top := PControl.CaptionHeight + 1;
1671
 
        Width := PControl.Width;
1672
 
        Height := PControl.Height - PControl.CaptionHeight + 1;  }
1673
 
        SetBounds(1, PControl.CaptionHeight + 1, PControl.Width - 3, PControl.Height - PControl.CaptionHeight - 4);
1674
 
        if PControl.ActivePage <> nil then
1675
 
          PControl.ActivePage.Hide;
1676
 
        PControl.ActivePage := NewPage;
1677
 
        Show;
1678
 
      end;
1679
 
      PControl.FPages.Add(NewPage);
1680
 
      Hook.PersistentAdded(NewPage,true);
1681
 
      Designer.Modified;
 
441
      lPageName := Designer.CreateUniqueComponentName(TCDTabSheet.ClassName);
 
442
      NewPage := PControl.AddPage(lPageName);
 
443
      Hook.PersistentAdded(NewPage, True);
1682
444
    end;
1683
445
    1:
 
446
    begin // Insert Page
 
447
      lPageName := Designer.CreateUniqueComponentName(TCDTabSheet.ClassName);
 
448
      NewPage := PControl.InsertPage(PControl.PageIndex, lPageName);
 
449
      Hook.PersistentAdded(NewPage, True);
 
450
    end;
 
451
    2:
1684
452
    begin  //  Delete Page
1685
 
      with PControl do
1686
 
      begin
1687
 
        NewPage := ActivePage;
1688
 
        //FPages.Remove(NewPage);
1689
 
        if not GetHook(Hook) then exit;
1690
 
        PageComponent := TPersistent(NewPage);
1691
 
        Hook.DeletePersistent(PageComponent);
1692
 
        if NewPage <> nil then
1693
 
          NewPage.Free;
1694
 
      end;
 
453
      //WriteLn('Delete 1');
 
454
      NewPage := PControl.ActivePage;
 
455
      if NewPage = nil then Exit;
 
456
      //WriteLn('Delete 2');
 
457
      PControl.RemovePage(PControl.PageIndex);
 
458
      Hook.PersistentDeleting(NewPage);
1695
459
    end;
1696
 
    2:
 
460
    3:
1697
461
    begin  //  Next Page
1698
 
      PControl.FindNextPage(PControl.ActivePage, True, False);
 
462
      PControl.ActivePage := PControl.FindNextPage(PControl.ActivePage, True, False);
1699
463
    end;
1700
 
    3:
 
464
    4:
1701
465
    begin  //  Previous Page
1702
 
      PControl.FindNextPage(PControl.ActivePage, False, False);
 
466
      PControl.ActivePage := PControl.FindNextPage(PControl.ActivePage, False, False);
1703
467
    end;
1704
468
  end;
1705
 
  if Designer <> nil then
1706
 
    Designer.Modified;
 
469
  Modified;
 
470
  if Designer <> nil then Designer.Modified;
 
471
  PControl.Invalidate;
1707
472
end;
1708
473
 
1709
474
function TCDPageControlEditor.GetVerb(Index: integer): string;
1710
475
begin
1711
476
  case Index of
1712
 
    0: Result := sNEW_PAGE;
1713
 
    1: Result := sDEL_PAGE;
1714
 
    2: Result := sNEXT_PAGE;
1715
 
    3: Result := sPREV_PAGE;
 
477
    0: Result := nbcesAddPage;
 
478
    1: Result := nbcesInsertPage;
 
479
    2: Result := nbcesDeletePage;
 
480
    3: Result := sNEXT_PAGE;
 
481
    4: Result := sPREV_PAGE;
 
482
    5: Result := nbcesShowPage;
1716
483
  end;
1717
484
end;
1718
485
 
1719
486
function TCDPageControlEditor.GetVerbCount: integer;
1720
487
begin
1721
 
  Result := 4;
1722
 
end;
1723
 
 
1724
 
{ TCDPageControl }
1725
 
 
1726
 
procedure TCDPageControl.PrepareCurrentDrawer();
1727
 
begin
1728
 
  case DrawStyle of
1729
 
    dsWince: FCurrentDrawer := FDrawerWinCE;
1730
 
    dsCustom: FCurrentDrawer := CustomDrawer;
1731
 
  end;
1732
 
end;
1733
 
 
1734
 
procedure TCDPageControl.SetDrawStyle(const AValue: TCDDrawStyle);
1735
 
begin
1736
 
  if FDrawStyle = AValue then
1737
 
    exit;
1738
 
  FDrawStyle := AValue;
1739
 
  Invalidate;
1740
 
  PrepareCurrentDrawer();
1741
 
  FCurrentDrawer.SetClientRectPos(Self);
1742
 
end;
1743
 
 
1744
 
function TCDPageControl.FindNextPage(CurPage: TCDTabSheet;
1745
 
  GoForward, CheckTabVisible: boolean): TCDTabSheet;
1746
 
var
1747
 
  I, StartIndex: integer;
1748
 
begin
1749
 
  if FPages.Count <> 0 then
1750
 
  begin
1751
 
    StartIndex := FPages.IndexOf(CurPage);
1752
 
    if StartIndex = -1 then
1753
 
      if GoForward then StartIndex := FPages.Count - 1 else StartIndex := 0;
1754
 
    I := StartIndex;
1755
 
    repeat
1756
 
      if GoForward then
1757
 
      begin
1758
 
        Inc(I);
1759
 
        if I = FPages.Count then I := 0;
1760
 
      end else
1761
 
      begin
1762
 
        if I = 0 then I := FPages.Count;
1763
 
        Dec(I);
1764
 
      end;
1765
 
      Result := TCDTabSheet(FPages[I]);
1766
 
      if not CheckTabVisible or Result.Visible then Exit;
1767
 
    until I = StartIndex;
1768
 
  end;
1769
 
  Result := nil;
1770
 
end;
1771
 
 
1772
 
procedure TCDPageControl.SelectNextPage(GoForward: boolean;
1773
 
  CheckTabVisible: boolean = True);
1774
 
var
1775
 
  Page: TCDTabSheet;
1776
 
begin
1777
 
  Page := FindNextPage(ActivePage, GoForward, CheckTabVisible);
1778
 
  if (Page <> nil) and (Page <> ActivePage) then
1779
 
    SetActivePage(Page);
1780
 
end;
1781
 
 
1782
 
constructor TCDPageControl.Create(AOwner: TComponent);
1783
 
begin
1784
 
  inherited Create(AOwner);
1785
 
  Width := 232;
1786
 
  Height := 184;
1787
 
  TabStop := False;
1788
 
  FDrawerWinCE := TCDPageControlDrawerWinCE.Create;
1789
 
  FCaptionHeight := 28;
1790
 
  ParentColor := True;
1791
 
  parentFont := True;
1792
 
  FGrad := True;
1793
 
  ControlStyle := [];
1794
 
  FPages := TList.Create;
1795
 
end;
1796
 
 
1797
 
destructor TCDPageControl.Destroy;
1798
 
begin
1799
 
  FPages.Free;
1800
 
  inherited Destroy;
1801
 
end;
1802
 
 
1803
 
procedure TCDPageControl.SetActivePage(Value: TCDTabSheet);
1804
 
var i: integer;
1805
 
begin
1806
 
  for i := 0 to FPages.Count - 1 do
1807
 
  begin
1808
 
    if TCDTabSheet(FPages[i]) = Value then
1809
 
      Show
1810
 
    else
1811
 
      Hide;
1812
 
  end;
1813
 
  FActivePage := Value;
1814
 
  Value.BringToFront;
1815
 
end;
1816
 
 
1817
 
procedure TCDPageControl.SetPageIndex(Value: integer);
1818
 
begin
1819
 
  FPageIndex := Value;
1820
 
  ActivePage := TCDTabSheet(Pages[Value]);
1821
 
  Invalidate;
1822
 
end;
1823
 
 
1824
 
procedure TCDPageControl.EraseBackground(DC: HDC);
1825
 
begin
1826
 
 
1827
 
end;
1828
 
 
1829
 
procedure TCDPageControl.Paint;
1830
 
var
1831
 
  AImage: TLazIntfImage = nil;
1832
 
  ABmp: TBitmap = nil;
1833
 
  lCanvas: TFPImageCanvas = nil;
1834
 
begin
1835
 
  inherited Paint;
1836
 
 
1837
 
  PrepareCurrentDrawer();
1838
 
 
1839
 
  ABmp := TBitmap.Create;
1840
 
  try
1841
 
    ABmp.Width := Width;
1842
 
    ABmp.Height := Height;
1843
 
    AImage := ABmp.CreateIntfImage;
1844
 
    lCanvas := TFPImageCanvas.Create(AImage);
1845
 
    // First step of the drawing: FCL TFPCustomCanvas for fast pixel access
1846
 
    FCurrentDrawer.DrawToIntfImage(lCanvas, AImage, Self);
1847
 
    ABmp.LoadFromIntfImage(AImage);
1848
 
    // Second step of the drawing: LCL TCustomCanvas for easy font access
1849
 
    FCurrentDrawer.DrawToCanvas(ABmp.Canvas, Self);
1850
 
    Canvas.Draw(0, 0, ABmp);
1851
 
  finally
1852
 
    if lCanvas <> nil then
1853
 
      lCanvas.Free;
1854
 
    if AImage <> nil then
1855
 
      AImage.Free;
1856
 
    ABmp.Free;
1857
 
  end;
1858
 
end;
1859
 
 
1860
 
procedure TCDPageControl.SetCaptionHeight(Value: integer);
1861
 
begin
1862
 
  FCaptionHeight := Value;
1863
 
  invalidate;
1864
 
end;
1865
 
 
1866
 
procedure TCDPageControl.SetPageGradient(Value: boolean);
1867
 
begin
1868
 
  FGrad := Value;
1869
 
  invalidate;
1870
 
end;
1871
 
 
1872
 
procedure TCDPageControl.SetShowTabs(Value: boolean);
1873
 
begin
1874
 
  FShowTabs := Value;
1875
 
  invalidate;
1876
 
end;
1877
 
 
1878
 
procedure TCDPageControl.DrawCaptionBar(ADest: TFPImageCanvas;
1879
 
  FPImg: TLazIntfImage; lRect: TRect);
1880
 
var
1881
 
  aRect: TRect; i: integer; rWidth: integer; aText: string;
1882
 
begin
1883
 
  aRect := lRect;
1884
 
  ADest.Pen.Style := psSolid;
1885
 
  ADest.Brush.Style := bsSolid;
1886
 
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($009C9B91));
1887
 
  aRect.Left := lRect.Left;
1888
 
  aRect.Top := lRect.Top;
1889
 
  aRect.Bottom := lRect.Bottom;
1890
 
  aRect.Right := lRect.Right;
1891
 
  if Owner.ComponentCount = 0 then
1892
 
  begin
1893
 
    ADest.RecTangle(aRect);
1894
 
    Exit;
1895
 
  end;
1896
 
  for i := 0 to Owner.ComponentCount - 1 do
1897
 
  begin
1898
 
    if Owner.Components[i].GetParentComponent = Self then
1899
 
    begin
1900
 
      aText := TCDTabSheet(Owner.Components[i]).Caption;
1901
 
      rWidth := 6 + Length(aText) * 9; //TCDTabSheet(FPages[i]).Font.Size;
1902
 
      if aRect.Left + rWidth > lRect.Right - 6 then
1903
 
        break
1904
 
      else
1905
 
        aRect.Right := aRect.Left + rWidth;
1906
 
      ADest.RecTangle(aRect);
1907
 
      //ADest.TextOut(aRect.Left + 3, aRect.Top + 3, aText);
1908
 
      aRect.Left := aRect.Right;
1909
 
    end;
1910
 
  end;
1911
 
  aRect.Left := lRect.Right - 51;
1912
 
  aRect.Top := 1;
1913
 
  aRect.Bottom := 25;
1914
 
  aRect.Right := lRect.Right - 26;
1915
 
  GradFill(ADest, aRect, $00FDD9CB, $00F2C9B8);
1916
 
  aRect.Left := lRect.Right - 25;
1917
 
  aRect.Top := 1;
1918
 
  aRect.Bottom := 25;
1919
 
  aRect.Right := lRect.Right;
1920
 
  GradFill(ADest, aRect, $00FDD9CB, $00F2C9B8);
1921
 
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(clWhite));
1922
 
  ADest.Line(lRect.Right - 51, 1, lRect.Right, 1);
1923
 
  ADest.Line(lRect.Right, 1, lRect.Right, 25);
1924
 
  ADest.Line(lRect.Right, 25, lRect.Right - 51, 25);
1925
 
  ADest.Line(lRect.Right - 51, 25, lRect.Right - 51, 1);
1926
 
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($00FFFFFF));
1927
 
  //ADest.Line();
1928
 
end;
1929
 
 
1930
 
procedure TCDPageControl.SetCDPages(Value: TList);
1931
 
begin
1932
 
  FPages.Assign(Value);
1933
 
end;
1934
 
 
1935
 
procedure TCDPageControl.DoOnResize;
1936
 
begin
1937
 
  if ActivePage <> nil then
1938
 
  begin
1939
 
    ActivePage.Left := 1;
1940
 
    ActivePage.Top := CaptionHeight + 1;
1941
 
    ActivePage.Width := Width - 3;
1942
 
    ActivePage.Height := Height - CaptionHeight - 4;
1943
 
  end;
1944
 
end;
1945
 
 
1946
 
procedure TCDPageControl.UpdateAllDesignerFlags;
 
488
  Result := 6;
 
489
end;
 
490
 
 
491
procedure TCDPageControlEditor.PrepareItem(Index: integer; const AnItem: TMenuItem);
 
492
begin
 
493
  inherited PrepareItem(Index, AnItem);
 
494
  case Index of
 
495
    0: ;
 
496
    1: AnItem.Enabled := PControl.PageIndex >= 0;
 
497
    2: AnItem.Enabled := PControl.PageIndex >= 0;
 
498
    3: AnItem.Enabled := PControl.PageIndex < PControl.PageCount - 1;
 
499
    4: AnItem.Enabled := PControl.PageIndex > 0;
 
500
    5: AddMenuItemsForPages(AnItem);
 
501
  end;
 
502
end;
 
503
 
 
504
procedure TCDPageControlEditor.AddMenuItemsForPages(ParentMenuItem: TMenuItem);
1947
505
var
1948
506
  i: integer;
1949
 
begin
1950
 
  for i:=0 to FPages.Count-1 do
1951
 
    UpdateDesignerFlags(i);
1952
 
end;
1953
 
 
1954
 
procedure TCDPageControl.UpdateDesignerFlags(APageIndex: integer);
1955
 
begin
1956
 
  if APageIndex<>fPageIndex then
1957
 
    TCDTabSheet(FPages[APageIndex]).ControlStyle:=
1958
 
      TCDTabSheet(FPages[APageIndex]).ControlStyle+[csNoDesignVisible]
1959
 
  else
1960
 
    TCDTabSheet(FPages[APageIndex]).ControlStyle:=
1961
 
      TCDTabSheet(FPages[APageIndex]).ControlStyle-[csNoDesignVisible];
1962
 
end;
1963
 
 
1964
 
{procedure TCDPageControl.CNNotify(var Message: TLMNotify);
1965
 
var
1966
 
  OldPageIndex: LongInt;
1967
 
begin
1968
 
  with Message do
1969
 
    case NMHdr^.code of
1970
 
      TCN_SELCHANGE:
1971
 
        begin
1972
 
          // set the page from the NMHDR^.idfrom
1973
 
          if not (csDestroyingHandle in ControlState) then
1974
 
          begin
1975
 
            OldPageIndex := FPageIndex;
1976
 
            FPageIndex := PtrInt(NMHDR^.idfrom);
1977
 
            if FPageIndex >= FPages.Count then
1978
 
              FPageIndex := -1;
1979
 
            //debugln(['TCDPageControl.CNNotify ',DbgSName(Self),' A Old=',OldPageIndex,' fPageIndex=',fPageIndex,' FLoadedPageIndex=',FLoadedPageIndex]);
1980
 
            //if PageIndex>=0 then DebugLn(['TCDPageControl.CNNotify Page=',DbgSName(Page[PageIndex]),' Visible=',Page[PageIndex].Visible]);
1981
 
            UpdateAllDesignerFlags;
1982
 
            if ([csLoading,csDestroying]*ComponentState=[]) then
1983
 
            begin
1984
 
              if OldPageIndex <> FPageIndex then
1985
 
              begin
1986
 
                if csDesigning in ComponentState then
1987
 
                  OwnerFormDesignerModified(Self);
1988
 
                //DebugLn(['TCustomNotebook.CNNotify ',DbgSName(Page[PageIndex]),' ',Page[PageIndex].Visible]);
1989
 
             //   Change;
1990
 
              end;
1991
 
            end;
1992
 
          end;
1993
 
        end;
1994
 
      TCN_SELCHANGING:
1995
 
        begin
1996
 
        {  if CanChangePageIndex and not
1997
 
          (csDestroyingHandle in ControlState) then
1998
 
            Result := 0
1999
 
          else
2000
 
            Result := 1;       }
2001
 
        end;
2002
 
    else
2003
 
      begin
2004
 
        {$IFDEF NOTEBOOK_DEBUG}
2005
 
        DebugLn(['[TCDPageControl.CNNotify] unhandled NMHdr code:', NMHdr^.code]);
2006
 
        {$ENDIF}
2007
 
      end;
2008
 
    end;
2009
 
end;       }
2010
 
 
2011
 
procedure TCDPageControl.SetMouseUP;
2012
 
begin
2013
 
  FMDownL := False;
2014
 
  FMDownR := False;
2015
 
end;
2016
 
 
2017
 
procedure TCDPageControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
2018
 
  X, Y: integer);
2019
 
begin
2020
 
  if (X > Width - 36) and (X < Width - 18) then
2021
 
    FMDownL := True
2022
 
  else
2023
 
    if (X > Width - 36) and (X < Width - 18) then
2024
 
     FMDownR := True
2025
 
    else
2026
 
      SetMouseUP;
2027
 
  if (Y < 3) or (Y > 18) then
2028
 
    SetMouseUP;
2029
 
  if FMDownR or FMDownL then
2030
 
    invalidate;
2031
 
  inherited MouseDown(Button, Shift, X, Y);
2032
 
end;
2033
 
 
2034
 
procedure TCDPageControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
2035
 
begin
2036
 
  SetMouseUP;
2037
 
  inherited MouseUp(Button, Shift, X, Y);
2038
 
end;
2039
 
 
2040
 
procedure TCDPageControl.MouseMove(Shift: TShiftState; X, Y: integer);
2041
 
begin
2042
 
  if (X > Width - 36) and (X < Width - 18) then
2043
 
    FMEnterL := True
2044
 
  else
2045
 
    if (X > Width - 36) and (X < Width - 18) then
2046
 
      FMEnterR := True
2047
 
    else
2048
 
    begin
2049
 
      FMEnterR := False;
2050
 
      FMEnterL := False;
2051
 
    end;
2052
 
  if (Y < 3) or (Y > 18) then
 
507
  NewMenuItem: TMenuItem;
 
508
  TabPage: TCDTabSheet;
 
509
begin
 
510
  ParentMenuItem.Enabled := PControl.PageCount > 0;
 
511
  for i := 0 to PControl.PageCount - 1 do
2053
512
  begin
2054
 
    FMEnterR := False;
2055
 
    FMEnterL := False;
 
513
    TabPage := PControl.GetPage(i);
 
514
    NewMenuItem := TMenuItem.Create(ParentMenuItem);
 
515
    NewMenuItem.Name := 'ShowPage' + IntToStr(i);
 
516
    NewMenuItem.Caption := TabPage.Name + ' "' + TabPage.Caption + '"';
 
517
    NewMenuItem.OnClick := @ShowPageMenuItemClick;
 
518
    ParentMenuItem.Add(NewMenuItem);
2056
519
  end;
2057
 
  if FMEnterR or FMENterL then
2058
 
    invalidate;
2059
 
  inherited MouseMove(Shift, X, Y);
2060
 
end;
2061
 
 
2062
 
procedure TCDPageControl.Loaded;
2063
 
begin
2064
 
  inherited;
2065
 
end;
2066
 
 
2067
 
procedure TCDPageControl.MouseEnter;
2068
 
begin
2069
 
  inherited MouseEnter;
2070
 
end;
2071
 
 
2072
 
procedure TCDPageControl.MouseLeave;
2073
 
begin
2074
 
  inherited MouseLeave;
2075
 
end;
2076
 
 
2077
 
{ TCDPageControlDrawerWinCE }
2078
 
 
2079
 
procedure TCDPageControlDrawerWinCE.SetClientRectPos(CDPageControl: TCDPageControl);
2080
 
var
2081
 
  lRect: TRect;
2082
 
  lCaptionHeight: integer;
2083
 
begin
2084
 
  lCaptionHeight := CDPageControl.CaptionHeight;
2085
 
  lRect := Rect(10, lCaptionHeight + 1, CDPageControl.Width - 10,
2086
 
    CDPageControl.Height - 1);
2087
 
  CDPageControl.AdjustClientRect(lRect);
2088
 
end;
2089
 
 
2090
 
procedure TCDPageControlDrawerWinCE.DrawToIntfImage(ADest: TFPImageCanvas;
2091
 
  FPImg: TLazIntfImage; CDPageControl: TCDPageControl);
2092
 
begin
2093
 
  ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CDPageControl.Color));
2094
 
  ADest.Brush.Style := bsSolid;
2095
 
  ADest.Pen.Style := psClear;
2096
 
  ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CDPageControl.Color));
2097
 
  ADest.Rectangle(0, 0, CDPageControl.Width, CDPageControl.Height);
2098
 
  ADest.Font.Name := CDPageControl.Font.Name;
2099
 
  ADest.Font.Size := CDPageControl.Font.Size;
2100
 
  CDPageControl.DrawCaptionBar(ADest, FPImg, Rect(0, 0, CDPageControl.Width -
2101
 
    2, CDPageControl.CaptionHeight + 1));
2102
 
  if CDPageControl.Gradient then
2103
 
    GradientFillFP(clWhite, GetUColor(CDPageControl.Color, 96), ADest,
2104
 
      Rect(0, CDPageControl.CaptionHeight, CDPageControl.Width, CDPageControl.Height))
2105
 
  else
2106
 
    ADest.Rectangle(0, CDPageControl.CaptionHeight, CDPageControl.Width,
2107
 
      CDPageControl.Height);
2108
 
  ADest.Colors[CDPageControl.Width - 1, CDPageControl.CaptionHeight] :=
2109
 
    TColorToFPColor(ColorToRGB(CDPageControl.Color));
2110
 
  // frame
2111
 
  //ADest.Pen.FPColor := colBlack;
2112
 
  ADest.Pen.Style := psSolid;
2113
 
  ADest.Brush.Style := bsClear;
2114
 
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($009C9B91));
2115
 
  //  ADest.Rectangle(0,0,CDPageControl.Width-2,CDPageControl.Height-2);
2116
 
  ADest.Rectangle(0, CDPageControl.CaptionHeight, CDPageControl.Width -
2117
 
    2, CDPageControl.Height - 2);
2118
 
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($00BFCED0));
2119
 
  ADest.Line(CDPageControl.Width - 1, CDPageControl.CaptionHeight + 1,
2120
 
    CDPageControl.Width - 1, CDPageControl.Height - 1);
2121
 
  ADest.Line(CDPageControl.Width - 1, CDPageControl.Height - 1, 1,
2122
 
    CDPageControl.Height - 1);
2123
 
end;
2124
 
 
2125
 
procedure TCDPageControlDrawerWinCE.DrawToCanvas(ADest: TCanvas;
2126
 
  CDPageControl: TCDPageControl);
2127
 
begin
2128
 
 
 
520
end;
 
521
 
 
522
function TCDPageControlEditor.PControl: TCDPageControl;
 
523
begin
 
524
  if Component is TCDPageControl then
 
525
    Result := TCDPageControl(Component)
 
526
  else if Component is TCDTabSheet then
 
527
    Result := TCDPageControl(TCDTabSheet(Component).Parent);
2129
528
end;
2130
529
 
2131
530
end.