mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-06 05:52:36 +02:00
2133 lines
57 KiB
ObjectPascal
2133 lines
57 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, customdrawnutils, contnrs, componenteditors, LMessages, Messages,
|
|
LCLProc, PropEdits,
|
|
// 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 = (dsWinCE, dsAndroid, dsXPTaskBar, 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;
|
|
|
|
|
|
TCDButtonDrawer = class;
|
|
TCDButtonDrawerWinCE = class;
|
|
TCDButtonDrawerAndroid = class;
|
|
TCDButtonDrawerXPTB = class;
|
|
|
|
TCDButton = class(TCustomControl)
|
|
private
|
|
FDrawStyle: TCDDrawStyle;
|
|
FCurrentDrawer: TCDButtonDrawer;
|
|
FDrawerWinCE: TCDButtonDrawerWinCE;
|
|
FDrawerAndroid: TCDButtonDrawerAndroid;
|
|
FDrawerXPTB: TCDButtonDrawerXPTB;
|
|
procedure PrepareCurrentDrawer();
|
|
procedure SetDrawStyle(const AValue: TCDDrawStyle);
|
|
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 EraseBackground(DC: HDC); 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
|
|
public
|
|
procedure SetClientRectPos(CDButton: TCDButton); virtual; abstract;
|
|
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 SetClientRectPos(CDButton: TCDButton); override;
|
|
procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override;
|
|
procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
|
|
FState: TBitmappedButtonState); override;
|
|
end;
|
|
|
|
{ TCDButtonDrawerAndroid }
|
|
TCDButtonDrawerAndroid = class(TCDButtonDrawer)
|
|
public
|
|
procedure SetClientRectPos(CDButton: TCDButton); override;
|
|
procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override;
|
|
procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
|
|
FState: TBitmappedButtonState); override;
|
|
end;
|
|
|
|
TCDButtonDrawerXPTB = class(TCDButtonDrawer)
|
|
public
|
|
procedure SetClientRectPos(CDButton: TCDButton); override;
|
|
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
|
|
FMDown: boolean;
|
|
FMin: integer;
|
|
FMax: integer;
|
|
FPosition: integer;
|
|
FOnChange: TNotifyEvent;
|
|
FCurrentDrawer: TCDTrackBarDrawer;
|
|
FFromColor, FToColor: TColor;
|
|
FStepWidth: integer;
|
|
procedure SetMax(Value: integer);
|
|
procedure SetMin(Value: integer);
|
|
procedure SetPosition(Value: integer);
|
|
procedure SetFromColor(Value: TColor);
|
|
procedure SetToColor(Value: TColor);
|
|
procedure SetStepWidth(Value: 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
|
|
xPosition: integer;
|
|
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 ColorFrom: TColor read FFromColor write SetFromColor;
|
|
property StepWidth: integer read FStepWidth write SetStepWidth;
|
|
property ColorTo: TColor read FToColor write SetToColor;
|
|
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; FromColor, ToColor: TColor; pWidth: integer);
|
|
virtual; abstract;
|
|
end;
|
|
|
|
TCDTrackBarDrawerGraph = class(TCDTrackBarDrawer)
|
|
public
|
|
procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
|
|
CDTrackBar: TCDTrackBar; FromColor, ToColor: TColor; pWidth: integer); override;
|
|
end;
|
|
|
|
{ TCDTabSheet }
|
|
|
|
TCDTabSheetDrawerGraph = class;
|
|
TCDPageControl = class;
|
|
|
|
TCDTabSheet = class(TCustomControl)
|
|
private
|
|
FCurrentDrawer: TCDTabSheetDrawerGraph;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure EraseBackground(DC: HDC); override;
|
|
procedure Paint; override;
|
|
published
|
|
property Caption;
|
|
property Color;
|
|
property Font;
|
|
end;
|
|
|
|
{ TCDTabSheetDrawer }
|
|
|
|
TCDTabSheetDrawer = class
|
|
public
|
|
procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
|
|
CDTrackBar: TCDTabSheet); virtual; abstract;
|
|
end;
|
|
|
|
TCDTabSheetDrawerGraph = class(TCDTabSheetDrawer)
|
|
public
|
|
procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
|
|
CDTabSheet: TCDTabSheet); override;
|
|
end;
|
|
|
|
{ TCDPageControl }
|
|
|
|
TCDPageControlDrawer = class;
|
|
TCDPageControlDrawerWinCE = class;
|
|
|
|
TCDPageControlEditor = class(TDefaultComponentEditor)
|
|
public
|
|
procedure ExecuteVerb(Index: integer); override;
|
|
function GetVerb(Index: integer): string; override;
|
|
function GetVerbCount: integer; override;
|
|
end;
|
|
|
|
TCDPageControl = class(TCustomControl)
|
|
private
|
|
FDrawStyle: TCDDrawStyle;
|
|
FCaptionHeight: integer;
|
|
FActivePage: TCDTabSheet;
|
|
FCurrentDrawer: TCDPageControlDrawer;
|
|
FDrawerWinCE: TCDPageControlDrawerWinCE;
|
|
FGrad: boolean;
|
|
FShowTabs: boolean;
|
|
FPages: TList;
|
|
FMDownL, FMDownR: Boolean;
|
|
FMEnterL, FMEnterR: Boolean;
|
|
FPageIndex: integer;
|
|
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 CNNotify(var Message: TLMNotify); message CN_NOTIFY;
|
|
procedure PrepareCurrentDrawer();
|
|
procedure SetDrawStyle(const AValue: TCDDrawStyle);
|
|
procedure SetCaptionHeight(Value: integer);
|
|
procedure DrawCaptionBar(ADest: TFPImageCanvas; FPImg: TLazIntfImage; lRect: TRect);
|
|
procedure SetPageGradient(Value: boolean);
|
|
procedure SetShowTabs(Value: boolean);
|
|
procedure SetActivePage(Value: TCDTabSheet);
|
|
procedure SetPageIndex(Value: integer);
|
|
procedure UpdateAllDesignerFlags;
|
|
procedure UpdateDesignerFlags(APageIndex: integer);
|
|
protected
|
|
procedure Loaded; override;
|
|
public
|
|
CustomDrawer: TCDPageControlDrawer; // 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;
|
|
procedure DoOnResize; override;
|
|
function FindNextPage(CurPage: TCDTabSheet;
|
|
GoForward, CheckTabVisible: boolean): TCDTabSheet;
|
|
procedure SelectNextPage(GoForward: boolean; CheckTabVisible: boolean = True);
|
|
procedure SetCDPages(Value: TList);
|
|
published
|
|
property ActivePage: TCDTabSheet read FActivePage write SetActivePage;
|
|
property DrawStyle: TCDDrawStyle read FDrawStyle write SetDrawStyle;
|
|
property Caption;
|
|
property CaptionHeight: integer read FCaptionHeight write SetCaptionHeight;
|
|
property Color;
|
|
property Font;
|
|
property Gradient: boolean read FGrad write SetPageGradient;
|
|
property Pages: TList read FPages write SetCDPages;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ShowTabs: boolean read FShowTabs write SetShowTabs;
|
|
property TabStop default True;
|
|
end;
|
|
|
|
{ TCDTrackBarDrawer }
|
|
|
|
TCDPageControlDrawer = class
|
|
public
|
|
procedure SetClientRectPos(CDPageControl: TCDPageControl); virtual; abstract;
|
|
procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
|
|
CDPageControl: TCDPageControl); virtual; abstract;
|
|
procedure DrawToCanvas(ADest: TCanvas; CDPageControl: TCDPageControl);
|
|
virtual; abstract;
|
|
end;
|
|
|
|
TCDPageControlDrawerWinCE = class(TCDPageControlDrawer)
|
|
public
|
|
procedure SetClientRectPos(CDPageControl: TCDPageControl); override;
|
|
procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
|
|
CDPageControl: TCDPageControl); override;
|
|
procedure DrawToCanvas(ADest: TCanvas; CDPageControl: TCDPageControl); override;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
const
|
|
INT_BitmappedButton_LineSpacing = 2;
|
|
|
|
resourcestring
|
|
sTABSHEET_DEFAULT_NAME = 'CTabSheet';
|
|
sNEW_PAGE = 'Ne&w Page';
|
|
sDEL_PAGE = '&Delete Page';
|
|
sNEXT_PAGE = 'Ne&xt Page';
|
|
sPREV_PAGE = '&Previouse Page';
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('Common Controls', [TCDButton]);
|
|
RegisterComponents('Common Controls', [TCDTrackBar]);
|
|
RegisterComponents('Common Controls', [TCDPageControl]);
|
|
RegisterComponents('Common Controls', [TCDGroupBox]);
|
|
RegisterComponentEditor(TCDPageControl, TCDPageControlEditor);
|
|
RegisterComponentEditor(TCDTabSheet, TCDPageControlEditor);
|
|
RegisterNoIcon([TCDTabSheet]);
|
|
RegisterClasses([TCDTabSheet]);
|
|
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;
|
|
|
|
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;
|
|
end;
|
|
end;
|
|
|
|
procedure TCDButton.SetDrawStyle(const AValue: TCDDrawStyle);
|
|
begin
|
|
if FDrawStyle = AValue then
|
|
exit;
|
|
FDrawStyle := AValue;
|
|
|
|
Invalidate;
|
|
|
|
PrepareCurrentDrawer();
|
|
// FCurrentDrawer.SetClientRectPos(Self); the button shouldn't receive controls inside it
|
|
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;
|
|
FDrawerAndroid := TCDButtonDrawerAndroid.Create;
|
|
FDrawerXPTB := TCDButtonDrawerXPTB.Create;
|
|
Width := 120;
|
|
Height := 43;
|
|
//Color := clTeal;
|
|
ParentFont := True;
|
|
FDrawStyle := dsAndroid;
|
|
Color := $00F1F5F5;
|
|
end;
|
|
|
|
destructor TCDButton.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TCDButton.EraseBackground(DC: HDC);
|
|
begin
|
|
|
|
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
|
|
FCurrentDrawer.DrawToIntfImage(lCanvas, Self);
|
|
ABmp.LoadFromIntfImage(AImage);
|
|
// Second step of the drawing: LCL TCustomCanvas for easy font access
|
|
FCurrentDrawer.DrawToCanvas(ABmp.Canvas, Self, FState);
|
|
|
|
with ABmp.Canvas do
|
|
begin
|
|
Brush.Style := bsClear;
|
|
if FState <> bbsDown then
|
|
begin
|
|
Pen.Color := GetAColor(Color, 86);
|
|
RoundRect(0, 0, Width, Height, 8, 8);
|
|
end;
|
|
Pen.Style := psSolid;
|
|
Pen.Color := Parent.Color;
|
|
Line(0, 2, 0, 0);
|
|
Line(0, 0, 2, 0);
|
|
Pixels[2, 0] := Pen.Color;
|
|
Line(Width - 3, 0, Width - 1, 0);
|
|
Line(Width - 1, 0, Width - 1, 2);
|
|
Line(0, Height - 3, 0, Height - 1);
|
|
Line(0, Height - 1, 2, Height - 1);
|
|
Line(Width - 1, Height - 3, Width - 1, Height - 1);
|
|
Line(Width - 1, Height - 1, Width - 3, Height - 1);
|
|
Pixels[Width - 1, 2] := Pen.Color;
|
|
Pixels[Width - 3, Height - 1] := Pen.Color;
|
|
Pixels[2, Height - 1] := Pen.Color;
|
|
pColor := Parent.Color; //GetAColor(Parent.Color, 96);
|
|
Pixels[1, 1] := pColor;
|
|
Pixels[Width - 2, 1] := pColor;
|
|
Pixels[Width - 2, Height - 2] := pColor;
|
|
Pixels[1, Height - 2] := pColor;
|
|
end;
|
|
Canvas.Draw(0, 0, ABmp);
|
|
finally
|
|
if lCanvas <> nil then
|
|
lCanvas.Free;
|
|
if AImage <> nil then
|
|
AImage.Free;
|
|
ABmp.Free;
|
|
end;
|
|
end;
|
|
|
|
{ TCDButtonDrawerWinCE }
|
|
|
|
procedure TCDButtonDrawerWinCE.SetClientRectPos(CDButton: TCDButton);
|
|
var
|
|
lRect: TRect;
|
|
begin
|
|
lRect := Rect(1, 1, CDButton.Width - 1, CDButton.Height - 1);
|
|
CDButton.AdjustClientRect(lRect);
|
|
end;
|
|
|
|
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);
|
|
|
|
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;
|
|
|
|
procedure TCDButtonDrawerAndroid.SetClientRectPos(CDButton: TCDButton);
|
|
var
|
|
lRect: TRect;
|
|
begin
|
|
lRect := Rect(1, 1, CDButton.Width - 1, CDButton.Height - 1);
|
|
CDButton.AdjustClientRect(lRect);
|
|
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.SetClientRectPos(CDButton: TCDButton);
|
|
var
|
|
lRect: TRect;
|
|
begin
|
|
lRect := Rect(1, 1, CDButton.Width - 1, CDButton.Height - 1);
|
|
CDButton.AdjustClientRect(lRect);
|
|
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;
|
|
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
|
|
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
|
|
ADest.Brush.Color := ColorToRGB(CDGroupBox.Parent.Color);
|
|
|
|
// Text background
|
|
ADest.Pen.Style := psClear;
|
|
ADest.Brush.Style := bsSolid;
|
|
ADest.Rectangle(FCaptionMiddle, 0, ADest.GetTextWidth(CDGroupBox.Caption) +
|
|
FCaptionMiddle, 10);
|
|
|
|
// paint text
|
|
ADest.Pen.Style := psSolid;
|
|
ADest.Brush.Style := bsClear;
|
|
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;
|
|
|
|
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);
|
|
begin
|
|
inherited KeyDown(Key, Shift);
|
|
if (Key = 37) or (Key = 40) then
|
|
Position := Position - (FMax - FMin) div 10;
|
|
if (Key = 38) or (Key = 39) then
|
|
Position := Position + (FMax - FMin) div 10;
|
|
if Position > FMax then
|
|
Position := FMax;
|
|
if Position < FMin then
|
|
Position := FMin;
|
|
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);
|
|
begin
|
|
SetFocus;
|
|
FPosition := FMin + (X - 8) * (FMax - FMin) div (Width - 14);
|
|
if X > Width - 14 then
|
|
FPosition := FMax;
|
|
if X < 13 then
|
|
FPosition := 0;
|
|
xPosition := X;
|
|
if X > Width - 14 then
|
|
xPosition := Width - 14;
|
|
if X < 13 then
|
|
xPosition := 13;
|
|
invalidate;
|
|
FMDown := True;
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TCDTrackBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
|
|
begin
|
|
FMDown := False;
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TCDTrackBar.MouseMove(Shift: TShiftState; X, Y: integer);
|
|
begin
|
|
if FMDown then
|
|
begin
|
|
FPosition := FMin + (X - 8) * (FMax - FMin) div (Width - 14);
|
|
if X > Width - 14 then
|
|
FPosition := FMax;
|
|
if X < 13 then
|
|
FPosition := 0;
|
|
xPosition := X;
|
|
if X > Width - 14 then
|
|
xPosition := Width - 14;
|
|
if X < 13 then
|
|
xPosition := 13;
|
|
invalidate;
|
|
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 := 100;
|
|
FMin := 0;
|
|
TabStop := True;
|
|
FFromColor := clWhite;
|
|
FToColor := clGray;
|
|
FStepWidth := 11;
|
|
TabStop := True;
|
|
xPosition := 13;
|
|
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, FFromColor,
|
|
FToColor, FStepWidth);
|
|
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;
|
|
|
|
procedure TCDTrackBar.SetFromColor(Value: TColor);
|
|
begin
|
|
FFromColor := Value;
|
|
invalidate;
|
|
end;
|
|
|
|
procedure TCDTrackBar.SetToColor(Value: TColor);
|
|
begin
|
|
FToColor := Value;
|
|
invalidate;
|
|
end;
|
|
|
|
procedure TCDTrackBar.SetStepWidth(Value: integer);
|
|
begin
|
|
FStepWidth := Value;
|
|
invalidate;
|
|
end;
|
|
|
|
{ TCDTrackBarDrawer }
|
|
|
|
procedure TCDTrackBarDrawerGraph.DrawToIntfImage(ADest: TFPImageCanvas;
|
|
FPImg: TLazIntfImage; CDTrackBar: TCDTrackBar; FromColor, ToColor: TColor;
|
|
pWidth: integer);
|
|
var
|
|
aStart, RNum, i, pStart: integer;
|
|
dRect: TRect;
|
|
TempB: TLazIntfImage;
|
|
BCanvas: TFPImageCanvas;
|
|
ABmp: TBitmap = nil;
|
|
begin
|
|
// 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));
|
|
//aStart := CDTrackBar.Height div 2 + 1;
|
|
aStart := CDTrackBar.Height - 10;
|
|
ADest.Pen.Style := psSolid;
|
|
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($006BB6E6));
|
|
//ADest.Rectangle(0, aStart, CDTrackBar.Width, aStart);
|
|
ADest.Line(0, aStart, CDTrackBar.Width, aStart);
|
|
ADest.Line(3, aStart - 1, 6, aStart - 1);
|
|
ADest.Line(5, aStart - 2, 6, aStart - 2);
|
|
ADest.Line(3, aStart + 1, 6, aStart + 1);
|
|
ADest.Line(5, aStart + 2, 6, aStart + 2);
|
|
//pStart := ((CDTrackBar.Position - CDTrackBar.Min) * (CDTrackBar.Width - 32)) div
|
|
// (CDTrackBar.Max - CDTrackBar.Min) + 2;
|
|
pStart := CDTrackBar.xPosition;
|
|
ADest.Rectangle(pStart - 5, aStart + 1, pStart + 5, aStart + 6);
|
|
ADest.Line(CDTrackBar.Width - 1 - 3, aStart - 1, CDTrackBar.Width - 1 - 6, aStart - 1);
|
|
ADest.Line(CDTrackBar.Width - 1 - 5, aStart - 2, CDTrackBar.Width - 1 - 6, aStart - 2);
|
|
ADest.Line(CDTrackBar.Width - 1 - 3, aStart + 1, CDTrackBar.Width - 1 - 6, aStart + 1);
|
|
ADest.Line(CDTrackBar.Width - 1 - 5, aStart + 2, CDTrackBar.Width - 1 - 6, aStart + 2);
|
|
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($005BA6C6));
|
|
ADest.RecTangle(pStart - 5, aStart + 2, pStart + 5, aStart + 7);
|
|
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($006BB6E6));
|
|
ADest.RecTangle(pStart - 5, aStart, pStart + 5, aStart + 2);
|
|
RNum := (CDTrackBar.Width - 15) div pWidth;
|
|
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(clGray));
|
|
ADest.Brush.FPColor := TColorToFPColor(ColorToRGB($00F0F0F0));
|
|
ABmp := TBitmap.Create;
|
|
ABmp.Width := CDTrackBar.Width;
|
|
ABmp.Height := CDTrackBar.Height;
|
|
TempB := ABmp.CreateIntfImage;
|
|
//TempB := TLazIntfImage.Create(0, 0);
|
|
//TempB.UsePalette := False;
|
|
//TempB.Width := CDTrackBar.Width;
|
|
//TempB.Height := CDTrackBar.Height;
|
|
BCanvas := TFPImageCanvas.Create(TempB);
|
|
//BCanvas.Brush.FPColor := TColorToFPColor(ColorToRGB(clRed));
|
|
BCanvas.Brush.Style := bsSolid;
|
|
//GradHFill(BCanvas, Rect(0, 0, CDTrackBar.Width, CDTrackBar.Height),
|
|
// GetAColor(FromColor, 70 + i), GetAColor(ToColor, 90 + i));
|
|
GradCenterFill(BCanvas, Rect(0, 0, CDTrackBar.Width, CDTrackBar.Height),
|
|
FromColor, ToColor, CDTrackBar.Position / (CDTrackBar.Max - CDTrackBar.Min));
|
|
for i := 0 to RNum - 1 do
|
|
begin
|
|
dRect := Rect(10 + i * pWidth, aStart - 5 - i, 10 + i * pWidth +
|
|
pWidth - 3, aStart - 1);
|
|
ADest.Brush.Style := bsSolid;
|
|
// GradHFill(ADest, dRect, GetAColor(FromColor, 70 + i), GetAColor(ToColor, 90 + i));
|
|
if aStart - 5 - i > 0 then
|
|
begin
|
|
FPImgCloneRect(TempB, FPImg, Rect(10 + i * pWidth, aStart - 5 -
|
|
i, 10 + i * pWidth + pWidth - 3, aStart - 1), False);
|
|
ADest.Brush.Style := bsClear;
|
|
ADest.RecTangle(10 + i * pWidth, aStart - 5 - i, 10 + i * pWidth +
|
|
pWidth - 3, aStart - 1);
|
|
end;
|
|
end;
|
|
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($007BC6F6));
|
|
ADest.Line(7, aStart - 1, CDTrackBar.Width - 8, aStart - 1);
|
|
ADest.Line(7, aStart + 1, CDTrackBar.Width - 8, aStart + 1);
|
|
ADest.Colors[2, aStart - 1] := ADest.Pen.FPColor;
|
|
ADest.Colors[4, aStart - 2] := ADest.Pen.FPColor;
|
|
ADest.Colors[2, aStart + 1] := ADest.Pen.FPColor;
|
|
ADest.Colors[4, aStart + 2] := ADest.Pen.FPColor;
|
|
ADest.Colors[6, aStart - 3] := ADest.Pen.FPColor;
|
|
ADest.Colors[6, aStart + 3] := ADest.Pen.FPColor;
|
|
ADest.Colors[CDTrackBar.Width - 1 - 2, aStart - 1] := ADest.Pen.FPColor;
|
|
ADest.Colors[CDTrackBar.Width - 1 - 4, aStart - 2] := ADest.Pen.FPColor;
|
|
ADest.Colors[CDTrackBar.Width - 1 - 2, aStart + 1] := ADest.Pen.FPColor;
|
|
ADest.Colors[CDTrackBar.Width - 1 - 4, aStart + 2] := ADest.Pen.FPColor;
|
|
ADest.Colors[CDTrackBar.Width - 1 - 6, aStart - 3] := ADest.Pen.FPColor;
|
|
ADest.Colors[CDTrackBar.Width - 1 - 6, aStart + 3] := ADest.Pen.FPColor;
|
|
//ADest.Draw(0,0,TempB);
|
|
//ADest.CopyRect(0, 0, BCanvas, Rect(0, 0, CDTrackBar.Width, CDTrackBar.Height));
|
|
//FPIMGCopyRect(TempB, FPImg, Rect(10, 10, CDTrackBar.Width - 11, CDTrackBar.Height - 11));
|
|
BCanvas.Free;
|
|
TempB.Free;
|
|
ABmp.Free;
|
|
end;
|
|
|
|
{ TCDTabSheet }
|
|
|
|
constructor TCDTabSheet.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
//Parent := TCDPageControl(AOwner);
|
|
TabStop := False;
|
|
ParentColor := True;
|
|
parentFont := True;
|
|
ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
|
|
csDoubleClicks, csReplicatable];
|
|
FCurrentDrawer := TCDTabSheetDrawerGraph.Create;
|
|
end;
|
|
|
|
destructor TCDTabSheet.Destroy;
|
|
begin
|
|
FCurrentDrawer.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TCDTabSheet.EraseBackground(DC: HDC);
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TCDTabSheet.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);
|
|
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;
|
|
|
|
procedure TCDTabSheetDrawerGraph.DrawToIntfImage(ADest: TFPImageCanvas;
|
|
FPImg: TLazIntfImage; CDTabSheet: TCDTabSheet);
|
|
begin
|
|
if TCDPageControl(CDTabSheet.Parent).Gradient then
|
|
GradientFillFP(clWhite, GetUColor(CDTabSheet.Color, 96), ADest,
|
|
Rect(0, 0, CDTabSheet.Width - 1, CDTabSheet.Height - 1))
|
|
else
|
|
ADest.Rectangle(0, 0, CDTabSheet.Width - 1, CDTabSheet.Height - 1);
|
|
end;
|
|
|
|
{ TCDPageControlEditor }
|
|
|
|
procedure TCDPageControlEditor.ExecuteVerb(Index: integer);
|
|
var
|
|
NewPage: TCDTabSheet;
|
|
PControl: TCDPageControl;
|
|
Hook: TPropertyEditorHook;
|
|
PageComponent: TPersistent;
|
|
begin
|
|
if Component is TCDPageControl then
|
|
PControl := TCDPageControl(Component)
|
|
else
|
|
if Component is TCDTabSheet then
|
|
PControl := TCDPageControl(TCDTabSheet(Component).Parent);
|
|
Hook:=nil;
|
|
case Index of
|
|
0:
|
|
begin // New Page
|
|
if not GetHook(Hook) then exit;
|
|
NewPage := TCDTabSheet.Create(PControl.Owner);
|
|
NewPage.Parent := PControl;
|
|
with NewPage do
|
|
begin
|
|
Name := Designer.CreateUniqueComponentName(ClassName);
|
|
//GetUniqueName(sTABSHEET_DEFAULT_NAME, PControl);
|
|
Caption := Name;
|
|
{Left := 0;
|
|
Top := PControl.CaptionHeight + 1;
|
|
Width := PControl.Width;
|
|
Height := PControl.Height - PControl.CaptionHeight + 1; }
|
|
SetBounds(1, PControl.CaptionHeight + 1, PControl.Width - 3, PControl.Height - PControl.CaptionHeight - 4);
|
|
if PControl.ActivePage <> nil then
|
|
PControl.ActivePage.Hide;
|
|
PControl.ActivePage := NewPage;
|
|
Show;
|
|
end;
|
|
PControl.FPages.Add(NewPage);
|
|
Hook.PersistentAdded(NewPage,true);
|
|
Designer.Modified;
|
|
end;
|
|
1:
|
|
begin // Delete Page
|
|
with PControl do
|
|
begin
|
|
NewPage := ActivePage;
|
|
//FPages.Remove(NewPage);
|
|
if not GetHook(Hook) then exit;
|
|
PageComponent := TPersistent(NewPage);
|
|
Hook.DeletePersistent(PageComponent);
|
|
if NewPage <> nil then
|
|
NewPage.Free;
|
|
end;
|
|
end;
|
|
2:
|
|
begin // Next Page
|
|
PControl.FindNextPage(PControl.ActivePage, True, False);
|
|
end;
|
|
3:
|
|
begin // Previous Page
|
|
PControl.FindNextPage(PControl.ActivePage, False, False);
|
|
end;
|
|
end;
|
|
if Designer <> nil then
|
|
Designer.Modified;
|
|
end;
|
|
|
|
function TCDPageControlEditor.GetVerb(Index: integer): string;
|
|
begin
|
|
case Index of
|
|
0: Result := sNEW_PAGE;
|
|
1: Result := sDEL_PAGE;
|
|
2: Result := sNEXT_PAGE;
|
|
3: Result := sPREV_PAGE;
|
|
end;
|
|
end;
|
|
|
|
function TCDPageControlEditor.GetVerbCount: integer;
|
|
begin
|
|
Result := 4;
|
|
end;
|
|
|
|
{ TCDPageControl }
|
|
|
|
procedure TCDPageControl.PrepareCurrentDrawer();
|
|
begin
|
|
case DrawStyle of
|
|
dsWince: FCurrentDrawer := FDrawerWinCE;
|
|
dsCustom: FCurrentDrawer := CustomDrawer;
|
|
end;
|
|
end;
|
|
|
|
procedure TCDPageControl.SetDrawStyle(const AValue: TCDDrawStyle);
|
|
begin
|
|
if FDrawStyle = AValue then
|
|
exit;
|
|
FDrawStyle := AValue;
|
|
Invalidate;
|
|
PrepareCurrentDrawer();
|
|
FCurrentDrawer.SetClientRectPos(Self);
|
|
end;
|
|
|
|
function TCDPageControl.FindNextPage(CurPage: TCDTabSheet;
|
|
GoForward, CheckTabVisible: boolean): TCDTabSheet;
|
|
var
|
|
I, StartIndex: integer;
|
|
begin
|
|
if FPages.Count <> 0 then
|
|
begin
|
|
StartIndex := FPages.IndexOf(CurPage);
|
|
if StartIndex = -1 then
|
|
if GoForward then StartIndex := FPages.Count - 1 else StartIndex := 0;
|
|
I := StartIndex;
|
|
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 := TCDTabSheet(FPages[I]);
|
|
if not CheckTabVisible or Result.Visible then Exit;
|
|
until I = StartIndex;
|
|
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 := False;
|
|
FDrawerWinCE := TCDPageControlDrawerWinCE.Create;
|
|
FCaptionHeight := 28;
|
|
ParentColor := True;
|
|
parentFont := True;
|
|
FGrad := True;
|
|
ControlStyle := [];
|
|
FPages := TList.Create;
|
|
end;
|
|
|
|
destructor TCDPageControl.Destroy;
|
|
begin
|
|
FPages.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TCDPageControl.SetActivePage(Value: TCDTabSheet);
|
|
var i: integer;
|
|
begin
|
|
for i := 0 to FPages.Count - 1 do
|
|
begin
|
|
if TCDTabSheet(FPages[i]) = Value then
|
|
Show
|
|
else
|
|
Hide;
|
|
end;
|
|
FActivePage := Value;
|
|
Value.BringToFront;
|
|
end;
|
|
|
|
procedure TCDPageControl.SetPageIndex(Value: integer);
|
|
begin
|
|
FPageIndex := Value;
|
|
ActivePage := TCDTabSheet(Pages[Value]);
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCDPageControl.EraseBackground(DC: HDC);
|
|
begin
|
|
|
|
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
|
|
FCurrentDrawer.DrawToIntfImage(lCanvas, AImage, 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;
|
|
|
|
procedure TCDPageControl.SetCaptionHeight(Value: integer);
|
|
begin
|
|
FCaptionHeight := Value;
|
|
invalidate;
|
|
end;
|
|
|
|
procedure TCDPageControl.SetPageGradient(Value: boolean);
|
|
begin
|
|
FGrad := Value;
|
|
invalidate;
|
|
end;
|
|
|
|
procedure TCDPageControl.SetShowTabs(Value: boolean);
|
|
begin
|
|
FShowTabs := Value;
|
|
invalidate;
|
|
end;
|
|
|
|
procedure TCDPageControl.DrawCaptionBar(ADest: TFPImageCanvas;
|
|
FPImg: TLazIntfImage; lRect: TRect);
|
|
var
|
|
aRect: TRect; i: integer; rWidth: integer; aText: string;
|
|
begin
|
|
aRect := lRect;
|
|
ADest.Pen.Style := psSolid;
|
|
ADest.Brush.Style := bsSolid;
|
|
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($009C9B91));
|
|
aRect.Left := lRect.Left;
|
|
aRect.Top := lRect.Top;
|
|
aRect.Bottom := lRect.Bottom;
|
|
aRect.Right := lRect.Right;
|
|
if Owner.ComponentCount = 0 then
|
|
begin
|
|
ADest.RecTangle(aRect);
|
|
Exit;
|
|
end;
|
|
for i := 0 to Owner.ComponentCount - 1 do
|
|
begin
|
|
if Owner.Components[i].GetParentComponent = Self then
|
|
begin
|
|
aText := TCDTabSheet(Owner.Components[i]).Caption;
|
|
rWidth := 6 + Length(aText) * 9; //TCDTabSheet(FPages[i]).Font.Size;
|
|
if aRect.Left + rWidth > lRect.Right - 6 then
|
|
break
|
|
else
|
|
aRect.Right := aRect.Left + rWidth;
|
|
ADest.RecTangle(aRect);
|
|
//ADest.TextOut(aRect.Left + 3, aRect.Top + 3, aText);
|
|
aRect.Left := aRect.Right;
|
|
end;
|
|
end;
|
|
aRect.Left := lRect.Right - 51;
|
|
aRect.Top := 1;
|
|
aRect.Bottom := 25;
|
|
aRect.Right := lRect.Right - 26;
|
|
GradFill(ADest, aRect, $00FDD9CB, $00F2C9B8);
|
|
aRect.Left := lRect.Right - 25;
|
|
aRect.Top := 1;
|
|
aRect.Bottom := 25;
|
|
aRect.Right := lRect.Right;
|
|
GradFill(ADest, aRect, $00FDD9CB, $00F2C9B8);
|
|
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));
|
|
//ADest.Line();
|
|
end;
|
|
|
|
procedure TCDPageControl.SetCDPages(Value: TList);
|
|
begin
|
|
FPages.Assign(Value);
|
|
end;
|
|
|
|
procedure TCDPageControl.DoOnResize;
|
|
begin
|
|
if ActivePage <> nil then
|
|
begin
|
|
ActivePage.Left := 1;
|
|
ActivePage.Top := CaptionHeight + 1;
|
|
ActivePage.Width := Width - 3;
|
|
ActivePage.Height := Height - CaptionHeight - 4;
|
|
end;
|
|
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
|
|
TCDTabSheet(FPages[APageIndex]).ControlStyle:=
|
|
TCDTabSheet(FPages[APageIndex]).ControlStyle+[csNoDesignVisible]
|
|
else
|
|
TCDTabSheet(FPages[APageIndex]).ControlStyle:=
|
|
TCDTabSheet(FPages[APageIndex]).ControlStyle-[csNoDesignVisible];
|
|
end;
|
|
|
|
{procedure TCDPageControl.CNNotify(var Message: TLMNotify);
|
|
var
|
|
OldPageIndex: LongInt;
|
|
begin
|
|
with Message do
|
|
case NMHdr^.code of
|
|
TCN_SELCHANGE:
|
|
begin
|
|
// set the page from the NMHDR^.idfrom
|
|
if not (csDestroyingHandle in ControlState) then
|
|
begin
|
|
OldPageIndex := FPageIndex;
|
|
FPageIndex := PtrInt(NMHDR^.idfrom);
|
|
if FPageIndex >= FPages.Count then
|
|
FPageIndex := -1;
|
|
//debugln(['TCDPageControl.CNNotify ',DbgSName(Self),' A Old=',OldPageIndex,' fPageIndex=',fPageIndex,' FLoadedPageIndex=',FLoadedPageIndex]);
|
|
//if PageIndex>=0 then DebugLn(['TCDPageControl.CNNotify Page=',DbgSName(Page[PageIndex]),' Visible=',Page[PageIndex].Visible]);
|
|
UpdateAllDesignerFlags;
|
|
if ([csLoading,csDestroying]*ComponentState=[]) then
|
|
begin
|
|
if OldPageIndex <> FPageIndex then
|
|
begin
|
|
if csDesigning in ComponentState then
|
|
OwnerFormDesignerModified(Self);
|
|
//DebugLn(['TCustomNotebook.CNNotify ',DbgSName(Page[PageIndex]),' ',Page[PageIndex].Visible]);
|
|
// Change;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
TCN_SELCHANGING:
|
|
begin
|
|
{ if CanChangePageIndex and not
|
|
(csDestroyingHandle in ControlState) then
|
|
Result := 0
|
|
else
|
|
Result := 1; }
|
|
end;
|
|
else
|
|
begin
|
|
{$IFDEF NOTEBOOK_DEBUG}
|
|
DebugLn(['[TCDPageControl.CNNotify] unhandled NMHdr code:', NMHdr^.code]);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
end; }
|
|
|
|
procedure TCDPageControl.SetMouseUP;
|
|
begin
|
|
FMDownL := False;
|
|
FMDownR := False;
|
|
end;
|
|
|
|
procedure TCDPageControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: integer);
|
|
begin
|
|
if (X > Width - 36) and (X < Width - 18) then
|
|
FMDownL := True
|
|
else
|
|
if (X > Width - 36) and (X < Width - 18) then
|
|
FMDownR := True
|
|
else
|
|
SetMouseUP;
|
|
if (Y < 3) or (Y > 18) then
|
|
SetMouseUP;
|
|
if FMDownR or FMDownL then
|
|
invalidate;
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TCDPageControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
|
|
begin
|
|
SetMouseUP;
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TCDPageControl.MouseMove(Shift: TShiftState; X, Y: integer);
|
|
begin
|
|
if (X > Width - 36) and (X < Width - 18) then
|
|
FMEnterL := True
|
|
else
|
|
if (X > Width - 36) and (X < Width - 18) then
|
|
FMEnterR := True
|
|
else
|
|
begin
|
|
FMEnterR := False;
|
|
FMEnterL := False;
|
|
end;
|
|
if (Y < 3) or (Y > 18) then
|
|
begin
|
|
FMEnterR := False;
|
|
FMEnterL := False;
|
|
end;
|
|
if FMEnterR or FMENterL then
|
|
invalidate;
|
|
inherited MouseMove(Shift, X, Y);
|
|
end;
|
|
|
|
procedure TCDPageControl.Loaded;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCDPageControl.MouseEnter;
|
|
begin
|
|
inherited MouseEnter;
|
|
end;
|
|
|
|
procedure TCDPageControl.MouseLeave;
|
|
begin
|
|
inherited MouseLeave;
|
|
end;
|
|
|
|
{ TCDPageControlDrawerWinCE }
|
|
|
|
procedure TCDPageControlDrawerWinCE.SetClientRectPos(CDPageControl: TCDPageControl);
|
|
var
|
|
lRect: TRect;
|
|
lCaptionHeight: integer;
|
|
begin
|
|
lCaptionHeight := CDPageControl.CaptionHeight;
|
|
lRect := Rect(10, lCaptionHeight + 1, CDPageControl.Width - 10,
|
|
CDPageControl.Height - 1);
|
|
CDPageControl.AdjustClientRect(lRect);
|
|
end;
|
|
|
|
procedure TCDPageControlDrawerWinCE.DrawToIntfImage(ADest: TFPImageCanvas;
|
|
FPImg: TLazIntfImage; CDPageControl: TCDPageControl);
|
|
begin
|
|
ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CDPageControl.Color));
|
|
ADest.Brush.Style := bsSolid;
|
|
ADest.Pen.Style := psClear;
|
|
ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CDPageControl.Color));
|
|
ADest.Rectangle(0, 0, CDPageControl.Width, CDPageControl.Height);
|
|
ADest.Font.Name := CDPageControl.Font.Name;
|
|
ADest.Font.Size := CDPageControl.Font.Size;
|
|
CDPageControl.DrawCaptionBar(ADest, FPImg, Rect(0, 0, CDPageControl.Width -
|
|
2, CDPageControl.CaptionHeight + 1));
|
|
if CDPageControl.Gradient then
|
|
GradientFillFP(clWhite, GetUColor(CDPageControl.Color, 96), ADest,
|
|
Rect(0, CDPageControl.CaptionHeight, CDPageControl.Width, CDPageControl.Height))
|
|
else
|
|
ADest.Rectangle(0, CDPageControl.CaptionHeight, CDPageControl.Width,
|
|
CDPageControl.Height);
|
|
ADest.Colors[CDPageControl.Width - 1, CDPageControl.CaptionHeight] :=
|
|
TColorToFPColor(ColorToRGB(CDPageControl.Color));
|
|
// frame
|
|
//ADest.Pen.FPColor := colBlack;
|
|
ADest.Pen.Style := psSolid;
|
|
ADest.Brush.Style := bsClear;
|
|
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($009C9B91));
|
|
// ADest.Rectangle(0,0,CDPageControl.Width-2,CDPageControl.Height-2);
|
|
ADest.Rectangle(0, CDPageControl.CaptionHeight, CDPageControl.Width -
|
|
2, CDPageControl.Height - 2);
|
|
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($00BFCED0));
|
|
ADest.Line(CDPageControl.Width - 1, CDPageControl.CaptionHeight + 1,
|
|
CDPageControl.Width - 1, CDPageControl.Height - 1);
|
|
ADest.Line(CDPageControl.Width - 1, CDPageControl.Height - 1, 1,
|
|
CDPageControl.Height - 1);
|
|
end;
|
|
|
|
procedure TCDPageControlDrawerWinCE.DrawToCanvas(ADest: TCanvas;
|
|
CDPageControl: TCDPageControl);
|
|
begin
|
|
|
|
end;
|
|
|
|
end.
|
|
|