mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-05 20:58:06 +02:00
745 lines
26 KiB
ObjectPascal
745 lines
26 KiB
ObjectPascal
unit CustomDrawnDrawers;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Types, fpcanvas, fpimage,
|
|
// LCL for types
|
|
Controls, Graphics, ComCtrls, ExtCtrls, LazUTF8;
|
|
|
|
const
|
|
CDDRAWSTYLE_COUNT = 19;
|
|
|
|
cddTestStr = 'ŹÇ'; // Used for testing text height
|
|
|
|
// Measures
|
|
TCDEDIT_LEFT_TEXT_SPACING = $400; // The space between the start of the text and the left end of the control
|
|
TCDEDIT_RIGHT_TEXT_SPACING = $401; // The space between the end of the text and the right end of the control
|
|
TCDEDIT_TOP_TEXT_SPACING = $402;
|
|
TCDEDIT_BOTTOM_TEXT_SPACING= $403;
|
|
|
|
TCDCHECKBOX_SQUARE_HALF_HEIGHT = $500;
|
|
TCDCHECKBOX_SQUARE_HEIGHT = $501;
|
|
|
|
TCDRADIOBUTTON_CIRCLE_HEIGHT = $601;
|
|
|
|
TCDCOMBOBOX_DEFAULT_HEIGHT = $801;
|
|
|
|
TCDSCROLLBAR_BUTTON_WIDTH = $900;
|
|
TCDSCROLLBAR_LEFT_SPACING = $901; // Left and right are only read left and right for horizontal orientation
|
|
TCDSCROLLBAR_RIGHT_SPACING= $902; // in vertical orientation they are respectively top and bottom
|
|
TCDSCROLLBAR_LEFT_BUTTON_POS =$903; // Positive Pos means it relative to the left margin,
|
|
TCDSCROLLBAR_RIGHT_BUTTON_POS=$904; // negative that it is relative to the right margin
|
|
|
|
TCDTRACKBAR_LEFT_SPACING = $1000;
|
|
TCDTRACKBAR_RIGHT_SPACING = $1001;
|
|
TCDTRACKBAR_TOP_SPACING = $1002;
|
|
TCDTRACKBAR_FRAME_HEIGHT = $1003;
|
|
|
|
TCDLISTVIEW_COLUMN_LEFT_SPACING = $1200;
|
|
TCDLISTVIEW_COLUMN_RIGHT_SPACING = $1201;
|
|
TCDLISTVIEW_COLUMN_TEXT_LEFT_SPACING = $1202;
|
|
TCDLISTVIEW_LINE_TOP_SPACING = $1203;
|
|
TCDLISTVIEW_LINE_BOTTOM_SPACING = $1204;
|
|
|
|
TCDTOOLBAR_ITEM_SPACING = $1300;
|
|
TCDTOOLBAR_ITEM_ARROW_WIDTH = $1301;
|
|
TCDTOOLBAR_ITEM_BUTTON_DEFAULT_WIDTH = $1303;
|
|
TCDTOOLBAR_ITEM_ARROW_RESERVED_WIDTH = $1304;
|
|
TCDTOOLBAR_ITEM_SEPARATOR_DEFAULT_WIDTH = $1305;
|
|
TCDTOOLBAR_DEFAULT_HEIGHT = $1306;
|
|
|
|
TCDCTABCONTROL_CLOSE_TAB_BUTTON_WIDTH = $2600;
|
|
TCDCTABCONTROL_CLOSE_TAB_BUTTON_EXTRA_SPACING = $2601;
|
|
|
|
// Measures Ex
|
|
TCDCONTROL_CAPTION_WIDTH = $100;
|
|
TCDCONTROL_CAPTION_HEIGHT = $101;
|
|
|
|
TCDCTABCONTROL_TAB_HEIGHT = $2600;
|
|
TCDCTABCONTROL_TAB_WIDTH = $2601;
|
|
TCDCTABCONTROL_TAB_LEFT_POS = $2602;
|
|
TCDCTABCONTROL_CLOSE_BUTTON_POS_X = $2603;
|
|
TCDCTABCONTROL_CLOSE_BUTTON_POS_Y = $2604;
|
|
|
|
// Colors
|
|
TCDEDIT_BACKGROUND_COLOR = $400;
|
|
TCDEDIT_TEXT_COLOR = $401;
|
|
TCDEDIT_SELECTED_BACKGROUND_COLOR = $402;
|
|
TCDEDIT_SELECTED_TEXT_COLOR = $403;
|
|
|
|
// Default Colors
|
|
TCDBUTTON_DEFAULT_COLOR = $10000;
|
|
|
|
type
|
|
|
|
TCDDrawStyle = (
|
|
// The default is given by the DefaultStyle global variable
|
|
// Don't implement anything for this drawer
|
|
dsDefault = 0,
|
|
// This is a common drawer, with a minimal implementation on which other
|
|
// drawers base on
|
|
dsCommon,
|
|
// Operating system styles
|
|
dsWinCE, dsWin2000, dsWinXP, dsWindows7,
|
|
dsKDEPlastique, dsGNOME, dsMacOSX,
|
|
dsAndroid,
|
|
// Other special styles for the user
|
|
dsExtra1, dsExtra2, dsExtra3, dsExtra4, dsExtra5,
|
|
dsExtra6, dsExtra7, dsExtra8, dsExtra9, dsExtra10
|
|
);
|
|
|
|
// Inspired by http://doc.qt.nokia.com/stable/qstyle.html#StateFlag-enum
|
|
TCDControlStateFlag = (
|
|
// Basic state flags
|
|
csfEnabled,
|
|
csfRaised, // Raised beyond the normal state, unlike Qt for buttons
|
|
csfSunken,
|
|
csfHasFocus,
|
|
csfReadOnly,
|
|
csfMouseOver,
|
|
// for TCDCheckBox, TCDRadioButton
|
|
csfOn,
|
|
csfOff,
|
|
csfPartiallyOn,
|
|
// for TCDScrollBar, TCDProgressBar
|
|
csfHorizontal,
|
|
csfVertical,
|
|
csfRightToLeft,
|
|
csfTopDown,
|
|
// for TCDProgressBar, TCDScrollBar, TCDComboBox
|
|
csfLeftArrow,
|
|
csfRightArrow,
|
|
csfDownArrow,
|
|
csfUpArrow
|
|
{ // for tool button
|
|
csfAutoRaise,
|
|
csfTop,
|
|
csfBottom,
|
|
csfFocusAtBorder,
|
|
csfSelected,
|
|
csfActive,
|
|
csfWindow,
|
|
csfOpen,
|
|
csfChildren,
|
|
csfItem,
|
|
csfSibling,
|
|
csfEditing,
|
|
csfKeyboardFocusChange,
|
|
// For Mac OS X
|
|
csfSmall,
|
|
csfMini}
|
|
);
|
|
|
|
TCDControlState = set of TCDControlStateFlag;
|
|
|
|
TCDControlStateEx = class
|
|
public
|
|
ParentRGBColor: TColor;
|
|
FPParentRGBColor: TFPColor;
|
|
RGBColor: TColor;
|
|
FPRGBColor: TFPColor;
|
|
Caption: string;
|
|
Font: TFont; // Just a reference, never Free
|
|
AutoSize: Boolean;
|
|
end;
|
|
|
|
TCDButtonStateEx = class(TCDControlStateEx)
|
|
public
|
|
Glyph: TBitmap; // Just a reference, never Free
|
|
end;
|
|
|
|
TCDEditStateEx = class(TCDControlStateEx)
|
|
public
|
|
CaretIsVisible: Boolean;
|
|
CaretPos: TPoint; // X and Y are zero-based positions
|
|
SelStart: TPoint; // X and Y are zero-based positions
|
|
SelLength: Integer; // zero means no selection. Negative numbers selection to the left from the start and positive ones to the right
|
|
VisibleTextStart: TPoint; // X is 1-based, Y is 0-based
|
|
EventArrived: Boolean; // Added by event handlers and used by the caret so that it stops blinking while events are incoming
|
|
MultiLine: Boolean;
|
|
Lines: TStrings; // Just a reference, never Free
|
|
FullyVisibleLinesCount, LineHeight: Integer; // Filled on drawing to be used in customdrawncontrols.pas
|
|
PasswordChar: Char;
|
|
// customizable extra margins, zero is the base value
|
|
LeftTextMargin, RightTextMargin: Integer;
|
|
// For the combo box for example
|
|
ExtraButtonState: TCDControlState;
|
|
end;
|
|
|
|
TCDPanelStateEx = class(TCDControlStateEx)
|
|
public
|
|
BevelInner: TPanelBevel;
|
|
BevelOuter: TPanelBevel;
|
|
BevelWidth: TBevelWidth;
|
|
end;
|
|
|
|
TCDPositionedCStateEx = class(TCDControlStateEx)
|
|
public
|
|
PosCount: integer; // The number of positions, calculated as Max - Min + 1
|
|
Position: integer; // A zero-based position, therefore it is = Position - Min
|
|
FloatPos: Double; // The same position, but as a float between 0.0 and 1.0
|
|
FloatPageSize: Double; // The page size as a float between 0.0 and 1.0
|
|
end;
|
|
|
|
TCDProgressBarStateEx = class(TCDControlStateEx)
|
|
public
|
|
BarShowText: Boolean;
|
|
PercentPosition: Double; // a float between 0.0 and 1.0 (1=full)
|
|
Smooth: Boolean;
|
|
Style: TProgressBarStyle;
|
|
end;
|
|
|
|
// TCDListItems are implemented as a tree with 2 levels beyond the first node
|
|
TCDListItems = class
|
|
private
|
|
procedure DoFreeItem(data,arg:pointer);
|
|
public
|
|
// These fields are not used in the first node of the tree
|
|
Caption: string;
|
|
ImageIndex: Integer;
|
|
StateIndex: Integer;
|
|
//
|
|
Childs: TFPList;
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function Add(ACaption: string; AImageIndex, AStateIndex: Integer): TCDListItems;
|
|
function GetItem(AIndex: Integer): TCDListItems;
|
|
function GetItemCount: Integer;
|
|
end;
|
|
|
|
TCDListViewStateEx = class(TCDControlStateEx)
|
|
public
|
|
Columns: TListColumns; // just a reference, never free
|
|
Items: TCDListItems; // just a reference, never free
|
|
ViewStyle: TViewStyle;
|
|
FirstVisibleColumn: Integer; // 0-based index
|
|
FirstVisibleLine: Integer; // 0-based index, remember that the header is always visible or always invisible
|
|
ShowColumnHeader: Boolean;
|
|
end;
|
|
|
|
// ToolBar Start
|
|
|
|
TCDToolbarItemKind = (tikButton, tikCheckButton, tikDropDownButton,
|
|
tikSeparator, tikDivider);
|
|
|
|
TCDToolbarItemSubpartKind = (tiskMain, tiskArrow);
|
|
|
|
TCDToolBarItem = class
|
|
Kind: TCDToolbarItemKind;
|
|
SubpartKind: TCDToolbarItemSubpartKind;
|
|
Image: TBitmap;
|
|
Caption: string;
|
|
Width: Integer;
|
|
Down: Boolean;
|
|
// filled for drawing
|
|
State: TCDControlState;
|
|
end;
|
|
|
|
TCDToolBarStateEx = class(TCDControlStateEx)
|
|
ShowCaptions: Boolean;
|
|
IsVertical: Boolean;
|
|
Items: TFPList; // of TCDToolBarItem
|
|
ToolBarHeight: Integer;
|
|
end;
|
|
|
|
// ToolBar End
|
|
|
|
TCDCTabControlStateEx = class(TCDControlStateEx)
|
|
public
|
|
LeftmostTabVisibleIndex: Integer;
|
|
Tabs: TStringList; // Just a reference, don't Free
|
|
TabIndex: Integer;
|
|
TabCount: Integer;
|
|
Options: TCTabControlOptions;
|
|
// Used internally by the drawers
|
|
CurTabIndex: Integer;// For Tab routines, obtain the index
|
|
CurStartLeftPos: Integer;
|
|
CurStartTopPos: Integer;
|
|
end;
|
|
|
|
TCDSpinStateEx = class(TCDPositionedCStateEx)
|
|
public
|
|
Min: integer;
|
|
Increment: integer;
|
|
FloatMin: Double;
|
|
FloatIncrement: Double;
|
|
end;
|
|
|
|
TCDControlID = (
|
|
cidControl,
|
|
// Standard
|
|
cidMenu, cidPopUp, cidButton, cidEdit, cidCheckBox, cidRadioButton,
|
|
cidListBox, cidComboBox, cidScrollBar, cidGroupBox, cidPanel,
|
|
// Additional
|
|
cidStaticText,
|
|
// Common Controls
|
|
cidTrackBar, cidProgressBar, cidListView, cidToolBar, cidCTabControl
|
|
);
|
|
|
|
{ TCDColorPalette }
|
|
|
|
TCDColorPalette = class
|
|
public
|
|
ScrollBar, Background, ActiveCaption, InactiveCaption,
|
|
Menu, Window, WindowFrame, MenuText, WindowText, CaptionText,
|
|
ActiveBorder, InactiveBorder, AppWorkspace, Highlight, HighlightText,
|
|
BtnFace, BtnShadow, GrayText, BtnText, InactiveCaptionText,
|
|
BtnHighlight, color3DDkShadow, color3DLight, InfoText, InfoBk,
|
|
//
|
|
HotLight, GradientActiveCaption, GradientInactiveCaption,
|
|
MenuHighlight, MenuBar, Form: TColor;
|
|
procedure Assign(AFrom: TCDColorPalette);
|
|
end;
|
|
|
|
{ There are 5 possible sources of input for color palettes:
|
|
palDefault - Uses palNative when the operating system matches the drawer style,
|
|
palFallback otherwise
|
|
palNative - Obtain from the operating system
|
|
palFallback - Use the fallback colors of the drawer
|
|
palUserConfig-Load it from the user configuration files, ToDo
|
|
palCustom - The user application has set its own palette
|
|
}
|
|
TCDPaletteKind = (palDefault, palNative, palFallback, palUserConfig, palCustom);
|
|
|
|
{ TCDDrawer }
|
|
|
|
TCDDrawer = class
|
|
protected
|
|
public
|
|
Palette: TCDColorPalette;
|
|
FallbackPalette: TCDColorPalette;
|
|
PaletteKind: TCDPaletteKind;
|
|
constructor Create; virtual;
|
|
destructor Destroy; override;
|
|
procedure CreateResources; virtual;
|
|
procedure LoadResources; virtual;
|
|
procedure FreeResources; virtual;
|
|
procedure ScaleRasterImage(ARasterImage: TRasterImage; ASourceDPI, ADestDPI: Word);
|
|
procedure LoadPalette;
|
|
procedure LoadNativePaletteColors;
|
|
procedure LoadFallbackPaletteColors; virtual;
|
|
function PalDefaultUsesNativePalette: Boolean; virtual;
|
|
function GetDrawStyle: TCDDrawStyle; virtual;
|
|
class function VisibleText(const aVisibleText: TCaption; const APasswordChar: Char): TCaption;
|
|
// GetControlDefaultColor is used by customdrawncontrols to resolve clDefault
|
|
function GetControlDefaultColor(AControlId: TCDControlID): TColor;
|
|
// General
|
|
function GetMeasures(AMeasureID: Integer): Integer; virtual; abstract;
|
|
function GetMeasuresEx(ADest: TCanvas; AMeasureID: Integer;
|
|
AState: TCDControlState; AStateEx: TCDControlStateEx): Integer; virtual; abstract;
|
|
procedure CalculatePreferredSize(ADest: TCanvas; AControlId: TCDControlID;
|
|
AState: TCDControlState; AStateEx: TCDControlStateEx;
|
|
var PreferredWidth, PreferredHeight: integer; WithThemeSpace, AAllowUseOfMeasuresEx: Boolean); virtual; abstract;
|
|
function GetColor(AColorID: Integer): TColor; virtual; abstract;
|
|
function GetClientArea(ADest: TCanvas; ASize: TSize; AControlId: TCDControlID;
|
|
AState: TCDControlState; AStateEx: TCDControlStateEx): TRect; virtual; abstract;
|
|
// To set a different position to draw the control then (0, 0) use the window org of the canvas
|
|
procedure DrawControl(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
|
|
AControl: TCDControlID; AState: TCDControlState; AStateEx: TCDControlStateEx);
|
|
// General drawing routines. The ones using TFPCustomCanvas are reusable in LCL-CustomDrawn
|
|
procedure DrawFocusRect(ADest: TFPCustomCanvas; ADestPos: TPoint; ASize: TSize); virtual; abstract;
|
|
procedure DrawRaisedFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize); virtual; abstract;
|
|
procedure DrawFrame3D(ADest: TFPCustomCanvas; ADestPos: TPoint; ASize: TSize;
|
|
const FrameWidth : integer; const Style : TBevelCut); virtual; abstract;
|
|
procedure DrawSunkenFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize); virtual; abstract;
|
|
procedure DrawShallowSunkenFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize); virtual; abstract;
|
|
procedure DrawTickmark(ADest: TFPCustomCanvas; ADestPos: TPoint; AState: TCDControlState); virtual; abstract;
|
|
procedure DrawSlider(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState); virtual; abstract;
|
|
procedure DrawArrow(ADest: TCanvas; ADestPos: TPoint; ADirection: TCDControlState; ASize: Integer = 7); virtual; abstract;
|
|
// Extra buttons drawing routines
|
|
procedure DrawSmallCloseButton(ADest: TCanvas; ADestPos: TPoint); virtual; abstract;
|
|
procedure DrawButtonWithArrow(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState); virtual; abstract;
|
|
// TCDControl
|
|
procedure DrawControl(ADest: TCanvas; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
|
|
// TCDButton
|
|
procedure DrawButton(ADest: TFPCustomCanvas; ADestPos: TPoint; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDButtonStateEx); virtual; abstract;
|
|
// TCDEdit
|
|
procedure DrawEditBackground(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDEditStateEx); virtual; abstract;
|
|
procedure DrawEditFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDEditStateEx); virtual; abstract;
|
|
procedure DrawCaret(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDEditStateEx); virtual; abstract;
|
|
procedure DrawEdit(ADest: TCanvas; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDEditStateEx); virtual; abstract;
|
|
// TCDCheckBox
|
|
procedure DrawCheckBoxSquare(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
|
|
procedure DrawCheckBox(ADest: TCanvas; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
|
|
// TCDRadioButton
|
|
procedure DrawRadioButtonCircle(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
|
|
procedure DrawRadioButton(ADest: TCanvas; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
|
|
// TCDComboBox
|
|
procedure DrawComboBox(ADest: TCanvas; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDEditStateEx); virtual; abstract;
|
|
// TCDScrollBar
|
|
procedure DrawScrollBar(ADest: TCanvas; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDPositionedCStateEx); virtual; abstract;
|
|
// TCDGroupBox
|
|
procedure DrawGroupBox(ADest: TFPCustomCanvas; ADestPos: TPoint; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
|
|
// TCDPanel
|
|
procedure DrawPanel(ADest: TCanvas; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDPanelStateEx); virtual; abstract;
|
|
// ===================================
|
|
// Additional Tab
|
|
// ===================================
|
|
procedure DrawStaticText(ADest: TCanvas; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
|
|
// ===================================
|
|
// Common Controls Tab
|
|
// ===================================
|
|
// TCDTrackBar
|
|
procedure DrawTrackBar(ADest: TCanvas; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDPositionedCStateEx); virtual; abstract;
|
|
// TCDProgressBar
|
|
procedure DrawProgressBar(ADest: TCanvas; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDProgressBarStateEx); virtual; abstract;
|
|
// TCDListView
|
|
procedure DrawListView(ADest: TCanvas; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDListViewStateEx); virtual; abstract;
|
|
procedure DrawReportListView(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDListViewStateEx); virtual; abstract;
|
|
procedure DrawReportListViewItem(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
|
|
ACurItem: TCDListItems; AState: TCDControlState; AStateEx: TCDListViewStateEx); virtual; abstract;
|
|
// TCDToolBar
|
|
procedure DrawToolBar(ADest: TCanvas; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDToolBarStateEx); virtual; abstract;
|
|
procedure DrawToolBarItem(ADest: TCanvas; ASize: TSize;
|
|
ACurItem: TCDToolBarItem; AX, AY: Integer;
|
|
AState: TCDControlState; AStateEx: TCDToolBarStateEx); virtual; abstract;
|
|
// TCDCustomTabControl
|
|
procedure DrawCTabControl(ADest: TCanvas; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDCTabControlStateEx); virtual; abstract;
|
|
procedure DrawCTabControlFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDCTabControlStateEx); virtual; abstract;
|
|
procedure DrawTabSheet(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDCTabControlStateEx); virtual; abstract;
|
|
procedure DrawTabs(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDCTabControlStateEx); virtual; abstract;
|
|
procedure DrawTab(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDCTabControlStateEx); virtual; abstract;
|
|
// ===================================
|
|
// Misc Tab
|
|
// ===================================
|
|
procedure DrawSpinEdit(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
|
|
AState: TCDControlState; AStateEx: TCDSpinStateEx); virtual; abstract;
|
|
end;
|
|
|
|
procedure RegisterDrawer(ADrawer: TCDDrawer; AStyle: TCDDrawStyle);
|
|
function GetDefaultDrawer: TCDDrawer;
|
|
function GetDrawer(AStyle: TCDDrawStyle): TCDDrawer;
|
|
|
|
var
|
|
DefaultStyle: TCDDrawStyle = dsCommon; // For now default to the most complete one, later per platform
|
|
|
|
implementation
|
|
|
|
var
|
|
RegisteredDrawers: array[TCDDrawStyle] of TCDDrawer
|
|
= (nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil);
|
|
|
|
procedure RegisterDrawer(ADrawer: TCDDrawer; AStyle: TCDDrawStyle);
|
|
begin
|
|
if RegisteredDrawers[AStyle] <> nil then RegisteredDrawers[AStyle].Free;
|
|
RegisteredDrawers[AStyle] := ADrawer;
|
|
end;
|
|
|
|
function GetDefaultDrawer: TCDDrawer;
|
|
begin
|
|
Result := GetDrawer(dsDefault);
|
|
end;
|
|
|
|
function GetDrawer(AStyle: TCDDrawStyle): TCDDrawer;
|
|
var
|
|
lDrawStyle: TCDDrawStyle;
|
|
begin
|
|
if AStyle = dsDefault then lDrawStyle := DefaultStyle
|
|
else lDrawStyle := AStyle;
|
|
Result := RegisteredDrawers[lDrawStyle];
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
|
|
{ TCDColorPalette }
|
|
|
|
procedure TCDColorPalette.Assign(AFrom: TCDColorPalette);
|
|
begin
|
|
ScrollBar := AFrom.ScrollBar;
|
|
Background := AFrom.Background;
|
|
ActiveCaption := AFrom.ActiveCaption;
|
|
InactiveCaption := AFrom.InactiveCaption;
|
|
Menu := AFrom.Menu;
|
|
Window := AFrom.Window;
|
|
WindowFrame := AFrom.WindowFrame;
|
|
MenuText := AFrom.MenuText;
|
|
WindowText := AFrom.WindowText;
|
|
CaptionText := AFrom.CaptionText;
|
|
ActiveBorder := AFrom.ActiveBorder;
|
|
InactiveBorder := AFrom.InactiveBorder;
|
|
AppWorkspace := AFrom.AppWorkspace;
|
|
Highlight := AFrom.Highlight;
|
|
HighlightText := AFrom.HighlightText;
|
|
BtnFace := AFrom.BtnFace;
|
|
BtnShadow := AFrom.BtnShadow;
|
|
GrayText := AFrom.GrayText;
|
|
BtnText := AFrom.BtnText;
|
|
InactiveCaptionText := AFrom.InactiveCaptionText;
|
|
BtnHighlight := AFrom.BtnHighlight;
|
|
color3DDkShadow := AFrom.color3DDkShadow;
|
|
color3DLight := AFrom.color3DLight;
|
|
InfoText := AFrom.InfoText;
|
|
InfoBk := AFrom.InfoBk;
|
|
//
|
|
HotLight := AFrom.HotLight;
|
|
GradientActiveCaption := AFrom.GradientActiveCaption;
|
|
GradientInactiveCaption := AFrom.GradientInactiveCaption;
|
|
MenuHighlight := AFrom.MenuHighlight;
|
|
MenuBar := AFrom.MenuBar;
|
|
Form := AFrom.Form;
|
|
end;
|
|
|
|
{ TCDListItems }
|
|
|
|
procedure TCDListItems.DoFreeItem(data, arg: pointer);
|
|
begin
|
|
TCDListItems(data).Free;
|
|
end;
|
|
|
|
constructor TCDListItems.Create;
|
|
begin
|
|
inherited Create;
|
|
Childs := TFPList.Create;
|
|
end;
|
|
|
|
destructor TCDListItems.Destroy;
|
|
begin
|
|
Childs.ForEachCall(@DoFreeItem, nil);
|
|
Childs.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TCDListItems.Add(ACaption: string; AImageIndex, AStateIndex: Integer
|
|
): TCDListItems;
|
|
begin
|
|
Result := TCDListItems.Create;
|
|
Result.Caption := ACaption;
|
|
Result.ImageIndex := AImageIndex;
|
|
Result.StateIndex := AStateIndex;
|
|
Childs.Add(Pointer(Result));
|
|
end;
|
|
|
|
function TCDListItems.GetItem(AIndex: Integer): TCDListItems;
|
|
begin
|
|
Result := TCDListItems(Childs.Items[AIndex]);
|
|
end;
|
|
|
|
function TCDListItems.GetItemCount: Integer;
|
|
begin
|
|
Result := Childs.Count;
|
|
end;
|
|
|
|
{ TCDDrawer }
|
|
|
|
constructor TCDDrawer.Create;
|
|
begin
|
|
inherited Create;
|
|
|
|
// We never load the system palette at creation because we might get created
|
|
// before the Widgetset is constructed
|
|
Palette := TCDColorPalette.Create;
|
|
LoadFallbackPaletteColors();
|
|
FallbackPalette := TCDColorPalette.Create;
|
|
FallbackPalette.Assign(Palette);
|
|
PaletteKind := palDefault;
|
|
|
|
CreateResources;
|
|
LoadResources;
|
|
end;
|
|
|
|
destructor TCDDrawer.Destroy;
|
|
begin
|
|
FreeResources;
|
|
Palette.Free;
|
|
FallbackPalette.Free;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TCDDrawer.CreateResources;
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TCDDrawer.LoadResources;
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TCDDrawer.FreeResources;
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TCDDrawer.ScaleRasterImage(ARasterImage: TRasterImage; ASourceDPI, ADestDPI: Word);
|
|
var
|
|
lNewWidth, lNewHeight: Int64;
|
|
lTmpBmp: TBitmap;
|
|
begin
|
|
lNewWidth := Round(ARasterImage.Width * ADestDPI / ASourceDPI);
|
|
lNewHeight := Round(ARasterImage.Height * ADestDPI / ASourceDPI);
|
|
lTmpBmp := TBitmap.Create;
|
|
try
|
|
lTmpBmp.Width := ARasterImage.Width;
|
|
lTmpBmp.Height := ARasterImage.Height;
|
|
lTmpBmp.Canvas.Draw(0, 0, ARasterImage);
|
|
ARasterImage.Canvas.StretchDraw(Bounds(0, 0, lNewWidth, lNewHeight), lTmpBmp);
|
|
finally
|
|
lTmpBmp.Free;
|
|
end;
|
|
ARasterImage.Width := lNewWidth;
|
|
ARasterImage.Height := lNewHeight;
|
|
end;
|
|
|
|
procedure TCDDrawer.LoadPalette;
|
|
begin
|
|
case PaletteKind of
|
|
palDefault:
|
|
begin
|
|
if PalDefaultUsesNativePalette() then LoadNativePaletteColors()
|
|
else LoadFallbackPaletteColors();
|
|
end;
|
|
palNative: LoadNativePaletteColors();
|
|
palFallback: LoadFallbackPaletteColors();
|
|
//palUserConfig:
|
|
end;
|
|
end;
|
|
|
|
procedure TCDDrawer.LoadNativePaletteColors;
|
|
begin
|
|
Palette.ScrollBar := ColorToRGB(clScrollBar);
|
|
Palette.Background := ColorToRGB(clBackground);
|
|
Palette.ActiveCaption := ColorToRGB(clActiveCaption);
|
|
Palette.InactiveCaption := ColorToRGB(clInactiveCaption);
|
|
Palette.Menu := ColorToRGB(clMenu);
|
|
Palette.Window := ColorToRGB(clWindow);
|
|
Palette.WindowFrame := ColorToRGB(clWindowFrame);
|
|
Palette.MenuText := ColorToRGB(clMenuText);
|
|
Palette.WindowText := ColorToRGB(clWindowText);
|
|
Palette.CaptionText := ColorToRGB(clCaptionText);
|
|
Palette.ActiveBorder := ColorToRGB(clActiveBorder);
|
|
Palette.InactiveBorder := ColorToRGB(clInactiveBorder);
|
|
Palette.AppWorkspace := ColorToRGB(clAppWorkspace);
|
|
Palette.Highlight := ColorToRGB(clHighlight);
|
|
Palette.HighlightText := ColorToRGB(clHighlightText);
|
|
Palette.BtnFace := ColorToRGB(clBtnFace);
|
|
Palette.BtnShadow := ColorToRGB(clBtnShadow);
|
|
Palette.GrayText := ColorToRGB(clGrayText);
|
|
Palette.BtnText := ColorToRGB(clBtnText);
|
|
Palette.InactiveCaptionText := ColorToRGB(clInactiveCaptionText);
|
|
Palette.BtnHighlight := ColorToRGB(clBtnHighlight);
|
|
Palette.color3DDkShadow := ColorToRGB(cl3DDkShadow);
|
|
Palette.color3DLight := ColorToRGB(cl3DLight);
|
|
Palette.InfoText := ColorToRGB(clInfoText);
|
|
Palette.InfoBk := ColorToRGB(clInfoBk);
|
|
|
|
Palette.HotLight := ColorToRGB(clHotLight);
|
|
Palette.GradientActiveCaption := ColorToRGB(clGradientActiveCaption);
|
|
Palette.GradientInactiveCaption := ColorToRGB(clGradientInactiveCaption);
|
|
Palette.MenuHighlight := ColorToRGB(clMenuHighlight);
|
|
Palette.MenuBar := ColorToRGB(clMenuBar);
|
|
Palette.Form := ColorToRGB(clForm);
|
|
end;
|
|
|
|
procedure TCDDrawer.LoadFallbackPaletteColors;
|
|
begin
|
|
|
|
end;
|
|
|
|
function TCDDrawer.PalDefaultUsesNativePalette: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TCDDrawer.GetDrawStyle: TCDDrawStyle;
|
|
begin
|
|
Result := dsCommon;
|
|
end;
|
|
|
|
class function TCDDrawer.VisibleText(const aVisibleText: TCaption; const APasswordChar: Char): TCaption;
|
|
begin
|
|
if aPasswordChar = #0 then
|
|
result := aVisibleText
|
|
else
|
|
result := StringOfChar( aPasswordChar, UTF8Length(aVisibleText) );
|
|
end;
|
|
|
|
{ Control colors can refer to their background or foreground }
|
|
function TCDDrawer.GetControlDefaultColor(AControlId: TCDControlID): TColor;
|
|
begin
|
|
case AControlId of
|
|
cidControl: Result := Palette.Form;
|
|
cidButton: Result := Palette.BtnFace;// foreground color
|
|
cidEdit: Result := Palette.Window; // foreground color
|
|
cidCheckBox: Result := Palette.Form; // background color
|
|
cidGroupBox: Result := Palette.Form; // ...
|
|
//
|
|
cidStaticText: Result := Palette.Form; // ...
|
|
//
|
|
cidTrackBar: Result := Palette.Form; // ...
|
|
cidProgressBar: Result := Palette.Form; // foreground color
|
|
cidListView: Result := Palette.Window; // foreground color
|
|
cidCTabControl: Result := Palette.Form; // foreground color
|
|
else
|
|
Result := Palette.Form;
|
|
end;
|
|
end;
|
|
|
|
procedure TCDDrawer.DrawControl(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
|
|
AControl: TCDControlID; AState: TCDControlState; AStateEx: TCDControlStateEx
|
|
);
|
|
begin
|
|
case AControl of
|
|
cidControl: DrawControl(ADest, ASize, AState, AStateEx);
|
|
//
|
|
cidButton: DrawButton(ADest, ADestPos, ASize, AState, TCDButtonStateEx(AStateEx));
|
|
cidEdit: DrawEdit(ADest, ASize, AState, TCDEditStateEx(AStateEx));
|
|
cidCheckBox: DrawCheckBox(ADest, ASize, AState, AStateEx);
|
|
cidRadioButton:DrawRadioButton(ADest, ASize, AState, AStateEx);
|
|
cidComboBox: DrawComboBox(ADest, ASize, AState, TCDEditStateEx(AStateEx));
|
|
cidScrollBar: DrawScrollBar(ADest, ASize, AState, TCDPositionedCStateEx(AStateEx));
|
|
cidGroupBox: DrawGroupBox(ADest, ADestPos, ASize, AState, AStateEx);
|
|
cidPanel: DrawPanel(ADest, ASize, AState, TCDPanelStateEx(AStateEx));
|
|
//
|
|
cidStaticText: DrawStaticText(ADest, ASize, AState, AStateEx);
|
|
//
|
|
cidTrackBar: DrawTrackBar(ADest, ASize, AState, TCDPositionedCStateEx(AStateEx));
|
|
cidProgressBar:DrawProgressBar(ADest, ASize, AState, TCDProgressBarStateEx(AStateEx));
|
|
cidListView: DrawListView(ADest, ASize, AState, TCDListViewStateEx(AStateEx));
|
|
cidToolBar: DrawToolBar(ADest, ASize, AState, TCDToolBarStateEx(AStateEx));
|
|
cidCTabControl:DrawCTabControl(ADest, ASize, AState, TCDCTabControlStateEx(AStateEx));
|
|
end;
|
|
end;
|
|
|
|
finalization
|
|
// Free all drawers
|
|
for i := 0 to CDDRAWSTYLE_COUNT-1 do
|
|
begin
|
|
if RegisteredDrawers[TCDDrawStyle(i)] <> nil then
|
|
begin
|
|
RegisteredDrawers[TCDDrawStyle(i)].Free;
|
|
RegisteredDrawers[TCDDrawStyle(i)] := nil;
|
|
end;
|
|
end;
|
|
end.
|
|
|