mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-05 20:12:42 +02:00
3101 lines
85 KiB
ObjectPascal
3101 lines
85 KiB
ObjectPascal
{
|
|
Copyright (C) 2010 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 customdrawnextras;
|
|
|
|
{$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
|
|
|
|
// commented items are not yet supported
|
|
TBitmappedButtonOption = (bboUseImageForSelection
|
|
{bboUseImageForMouseOver, bboDrawFocusRectangle,}
|
|
(*bboCheckable,*));
|
|
|
|
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)
|
|
private
|
|
FOnChange: TNotifyEvent;
|
|
BmpBuffer: TBitmap;
|
|
StrBuffer: TStringList;
|
|
protected
|
|
FImageBtn: TPicture;
|
|
FImageBtnDown: TPicture;
|
|
FImageBtnMouseOver: TPicture;
|
|
FImageBtnFocused: TPicture;
|
|
FImageBtnChecked: TPicture;
|
|
FOptions: TBitmappedButtonOptions;
|
|
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();
|
|
// inherited
|
|
procedure RealSetText(const Value: TCaption); override;
|
|
protected
|
|
// Properties
|
|
property ImageBtn: TPicture read FImageBtn;
|
|
property ImageBtnDown: TPicture read FImageBtnDown;
|
|
property ImageBtnFocused: TPicture read FImageBtnFocused;
|
|
property Options: TBitmappedButtonOptions read FOptions write FOptions;
|
|
// Events
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure EraseBackground(DC: HDC); override;
|
|
procedure Paint; override;
|
|
function GetStateBitmap(): TBitmap;
|
|
end;
|
|
|
|
{@@
|
|
TBitmappedButton is a simple custom drawn button which bases it's drawing
|
|
on provided raster images. Currently the following states are supported:
|
|
normal, down and focused.
|
|
|
|
The Caption of this button may have multiple lines of text, separated by any
|
|
line separator. The text is drawn centralized in the button.
|
|
|
|
Some work was done trying to achieve alpha blending for the button, but this
|
|
wasn't successfull. It would work like this: The button may be drawn flat
|
|
or alpha blended using a separate image for the Alpha channel. While pixels
|
|
in the alpha channel will result in the button pixel being fully drawn,
|
|
while black pixels represent pixels which aren't drawn. grey pixels are
|
|
alpha blended.
|
|
}
|
|
|
|
TBitmappedButton = class(TCustomBitmappedButton)
|
|
published
|
|
// LCL properties and events
|
|
property Action;
|
|
property Anchors;
|
|
property AnchorSide;
|
|
// property BidiMode;
|
|
// property BorderSpacing;
|
|
// property Cancel;
|
|
property Caption;
|
|
property Constraints;
|
|
// property Default;
|
|
// property DragCursor;
|
|
// property DragKind;
|
|
// property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
// property ParentBidiMode;
|
|
// property ModalResult;
|
|
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;
|
|
// Specific properties
|
|
property ImageBtn;
|
|
property ImageBtnDown;
|
|
property ImageBtnFocused;
|
|
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;
|
|
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);
|
|
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 = class(TCustomControl)
|
|
private
|
|
FIndex: integer;
|
|
CDTabControl: TCDCustomTabControl;
|
|
end;
|
|
|
|
TCDCustomTabControl = class(TCDControl)
|
|
private
|
|
FTabIndex: Integer;
|
|
FTabs: TStringList;
|
|
FDrawerWinCE: TCDCustomTabControlDrawerWinCE;
|
|
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;
|
|
protected
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Paint; override;
|
|
public
|
|
CustomDrawer: TCDCustomTabControlDrawer; // Fill the field to use the dsCustom draw mode
|
|
property Tabs: TStringList read FTabs;
|
|
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;
|
|
|
|
TCDTabSheet = class;
|
|
|
|
TTabItem = class(TCollectionItem)
|
|
private
|
|
FTitle: string;
|
|
FSelected: boolean;
|
|
FData: TObject;
|
|
FModified: boolean;
|
|
FImageIndex: TImageIndex;
|
|
FWidth: integer;
|
|
FTabPage: TCDTabSheet;
|
|
procedure SetSelected(Value: boolean);
|
|
procedure SetModified(Value: boolean);
|
|
procedure DoChange;
|
|
procedure SetTitle(Value: string);
|
|
procedure SetImageIndex(Value: TImageIndex);
|
|
protected
|
|
FStartPos: integer;
|
|
FSize: integer;
|
|
function GetDisplayName: string; override;
|
|
public
|
|
constructor Create(aCollection: TCollection); override;
|
|
destructor Destroy; override;
|
|
property Data: TObject read FData write FData;
|
|
published
|
|
property Width: integer read FWidth write FWidth;
|
|
property Title: string read FTitle write SetTitle;
|
|
property Selected: boolean read FSelected write SetSelected;
|
|
property Modified: boolean read Fmodified write SetModified;
|
|
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
|
|
property TabPage: TCDTabSheet read FTabPage write FTabPage;
|
|
end;
|
|
|
|
TTabItemList = class(TCollection)
|
|
protected
|
|
procedure DoSelected(ATab: TTabItem; ASelected: boolean); dynamic;
|
|
procedure DoChanged(ATab: TTabItem); dynamic;
|
|
procedure SetItem(Index: integer; Value: TTabItem);
|
|
function GetItem(Index: integer): TTabItem;
|
|
public
|
|
function IndexOf(ATab: TTabItem): integer;
|
|
function Add: TTabItem;
|
|
property Items[Index: integer]: TTabItem read GetItem write SetItem; default;
|
|
end;
|
|
|
|
TTabSelectedEvent = procedure(Sender: TObject; ATab: TTabItem;
|
|
ASelected: boolean) of object;
|
|
|
|
TCDTabControl = class(TCDCustomTabControl)
|
|
published
|
|
property Color;
|
|
property Font;
|
|
property TabIndex: integer read FTabIndex write SetTabIndex;
|
|
property Tabs: TStringList read FTabs;
|
|
// property OnTabSelected: TTabSelectedEvent read fOnTabSelected write fOnTabSelected;
|
|
end;
|
|
|
|
{ TCDTabSheet }
|
|
|
|
TCDPageControl = class;
|
|
|
|
TCDTabSheet = class(TCustomControl)
|
|
private
|
|
FIndex: integer;
|
|
public
|
|
StoredWidth: Integer;
|
|
CDPageControl: TCDPageControl;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure EraseBackground(DC: HDC); override;
|
|
procedure Paint; override;
|
|
published
|
|
property Caption;
|
|
property Color;
|
|
property Font;
|
|
property Index: integer read FIndex write FIndex;
|
|
end;
|
|
|
|
{ TCDPageControl }
|
|
|
|
TCDPageControlDrawer = class;
|
|
TCDPageControlDrawerWinCE = class;
|
|
|
|
{ TCDPageControlEditor }
|
|
|
|
TCDPageControlEditor = class(TDefaultComponentEditor)
|
|
procedure ShowPageMenuItemClick(Sender: TObject);
|
|
public
|
|
procedure ExecuteVerb(Index: integer); override;
|
|
function GetVerb(Index: integer): string; override;
|
|
function GetVerbCount: integer; override;
|
|
procedure PrepareItem(Index: integer; const AnItem: TMenuItem); override;
|
|
procedure AddMenuItemsForPages(ParentMenuItem: TMenuItem); virtual;
|
|
function PControl: TCDPageControl; virtual;
|
|
end;
|
|
|
|
TCDPageControl = class(TCDControl)
|
|
private
|
|
FActivePage: TCDTabSheet;
|
|
//FCurrentDrawer: TCDPageControlDrawer;
|
|
FDrawerWinCE: TCDPageControlDrawerWinCE;
|
|
FPages: TTabItemList;
|
|
FMDownL, FMDownR: boolean;
|
|
FMEnterL, FMEnterR: boolean;
|
|
FPageIndex: integer; //FPageCount
|
|
function GetPageCount: integer;
|
|
procedure SetDrawStyle(AValue: TCDDrawStyle);
|
|
procedure SetMouseUP;
|
|
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 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;
|
|
procedure Paint; override;
|
|
function FindNextPage(CurPage: TCDTabSheet;
|
|
GoForward, CheckTabVisible: boolean): TCDTabSheet;
|
|
procedure SelectNextPage(GoForward: boolean; CheckTabVisible: boolean = True);
|
|
procedure SetCDPages(Value: TTabItemList);
|
|
public
|
|
CustomDrawer: TCDPageControlDrawer; // Fill the field to use the dsCustom draw mode
|
|
procedure InsertPage(aIndex: integer; S: string);
|
|
procedure RemovePage(aIndex: integer);
|
|
procedure AddPage(S: string);
|
|
function GetPage(aIndex: integer): TCDTabSheet;
|
|
published
|
|
property ActivePage: TCDTabSheet read FActivePage write SetActivePage;
|
|
property DrawStyle: TCDDrawStyle read FDrawStyle write SetDrawStyle;
|
|
property Caption;
|
|
property Color;
|
|
property Font;
|
|
//property PageCount: integer read FPageCount;
|
|
property PageIndex: integer read FPageIndex write SetPageIndex;
|
|
property Pages: TTabItemList read FPages write SetCDPages;
|
|
property PageCount: integer read GetPageCount;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property TabStop default True;
|
|
end;
|
|
|
|
{ TCDTrackBarDrawer }
|
|
|
|
TCDPageControlDrawer = class(TCDControlDrawer)
|
|
public
|
|
CDPageControl: TCDPageControl;
|
|
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; ATabSheet: TCDTabSheet); virtual; abstract;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: integer); virtual; abstract;
|
|
end;
|
|
|
|
{ TCDPageControlDrawerWinCE }
|
|
|
|
TCDPageControlDrawerWinCE = class(TCDPageControlDrawer)
|
|
private
|
|
StartIndex: integer; //FEndIndex
|
|
LeftmostTabVisibleIndex: Integer;
|
|
procedure DrawTabs(ADest: TCanvas);
|
|
procedure DrawTab(ADest: TCanvas; AIndex: Integer; ACurStartLeftPos: Integer; ACurPage: TCDTabSheet);
|
|
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; ATabSheet: TCDTabSheet); override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: integer); override;
|
|
end;
|
|
|
|
procedure Register;
|
|
function CheckTabButton(RWidth: integer; aItem: TTabItemList): boolean;
|
|
|
|
implementation
|
|
|
|
uses
|
|
ObjInspStrConsts;
|
|
|
|
const
|
|
INT_BitmappedButton_LineSpacing = 2;
|
|
MaskBaseColor = $00111111;
|
|
|
|
resourcestring
|
|
sTABSHEET_DEFAULT_NAME = 'CTabSheet';
|
|
sNEXT_PAGE = 'Ne&xt Page';
|
|
sPREV_PAGE = '&Previouse Page';
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('Common Controls', [TCDButton, TCDTrackBar, TCDTabControl,
|
|
TCDPageControl, TCDGroupBox]);
|
|
RegisterComponentEditor(TCDPageControl, TCDPageControlEditor);
|
|
RegisterComponentEditor(TCDTabSheet, TCDPageControlEditor);
|
|
RegisterNoIcon([TCDTabSheet]);
|
|
RegisterClasses([TCDTabSheet]);
|
|
end;
|
|
|
|
function CheckTabButton(RWidth: integer; aItem: TTabItemList): boolean;
|
|
var
|
|
i, j: integer;
|
|
begin
|
|
Result := False;
|
|
j := 0;
|
|
for i := 0 to aItem.Count - 1 do
|
|
begin
|
|
j := j + aItem[i].Width;
|
|
if j > RWidth - 6 then
|
|
begin
|
|
Result := True;
|
|
break;
|
|
end;
|
|
end;
|
|
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);
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TCDCustomTabControlDrawerWinCE.DrawToCanvas(ADest: TCanvas);
|
|
var
|
|
CaptionHeight: Integer;
|
|
lColor: TColor;
|
|
begin
|
|
CaptionHeight := GetTabHeight(CDTabControl.FTabIndex);
|
|
|
|
if CDTabControl.Color = clDefault then lColor := clSilver
|
|
else lColor := ColorToRGB(CDTabControl.Color);
|
|
|
|
// Background
|
|
ADest.Brush.Color := lColor;
|
|
ADest.Brush.Style := bsSolid;
|
|
ADest.Pen.Style := psClear;
|
|
ADest.Rectangle(0, 0, CDTabControl.Width, CDTabControl.Height);
|
|
|
|
// Frame detail
|
|
ADest.Pixels[CDTabControl.Width - 1, CaptionHeight] := lColor;
|
|
|
|
// frame
|
|
ADest.Pen.Style := psSolid;
|
|
ADest.Brush.Style := bsClear;
|
|
ADest.Pen.Color := ColorToRGB($009C9B91);
|
|
|
|
if CDTabControl.Tabs.Count = 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
|
|
CDTabControl.SetTabIndex(i);
|
|
Exit;
|
|
end;
|
|
CurStartLeftPos := CurStartLeftPos + lTabWidth;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TCDCustomTabControl }
|
|
|
|
procedure TCDCustomTabControl.MouseDown(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: integer);
|
|
begin
|
|
TCDPageControlDrawer(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;
|
|
FTabIndex := AValue;
|
|
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 + [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;
|
|
|
|
{ TCustomBitmappedButton }
|
|
|
|
procedure TCustomBitmappedButton.DoEnter;
|
|
begin
|
|
DoButtonUp();
|
|
|
|
inherited DoEnter;
|
|
end;
|
|
|
|
procedure TCustomBitmappedButton.DoExit;
|
|
begin
|
|
DoButtonUp();
|
|
|
|
inherited DoExit;
|
|
end;
|
|
|
|
procedure TCustomBitmappedButton.KeyDown(var Key: word; Shift: TShiftState);
|
|
begin
|
|
inherited KeyDown(Key, Shift);
|
|
|
|
if Key = VK_SPACE then
|
|
DoButtonDown();
|
|
end;
|
|
|
|
procedure TCustomBitmappedButton.KeyUp(var Key: word; Shift: TShiftState);
|
|
begin
|
|
DoButtonUp();
|
|
|
|
inherited KeyUp(Key, Shift);
|
|
end;
|
|
|
|
procedure TCustomBitmappedButton.MouseDown(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: integer);
|
|
begin
|
|
DoButtonDown();
|
|
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TCustomBitmappedButton.MouseUp(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: integer);
|
|
begin
|
|
DoButtonUp();
|
|
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TCustomBitmappedButton.MouseEnter;
|
|
begin
|
|
inherited MouseEnter;
|
|
end;
|
|
|
|
procedure TCustomBitmappedButton.MouseLeave;
|
|
begin
|
|
inherited MouseLeave;
|
|
end;
|
|
|
|
procedure TCustomBitmappedButton.DoButtonDown();
|
|
var
|
|
NewState: TBitmappedButtonState;
|
|
begin
|
|
NewState := bbsDown;
|
|
|
|
case FState of
|
|
bbsNormal, bbsFocused: NewState := bbsDown;
|
|
// bbsChecked, bbsCheckedSelected: NewState := bbsCheckedDown;
|
|
end;
|
|
|
|
if NewState <> FState then
|
|
begin
|
|
FState := NewState;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomBitmappedButton.DoButtonUp();
|
|
var
|
|
NewState: TBitmappedButtonState;
|
|
begin
|
|
if Focused then
|
|
NewState := bbsFocused
|
|
else
|
|
NewState := bbsNormal;
|
|
|
|
{ case FState of
|
|
bbsCheckedDown:
|
|
begin
|
|
if Focused then NewState := bbsCheckedSelected
|
|
else NewState := bbsChecked;
|
|
end;
|
|
end;}
|
|
|
|
if NewState <> FState then
|
|
begin
|
|
FState := NewState;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomBitmappedButton.RealSetText(const Value: TCaption);
|
|
begin
|
|
inherited RealSetText(Value);
|
|
|
|
// Makes sure that caption changes are drawn
|
|
Invalidate;
|
|
end;
|
|
|
|
constructor TCustomBitmappedButton.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
BmpBuffer := TBitmap.Create;
|
|
StrBuffer := TStringList.Create;
|
|
|
|
FImageBtn := TPicture.Create;
|
|
FImageBtnDown := TPicture.Create;
|
|
FImageBtnMouseOver := TPicture.Create;
|
|
FImageBtnFocused := TPicture.Create;
|
|
FImageBtnChecked := TPicture.Create;
|
|
|
|
FOptions := [{bboDrawSelectionRectangle}];
|
|
|
|
TabStop := True;
|
|
end;
|
|
|
|
destructor TCustomBitmappedButton.Destroy;
|
|
begin
|
|
if Assigned(FImageBtn) then
|
|
FImageBtn.Free;
|
|
if Assigned(FImageBtnDown) then
|
|
FImageBtnDown.Free;
|
|
if Assigned(FImageBtnMouseOver) then
|
|
FImageBtnMouseOver.Free;
|
|
if Assigned(FImageBtnFocused) then
|
|
FImageBtnFocused.Free;
|
|
if Assigned(FImageBtnChecked) then
|
|
FImageBtnChecked.Free;
|
|
|
|
BmpBuffer.Free;
|
|
StrBuffer.Free;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TCustomBitmappedButton.EraseBackground(DC: HDC);
|
|
begin
|
|
// The correct implementation is doing nothing
|
|
end;
|
|
|
|
procedure TCustomBitmappedButton.Paint;
|
|
var
|
|
lTextX, lTextY, lTextCX, lTextCY, lTmp, lTextHeightPlusLineSpacing: integer;
|
|
i: integer;
|
|
begin
|
|
// First draw the button image
|
|
BmpBuffer.Width := Width;
|
|
BmpBuffer.Height := Height;
|
|
BmpBuffer.Canvas.Draw(0, 0, GetStateBitmap());
|
|
|
|
// Now measure the text position
|
|
|
|
BmpBuffer.Canvas.Font.Assign(Self.Font);
|
|
BmpBuffer.Canvas.Brush.Style := bsClear;
|
|
|
|
StrBuffer.Text := Caption;
|
|
|
|
lTextCX := 0;
|
|
for i := 0 to StrBuffer.Count - 1 do
|
|
begin
|
|
lTmp := BmpBuffer.Canvas.TextWidth(StrBuffer.Strings[i]);
|
|
lTextCX := Max(lTextCX, lTmp);
|
|
end;
|
|
|
|
lTextHeightPlusLineSpacing :=
|
|
BmpBuffer.Canvas.TextHeight(Caption) + INT_BitmappedButton_LineSpacing;
|
|
lTextCY := BmpBuffer.Canvas.TextHeight(Caption) * StrBuffer.Count +
|
|
INT_BitmappedButton_LineSpacing * (StrBuffer.Count - 1);
|
|
|
|
lTextX := Width div 2 - lTextCX div 2;
|
|
lTextY := Height div 2 - lTextCY div 2;
|
|
|
|
// Draw the text
|
|
|
|
for i := 0 to StrBuffer.Count - 1 do
|
|
begin
|
|
BmpBuffer.Canvas.TextOut(lTextX, lTextY + lTextHeightPlusLineSpacing * i,
|
|
StrBuffer.Strings[i]);
|
|
end;
|
|
|
|
// And flush the buffer to the screen
|
|
Canvas.Draw(0, 0, BmpBuffer);
|
|
end;
|
|
|
|
function TCustomBitmappedButton.GetStateBitmap(): TBitmap;
|
|
begin
|
|
case FState of
|
|
bbsDown: Result := FImageBtnDown.Bitmap;
|
|
// bbsMouseOver: Result := FImageBtnMouseOver;
|
|
bbsFocused:
|
|
begin
|
|
if bboUseImageForSelection in Options then
|
|
Result := FImageBtnFocused.Bitmap
|
|
else
|
|
Result := FImageBtn.Bitmap;
|
|
end;
|
|
// bbsChecked: Result := FImageBtnChecked;
|
|
else
|
|
Result := FImageBtn.Bitmap;
|
|
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
|
|
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;
|
|
|
|
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;
|
|
|
|
// 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;
|
|
|
|
{TCDTabControlItemList}
|
|
|
|
constructor TTabItem.Create(aCollection: TCollection);
|
|
begin
|
|
inherited Create(ACollection);
|
|
fImageIndex := -1;
|
|
end;
|
|
|
|
destructor TTabItem.Destroy;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
procedure TTabItem.SetModified(Value: boolean);
|
|
begin
|
|
if fModified <> Value then
|
|
begin
|
|
fModified := Value;
|
|
DoChange;
|
|
end;
|
|
end;
|
|
|
|
procedure TTabItem.SetSelected(Value: boolean);
|
|
var
|
|
i: integer;
|
|
begin
|
|
if FSelected <> Value then
|
|
begin
|
|
FSelected := Value;
|
|
if FSelected then
|
|
begin
|
|
with (GetOwner as TTabItemList) do
|
|
begin
|
|
for i := 0 to Count - 1 do
|
|
begin
|
|
if (Items[i] <> Self) and (Items[i].Selected) then
|
|
begin
|
|
Items[i].Selected := False;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
(Collection as TTabItemList).DoSelected(Self, FSelected);
|
|
end;
|
|
end;
|
|
|
|
function TTabItem.GetDisplayName: string;
|
|
begin
|
|
{if FCaption <> '' then
|
|
Result := FCaption
|
|
else }
|
|
Result := inherited GetDisplayName;
|
|
end;
|
|
|
|
procedure TTabItem.DoChange;
|
|
begin
|
|
(Collection as TTabItemList).DoChanged(Self);
|
|
end;
|
|
|
|
procedure TTabItem.SetTitle(Value: string);
|
|
begin
|
|
if FTitle <> Value then
|
|
begin
|
|
FTitle := Value;
|
|
//DoChange;
|
|
end;
|
|
end;
|
|
|
|
procedure TTabItem.SetImageIndex(Value: TImageIndex);
|
|
begin
|
|
if FImageIndex <> Value then
|
|
begin
|
|
FImageIndex := Value;
|
|
DoChange;
|
|
end;
|
|
end;
|
|
|
|
{ TTabItemList }
|
|
|
|
procedure TTabItemList.DoSelected(ATab: TTabItem; ASelected: boolean);
|
|
begin
|
|
// (GetOwner as TCDPageControl).TabSelected(ATab, ASelected);
|
|
end;
|
|
|
|
procedure TTabItemList.DoChanged(ATab: TTabItem);
|
|
begin
|
|
(GetOwner as TCDPageControl).Invalidate;
|
|
end;
|
|
|
|
procedure TTabItemList.SetItem(Index: integer; Value: TTabItem);
|
|
begin
|
|
inherited SetItem(Index, Value);
|
|
end;
|
|
|
|
function TTabItemList.GetItem(Index: integer): TTabItem;
|
|
begin
|
|
Result := inherited GetItem(Index) as TTabItem;
|
|
end;
|
|
|
|
function TTabItemList.IndexOf(ATab: TTabItem): integer;
|
|
var
|
|
i, c: integer;
|
|
begin
|
|
c := Count;
|
|
for i := 0 to c - 1 do
|
|
if Items[i] = ATab then
|
|
begin
|
|
Result := i;
|
|
Exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TTabItemList.Add: TTabItem;
|
|
begin
|
|
Result := TTabItem(inherited add);
|
|
Result.Title := 'Title' + IntToStr(Count - 1);
|
|
end;
|
|
|
|
{ TCDTabSheet }
|
|
|
|
constructor TCDTabSheet.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
//Parent := TCDPageControl(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
|
|
inherited Paint;
|
|
|
|
if CDPageControl <> nil then
|
|
begin
|
|
TCDPageControlDrawer(CDPageControl.FCurrentDrawer).DrawTabSheet(Canvas, Self);
|
|
end;
|
|
end;
|
|
|
|
{ TCDPageControlEditor }
|
|
|
|
procedure TCDPageControlEditor.ShowPageMenuItemClick(Sender: TObject);
|
|
var
|
|
AMenuItem: TMenuItem;
|
|
NewPageIndex: integer;
|
|
begin
|
|
AMenuItem := TMenuItem(Sender);
|
|
if (AMenuItem = nil) or (not (AMenuItem is TMenuItem)) then
|
|
exit;
|
|
NewPageIndex := AMenuItem.MenuIndex;
|
|
if (NewPageIndex < 0) or (NewPageIndex >= PControl.PageCount) then
|
|
exit;
|
|
PControl.PageIndex := NewPageIndex;
|
|
GetDesigner.SelectOnlyThisComponent(PControl.Pages[PControl.PageIndex].TabPage);
|
|
end;
|
|
|
|
procedure TCDPageControlEditor.ExecuteVerb(Index: integer);
|
|
var
|
|
NewPage: TCDTabSheet;
|
|
Hook: TPropertyEditorHook;
|
|
PageComponent: TPersistent;
|
|
OldPage: longint;
|
|
begin
|
|
if not GetHook(Hook) then
|
|
exit;
|
|
|
|
case Index of
|
|
0:
|
|
begin // New Page
|
|
PControl.AddPage('');
|
|
NewPage := PControl.ActivePage;
|
|
Hook.PersistentAdded(NewPage, True);
|
|
Designer.Modified;
|
|
//Hook.PersistentAdded(NewPage,true);
|
|
//Designer.Modified;
|
|
end;
|
|
1:
|
|
begin // Insert Page
|
|
PControl.InsertPage(PControl.PageIndex, '');
|
|
Hook.PersistentAdded(PControl.ActivePage, True);
|
|
Modified;
|
|
end;
|
|
2:
|
|
begin // Delete Page
|
|
with PControl do
|
|
begin
|
|
NewPage := ActivePage;
|
|
if NewPage = nil then
|
|
Exit;
|
|
RemovePage(NewPage.Index);
|
|
end;
|
|
end;
|
|
3:
|
|
begin // Next Page
|
|
PControl.ActivePage := PControl.FindNextPage(PControl.ActivePage, True, False);
|
|
end;
|
|
4:
|
|
begin // Previous Page
|
|
PControl.ActivePage := PControl.FindNextPage(PControl.ActivePage, False, False);
|
|
end;
|
|
end;
|
|
Modified;
|
|
if Designer <> nil then
|
|
Designer.Modified;
|
|
PControl.Invalidate;
|
|
end;
|
|
|
|
function TCDPageControlEditor.GetVerb(Index: integer): string;
|
|
begin
|
|
case Index of
|
|
0: Result := nbcesAddPage;
|
|
1: Result := nbcesInsertPage;
|
|
2: Result := nbcesDeletePage;
|
|
3: Result := sNEXT_PAGE;
|
|
4: Result := sPREV_PAGE;
|
|
5: Result := nbcesShowPage;
|
|
end;
|
|
end;
|
|
|
|
function TCDPageControlEditor.GetVerbCount: integer;
|
|
begin
|
|
Result := 6;
|
|
end;
|
|
|
|
procedure TCDPageControlEditor.PrepareItem(Index: integer; const AnItem: TMenuItem);
|
|
begin
|
|
inherited PrepareItem(Index, AnItem);
|
|
case Index of
|
|
0: ;
|
|
1: AnItem.Enabled := PControl.PageIndex >= 0;
|
|
2: AnItem.Enabled := PControl.PageIndex >= 0;
|
|
3: AnItem.Enabled := PControl.PageIndex < PControl.PageCount - 1;
|
|
4: AnItem.Enabled := PControl.PageIndex > 0;
|
|
5: AddMenuItemsForPages(AnItem);
|
|
end;
|
|
end;
|
|
|
|
procedure TCDPageControlEditor.AddMenuItemsForPages(ParentMenuItem: TMenuItem);
|
|
var
|
|
i: integer;
|
|
NewMenuItem: TMenuItem;
|
|
TabPage: TCDTabSheet;
|
|
begin
|
|
ParentMenuItem.Enabled := PControl.PageCount > 0;
|
|
for i := 0 to PControl.PageCount - 1 do
|
|
begin
|
|
TabPage := PControl.Pages.Items[i].TabPage;
|
|
NewMenuItem := TMenuItem.Create(ParentMenuItem);
|
|
NewMenuItem.Name := 'ShowPage' + IntToStr(i);
|
|
NewMenuItem.Caption := TabPage.Name + ' "' + TabPage.Caption + '"';
|
|
NewMenuItem.OnClick := @ShowPageMenuItemClick;
|
|
ParentMenuItem.Add(NewMenuItem);
|
|
end;
|
|
end;
|
|
|
|
function TCDPageControlEditor.PControl: TCDPageControl;
|
|
begin
|
|
if Component is TCDPageControl then
|
|
Result := TCDPageControl(Component)
|
|
else if Component is TCDTabSheet then
|
|
Result := TCDPageControl(TCDTabSheet(Component).Parent);
|
|
end;
|
|
|
|
{ TCDPageControl }
|
|
|
|
procedure TCDPageControl.AddPage(S: string);
|
|
// InsertPage(FPages.Count, S);
|
|
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);
|
|
|
|
SetActivePage(NewPage);
|
|
|
|
//FPages.AddObject(NewPage.Name, NewPage);
|
|
FPages.Insert(FPages.Count);
|
|
FPages.Items[FPages.Count - 1].DisplayName := NewPage.Name;
|
|
FPages.Items[FPages.Count - 1].TabPage := NewPage;
|
|
NewPage.Index := FPages.Count - 1;
|
|
FPageIndex := FPages.Count - 1;
|
|
//FPageCount := PageCount + 1;
|
|
enD;
|
|
|
|
function TCDPageControl.GetPage(aIndex: integer): TCDTabSheet;
|
|
begin
|
|
Result := FPages[aIndex].TabPage;
|
|
end;
|
|
|
|
procedure TCDPageControl.InsertPage(aIndex: integer; S: string);
|
|
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);
|
|
|
|
SetActivePage(NewPage);
|
|
|
|
//FPages.AddObject(NewPage.Name, NewPage);
|
|
FPages.Insert(aIndex);
|
|
FPages.Items[aIndex].DisplayName := NewPage.Name;
|
|
FPages.Items[aIndex].TabPage := NewPage;
|
|
NewPage.Index := FPages.Count - 1;
|
|
FPageIndex := aIndex;
|
|
//FPageCount := PageCount + 1;
|
|
end;
|
|
|
|
procedure TCDPageControl.RemovePage(aIndex: integer);
|
|
begin
|
|
if aIndex > 0 then
|
|
PageIndex := aIndex - 1
|
|
else
|
|
Exit;
|
|
{if not GetHook(Hook) then
|
|
exit;
|
|
PageComponent := TPersistent(NewPage);
|
|
Hook.DeletePersistent(PageComponent); }
|
|
//if NewPage <> nil then
|
|
// NewPage.Free;
|
|
Application.ReleaseComponent(FPages[aIndex].TabPage);
|
|
//Owner.RemoveComponent(FPages[aIndex].TabPage);
|
|
//FPages[aIndex].TabPage := nil;
|
|
FPages.Delete(aIndex);
|
|
//Owner.RemoveComponent(NewPage);
|
|
//if PControl.PageCount > 1 then
|
|
// PControl.FPageCount := PControl.PageCount - 1;
|
|
end;
|
|
|
|
procedure TCDPageControl.PrepareCurrentDrawer();
|
|
begin
|
|
case DrawStyle of
|
|
dsWince: FCurrentDrawer := FDrawerWinCE;
|
|
dsCustom: FCurrentDrawer := CustomDrawer;
|
|
end;
|
|
end;
|
|
|
|
function TCDPageControl.FindNextPage(CurPage: TCDTabSheet;
|
|
GoForward, CheckTabVisible: boolean): TCDTabSheet;
|
|
var
|
|
I, TempStartIndex: integer;
|
|
begin
|
|
if FPages.Count <> 0 then
|
|
begin
|
|
//StartIndex := FPages.IndexOfObject(CurPage);
|
|
TempStartIndex := CurPage.Index;
|
|
if TempStartIndex = -1 then
|
|
if GoForward then
|
|
TempStartIndex := FPages.Count - 1
|
|
else
|
|
TempStartIndex := 0;
|
|
I := TempStartIndex;
|
|
repeat
|
|
if GoForward then
|
|
begin
|
|
Inc(I);
|
|
if I = FPages.Count then
|
|
I := 0;
|
|
end
|
|
else
|
|
begin
|
|
if I = 0 then
|
|
I := FPages.Count;
|
|
Dec(I);
|
|
end;
|
|
Result := FPages[I].TabPage;
|
|
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);
|
|
|
|
Width := 232;
|
|
Height := 184;
|
|
TabStop := True;
|
|
|
|
FDrawerWinCE := TCDPageControlDrawerWinCE.Create;
|
|
TCDPageControlDrawer(FDrawerWinCE).CDPageControl := Self;
|
|
CustomDrawer := FDrawerWinCE; // Dummy to avoid designer crashes
|
|
FDrawStyle := dsWinCE;
|
|
|
|
ParentColor := True;
|
|
ParentFont := True;
|
|
ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks, csDesignInteractive];
|
|
FPages := TTabItemList.Create(TTabItem);
|
|
end;
|
|
|
|
destructor TCDPageControl.Destroy;
|
|
begin
|
|
FPages.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TCDPageControl.SetActivePage(Value: TCDTabSheet);
|
|
var
|
|
i: integer;
|
|
CurPage: TCDTabSheet;
|
|
begin
|
|
for i := 0 to FPages.Count - 1 do
|
|
begin
|
|
CurPage := FPages[i].TabPage;
|
|
if CurPage = Value then
|
|
begin
|
|
PositionTabSheet(CurPage);
|
|
CurPage.BringToFront;
|
|
|
|
// Check first, Tab is Visible?
|
|
FPageIndex := i;
|
|
end
|
|
else
|
|
begin
|
|
CurPage.Align := alNone;
|
|
CurPage.Height := 0;
|
|
end;
|
|
end;
|
|
FActivePage := Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCDPageControl.SetPageIndex(Value: integer);
|
|
begin
|
|
if (Value > -1) and (Value < FPages.Count) then
|
|
begin
|
|
FPageIndex := Value;
|
|
ActivePage := FPages[Value].TabPage;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCDPageControl.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
|
|
TCDPageControlDrawer(FCurrentDrawer).DrawToIntfImage(lCanvas, AImage);
|
|
ABmp.LoadFromIntfImage(AImage);
|
|
ABmp.Canvas.Font.Assign(Font);
|
|
// Second step of the drawing: LCL TCustomCanvas for easy font access
|
|
TCDPageControlDrawer(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;
|
|
|
|
procedure TCDPageControl.SetCDPages(Value: TTabItemList);
|
|
begin
|
|
FPages.Assign(Value);
|
|
end;
|
|
|
|
procedure TCDPageControl.UpdateAllDesignerFlags;
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to FPages.Count - 1 do
|
|
UpdateDesignerFlags(i);
|
|
end;
|
|
|
|
procedure TCDPageControl.UpdateDesignerFlags(APageIndex: integer);
|
|
begin
|
|
if APageIndex <> fPageIndex then
|
|
FPages[APageIndex].TabPage.ControlStyle :=
|
|
FPages[APageIndex].TabPage.ControlStyle + [csNoDesignVisible]
|
|
else
|
|
FPages[APageIndex].TabPage.ControlStyle :=
|
|
FPages[APageIndex].TabPage.ControlStyle - [csNoDesignVisible];
|
|
end;
|
|
|
|
procedure TCDPageControl.PositionTabSheet(ATabSheet: TCDTabSheet);
|
|
begin
|
|
ATabSheet.SetBounds(1, 32 + 1, Width - 3, Height - 32 - 4);
|
|
ATabSheet.BorderSpacing.Top := 32 + 2;
|
|
ATabSheet.BorderSpacing.Left := 2;
|
|
ATabSheet.BorderSpacing.Right := 3;
|
|
ATabSheet.BorderSpacing.Bottom := 3;
|
|
ATabSheet.Align := alClient;
|
|
end;
|
|
|
|
procedure TCDPageControl.SetMouseUP;
|
|
begin
|
|
FMDownL := False;
|
|
FMDownR := False;
|
|
end;
|
|
|
|
function TCDPageControl.GetPageCount: integer;
|
|
begin
|
|
Result := FPages.Count;
|
|
end;
|
|
|
|
procedure TCDPageControl.SetDrawStyle(AValue: TCDDrawStyle);
|
|
begin
|
|
if FDrawStyle=AValue then Exit;
|
|
FDrawStyle:=AValue;
|
|
end;
|
|
|
|
procedure TCDPageControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: integer);
|
|
begin
|
|
TCDPageControlDrawer(FCurrentDrawer).MouseDown(Button, Shift, X, Y);
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
end;
|
|
|
|
{ TCDPageControlDrawerWinCE }
|
|
|
|
procedure TCDPageControlDrawerWinCE.DrawTabs(ADest: TCanvas);
|
|
var
|
|
CurVisibleIndex: Integer = 0;
|
|
IsPainting: Boolean = False;
|
|
CurPage: TCDTabSheet;
|
|
CurStartLeftPos: Integer = 0;
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to CDPageControl.Pages.Count - 1 do
|
|
begin
|
|
CurPage := CDPageControl.GetPage(i);
|
|
if CurPage.Visible then
|
|
begin
|
|
if CurVisibleIndex = LeftmostTabVisibleIndex then
|
|
IsPainting := True;
|
|
|
|
if IsPainting then
|
|
begin
|
|
DrawTab(ADest, i, CurStartLeftPos, CurPage);
|
|
CurStartLeftPos := CurStartLeftPos + GetTabWidth(ADest, i);
|
|
end;
|
|
|
|
Inc(CurVisibleIndex);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCDPageControlDrawerWinCE.DrawTab(ADest: TCanvas; AIndex: Integer;
|
|
ACurStartLeftPos: Integer; ACurPage: TCDTabSheet);
|
|
var
|
|
IsSelected: Boolean;
|
|
lTabWidth, lTabHeight, lTabTopPos: Integer;
|
|
Points: array of TPoint;
|
|
begin
|
|
IsSelected := CDPageControl.ActivePage = ACurPage;
|
|
|
|
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
|
|
ADest.TextOut(ACurStartLeftPos+5, lTabTopPos+5, ACurPage.Caption);
|
|
end;
|
|
|
|
function TCDPageControlDrawerWinCE.GetPageIndexFromXY(x, y: integer): integer;
|
|
begin
|
|
Result := 1;
|
|
//if MaskHeadBmp.Canvas.Pixels[x, y] = clWhite then
|
|
// Result := -1
|
|
//else
|
|
// Result := MaskHeadBmp.Canvas.Pixels[x, y] - MaskBaseColor + StartIndex;
|
|
//if (PageIndex <> Result) and (PageIndex > -1) then
|
|
// PageIndex := Result;
|
|
end;
|
|
|
|
function TCDPageControlDrawerWinCE.GetTabHeight(AIndex: Integer): Integer;
|
|
//var
|
|
// CurPage: TCDTabSheet;
|
|
begin
|
|
//CurPage := CDPageControl.GetPage(AIndex);
|
|
if CDPageControl.Font.Size = 0 then
|
|
Result := 32
|
|
else
|
|
Result := CDPageControl.Font.Size + 22;
|
|
end;
|
|
|
|
function TCDPageControlDrawerWinCE.GetTabWidth(ADest: TCanvas; AIndex: Integer): Integer;
|
|
const
|
|
TCDPageControl_WinCE_TabCaptionExtraWidth = 20;
|
|
var
|
|
CurPage: TCDTabSheet;
|
|
begin
|
|
CurPage := CDPageControl.GetPage(AIndex);
|
|
if ADest <> nil then
|
|
begin
|
|
Result := ADest.TextWidth(CurPage.Caption) + TCDPageControl_WinCE_TabCaptionExtraWidth;
|
|
CurPage.StoredWidth := Result;
|
|
end
|
|
else
|
|
Result := CurPage.StoredWidth;
|
|
end;
|
|
|
|
function TCDPageControlDrawerWinCE.GetClientRect(AControl: TCDControl): TRect;
|
|
var
|
|
lCaptionHeight: Integer;
|
|
begin
|
|
lCaptionHeight := GetTabHeight(CDPageControl.PageIndex) - 4;
|
|
|
|
Result := Rect(5, lCaptionHeight + 1, CDPageControl.Width - 10,
|
|
CDPageControl.Height - lCaptionHeight - 5);
|
|
end;
|
|
|
|
procedure TCDPageControlDrawerWinCE.DrawToIntfImage(ADest: TFPImageCanvas;
|
|
FPImg: TLazIntfImage);
|
|
begin
|
|
end;
|
|
|
|
procedure TCDPageControlDrawerWinCE.DrawToCanvas(ADest: TCanvas);
|
|
var
|
|
CaptionHeight: Integer;
|
|
lColor: TColor;
|
|
begin
|
|
CaptionHeight := GetTabHeight(CDPageControl.PageIndex);
|
|
|
|
if CDPageControl.Color = clDefault then lColor := clSilver
|
|
else lColor := ColorToRGB(CDPageControl.Color);
|
|
|
|
// Background
|
|
ADest.Brush.Color := lColor;
|
|
ADest.Brush.Style := bsSolid;
|
|
ADest.Pen.Style := psClear;
|
|
ADest.Rectangle(0, 0, CDPageControl.Width, CDPageControl.Height);
|
|
|
|
// Frame detail
|
|
ADest.Pixels[CDPageControl.Width - 1, CaptionHeight] := lColor;
|
|
|
|
// frame
|
|
ADest.Pen.Style := psSolid;
|
|
ADest.Brush.Style := bsClear;
|
|
ADest.Pen.Color := ColorToRGB($009C9B91);
|
|
|
|
if CDPageControl.Pages.Count = 0 then
|
|
ADest.Rectangle(0, 0, CDPageControl.Width - 2, CDPageControl.Height - 2)
|
|
else
|
|
ADest.Rectangle(0, CaptionHeight, CDPageControl.Width - 2, CDPageControl.Height - 2);
|
|
|
|
ADest.Pen.Color := ColorToRGB($00BFCED0);
|
|
ADest.Line(CDPageControl.Width - 1, CaptionHeight + 1,
|
|
CDPageControl.Width - 1, CDPageControl.Height - 1);
|
|
ADest.Line(CDPageControl.Width - 1, CDPageControl.Height - 1, 1,
|
|
CDPageControl.Height - 1);
|
|
|
|
// Tabs
|
|
ADest.Font.Name := CDPageControl.Font.Name;
|
|
ADest.Font.Size := CDPageControl.Font.Size;
|
|
// DrawCaptionBar(ADest, Rect(0, 0, CDPageControl.Width -
|
|
// 2, CaptionHeight + 1), CDPageControl.Color, CDPageControl);
|
|
DrawTabs(ADest);
|
|
end;
|
|
|
|
procedure TCDPageControlDrawerWinCE.DrawTabSheet(ADest: TCanvas; ATabSheet: TCDTabSheet);
|
|
begin
|
|
ADest.Brush.Color := CDPageControl.Color;
|
|
ADest.Brush.Style := bsSolid;
|
|
ADest.Pen.Style := psClear;
|
|
ADest.Rectangle(0, 0, ATabSheet.Width, ATabSheet.Height);
|
|
end;
|
|
|
|
procedure TCDPageControlDrawerWinCE.MouseDown(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: integer);
|
|
var
|
|
i: Integer;
|
|
CurPage: TCDTabSheet;
|
|
CurVisibleIndex: Integer = 0;
|
|
CurStartLeftPos: Integer = 0;
|
|
VisiblePagesStarted: Boolean = False;
|
|
begin
|
|
for i := 0 to CDPageControl.Pages.Count - 1 do
|
|
begin
|
|
CurPage := CDPageControl.GetPage(i);
|
|
if CurPage.Visible then
|
|
begin
|
|
if CurVisibleIndex = LeftmostTabVisibleIndex then
|
|
VisiblePagesStarted := True;
|
|
|
|
if VisiblePagesStarted then
|
|
begin
|
|
if (X > CurStartLeftPos) and
|
|
(X < CurStartLeftPos + GetTabWidth(nil, i)) and
|
|
(Y < GetTabHeight(i)) then
|
|
begin
|
|
CDPageControl.ActivePage := CurPage;
|
|
Exit;
|
|
end;
|
|
CurStartLeftPos := CurStartLeftPos + GetTabWidth(nil, i);
|
|
end;
|
|
|
|
Inc(CurVisibleIndex);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|