From 07009999428a63aa56a06ba3c872c771ef4c15f2 Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Wed, 26 Oct 2011 09:25:30 +0000 Subject: [PATCH] Splits the big customdrawn unit in two smaller parts git-svn-id: trunk@33087 - --- .gitattributes | 1 + components/customdrawn/customdrawn.lpk | 6 +- components/customdrawn/customdrawn.pas | 2 +- .../customdrawn/customdrawncontrols.pas | 2149 +++++++++++++++++ components/customdrawn/customdrawnextras.pas | 2125 +--------------- 5 files changed, 2162 insertions(+), 2121 deletions(-) create mode 100644 components/customdrawn/customdrawncontrols.pas diff --git a/.gitattributes b/.gitattributes index 28a14323a0..a2695e75f5 100644 --- a/.gitattributes +++ b/.gitattributes @@ -638,6 +638,7 @@ components/compilers/javascript/examples/jsclassxmlread.pas svneol=native#text/p components/custom/README.txt svneol=native#text/plain components/customdrawn/customdrawn.lpk svneol=native#text/plain components/customdrawn/customdrawn.pas svneol=native#text/pascal +components/customdrawn/customdrawncontrols.pas svneol=native#text/pascal components/customdrawn/customdrawnextras.pas svneol=native#text/plain components/customdrawn/customdrawnutils.pas svneol=native#text/pascal components/customform/custforms.pp svneol=native#text/plain diff --git a/components/customdrawn/customdrawn.lpk b/components/customdrawn/customdrawn.lpk index d3a666a344..32387af516 100644 --- a/components/customdrawn/customdrawn.lpk +++ b/components/customdrawn/customdrawn.lpk @@ -23,7 +23,7 @@ - + @@ -33,6 +33,10 @@ + + + + diff --git a/components/customdrawn/customdrawn.pas b/components/customdrawn/customdrawn.pas index 48a520cf55..c9e4d065ee 100644 --- a/components/customdrawn/customdrawn.pas +++ b/components/customdrawn/customdrawn.pas @@ -7,7 +7,7 @@ unit customdrawn; interface uses - customdrawnextras, customdrawnutils, LazarusPackageIntf; + customdrawnextras, customdrawnutils, customdrawncontrols, LazarusPackageIntf; implementation diff --git a/components/customdrawn/customdrawncontrols.pas b/components/customdrawn/customdrawncontrols.pas new file mode 100644 index 0000000000..a5952e855c --- /dev/null +++ b/components/customdrawn/customdrawncontrols.pas @@ -0,0 +1,2149 @@ +{ + Copyright (C) 2011 Felipe Monteiro de Carvalho + + License: The same modifying LGPL with static linking exception as the LCL + + This unit should be a repository for various custom drawn components, + such as a custom drawn version of TButton, of TEdit, of TPageControl, etc, + eventually forming a full set of custom drawn components. +} +unit customdrawncontrols; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Graphics, Controls, LCLType, LCLIntf, IntfGraphics, + Math, types, customdrawnutils, contnrs, componenteditors, LMessages, Messages, + LCLProc, PropEdits, ExtCtrls, ImgList, Forms, Menus, + // fpimage + fpcanvas, fpimgcanv, fpimage + {$ifdef CUSTOMDRAWN_USE_FREETYPE} + // font support + , ftfont + {$endif} ; + +type + + TCDDrawStyle = ( + // Operating system styles + dsWinCE, dsWin2000, dsAndroid, dsXPTaskBar, + // Other special styles + dsGrad, + // Defined by the user + dsCustom); + + // commented items are not yet supported + TCDButtonState = (bbsNormal, bbsDown, bbsMouseOver, bbsFocused + (* bbsChecked, bbsCheckedSelected, bbsCheckedDown { is going to be unchecked }*)); + + TCDControlDrawer = class; + + { TCDControl } + + TCDControl = class(TCustomControl) + protected + FDrawStyle: TCDDrawStyle; + FCurrentDrawer: TCDControlDrawer; + //constructor Create(AOwner: TComponent); override; + //destructor Destroy; override; + procedure PrepareCurrentDrawer(); virtual; + procedure SetDrawStyle(const AValue: TCDDrawStyle); + function GetClientRect: TRect; override; + procedure EraseBackground(DC: HDC); override; + property DrawStyle: TCDDrawStyle read FDrawStyle write SetDrawStyle; + public + end; + + TCDControlDrawer = class + public + function GetClientRect(AControl: TCDControl): TRect; virtual; abstract; + //procedure DrawToIntfImage(ADest: TFPImageCanvas; AControl: TCDControl); + // virtual; abstract; + //procedure DrawToCanvas(ADest: TCanvas; AControl: TCDControl); virtual; abstract; + end; + + TCDButtonDrawer = class; + TCDButtonDrawerWinCE = class; + TCDButtonDrawerAndroid = class; + TCDButtonDrawerXPTB = class; + TCDButtonDrawerGrad = class; + TCDButtonDrawerWin2k = class; + + { TCDButton } + + TCDButton = class(TCDControl) + private + //FCurrentDrawer: TCDButtonDrawer; + FDrawerWinCE: TCDButtonDrawerWinCE; + FDrawerAndroid: TCDButtonDrawerAndroid; + FDrawerXPTB: TCDButtonDrawerXPTB; + FDrawerGrad: TCDButtonDrawerGrad; + FDrawerWin2k: TCDButtonDrawerWin2k; + procedure PrepareCurrentDrawer(); override; + protected + FState: TCDButtonState; + // keyboard + procedure DoEnter; override; + procedure DoExit; override; + procedure KeyDown(var Key: word; Shift: TShiftState); override; + procedure KeyUp(var Key: word; Shift: TShiftState); override; + // mouse + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override; + procedure MouseEnter; override; + procedure MouseLeave; override; + // button state change + procedure DoButtonDown(); + procedure DoButtonUp(); + procedure RealSetText(const Value: TCaption); override; + public + CustomDrawer: TCDButtonDrawer; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Paint; override; + published + property Action; + property Anchors; + property Caption; + property Color; + property Constraints; + property DrawStyle: TCDDrawStyle read FDrawStyle write SetDrawStyle; + property Enabled; + property Font; + property OnChangeBounds; + property OnClick; + property OnContextPopup; + property OnDragDrop; + property OnDragOver; + property OnEndDrag; + property OnEnter; + property OnExit; + property OnKeyDown; + property OnKeyPress; + property OnKeyUp; + property OnMouseDown; + property OnMouseEnter; + property OnMouseLeave; + property OnMouseMove; + property OnMouseUp; + property OnResize; + property OnStartDrag; + property OnUTF8KeyPress; + property ParentFont; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property TabOrder; + property TabStop; + property Visible; + end; + + { TCDButtonDrawer } + + TCDButtonDrawer = class(TCDControlDrawer) + public + function GetClientRect(AControl: TCDControl): TRect; override; + procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); + virtual; abstract; + procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; + FState: TCDButtonState); virtual; abstract; + end; + + { TCDButtonDrawerWinCE } + + TCDButtonDrawerWinCE = class(TCDButtonDrawer) + public + procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override; + procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; + FState: TCDButtonState); override; + end; + + { TCDButtonDrawerAndroid } + TCDButtonDrawerAndroid = class(TCDButtonDrawer) + public + procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override; + procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; + FState: TCDButtonState); override; + end; + + TCDButtonDrawerXPTB = class(TCDButtonDrawer) + public + procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override; + procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; + FState: TCDButtonState); override; + end; + + TCDButtonDrawerGrad = class(TCDButtonDrawer) + public + procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override; + procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; + FState: TCDButtonState); override; + end; + + TCDButtonDrawerWin2k = class(TCDButtonDrawer) + public + procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override; + procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; + FState: TCDButtonState); override; + end; + + {@@ + TCDGroupBox is a custom-drawn group box control + } + + TCDGroupBoxDrawer = class; + TCDGroupBoxDrawerWinCE = class; + + { TCDGroupBox } + + TCDGroupBox = class(TCustomControl) + private + FDrawStyle: TCDDrawStyle; + FCurrentDrawer: TCDGroupBoxDrawer; + FDrawerWinCE: TCDGroupBoxDrawerWinCE; + procedure PrepareCurrentDrawer(); + procedure SetDrawStyle(const AValue: TCDDrawStyle); + protected + procedure RealSetText(const Value: TCaption); override; // to update on caption changes + public + CustomDrawer: TCDGroupBoxDrawer; // Fill the field to use the dsCustom draw mode + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure EraseBackground(DC: HDC); override; + procedure Paint; override; + published + property DrawStyle: TCDDrawStyle read FDrawStyle write SetDrawStyle; + property Caption; + property TabStop default False; + end; + + { TCDGroupBoxDrawer } + + TCDGroupBoxDrawer = class + public + procedure SetClientRectPos(CDGroupBox: TCDGroupBox); virtual; abstract; + procedure DrawToIntfImage(ADest: TFPImageCanvas; CDGroupBox: TCDGroupBox); + virtual; abstract; + procedure DrawToCanvas(ADest: TCanvas; CDGroupBox: TCDGroupBox); virtual; abstract; + end; + + { TCDGroupBoxDrawerWinCE } + + TCDGroupBoxDrawerWinCE = class(TCDGroupBoxDrawer) + public + FCaptionMiddle: integer; + procedure SetClientRectPos(CDGroupBox: TCDGroupBox); override; + procedure DrawToIntfImage(ADest: TFPImageCanvas; CDGroupBox: TCDGroupBox); override; + procedure DrawToCanvas(ADest: TCanvas; CDGroupBox: TCDGroupBox); override; + end; + + {@@ + TCDTrackBar is a custom-drawn trackbar control + } + + TCDTrackBarDrawer = class; + + { TCDTrackBar } + + TCDTrackBar = class(TCustomControl) + private + DragDropStarted: boolean; + // fields + FMin: integer; + FMax: integer; + FPosition: integer; + FOnChange: TNotifyEvent; + FCurrentDrawer: TCDTrackBarDrawer; + procedure SetMax(Value: integer); + procedure SetMin(Value: integer); + procedure SetPosition(Value: integer); + // + function GetPositionFromMousePos(X, Y: Integer): integer; + protected + procedure Changed; virtual; + // keyboard + procedure DoEnter; override; + procedure DoExit; override; + procedure KeyDown(var Key: word; Shift: TShiftState); override; + procedure KeyUp(var Key: word; Shift: TShiftState); override; + // mouse + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override; + procedure MouseEnter; override; + procedure MouseLeave; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure EraseBackground(DC: HDC); override; + procedure Paint; override; + published + property Color; + property Max: integer read FMax write SetMax default 10; + property Min: integer read FMin write SetMin default 0; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property Position: integer read FPosition write SetPosition; + property TabStop default True; + end; + + { TCDTrackBarDrawer } + + TCDTrackBarDrawer = class + public + procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage; + CDTrackBar: TCDTrackBar); virtual; abstract; + procedure GetGeometry(var ALeftBorder, ARightBorder: Integer); virtual; abstract; + end; + + { TCDTrackBarDrawerGraph } + + TCDTrackBarDrawerGraph = class(TCDTrackBarDrawer) + public + procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage; + CDTrackBar: TCDTrackBar); override; + procedure GetGeometry(var ALeftBorder, ARightBorder: Integer); override; + end; + + {TCDTabControl} + + { TCDCustomTabControl } + + TCDCustomTabControl = class; + TCDCustomTabControlDrawer = class; + TCDCustomTabControlDrawerWinCE = class; + + { TCDCustomTabSheet } + + TCDCustomTabSheet = class(TCustomControl) + private + CDTabControl: TCDCustomTabControl; + FTabVisible: Boolean; + protected + procedure RealSetText(const Value: TCaption); override; // to update on caption changes + public + destructor Destroy; override; + property TabVisible: Boolean read FTabVisible write FTabVisible; + end; + + TCDCustomTabControl = class(TCDControl) + private + FTabIndex: Integer; + FTabs: TStringList; + FDrawerWinCE: TCDCustomTabControlDrawerWinCE; + FOnChanging: TNotifyEvent; + FOnChange: TNotifyEvent; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: integer); override; + //procedure MouseMove(Shift: TShiftState; X, Y: integer); override; + //procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override; + //procedure MouseEnter; override; + //procedure MouseLeave; override; + procedure PrepareCurrentDrawer(); override; + procedure SetTabIndex(AValue: Integer); virtual; + procedure SetTabs(AValue: TStringList); + protected + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Paint; override; + function GetTabCount: Integer; + procedure CorrectTabIndex(); + public + CustomDrawer: TCDCustomTabControlDrawer; // Fill the field to use the dsCustom draw mode + property Tabs: TStringList read FTabs write SetTabs; + property OnChanging: TNotifyEvent read FOnChanging write FOnChanging; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property TabIndex: integer read FTabIndex write SetTabIndex; + end; + + { TCDCustomTabControlDrawer } + + TCDCustomTabControlDrawer = class(TCDControlDrawer) + public + CDTabControl: TCDCustomTabControl; + function GetPageIndexFromXY(x, y: integer): integer; virtual; abstract; + function GetTabHeight(AIndex: Integer): Integer; virtual; abstract; + function GetTabWidth(ADest: TCanvas; AIndex: Integer): Integer; virtual; abstract; + procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage); virtual; abstract; + procedure DrawToCanvas(ADest: TCanvas); virtual; abstract; + procedure DrawTabSheet(ADest: TCanvas); virtual; abstract; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: integer); virtual; abstract; + end; + + { TCDCustomTabControlDrawerWinCE } + + TCDCustomTabControlDrawerWinCE = class(TCDCustomTabControlDrawer) + private + StartIndex: integer; //FEndIndex + LeftmostTabVisibleIndex: Integer; + procedure DrawCaptionBar(ADest: TCanvas; lRect: TRect; CL: TColor); + procedure DrawTabs(ADest: TCanvas); + procedure DrawTab(ADest: TCanvas; AIndex: Integer; ACurStartLeftPos: Integer); + public + function GetPageIndexFromXY(x, y: integer): integer; override; + function GetTabHeight(AIndex: Integer): Integer; override; + function GetTabWidth(ADest: TCanvas; AIndex: Integer): Integer; override; + //function GetClientRect(AControl: TCDControl): TRect; override; + procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage); override; + procedure DrawToCanvas(ADest: TCanvas); override; + procedure DrawTabSheet(ADest: TCanvas); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: integer); override; + end; + +// TTabSelectedEvent = procedure(Sender: TObject; ATab: TTabItem; +// ASelected: boolean) of object; + + TCDTabControl = class(TCDCustomTabControl) + published + property Color; + property Font; + property Tabs; + property TabIndex; + property OnChanging; + property OnChange; + end; + + { TCDTabSheet } + + TCDPageControl = class; + + TCDTabSheet = class(TCDCustomTabSheet) + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure EraseBackground(DC: HDC); override; + procedure Paint; override; + published + property Caption; + property Color; + property Font; + property TabVisible: Boolean; + end; + + { TCDPageControl } + + TCDPageControl = class(TCDCustomTabControl) + private + function GetActivePage: TCDTabSheet; + function GetPageCount: integer; + function GetPageIndex: integer; + procedure SetActivePage(Value: TCDTabSheet); + procedure SetPageIndex(Value: integer); + procedure UpdateAllDesignerFlags; + procedure UpdateDesignerFlags(APageIndex: integer); + procedure PositionTabSheet(ATabSheet: TCDTabSheet); + protected + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + public + function InsertPage(aIndex: integer; S: string): TCDTabSheet; + procedure RemovePage(aIndex: integer); + function AddPage(S: string): TCDTabSheet; + function GetPage(aIndex: integer): TCDTabSheet; + property PageCount: integer read GetPageCount; + // Used by the property editor in customdrawnextras + function FindNextPage(CurPage: TCDTabSheet; + GoForward, CheckTabVisible: boolean): TCDTabSheet; + procedure SelectNextPage(GoForward: boolean; CheckTabVisible: boolean = True); + published + property ActivePage: TCDTabSheet read GetActivePage write SetActivePage; + property DrawStyle: TCDDrawStyle; + property Caption; + property Color; + property Font; + property PageIndex: integer read GetPageIndex write SetPageIndex; + property ParentColor; + property ParentFont; + property TabStop default True; + property TabIndex; + property OnChanging; + property OnChange; + end; + +implementation + +resourcestring + sTABSHEET_DEFAULT_NAME = 'CTabSheet'; + +{ TCDCustomTabSheet } + +procedure TCDCustomTabSheet.RealSetText(const Value: TCaption); +var + lIndex: Integer; +begin + inherited RealSetText(Value); + lIndex := CDTabControl.Tabs.IndexOfObject(Self); + if lIndex >= 0 then + CDTabControl.Tabs.Strings[lIndex] := Value; + CDTabControl.Invalidate; +end; + +destructor TCDCustomTabSheet.Destroy; +var + lIndex: Integer; +begin + // We should support deleting the tabsheet directly too, + // and then it should update the tabcontrol + // This is important mostly for the designer + if CDTabControl <> nil then + begin + lIndex := CDTabControl.FTabs.IndexOfObject(Self); + if lIndex >= 0 then + begin + CDTabControl.FTabs.Delete(lIndex); + CDTabControl.CorrectTabIndex(); + end; + end; + + inherited Destroy; +end; + +{ TCDCustomTabControlDrawerWinCE } + +procedure TCDCustomTabControlDrawerWinCE.DrawCaptionBar(ADest: TCanvas; + lRect: TRect; CL: TColor); +begin + { CaptionHeight := GetTabHeight(CDPageControl.PageIndex, CDPageControl) - 4; + RButtHeight := GetTabHeight(CDPageControl.PageIndex, CDPageControl); + aRect := lRect; + ADest.Pen.Style := psSolid; + ADest.Brush.Style := bsSolid; + ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(CL)); + //TColorToFPColor(ColorToRGB($009C9B91)); + ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CL)); + aRect.Left := lRect.Left; + aRect.Top := lRect.Top; + aRect.Bottom := lRect.Bottom; + aRect.Right := lRect.Right; + ADest.RecTangle(lRect); + if CDPageControl.FPages.Count = 0 then + begin + ADest.Brush.Color := clWhite; + ADest.Pen.Color := $009C9B91; + ADest.RecTangle(Rect(aRect.Left, aRect.Top, aRect.Right + 1, aRect.Bottom + 2)); + ADest.Pen.Color := clWhite; + ADest.Line(aRect.Left + 1, aRect.Bottom + 1, aRect.Right, aRect.Bottom + 1); + Exit; + end; + aRect.Left := lRect.Left + 2; + aRect.Top := lRect.Top + 3; + //ADest.TextStyle.Opaque :=false; + //SetBkMode(ADest.Handle, TRANSPARENT); + if ADest.Brush.Style = bsSolid then + SetBkMode(ADest.Handle, OPAQUE) + else + SetBkMode(ADest.Handle, TRANSPARENT); + + for i := StartIndex to CDPageControl.FPages.Count - 1 do + begin + aText := CDPageControl.FPages[i].TabPage.Caption; + rWidth := (CaptionHeight - ADest.TextHeight(aText)) + ADest.TextWidth(aText); + CDPageControl.FPages[i].Width := rWidth; + if aRect.Left + rWidth > lRect.Right - 6 then + Break + else + aRect.Right := aRect.Left + rWidth; + if CDPageControl.PageIndex = i then + begin + cRect := aRect; + if i = StartIndex then + cRect.Left := aRect.Left - 2 + else + cRect.Left := aRect.Left - 4; + cRect.Right := aRect.Right + 4; + cRect.Top := cRect.Top - 2; + bText := CDPageControl.FPages[i].TabPage.Caption; + end + else + DrawTabHead(aDest, aRect, CDPageControl.Color, False); + MaskColor := MaskBaseColor + i - StartIndex; + //DrawTabHeadMask(MaskHeadBmp.Canvas, aRect, MaskColor, False); + ADest.TextOut(aRect.Left + (aRect.Right - aRect.Left - ADest.TextWidth(aText)) div 2, + aRect.Top + (aRect.Bottom - aRect.Top - ADest.TextHeight(aText)) div 2, aText); + aRect.Left := aRect.Right + 3; + end; + ADest.Line(lRect.Left, lRect.Bottom - 1, cRect.Left, lRect.Bottom - 1); + ADest.Line(cRect.Right, lRect.Bottom - 1, lRect.Right, lRect.Bottom - 1); + DrawTabHead(aDest, cRect, clWhite, True); + ADest.TextOut(cRect.Left + (cRect.Right - cRect.Left - ADest.TextWidth(bText)) div 2, + cRect.Top + (cRect.Bottom - cRect.Top - ADest.TextHeight(bText)) div 2, bText); + if not CheckTabButton(lRect.Right - lRect.Left, CDPageControl.FPages) then + Exit; + aRect.Left := lRect.Right - RButtHeight * 2 - 3; + aRect.Top := 1; + aRect.Bottom := RButtHeight + 1; + aRect.Right := lRect.Right - RButtHeight; + //if FMDownL then + // GradFill(ADest, aRect, $00F1A079, $00EFAF9B) + //else + GradFill(ADest, aRect, $00FDD9CB, $00F2C9B8); + aRect.Left := lRect.Right - RButtHeight - 1; + aRect.Top := 1; + aRect.Bottom := RButtHeight + 1; + aRect.Right := lRect.Right; + + GradFill(ADest, aRect, $00FDD9CB, $00F2C9B8); + + ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($0085614D)); + bRect.Top := 1; + bRect.Left := lRect.Right - RButtHeight * 2 - 3; + bRect.Right := lRect.Right; + bRect.Bottom := RButtHeight + 1; + DrawArrow(ADest, bRect, True); + DrawArrow(ADest, bRect, False); + ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(clWhite)); + ADest.Line(lRect.Right - RButtHeight * 2 - 3, 1, lRect.Right, 1); + ADest.Line(lRect.Right, 1, lRect.Right, RButtHeight + 1); + ADest.Line(lRect.Right, RButtHeight + 1, lRect.Right - RButtHeight * + 2 - 3, RButtHeight + 1); + ADest.Line(lRect.Right - RButtHeight * 2 - 3, RButtHeight + 1, + lRect.Right - RButtHeight * 2 - 3, 1); + ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($00E5BAA7)); + ADest.Brush.Style := bsClear; + ADest.Rectangle(lRect.Right - RButtHeight * 2 - 2, 2, lRect.Right - + 1, RButtHeight + 1); + CornerColor := TColorToFPColor(ColorToRGB($00F6E3D9)); + ADest.Colors[lRect.Right - RButtHeight * 2 - 2, 2] := CornerColor; + ADest.Colors[lRect.Right - RButtHeight * 2 - 2, RButtHeight] := CornerColor; + ADest.Colors[lRect.Right - 1, 2] := CornerColor; + ADest.Colors[lRect.Right - 1, RButtHeight] := CornerColor; + ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(clWhite)); + ADest.Line(lRect.Right - 51, 1, lRect.Right, 1); + ADest.Line(lRect.Right, 1, lRect.Right, 25); + ADest.Line(lRect.Right, 25, lRect.Right - 51, 25); + ADest.Line(lRect.Right - 51, 25, lRect.Right - 51, 1); + ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($00FFFFFF));} +end; + +procedure TCDCustomTabControlDrawerWinCE.DrawTabs(ADest: TCanvas); +var + IsPainting: Boolean = False; + CurStartLeftPos: Integer = 0; + i: Integer; +begin + for i := 0 to CDTabControl.Tabs.Count - 1 do + begin + if i = LeftmostTabVisibleIndex then + IsPainting := True; + + if IsPainting then + begin + DrawTab(ADest, i, CurStartLeftPos); + CurStartLeftPos := CurStartLeftPos + GetTabWidth(ADest, i); + end; + end; +end; + +procedure TCDCustomTabControlDrawerWinCE.DrawTab(ADest: TCanvas; + AIndex: Integer; ACurStartLeftPos: Integer); +var + IsSelected: Boolean; + lTabWidth, lTabHeight, lTabTopPos: Integer; + Points: array of TPoint; + lCaption: String; +begin + IsSelected := CDTabControl.FTabIndex = AIndex; + + if IsSelected then + begin + lTabTopPos := 0; + lTabHeight := GetTabHeight(AIndex); + end + else + begin + lTabTopPos := 5; + lTabHeight := GetTabHeight(AIndex)-5; + end; + + lTabWidth := GetTabWidth(ADest, AIndex); + + // Fill the area inside the outer border + ADest.Pen.Style := psClear; + ADest.Brush.Style := bsSolid; + ADest.Brush.Color := clWhite; + SetLength(Points, 5); + Points[0] := Point(ACurStartLeftPos, lTabTopPos); + Points[1] := Point(ACurStartLeftPos+lTabWidth-5, lTabTopPos); + Points[2] := Point(ACurStartLeftPos+lTabWidth, lTabTopPos+5); + Points[3] := Point(ACurStartLeftPos+lTabWidth, lTabTopPos+lTabHeight); + Points[4] := Point(ACurStartLeftPos, lTabTopPos+lTabHeight); + ADest.Polygon(Points); + + // Draw the outer border only in the top and right sides, + // and bottom if unselected + ADest.Pen.Style := psSolid; + ADest.Brush.Style := bsClear; + ADest.Pen.Color := ColorToRGB($009C9B91); + ADest.MoveTo(ACurStartLeftPos+1, lTabTopPos); + ADest.LineTo(ACurStartLeftPos+lTabWidth-5, lTabTopPos); + ADest.LineTo(ACurStartLeftPos+lTabWidth, lTabTopPos+5); + ADest.LineTo(ACurStartLeftPos+lTabWidth, lTabTopPos+lTabHeight); + + // If it is selected, add a selection frame + if IsSelected then + begin + ADest.Pen.Color := ColorToRGB($00D6C731); + ADest.Pen.Style := psSolid; + ADest.Brush.Style := bsClear; + ADest.Rectangle( + ACurStartLeftPos+3, lTabTopPos+3, + ACurStartLeftPos+lTabWidth-5, lTabTopPos+lTabHeight-5 + ); + end; + + // Now the text + lCaption := CDTabControl.Tabs.Strings[AIndex]; + ADest.TextOut(ACurStartLeftPos+5, lTabTopPos+5, lCaption); +end; + +function TCDCustomTabControlDrawerWinCE.GetPageIndexFromXY(x, y: integer + ): integer; +begin + Result := 1; +end; + +function TCDCustomTabControlDrawerWinCE.GetTabHeight(AIndex: Integer): Integer; +begin + if CDTabControl.Font.Size = 0 then + Result := 32 + else + Result := CDTabControl.Font.Size + 22; +end; + +function TCDCustomTabControlDrawerWinCE.GetTabWidth(ADest: TCanvas; + AIndex: Integer): Integer; +const + TCDTabControl_WinCE_TabCaptionExtraWidth = 20; +var + lCaption: string; +begin + lCaption := CDTabControl.Tabs.Strings[AIndex]; + + Result := ADest.TextWidth(lCaption) + TCDTabControl_WinCE_TabCaptionExtraWidth; +end; + +{function TCDCustomTabControlDrawerWinCE.GetClientRect(AControl: TCDControl + ): TRect; +var + lCaptionHeight: Integer; +begin + lCaptionHeight := GetTabHeight(CDTabControl.FTabIndex) - 4; + + Result := Rect(5, lCaptionHeight + 1, CDTabControl.Width - 10, + CDTabControl.Height - lCaptionHeight - 5); +end;} + +procedure TCDCustomTabControlDrawerWinCE.DrawToIntfImage(ADest: TFPImageCanvas; + FPImg: TLazIntfImage); +var + lColor: TColor; + lFPColor: TFPColor; + x, y: Integer; +begin + if CDTabControl.Color = clDefault then + lColor := ColorToRGB(CDTabControl.GetDefaultColor(dctBrush)) + else lColor := ColorToRGB(CDTabControl.Color); + + // Background + lFPColor := TColorToFPColor(lColor); + FPImg.FillPixels(lFPColor); +end; + +procedure TCDCustomTabControlDrawerWinCE.DrawToCanvas(ADest: TCanvas); +var + CaptionHeight: Integer; +begin + CaptionHeight := GetTabHeight(CDTabControl.FTabIndex); + + // frame + ADest.Pen.Style := psSolid; + ADest.Brush.Style := bsClear; + ADest.Pen.Color := ColorToRGB($009C9B91); + + if CDTabControl.GetTabCount = 0 then + ADest.Rectangle(0, 0, CDTabControl.Width - 2, CDTabControl.Height - 2) + else + ADest.Rectangle(0, CaptionHeight, CDTabControl.Width - 2, CDTabControl.Height - 2); + + ADest.Pen.Color := ColorToRGB($00BFCED0); + ADest.Line(CDTabControl.Width - 1, CaptionHeight + 1, + CDTabControl.Width - 1, CDTabControl.Height - 1); + ADest.Line(CDTabControl.Width - 1, CDTabControl.Height - 1, 1, + CDTabControl.Height - 1); + + // Tabs + ADest.Font.Name := CDTabControl.Font.Name; + ADest.Font.Size := CDTabControl.Font.Size; +// DrawCaptionBar(ADest, Rect(0, 0, CDPageControl.Width - +// 2, CaptionHeight + 1), CDPageControl.Color, CDPageControl); + DrawTabs(ADest); +end; + +procedure TCDCustomTabControlDrawerWinCE.DrawTabSheet(ADest: TCanvas); +begin + ADest.Brush.Color := CDTabControl.Color; + ADest.Brush.Style := bsSolid; + ADest.Pen.Style := psClear; + ADest.Rectangle(0, 0, CDTabControl.Width, CDTabControl.Height); +end; + +procedure TCDCustomTabControlDrawerWinCE.MouseDown(Button: TMouseButton; + Shift: TShiftState; X, Y: integer); +var + i: Integer; + CurPage: TCDTabSheet; + CurStartLeftPos: Integer = 0; + VisiblePagesStarted: Boolean = False; + lTabWidth: Integer; +begin + for i := 0 to CDTabControl.Tabs.Count - 1 do + begin + if i = LeftmostTabVisibleIndex then + VisiblePagesStarted := True; + + if VisiblePagesStarted then + begin + lTabWidth := GetTabWidth(CDTabControl.Canvas, i); + if (X > CurStartLeftPos) and + (X < CurStartLeftPos + lTabWidth) and + (Y < GetTabHeight(i)) then + begin + if CDTabControl is TCDPageControl then + (CDTabControl as TCDPageControl).SetPageIndex(i) + else + CDTabControl.SetTabIndex(i); + + Exit; + end; + CurStartLeftPos := CurStartLeftPos + lTabWidth; + end; + end; +end; + +{ TCDCustomTabControl } + +procedure TCDCustomTabControl.MouseDown(Button: TMouseButton; + Shift: TShiftState; X, Y: integer); +begin + TCDCustomTabControlDrawer(FCurrentDrawer).MouseDown(Button, Shift, X, Y); + inherited MouseDown(Button, Shift, X, Y); +end; + +procedure TCDCustomTabControl.PrepareCurrentDrawer; +begin + case FDrawStyle of + dsWince: FCurrentDrawer := FDrawerWinCE; + dsCustom: FCurrentDrawer := CustomDrawer; + end; +end; + +procedure TCDCustomTabControl.SetTabIndex(AValue: Integer); +begin + if FTabIndex = AValue then Exit; + if Assigned(OnChanging) then OnChanging(Self); + FTabIndex := AValue; + if Assigned(OnChange) then OnChange(Self); + Invalidate; +end; + +procedure TCDCustomTabControl.SetTabs(AValue: TStringList); +begin + if FTabs=AValue then Exit; + FTabs.Assign(AValue); + CorrectTabIndex(); + Invalidate; +end; + +constructor TCDCustomTabControl.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + Width := 232; + Height := 184; + TabStop := True; + + FDrawerWinCE := TCDCustomTabControlDrawerWinCE.Create; + TCDCustomTabControlDrawerWinCE(FDrawerWinCE).CDTabControl := Self; + CustomDrawer := FDrawerWinCE; // Dummy to avoid designer crashes + FCurrentDrawer := FDrawerWinCE; + FDrawStyle := dsWinCE; + + ParentColor := True; + ParentFont := True; + ControlStyle := ControlStyle + [csAcceptsControls, csDesignInteractive]; + + // FTabs should hold only visible tabs + FTabs := TStringList.Create; +end; + +destructor TCDCustomTabControl.Destroy; +begin + FTabs.Free; + + inherited Destroy; +end; + +procedure TCDCustomTabControl.Paint; +var + AImage: TLazIntfImage = nil; + ABmp: TBitmap = nil; + lCanvas: TFPImageCanvas = nil; +begin + ABmp := TBitmap.Create; + try + ABmp.Width := Width; + ABmp.Height := Height; + AImage := ABmp.CreateIntfImage; + lCanvas := TFPImageCanvas.Create(AImage); + TCDCustomTabControlDrawer(FCurrentDrawer).DrawToIntfImage(lCanvas, AImage); + ABmp.LoadFromIntfImage(AImage); + ABmp.Canvas.Font.Assign(Font); + TCDCustomTabControlDrawer(FCurrentDrawer).DrawToCanvas(ABmp.Canvas); + Canvas.Draw(0, 0, ABmp); + finally + if lCanvas <> nil then + lCanvas.Free; + if AImage <> nil then + AImage.Free; + ABmp.Free; + end; +end; + +function TCDCustomTabControl.GetTabCount: Integer; +begin + Result := 0; + if FTabs <> nil then Result := FTabs.Count; +end; + +procedure TCDCustomTabControl.CorrectTabIndex; +begin + if FTabIndex >= FTabs.Count then SetTabIndex(FTabs.Count - 1); +end; + +{ TCDControl } + +procedure TCDControl.PrepareCurrentDrawer; +begin + +end; + +procedure TCDControl.SetDrawStyle(const AValue: TCDDrawStyle); +begin + if FDrawStyle = AValue then exit; + FDrawStyle := AValue; + Invalidate; + PrepareCurrentDrawer(); + + //FCurrentDrawer.SetClientRectPos(Self); +end; + +function TCDControl.GetClientRect: TRect; +begin + // Disable this, since although it works in Win32, it doesn't seam to work in LCL-Carbon + //if (FCurrentDrawer = nil) then + Result := inherited GetClientRect() + //else + //Result := FCurrentDrawer.GetClientRect(Self); +end; + +procedure TCDControl.EraseBackground(DC: HDC); +begin + +end; + +{ TCDButtonDrawer } + +function TCDButtonDrawer.GetClientRect(AControl: TCDControl): TRect; +var + CDButton: TCDButton absolute AControl; +begin + Result := Rect(1, 1, CDButton.Width - 1, CDButton.Height - 1); +end; + +procedure TCDButton.DoEnter; +begin + DoButtonUp(); + + inherited DoEnter; +end; + +procedure TCDButton.DoExit; +begin + DoButtonUp(); + + inherited DoExit; +end; + +procedure TCDButton.KeyDown(var Key: word; Shift: TShiftState); +begin + inherited KeyDown(Key, Shift); + + if (Key = VK_SPACE) or (Key = VK_RETURN) then + DoButtonDown(); +end; + +procedure TCDButton.KeyUp(var Key: word; Shift: TShiftState); +begin + DoButtonUp(); + + inherited KeyUp(Key, Shift); +end; + +procedure TCDButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); +begin + if not Focused then + SetFocus; + DoButtonDown(); + + inherited MouseDown(Button, Shift, X, Y); +end; + +procedure TCDButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); +begin + DoButtonUp(); + + inherited MouseUp(Button, Shift, X, Y); +end; + +procedure TCDButton.MouseEnter; +begin + inherited MouseEnter; +end; + +procedure TCDButton.MouseLeave; +begin + inherited MouseLeave; +end; + +procedure TCDButton.DoButtonDown(); +var + NewState: TCDButtonState; +begin + NewState := bbsDown; + + case FState of + bbsNormal, bbsFocused: NewState := bbsDown; + end; + + if NewState <> FState then + begin + FState := NewState; + Invalidate; + end; +end; + +procedure TCDButton.DoButtonUp(); +var + NewState: TCDButtonState; +begin + if Focused then + NewState := bbsFocused + else + NewState := bbsNormal; + + if NewState <> FState then + begin + FState := NewState; + Invalidate; + end; +end; + +procedure TCDButton.PrepareCurrentDrawer; +begin + case DrawStyle of + dsWince: FCurrentDrawer := FDrawerWinCE; + dsCustom: FCurrentDrawer := CustomDrawer; + dsAndroid: FCurrentDrawer := FDrawerAndroid; + dsXPTaskbar: FCurrentDrawer := FDrawerXPTB; + dsGrad: FCurrentDrawer := FDrawerGrad; + dsWin2000: FCurrentDrawer := FDrawerWin2k; + end; +end; + +procedure TCDButton.RealSetText(const Value: TCaption); +begin + inherited RealSetText(Value); + Invalidate; +end; + +constructor TCDButton.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + TabStop := True; + FDrawerWinCE := TCDButtonDrawerWinCE.Create; + CustomDrawer := FDrawerWinCE; // Dummy to avoid designer crashes + FDrawerAndroid := TCDButtonDrawerAndroid.Create; + FDrawerXPTB := TCDButtonDrawerXPTB.Create; + FDrawerGrad := TCDButtonDrawerGrad.Create; + FDrawerWin2k := TCDButtonDrawerWin2k.Create; + Width := 120; + Height := 43; + //Color := clTeal; + ParentFont := True; + FDrawStyle := dsAndroid; + Color := $00F1F5F5; +end; + +destructor TCDButton.Destroy; +begin + inherited Destroy; +end; + +procedure DrawCDButtonDown(Canvas: TCanvas; CDButton: TCDButton); +begin + with Canvas do + begin + Brush.Style := bsSolid; + Brush.Color := CDButton.Color; + Pen.Color := Brush.Color; + Rectangle(0, 0, Width, Height); + FillRect(0, 0, Width, Height); + Brush.Color := GetAColor(CDButton.Color, 93); + Pen.Color := GetAColor(Brush.Color, 76); + RoundRect(0, 0, Width, Height, 8, 8); + end; +end; + +procedure TCDButton.Paint; +var + AImage: TLazIntfImage = nil; + ABmp: TBitmap = nil; + lCanvas: TFPImageCanvas = nil; + pColor: TColor; +begin + // inherited Paint; + + PrepareCurrentDrawer(); + + ABmp := TBitmap.Create; + try + ABmp.Width := Width; + ABmp.Height := Height; + AImage := ABmp.CreateIntfImage; + lCanvas := TFPImageCanvas.Create(AImage); + // First step of the drawing: FCL TFPCustomCanvas for fast pixel access + TCDButtonDrawer(FCurrentDrawer).DrawToIntfImage(lCanvas, Self); + ABmp.LoadFromIntfImage(AImage); + // Second step of the drawing: LCL TCustomCanvas for easy font access + TCDButtonDrawer(FCurrentDrawer).DrawToCanvas(ABmp.Canvas, Self, FState); + + Canvas.Draw(0, 0, ABmp); + finally + if lCanvas <> nil then + lCanvas.Free; + if AImage <> nil then + AImage.Free; + ABmp.Free; + end; +end; + +{ TCDButtonDrawerGrad } + +procedure TCDButtonDrawerGrad.DrawToIntfImage(ADest: TFPImageCanvas; + CDButton: TCDButton); +begin + +end; + +procedure TCDButtonDrawerGrad.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; + FState: TCDButtonState); +var + TmpB: TBitmap; + Str: string; +begin + // Button shape -> This crashes in Gtk2 + TmpB := TBitmap.Create; + TmpB.Width := CDButton.Width; + TmpB.Height := CDButton.Height; + TmpB.Canvas.Brush.Color := CDButton.Color; + TmpB.Canvas.Brush.Style := bsSolid; + TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8); + // CDButton.SetShape(TmpB); + + with TmpB.Canvas do + begin + Brush.Style := bsSolid; + Brush.Color := CDButton.Parent.Color; + Pen.Color := Brush.Color; + Rectangle(0, 0, Width, Height); + FillRect(0, 0, Width, Height); + Brush.Color := GetAColor(CDButton.Color, 90); + end; + + // Button image + case FState of + bbsDown: + begin + DrawCDButtonDown(TmpB.Canvas, CDButton); + end; + bbsFocused: + //GradientFill(GetUColor(CDButton.Color, 50), GetAColor(CDButton.Color, 60), TmpB.Canvas); + GradientFill(clWhite, GetAColor(CDButton.Color, 96), TmpB.Canvas); + else + //GradientFill(GetUColor(CDButton.Color, 10), GetAColor(CDButton.Color, 20), TmpB.Canvas); + GradientFill(clWhite, CDButton.Color, TmpB.Canvas); + end; + + ADest.Draw(0, 0, TmpB); + + TmpB.Free; + + // Button text + {$ifndef CUSTOMDRAWN_USE_FREETYPE} + ADest.Font.Assign(CDButton.Font); + ADest.Brush.Style := bsClear; + ADest.Pen.Style := psSolid; + Str := CDButton.Caption; + ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2, + (CDButton.Height - ADest.TextHeight(Str)) div 2, Str); + {$endif} +end; + +{ TCDButtonDrawerWinCE } + +procedure TCDButtonDrawerWinCE.DrawToIntfImage(ADest: TFPImageCanvas; + CDButton: TCDButton); +begin + +end; + +procedure TCDButtonDrawerWinCE.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; + FState: TCDButtonState); +var + TmpB: TBitmap; + Str: string; +begin + // Button shape -> This crashes in Gtk2 + TmpB := TBitmap.Create; + TmpB.Width := CDButton.Width; + TmpB.Height := CDButton.Height; + TmpB.Canvas.Brush.Color := CDButton.Color; + TmpB.Canvas.Brush.Style := bsSolid; + TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8); + // CDButton.SetShape(TmpB); + + // Button image + case FState of + bbsDown: + begin + with TmpB.Canvas do + begin + Brush.Style := bsSolid; + Brush.Color := GetAColor(CDButton.Color, 90); + Pen.Color := clBlack; + Pen.Style := psSolid; + Rectangle(0, 0, Width, Height); + end; + end; + bbsFocused: + with TmpB.Canvas do + begin + Brush.Style := bsSolid; + Brush.Color := GetAColor(CDButton.Color, 99); + Pen.Color := clBlack; + Pen.Style := psSolid; + Rectangle(0, 0, Width, Height); + Rectangle(1, 1, Width - 1, Height - 1); // The border is thicken when focused + end; + else + with TmpB.Canvas do + begin + Brush.Style := bsSolid; + Brush.Color := CDButton.Color; + Pen.Color := clBlack; + Pen.Style := psSolid; + Rectangle(0, 0, Width, Height); + end; + end; + + ADest.Draw(0, 0, TmpB); + + TmpB.Free; + + // Button text + {$ifndef CUSTOMDRAWN_USE_FREETYPE} + ADest.Font.Assign(CDButton.Font); + ADest.Brush.Style := bsClear; + ADest.Pen.Style := psSolid; + Str := CDButton.Caption; + ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2, + (CDButton.Height - ADest.TextHeight(Str)) div 2, Str); + {$endif} +end; + +procedure TCDButtonDrawerWin2k.DrawToIntfImage(ADest: TFPImageCanvas; + CDButton: TCDButton); +begin + +end; + +procedure TCDButtonDrawerWin2k.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; + FState: TCDButtonState); +var + TmpB: TBitmap; + Str: string; +begin + // Button shape -> This crashes in Gtk2 + TmpB := TBitmap.Create; + TmpB.Width := CDButton.Width; + TmpB.Height := CDButton.Height; + TmpB.Canvas.Brush.Color := CDButton.Color; + TmpB.Canvas.Brush.Style := bsSolid; + TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8); + + with TmpB.Canvas do + begin + Brush.Style := bsSolid; + Brush.Color := CDButton.Color; + Pen.Color := clWhite; + Pen.Style := psSolid; + Rectangle(0, 0, Width - 1, Height - 1); + Pen.Color := clWhite; + Line(0, 0, Width - 1, 0); + Line(0, 0, 0, Height - 1); + Pen.Color := clGray; + Line(0, Height - 1, Width - 1, Height - 1); + Line(Width - 1, Height - 1, Width - 1, -1); + Pen.Color := $0099A8AC; + Line(1, Height - 2, Width - 2, Height - 2); + Line(Width - 2, Height - 2, Width - 2, 0); + Pen.Color := $00E2EFF1; + Line(1, 1, Width - 2, 1); + Line(1, 1, 1, Height - 2); + end; + + // Button image + case FState of + bbsDown: + begin + with TmpB.Canvas do + begin + Brush.Style := bsSolid; + Brush.Color := CDButton.Color; + Pen.Color := clWhite; + Pen.Style := psSolid; + Rectangle(0, 0, Width - 1, Height - 1); + Pen.Color := clGray; + Line(0, 0, Width - 1, 0); + Line(0, 0, 0, Height - 1); + Pen.Color := clWhite; + Line(0, Height - 1, Width - 1, Height - 1); + Line(Width - 1, Height - 1, Width - 1, -1); + Pen.Color := $00E2EFF1; + Line(1, Height - 2, Width - 2, Height - 2); + Line(Width - 2, Height - 2, Width - 2, 0); + Pen.Color := $0099A8AC; + Line(1, 1, Width - 2, 1); + Line(1, 1, 1, Height - 2); + end; + end; + bbsFocused: + with TmpB.Canvas do + DrawFocusRect(Rect(3, 3, Width - 4, Height - 4)) + else + begin + end; + end; + + ADest.Draw(0, 0, TmpB); + + TmpB.Free; + + // Button text + {$ifndef CUSTOMDRAWN_USE_FREETYPE} + ADest.Font.Assign(CDButton.Font); + ADest.Brush.Style := bsClear; + ADest.Pen.Style := psSolid; + Str := CDButton.Caption; + if FState = bbsDown then + ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2 + 1, + (CDButton.Height - ADest.TextHeight(Str)) div 2 + 1, Str) + else + ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2, + (CDButton.Height - ADest.TextHeight(Str)) div 2, Str); + {$endif} +end; + +procedure TCDButtonDrawerAndroid.DrawToIntfImage(ADest: TFPImageCanvas; + CDButton: TCDButton); +begin + +end; + +procedure TCDButtonDrawerAndroid.DrawToCanvas(ADest: TCanvas; + CDButton: TCDButton; FState: TCDButtonState); +var + //TmpB: TBitmap; + Str: string; +begin + // Button shape -> This crashes in Gtk2 +{ TmpB.Canvas.Brush.Color := CDButton.Color; + TmpB.Canvas.Brush.Style := bsSolid; + TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8); + CDButton.SetShape(TmpB); + ADest.Draw(0, 0, TmpB); + TmpB.Free; + } + + ADest.Brush.Color := CDButton.Parent.Color; + ADest.Brush.Style := bsSolid; + ADest.Pen.Color := ADest.Brush.Color; + ADest.RecTangle(0, 0, CDButton.Width, CDButton.Height); + + // Button image + case FState of + bbsDown: + begin + DrawCDButtonDown(ADest, CDButton); + end; + bbsFocused: + begin + DrawAndroidButton(ADest, GetAColor(CDButton.Color, 98)); + end; + else + DrawAndroidButton(ADest, GetAColor(CDButton.Color, 96)); + end; + + // Button text + {$ifndef CUSTOMDRAWN_USE_FREETYPE} + ADest.Font.Assign(CDButton.Font); + ADest.Brush.Style := bsClear; + ADest.Pen.Style := psSolid; + Str := CDButton.Caption; + ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2, + (CDButton.Height - ADest.TextHeight(Str)) div 2, Str); + {$endif} +end; + +procedure TCDButtonDrawerXPTB.DrawToIntfImage(ADest: TFPImageCanvas; + CDButton: TCDButton); +begin + +end; + +procedure TCDButtonDrawerXPTB.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; + FState: TCDButtonState); +var + Str: string; +begin + case FState of + bbsDown: + begin + DrawCDButtonDown(ADest, CDButton); + end; + bbsFocused: + begin + DrawXPTaskbarButton(ADest, GetAColor(CDButton.Color, 98)); + end; + else + DrawXPTaskbarButton(ADest, CDButton.Color); + end; + + // Button text + {$ifndef CUSTOMDRAWN_USE_FREETYPE} + ADest.Font.Assign(CDButton.Font); + ADest.Brush.Style := bsClear; + ADest.Pen.Style := psSolid; + Str := CDButton.Caption; + ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2, + (CDButton.Height - ADest.TextHeight(Str)) div 2, Str); + {$endif} +end; + +{ TCDGroupBox } + +procedure TCDGroupBox.PrepareCurrentDrawer(); +begin + case DrawStyle of + dsWince: FCurrentDrawer := FDrawerWinCE; + dsCustom: FCurrentDrawer := CustomDrawer; + end; +end; + +procedure TCDGroupBox.SetDrawStyle(const AValue: TCDDrawStyle); +begin + if FDrawStyle = AValue then + exit; + FDrawStyle := AValue; + + Invalidate; + + PrepareCurrentDrawer(); + FCurrentDrawer.SetClientRectPos(Self); +end; + +procedure TCDGroupBox.RealSetText(const Value: TCaption); +begin + inherited RealSetText(Value); + Invalidate; +end; + +constructor TCDGroupBox.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + Width := 100; + Height := 100; + TabStop := False; + FDrawerWinCE := TCDGroupBoxDrawerWinCE.Create; + CustomDrawer := FDrawerWinCE; // Dummy to avoid designer crashes + ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents, + csDoubleClicks, csReplicatable]; +end; + +destructor TCDGroupBox.Destroy; +begin + inherited Destroy; +end; + +procedure TCDGroupBox.EraseBackground(DC: HDC); +begin + +end; + +procedure TCDGroupBox.Paint; +var + AImage: TLazIntfImage = nil; + ABmp: TBitmap = nil; + lCanvas: TFPImageCanvas = nil; +begin + inherited Paint; + + PrepareCurrentDrawer(); + + ABmp := TBitmap.Create; + try + ABmp.Width := Width; + ABmp.Height := Height; + AImage := ABmp.CreateIntfImage; + lCanvas := TFPImageCanvas.Create(AImage); + // First step of the drawing: FCL TFPCustomCanvas for fast pixel access + FCurrentDrawer.DrawToIntfImage(lCanvas, Self); + ABmp.LoadFromIntfImage(AImage); + // Second step of the drawing: LCL TCustomCanvas for easy font access + FCurrentDrawer.DrawToCanvas(ABmp.Canvas, Self); + Canvas.Draw(0, 0, ABmp); + finally + if lCanvas <> nil then + lCanvas.Free; + if AImage <> nil then + AImage.Free; + ABmp.Free; + end; +end; + +{ TCDGroupBoxDrawerWinCE } + +procedure TCDGroupBoxDrawerWinCE.SetClientRectPos(CDGroupBox: TCDGroupBox); +var + lRect: TRect; + lCaptionHeight: integer; +begin + lCaptionHeight := 10; + lRect := Rect(1, lCaptionHeight, CDGroupBox.Width - 1, CDGroupBox.Height - 1); + CDGroupBox.AdjustClientRect(lRect); +end; + +procedure TCDGroupBoxDrawerWinCE.DrawToIntfImage(ADest: TFPImageCanvas; + CDGroupBox: TCDGroupBox); +{$ifdef CUSTOMDRAWN_USE_FREETYPE} +var + AFont: TFreeTypeFont = nil; +{$endif} +begin + FCaptionMiddle := CDGroupBox.Canvas.TextHeight('Ź') div 2; + if FCaptionMiddle = 0 then FCaptionMiddle := CDGroupBox.Canvas.Font.Size div 2; + if FCaptionMiddle = 0 then FCaptionMiddle := 5; + + // Background + if CDGroupBox.Parent = nil then + ADest.Brush.FPColor := colLtGray + else if CDGroupBox.Parent.Color = clDefault then + ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(clForm)) + else + ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CDGroupBox.Parent.Color)); + ADest.Brush.Style := bsSolid; + ADest.Pen.Style := psClear; + ADest.Rectangle(0, 0, CDGroupBox.Width, CDGroupBox.Height); + + // frame + ADest.Pen.FPColor := colBlack; + ADest.Pen.Style := psSolid; + ADest.Brush.Style := bsClear; + ADest.Rectangle(0, FCaptionMiddle, CDGroupBox.Width - 1, CDGroupBox.Height - 1); + + {$ifdef CUSTOMDRAWN_USE_FREETYPE} + // Caption background and caption + + // initialize free type font manager + opcftfont.InitEngine; + // FontMgr.SearchPath:='/usr/share/fonts/truetype/'; + AFont := TFreeTypeFont.Create; + try + // Text background + ADest.Pen.Style := psClear; + ADest.Brush.Style := bsSolid; + // The brush color was already set previously and is already correct + // ADest.Rectangle(5, 0, AFont.GetTextWidth(CDGroupBox.Caption) + 5, 10); + + // paint text + ADest.Pen.Style := psSolid; + ADest.Brush.Style := bsClear; + ADest.Font := AFont; + ADest.Font.Name := 'Arial'; + ADest.Font.Size := 10; + ADest.TextOut(5, 10, CDGroupBox.Caption); + finally + AFont.Free; + end; + {$endif} +end; + +procedure TCDGroupBoxDrawerWinCE.DrawToCanvas(ADest: TCanvas; CDGroupBox: TCDGroupBox); +begin + {$ifndef CUSTOMDRAWN_USE_FREETYPE} + if CDGroupBox.Parent = nil then + ADest.Brush.Color := clLtGray + else if CDGroupBox.Parent.Color = clDefault then + ADest.Brush.Color := ColorToRGB(clForm) + else + ADest.Brush.Color := ColorToRGB(CDGroupBox.Parent.Color); + + // paint text + ADest.Pen.Style := psSolid; + ADest.Brush.Style := bsSolid; // This will fill the text background + ADest.Font.Size := 10; + ADest.TextOut(FCaptionMiddle, 0, CDGroupBox.Caption); + {$endif} +end; + +{ TCDTrackBar } + +procedure TCDTrackBar.SetMax(Value: integer); +begin + if Value = FMax then + Exit; + FMax := Value; + Invalidate; +end; + +procedure TCDTrackBar.SetMin(Value: integer); +begin + if Value = FMin then + Exit; + FMin := Value; + Invalidate; +end; + +procedure TCDTrackBar.SetPosition(Value: integer); +begin + if Value = FPosition then Exit; + FPosition := Value; + Invalidate; +end; + +function TCDTrackBar.GetPositionFromMousePos(X, Y: integer): integer; +var + lLeftBorder, lRightBorder: Integer; +begin + FCurrentDrawer.GetGeometry(lLeftBorder, lRightBorder); + if X > Width - lRightBorder then Result := FMax + else if X < lLeftBorder then Result := FMin + else Result := FMin + (X - lLeftBorder) * (FMax - FMin + 1) div (Width - lRightBorder - lLeftBorder); + + // sanity check + if Result > FMax then Result := FMax; + if Result < FMin then Result := FMin; +end; + +procedure TCDTrackBar.Changed; +begin + +end; + +procedure TCDTrackBar.DoEnter; +begin + inherited DoEnter; +end; + +procedure TCDTrackBar.DoExit; +begin + inherited DoExit; +end; + +procedure TCDTrackBar.KeyDown(var Key: word; Shift: TShiftState); +var + NewPosition: Integer; +begin + inherited KeyDown(Key, Shift); + if (Key = 37) or (Key = 40) then + NewPosition := FPosition - (FMax - FMin) div 10; + if (Key = 38) or (Key = 39) then + NewPosition := FPosition + (FMax - FMin) div 10; + + // sanity check + if NewPosition > FMax then NewPosition := FMax; + if NewPosition < FMin then NewPosition := FMin; + + Position := NewPosition; +end; + +procedure TCDTrackBar.KeyUp(var Key: word; Shift: TShiftState); +begin + inherited KeyUp(Key, Shift); +end; + +procedure TCDTrackBar.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: integer); +var + NewPosition: Integer; +begin + SetFocus; + + NewPosition := GetPositionFromMousePos(X, Y); + + DragDropStarted := True; + + Position := NewPosition; + + inherited MouseDown(Button, Shift, X, Y); +end; + +procedure TCDTrackBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); +begin + DragDropStarted := False; + inherited MouseUp(Button, Shift, X, Y); +end; + +procedure TCDTrackBar.MouseMove(Shift: TShiftState; X, Y: integer); +var + NewPosition: Integer; +begin + if DragDropStarted then + begin + NewPosition := GetPositionFromMousePos(X, Y); + Position := NewPosition; + end; + inherited MouseMove(Shift, X, Y); +end; + +procedure TCDTrackBar.MouseEnter; +begin + inherited MouseEnter; +end; + +procedure TCDTrackBar.MouseLeave; +begin + inherited MouseLeave; +end; + +constructor TCDTrackBar.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + Height := 25; + Width := 100; + FCurrentDrawer := TCDTrackBarDrawerGraph.Create; + Color := clBtnFace; + FMax := 10; + FMin := 0; + TabStop := True; +end; + +destructor TCDTrackBar.Destroy; +begin + FCurrentDrawer.Free; + inherited Destroy; +end; + +procedure TCDTrackBar.EraseBackground(DC: HDC); +begin + //inherited EraseBackground(DC); +end; + +procedure TCDTrackBar.Paint; +var + AImage: TLazIntfImage = nil; + ABmp: TBitmap = nil; + lCanvas: TFPImageCanvas = nil; +begin + inherited Paint; + ABmp := TBitmap.Create; + try + ABmp.Width := Width; + ABmp.Height := Height; + AImage := ABmp.CreateIntfImage; + lCanvas := TFPImageCanvas.Create(AImage); + // First step of the drawing: FCL TFPCustomCanvas for fast pixel access + FCurrentDrawer.DrawToIntfImage(lCanvas, AImage, Self); + ABmp.LoadFromIntfImage(AImage); + Canvas.Draw(0, 0, ABmp); + finally + if lCanvas <> nil then + lCanvas.Free; + if AImage <> nil then + AImage.Free; + ABmp.Free; + end; +end; + +{ TCDTrackBarDrawer } + +procedure TCDTrackBarDrawerGraph.DrawToIntfImage(ADest: TFPImageCanvas; + FPImg: TLazIntfImage; CDTrackBar: TCDTrackBar); +const + CDBarEdge = 18; +var + lDrawingBottom, StepsCount, i: Integer; + pStart, pEnd: integer; // for drawing the decorative bars + dRect: TRect; + pStepWidth, pHalfStepWidth: Integer; +begin + // Sanity check + if CDTrackBar.Max - CDTrackBar.Min <= 0 then + raise Exception.Create('[TCDTrackBarDrawerGraph.DrawToIntfImage] Max-Min must be at least 1'); + + // Preparations + StepsCount := CDTrackBar.Max - CDTrackBar.Min + 1; + pStepWidth := (CDTrackBar.Width - CDBarEdge) div StepsCount; + pHalfStepWidth := (CDTrackBar.Width - CDBarEdge) div (StepsCount * 2); + + // The bottom part of the drawing + lDrawingBottom := CDTrackBar.Height - 10; + + // Background + + if CDTrackBar.Parent = nil then + ADest.Brush.FPColor := colLtGray + else + ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CDTrackBar.Color)); + ADest.Brush.Style := bsSolid; + ADest.Pen.Style := psClear; + ADest.Rectangle(0, 0, CDTrackBar.Width, CDTrackBar.Height); + ADest.Brush.FPColor := TColorToFPColor(ColorToRGB($006BB6E6)); + + // Draws the double-sided arrow in the center of the slider + + ADest.Pen.Style := psSolid; + ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($006BB6E6)); + ADest.Line(0, lDrawingBottom, CDTrackBar.Width, lDrawingBottom); + ADest.Line(3, lDrawingBottom - 1, 6, lDrawingBottom - 1); + ADest.Line(5, lDrawingBottom - 2, 6, lDrawingBottom - 2); + ADest.Line(3, lDrawingBottom + 1, 6, lDrawingBottom + 1); + ADest.Line(5, lDrawingBottom + 2, 6, lDrawingBottom + 2); + ADest.Line(CDTrackBar.Width - 1 - 3, lDrawingBottom - 1, CDTrackBar.Width - 1 - 6, lDrawingBottom - 1); + ADest.Line(CDTrackBar.Width - 1 - 5, lDrawingBottom - 2, CDTrackBar.Width - 1 - 6, lDrawingBottom - 2); + ADest.Line(CDTrackBar.Width - 1 - 3, lDrawingBottom + 1, CDTrackBar.Width - 1 - 6, lDrawingBottom + 1); + ADest.Line(CDTrackBar.Width - 1 - 5, lDrawingBottom + 2, CDTrackBar.Width - 1 - 6, lDrawingBottom + 2); + ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(clGray)); + ADest.Brush.FPColor := TColorToFPColor(ColorToRGB($00F0F0F0)); + + // Draws the decorative bars and also the slider button + + pStart := 10 - 1; + for i := 0 to StepsCount - 1 do + begin + // Draw the decorative bars + dRect := Bounds( + pStart + pHalfStepWidth, + lDrawingBottom - 5 - i, + Round(pStepWidth)-3, + 4 + i); + + ADest.Brush.Style := bsSolid; + ADest.Pen.Style := psSolid; + ADest.Pen.FPColor := colBlack; + if i + CDTrackBar.Min <= CDTrackBar.Position then + ADest.Brush.FPColor := colDkGray + else + ADest.Brush.FPColor := colWhite; + + ADest.Rectangle(dRect); + + // Draw the slider + + if i + CDTrackBar.Min = CDTrackBar.Position then + begin + ADest.Brush.FPColor := TColorToFPColor(ColorToRGB($006BB6E6)); + ADest.Brush.Style := bsSolid; + ADest.Rectangle(pStart, lDrawingBottom + 1, pStart + 10, lDrawingBottom + 6); + ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($005BA6C6)); + ADest.RecTangle(pStart, lDrawingBottom + 2, pStart + 10, lDrawingBottom + 7); + ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($006BB6E6)); + ADest.RecTangle(pStart, lDrawingBottom, pStart + 10, lDrawingBottom + 2); + end; + pStart := pStart + pStepWidth; + end; + + ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($007BC6F6)); + ADest.Line(7, lDrawingBottom - 1, CDTrackBar.Width - 8, lDrawingBottom - 1); + ADest.Line(7, lDrawingBottom + 1, CDTrackBar.Width - 8, lDrawingBottom + 1); + ADest.Colors[2, lDrawingBottom - 1] := ADest.Pen.FPColor; + ADest.Colors[4, lDrawingBottom - 2] := ADest.Pen.FPColor; + ADest.Colors[2, lDrawingBottom + 1] := ADest.Pen.FPColor; + ADest.Colors[4, lDrawingBottom + 2] := ADest.Pen.FPColor; + ADest.Colors[6, lDrawingBottom - 3] := ADest.Pen.FPColor; + ADest.Colors[6, lDrawingBottom + 3] := ADest.Pen.FPColor; + ADest.Colors[CDTrackBar.Width - 1 - 2, lDrawingBottom - 1] := ADest.Pen.FPColor; + ADest.Colors[CDTrackBar.Width - 1 - 4, lDrawingBottom - 2] := ADest.Pen.FPColor; + ADest.Colors[CDTrackBar.Width - 1 - 2, lDrawingBottom + 1] := ADest.Pen.FPColor; + ADest.Colors[CDTrackBar.Width - 1 - 4, lDrawingBottom + 2] := ADest.Pen.FPColor; + ADest.Colors[CDTrackBar.Width - 1 - 6, lDrawingBottom - 3] := ADest.Pen.FPColor; + ADest.Colors[CDTrackBar.Width - 1 - 6, lDrawingBottom + 3] := ADest.Pen.FPColor; +end; + +procedure TCDTrackBarDrawerGraph.GetGeometry(var ALeftBorder, + ARightBorder: Integer); +begin + ALeftBorder := 9; + ARightBorder := 9; +end; + +{ TCDTabSheet } + +constructor TCDTabSheet.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + TabStop := False; + ParentColor := True; + parentFont := True; + ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents, + csDesignFixedBounds, csDoubleClicks, csDesignInteractive]; + //ControlStyle := ControlStyle + [csAcceptsControls, csDesignFixedBounds, + // csNoDesignVisible, csNoFocus]; +end; + +destructor TCDTabSheet.Destroy; +begin + inherited Destroy; +end; + +procedure TCDTabSheet.EraseBackground(DC: HDC); +begin + +end; + +procedure TCDTabSheet.Paint; +begin + if CDTabControl <> nil then + begin + TCDCustomTabControlDrawer(CDTabControl.FCurrentDrawer).DrawTabSheet(Canvas); + end; +end; + +{ TCDPageControl } + +function TCDPageControl.AddPage(S: string): TCDTabSheet; +// InsertPage(FPages.Count, S); +var + NewPage: TCDTabSheet; +begin + NewPage := TCDTabSheet.Create(Owner); + NewPage.Parent := Self; + NewPage.CDTabControl := Self; + //Name := Designer.CreateUniqueComponentName(ClassName); + NewPage.Name := GetUniqueName(sTABSHEET_DEFAULT_NAME, Self.Owner); + if S = '' then + NewPage.Caption := NewPage.Name + else + NewPage.Caption := S; + + PositionTabSheet(NewPage); + + FTabs.AddObject(S, NewPage); + + SetActivePage(NewPage); + + Result := NewPage; +end; + +function TCDPageControl.GetPage(AIndex: integer): TCDTabSheet; +begin + if (AIndex >= 0) and (AIndex < FTabs.Count) then + Result := TCDTabSheet(FTabs.Objects[AIndex]) + else + Result := nil; +end; + +function TCDPageControl.InsertPage(aIndex: integer; S: string): TCDTabSheet; +var + NewPage: TCDTabSheet; +begin + NewPage := TCDTabSheet.Create(Owner); + NewPage.Parent := Self; + //Name := Designer.CreateUniqueComponentName(ClassName); + NewPage.Name := GetUniqueName(sTABSHEET_DEFAULT_NAME, Self.Owner); + if S = '' then + NewPage.Caption := NewPage.Name + else + NewPage.Caption := S; + + PositionTabSheet(NewPage); + + FTabs.InsertObject(AIndex, S, NewPage); + + SetActivePage(NewPage); + Result := NewPage; +end; + +procedure TCDPageControl.RemovePage(aIndex: integer); +begin + if (AIndex < 0) or (AIndex >= FTabs.Count) then Exit; + + Application.ReleaseComponent(TComponent(FTabs.Objects[AIndex])); + + FTabs.Delete(aIndex); + if FTabIndex >= FTabs.Count then SetTabIndex(FTabIndex-1); + + Invalidate; +end; + +function TCDPageControl.FindNextPage(CurPage: TCDTabSheet; + GoForward, CheckTabVisible: boolean): TCDTabSheet; +var + I, TempStartIndex: integer; +begin + if FTabs.Count <> 0 then + begin + //StartIndex := FPages.IndexOfObject(CurPage); + TempStartIndex := FTabs.IndexOfObject(CurPage); + if TempStartIndex = -1 then + if GoForward then + TempStartIndex := FTabs.Count - 1 + else + TempStartIndex := 0; + I := TempStartIndex; + repeat + if GoForward then + begin + Inc(I); + if I = FTabs.Count then + I := 0; + end + else + begin + if I = 0 then + I := FTabs.Count; + Dec(I); + end; + Result := TCDTabSheet(FTabs.Objects[I]); + if not CheckTabVisible or Result.Visible then + Exit; + until I = TempStartIndex; + end; + Result := nil; +end; + +procedure TCDPageControl.SelectNextPage(GoForward: boolean; + CheckTabVisible: boolean = True); +var + Page: TCDTabSheet; +begin + Page := FindNextPage(ActivePage, GoForward, CheckTabVisible); + if (Page <> nil) and (Page <> ActivePage) then + SetActivePage(Page); +end; + +constructor TCDPageControl.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + ControlStyle := ControlStyle - [csAcceptsControls]; +end; + +destructor TCDPageControl.Destroy; +begin + inherited Destroy; +end; + +procedure TCDPageControl.SetActivePage(Value: TCDTabSheet); +var + i: integer; + CurPage: TCDTabSheet; +begin + for i := 0 to FTabs.Count - 1 do + begin + CurPage := TCDTabSheet(FTabs.Objects[i]); + if CurPage = Value then + begin + PositionTabSheet(CurPage); + CurPage.BringToFront; + CurPage.Visible := True; + + // Check first, Tab is Visible? + SetTabIndex(i); + end + else if CurPage <> nil then + begin + //CurPage.Align := alNone; + //CurPage.Height := 0; + CurPage.Visible := False; + end; + end; + + Invalidate; +end; + +procedure TCDPageControl.SetPageIndex(Value: integer); +begin + if (Value > -1) and (Value < FTabs.Count) then + begin + SetTabIndex(Value); + ActivePage := GetPage(Value); + end; +end; + +procedure TCDPageControl.UpdateAllDesignerFlags; +var + i: integer; +begin + for i := 0 to FTabs.Count - 1 do + UpdateDesignerFlags(i); +end; + +procedure TCDPageControl.UpdateDesignerFlags(APageIndex: integer); +var + CurPage: TCDTabSheet; +begin + CurPage := GetPage(APageIndex); + if APageIndex <> fTabIndex then + CurPage.ControlStyle := CurPage.ControlStyle + [csNoDesignVisible] + else + CurPage.ControlStyle := CurPage.ControlStyle - [csNoDesignVisible]; +end; + +procedure TCDPageControl.PositionTabSheet(ATabSheet: TCDTabSheet); +var + lTabHeight, lIndex: Integer; +begin +// ATabSheet.SetBounds(1, 32 + 1, Width - 3, Height - 32 - 4); + lIndex := FTabs.IndexOfObject(ATabSheet);; + lTabHeight := TCDCustomTabControlDrawer(FCurrentDrawer).GetTabHeight(lIndex); + ATabSheet.BorderSpacing.Top := lTabHeight; + ATabSheet.BorderSpacing.Left := 2; + ATabSheet.BorderSpacing.Right := 3; + ATabSheet.BorderSpacing.Bottom := 3; + ATabSheet.Align := alClient; +end; + +function TCDPageControl.GetActivePage: TCDTabSheet; +begin + Result := GetPage(FTabIndex); +end; + +function TCDPageControl.GetPageCount: integer; +begin + Result := FTabs.Count; +end; + +function TCDPageControl.GetPageIndex: integer; +begin + Result := FTabIndex; +end; + +end. + diff --git a/components/customdrawn/customdrawnextras.pas b/components/customdrawn/customdrawnextras.pas index cae7189cd1..3c7a9deba4 100644 --- a/components/customdrawn/customdrawnextras.pas +++ b/components/customdrawn/customdrawnextras.pas @@ -4,8 +4,8 @@ License: The same modifying LGPL with static linking exception as the LCL This unit should be a repository for various custom drawn components, - such as a custom drawn version of TButton, of TEdit, of TPageControl, etc, - eventually forming a full set of custom drawn components. + which are not in the unit customdrawncontrols, + and also property editors for the customdrawnextras } unit customdrawnextras; @@ -17,6 +17,7 @@ uses Classes, SysUtils, Graphics, Controls, LCLType, LCLIntf, IntfGraphics, Math, types, customdrawnutils, contnrs, componenteditors, LMessages, Messages, LCLProc, PropEdits, ExtCtrls, ImgList, Forms, Menus, + customdrawncontrols, // fpimage fpcanvas, fpimgcanv, fpimage {$ifdef CUSTOMDRAWN_USE_FREETYPE} @@ -33,18 +34,6 @@ type TBitmappedButtonOptions = set of TBitmappedButtonOption; - // commented items are not yet supported - TBitmappedButtonState = (bbsNormal, bbsDown, bbsMouseOver, bbsFocused - (* bbsChecked, bbsCheckedSelected, bbsCheckedDown { is going to be unchecked }*)); - - TCDDrawStyle = ( - // Operating system styles - dsWinCE, dsWin2000, dsAndroid, dsXPTaskBar, - // Other special styles - dsGrad, - // Defined by the user - dsCustom); - { TCustomBitmappedButton } TCustomBitmappedButton = class(TCustomControl) @@ -59,7 +48,7 @@ type FImageBtnFocused: TPicture; FImageBtnChecked: TPicture; FOptions: TBitmappedButtonOptions; - FState: TBitmappedButtonState; + FState: TCDButtonState; // keyboard procedure DoEnter; override; procedure DoExit; override; @@ -160,395 +149,6 @@ type property Options; end; - TCDControlDrawer = class; - - { TCDControl } - - TCDControl = class(TCustomControl) - protected - FDrawStyle: TCDDrawStyle; - FCurrentDrawer: TCDControlDrawer; - //constructor Create(AOwner: TComponent); override; - //destructor Destroy; override; - procedure PrepareCurrentDrawer(); virtual; - procedure SetDrawStyle(const AValue: TCDDrawStyle); - function GetClientRect: TRect; override; - procedure EraseBackground(DC: HDC); override; - property DrawStyle: TCDDrawStyle read FDrawStyle write SetDrawStyle; - public - end; - - TCDControlDrawer = class - public - function GetClientRect(AControl: TCDControl): TRect; virtual; abstract; - //procedure DrawToIntfImage(ADest: TFPImageCanvas; AControl: TCDControl); - // virtual; abstract; - //procedure DrawToCanvas(ADest: TCanvas; AControl: TCDControl); virtual; abstract; - end; - - TCDButtonDrawer = class; - TCDButtonDrawerWinCE = class; - TCDButtonDrawerAndroid = class; - TCDButtonDrawerXPTB = class; - TCDButtonDrawerGrad = class; - TCDButtonDrawerWin2k = class; - - { TCDButton } - - TCDButton = class(TCDControl) - private - //FCurrentDrawer: TCDButtonDrawer; - FDrawerWinCE: TCDButtonDrawerWinCE; - FDrawerAndroid: TCDButtonDrawerAndroid; - FDrawerXPTB: TCDButtonDrawerXPTB; - FDrawerGrad: TCDButtonDrawerGrad; - FDrawerWin2k: TCDButtonDrawerWin2k; - procedure PrepareCurrentDrawer(); override; - protected - FState: TBitmappedButtonState; - // keyboard - procedure DoEnter; override; - procedure DoExit; override; - procedure KeyDown(var Key: word; Shift: TShiftState); override; - procedure KeyUp(var Key: word; Shift: TShiftState); override; - // mouse - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: integer); override; - procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override; - procedure MouseEnter; override; - procedure MouseLeave; override; - // button state change - procedure DoButtonDown(); - procedure DoButtonUp(); - procedure RealSetText(const Value: TCaption); override; - public - CustomDrawer: TCDButtonDrawer; - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure Paint; override; - published - property Action; - property Anchors; - property Caption; - property Color; - property Constraints; - property DrawStyle: TCDDrawStyle read FDrawStyle write SetDrawStyle; - property Enabled; - property Font; - property OnChangeBounds; - property OnClick; - property OnContextPopup; - property OnDragDrop; - property OnDragOver; - property OnEndDrag; - property OnEnter; - property OnExit; - property OnKeyDown; - property OnKeyPress; - property OnKeyUp; - property OnMouseDown; - property OnMouseEnter; - property OnMouseLeave; - property OnMouseMove; - property OnMouseUp; - property OnResize; - property OnStartDrag; - property OnUTF8KeyPress; - property ParentFont; - property ParentShowHint; - property PopupMenu; - property ShowHint; - property TabOrder; - property TabStop; - property Visible; - end; - - { TCDButtonDrawer } - - TCDButtonDrawer = class(TCDControlDrawer) - public - function GetClientRect(AControl: TCDControl): TRect; override; - procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); - virtual; abstract; - procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; - FState: TBitmappedButtonState); virtual; abstract; - end; - - { TCDButtonDrawerWinCE } - - TCDButtonDrawerWinCE = class(TCDButtonDrawer) - public - procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override; - procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; - FState: TBitmappedButtonState); override; - end; - - { TCDButtonDrawerAndroid } - TCDButtonDrawerAndroid = class(TCDButtonDrawer) - public - procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override; - procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; - FState: TBitmappedButtonState); override; - end; - - TCDButtonDrawerXPTB = class(TCDButtonDrawer) - public - procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override; - procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; - FState: TBitmappedButtonState); override; - end; - - TCDButtonDrawerGrad = class(TCDButtonDrawer) - public - procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override; - procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; - FState: TBitmappedButtonState); override; - end; - - TCDButtonDrawerWin2k = class(TCDButtonDrawer) - public - procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override; - procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; - FState: TBitmappedButtonState); override; - end; - - {@@ - TCDGroupBox is a custom-drawn group box control - } - - TCDGroupBoxDrawer = class; - TCDGroupBoxDrawerWinCE = class; - - { TCDGroupBox } - - TCDGroupBox = class(TCustomControl) - private - FDrawStyle: TCDDrawStyle; - FCurrentDrawer: TCDGroupBoxDrawer; - FDrawerWinCE: TCDGroupBoxDrawerWinCE; - procedure PrepareCurrentDrawer(); - procedure SetDrawStyle(const AValue: TCDDrawStyle); - protected - procedure RealSetText(const Value: TCaption); override; // to update on caption changes - public - CustomDrawer: TCDGroupBoxDrawer; // Fill the field to use the dsCustom draw mode - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure EraseBackground(DC: HDC); override; - procedure Paint; override; - published - property DrawStyle: TCDDrawStyle read FDrawStyle write SetDrawStyle; - property Caption; - property TabStop default False; - end; - - { TCDGroupBoxDrawer } - - TCDGroupBoxDrawer = class - public - procedure SetClientRectPos(CDGroupBox: TCDGroupBox); virtual; abstract; - procedure DrawToIntfImage(ADest: TFPImageCanvas; CDGroupBox: TCDGroupBox); - virtual; abstract; - procedure DrawToCanvas(ADest: TCanvas; CDGroupBox: TCDGroupBox); virtual; abstract; - end; - - { TCDGroupBoxDrawerWinCE } - - TCDGroupBoxDrawerWinCE = class(TCDGroupBoxDrawer) - public - FCaptionMiddle: integer; - procedure SetClientRectPos(CDGroupBox: TCDGroupBox); override; - procedure DrawToIntfImage(ADest: TFPImageCanvas; CDGroupBox: TCDGroupBox); override; - procedure DrawToCanvas(ADest: TCanvas; CDGroupBox: TCDGroupBox); override; - end; - - {@@ - TCDTrackBar is a custom-drawn trackbar control - } - - TCDTrackBarDrawer = class; - - { TCDTrackBar } - - TCDTrackBar = class(TCustomControl) - private - DragDropStarted: boolean; - // fields - FMin: integer; - FMax: integer; - FPosition: integer; - FOnChange: TNotifyEvent; - FCurrentDrawer: TCDTrackBarDrawer; - procedure SetMax(Value: integer); - procedure SetMin(Value: integer); - procedure SetPosition(Value: integer); - // - function GetPositionFromMousePos(X, Y: Integer): integer; - protected - procedure Changed; virtual; - // keyboard - procedure DoEnter; override; - procedure DoExit; override; - procedure KeyDown(var Key: word; Shift: TShiftState); override; - procedure KeyUp(var Key: word; Shift: TShiftState); override; - // mouse - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: integer); override; - procedure MouseMove(Shift: TShiftState; X, Y: integer); override; - procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override; - procedure MouseEnter; override; - procedure MouseLeave; override; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure EraseBackground(DC: HDC); override; - procedure Paint; override; - published - property Color; - property Max: integer read FMax write SetMax default 10; - property Min: integer read FMin write SetMin default 0; - property OnChange: TNotifyEvent read FOnChange write FOnChange; - property Position: integer read FPosition write SetPosition; - property TabStop default True; - end; - - { TCDTrackBarDrawer } - - TCDTrackBarDrawer = class - public - procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage; - CDTrackBar: TCDTrackBar); virtual; abstract; - procedure GetGeometry(var ALeftBorder, ARightBorder: Integer); virtual; abstract; - end; - - { TCDTrackBarDrawerGraph } - - TCDTrackBarDrawerGraph = class(TCDTrackBarDrawer) - public - procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage; - CDTrackBar: TCDTrackBar); override; - procedure GetGeometry(var ALeftBorder, ARightBorder: Integer); override; - end; - - {TCDTabControl} - - { TCDCustomTabControl } - - TCDCustomTabControl = class; - TCDCustomTabControlDrawer = class; - TCDCustomTabControlDrawerWinCE = class; - - { TCDCustomTabSheet } - - TCDCustomTabSheet = class(TCustomControl) - private - CDTabControl: TCDCustomTabControl; - FTabVisible: Boolean; - protected - procedure RealSetText(const Value: TCaption); override; // to update on caption changes - public - destructor Destroy; override; - property TabVisible: Boolean read FTabVisible write FTabVisible; - end; - - TCDCustomTabControl = class(TCDControl) - private - FTabIndex: Integer; - FTabs: TStringList; - FDrawerWinCE: TCDCustomTabControlDrawerWinCE; - FOnChanging: TNotifyEvent; - FOnChange: TNotifyEvent; - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: integer); override; - //procedure MouseMove(Shift: TShiftState; X, Y: integer); override; - //procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override; - //procedure MouseEnter; override; - //procedure MouseLeave; override; - procedure PrepareCurrentDrawer(); override; - procedure SetTabIndex(AValue: Integer); virtual; - procedure SetTabs(AValue: TStringList); - protected - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure Paint; override; - function GetTabCount: Integer; - procedure CorrectTabIndex(); - public - CustomDrawer: TCDCustomTabControlDrawer; // Fill the field to use the dsCustom draw mode - property Tabs: TStringList read FTabs write SetTabs; - property OnChanging: TNotifyEvent read FOnChanging write FOnChanging; - property OnChange: TNotifyEvent read FOnChange write FOnChange; - property TabIndex: integer read FTabIndex write SetTabIndex; - end; - - { TCDCustomTabControlDrawer } - - TCDCustomTabControlDrawer = class(TCDControlDrawer) - public - CDTabControl: TCDCustomTabControl; - function GetPageIndexFromXY(x, y: integer): integer; virtual; abstract; - function GetTabHeight(AIndex: Integer): Integer; virtual; abstract; - function GetTabWidth(ADest: TCanvas; AIndex: Integer): Integer; virtual; abstract; - procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage); virtual; abstract; - procedure DrawToCanvas(ADest: TCanvas); virtual; abstract; - procedure DrawTabSheet(ADest: TCanvas); virtual; abstract; - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: integer); virtual; abstract; - end; - - { TCDCustomTabControlDrawerWinCE } - - TCDCustomTabControlDrawerWinCE = class(TCDCustomTabControlDrawer) - private - StartIndex: integer; //FEndIndex - LeftmostTabVisibleIndex: Integer; - procedure DrawCaptionBar(ADest: TCanvas; lRect: TRect; CL: TColor); - procedure DrawTabs(ADest: TCanvas); - procedure DrawTab(ADest: TCanvas; AIndex: Integer; ACurStartLeftPos: Integer); - public - function GetPageIndexFromXY(x, y: integer): integer; override; - function GetTabHeight(AIndex: Integer): Integer; override; - function GetTabWidth(ADest: TCanvas; AIndex: Integer): Integer; override; - //function GetClientRect(AControl: TCDControl): TRect; override; - procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage); override; - procedure DrawToCanvas(ADest: TCanvas); override; - procedure DrawTabSheet(ADest: TCanvas); override; - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: integer); override; - end; - -// TTabSelectedEvent = procedure(Sender: TObject; ATab: TTabItem; -// ASelected: boolean) of object; - - TCDTabControl = class(TCDCustomTabControl) - published - property Color; - property Font; - property Tabs; - property TabIndex; - property OnChanging; - property OnChange; - end; - - { TCDTabSheet } - - TCDPageControl = class; - - TCDTabSheet = class(TCDCustomTabSheet) - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure EraseBackground(DC: HDC); override; - procedure Paint; override; - published - property Caption; - property Color; - property Font; - property TabVisible: Boolean; - end; - - { TCDPageControl } - { TCDPageControlEditor } TCDPageControlEditor = class(TDefaultComponentEditor) @@ -563,43 +163,6 @@ type function PControl: TCDPageControl; virtual; end; - TCDPageControl = class(TCDCustomTabControl) - private - function GetActivePage: TCDTabSheet; - function GetPageCount: integer; - function GetPageIndex: integer; - procedure SetActivePage(Value: TCDTabSheet); - procedure SetPageIndex(Value: integer); - procedure UpdateAllDesignerFlags; - procedure UpdateDesignerFlags(APageIndex: integer); - procedure PositionTabSheet(ATabSheet: TCDTabSheet); - protected - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - function FindNextPage(CurPage: TCDTabSheet; - GoForward, CheckTabVisible: boolean): TCDTabSheet; - procedure SelectNextPage(GoForward: boolean; CheckTabVisible: boolean = True); - public - function InsertPage(aIndex: integer; S: string): TCDTabSheet; - procedure RemovePage(aIndex: integer); - function AddPage(S: string): TCDTabSheet; - function GetPage(aIndex: integer): TCDTabSheet; - property PageCount: integer read GetPageCount; - published - property ActivePage: TCDTabSheet read GetActivePage write SetActivePage; - property DrawStyle: TCDDrawStyle; - property Caption; - property Color; - property Font; - property PageIndex: integer read GetPageIndex write SetPageIndex; - property ParentColor; - property ParentFont; - property TabStop default True; - property TabIndex; - property OnChanging; - property OnChange; - end; - procedure Register; implementation @@ -612,7 +175,6 @@ const MaskBaseColor = $00111111; resourcestring - sTABSHEET_DEFAULT_NAME = 'CTabSheet'; sNEXT_PAGE = 'Ne&xt Page'; sPREV_PAGE = '&Previouse Page'; @@ -626,461 +188,6 @@ begin RegisterClasses([TCDTabSheet]); end; -{ TCDCustomTabSheet } - -procedure TCDCustomTabSheet.RealSetText(const Value: TCaption); -var - lIndex: Integer; -begin - inherited RealSetText(Value); - lIndex := CDTabControl.Tabs.IndexOfObject(Self); - if lIndex >= 0 then - CDTabControl.Tabs.Strings[lIndex] := Value; - CDTabControl.Invalidate; -end; - -destructor TCDCustomTabSheet.Destroy; -var - lIndex: Integer; -begin - // We should support deleting the tabsheet directly too, - // and then it should update the tabcontrol - // This is important mostly for the designer - if CDTabControl <> nil then - begin - lIndex := CDTabControl.FTabs.IndexOfObject(Self); - if lIndex >= 0 then - begin - CDTabControl.FTabs.Delete(lIndex); - CDTabControl.CorrectTabIndex(); - end; - end; - - inherited Destroy; -end; - -{ TCDCustomTabControlDrawerWinCE } - -procedure TCDCustomTabControlDrawerWinCE.DrawCaptionBar(ADest: TCanvas; - lRect: TRect; CL: TColor); -begin - { CaptionHeight := GetTabHeight(CDPageControl.PageIndex, CDPageControl) - 4; - RButtHeight := GetTabHeight(CDPageControl.PageIndex, CDPageControl); - aRect := lRect; - ADest.Pen.Style := psSolid; - ADest.Brush.Style := bsSolid; - ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(CL)); - //TColorToFPColor(ColorToRGB($009C9B91)); - ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CL)); - aRect.Left := lRect.Left; - aRect.Top := lRect.Top; - aRect.Bottom := lRect.Bottom; - aRect.Right := lRect.Right; - ADest.RecTangle(lRect); - if CDPageControl.FPages.Count = 0 then - begin - ADest.Brush.Color := clWhite; - ADest.Pen.Color := $009C9B91; - ADest.RecTangle(Rect(aRect.Left, aRect.Top, aRect.Right + 1, aRect.Bottom + 2)); - ADest.Pen.Color := clWhite; - ADest.Line(aRect.Left + 1, aRect.Bottom + 1, aRect.Right, aRect.Bottom + 1); - Exit; - end; - aRect.Left := lRect.Left + 2; - aRect.Top := lRect.Top + 3; - //ADest.TextStyle.Opaque :=false; - //SetBkMode(ADest.Handle, TRANSPARENT); - if ADest.Brush.Style = bsSolid then - SetBkMode(ADest.Handle, OPAQUE) - else - SetBkMode(ADest.Handle, TRANSPARENT); - - for i := StartIndex to CDPageControl.FPages.Count - 1 do - begin - aText := CDPageControl.FPages[i].TabPage.Caption; - rWidth := (CaptionHeight - ADest.TextHeight(aText)) + ADest.TextWidth(aText); - CDPageControl.FPages[i].Width := rWidth; - if aRect.Left + rWidth > lRect.Right - 6 then - Break - else - aRect.Right := aRect.Left + rWidth; - if CDPageControl.PageIndex = i then - begin - cRect := aRect; - if i = StartIndex then - cRect.Left := aRect.Left - 2 - else - cRect.Left := aRect.Left - 4; - cRect.Right := aRect.Right + 4; - cRect.Top := cRect.Top - 2; - bText := CDPageControl.FPages[i].TabPage.Caption; - end - else - DrawTabHead(aDest, aRect, CDPageControl.Color, False); - MaskColor := MaskBaseColor + i - StartIndex; - //DrawTabHeadMask(MaskHeadBmp.Canvas, aRect, MaskColor, False); - ADest.TextOut(aRect.Left + (aRect.Right - aRect.Left - ADest.TextWidth(aText)) div 2, - aRect.Top + (aRect.Bottom - aRect.Top - ADest.TextHeight(aText)) div 2, aText); - aRect.Left := aRect.Right + 3; - end; - ADest.Line(lRect.Left, lRect.Bottom - 1, cRect.Left, lRect.Bottom - 1); - ADest.Line(cRect.Right, lRect.Bottom - 1, lRect.Right, lRect.Bottom - 1); - DrawTabHead(aDest, cRect, clWhite, True); - ADest.TextOut(cRect.Left + (cRect.Right - cRect.Left - ADest.TextWidth(bText)) div 2, - cRect.Top + (cRect.Bottom - cRect.Top - ADest.TextHeight(bText)) div 2, bText); - if not CheckTabButton(lRect.Right - lRect.Left, CDPageControl.FPages) then - Exit; - aRect.Left := lRect.Right - RButtHeight * 2 - 3; - aRect.Top := 1; - aRect.Bottom := RButtHeight + 1; - aRect.Right := lRect.Right - RButtHeight; - //if FMDownL then - // GradFill(ADest, aRect, $00F1A079, $00EFAF9B) - //else - GradFill(ADest, aRect, $00FDD9CB, $00F2C9B8); - aRect.Left := lRect.Right - RButtHeight - 1; - aRect.Top := 1; - aRect.Bottom := RButtHeight + 1; - aRect.Right := lRect.Right; - - GradFill(ADest, aRect, $00FDD9CB, $00F2C9B8); - - ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($0085614D)); - bRect.Top := 1; - bRect.Left := lRect.Right - RButtHeight * 2 - 3; - bRect.Right := lRect.Right; - bRect.Bottom := RButtHeight + 1; - DrawArrow(ADest, bRect, True); - DrawArrow(ADest, bRect, False); - ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(clWhite)); - ADest.Line(lRect.Right - RButtHeight * 2 - 3, 1, lRect.Right, 1); - ADest.Line(lRect.Right, 1, lRect.Right, RButtHeight + 1); - ADest.Line(lRect.Right, RButtHeight + 1, lRect.Right - RButtHeight * - 2 - 3, RButtHeight + 1); - ADest.Line(lRect.Right - RButtHeight * 2 - 3, RButtHeight + 1, - lRect.Right - RButtHeight * 2 - 3, 1); - ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($00E5BAA7)); - ADest.Brush.Style := bsClear; - ADest.Rectangle(lRect.Right - RButtHeight * 2 - 2, 2, lRect.Right - - 1, RButtHeight + 1); - CornerColor := TColorToFPColor(ColorToRGB($00F6E3D9)); - ADest.Colors[lRect.Right - RButtHeight * 2 - 2, 2] := CornerColor; - ADest.Colors[lRect.Right - RButtHeight * 2 - 2, RButtHeight] := CornerColor; - ADest.Colors[lRect.Right - 1, 2] := CornerColor; - ADest.Colors[lRect.Right - 1, RButtHeight] := CornerColor; - ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(clWhite)); - ADest.Line(lRect.Right - 51, 1, lRect.Right, 1); - ADest.Line(lRect.Right, 1, lRect.Right, 25); - ADest.Line(lRect.Right, 25, lRect.Right - 51, 25); - ADest.Line(lRect.Right - 51, 25, lRect.Right - 51, 1); - ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($00FFFFFF));} -end; - -procedure TCDCustomTabControlDrawerWinCE.DrawTabs(ADest: TCanvas); -var - IsPainting: Boolean = False; - CurStartLeftPos: Integer = 0; - i: Integer; -begin - for i := 0 to CDTabControl.Tabs.Count - 1 do - begin - if i = LeftmostTabVisibleIndex then - IsPainting := True; - - if IsPainting then - begin - DrawTab(ADest, i, CurStartLeftPos); - CurStartLeftPos := CurStartLeftPos + GetTabWidth(ADest, i); - end; - end; -end; - -procedure TCDCustomTabControlDrawerWinCE.DrawTab(ADest: TCanvas; - AIndex: Integer; ACurStartLeftPos: Integer); -var - IsSelected: Boolean; - lTabWidth, lTabHeight, lTabTopPos: Integer; - Points: array of TPoint; - lCaption: String; -begin - IsSelected := CDTabControl.FTabIndex = AIndex; - - if IsSelected then - begin - lTabTopPos := 0; - lTabHeight := GetTabHeight(AIndex); - end - else - begin - lTabTopPos := 5; - lTabHeight := GetTabHeight(AIndex)-5; - end; - - lTabWidth := GetTabWidth(ADest, AIndex); - - // Fill the area inside the outer border - ADest.Pen.Style := psClear; - ADest.Brush.Style := bsSolid; - ADest.Brush.Color := clWhite; - SetLength(Points, 5); - Points[0] := Point(ACurStartLeftPos, lTabTopPos); - Points[1] := Point(ACurStartLeftPos+lTabWidth-5, lTabTopPos); - Points[2] := Point(ACurStartLeftPos+lTabWidth, lTabTopPos+5); - Points[3] := Point(ACurStartLeftPos+lTabWidth, lTabTopPos+lTabHeight); - Points[4] := Point(ACurStartLeftPos, lTabTopPos+lTabHeight); - ADest.Polygon(Points); - - // Draw the outer border only in the top and right sides, - // and bottom if unselected - ADest.Pen.Style := psSolid; - ADest.Brush.Style := bsClear; - ADest.Pen.Color := ColorToRGB($009C9B91); - ADest.MoveTo(ACurStartLeftPos+1, lTabTopPos); - ADest.LineTo(ACurStartLeftPos+lTabWidth-5, lTabTopPos); - ADest.LineTo(ACurStartLeftPos+lTabWidth, lTabTopPos+5); - ADest.LineTo(ACurStartLeftPos+lTabWidth, lTabTopPos+lTabHeight); - - // If it is selected, add a selection frame - if IsSelected then - begin - ADest.Pen.Color := ColorToRGB($00D6C731); - ADest.Pen.Style := psSolid; - ADest.Brush.Style := bsClear; - ADest.Rectangle( - ACurStartLeftPos+3, lTabTopPos+3, - ACurStartLeftPos+lTabWidth-5, lTabTopPos+lTabHeight-5 - ); - end; - - // Now the text - lCaption := CDTabControl.Tabs.Strings[AIndex]; - ADest.TextOut(ACurStartLeftPos+5, lTabTopPos+5, lCaption); -end; - -function TCDCustomTabControlDrawerWinCE.GetPageIndexFromXY(x, y: integer - ): integer; -begin - Result := 1; -end; - -function TCDCustomTabControlDrawerWinCE.GetTabHeight(AIndex: Integer): Integer; -begin - if CDTabControl.Font.Size = 0 then - Result := 32 - else - Result := CDTabControl.Font.Size + 22; -end; - -function TCDCustomTabControlDrawerWinCE.GetTabWidth(ADest: TCanvas; - AIndex: Integer): Integer; -const - TCDTabControl_WinCE_TabCaptionExtraWidth = 20; -var - lCaption: string; -begin - lCaption := CDTabControl.Tabs.Strings[AIndex]; - - Result := ADest.TextWidth(lCaption) + TCDTabControl_WinCE_TabCaptionExtraWidth; -end; - -{function TCDCustomTabControlDrawerWinCE.GetClientRect(AControl: TCDControl - ): TRect; -var - lCaptionHeight: Integer; -begin - lCaptionHeight := GetTabHeight(CDTabControl.FTabIndex) - 4; - - Result := Rect(5, lCaptionHeight + 1, CDTabControl.Width - 10, - CDTabControl.Height - lCaptionHeight - 5); -end;} - -procedure TCDCustomTabControlDrawerWinCE.DrawToIntfImage(ADest: TFPImageCanvas; - FPImg: TLazIntfImage); -var - lColor: TColor; - lFPColor: TFPColor; - x, y: Integer; -begin - if CDTabControl.Color = clDefault then - lColor := ColorToRGB(CDTabControl.GetDefaultColor(dctBrush)) - else lColor := ColorToRGB(CDTabControl.Color); - - // Background - lFPColor := TColorToFPColor(lColor); - FPImg.FillPixels(lFPColor); -end; - -procedure TCDCustomTabControlDrawerWinCE.DrawToCanvas(ADest: TCanvas); -var - CaptionHeight: Integer; -begin - CaptionHeight := GetTabHeight(CDTabControl.FTabIndex); - - // frame - ADest.Pen.Style := psSolid; - ADest.Brush.Style := bsClear; - ADest.Pen.Color := ColorToRGB($009C9B91); - - if CDTabControl.GetTabCount = 0 then - ADest.Rectangle(0, 0, CDTabControl.Width - 2, CDTabControl.Height - 2) - else - ADest.Rectangle(0, CaptionHeight, CDTabControl.Width - 2, CDTabControl.Height - 2); - - ADest.Pen.Color := ColorToRGB($00BFCED0); - ADest.Line(CDTabControl.Width - 1, CaptionHeight + 1, - CDTabControl.Width - 1, CDTabControl.Height - 1); - ADest.Line(CDTabControl.Width - 1, CDTabControl.Height - 1, 1, - CDTabControl.Height - 1); - - // Tabs - ADest.Font.Name := CDTabControl.Font.Name; - ADest.Font.Size := CDTabControl.Font.Size; -// DrawCaptionBar(ADest, Rect(0, 0, CDPageControl.Width - -// 2, CaptionHeight + 1), CDPageControl.Color, CDPageControl); - DrawTabs(ADest); -end; - -procedure TCDCustomTabControlDrawerWinCE.DrawTabSheet(ADest: TCanvas); -begin - ADest.Brush.Color := CDTabControl.Color; - ADest.Brush.Style := bsSolid; - ADest.Pen.Style := psClear; - ADest.Rectangle(0, 0, CDTabControl.Width, CDTabControl.Height); -end; - -procedure TCDCustomTabControlDrawerWinCE.MouseDown(Button: TMouseButton; - Shift: TShiftState; X, Y: integer); -var - i: Integer; - CurPage: TCDTabSheet; - CurStartLeftPos: Integer = 0; - VisiblePagesStarted: Boolean = False; - lTabWidth: Integer; -begin - for i := 0 to CDTabControl.Tabs.Count - 1 do - begin - if i = LeftmostTabVisibleIndex then - VisiblePagesStarted := True; - - if VisiblePagesStarted then - begin - lTabWidth := GetTabWidth(CDTabControl.Canvas, i); - if (X > CurStartLeftPos) and - (X < CurStartLeftPos + lTabWidth) and - (Y < GetTabHeight(i)) then - begin - if CDTabControl is TCDPageControl then - (CDTabControl as TCDPageControl).SetPageIndex(i) - else - CDTabControl.SetTabIndex(i); - - Exit; - end; - CurStartLeftPos := CurStartLeftPos + lTabWidth; - end; - end; -end; - -{ TCDCustomTabControl } - -procedure TCDCustomTabControl.MouseDown(Button: TMouseButton; - Shift: TShiftState; X, Y: integer); -begin - TCDCustomTabControlDrawer(FCurrentDrawer).MouseDown(Button, Shift, X, Y); - inherited MouseDown(Button, Shift, X, Y); -end; - -procedure TCDCustomTabControl.PrepareCurrentDrawer; -begin - case FDrawStyle of - dsWince: FCurrentDrawer := FDrawerWinCE; - dsCustom: FCurrentDrawer := CustomDrawer; - end; -end; - -procedure TCDCustomTabControl.SetTabIndex(AValue: Integer); -begin - if FTabIndex = AValue then Exit; - if Assigned(OnChanging) then OnChanging(Self); - FTabIndex := AValue; - if Assigned(OnChange) then OnChange(Self); - Invalidate; -end; - -procedure TCDCustomTabControl.SetTabs(AValue: TStringList); -begin - if FTabs=AValue then Exit; - FTabs.Assign(AValue); - CorrectTabIndex(); - Invalidate; -end; - -constructor TCDCustomTabControl.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - - Width := 232; - Height := 184; - TabStop := True; - - FDrawerWinCE := TCDCustomTabControlDrawerWinCE.Create; - TCDCustomTabControlDrawerWinCE(FDrawerWinCE).CDTabControl := Self; - CustomDrawer := FDrawerWinCE; // Dummy to avoid designer crashes - FCurrentDrawer := FDrawerWinCE; - FDrawStyle := dsWinCE; - - ParentColor := True; - ParentFont := True; - ControlStyle := ControlStyle + [csAcceptsControls, csDesignInteractive]; - - // FTabs should hold only visible tabs - FTabs := TStringList.Create; -end; - -destructor TCDCustomTabControl.Destroy; -begin - FTabs.Free; - - inherited Destroy; -end; - -procedure TCDCustomTabControl.Paint; -var - AImage: TLazIntfImage = nil; - ABmp: TBitmap = nil; - lCanvas: TFPImageCanvas = nil; -begin - ABmp := TBitmap.Create; - try - ABmp.Width := Width; - ABmp.Height := Height; - AImage := ABmp.CreateIntfImage; - lCanvas := TFPImageCanvas.Create(AImage); - TCDCustomTabControlDrawer(FCurrentDrawer).DrawToIntfImage(lCanvas, AImage); - ABmp.LoadFromIntfImage(AImage); - ABmp.Canvas.Font.Assign(Font); - TCDCustomTabControlDrawer(FCurrentDrawer).DrawToCanvas(ABmp.Canvas); - Canvas.Draw(0, 0, ABmp); - finally - if lCanvas <> nil then - lCanvas.Free; - if AImage <> nil then - AImage.Free; - ABmp.Free; - end; -end; - -function TCDCustomTabControl.GetTabCount: Integer; -begin - Result := 0; - if FTabs <> nil then Result := FTabs.Count; -end; - -procedure TCDCustomTabControl.CorrectTabIndex; -begin - if FTabIndex >= FTabs.Count then SetTabIndex(FTabs.Count - 1); -end; - { TCustomBitmappedButton } procedure TCustomBitmappedButton.DoEnter; @@ -1140,7 +247,7 @@ end; procedure TCustomBitmappedButton.DoButtonDown(); var - NewState: TBitmappedButtonState; + NewState: TCDButtonState; begin NewState := bbsDown; @@ -1158,7 +265,7 @@ end; procedure TCustomBitmappedButton.DoButtonUp(); var - NewState: TBitmappedButtonState; + NewState: TCDButtonState; begin if Focused then NewState := bbsFocused @@ -1292,1016 +399,6 @@ begin end; end; -{ TCDControl } - -procedure TCDControl.PrepareCurrentDrawer; -begin - -end; - -procedure TCDControl.SetDrawStyle(const AValue: TCDDrawStyle); -begin - if FDrawStyle = AValue then exit; - FDrawStyle := AValue; - Invalidate; - PrepareCurrentDrawer(); - - //FCurrentDrawer.SetClientRectPos(Self); -end; - -function TCDControl.GetClientRect: TRect; -begin - // Disable this, since although it works in Win32, it doesn't seam to work in LCL-Carbon - //if (FCurrentDrawer = nil) then - Result := inherited GetClientRect() - //else - //Result := FCurrentDrawer.GetClientRect(Self); -end; - -procedure TCDControl.EraseBackground(DC: HDC); -begin - -end; - -{ TCDButtonDrawer } - -function TCDButtonDrawer.GetClientRect(AControl: TCDControl): TRect; -var - CDButton: TCDButton absolute AControl; -begin - Result := Rect(1, 1, CDButton.Width - 1, CDButton.Height - 1); -end; - -procedure TCDButton.DoEnter; -begin - DoButtonUp(); - - inherited DoEnter; -end; - -procedure TCDButton.DoExit; -begin - DoButtonUp(); - - inherited DoExit; -end; - -procedure TCDButton.KeyDown(var Key: word; Shift: TShiftState); -begin - inherited KeyDown(Key, Shift); - - if (Key = VK_SPACE) or (Key = VK_RETURN) then - DoButtonDown(); -end; - -procedure TCDButton.KeyUp(var Key: word; Shift: TShiftState); -begin - DoButtonUp(); - - inherited KeyUp(Key, Shift); -end; - -procedure TCDButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); -begin - if not Focused then - SetFocus; - DoButtonDown(); - - inherited MouseDown(Button, Shift, X, Y); -end; - -procedure TCDButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); -begin - DoButtonUp(); - - inherited MouseUp(Button, Shift, X, Y); -end; - -procedure TCDButton.MouseEnter; -begin - inherited MouseEnter; -end; - -procedure TCDButton.MouseLeave; -begin - inherited MouseLeave; -end; - -procedure TCDButton.DoButtonDown(); -var - NewState: TBitmappedButtonState; -begin - NewState := bbsDown; - - case FState of - bbsNormal, bbsFocused: NewState := bbsDown; - end; - - if NewState <> FState then - begin - FState := NewState; - Invalidate; - end; -end; - -procedure TCDButton.DoButtonUp(); -var - NewState: TBitmappedButtonState; -begin - if Focused then - NewState := bbsFocused - else - NewState := bbsNormal; - - if NewState <> FState then - begin - FState := NewState; - Invalidate; - end; -end; - -procedure TCDButton.PrepareCurrentDrawer; -begin - case DrawStyle of - dsWince: FCurrentDrawer := FDrawerWinCE; - dsCustom: FCurrentDrawer := CustomDrawer; - dsAndroid: FCurrentDrawer := FDrawerAndroid; - dsXPTaskbar: FCurrentDrawer := FDrawerXPTB; - dsGrad: FCurrentDrawer := FDrawerGrad; - dsWin2000: FCurrentDrawer := FDrawerWin2k; - end; -end; - -procedure TCDButton.RealSetText(const Value: TCaption); -begin - inherited RealSetText(Value); - Invalidate; -end; - -constructor TCDButton.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - TabStop := True; - FDrawerWinCE := TCDButtonDrawerWinCE.Create; - CustomDrawer := FDrawerWinCE; // Dummy to avoid designer crashes - FDrawerAndroid := TCDButtonDrawerAndroid.Create; - FDrawerXPTB := TCDButtonDrawerXPTB.Create; - FDrawerGrad := TCDButtonDrawerGrad.Create; - FDrawerWin2k := TCDButtonDrawerWin2k.Create; - Width := 120; - Height := 43; - //Color := clTeal; - ParentFont := True; - FDrawStyle := dsAndroid; - Color := $00F1F5F5; -end; - -destructor TCDButton.Destroy; -begin - inherited Destroy; -end; - -procedure DrawCDButtonDown(Canvas: TCanvas; CDButton: TCDButton); -begin - with Canvas do - begin - Brush.Style := bsSolid; - Brush.Color := CDButton.Color; - Pen.Color := Brush.Color; - Rectangle(0, 0, Width, Height); - FillRect(0, 0, Width, Height); - Brush.Color := GetAColor(CDButton.Color, 93); - Pen.Color := GetAColor(Brush.Color, 76); - RoundRect(0, 0, Width, Height, 8, 8); - end; -end; - -procedure TCDButton.Paint; -var - AImage: TLazIntfImage = nil; - ABmp: TBitmap = nil; - lCanvas: TFPImageCanvas = nil; - pColor: TColor; -begin - // inherited Paint; - - PrepareCurrentDrawer(); - - ABmp := TBitmap.Create; - try - ABmp.Width := Width; - ABmp.Height := Height; - AImage := ABmp.CreateIntfImage; - lCanvas := TFPImageCanvas.Create(AImage); - // First step of the drawing: FCL TFPCustomCanvas for fast pixel access - TCDButtonDrawer(FCurrentDrawer).DrawToIntfImage(lCanvas, Self); - ABmp.LoadFromIntfImage(AImage); - // Second step of the drawing: LCL TCustomCanvas for easy font access - TCDButtonDrawer(FCurrentDrawer).DrawToCanvas(ABmp.Canvas, Self, FState); - - Canvas.Draw(0, 0, ABmp); - finally - if lCanvas <> nil then - lCanvas.Free; - if AImage <> nil then - AImage.Free; - ABmp.Free; - end; -end; - -{ TCDButtonDrawerGrad } - -procedure TCDButtonDrawerGrad.DrawToIntfImage(ADest: TFPImageCanvas; - CDButton: TCDButton); -begin - -end; - -procedure TCDButtonDrawerGrad.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; - FState: TBitmappedButtonState); -var - TmpB: TBitmap; - Str: string; -begin - // Button shape -> This crashes in Gtk2 - TmpB := TBitmap.Create; - TmpB.Width := CDButton.Width; - TmpB.Height := CDButton.Height; - TmpB.Canvas.Brush.Color := CDButton.Color; - TmpB.Canvas.Brush.Style := bsSolid; - TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8); - // CDButton.SetShape(TmpB); - - with TmpB.Canvas do - begin - Brush.Style := bsSolid; - Brush.Color := CDButton.Parent.Color; - Pen.Color := Brush.Color; - Rectangle(0, 0, Width, Height); - FillRect(0, 0, Width, Height); - Brush.Color := GetAColor(CDButton.Color, 90); - end; - - // Button image - case FState of - bbsDown: - begin - DrawCDButtonDown(TmpB.Canvas, CDButton); - end; - bbsFocused: - //GradientFill(GetUColor(CDButton.Color, 50), GetAColor(CDButton.Color, 60), TmpB.Canvas); - GradientFill(clWhite, GetAColor(CDButton.Color, 96), TmpB.Canvas); - else - //GradientFill(GetUColor(CDButton.Color, 10), GetAColor(CDButton.Color, 20), TmpB.Canvas); - GradientFill(clWhite, CDButton.Color, TmpB.Canvas); - end; - - ADest.Draw(0, 0, TmpB); - - TmpB.Free; - - // Button text - {$ifndef CUSTOMDRAWN_USE_FREETYPE} - ADest.Font.Assign(CDButton.Font); - ADest.Brush.Style := bsClear; - ADest.Pen.Style := psSolid; - Str := CDButton.Caption; - ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2, - (CDButton.Height - ADest.TextHeight(Str)) div 2, Str); - {$endif} -end; - -{ TCDButtonDrawerWinCE } - -procedure TCDButtonDrawerWinCE.DrawToIntfImage(ADest: TFPImageCanvas; - CDButton: TCDButton); -begin - -end; - -procedure TCDButtonDrawerWinCE.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; - FState: TBitmappedButtonState); -var - TmpB: TBitmap; - Str: string; -begin - // Button shape -> This crashes in Gtk2 - TmpB := TBitmap.Create; - TmpB.Width := CDButton.Width; - TmpB.Height := CDButton.Height; - TmpB.Canvas.Brush.Color := CDButton.Color; - TmpB.Canvas.Brush.Style := bsSolid; - TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8); - // CDButton.SetShape(TmpB); - - // Button image - case FState of - bbsDown: - begin - with TmpB.Canvas do - begin - Brush.Style := bsSolid; - Brush.Color := GetAColor(CDButton.Color, 90); - Pen.Color := clBlack; - Pen.Style := psSolid; - Rectangle(0, 0, Width, Height); - end; - end; - bbsFocused: - with TmpB.Canvas do - begin - Brush.Style := bsSolid; - Brush.Color := GetAColor(CDButton.Color, 99); - Pen.Color := clBlack; - Pen.Style := psSolid; - Rectangle(0, 0, Width, Height); - Rectangle(1, 1, Width - 1, Height - 1); // The border is thicken when focused - end; - else - with TmpB.Canvas do - begin - Brush.Style := bsSolid; - Brush.Color := CDButton.Color; - Pen.Color := clBlack; - Pen.Style := psSolid; - Rectangle(0, 0, Width, Height); - end; - end; - - ADest.Draw(0, 0, TmpB); - - TmpB.Free; - - // Button text - {$ifndef CUSTOMDRAWN_USE_FREETYPE} - ADest.Font.Assign(CDButton.Font); - ADest.Brush.Style := bsClear; - ADest.Pen.Style := psSolid; - Str := CDButton.Caption; - ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2, - (CDButton.Height - ADest.TextHeight(Str)) div 2, Str); - {$endif} -end; - -procedure TCDButtonDrawerWin2k.DrawToIntfImage(ADest: TFPImageCanvas; - CDButton: TCDButton); -begin - -end; - -procedure TCDButtonDrawerWin2k.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; - FState: TBitmappedButtonState); -var - TmpB: TBitmap; - Str: string; -begin - // Button shape -> This crashes in Gtk2 - TmpB := TBitmap.Create; - TmpB.Width := CDButton.Width; - TmpB.Height := CDButton.Height; - TmpB.Canvas.Brush.Color := CDButton.Color; - TmpB.Canvas.Brush.Style := bsSolid; - TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8); - - with TmpB.Canvas do - begin - Brush.Style := bsSolid; - Brush.Color := CDButton.Color; - Pen.Color := clWhite; - Pen.Style := psSolid; - Rectangle(0, 0, Width - 1, Height - 1); - Pen.Color := clWhite; - Line(0, 0, Width - 1, 0); - Line(0, 0, 0, Height - 1); - Pen.Color := clGray; - Line(0, Height - 1, Width - 1, Height - 1); - Line(Width - 1, Height - 1, Width - 1, -1); - Pen.Color := $0099A8AC; - Line(1, Height - 2, Width - 2, Height - 2); - Line(Width - 2, Height - 2, Width - 2, 0); - Pen.Color := $00E2EFF1; - Line(1, 1, Width - 2, 1); - Line(1, 1, 1, Height - 2); - end; - - // Button image - case FState of - bbsDown: - begin - with TmpB.Canvas do - begin - Brush.Style := bsSolid; - Brush.Color := CDButton.Color; - Pen.Color := clWhite; - Pen.Style := psSolid; - Rectangle(0, 0, Width - 1, Height - 1); - Pen.Color := clGray; - Line(0, 0, Width - 1, 0); - Line(0, 0, 0, Height - 1); - Pen.Color := clWhite; - Line(0, Height - 1, Width - 1, Height - 1); - Line(Width - 1, Height - 1, Width - 1, -1); - Pen.Color := $00E2EFF1; - Line(1, Height - 2, Width - 2, Height - 2); - Line(Width - 2, Height - 2, Width - 2, 0); - Pen.Color := $0099A8AC; - Line(1, 1, Width - 2, 1); - Line(1, 1, 1, Height - 2); - end; - end; - bbsFocused: - with TmpB.Canvas do - DrawFocusRect(Rect(3, 3, Width - 4, Height - 4)) - else - begin - end; - end; - - ADest.Draw(0, 0, TmpB); - - TmpB.Free; - - // Button text - {$ifndef CUSTOMDRAWN_USE_FREETYPE} - ADest.Font.Assign(CDButton.Font); - ADest.Brush.Style := bsClear; - ADest.Pen.Style := psSolid; - Str := CDButton.Caption; - if FState = bbsDown then - ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2 + 1, - (CDButton.Height - ADest.TextHeight(Str)) div 2 + 1, Str) - else - ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2, - (CDButton.Height - ADest.TextHeight(Str)) div 2, Str); - {$endif} -end; - -procedure TCDButtonDrawerAndroid.DrawToIntfImage(ADest: TFPImageCanvas; - CDButton: TCDButton); -begin - -end; - -procedure TCDButtonDrawerAndroid.DrawToCanvas(ADest: TCanvas; - CDButton: TCDButton; FState: TBitmappedButtonState); -var - //TmpB: TBitmap; - Str: string; -begin - // Button shape -> This crashes in Gtk2 -{ TmpB.Canvas.Brush.Color := CDButton.Color; - TmpB.Canvas.Brush.Style := bsSolid; - TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8); - CDButton.SetShape(TmpB); - ADest.Draw(0, 0, TmpB); - TmpB.Free; - } - - ADest.Brush.Color := CDButton.Parent.Color; - ADest.Brush.Style := bsSolid; - ADest.Pen.Color := ADest.Brush.Color; - ADest.RecTangle(0, 0, CDButton.Width, CDButton.Height); - - // Button image - case FState of - bbsDown: - begin - DrawCDButtonDown(ADest, CDButton); - end; - bbsFocused: - begin - DrawAndroidButton(ADest, GetAColor(CDButton.Color, 98)); - end; - else - DrawAndroidButton(ADest, GetAColor(CDButton.Color, 96)); - end; - - // Button text - {$ifndef CUSTOMDRAWN_USE_FREETYPE} - ADest.Font.Assign(CDButton.Font); - ADest.Brush.Style := bsClear; - ADest.Pen.Style := psSolid; - Str := CDButton.Caption; - ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2, - (CDButton.Height - ADest.TextHeight(Str)) div 2, Str); - {$endif} -end; - -procedure TCDButtonDrawerXPTB.DrawToIntfImage(ADest: TFPImageCanvas; - CDButton: TCDButton); -begin - -end; - -procedure TCDButtonDrawerXPTB.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton; - FState: TBitmappedButtonState); -var - Str: string; -begin - case FState of - bbsDown: - begin - DrawCDButtonDown(ADest, CDButton); - end; - bbsFocused: - begin - DrawXPTaskbarButton(ADest, GetAColor(CDButton.Color, 98)); - end; - else - DrawXPTaskbarButton(ADest, CDButton.Color); - end; - - // Button text - {$ifndef CUSTOMDRAWN_USE_FREETYPE} - ADest.Font.Assign(CDButton.Font); - ADest.Brush.Style := bsClear; - ADest.Pen.Style := psSolid; - Str := CDButton.Caption; - ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2, - (CDButton.Height - ADest.TextHeight(Str)) div 2, Str); - {$endif} -end; - -{ TCDGroupBox } - -procedure TCDGroupBox.PrepareCurrentDrawer(); -begin - case DrawStyle of - dsWince: FCurrentDrawer := FDrawerWinCE; - dsCustom: FCurrentDrawer := CustomDrawer; - end; -end; - -procedure TCDGroupBox.SetDrawStyle(const AValue: TCDDrawStyle); -begin - if FDrawStyle = AValue then - exit; - FDrawStyle := AValue; - - Invalidate; - - PrepareCurrentDrawer(); - FCurrentDrawer.SetClientRectPos(Self); -end; - -procedure TCDGroupBox.RealSetText(const Value: TCaption); -begin - inherited RealSetText(Value); - Invalidate; -end; - -constructor TCDGroupBox.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - Width := 100; - Height := 100; - TabStop := False; - FDrawerWinCE := TCDGroupBoxDrawerWinCE.Create; - CustomDrawer := FDrawerWinCE; // Dummy to avoid designer crashes - ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents, - csDoubleClicks, csReplicatable]; -end; - -destructor TCDGroupBox.Destroy; -begin - inherited Destroy; -end; - -procedure TCDGroupBox.EraseBackground(DC: HDC); -begin - -end; - -procedure TCDGroupBox.Paint; -var - AImage: TLazIntfImage = nil; - ABmp: TBitmap = nil; - lCanvas: TFPImageCanvas = nil; -begin - inherited Paint; - - PrepareCurrentDrawer(); - - ABmp := TBitmap.Create; - try - ABmp.Width := Width; - ABmp.Height := Height; - AImage := ABmp.CreateIntfImage; - lCanvas := TFPImageCanvas.Create(AImage); - // First step of the drawing: FCL TFPCustomCanvas for fast pixel access - FCurrentDrawer.DrawToIntfImage(lCanvas, Self); - ABmp.LoadFromIntfImage(AImage); - // Second step of the drawing: LCL TCustomCanvas for easy font access - FCurrentDrawer.DrawToCanvas(ABmp.Canvas, Self); - Canvas.Draw(0, 0, ABmp); - finally - if lCanvas <> nil then - lCanvas.Free; - if AImage <> nil then - AImage.Free; - ABmp.Free; - end; -end; - -{ TCDGroupBoxDrawerWinCE } - -procedure TCDGroupBoxDrawerWinCE.SetClientRectPos(CDGroupBox: TCDGroupBox); -var - lRect: TRect; - lCaptionHeight: integer; -begin - lCaptionHeight := 10; - lRect := Rect(1, lCaptionHeight, CDGroupBox.Width - 1, CDGroupBox.Height - 1); - CDGroupBox.AdjustClientRect(lRect); -end; - -procedure TCDGroupBoxDrawerWinCE.DrawToIntfImage(ADest: TFPImageCanvas; - CDGroupBox: TCDGroupBox); -{$ifdef CUSTOMDRAWN_USE_FREETYPE} -var - AFont: TFreeTypeFont = nil; -{$endif} -begin - FCaptionMiddle := CDGroupBox.Canvas.TextHeight('Ź') div 2; - if FCaptionMiddle = 0 then FCaptionMiddle := CDGroupBox.Canvas.Font.Size div 2; - if FCaptionMiddle = 0 then FCaptionMiddle := 5; - - // Background - if CDGroupBox.Parent = nil then - ADest.Brush.FPColor := colLtGray - else if CDGroupBox.Parent.Color = clDefault then - ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(clForm)) - else - ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CDGroupBox.Parent.Color)); - ADest.Brush.Style := bsSolid; - ADest.Pen.Style := psClear; - ADest.Rectangle(0, 0, CDGroupBox.Width, CDGroupBox.Height); - - // frame - ADest.Pen.FPColor := colBlack; - ADest.Pen.Style := psSolid; - ADest.Brush.Style := bsClear; - ADest.Rectangle(0, FCaptionMiddle, CDGroupBox.Width - 1, CDGroupBox.Height - 1); - - {$ifdef CUSTOMDRAWN_USE_FREETYPE} - // Caption background and caption - - // initialize free type font manager - opcftfont.InitEngine; - // FontMgr.SearchPath:='/usr/share/fonts/truetype/'; - AFont := TFreeTypeFont.Create; - try - // Text background - ADest.Pen.Style := psClear; - ADest.Brush.Style := bsSolid; - // The brush color was already set previously and is already correct - // ADest.Rectangle(5, 0, AFont.GetTextWidth(CDGroupBox.Caption) + 5, 10); - - // paint text - ADest.Pen.Style := psSolid; - ADest.Brush.Style := bsClear; - ADest.Font := AFont; - ADest.Font.Name := 'Arial'; - ADest.Font.Size := 10; - ADest.TextOut(5, 10, CDGroupBox.Caption); - finally - AFont.Free; - end; - {$endif} -end; - -procedure TCDGroupBoxDrawerWinCE.DrawToCanvas(ADest: TCanvas; CDGroupBox: TCDGroupBox); -begin - {$ifndef CUSTOMDRAWN_USE_FREETYPE} - if CDGroupBox.Parent = nil then - ADest.Brush.Color := clLtGray - else if CDGroupBox.Parent.Color = clDefault then - ADest.Brush.Color := ColorToRGB(clForm) - else - ADest.Brush.Color := ColorToRGB(CDGroupBox.Parent.Color); - - // paint text - ADest.Pen.Style := psSolid; - ADest.Brush.Style := bsSolid; // This will fill the text background - ADest.Font.Size := 10; - ADest.TextOut(FCaptionMiddle, 0, CDGroupBox.Caption); - {$endif} -end; - -{ TCDTrackBar } - -procedure TCDTrackBar.SetMax(Value: integer); -begin - if Value = FMax then - Exit; - FMax := Value; - Invalidate; -end; - -procedure TCDTrackBar.SetMin(Value: integer); -begin - if Value = FMin then - Exit; - FMin := Value; - Invalidate; -end; - -procedure TCDTrackBar.SetPosition(Value: integer); -begin - if Value = FPosition then Exit; - FPosition := Value; - Invalidate; -end; - -function TCDTrackBar.GetPositionFromMousePos(X, Y: integer): integer; -var - lLeftBorder, lRightBorder: Integer; -begin - FCurrentDrawer.GetGeometry(lLeftBorder, lRightBorder); - if X > Width - lRightBorder then Result := FMax - else if X < lLeftBorder then Result := FMin - else Result := FMin + (X - lLeftBorder) * (FMax - FMin + 1) div (Width - lRightBorder - lLeftBorder); - - // sanity check - if Result > FMax then Result := FMax; - if Result < FMin then Result := FMin; -end; - -procedure TCDTrackBar.Changed; -begin - -end; - -procedure TCDTrackBar.DoEnter; -begin - inherited DoEnter; -end; - -procedure TCDTrackBar.DoExit; -begin - inherited DoExit; -end; - -procedure TCDTrackBar.KeyDown(var Key: word; Shift: TShiftState); -var - NewPosition: Integer; -begin - inherited KeyDown(Key, Shift); - if (Key = 37) or (Key = 40) then - NewPosition := FPosition - (FMax - FMin) div 10; - if (Key = 38) or (Key = 39) then - NewPosition := FPosition + (FMax - FMin) div 10; - - // sanity check - if NewPosition > FMax then NewPosition := FMax; - if NewPosition < FMin then NewPosition := FMin; - - Position := NewPosition; -end; - -procedure TCDTrackBar.KeyUp(var Key: word; Shift: TShiftState); -begin - inherited KeyUp(Key, Shift); -end; - -procedure TCDTrackBar.MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: integer); -var - NewPosition: Integer; -begin - SetFocus; - - NewPosition := GetPositionFromMousePos(X, Y); - - DragDropStarted := True; - - Position := NewPosition; - - inherited MouseDown(Button, Shift, X, Y); -end; - -procedure TCDTrackBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); -begin - DragDropStarted := False; - inherited MouseUp(Button, Shift, X, Y); -end; - -procedure TCDTrackBar.MouseMove(Shift: TShiftState; X, Y: integer); -var - NewPosition: Integer; -begin - if DragDropStarted then - begin - NewPosition := GetPositionFromMousePos(X, Y); - Position := NewPosition; - end; - inherited MouseMove(Shift, X, Y); -end; - -procedure TCDTrackBar.MouseEnter; -begin - inherited MouseEnter; -end; - -procedure TCDTrackBar.MouseLeave; -begin - inherited MouseLeave; -end; - -constructor TCDTrackBar.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - Height := 25; - Width := 100; - FCurrentDrawer := TCDTrackBarDrawerGraph.Create; - Color := clBtnFace; - FMax := 10; - FMin := 0; - TabStop := True; -end; - -destructor TCDTrackBar.Destroy; -begin - FCurrentDrawer.Free; - inherited Destroy; -end; - -procedure TCDTrackBar.EraseBackground(DC: HDC); -begin - //inherited EraseBackground(DC); -end; - -procedure TCDTrackBar.Paint; -var - AImage: TLazIntfImage = nil; - ABmp: TBitmap = nil; - lCanvas: TFPImageCanvas = nil; -begin - inherited Paint; - ABmp := TBitmap.Create; - try - ABmp.Width := Width; - ABmp.Height := Height; - AImage := ABmp.CreateIntfImage; - lCanvas := TFPImageCanvas.Create(AImage); - // First step of the drawing: FCL TFPCustomCanvas for fast pixel access - FCurrentDrawer.DrawToIntfImage(lCanvas, AImage, Self); - ABmp.LoadFromIntfImage(AImage); - Canvas.Draw(0, 0, ABmp); - finally - if lCanvas <> nil then - lCanvas.Free; - if AImage <> nil then - AImage.Free; - ABmp.Free; - end; -end; - -{ TCDTrackBarDrawer } - -procedure TCDTrackBarDrawerGraph.DrawToIntfImage(ADest: TFPImageCanvas; - FPImg: TLazIntfImage; CDTrackBar: TCDTrackBar); -const - CDBarEdge = 18; -var - lDrawingBottom, StepsCount, i: Integer; - pStart, pEnd: integer; // for drawing the decorative bars - dRect: TRect; - pStepWidth, pHalfStepWidth: Integer; -begin - // Sanity check - if CDTrackBar.Max - CDTrackBar.Min <= 0 then - raise Exception.Create('[TCDTrackBarDrawerGraph.DrawToIntfImage] Max-Min must be at least 1'); - - // Preparations - StepsCount := CDTrackBar.Max - CDTrackBar.Min + 1; - pStepWidth := (CDTrackBar.Width - CDBarEdge) div StepsCount; - pHalfStepWidth := (CDTrackBar.Width - CDBarEdge) div (StepsCount * 2); - - // The bottom part of the drawing - lDrawingBottom := CDTrackBar.Height - 10; - - // Background - - if CDTrackBar.Parent = nil then - ADest.Brush.FPColor := colLtGray - else - ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CDTrackBar.Color)); - ADest.Brush.Style := bsSolid; - ADest.Pen.Style := psClear; - ADest.Rectangle(0, 0, CDTrackBar.Width, CDTrackBar.Height); - ADest.Brush.FPColor := TColorToFPColor(ColorToRGB($006BB6E6)); - - // Draws the double-sided arrow in the center of the slider - - ADest.Pen.Style := psSolid; - ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($006BB6E6)); - ADest.Line(0, lDrawingBottom, CDTrackBar.Width, lDrawingBottom); - ADest.Line(3, lDrawingBottom - 1, 6, lDrawingBottom - 1); - ADest.Line(5, lDrawingBottom - 2, 6, lDrawingBottom - 2); - ADest.Line(3, lDrawingBottom + 1, 6, lDrawingBottom + 1); - ADest.Line(5, lDrawingBottom + 2, 6, lDrawingBottom + 2); - ADest.Line(CDTrackBar.Width - 1 - 3, lDrawingBottom - 1, CDTrackBar.Width - 1 - 6, lDrawingBottom - 1); - ADest.Line(CDTrackBar.Width - 1 - 5, lDrawingBottom - 2, CDTrackBar.Width - 1 - 6, lDrawingBottom - 2); - ADest.Line(CDTrackBar.Width - 1 - 3, lDrawingBottom + 1, CDTrackBar.Width - 1 - 6, lDrawingBottom + 1); - ADest.Line(CDTrackBar.Width - 1 - 5, lDrawingBottom + 2, CDTrackBar.Width - 1 - 6, lDrawingBottom + 2); - ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(clGray)); - ADest.Brush.FPColor := TColorToFPColor(ColorToRGB($00F0F0F0)); - - // Draws the decorative bars and also the slider button - - pStart := 10 - 1; - for i := 0 to StepsCount - 1 do - begin - // Draw the decorative bars - dRect := Bounds( - pStart + pHalfStepWidth, - lDrawingBottom - 5 - i, - Round(pStepWidth)-3, - 4 + i); - - ADest.Brush.Style := bsSolid; - ADest.Pen.Style := psSolid; - ADest.Pen.FPColor := colBlack; - if i + CDTrackBar.Min <= CDTrackBar.Position then - ADest.Brush.FPColor := colDkGray - else - ADest.Brush.FPColor := colWhite; - - ADest.Rectangle(dRect); - - // Draw the slider - - if i + CDTrackBar.Min = CDTrackBar.Position then - begin - ADest.Brush.FPColor := TColorToFPColor(ColorToRGB($006BB6E6)); - ADest.Brush.Style := bsSolid; - ADest.Rectangle(pStart, lDrawingBottom + 1, pStart + 10, lDrawingBottom + 6); - ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($005BA6C6)); - ADest.RecTangle(pStart, lDrawingBottom + 2, pStart + 10, lDrawingBottom + 7); - ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($006BB6E6)); - ADest.RecTangle(pStart, lDrawingBottom, pStart + 10, lDrawingBottom + 2); - end; - pStart := pStart + pStepWidth; - end; - - ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($007BC6F6)); - ADest.Line(7, lDrawingBottom - 1, CDTrackBar.Width - 8, lDrawingBottom - 1); - ADest.Line(7, lDrawingBottom + 1, CDTrackBar.Width - 8, lDrawingBottom + 1); - ADest.Colors[2, lDrawingBottom - 1] := ADest.Pen.FPColor; - ADest.Colors[4, lDrawingBottom - 2] := ADest.Pen.FPColor; - ADest.Colors[2, lDrawingBottom + 1] := ADest.Pen.FPColor; - ADest.Colors[4, lDrawingBottom + 2] := ADest.Pen.FPColor; - ADest.Colors[6, lDrawingBottom - 3] := ADest.Pen.FPColor; - ADest.Colors[6, lDrawingBottom + 3] := ADest.Pen.FPColor; - ADest.Colors[CDTrackBar.Width - 1 - 2, lDrawingBottom - 1] := ADest.Pen.FPColor; - ADest.Colors[CDTrackBar.Width - 1 - 4, lDrawingBottom - 2] := ADest.Pen.FPColor; - ADest.Colors[CDTrackBar.Width - 1 - 2, lDrawingBottom + 1] := ADest.Pen.FPColor; - ADest.Colors[CDTrackBar.Width - 1 - 4, lDrawingBottom + 2] := ADest.Pen.FPColor; - ADest.Colors[CDTrackBar.Width - 1 - 6, lDrawingBottom - 3] := ADest.Pen.FPColor; - ADest.Colors[CDTrackBar.Width - 1 - 6, lDrawingBottom + 3] := ADest.Pen.FPColor; -end; - -procedure TCDTrackBarDrawerGraph.GetGeometry(var ALeftBorder, - ARightBorder: Integer); -begin - ALeftBorder := 9; - ARightBorder := 9; -end; - -{ TCDTabSheet } - -constructor TCDTabSheet.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - - TabStop := False; - ParentColor := True; - parentFont := True; - ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents, - csDesignFixedBounds, csDoubleClicks, csDesignInteractive]; - //ControlStyle := ControlStyle + [csAcceptsControls, csDesignFixedBounds, - // csNoDesignVisible, csNoFocus]; -end; - -destructor TCDTabSheet.Destroy; -begin - inherited Destroy; -end; - -procedure TCDTabSheet.EraseBackground(DC: HDC); -begin - -end; - -procedure TCDTabSheet.Paint; -begin - if CDTabControl <> nil then - begin - TCDCustomTabControlDrawer(CDTabControl.FCurrentDrawer).DrawTabSheet(Canvas); - end; -end; - { TCDPageControlEditor } procedure TCDPageControlEditor.ShowPageMenuItemClick(Sender: TObject); @@ -2418,215 +515,5 @@ begin Result := TCDPageControl(TCDTabSheet(Component).Parent); end; -{ TCDPageControl } - -function TCDPageControl.AddPage(S: string): TCDTabSheet; -// InsertPage(FPages.Count, S); -var - NewPage: TCDTabSheet; -begin - NewPage := TCDTabSheet.Create(Owner); - NewPage.Parent := Self; - NewPage.CDTabControl := Self; - //Name := Designer.CreateUniqueComponentName(ClassName); - NewPage.Name := GetUniqueName(sTABSHEET_DEFAULT_NAME, Self.Owner); - if S = '' then - NewPage.Caption := NewPage.Name - else - NewPage.Caption := S; - - PositionTabSheet(NewPage); - - FTabs.AddObject(S, NewPage); - - SetActivePage(NewPage); - - Result := NewPage; -end; - -function TCDPageControl.GetPage(AIndex: integer): TCDTabSheet; -begin - if (AIndex >= 0) and (AIndex < FTabs.Count) then - Result := TCDTabSheet(FTabs.Objects[AIndex]) - else - Result := nil; -end; - -function TCDPageControl.InsertPage(aIndex: integer; S: string): TCDTabSheet; -var - NewPage: TCDTabSheet; -begin - NewPage := TCDTabSheet.Create(Owner); - NewPage.Parent := Self; - //Name := Designer.CreateUniqueComponentName(ClassName); - NewPage.Name := GetUniqueName(sTABSHEET_DEFAULT_NAME, Self.Owner); - if S = '' then - NewPage.Caption := NewPage.Name - else - NewPage.Caption := S; - - PositionTabSheet(NewPage); - - FTabs.InsertObject(AIndex, S, NewPage); - - SetActivePage(NewPage); - Result := NewPage; -end; - -procedure TCDPageControl.RemovePage(aIndex: integer); -begin - if (AIndex < 0) or (AIndex >= FTabs.Count) then Exit; - - Application.ReleaseComponent(TComponent(FTabs.Objects[AIndex])); - - FTabs.Delete(aIndex); - if FTabIndex >= FTabs.Count then SetTabIndex(FTabIndex-1); - - Invalidate; -end; - -function TCDPageControl.FindNextPage(CurPage: TCDTabSheet; - GoForward, CheckTabVisible: boolean): TCDTabSheet; -var - I, TempStartIndex: integer; -begin - if FTabs.Count <> 0 then - begin - //StartIndex := FPages.IndexOfObject(CurPage); - TempStartIndex := FTabs.IndexOfObject(CurPage); - if TempStartIndex = -1 then - if GoForward then - TempStartIndex := FTabs.Count - 1 - else - TempStartIndex := 0; - I := TempStartIndex; - repeat - if GoForward then - begin - Inc(I); - if I = FTabs.Count then - I := 0; - end - else - begin - if I = 0 then - I := FTabs.Count; - Dec(I); - end; - Result := TCDTabSheet(FTabs.Objects[I]); - if not CheckTabVisible or Result.Visible then - Exit; - until I = TempStartIndex; - end; - Result := nil; -end; - -procedure TCDPageControl.SelectNextPage(GoForward: boolean; - CheckTabVisible: boolean = True); -var - Page: TCDTabSheet; -begin - Page := FindNextPage(ActivePage, GoForward, CheckTabVisible); - if (Page <> nil) and (Page <> ActivePage) then - SetActivePage(Page); -end; - -constructor TCDPageControl.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - - ControlStyle := ControlStyle - [csAcceptsControls]; -end; - -destructor TCDPageControl.Destroy; -begin - inherited Destroy; -end; - -procedure TCDPageControl.SetActivePage(Value: TCDTabSheet); -var - i: integer; - CurPage: TCDTabSheet; -begin - for i := 0 to FTabs.Count - 1 do - begin - CurPage := TCDTabSheet(FTabs.Objects[i]); - if CurPage = Value then - begin - PositionTabSheet(CurPage); - CurPage.BringToFront; - CurPage.Visible := True; - - // Check first, Tab is Visible? - SetTabIndex(i); - end - else if CurPage <> nil then - begin - //CurPage.Align := alNone; - //CurPage.Height := 0; - CurPage.Visible := False; - end; - end; - - Invalidate; -end; - -procedure TCDPageControl.SetPageIndex(Value: integer); -begin - if (Value > -1) and (Value < FTabs.Count) then - begin - SetTabIndex(Value); - ActivePage := GetPage(Value); - end; -end; - -procedure TCDPageControl.UpdateAllDesignerFlags; -var - i: integer; -begin - for i := 0 to FTabs.Count - 1 do - UpdateDesignerFlags(i); -end; - -procedure TCDPageControl.UpdateDesignerFlags(APageIndex: integer); -var - CurPage: TCDTabSheet; -begin - CurPage := GetPage(APageIndex); - if APageIndex <> fTabIndex then - CurPage.ControlStyle := CurPage.ControlStyle + [csNoDesignVisible] - else - CurPage.ControlStyle := CurPage.ControlStyle - [csNoDesignVisible]; -end; - -procedure TCDPageControl.PositionTabSheet(ATabSheet: TCDTabSheet); -var - lTabHeight, lIndex: Integer; -begin -// ATabSheet.SetBounds(1, 32 + 1, Width - 3, Height - 32 - 4); - lIndex := FTabs.IndexOfObject(ATabSheet);; - lTabHeight := TCDCustomTabControlDrawer(FCurrentDrawer).GetTabHeight(lIndex); - ATabSheet.BorderSpacing.Top := lTabHeight; - ATabSheet.BorderSpacing.Left := 2; - ATabSheet.BorderSpacing.Right := 3; - ATabSheet.BorderSpacing.Bottom := 3; - ATabSheet.Align := alClient; -end; - -function TCDPageControl.GetActivePage: TCDTabSheet; -begin - Result := GetPage(FTabIndex); -end; - -function TCDPageControl.GetPageCount: integer; -begin - Result := FTabs.Count; -end; - -function TCDPageControl.GetPageIndex: integer; -begin - Result := FTabIndex; -end; - end.