david
03dfd8c7c1
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.SpTBXLib@4 aa3591e4-a9f2-482a-ba07-9d38a056ee4e
3679 lines
124 KiB
ObjectPascal
3679 lines
124 KiB
ObjectPascal
unit SpTBXSkins;
|
|
|
|
{==============================================================================
|
|
Version 2.4.4
|
|
|
|
The contents of this file are subject to the SpTBXLib License; you may
|
|
not use or distribute this file except in compliance with the
|
|
SpTBXLib License.
|
|
A copy of the SpTBXLib License may be found in SpTBXLib-LICENSE.txt or at:
|
|
http://www.silverpointdevelopment.com/sptbxlib/SpTBXLib-LICENSE.htm
|
|
|
|
Alternatively, the contents of this file may be used under the terms of the
|
|
Mozilla Public License Version 1.1 (the "MPL v1.1"), in which case the provisions
|
|
of the MPL v1.1 are applicable instead of those in the SpTBXLib License.
|
|
A copy of the MPL v1.1 may be found in MPL-LICENSE.txt or at:
|
|
http://www.mozilla.org/MPL/
|
|
|
|
If you wish to allow use of your version of this file only under the terms of
|
|
the MPL v1.1 and not to allow others to use your version of this file under the
|
|
SpTBXLib License, indicate your decision by deleting the provisions
|
|
above and replace them with the notice and other provisions required by the
|
|
MPL v1.1. If you do not delete the provisions above, a recipient may use your
|
|
version of this file under either the SpTBXLib License or the MPL v1.1.
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The initial developer of this code is Robert Lee.
|
|
|
|
Requirements:
|
|
For Delphi/C++Builder 2009 or newer:
|
|
- Jordan Russell's Toolbar 2000
|
|
http://www.jrsoftware.org
|
|
For Delphi/C++Builder 7-2007:
|
|
- Jordan Russell's Toolbar 2000
|
|
http://www.jrsoftware.org
|
|
- Troy Wolbrink's TNT Unicode Controls
|
|
http://www.tntware.com/delphicontrols/unicode/
|
|
|
|
Development notes:
|
|
- All the Windows and Delphi bugs fixes are marked with '[Bugfix]'.
|
|
- All the theme changes and adjustments are marked with '[Theme-Change]'.
|
|
- DT_END_ELLIPSIS and DT_PATH_ELLIPSIS doesn't work with rotated text
|
|
http://support.microsoft.com/kb/249678
|
|
|
|
History:
|
|
2 December 2009 - version 2.4.4
|
|
- Renamed the OfficeMenuSeparator skin option to OfficeMenu.
|
|
|
|
13 September 2009 - version 2.4.3
|
|
- Improved the gradient painting performance, it's 2x faster on
|
|
Vista/Win7, thanks to Kyan and Jim Kueneman for the code donation.
|
|
- Fixed CurrentSkin.GetTextColor bug, it didn't return the
|
|
correct skncDockablePanelTitleBar text color when using
|
|
the EOS skin, thanks to Aaron Taylor for reporting this.
|
|
- Fixed CurrentSkin.GetTextColor bug, it didn't return the
|
|
correct skncButton disabled text color on Windows Vista,
|
|
thanks to Arvid for reporting this.
|
|
|
|
8 May 2009 - version 2.4.2
|
|
- No changes.
|
|
|
|
15 March 2009 - version 2.4.1
|
|
- Added OnSkinChange event to TSpTBXSkinManager.
|
|
|
|
17 January 2009 - version 2.4
|
|
- Minor Fixes.
|
|
|
|
26 September 2008 - version 2.3
|
|
- Fixed incorrect skin loading when the Aluminum skin was used,
|
|
thanks to Costas Stergiou for reporting this.
|
|
|
|
29 July 2008 - version 2.2
|
|
- Fixed incorrect menu items painting on Vista when the Windows
|
|
themes was disabled, thanks to Arvid for reporting this.
|
|
|
|
26 June 2008 - version 2.1
|
|
- Added Windows Vista specific constants to support Vista
|
|
themes on Delphi versions prior to 2007, thanks to Wolf B.
|
|
for his contribution.
|
|
|
|
3 May 2008 - version 2.0
|
|
- Renamed TSpTBXSkinOptions.TitleBarBorderSize to
|
|
FloatingWindowBorderSize.
|
|
|
|
2 April 2008 - version 1.9.5
|
|
- No changes.
|
|
|
|
3 February 2008 - version 1.9.4
|
|
- Added TitleBarBorderSize to the skins options.
|
|
|
|
19 January 2008 - version 1.9.3
|
|
- No changes.
|
|
|
|
26 December 2007 - version 1.9.2
|
|
- New gradient skin style added to mimic Vista toolbar gradients, use
|
|
9 or 10 gradient style to paint vertically or horizontally.
|
|
|
|
1 December 2007 - version 1.9.1
|
|
- Added Header and Tabs Toolbar skinning. skncHeader and skncTabToolbar
|
|
skin elements were added to the skin components type.
|
|
- Added SpDrawXPHeader utility function to paint the header controls.
|
|
|
|
20 November 2007 - version 1.9
|
|
- Initial release.
|
|
|
|
==============================================================================}
|
|
|
|
interface
|
|
|
|
{$BOOLEVAL OFF} // Unit depends on short-circuit boolean evaluation
|
|
|
|
// Use GradientFill API instead of FillRect to paint the gradients
|
|
// GradientFill vs FillRect: http://www.mustangpeak.net/phpBB2/viewtopic.php?f=12&t=2109
|
|
{$DEFINE SYSTEM_GRADIENT}
|
|
|
|
uses
|
|
Windows, Messages, Classes, SysUtils, Graphics, Controls, StdCtrls,
|
|
ImgList, IniFiles;
|
|
|
|
const
|
|
WM_SPSKINCHANGE = WM_APP + 2007; // Skin change notification message
|
|
|
|
{ Windows Vista theme painting constants }
|
|
MENU_BARITEM = 8;
|
|
MENU_POPUPBACKGROUND = 9;
|
|
MENU_POPUPBORDERS = 10;
|
|
MENU_POPUPCHECK = 11;
|
|
MENU_POPUPCHECKBACKGROUND = 12;
|
|
MENU_POPUPGUTTER = 13;
|
|
MENU_POPUPITEM = 14;
|
|
MENU_POPUPSEPARATOR = 15;
|
|
MBI_NORMAL = 1;
|
|
MBI_HOT = 2;
|
|
MBI_PUSHED = 3;
|
|
MBI_DISABLED = 4;
|
|
MBI_DISABLEDHOT = 5;
|
|
MBI_DISABLEDPUSHED = 6;
|
|
MPI_NORMAL = 1;
|
|
MPI_HOT = 2;
|
|
MPI_DISABLED = 3;
|
|
MPI_DISABLEDHOT = 4;
|
|
MCB_DISABLED = 1;
|
|
MCB_NORMAL = 2;
|
|
MCB_BITMAP = 3;
|
|
MC_CHECKMARKNORMAL = 1;
|
|
MC_CHECKMARKDISABLED = 2;
|
|
MC_BULLETNORMAL = 3;
|
|
MC_BULLETDISABLED = 4;
|
|
|
|
type
|
|
{ Skins }
|
|
|
|
TSpTBXSkinType = (
|
|
sknNone, // No themes
|
|
sknWindows, // Use Windows themes
|
|
sknSkin // Use Skins
|
|
);
|
|
|
|
TSpTBXLunaScheme = (
|
|
lusBlue,
|
|
lusMetallic,
|
|
lusGreen,
|
|
lusUnknown
|
|
);
|
|
|
|
TSpTBXSkinComponentsType = (
|
|
skncDock,
|
|
skncDockablePanel,
|
|
skncDockablePanelTitleBar,
|
|
skncGutter,
|
|
skncMenuBar,
|
|
skncOpenToolbarItem,
|
|
skncPanel,
|
|
skncPopup,
|
|
skncSeparator,
|
|
skncSplitter,
|
|
skncStatusBar,
|
|
skncStatusBarGrip,
|
|
skncTabBackground,
|
|
skncTabToolbar,
|
|
skncToolbar,
|
|
skncToolbarGrip,
|
|
skncWindow,
|
|
skncWindowTitleBar,
|
|
|
|
// Multiple States
|
|
skncMenuBarItem,
|
|
skncMenuItem,
|
|
skncToolbarItem,
|
|
skncButton,
|
|
skncCheckBox,
|
|
skncEditButton,
|
|
skncEditFrame,
|
|
skncHeader,
|
|
skncLabel,
|
|
skncListItem,
|
|
skncProgressBar,
|
|
skncRadioButton,
|
|
skncTab,
|
|
skncTrackBar,
|
|
skncTrackBarButton
|
|
);
|
|
TSpTBXSkinStatesType = (sknsNormal, sknsDisabled, sknsHotTrack, sknsPushed, sknsChecked, sknsCheckedAndHotTrack);
|
|
|
|
TSpTBXSkinStatesSet = set of TSpTBXSkinStatesType;
|
|
|
|
TSpTBXSkinPartsType = (sknpBody, sknpBorders, sknpText);
|
|
|
|
TSpTBXSkinComponentsIdentEntry = record
|
|
Name: string;
|
|
States: TSpTBXSkinStatesSet;
|
|
end;
|
|
|
|
const
|
|
SpTBXSkinMultiStateComponents: set of TSpTBXSkinComponentsType = [skncMenuBarItem..High(TSpTBXSkinComponentsType)];
|
|
|
|
CSpTBXSkinAllStates = [Low(TSpTBXSkinStatesType)..High(TSpTBXSkinStatesType)];
|
|
CSpTBXSkinComponents: array [TSpTBXSkinComponentsType] of TSpTBXSkinComponentsIdentEntry = (
|
|
// Single state Components
|
|
(Name: 'Dock'; States: [sknsNormal]),
|
|
(Name: 'DockablePanel'; States: [sknsNormal]),
|
|
(Name: 'DockablePanelTitleBar'; States: [sknsNormal]),
|
|
(Name: 'Gutter'; States: [sknsNormal]),
|
|
(Name: 'MenuBar'; States: [sknsNormal]),
|
|
(Name: 'OpenToolbarItem'; States: [sknsNormal]),
|
|
(Name: 'Panel'; States: [sknsNormal]),
|
|
(Name: 'Popup'; States: [sknsNormal]),
|
|
(Name: 'Separator'; States: [sknsNormal]),
|
|
(Name: 'Splitter'; States: [sknsNormal]),
|
|
(Name: 'StatusBar'; States: [sknsNormal]),
|
|
(Name: 'StatusBarGrip'; States: [sknsNormal]),
|
|
(Name: 'TabBackground'; States: [sknsNormal]),
|
|
(Name: 'TabToolbar'; States: [sknsNormal]),
|
|
(Name: 'Toolbar'; States: [sknsNormal]),
|
|
(Name: 'ToolbarGrip'; States: [sknsNormal]),
|
|
(Name: 'Window'; States: [sknsNormal]),
|
|
(Name: 'WindowTitleBar'; States: [sknsNormal]),
|
|
// Multi state Components
|
|
(Name: 'MenuBarItem'; States: CSpTBXSkinAllStates),
|
|
(Name: 'MenuItem'; States: CSpTBXSkinAllStates),
|
|
(Name: 'ToolbarItem'; States: CSpTBXSkinAllStates),
|
|
(Name: 'Button'; States: CSpTBXSkinAllStates),
|
|
(Name: 'CheckBox'; States: CSpTBXSkinAllStates),
|
|
(Name: 'EditButton'; States: CSpTBXSkinAllStates),
|
|
(Name: 'EditFrame'; States: [sknsNormal, sknsDisabled, sknsHotTrack]),
|
|
(Name: 'Header'; States: [sknsNormal, sknsDisabled, sknsHotTrack, sknsPushed]),
|
|
(Name: 'Label'; States: [sknsNormal, sknsDisabled]),
|
|
(Name: 'ListItem'; States: CSpTBXSkinAllStates),
|
|
(Name: 'ProgressBar'; States: [sknsNormal, sknsHotTrack]),
|
|
(Name: 'RadioButton'; States: CSpTBXSkinAllStates),
|
|
(Name: 'Tab'; States: CSpTBXSkinAllStates),
|
|
(Name: 'TrackBar'; States: [sknsNormal, sknsHotTrack]),
|
|
(Name: 'TrackBarButton'; States: [sknsNormal, sknsPushed])
|
|
);
|
|
|
|
SSpTBXSkinStatesString: array [TSpTBXSkinStatesType] of string = ('Normal', 'Disabled', 'HotTrack', 'Pushed', 'Checked', 'CheckedAndHotTrack');
|
|
SSpTBXSkinDisplayStatesString: array [TSpTBXSkinStatesType] of string = ('Normal', 'Disabled', 'Hot', 'Pushed', 'Checked', 'Checked && Hot');
|
|
|
|
type
|
|
{ Text }
|
|
|
|
TSpTextRotationAngle = (
|
|
tra0, // No rotation
|
|
tra90, // 90 degree rotation
|
|
tra270 // 270 degree rotation
|
|
);
|
|
|
|
TSpTBXTextInfo = record
|
|
Text: WideString;
|
|
TextAngle: TSpTextRotationAngle;
|
|
TextFlags: Cardinal;
|
|
TextSize: TSize;
|
|
IsCaptionShown: Boolean;
|
|
IsTextRotated: Boolean;
|
|
end;
|
|
|
|
TSpGlyphLayout = (
|
|
ghlGlyphLeft, // Glyph icon on the left of the caption
|
|
ghlGlyphTop // Glyph icon on the top of the caption
|
|
);
|
|
|
|
TSpGlowDirection = (
|
|
gldNone, // No glow
|
|
gldAll, // Glow on Left, Top, Right and Bottom of the text
|
|
gldTopLeft, // Glow on Top-Left of the text
|
|
gldBottomRight // Glow on Bottom-Right of the text
|
|
);
|
|
|
|
{ MenuItem }
|
|
|
|
TSpTBXComboPart = (cpNone, cpCombo, cpSplitLeft, cpSplitRight);
|
|
TSpTBXMenuItemMarginsInfo = record
|
|
Margins: TRect; // MenuItem margins
|
|
GutterSize: Integer; // Size of the gutter
|
|
LeftCaptionMargin: Integer; // Left margin of the caption
|
|
RightCaptionMargin: Integer; // Right margin of the caption
|
|
ImageTextSpace: Integer; // Space between the Icon and the caption
|
|
end;
|
|
|
|
TSpTBXMenuItemInfo = record
|
|
Enabled: Boolean;
|
|
HotTrack: Boolean;
|
|
Pushed: Boolean;
|
|
Checked: Boolean;
|
|
HasArrow: Boolean;
|
|
ImageShown: Boolean;
|
|
ImageOrCheckShown: Boolean;
|
|
ImageSize: TSize;
|
|
RightImageSize: TSize;
|
|
IsDesigning: Boolean;
|
|
IsOnMenuBar: Boolean;
|
|
IsOnToolbox: Boolean;
|
|
IsOpen: Boolean;
|
|
IsSplit: Boolean;
|
|
IsSunkenCaption: Boolean;
|
|
IsVertical: Boolean;
|
|
MenuMargins: TSpTBXMenuItemMarginsInfo; // Used only on menu items
|
|
ComboPart: TSpTBXComboPart;
|
|
ComboRect: TRect;
|
|
ComboState: TSpTBXSkinStatesType;
|
|
ToolbarStyle: Boolean;
|
|
State: TSpTBXSkinStatesType;
|
|
SkinType: TSpTBXSkinType;
|
|
end;
|
|
|
|
{ Colors }
|
|
|
|
TSpTBXColorTextType = (
|
|
cttDefault, // Default format (clWhite, $FFFFFF)
|
|
cttHTML, // HTML format (#FFFFFF)
|
|
cttIdentAndHTML // Use color idents (clWhite), if not possible use HTML format
|
|
);
|
|
|
|
{ TSpTBXSkinOptions }
|
|
|
|
TSpTBXSkinOptionEntry = class(TPersistent)
|
|
private
|
|
FSkinType: Integer;
|
|
FColor1, FColor2, FColor3, FColor4: TColor;
|
|
protected
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
public
|
|
constructor Create; virtual;
|
|
procedure Fill(ASkinType: Integer; AColor1, AColor2, AColor3, AColor4: TColor);
|
|
procedure ReadFromString(S: string);
|
|
function WriteToString: string;
|
|
function IsEmpty: Boolean;
|
|
function IsEqual(AOptionEntry: TSpTBXSkinOptionEntry): Boolean;
|
|
procedure Lighten(Amount: Integer);
|
|
procedure Reset;
|
|
published
|
|
property SkinType: Integer read FSkinType write FSkinType;
|
|
property Color1: TColor read FColor1 write FColor1;
|
|
property Color2: TColor read FColor2 write FColor2;
|
|
property Color3: TColor read FColor3 write FColor3;
|
|
property Color4: TColor read FColor4 write FColor4;
|
|
end;
|
|
|
|
TSpTBXSkinOptionCategory = class(TPersistent)
|
|
private
|
|
FBody: TSpTBXSkinOptionEntry;
|
|
FBorders: TSpTBXSkinOptionEntry;
|
|
FTextColor: TColor;
|
|
protected
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
public
|
|
constructor Create; virtual;
|
|
destructor Destroy; override;
|
|
function IsEmpty: Boolean;
|
|
procedure Reset;
|
|
procedure LoadFromIni(MemIni: TMemIniFile; Section, Ident: string);
|
|
procedure SaveToIni(MemIni: TMemIniFile; Section, Ident: string);
|
|
published
|
|
property Body: TSpTBXSkinOptionEntry read FBody write FBody;
|
|
property Borders: TSpTBXSkinOptionEntry read FBorders write FBorders;
|
|
property TextColor: TColor read FTextColor write FTextColor;
|
|
end;
|
|
|
|
TSpTBXSkinOptions = class(TPersistent)
|
|
private
|
|
FColorBtnFace: TColor;
|
|
FFloatingWindowBorderSize: Integer;
|
|
FOptions: array [TSpTBXSkinComponentsType, TSpTBXSkinStatesType] of TSpTBXSkinOptionCategory;
|
|
FOfficeIcons: Boolean;
|
|
FOfficeMenu: Boolean;
|
|
FOfficeStatusBar: Boolean;
|
|
FSkinAuthor: string;
|
|
FSkinName: string;
|
|
function GetOfficeIcons: Boolean;
|
|
function GetOfficeMenu: Boolean;
|
|
function GetOfficePopup: Boolean;
|
|
function GetOfficeStatusBar: Boolean;
|
|
function GetFloatingWindowBorderSize: Integer;
|
|
procedure SetFloatingWindowBorderSize(const Value: Integer);
|
|
protected
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
procedure BroadcastChanges;
|
|
public
|
|
constructor Create; virtual;
|
|
destructor Destroy; override;
|
|
procedure CopyOptions(AComponent, ToComponent: TSpTBXSkinComponentsType);
|
|
procedure FillOptions; virtual;
|
|
function Options(Component: TSpTBXSkinComponentsType; State: TSpTBXSkinStatesType): TSpTBXSkinOptionCategory; overload;
|
|
function Options(Component: TSpTBXSkinComponentsType): TSpTBXSkinOptionCategory; overload;
|
|
procedure LoadFromFile(Filename: WideString);
|
|
procedure LoadFromStrings(L: TStrings); virtual;
|
|
procedure SaveToFile(Filename: WideString);
|
|
procedure SaveToStrings(L: TStrings); virtual;
|
|
procedure SaveToMemIni(MemIni: TMemIniFile); virtual;
|
|
procedure Reset(ForceResetSkinProperties: Boolean = False);
|
|
|
|
// Metrics
|
|
procedure GetDropDownArrowSize(out DropDownArrowSize, DropDownArrowMargin, SplitBtnArrowSize: Integer); virtual;
|
|
procedure GetMenuItemMargins(ACanvas: TCanvas; ImgSize: Integer; out MarginsInfo: TSpTBXMenuItemMarginsInfo); virtual;
|
|
function GetState(Enabled, Pushed, HotTrack, Checked: Boolean): TSpTBXSkinStatesType;
|
|
function GetTextColor(Component: TSpTBXSkinComponentsType; State: TSpTBXSkinStatesType; SkinType: TSpTBXSkinType = sknSkin): TColor; virtual;
|
|
|
|
// Skin Paint
|
|
procedure PaintBackground(ACanvas: TCanvas; ARect: TRect; Component: TSpTBXSkinComponentsType; State: TSpTBXSkinStatesType; Background, Borders: Boolean; Vertical: Boolean = False; ForceRectBorders: TAnchors = []); virtual;
|
|
|
|
// Element Paint
|
|
procedure PaintMenuCheckMark(ACanvas: TCanvas; ARect: TRect; Checked, Grayed, MenuItemStyle: Boolean; State: TSpTBXSkinStatesType); virtual;
|
|
procedure PaintMenuRadioMark(ACanvas: TCanvas; ARect: TRect; Checked, MenuItemStyle: Boolean; State: TSpTBXSkinStatesType); virtual;
|
|
procedure PaintWindowFrame(ACanvas: TCanvas; ARect: TRect; IsActive, DrawBody: Boolean; BorderSize: Integer = 4); virtual;
|
|
|
|
// Properties
|
|
property ColorBtnFace: TColor read FColorBtnFace write FColorBtnFace;
|
|
property FloatingWindowBorderSize: Integer read GetFloatingWindowBorderSize write SetFloatingWindowBorderSize;
|
|
property OfficeIcons: Boolean read GetOfficeIcons write FOfficeIcons;
|
|
property OfficeMenu: Boolean read GetOfficeMenu write FOfficeMenu;
|
|
property OfficePopup: Boolean read GetOfficePopup;
|
|
property OfficeStatusBar: Boolean read GetOfficeStatusBar write FOfficeStatusBar;
|
|
property SkinAuthor: string read FSkinAuthor write FSkinAuthor;
|
|
property SkinName: string read FSkinName write FSkinName;
|
|
end;
|
|
|
|
TSpTBXSkinOptionsClass = class of TSpTBXSkinOptions;
|
|
|
|
{ TSpTBXSkinsList }
|
|
|
|
TSpTBXSkinsListEntry = class
|
|
public
|
|
SkinClass: TSpTBXSkinOptionsClass;
|
|
SkinStrings: TStringList;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
TSpTBXSkinsList = class(TStringList)
|
|
private
|
|
function GetSkinOption(Index: Integer): TSpTBXSkinsListEntry;
|
|
public
|
|
procedure Delete(Index: Integer); override;
|
|
destructor Destroy; override;
|
|
function AddSkin(SkinName: string; SkinClass: TSpTBXSkinOptionsClass): Integer; overload;
|
|
function AddSkin(SkinOptions: TStrings): Integer; overload;
|
|
function AddSkinFromFile(Filename: WideString): Integer;
|
|
procedure AddSkinsFromFolder(Folder: WideString);
|
|
procedure GetSkinNames(SkinNames: TStrings);
|
|
property SkinOptions[Index: Integer]: TSpTBXSkinsListEntry read GetSkinOption;
|
|
end;
|
|
|
|
{ TSpTBXSkinManager }
|
|
|
|
TSpTBXSkinManager = class
|
|
private
|
|
FCurrentSkin: TSpTBXSkinOptions;
|
|
FNotifies: TList;
|
|
FSkinsList: TSpTBXSkinsList;
|
|
FOnSkinChange: TNotifyEvent;
|
|
procedure Broadcast;
|
|
function GetCurrentSkinName: string;
|
|
public
|
|
constructor Create; virtual;
|
|
destructor Destroy; override;
|
|
|
|
function GetSkinType: TSpTBXSkinType;
|
|
function IsDefaultSkin: Boolean;
|
|
function IsXPThemesEnabled: Boolean;
|
|
|
|
procedure AddSkinNotification(AObject: TObject);
|
|
procedure RemoveSkinNotification(AObject: TObject);
|
|
procedure BroadcastSkinNotification;
|
|
|
|
procedure LoadFromFile(Filename: WideString);
|
|
procedure SaveToFile(Filename: WideString);
|
|
|
|
procedure SetToDefaultSkin;
|
|
procedure SetSkin(SkinName: string);
|
|
procedure ChangeControlSkinType(Control: TWinControl; SkinType: TSpTBXSkinType; Recursive: Boolean = True);
|
|
|
|
property CurrentSkin: TSpTBXSkinOptions read FCurrentSkin;
|
|
property CurrentSkinName: string read GetCurrentSkinName;
|
|
property SkinsList: TSpTBXSkinsList read FSkinsList;
|
|
property OnSkinChange: TNotifyEvent read FOnSkinChange write FOnSkinChange;
|
|
end;
|
|
|
|
{ TSpTBXSkinSwitcher }
|
|
|
|
TSpTBXSkinSwitcher = class(TComponent)
|
|
private
|
|
FOnSkinChange: TNotifyEvent;
|
|
function GetSkin: string;
|
|
procedure SetSkin(const Value: string);
|
|
procedure WMSpSkinChange(var Message: TMessage); message WM_SPSKINCHANGE;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
property Skin: string read GetSkin write SetSkin;
|
|
property OnSkinChange: TNotifyEvent read FOnSkinChange write FOnSkinChange;
|
|
end;
|
|
|
|
{ TSpPrintWindow }
|
|
// Use SpPrintWindow instead of PaintTo as many controls will not render
|
|
// properly (no text on editors, no scrollbars, incorrect borders, etc)
|
|
// http://msdn2.microsoft.com/en-us/library/ms535695.aspx
|
|
TSpPrintWindow = function(Hnd: HWND; HdcBlt: HDC; nFlags: UINT): BOOL; stdcall;
|
|
|
|
{ Themes }
|
|
function SkinManager: TSpTBXSkinManager;
|
|
function CurrentSkin: TSpTBXSkinOptions;
|
|
function SpTBXSkinType(T: TSpTBXSkinType): TSpTBXSkinType;
|
|
function SpGetLunaScheme: TSpTBXLunaScheme;
|
|
procedure SpDrawParentBackground(Control: TControl; DC: HDC; R: TRect);
|
|
|
|
{ WideString helpers }
|
|
function SpCreateRotatedFont(DC: HDC; Orientation: Integer = 2700): HFONT;
|
|
function SpDrawRotatedText(const DC: HDC; AText: WideString; var ARect: TRect; const AFormat: Cardinal; RotationAngle: TSpTextRotationAngle = tra270): Integer;
|
|
function SpCalcXPText(ACanvas: TCanvas; ARect: TRect; Caption: WideString; CaptionAlignment: TAlignment; Flags: Cardinal; GlyphSize, RightGlyphSize: TSize; Layout: TSpGlyphLayout; PushedCaption: Boolean; out ACaptionRect, AGlyphRect, ARightGlyphRect: TRect; RotationAngle: TSpTextRotationAngle = tra0): Integer;
|
|
function SpDrawXPText(ACanvas: TCanvas; Caption: WideString; var ARect: TRect; Flags: Cardinal; CaptionGlow: TSpGlowDirection = gldNone; CaptionGlowColor: TColor = clYellow; RotationAngle: TSpTextRotationAngle = tra0): Integer; overload;
|
|
function SpDrawXPText(ACanvas: TCanvas; ARect: TRect; Caption: WideString; CaptionGlow: TSpGlowDirection; CaptionGlowColor: TColor; CaptionAlignment: TAlignment; Flags: Cardinal; GlyphSize: TSize; Layout: TSpGlyphLayout; PushedCaption: Boolean; out ACaptionRect, AGlyphRect: TRect; RotationAngle: TSpTextRotationAngle = tra0): Integer; overload;
|
|
function SpDrawXPText(ACanvas: TCanvas; ARect: TRect; Caption: WideString; CaptionGlow: TSpGlowDirection; CaptionGlowColor: TColor; CaptionAlignment: TAlignment; Flags: Cardinal; IL: TCustomImageList; ImageIndex: Integer; Layout: TSpGlyphLayout; Enabled, PushedCaption, DisabledIconCorrection: Boolean; out ACaptionRect, AGlyphRect: TRect; RotationAngle: TSpTextRotationAngle = tra0): Integer; overload;
|
|
function SpGetTextSize(DC: HDC; WS: WideString; NoPrefix: Boolean): TSize;
|
|
function SpGetControlTextHeight(AControl: TControl; AFont: TFont): Integer;
|
|
function SpGetControlTextSize(AControl: TControl; AFont: TFont; WS: WideString): TSize;
|
|
function SpSameText(W1, W2: WideString): Boolean;
|
|
function SpStripAccelChars(S: WideString): WideString;
|
|
function SpStripShortcut(S: WideString): WideString;
|
|
function SpStripTrailingPunctuation(S: WideString): WideString;
|
|
function SpRectToString(R: TRect): string;
|
|
function SpStringToRect(S: string; out R: TRect): Boolean;
|
|
|
|
{ Color helpers }
|
|
function SpColorToHTML(const Color: TColor): string;
|
|
function SpColorToString(const Color: TColor; TextType: TSpTBXColorTextType = cttDefault): string;
|
|
function SpStringToColor(S: string; out Color: TColor): Boolean;
|
|
procedure SpGetRGB(Color: TColor; out R, G, B: Integer);
|
|
function SpRGBToColor(R, G, B: Integer): TColor;
|
|
function SpLighten(Color: TColor; Amount: Integer): TColor;
|
|
function SpBlendColors(TargetColor, BaseColor: TColor; Percent: Integer): TColor;
|
|
function SpMixColors(TargetColor, BaseColor: TColor; Amount: Byte): TColor;
|
|
|
|
{ Painting helpers }
|
|
function SpCenterRect(Parent: TRect; ChildWidth, ChildHeight: Integer): TRect; overload;
|
|
function SpCenterRect(Parent, Child: TRect): TRect; overload;
|
|
function SpCenterRectHoriz(Parent: TRect; ChildWidth: Integer): TRect;
|
|
function SpCenterRectVert(Parent: TRect; ChildHeight: Integer): TRect;
|
|
procedure SpFillRect(ACanvas: TCanvas; const ARect: TRect; BrushColor: TColor; PenColor: TColor = clNone);
|
|
procedure SpDrawLine(ACanvas: TCanvas; X1, Y1, X2, Y2: Integer; Color: TColor);
|
|
procedure SpDrawRectangle(ACanvas: TCanvas; ARect: TRect; CornerSize: Integer; ColorTL, ColorBR: TColor; ColorTLInternal: TColor = clNone; ColorBRInternal: TColor = clNone; ForceRectBorders: TAnchors = []); overload;
|
|
procedure SpDrawRectangle(ACanvas: TCanvas; ARect: TRect; CornerSize: Integer; ColorL, ColorT, ColorR, ColorB, InternalColorL, InternalColorT, InternalColorR, InternalColorB: TColor; ForceRectBorders: TAnchors = []); overload;
|
|
procedure SpAlphaBlend(SrcDC, DstDC: HDC; SrcR, DstR: TRect; Alpha: Byte; SrcHasAlphaChannel: Boolean = False);
|
|
procedure SpPaintTo(WinControl: TWinControl; ACanvas: TCanvas; X, Y: Integer);
|
|
|
|
{ ImageList painting }
|
|
procedure SpDrawIconShadow(ACanvas: TCanvas; const ARect: TRect; ImageList: TCustomImageList; ImageIndex: Integer);
|
|
procedure SpDrawImageList(ACanvas: TCanvas; const ARect: TRect; ImageList: TCustomImageList; ImageIndex: Integer; Enabled, DisabledIconCorrection: Boolean);
|
|
|
|
{ Gradients }
|
|
procedure SpGradient(ACanvas: TCanvas; const ARect: TRect; StartPos, EndPos, ChunkSize: Integer; C1, C2: TColor; const Vertical: Boolean);
|
|
procedure SpGradientFill(ACanvas: TCanvas; const ARect: TRect; const C1, C2: TColor; const Vertical: Boolean);
|
|
procedure SpGradientFillMirror(ACanvas: TCanvas; const ARect: TRect; const C1, C2, C3, C4: TColor; const Vertical: Boolean);
|
|
procedure SpGradientFillMirrorTop(ACanvas: TCanvas; const ARect: TRect; const C1, C2, C3, C4: TColor; const Vertical: Boolean);
|
|
procedure SpGradientFillGlass(ACanvas: TCanvas; const ARect: TRect; const C1, C2, C3, C4: TColor; const Vertical: Boolean);
|
|
|
|
{ Element painting }
|
|
procedure SpDrawArrow(ACanvas: TCanvas; X, Y: Integer; AColor: TColor; Vertical, Reverse: Boolean; Size: Integer);
|
|
procedure SpDrawDropMark(ACanvas: TCanvas; DropMark: TRect);
|
|
procedure SpDrawFocusRect(ACanvas: TCanvas; const ARect: TRect);
|
|
procedure SpDrawGlyphPattern(DC: HDC; const R: TRect; Width, Height: Integer; const PatternBits; PatternColor: TColor); overload;
|
|
procedure SpDrawGlyphPattern(ACanvas: TCanvas; ARect: TRect; PatternIndex: Integer; PatternColor: TColor); overload;
|
|
procedure SpDrawXPButton(ACanvas: TCanvas; ARect: TRect; Enabled, Pushed, HotTrack, Checked, Focused, Defaulted: Boolean; SkinType: TSpTBXSkinType);
|
|
procedure SpDrawXPCheckBoxGlyph(ACanvas: TCanvas; ARect: TRect; Enabled: Boolean; State: TCheckBoxState; HotTrack, Pushed: Boolean; SkinType: TSpTBXSkinType);
|
|
procedure SpDrawXPRadioButtonGlyph(ACanvas: TCanvas; ARect: TRect; Enabled, Checked, HotTrack, Pushed: Boolean; SkinType: TSpTBXSkinType);
|
|
procedure SpDrawXPEditFrame(ACanvas: TCanvas; ARect: TRect; Enabled, HotTrack: Boolean; SkinType: TSpTBXSkinType; ClipContent: Boolean = False; AutoAdjust: Boolean = False); overload;
|
|
procedure SpDrawXPEditFrame(AWinControl: TWinControl; HotTracking: Boolean; SkinType: TSpTBXSkinType; AutoAdjust: Boolean = False; HideFrame: Boolean = False); overload;
|
|
procedure SpDrawXPGrip(ACanvas: TCanvas; ARect: TRect; LoC, HiC: TColor);
|
|
procedure SpDrawXPHeader(ACanvas: TCanvas; ARect: TRect; HotTrack, Pushed: Boolean; SkinType: TSpTBXSkinType);
|
|
procedure SpDrawXPListItemBackground(ACanvas: TCanvas; ARect: TRect; Selected, HotTrack, Focused: Boolean; SkinType: TSpTBXSkinType; ForceRectBorders: Boolean = False; Borders: Boolean = True);
|
|
|
|
{ Skins painting }
|
|
procedure SpPaintSkinBackground(ACanvas: TCanvas; ARect: TRect; SkinOption: TSpTBXSkinOptionCategory; Vertical: Boolean);
|
|
procedure SpPaintSkinBorders(ACanvas: TCanvas; ARect: TRect; SkinOption: TSpTBXSkinOptionCategory; ForceRectBorders: TAnchors = []);
|
|
|
|
{ Misc }
|
|
function SpIsWinVistaOrUp: Boolean;
|
|
function SpGetDirectories(Path: WideString; L: TStringList): Boolean;
|
|
|
|
{ Stock Objects }
|
|
var
|
|
StockBitmap: TBitmap;
|
|
SpPrintWindow: TSpPrintWindow = nil;
|
|
|
|
implementation
|
|
|
|
uses
|
|
UxTheme, Themes, Forms, Math, TypInfo, SpTBXDefaultSkins;
|
|
|
|
var
|
|
FInternalSkinManager: TSpTBXSkinManager = nil;
|
|
|
|
{$IFDEF SYSTEM_GRADIENT}
|
|
FMsimg32Library: HMODULE;
|
|
{$ENDIF}
|
|
|
|
const
|
|
ROP_DSPDxax = $00E20746;
|
|
|
|
type
|
|
TTriVertex = packed record
|
|
X: Integer;
|
|
Y: Integer;
|
|
Red: WORD;
|
|
Green: WORD;
|
|
Blue: WORD;
|
|
Alpha: WORD;
|
|
end;
|
|
|
|
TControlAccess = class(TControl);
|
|
|
|
{$IFDEF SYSTEM_GRADIENT}
|
|
var
|
|
GradientFillSystem: function (ADC: THandle; const AVertex: TTriVertex; ANumVertex: Integer;
|
|
const AMesh: TGradientRect; ANumMesh: Integer; AMode: DWORD): Boolean; stdcall;
|
|
{$ENDIF}
|
|
|
|
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
|
|
{ Skin Notification }
|
|
|
|
function SkinManager: TSpTBXSkinManager;
|
|
begin
|
|
if not Assigned(FInternalSkinManager) then
|
|
FInternalSkinManager := TSpTBXSkinManager.Create;
|
|
Result := FInternalSkinManager;
|
|
end;
|
|
|
|
function CurrentSkin: TSpTBXSkinOptions;
|
|
begin
|
|
Result := SkinManager.CurrentSkin;
|
|
end;
|
|
|
|
function SpTBXSkinType(T: TSpTBXSkinType): TSpTBXSkinType;
|
|
begin
|
|
Result := T;
|
|
if (Result = sknSkin) and SkinManager.IsDefaultSkin then
|
|
Result := sknWindows;
|
|
if (Result = sknWindows) and not SkinManager.IsXPThemesEnabled then
|
|
Result := sknNone;
|
|
end;
|
|
|
|
function SpGetLunaScheme: TSpTBXLunaScheme;
|
|
const
|
|
MaxChars = 1024;
|
|
var
|
|
pszThemeFileName, pszColorBuff, pszSizeBuf: PWideChar;
|
|
S: string;
|
|
begin
|
|
Result := lusUnknown;
|
|
|
|
if SkinManager.IsXPThemesEnabled then begin
|
|
GetMem(pszThemeFileName, 2 * MaxChars);
|
|
GetMem(pszColorBuff, 2 * MaxChars);
|
|
GetMem(pszSizeBuf, 2 * MaxChars);
|
|
try
|
|
if not Failed(GetCurrentThemeName(pszThemeFileName, MaxChars, pszColorBuff, MaxChars, pszSizeBuf, MaxChars)) then
|
|
if UpperCase(ExtractFileName(pszThemeFileName)) = 'LUNA.MSSTYLES' then begin
|
|
S := UpperCase(pszColorBuff);
|
|
if S = 'NORMALCOLOR' then
|
|
Result := lusBlue
|
|
else if S = 'METALLIC' then
|
|
Result := lusMetallic
|
|
else if S = 'HOMESTEAD' then
|
|
Result := lusGreen;
|
|
end;
|
|
finally
|
|
FreeMem(pszSizeBuf);
|
|
FreeMem(pszColorBuff);
|
|
FreeMem(pszThemeFileName);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SpDrawParentBackground(Control: TControl; DC: HDC; R: TRect);
|
|
// Delphi 2007 and Vista compatible
|
|
var
|
|
Parent: TWinControl;
|
|
P: TPoint;
|
|
Brush: HBRUSH;
|
|
begin
|
|
Parent := Control.Parent;
|
|
if Parent = nil then begin
|
|
Brush := CreateSolidBrush(ColorToRGB(clBtnFace));
|
|
Windows.FillRect(DC, R, Brush);
|
|
end
|
|
else if Parent.HandleAllocated then begin
|
|
if not Parent.DoubleBuffered and (Control is TWinControl) and SkinManager.IsXPThemesEnabled then
|
|
UxTheme.DrawThemeParentBackground(TWinControl(Control).Handle, DC, @R)
|
|
else begin
|
|
// Same as Controls.PerformEraseBackground
|
|
GetWindowOrgEx(DC, P);
|
|
SetWindowOrgEx(DC, P.X + Control.Left, P.Y + Control.Top, nil);
|
|
Parent.Perform(WM_ERASEBKGND, Integer(DC), Integer(DC));
|
|
SetWindowOrgEx(DC, P.X, P.Y, nil);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
|
|
{ WideString helpers}
|
|
|
|
function EnumFontsProc(const lplf: TLogFont; const lptm: TTextMetric;
|
|
dwType: DWORD; lpData: LPARAM): Integer; stdcall;
|
|
begin
|
|
Boolean(Pointer(lpData)^) := True;
|
|
Result := 0;
|
|
end;
|
|
|
|
function SpCreateRotatedFont(DC: HDC; Orientation: Integer = 2700): HFONT;
|
|
var
|
|
LogFont: TLogFont;
|
|
TM: TTextMetric;
|
|
VerticalFontName: array[0..LF_FACESIZE-1] of Char;
|
|
VerticalFontExists: Boolean;
|
|
begin
|
|
if GetObject(GetCurrentObject(DC, OBJ_FONT), SizeOf(LogFont),
|
|
@LogFont) = 0 then begin
|
|
{ just in case... }
|
|
Result := 0;
|
|
Exit;
|
|
end;
|
|
LogFont.lfEscapement := Orientation;
|
|
LogFont.lfOrientation := Orientation;
|
|
LogFont.lfOutPrecision := OUT_TT_ONLY_PRECIS; { needed for Win9x }
|
|
|
|
{ Don't let a random TrueType font be substituted when MS Sans Serif or
|
|
Microsoft Sans Serif are used. On Windows 2000 and later, hard-code Tahoma
|
|
because Arial can't display Japanese or Thai Unicode characters (on Windows
|
|
2000 at least). On earlier versions, hard-code Arial since NT 4.0 doesn't
|
|
ship with Tahoma, and 9x doesn't do Unicode. }
|
|
if (StrIComp(LogFont.lfFaceName, 'MS Sans Serif') = 0) or
|
|
(StrIComp(LogFont.lfFaceName, 'Microsoft Sans Serif') = 0) then begin
|
|
if Win32MajorVersion >= 5 then
|
|
StrPCopy(LogFont.lfFaceName, 'Tahoma')
|
|
else
|
|
StrPCopy(LogFont.lfFaceName, 'Arial');
|
|
{ Set lfHeight to the actual height of the current font. This is needed
|
|
to work around a Windows 98 issue: on a clean install of the OS,
|
|
SPI_GETNONCLIENTMETRICS returns -5 for lfSmCaptionFont.lfHeight. This is
|
|
wrong; it should return -11 for an 8 pt font. With normal, unrotated text
|
|
this actually displays correctly, since MS Sans Serif doesn't support
|
|
sizes below 8 pt. However, when we change to a TrueType font like Arial,
|
|
this becomes a problem because it'll actually create a font that small. }
|
|
if GetTextMetrics(DC, TM) then begin
|
|
{ If the original height was negative, keep it negative }
|
|
if LogFont.lfHeight <= 0 then
|
|
LogFont.lfHeight := -(TM.tmHeight - TM.tmInternalLeading)
|
|
else
|
|
LogFont.lfHeight := TM.tmHeight;
|
|
end;
|
|
end;
|
|
|
|
{ Use a vertical font if available so that Asian characters aren't drawn
|
|
sideways }
|
|
if StrLen(LogFont.lfFaceName) < SizeOf(VerticalFontName)-1 then begin
|
|
VerticalFontName[0] := '@';
|
|
StrCopy(@VerticalFontName[1], LogFont.lfFaceName);
|
|
VerticalFontExists := False;
|
|
EnumFonts(DC, VerticalFontName, @EnumFontsProc, @VerticalFontExists);
|
|
if VerticalFontExists then
|
|
StrCopy(LogFont.lfFaceName, VerticalFontName);
|
|
end;
|
|
|
|
Result := CreateFontIndirect(LogFont);
|
|
end;
|
|
|
|
function SpDrawRotatedText(const DC: HDC; AText: WideString; var ARect: TRect; const AFormat: Cardinal; RotationAngle: TSpTextRotationAngle = tra270): Integer;
|
|
{ The format flag this function respects are
|
|
DT_CALCRECT, DT_NOPREFIX, DT_HIDEPREFIX, DT_CENTER, DT_END_ELLIPSIS, DT_NOCLIP }
|
|
var
|
|
RotatedFont, SaveFont: HFONT;
|
|
TextMetrics: TTextMetric;
|
|
X, Y, P, I, SU, FU, W: Integer;
|
|
SaveAlign: UINT;
|
|
Clip: Boolean;
|
|
Pen, SavePen: HPEN;
|
|
Sz: TSize;
|
|
Orientation: Integer;
|
|
begin
|
|
Result := 0;
|
|
if Length(AText) = 0 then Exit;
|
|
|
|
Orientation := 0;
|
|
case RotationAngle of
|
|
tra90: Orientation := 900; // 90 degrees
|
|
tra270: Orientation := 2700; // 270 degrees
|
|
end;
|
|
RotatedFont := SpCreateRotatedFont(DC, Orientation);
|
|
SaveFont := SelectObject(DC, RotatedFont);
|
|
|
|
GetTextMetrics(DC, TextMetrics);
|
|
X := ARect.Left + (ARect.Right - ARect.Left - TextMetrics.tmHeight) div 2;
|
|
|
|
Clip := AFormat and DT_NOCLIP = 0;
|
|
|
|
{ Find the index of the character that should be underlined. Delete '&'
|
|
characters from the string. Like DrawText, only the last prefixed character
|
|
will be underlined. }
|
|
P := 0;
|
|
I := 1;
|
|
if AFormat and DT_NOPREFIX = 0 then
|
|
while I <= Length(AText) do
|
|
begin
|
|
if AText[I] = '&' then
|
|
begin
|
|
Delete(AText, I, 1);
|
|
if PWideChar(AText)[I - 1] <> '&' then P := I;
|
|
end;
|
|
Inc(I);
|
|
end;
|
|
|
|
if AFormat and DT_END_ELLIPSIS <> 0 then
|
|
begin
|
|
if (Length(AText) > 1) and (SpGetTextSize(DC, AText, False).cx > ARect.Bottom - ARect.Top) then
|
|
begin
|
|
W := ARect.Bottom - ARect.Top;
|
|
if W > 2 then
|
|
begin
|
|
Delete(AText, Length(AText), 1);
|
|
while (Length(AText) > 1) and (SpGetTextSize(DC, AText + '...', False).cx > W) do
|
|
Delete(AText, Length(AText), 1);
|
|
end
|
|
else AText := AText[1];
|
|
if P > Length(AText) then P := 0;
|
|
AText := AText + '...';
|
|
end;
|
|
end;
|
|
|
|
Sz := SpGetTextSize(DC, AText, False);
|
|
Result := Sz.cy;
|
|
|
|
if AFormat and DT_CALCRECT <> 0 then begin
|
|
ARect.Right := ARect.Left + Sz.cy;
|
|
ARect.Bottom := ARect.Top + Sz.cx;
|
|
end
|
|
else begin
|
|
if AFormat and DT_CENTER <> 0 then
|
|
Y := ARect.Top + (ARect.Bottom - ARect.Top - Sz.cx) div 2
|
|
else
|
|
Y := ARect.Top;
|
|
|
|
if Clip then
|
|
begin
|
|
SaveDC(DC);
|
|
with ARect do IntersectClipRect(DC, Left, Top, Right, Bottom);
|
|
end;
|
|
|
|
case RotationAngle of
|
|
tra90: SaveAlign := SetTextAlign(DC, TA_RIGHT);
|
|
tra270: SaveAlign := SetTextAlign(DC, TA_BOTTOM);
|
|
else
|
|
SaveAlign := SetTextAlign(DC, TA_LEFT);
|
|
end;
|
|
|
|
if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
|
|
Windows.TextOutA(DC, X, Y, PAnsiChar(AnsiString(AText)), Length(AnsiString(AText)))
|
|
else
|
|
Windows.TextOutW(DC, X, Y, PWideChar(AText), Length(AText));
|
|
|
|
SetTextAlign(DC, SaveAlign);
|
|
|
|
{ Underline }
|
|
if (P > 0) and (AFormat and DT_HIDEPREFIX = 0) then
|
|
begin
|
|
SU := SpGetTextSize(DC, Copy(AText, 1, P - 1), False).cx;
|
|
FU := SU + SpGetTextSize(DC, PWideChar(AText)[P - 1], False).cx;
|
|
Inc(X, TextMetrics.tmDescent - 2);
|
|
Pen := CreatePen(PS_SOLID, 1, GetTextColor(DC));
|
|
SavePen := SelectObject(DC, Pen);
|
|
MoveToEx(DC, X, Y + SU, nil);
|
|
LineTo(DC, X, Y + FU);
|
|
SelectObject(DC, SavePen);
|
|
DeleteObject(Pen);
|
|
end;
|
|
|
|
if Clip then RestoreDC(DC, -1);
|
|
end;
|
|
|
|
SelectObject(DC, SaveFont);
|
|
DeleteObject(RotatedFont);
|
|
end;
|
|
|
|
function SpCalcXPText(ACanvas: TCanvas; ARect: TRect; Caption: WideString;
|
|
CaptionAlignment: TAlignment; Flags: Cardinal; GlyphSize, RightGlyphSize: TSize;
|
|
Layout: TSpGlyphLayout; PushedCaption: Boolean; out ACaptionRect, AGlyphRect, ARightGlyphRect: TRect;
|
|
RotationAngle: TSpTextRotationAngle = tra0): Integer;
|
|
var
|
|
R: TRect;
|
|
TextOffset, Spacing, RightSpacing: TPoint;
|
|
CaptionSz: TSize;
|
|
begin
|
|
Result := 0;
|
|
ACaptionRect := Rect(0, 0, 0, 0);
|
|
AGlyphRect := Rect(0, 0, 0, 0);
|
|
ARightGlyphRect := Rect(0, 0, 0, 0);
|
|
TextOffset := Point(0, 0);
|
|
Spacing := Point(0, 0);
|
|
RightSpacing := Point(0, 0);
|
|
if (Caption <> '') and (GlyphSize.cx > 0) and (GlyphSize.cy > 0) then
|
|
Spacing := Point(4, 1);
|
|
if (Caption <> '') and (RightGlyphSize.cx > 0) and (RightGlyphSize.cy > 0) then
|
|
RightSpacing := Point(4, 1);
|
|
|
|
Flags := Flags and not DT_CENTER;
|
|
Flags := Flags and not DT_VCENTER;
|
|
if CaptionAlignment = taRightJustify then
|
|
Flags := Flags or DT_RIGHT;
|
|
|
|
// DT_END_ELLIPSIS and DT_PATH_ELLIPSIS doesn't work with rotated text
|
|
// http://support.microsoft.com/kb/249678
|
|
// Revert the ARect if the text is rotated, from now on work on horizontal text !!!
|
|
if RotationAngle <> tra0 then
|
|
ARect := Rect(ARect.Top, ARect.Left, ARect.Bottom, ARect.Right);
|
|
|
|
// Get the caption size
|
|
if ((Flags and DT_WORDBREAK) <> 0) or ((Flags and DT_END_ELLIPSIS) <> 0) or ((Flags and DT_PATH_ELLIPSIS) <> 0) then begin
|
|
if Layout = ghlGlyphLeft then // Glyph on left or right side
|
|
R := Rect(0, 0, ARect.Right - ARect.Left - GlyphSize.cx - Spacing.X - RightGlyphSize.cx - RightSpacing.X + 2, 1)
|
|
else // Glyph on top
|
|
R := Rect(0, 0, ARect.Right - ARect.Left + 2, 1);
|
|
end
|
|
else
|
|
R := Rect(0, 0, 1, 1);
|
|
|
|
if (fsBold in ACanvas.Font.Style) and (RotationAngle = tra0) and (((Flags and DT_END_ELLIPSIS) <> 0) or ((Flags and DT_PATH_ELLIPSIS) <> 0)) then begin
|
|
// [Bugfix] Windows bug:
|
|
// When the Font is Bold and DT_END_ELLIPSIS or DT_PATH_ELLIPSIS is used
|
|
// DrawTextW returns an incorrect size if the string is unicode.
|
|
// The R.Right is reduced by 3 which cuts down the string and
|
|
// adds the ellipsis.
|
|
// We have to obtain the real size and check if it fits in the Rect.
|
|
CaptionSz := SpGetTextSize(ACanvas.Handle, Caption, True);
|
|
if CaptionSz.cx <= R.Right then begin
|
|
R := Rect(0, 0, CaptionSz.cx, CaptionSz.cy);
|
|
Result := CaptionSz.cy;
|
|
end;
|
|
end;
|
|
|
|
if Result <= 0 then begin
|
|
Result := SpDrawXPText(ACanvas, Caption, R, Flags or DT_CALCRECT, gldNone, clYellow);
|
|
CaptionSz.cx := R.Right;
|
|
CaptionSz.cy := R.Bottom;
|
|
end;
|
|
|
|
// ACaptionRect
|
|
if Result > 0 then begin
|
|
R.Top := ARect.Top + (ARect.Bottom - ARect.Top - CaptionSz.cy) div 2; // Vertically centered
|
|
R.Bottom := R.Top + CaptionSz.cy;
|
|
case CaptionAlignment of
|
|
taCenter:
|
|
R.Left := ARect.Left + (ARect.Right - ARect.Left - CaptionSz.cx) div 2; // Horizontally centered
|
|
taLeftJustify:
|
|
R.Left := ARect.Left;
|
|
taRightJustify:
|
|
R.Left := ARect.Right - CaptionSz.cx;
|
|
end;
|
|
R.Right := R.Left + CaptionSz.cx;
|
|
|
|
// Since DT_END_ELLIPSIS and DT_PATH_ELLIPSIS doesn't work with rotated text
|
|
// try to fix it by padding the text 8 pixels to the right
|
|
if (RotationAngle <> tra0) and (R.Right + 8 < ARect.Right) then
|
|
if ((Flags and DT_END_ELLIPSIS) <> 0) or ((Flags and DT_PATH_ELLIPSIS) <> 0) then
|
|
R.Right := R.Right + 8;
|
|
|
|
if PushedCaption then
|
|
OffsetRect(R, 1, 1);
|
|
|
|
ACaptionRect := R;
|
|
end;
|
|
|
|
// AGlyphRect
|
|
if (GlyphSize.cx > 0) and (GlyphSize.cy > 0) then begin
|
|
R := ARect;
|
|
|
|
// If ghlGlyphTop is used the glyph should be centered
|
|
if Layout = ghlGlyphTop then
|
|
CaptionAlignment := taCenter;
|
|
|
|
case CaptionAlignment of
|
|
taCenter:
|
|
begin
|
|
// Total width = Icon + Space + Text
|
|
if Layout = ghlGlyphLeft then begin
|
|
AGlyphRect.Left := R.Left + (R.Right - R.Left - (GlyphSize.cx + Spacing.X + CaptionSz.cx)) div 2;
|
|
TextOffset.X := (GlyphSize.cx + Spacing.X) div 2;
|
|
end
|
|
else
|
|
AGlyphRect.Left := R.Left + (R.Right - R.Left - GlyphSize.cx) div 2;
|
|
end;
|
|
taLeftJustify:
|
|
begin
|
|
AGlyphRect.Left := R.Left;
|
|
TextOffset.X := GlyphSize.cx + Spacing.X;
|
|
end;
|
|
taRightJustify:
|
|
begin
|
|
AGlyphRect.Left := R.Right - GlyphSize.cx;
|
|
TextOffset.X := - Spacing.X - GlyphSize.cx;
|
|
end;
|
|
end;
|
|
|
|
if Layout = ghlGlyphLeft then
|
|
AGlyphRect.Top := R.Top + (R.Bottom - R.Top - GlyphSize.cy) div 2
|
|
else begin
|
|
AGlyphRect.Top := R.Top + (R.Bottom - R.Top - (GlyphSize.cy + Spacing.Y + CaptionSz.cy)) div 2;
|
|
Inc(TextOffset.Y, (GlyphSize.cy + Spacing.Y) div 2);
|
|
end;
|
|
|
|
AGlyphRect.Right := AGlyphRect.Left + GlyphSize.cx;
|
|
AGlyphRect.Bottom := AGlyphRect.Top + GlyphSize.cy;
|
|
|
|
if PushedCaption then
|
|
OffsetRect(AGlyphRect, 1, 1);
|
|
end;
|
|
|
|
// Move the text according to the icon position
|
|
if Result > 0 then
|
|
OffsetRect(ACaptionRect, TextOffset.X, TextOffset.Y);
|
|
|
|
// ARightGlyphRect, it's valid only when using taLeftJustify
|
|
if (RightGlyphSize.cx > 0) and (RightGlyphSize.cy > 0) then
|
|
if CaptionAlignment = taLeftJustify then begin
|
|
R := ARect;
|
|
ARightGlyphRect.Left := R.Right - RightGlyphSize.cx;
|
|
ARightGlyphRect.Right := ARightGlyphRect.Left + RightGlyphSize.cx;
|
|
ARightGlyphRect.Top := R.Top + (R.Bottom - R.Top - RightGlyphSize.cy) div 2;
|
|
ARightGlyphRect.Bottom := ARightGlyphRect.Top + RightGlyphSize.cy;
|
|
if (Result > 0) and (ACaptionRect.Right > ARightGlyphRect.Left - RightSpacing.X) then
|
|
ACaptionRect.Right := ARightGlyphRect.Left - RightSpacing.X;
|
|
end;
|
|
|
|
// Revert back, normalize when the text is rotated
|
|
if RotationAngle <> tra0 then begin
|
|
ACaptionRect := Rect(ACaptionRect.Top, ACaptionRect.Left, ACaptionRect.Bottom, ACaptionRect.Right);
|
|
AGlyphRect := Rect(AGlyphRect.Top, AGlyphRect.Left, AGlyphRect.Bottom, AGlyphRect.Right);
|
|
ARightGlyphRect := Rect(ARightGlyphRect.Top, ARightGlyphRect.Left, ARightGlyphRect.Bottom, ARightGlyphRect.Right);
|
|
end;
|
|
end;
|
|
|
|
function SpDrawXPText(ACanvas: TCanvas; Caption: WideString; var ARect: TRect;
|
|
Flags: Cardinal; CaptionGlow: TSpGlowDirection = gldNone;
|
|
CaptionGlowColor: TColor = clYellow; RotationAngle: TSpTextRotationAngle = tra0): Integer; overload;
|
|
|
|
function InternalDraw(var R: TRect): Integer;
|
|
begin
|
|
Result := 0;
|
|
case RotationAngle of
|
|
tra0:
|
|
if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
|
|
Result := Windows.DrawTextA(ACanvas.Handle, PAnsiChar(AnsiString(Caption)), -1, R, Flags)
|
|
else
|
|
Result := Windows.DrawTextW(ACanvas.Handle, PWideChar(Caption), -1, R, Flags);
|
|
tra90, tra270:
|
|
Result := SpDrawRotatedText(ACanvas.Handle, Caption, R, Flags, RotationAngle);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
BS: TBrushStyle;
|
|
GlowR: TRect;
|
|
C, FC: TColor;
|
|
begin
|
|
BS := ACanvas.Brush.Style;
|
|
C := ACanvas.Brush.Color;
|
|
try
|
|
ACanvas.Brush.Style := bsClear;
|
|
|
|
if (Flags and DT_CALCRECT = 0) and (CaptionGlow <> gldNone) then begin
|
|
FC := ACanvas.Font.Color;
|
|
ACanvas.Font.Color := CaptionGlowColor;
|
|
case CaptionGlow of
|
|
gldAll:
|
|
begin
|
|
GlowR := ARect; OffsetRect(GlowR, 0, -1);
|
|
InternalDraw(GlowR);
|
|
GlowR := ARect; OffsetRect(GlowR, 0, 1);
|
|
InternalDraw(GlowR);
|
|
GlowR := ARect; OffsetRect(GlowR, -1, 0);
|
|
InternalDraw(GlowR);
|
|
GlowR := ARect; OffsetRect(GlowR, 1, 0);
|
|
end;
|
|
gldTopLeft:
|
|
begin
|
|
GlowR := ARect; OffsetRect(GlowR, -1, -1);
|
|
InternalDraw(GlowR);
|
|
end;
|
|
gldBottomRight:
|
|
begin
|
|
GlowR := ARect; OffsetRect(GlowR, 1, 1);
|
|
InternalDraw(GlowR);
|
|
end;
|
|
end;
|
|
ACanvas.Font.Color := FC;
|
|
end;
|
|
|
|
Result := InternalDraw(ARect);
|
|
|
|
if IsRectEmpty(ARect) then
|
|
Result := 0
|
|
else
|
|
if Flags and DT_CALCRECT <> 0 then begin
|
|
// [Bugfix] Windows bug:
|
|
// When DT_CALCRECT is used and the font is italic the
|
|
// resulting rect is incorrect
|
|
if fsItalic in ACanvas.Font.Style then
|
|
ARect.Right := ARect.Right + 1 + (ACanvas.Font.Size div 8) * 2;
|
|
end;
|
|
|
|
finally
|
|
ACanvas.Brush.Style := BS;
|
|
ACanvas.Brush.Color := C;
|
|
end;
|
|
end;
|
|
|
|
function SpDrawXPText(ACanvas: TCanvas; ARect: TRect; Caption: WideString;
|
|
CaptionGlow: TSpGlowDirection; CaptionGlowColor: TColor; CaptionAlignment: TAlignment;
|
|
Flags: Cardinal; GlyphSize: TSize; Layout: TSpGlyphLayout; PushedCaption: Boolean;
|
|
out ACaptionRect, AGlyphRect: TRect;
|
|
RotationAngle: TSpTextRotationAngle = tra0): Integer; overload;
|
|
var
|
|
DummyRightGlyphSize: TSize;
|
|
DummyRightGlyphRect: TRect;
|
|
begin
|
|
DummyRightGlyphSize.cx := 0;
|
|
DummyRightGlyphSize.cy := 0;
|
|
DummyRightGlyphRect := Rect(0, 0, 0, 0);
|
|
Result := SpCalcXPText(ACanvas, ARect, Caption, CaptionAlignment, Flags, GlyphSize, DummyRightGlyphSize,
|
|
Layout, PushedCaption, ACaptionRect, AGlyphRect, DummyRightGlyphRect, RotationAngle);
|
|
SpDrawXPText(ACanvas, Caption, ACaptionRect, Flags and not DT_CALCRECT, CaptionGlow, CaptionGlowColor, RotationAngle);
|
|
end;
|
|
|
|
function SpDrawXPText(ACanvas: TCanvas; ARect: TRect; Caption: WideString;
|
|
CaptionGlow: TSpGlowDirection; CaptionGlowColor: TColor; CaptionAlignment: TAlignment;
|
|
Flags: Cardinal; IL: TCustomImageList; ImageIndex: Integer; Layout: TSpGlyphLayout;
|
|
Enabled, PushedCaption, DisabledIconCorrection: Boolean; out ACaptionRect, AGlyphRect: TRect;
|
|
RotationAngle: TSpTextRotationAngle = tra0): Integer; overload;
|
|
var
|
|
GlyphSize, DummyRightGlyphSize: TSize;
|
|
DummyRightGlyphRect: TRect;
|
|
begin
|
|
GlyphSize.cx := 0;
|
|
GlyphSize.cy := 0;
|
|
DummyRightGlyphSize.cx := 0;
|
|
DummyRightGlyphSize.cy := 0;
|
|
DummyRightGlyphRect := Rect(0, 0, 0, 0);
|
|
|
|
if Assigned(IL) and (ImageIndex > -1) and (ImageIndex < IL.Count) then begin
|
|
GlyphSize.cx := IL.Width;
|
|
GlyphSize.cy := IL.Height;
|
|
end;
|
|
|
|
Result := SpCalcXPText(ACanvas, ARect, Caption, CaptionAlignment, Flags, GlyphSize, DummyRightGlyphSize,
|
|
Layout, PushedCaption, ACaptionRect, AGlyphRect, DummyRightGlyphRect, RotationAngle);
|
|
|
|
SpDrawXPText(ACanvas, Caption, ACaptionRect, Flags and not DT_CALCRECT, CaptionGlow, CaptionGlowColor, RotationAngle);
|
|
|
|
if Assigned(IL) and (ImageIndex > -1) and (ImageIndex < IL.Count) then
|
|
SpDrawImageList(ACanvas, AGlyphRect, IL, ImageIndex, Enabled, DisabledIconCorrection);
|
|
end;
|
|
|
|
function SpGetTextSize(DC: HDC; WS: WideString; NoPrefix: Boolean): TSize;
|
|
// Returns the size of the string, if NoPrefix is True, it first removes "&"
|
|
// characters as necessary.
|
|
// This procedure is 10x faster than using DrawText with the DT_CALCRECT flag
|
|
begin
|
|
Result.cx := 0;
|
|
Result.cy := 0;
|
|
if NoPrefix then
|
|
WS := SpStripAccelChars(WS);
|
|
if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
|
|
Windows.GetTextExtentPoint32A(DC, PAnsiChar(AnsiString(WS)), Length(AnsiString(WS)), Result)
|
|
else
|
|
Windows.GetTextExtentPoint32W(DC, PWideChar(WS), Length(WS), Result);
|
|
end;
|
|
|
|
function SpGetControlTextHeight(AControl: TControl; AFont: TFont): Integer;
|
|
// Returns the control text height based on the font
|
|
var
|
|
Sz: TSize;
|
|
begin
|
|
Sz := SpGetControlTextSize(AControl, AFont, 'WQqJ');
|
|
Result := Sz.cy;
|
|
end;
|
|
|
|
function SpGetControlTextSize(AControl: TControl; AFont: TFont; WS: WideString): TSize;
|
|
// Returns the control text size based on the font
|
|
var
|
|
ACanvas: TControlCanvas;
|
|
begin
|
|
ACanvas := TControlCanvas.Create;
|
|
try
|
|
ACanvas.Control := AControl;
|
|
ACanvas.Font.Assign(AFont);
|
|
Result := SpGetTextSize(ACanvas.Handle, WS, False);
|
|
finally
|
|
ACanvas.Free;
|
|
end;
|
|
end;
|
|
|
|
function SpSameText(W1, W2: WideString): Boolean;
|
|
begin
|
|
{$IFNDEF UNICODE}
|
|
if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
|
|
Result := AnsiSameText(AnsiString(W1), AnsiString(W2))
|
|
else
|
|
Result := WideSameText(W1, W2);
|
|
{$ELSE}
|
|
Result := WideSameText(W1, W2);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function SpStripAccelChars(S: WideString): WideString;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := S;
|
|
I := 1;
|
|
while I <= Length(Result) do begin
|
|
if Result[I] = '&' then
|
|
System.Delete(Result, I, 1);
|
|
Inc(I);
|
|
end;
|
|
end;
|
|
|
|
function SpStripShortcut(S: WideString): WideString;
|
|
var
|
|
P: Integer;
|
|
begin
|
|
Result := S;
|
|
P := Pos(#9, Result);
|
|
if P <> 0 then
|
|
SetLength(Result, P - 1);
|
|
end;
|
|
|
|
function SpStripTrailingPunctuation(S: WideString): WideString;
|
|
// Removes any colon (':') or ellipsis ('...') from the end of S and returns
|
|
// the resulting string
|
|
var
|
|
L: Integer;
|
|
begin
|
|
Result := S;
|
|
L := Length(Result);
|
|
if (L > 1) and (Result[L] = ':') then
|
|
SetLength(Result, L-1)
|
|
else if (L > 3) and (Result[L-2] = '.') and (Result[L-1] = '.') and
|
|
(Result[L] = '.') then
|
|
SetLength(Result, L-3);
|
|
end;
|
|
|
|
function SpRectToString(R: TRect): string;
|
|
begin
|
|
Result := Format('%d, %d, %d, %d', [R.Left, R.Top, R.Right, R.Bottom]);
|
|
end;
|
|
|
|
function SpStringToRect(S: string; out R: TRect): Boolean;
|
|
var
|
|
L: TStringList;
|
|
begin
|
|
Result := False;
|
|
R := Rect(0, 0, 0, 0);
|
|
L := TStringList.Create;
|
|
try
|
|
L.CommaText := S;
|
|
if L.Count = 4 then begin
|
|
R.Left := StrToIntDef(L[0], 0);
|
|
R.Top := StrToIntDef(L[1], 0);
|
|
R.Right := StrToIntDef(L[2], 0);
|
|
R.Bottom := StrToIntDef(L[3], 0);
|
|
Result := True;
|
|
end;
|
|
finally
|
|
L.Free;
|
|
end;
|
|
end;
|
|
|
|
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
|
|
{ Color Helpers }
|
|
|
|
function SpColorToHTML(const Color: TColor): string;
|
|
var
|
|
R: TColorRef;
|
|
begin
|
|
R := ColorToRGB(Color);
|
|
Result := Format('#%.2x%.2x%.2x', [GetRValue(R), GetGValue(R), GetBValue(R)]);
|
|
end;
|
|
|
|
function SpColorToString(const Color: TColor; TextType: TSpTBXColorTextType = cttDefault): string;
|
|
begin
|
|
case TextType of
|
|
cttDefault:
|
|
Result := ColorToString(Color);
|
|
cttHTML:
|
|
Result := SpColorToHTML(Color);
|
|
cttIdentAndHTML:
|
|
begin
|
|
Result := ColorToString(Color);
|
|
if (Length(Result) > 0) and (Result[1] = '$') then
|
|
Result := SpColorToHTML(Color);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function SpStringToColor(S: string; out Color: TColor): Boolean;
|
|
var
|
|
E, L: Integer;
|
|
begin
|
|
Result := False;
|
|
Color := clDefault;
|
|
L := Length(S);
|
|
if L < 2 then Exit;
|
|
|
|
if (S[1] = '#') and (L = 7) then begin
|
|
Delete(S, 1, 1); // strip the # char
|
|
S := Format('$00%s%s%s', [Copy(S, 5, 2), Copy(S, 3, 2), Copy(S, 1, 2)]);
|
|
Color := StringToColor(S);
|
|
Result := True;
|
|
end
|
|
else begin
|
|
Result := IdentToColor(S, Longint(Color));
|
|
if not Result and (L > 6) and (L < 10) and (S[1] = '$') then begin
|
|
Val(S, Color, E);
|
|
Result := E = 0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SpGetRGB(Color: TColor; out R, G, B: Integer);
|
|
begin
|
|
Color := ColorToRGB(Color);
|
|
R := GetRValue(Color);
|
|
G := GetGValue(Color);
|
|
B := GetBValue(Color);
|
|
end;
|
|
|
|
function SpRGBToColor(R, G, B: Integer): TColor;
|
|
begin
|
|
if R < 0 then R := 0 else if R > 255 then R := 255;
|
|
if G < 0 then G := 0 else if G > 255 then G := 255;
|
|
if B < 0 then B := 0 else if B > 255 then B := 255;
|
|
Result := TColor(RGB(R, G, B));
|
|
end;
|
|
|
|
function SpLighten(Color: TColor; Amount: Integer): TColor;
|
|
var
|
|
R, G, B: Integer;
|
|
begin
|
|
Color := ColorToRGB(Color);
|
|
R := GetRValue(Color) + Amount;
|
|
G := GetGValue(Color) + Amount;
|
|
B := GetBValue(Color) + Amount;
|
|
Result := SpRGBToColor(R, G, B);
|
|
end;
|
|
|
|
function SpBlendColors(TargetColor, BaseColor: TColor; Percent: Integer): TColor;
|
|
// Blend 2 colors with a predefined percent (0..100 or 0..1000)
|
|
// If Percent is 0 the result will be BaseColor,
|
|
// If Percent is 100 the result will be TargetColor.
|
|
// Any other value will return a color between base and target.
|
|
// For example if you want to add 70% of yellow ($0000FFFF) to a color:
|
|
// NewColor := SpBlendColor($0000FFFF, BaseColor, 70);
|
|
// The result will have 70% of yellow and 30% of BaseColor
|
|
var
|
|
Percent2, D, F: Integer;
|
|
R, G, B, R2, G2, B2: Integer;
|
|
begin
|
|
SpGetRGB(TargetColor, R, G, B);
|
|
SpGetRGB(BaseColor, R2, G2, B2);
|
|
|
|
if Percent >= 100 then D := 1000
|
|
else D := 100;
|
|
Percent2 := D - Percent;
|
|
F := D div 2;
|
|
|
|
R := (R * Percent + R2 * Percent2 + F) div D;
|
|
G := (G * Percent + G2 * Percent2 + F) div D;
|
|
B := (B * Percent + B2 * Percent2 + F) div D;
|
|
|
|
Result := SpRGBToColor(R, G, B);
|
|
end;
|
|
|
|
function SpMixColors(TargetColor, BaseColor: TColor; Amount: Byte): TColor;
|
|
// Mix 2 colors with a predefined amount (0..255).
|
|
// If Amount is 0 the result will be BaseColor,
|
|
// If Amount is 255 the result will be TargetColor.
|
|
// Any other value will return a color between base and target.
|
|
// For example if you want to add 50% of yellow ($0000FFFF) to a color:
|
|
// NewColor := SpMixColors($0000FFFF, BaseColor, 128);
|
|
// The result will be BaseColor + 50% of yellow
|
|
var
|
|
R1, G1, B1: Integer;
|
|
R2, G2, B2: Integer;
|
|
begin
|
|
SpGetRGB(BaseColor, R1, G1, B1);
|
|
SpGetRGB(TargetColor, R2, G2, B2);
|
|
|
|
R1 := (R2 - R1) * Amount div 255 + R1;
|
|
G1 := (G2 - G1) * Amount div 255 + G1;
|
|
B1 := (B2 - B1) * Amount div 255 + B1;
|
|
|
|
Result := SpRGBToColor(R1, G1, B1);
|
|
end;
|
|
|
|
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
|
|
{ Painting Helpers }
|
|
|
|
function SpCenterRect(Parent: TRect; ChildWidth, ChildHeight: Integer): TRect;
|
|
begin
|
|
Result.Left := Parent.Left + (Parent.Right - Parent.Left - ChildWidth) div 2;
|
|
Result.Top := Parent.Top + (Parent.Bottom - Parent.Top - ChildHeight) div 2;
|
|
Result.Right := Result.Left + ChildWidth;
|
|
Result.Bottom := Result.Top + ChildHeight;
|
|
end;
|
|
|
|
function SpCenterRect(Parent, Child: TRect): TRect;
|
|
begin
|
|
Result := SpCenterRect(Parent, Child.Right - Child.Left, Child.Bottom - Child.Top);
|
|
end;
|
|
|
|
function SpCenterRectHoriz(Parent: TRect; ChildWidth: Integer): TRect;
|
|
begin
|
|
Result.Left := Parent.Left + (Parent.Right - Parent.Left - ChildWidth) div 2;
|
|
Result.Right := Result.Left + ChildWidth;
|
|
Result.Top := Parent.Top;
|
|
Result.Bottom := Parent.Bottom;
|
|
end;
|
|
|
|
function SpCenterRectVert(Parent: TRect; ChildHeight: Integer): TRect;
|
|
begin
|
|
Result.Left := Parent.Left;
|
|
Result.Right := Parent.Right;
|
|
Result.Top := Parent.Top + (Parent.Bottom - Parent.Top - ChildHeight) div 2;
|
|
Result.Bottom := Result.Top + ChildHeight;
|
|
end;
|
|
|
|
procedure SpFillRect(ACanvas: TCanvas; const ARect: TRect; BrushColor: TColor; PenColor: TColor = clNone);
|
|
var
|
|
C, C2: TColor;
|
|
begin
|
|
if BrushColor <> clNone then begin
|
|
C := ACanvas.Brush.Color;
|
|
C2 := ACanvas.Pen.Color;
|
|
ACanvas.Brush.Color := BrushColor;
|
|
ACanvas.Pen.Color := PenColor;
|
|
if PenColor = clNone then
|
|
ACanvas.FillRect(ARect)
|
|
else
|
|
ACanvas.Rectangle(ARect);
|
|
ACanvas.Brush.Color := C;
|
|
ACanvas.Pen.Color := C2;
|
|
end;
|
|
end;
|
|
|
|
procedure SpDrawLine(ACanvas: TCanvas; X1, Y1, X2, Y2: Integer; Color: TColor);
|
|
var
|
|
C: TColor;
|
|
begin
|
|
if Color <> clNone then begin
|
|
C := ACanvas.Pen.Color;
|
|
ACanvas.Pen.Color := Color;
|
|
ACanvas.MoveTo(X1, Y1);
|
|
ACanvas.LineTo(X2, Y2);
|
|
ACanvas.Pen.Color := C;
|
|
end;
|
|
end;
|
|
|
|
procedure SpDrawRectangle(ACanvas: TCanvas; ARect: TRect; CornerSize: Integer;
|
|
ColorL, ColorT, ColorR, ColorB,
|
|
InternalColorL, InternalColorT, InternalColorR, InternalColorB: TColor;
|
|
ForceRectBorders: TAnchors = []);
|
|
// Draws 2 beveled borders.
|
|
// CornerSize can be 0, 1 or 2.
|
|
// Color: left, top, right, bottom external border color
|
|
// InternalColor: left, top, right, bottom internal border color
|
|
// ForceRectBorders: forces the borders to be rect
|
|
var
|
|
Color: TColor;
|
|
CornerSizeTL, CornerSizeTR, CornerSizeBL, CornerSizeBR: Integer;
|
|
begin
|
|
Color := ACanvas.Pen.Color;
|
|
|
|
if CornerSize < 0 then CornerSize := 0;
|
|
if CornerSize > 2 then CornerSize := 2;
|
|
CornerSizeTL := CornerSize;
|
|
CornerSizeTR := CornerSize;
|
|
CornerSizeBL := CornerSize;
|
|
CornerSizeBR := CornerSize;
|
|
if akLeft in ForceRectBorders then begin
|
|
CornerSizeTL := 0;
|
|
CornerSizeBL := 0;
|
|
end;
|
|
if akRight in ForceRectBorders then begin
|
|
CornerSizeTR := 0;
|
|
CornerSizeBR := 0;
|
|
end;
|
|
if akTop in ForceRectBorders then begin
|
|
CornerSizeTL := 0;
|
|
CornerSizeTR := 0;
|
|
end;
|
|
if akBottom in ForceRectBorders then begin
|
|
CornerSizeBL := 0;
|
|
CornerSizeBR := 0;
|
|
end;
|
|
|
|
with ARect do begin
|
|
Dec(Right);
|
|
Dec(Bottom);
|
|
|
|
// Internal borders
|
|
InflateRect(ARect, -1, -1);
|
|
if InternalColorL <> clNone then begin
|
|
ACanvas.Pen.Color := InternalColorL;
|
|
ACanvas.PolyLine([Point(Left, Bottom), Point(Left, Top)]);
|
|
end;
|
|
if InternalColorT <> clNone then begin
|
|
ACanvas.Pen.Color := InternalColorT;
|
|
ACanvas.PolyLine([Point(Left, Top), Point(Right, Top)]);
|
|
end;
|
|
if InternalColorR <> clNone then begin
|
|
ACanvas.Pen.Color := InternalColorR;
|
|
ACanvas.PolyLine([Point(Right, Bottom), Point(Right, Top - 1)]);
|
|
end;
|
|
if InternalColorB <> clNone then begin
|
|
ACanvas.Pen.Color := InternalColorB;
|
|
ACanvas.PolyLine([Point(Left, Bottom), Point(Right, Bottom)]);
|
|
end;
|
|
|
|
// External borders
|
|
InflateRect(ARect, 1, 1);
|
|
if ColorL <> clNone then begin
|
|
ACanvas.Pen.Color := ColorL;
|
|
ACanvas.PolyLine([
|
|
Point(Left, Bottom - CornerSizeBL),
|
|
Point(Left, Top + CornerSizeTL)
|
|
]);
|
|
end;
|
|
if ColorT <> clNone then begin
|
|
ACanvas.Pen.Color := ColorT;
|
|
ACanvas.PolyLine([
|
|
Point(Left, Top + CornerSizeTL),
|
|
Point(Left + CornerSizeTL, Top),
|
|
Point(Right - CornerSizeTR + 1, Top),
|
|
Point(Right, Top + CornerSizeTR)
|
|
]);
|
|
end;
|
|
if ColorR <> clNone then begin
|
|
ACanvas.Pen.Color := ColorR;
|
|
ACanvas.PolyLine([
|
|
Point(Right, Top + CornerSizeTR),
|
|
Point(Right , Bottom - CornerSizeBR)
|
|
]);
|
|
end;
|
|
if ColorB <> clNone then begin
|
|
ACanvas.Pen.Color := ColorB;
|
|
ACanvas.PolyLine([
|
|
Point(Right, Bottom - CornerSizeBR),
|
|
Point(Right - CornerSizeBR, Bottom),
|
|
Point(Left + CornerSizeBL, Bottom),
|
|
Point(Left, Bottom - CornerSizeBL)
|
|
]);
|
|
end;
|
|
end;
|
|
|
|
ACanvas.Pen.Color := Color;
|
|
end;
|
|
|
|
|
|
procedure SpDrawRectangle(ACanvas: TCanvas; ARect: TRect;
|
|
CornerSize: Integer; ColorTL, ColorBR, ColorTLInternal, ColorBRInternal: TColor;
|
|
ForceRectBorders: TAnchors);
|
|
// Draws 2 beveled borders.
|
|
// CornerSize can be 0, 1 or 2.
|
|
// TLColor, ColorBR: external border color
|
|
// InternalTL, ColorBRInternal: internal border color
|
|
// ForceRectBorders: forces the borders to be rect
|
|
var
|
|
Color: TColor;
|
|
CornerSizeTL, CornerSizeTR, CornerSizeBL, CornerSizeBR: Integer;
|
|
begin
|
|
Color := ACanvas.Pen.Color;
|
|
|
|
if CornerSize < 0 then CornerSize := 0;
|
|
if CornerSize > 2 then CornerSize := 2;
|
|
CornerSizeTL := CornerSize;
|
|
CornerSizeTR := CornerSize;
|
|
CornerSizeBL := CornerSize;
|
|
CornerSizeBR := CornerSize;
|
|
if akLeft in ForceRectBorders then begin
|
|
CornerSizeTL := 0;
|
|
CornerSizeBL := 0;
|
|
end;
|
|
if akRight in ForceRectBorders then begin
|
|
CornerSizeTR := 0;
|
|
CornerSizeBR := 0;
|
|
end;
|
|
if akTop in ForceRectBorders then begin
|
|
CornerSizeTL := 0;
|
|
CornerSizeTR := 0;
|
|
end;
|
|
if akBottom in ForceRectBorders then begin
|
|
CornerSizeBL := 0;
|
|
CornerSizeBR := 0;
|
|
end;
|
|
|
|
with ARect do begin
|
|
Dec(Right);
|
|
Dec(Bottom);
|
|
|
|
// Internal borders
|
|
InflateRect(ARect, -1, -1);
|
|
if ColorTLInternal <> clNone then begin
|
|
ACanvas.Pen.Color := ColorTLInternal;
|
|
ACanvas.PolyLine([
|
|
Point(Left, Bottom),
|
|
Point(Left, Top),
|
|
Point(Right, Top)
|
|
]);
|
|
end;
|
|
if ColorBRInternal <> clNone then begin
|
|
ACanvas.Pen.Color := ColorBRInternal;
|
|
ACanvas.PolyLine([
|
|
Point(Left, Bottom),
|
|
Point(Right, Bottom),
|
|
Point(Right, Top - 1)
|
|
]);
|
|
end;
|
|
|
|
// External borders
|
|
InflateRect(ARect, 1, 1);
|
|
if ColorTL <> clNone then begin
|
|
ACanvas.Pen.Color := ColorTL;
|
|
ACanvas.PolyLine([
|
|
Point(Left + CornerSizeBL, Bottom),
|
|
Point(Left, Bottom - CornerSizeBL),
|
|
Point(Left, Top + CornerSizeTL),
|
|
Point(Left + CornerSizeTL, Top),
|
|
Point(Right - CornerSizeTR, Top),
|
|
Point(Right, Top + CornerSizeTR)
|
|
]);
|
|
end;
|
|
if ColorBR <> clNone then begin
|
|
ACanvas.Pen.Color := ColorBR;
|
|
ACanvas.PolyLine([
|
|
Point(Right, Top + CornerSizeTR),
|
|
Point(Right , Bottom - CornerSizeBR),
|
|
Point(Right - CornerSizeBR, Bottom),
|
|
Point(Left + CornerSizeBL - 1, Bottom)
|
|
]);
|
|
end;
|
|
end;
|
|
|
|
ACanvas.Pen.Color := Color;
|
|
end;
|
|
|
|
procedure SpAlphaBlend(SrcDC, DstDC: HDC; SrcR, DstR: TRect; Alpha: Byte;
|
|
SrcHasAlphaChannel: Boolean = False);
|
|
// NOTE: AlphaBlend does not work on Windows 95 and Windows NT
|
|
var
|
|
BF: TBlendFunction;
|
|
begin
|
|
BF.BlendOp := AC_SRC_OVER;
|
|
BF.BlendFlags := 0;
|
|
BF.SourceConstantAlpha := Alpha;
|
|
if SrcHasAlphaChannel then
|
|
BF.AlphaFormat := AC_SRC_ALPHA
|
|
else
|
|
BF.AlphaFormat := 0;
|
|
Windows.AlphaBlend(DstDC, DstR.Left, DstR.Top, DstR.Right - DstR.Left, DstR.Bottom - DstR.Top,
|
|
SrcDC, SrcR.Left, SrcR.Top, SrcR.Right - SrcR.Left, SrcR.Bottom - SrcR.Top, BF);
|
|
end;
|
|
|
|
procedure SpPaintTo(WinControl: TWinControl; ACanvas: TCanvas; X, Y: Integer);
|
|
// NOTE: PrintWindow does not work if the control is not visible
|
|
var
|
|
B: TBitmap;
|
|
PrevTop: Integer;
|
|
begin
|
|
// Use SpPrintWindow instead of PaintTo as many controls will not render
|
|
// properly (no text on editors, no scrollbars, incorrect borders, etc)
|
|
// http://msdn2.microsoft.com/en-us/library/ms535695.aspx
|
|
if Assigned(SpPrintWindow) then begin
|
|
ACanvas.Lock;
|
|
try
|
|
// It doesn't work if the control is not visible !!!
|
|
// Show it and move it offscreen
|
|
if not WinControl.Visible then begin
|
|
PrevTop := WinControl.Top;
|
|
WinControl.Top := 10000; // Move it offscreen
|
|
WinControl.Visible := True;
|
|
SpPrintWindow(WinControl.Handle, ACanvas.Handle, 0);
|
|
WinControl.Visible := False;
|
|
WinControl.Top := PrevTop;
|
|
end
|
|
else
|
|
SpPrintWindow(WinControl.Handle, ACanvas.Handle, 0);
|
|
finally
|
|
ACanvas.UnLock;
|
|
end;
|
|
end
|
|
else begin
|
|
// If SpPrintWindow is not available use PaintTo
|
|
// If the Control is a Form use GetFormImage instead
|
|
if WinControl is TCustomForm then begin
|
|
B := TCustomForm(WinControl).GetFormImage;
|
|
try
|
|
ACanvas.Draw(X, Y, B);
|
|
finally
|
|
B.Free;
|
|
end;
|
|
end
|
|
else
|
|
WinControl.PaintTo(ACanvas, X, Y);
|
|
end;
|
|
end;
|
|
|
|
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
|
|
{ ImageList painting }
|
|
|
|
procedure SpDrawIconShadow(ACanvas: TCanvas; const ARect: TRect;
|
|
ImageList: TCustomImageList; ImageIndex: Integer);
|
|
var
|
|
ImageWidth, ImageHeight: Integer;
|
|
I, J: Integer;
|
|
Src, Dst: ^Cardinal;
|
|
S, C, CBRB, CBG: Cardinal;
|
|
B1, B2: TBitmap;
|
|
begin
|
|
ImageWidth := ARect.Right - ARect.Left;
|
|
ImageHeight := ARect.Bottom - ARect.Top;
|
|
with ImageList do
|
|
begin
|
|
if Width < ImageWidth then ImageWidth := Width;
|
|
if Height < ImageHeight then ImageHeight := Height;
|
|
end;
|
|
|
|
B1 := TBitmap.Create;
|
|
B2 := TBitmap.Create;
|
|
try
|
|
B1.PixelFormat := pf32bit;
|
|
B2.PixelFormat := pf32bit;
|
|
B1.Width := ImageWidth;
|
|
B1.Height := ImageHeight;
|
|
B2.Width := ImageWidth;
|
|
B2.Height := ImageHeight;
|
|
|
|
BitBlt(B1.Canvas.Handle, 0, 0, ImageWidth, ImageHeight, ACanvas.Handle, ARect.Left, ARect.Top, SRCCOPY);
|
|
BitBlt(B2.Canvas.Handle, 0, 0, ImageWidth, ImageHeight, ACanvas.Handle, ARect.Left, ARect.Top, SRCCOPY);
|
|
ImageList.Draw(B2.Canvas, 0, 0, ImageIndex, True);
|
|
|
|
for J := 0 to ImageHeight - 1 do
|
|
begin
|
|
Src := B2.ScanLine[J];
|
|
Dst := B1.ScanLine[J];
|
|
for I := 0 to ImageWidth - 1 do
|
|
begin
|
|
S := Src^;
|
|
if S <> Dst^ then
|
|
begin
|
|
CBRB := Dst^ and $00FF00FF;
|
|
CBG := Dst^ and $0000FF00;
|
|
C := ((S and $00FF0000) shr 16 * 29 + (S and $0000FF00) shr 8 * 150 +
|
|
(S and $000000FF) * 76) shr 8;
|
|
C := (C div 3) + (255 - 255 div 3);
|
|
Dst^ := ((CBRB * C and $FF00FF00) or (CBG * C and $00FF0000)) shr 8;
|
|
end;
|
|
Inc(Src);
|
|
Inc(Dst);
|
|
end;
|
|
end;
|
|
BitBlt(ACanvas.Handle, ARect.Left, ARect.Top, ImageWidth, ImageHeight, B1.Canvas.Handle, 0, 0, SRCCOPY);
|
|
finally
|
|
B1.Free;
|
|
B2.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure SpDrawImageList(ACanvas: TCanvas; const ARect: TRect; ImageList: TCustomImageList;
|
|
ImageIndex: Integer; Enabled, DisabledIconCorrection: Boolean);
|
|
begin
|
|
if Assigned(ImageList) and (ImageIndex > -1) and (ImageIndex < ImageList.Count) then
|
|
if Enabled then
|
|
ImageList.Draw(ACanvas, ARect.Left, ARect.Top, ImageIndex)
|
|
else
|
|
if DisabledIconCorrection then
|
|
SpDrawIconShadow(ACanvas, ARect, ImageList, ImageIndex)
|
|
else
|
|
ImageList.Draw(ACanvas, ARect.Left, ARect.Top, ImageIndex, False);
|
|
end;
|
|
|
|
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
|
|
{ Gradients }
|
|
|
|
procedure SpGradient(ACanvas: TCanvas; const ARect: TRect;
|
|
StartPos, EndPos, ChunkSize: Integer; C1, C2: TColor; const Vertical: Boolean);
|
|
// StartPos: start position relative to ARect, usually 0
|
|
// EndPos: end position relative to ARect, usually ARect.Bottom - ARect.Top
|
|
// ChunkSize: size of the chunk of the gradient we need to paint
|
|
|
|
procedure SpGradientSoft(ACanvas: TCanvas; const ARect: TRect;
|
|
StartPos, EndPos, ChunkSize: Integer; C1, C2: TColor; const Vertical: Boolean);
|
|
var
|
|
I: Integer;
|
|
r, g, b: Integer;
|
|
rc1, gc1, bc1: Integer;
|
|
rc2, gc2, bc2: Integer;
|
|
PrevColor: TColor;
|
|
begin
|
|
PrevColor := ACanvas.Brush.Color;
|
|
if ChunkSize = 0 then ChunkSize := 1;
|
|
SpGetRGB(C1, rc1, gc1, bc1);
|
|
SpGetRGB(C2, rc2, gc2, bc2);
|
|
for I := StartPos to EndPos do begin
|
|
r := rc1 + (((rc2 - rc1) * (I - StartPos)) div ChunkSize);
|
|
g := gc1 + (((gc2 - gc1) * (I - StartPos)) div ChunkSize);
|
|
b := bc1 + (((bc2 - bc1) * (I - StartPos)) div ChunkSize);
|
|
|
|
ACanvas.Brush.Color := SpRGBToColor(r, g, b);
|
|
if Vertical then
|
|
ACanvas.FillRect(Rect(ARect.Left, ARect.Top + I, ARect.Right, ARect.Top + I + 1))
|
|
else
|
|
ACanvas.FillRect(Rect(ARect.Left + I, ARect.Top, ARect.Left + I + 1, ARect.Bottom));
|
|
end;
|
|
ACanvas.Brush.Color := PrevColor;
|
|
end;
|
|
|
|
{$IFDEF SYSTEM_GRADIENT}
|
|
procedure SpGradientSystem(ACanvas: TCanvas; const ARect: TRect;
|
|
StartPos, EndPos, ChunkSize: Integer; C1, C2: TColor; const Vertical: Boolean);
|
|
|
|
procedure SetVertex(var AVertex: TTriVertex; const APoint: TPoint; ARGBColor: DWORD);
|
|
begin
|
|
AVertex.X := APoint.X;
|
|
AVertex.Y := APoint.Y;
|
|
AVertex.Red := MakeWord(0, GetRValue(ARGBColor));
|
|
AVertex.Green := MakeWord(0, GetGValue(ARGBColor));
|
|
AVertex.Blue := MakeWord(0, GetBValue(ARGBColor));
|
|
AVertex.Alpha := 0;
|
|
end;
|
|
|
|
const
|
|
AModesMap: array[Boolean] of DWORD = (GRADIENT_FILL_RECT_H, GRADIENT_FILL_RECT_V);
|
|
var
|
|
AVertices: array[0..1] of TTriVertex;
|
|
AGradientRect: TGradientRect;
|
|
ARGBColor1, ARGBColor2: DWORD;
|
|
Vertex: TPoint;
|
|
begin
|
|
ARGBColor1 := ColorToRGB(C1);
|
|
ARGBColor2 := ColorToRGB(C2);
|
|
Vertex := ARect.TopLeft;
|
|
if Vertical then
|
|
Vertex.Y := Vertex.Y + StartPos
|
|
else
|
|
Vertex.X := Vertex.X + StartPos;
|
|
SetVertex(AVertices[0], Vertex, ARGBColor1);
|
|
Vertex := ARect.BottomRight;
|
|
if Vertical then
|
|
Vertex.Y := ARect.Top + EndPos + 1
|
|
else
|
|
Vertex.X := ARect.Left + EndPos + 1;
|
|
SetVertex(AVertices[1], Vertex, ARGBColor2);
|
|
AGradientRect.UpperLeft := 0;
|
|
AGradientRect.LowerRight := 1;
|
|
GradientFillSystem(ACanvas.Handle, AVertices[0], 2, AGradientRect, 1, AModesMap[Vertical]);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
begin
|
|
{$IFDEF SYSTEM_GRADIENT}
|
|
if Assigned(GradientFillSystem) then
|
|
SpGradientSystem(ACanvas, ARect, StartPos, EndPos, ChunkSize, C1, C2, Vertical)
|
|
else
|
|
{$ENDIF}
|
|
SpGradientSoft(ACanvas, ARect, StartPos, EndPos, ChunkSize, C1, C2, Vertical);
|
|
end;
|
|
|
|
{
|
|
procedure SpGradient(ACanvas: TCanvas; const ARect: TRect;
|
|
StartPos, EndPos, ChunkSize: Integer; C1, C2: TColor; const Vertical: Boolean);
|
|
// StartPos: start position relative to ARect, usually 0
|
|
// EndPos: end position relative to ARect, usually ARect.Bottom - ARect.Top
|
|
// ChunkSize: size of the chunk of the gradient we need to paint
|
|
var
|
|
I: Integer;
|
|
r, g, b: Integer;
|
|
rc1, gc1, bc1: Integer;
|
|
rc2, gc2, bc2: Integer;
|
|
PrevColor: TColor;
|
|
begin
|
|
PrevColor := ACanvas.Brush.Color;
|
|
if ChunkSize = 0 then ChunkSize := 1;
|
|
SpGetRGB(C1, rc1, gc1, bc1);
|
|
SpGetRGB(C2, rc2, gc2, bc2);
|
|
for I := StartPos to EndPos do begin
|
|
r := rc1 + (((rc2 - rc1) * (I - StartPos)) div ChunkSize);
|
|
g := gc1 + (((gc2 - gc1) * (I - StartPos)) div ChunkSize);
|
|
b := bc1 + (((bc2 - bc1) * (I - StartPos)) div ChunkSize);
|
|
|
|
ACanvas.Brush.Color := SpRGBToColor(r, g, b);
|
|
if Vertical then
|
|
ACanvas.FillRect(Rect(ARect.Left, ARect.Top + I, ARect.Right, ARect.Top + I + 1))
|
|
else
|
|
ACanvas.FillRect(Rect(ARect.Left + I, ARect.Top, ARect.Left + I + 1, ARect.Bottom));
|
|
end;
|
|
ACanvas.Brush.Color := PrevColor;
|
|
end; }
|
|
|
|
procedure SpGradientFill(ACanvas: TCanvas; const ARect: TRect;
|
|
const C1, C2: TColor; const Vertical: Boolean);
|
|
var
|
|
GSize: Integer;
|
|
begin
|
|
if Vertical then
|
|
GSize := (ARect.Bottom - ARect.Top) - 1
|
|
else
|
|
GSize := (ARect.Right - ARect.Left) - 1;
|
|
|
|
SpGradient(ACanvas, ARect, 0, GSize, GSize, C1, C2, Vertical);
|
|
end;
|
|
|
|
procedure SpGradientFillMirror(ACanvas: TCanvas; const ARect: TRect;
|
|
const C1, C2, C3, C4: TColor; const Vertical: Boolean);
|
|
var
|
|
GSize, ChunkSize, d1, d2: Integer;
|
|
begin
|
|
if Vertical then
|
|
GSize := (ARect.Bottom - ARect.Top) - 1
|
|
else
|
|
GSize := (ARect.Right - ARect.Left) - 1;
|
|
|
|
ChunkSize := GSize div 2;
|
|
if ChunkSize = 0 then ChunkSize := 1;
|
|
d1 := ChunkSize;
|
|
d2 := GSize;
|
|
|
|
SpGradient(ACanvas, ARect, 0, d1, ChunkSize, C1, C2, Vertical);
|
|
SpGradient(ACanvas, ARect, d1, d2, ChunkSize, C3, C4, Vertical);
|
|
end;
|
|
|
|
procedure SpGradientFillMirrorTop(ACanvas: TCanvas; const ARect: TRect;
|
|
const C1, C2, C3, C4: TColor; const Vertical: Boolean);
|
|
var
|
|
GSize, d1, d2: Integer;
|
|
begin
|
|
if Vertical then
|
|
GSize := (ARect.Bottom - ARect.Top) - 1
|
|
else
|
|
GSize := (ARect.Right - ARect.Left) - 1;
|
|
|
|
d1 := GSize div 3;
|
|
d2 := GSize;
|
|
|
|
SpGradient(ACanvas, ARect, 0, d1, d1, C1, C2, Vertical);
|
|
SpGradient(ACanvas, ARect, d1, d2, d2 - d1, C3, C4, Vertical);
|
|
end;
|
|
|
|
procedure SpGradientFillGlass(ACanvas: TCanvas; const ARect: TRect;
|
|
const C1, C2, C3, C4: TColor; const Vertical: Boolean);
|
|
var
|
|
GSize, ChunkSize, d1, d2, d3: Integer;
|
|
begin
|
|
if Vertical then
|
|
GSize := (ARect.Bottom - ARect.Top) - 1
|
|
else
|
|
GSize := (ARect.Right - ARect.Left) - 1;
|
|
|
|
ChunkSize := GSize div 3;
|
|
if ChunkSize = 0 then ChunkSize := 1;
|
|
d1 := ChunkSize;
|
|
d2 := ChunkSize * 2;
|
|
d3 := GSize;
|
|
|
|
SpGradient(ACanvas, ARect, 0, d1, ChunkSize, C1, C2, Vertical);
|
|
SpGradient(ACanvas, ARect, d1, d2, ChunkSize, C2, C3, Vertical);
|
|
SpGradient(ACanvas, ARect, d2, d3, ChunkSize, C3, C4, Vertical);
|
|
end;
|
|
|
|
procedure SpGradientFill9pixels(ACanvas: TCanvas; const ARect: TRect;
|
|
const C1, C2, C3, C4: TColor; const Vertical: Boolean);
|
|
// Mimics Vista menubar/toolbar blue gradient
|
|
var
|
|
GSize, d1, d2: Integer;
|
|
begin
|
|
if Vertical then
|
|
GSize := (ARect.Bottom - ARect.Top) - 1
|
|
else
|
|
GSize := (ARect.Right - ARect.Left) - 1;
|
|
|
|
d1 := GSize div 3;
|
|
if d1 > 9 then d1 := 9;
|
|
d2 := GSize;
|
|
|
|
SpGradient(ACanvas, ARect, 0, d1, d1, C1, C2, Vertical);
|
|
SpGradient(ACanvas, ARect, d1, d2, d2 - d1, C3, C4, Vertical);
|
|
end;
|
|
|
|
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
|
|
{ Element painting }
|
|
|
|
procedure SpDrawArrow(ACanvas: TCanvas; X, Y: Integer; AColor: TColor; Vertical, Reverse: Boolean; Size: Integer);
|
|
var
|
|
C1, C2: TColor;
|
|
begin
|
|
C1 := ACanvas.Pen.Color;
|
|
C2 := ACanvas.Brush.Color;
|
|
ACanvas.Pen.Color := AColor;
|
|
ACanvas.Brush.Color := AColor;
|
|
|
|
if Vertical then
|
|
if Reverse then
|
|
ACanvas.Polygon([Point(X, Y), Point(X - Size, Y + Size), Point(X + Size, Y + Size)])
|
|
else
|
|
ACanvas.Polygon([Point(X - Size, Y), Point(X + Size, Y), Point(X, Y + Size)])
|
|
else
|
|
if Reverse then
|
|
ACanvas.Polygon([Point(X, Y), Point(X + Size, Y + Size), Point(X + Size, Y - Size)])
|
|
else
|
|
ACanvas.Polygon([Point(X, Y - Size), Point(X, Y + Size), Point(X + Size, Y)]);
|
|
|
|
ACanvas.Pen.Color := C1;
|
|
ACanvas.Brush.Color := C2;
|
|
end;
|
|
|
|
procedure SpDrawDropMark(ACanvas: TCanvas; DropMark: TRect);
|
|
var
|
|
C: TColor;
|
|
R: TRect;
|
|
begin
|
|
if IsRectEmpty(DropMark) then Exit;
|
|
C := ACanvas.Brush.Color;
|
|
|
|
R := Rect(DropMark.Left + 1, DropMark.Top, DropMark.Right - 1, DropMark.Top + 2);
|
|
ACanvas.Rectangle(R);
|
|
R := Rect(DropMark.Left + 1, DropMark.Bottom - 2, DropMark.Right - 1, DropMark.Bottom);
|
|
ACanvas.Rectangle(R);
|
|
|
|
R := Rect(DropMark.Left, DropMark.Top + 1, DropMark.Right, DropMark.Top + 3);
|
|
ACanvas.Rectangle(R);
|
|
R := Rect(DropMark.Left, DropMark.Bottom - 3, DropMark.Right, DropMark.Bottom - 1);
|
|
ACanvas.Rectangle(R);
|
|
|
|
R := Rect(DropMark.Left + 1, DropMark.Top + 4, DropMark.Right - 1, DropMark.Bottom - 4);
|
|
ACanvas.Rectangle(R);
|
|
|
|
{
|
|
// Standard DropMark
|
|
|
|
R := Rect(DropMark.Left, DropMark.Top, DropMark.Right - 1, DropMark.Bottom - 1);
|
|
if IsRectEmpty(R) then Exit;
|
|
ACanvas.Brush.Color := clBlack;
|
|
ACanvas.Polygon([
|
|
Point(R.Left, R.Top),
|
|
Point(R.Left + 2, R.Top + 2),
|
|
Point(R.Left + 2, R.Bottom - 2),
|
|
Point(R.Left, R.Bottom),
|
|
Point(R.Right, R.Bottom),
|
|
Point(R.Right - 2, R.Bottom - 2),
|
|
Point(R.Right - 2, R.Top + 2),
|
|
Point(R.Right, R.Top)
|
|
]);
|
|
}
|
|
ACanvas.Brush.Color := C;
|
|
end;
|
|
|
|
procedure SpDrawFocusRect(ACanvas: TCanvas; const ARect: TRect);
|
|
var
|
|
DC: HDC;
|
|
C1, C2: TColor;
|
|
begin
|
|
if not IsRectEmpty(ARect) then begin
|
|
DC := ACanvas.Handle;
|
|
C1 := SetTextColor(DC, clBlack);
|
|
C2 := SetBkColor(DC, clWhite);
|
|
ACanvas.DrawFocusRect(ARect);
|
|
SetTextColor(DC, C1);
|
|
SetBkColor(DC, C2);
|
|
end;
|
|
end;
|
|
|
|
procedure SpDrawGlyphPattern(DC: HDC; const R: TRect; Width, Height: Integer;
|
|
const PatternBits; PatternColor: TColor);
|
|
var
|
|
B: TBitmap;
|
|
OldTextColor, OldBkColor: Longword;
|
|
OldBrush, Brush: HBrush;
|
|
BitmapWidth, BitmapHeight: Integer;
|
|
begin
|
|
OldTextColor := SetTextColor(DC, clBlack);
|
|
OldBkColor := SetBkColor(DC, clWhite);
|
|
B := TBitmap.Create;
|
|
try
|
|
BitmapWidth := 8;
|
|
if Width > BitmapWidth then BitmapWidth := Width;
|
|
BitmapHeight := 8;
|
|
if Height > BitmapHeight then BitmapHeight := Height;
|
|
|
|
B.Handle := CreateBitmap(BitmapWidth, BitmapHeight, 1, 1, @PatternBits);
|
|
if PatternColor < 0 then Brush := GetSysColorBrush(PatternColor and $FF)
|
|
else Brush := CreateSolidBrush(PatternColor);
|
|
OldBrush := SelectObject(DC, Brush);
|
|
BitBlt(DC, (R.Left + R.Right + 1 - Width) div 2, (R.Top + R.Bottom + 1 - Height) div 2,
|
|
Width, Height, B.Canvas.Handle, 0, 0, ROP_DSPDxax);
|
|
SelectObject(DC, OldBrush);
|
|
if PatternColor >= 0 then DeleteObject(Brush);
|
|
finally
|
|
SetTextColor(DC, OldTextColor);
|
|
SetBkColor(DC, OldBkColor);
|
|
B.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure SpDrawGlyphPattern(ACanvas: TCanvas; ARect: TRect; PatternIndex: Integer; PatternColor: TColor);
|
|
// The pattern is a 8x8 bitmap
|
|
// The array has 16 elements, only the odd elements are used
|
|
// The first value of an element represents the bits from the 4 first horizontal pixels,
|
|
// and the next value represents the bits of the 4 last horizontal pixels.
|
|
// For example: 0 represents --------
|
|
// $FF represents xxxxxxxx
|
|
// $C6 represents xx---xx-
|
|
const
|
|
ClosePattern: array [0..15] of Byte = ($C6, 0, $EE, 0, $7C, 0, $38, 0, $7C, 0, $EE, 0, $C6, 0, 0, 0);
|
|
MaximizePattern: array [0..15] of Byte = ($FF, 0, $FF, 0, $81, 0, $81, 0, $81, 0, $81, 0, $81, 0, $FF, 0);
|
|
MinimizePattern: array [0..15] of Byte = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, $7E, 0, $7E, 0, 0, 0);
|
|
RestorePattern: array [0..17] of Byte = ($3F, 0, $3F, 0, $21, 0, $FD, 0, $FD, 0, $87, 0, $84, 0, $84, 0, $FC, 0);
|
|
begin
|
|
case PatternIndex of
|
|
0: SpDrawGlyphPattern(ACanvas.Handle, ARect, 8, 8, ClosePattern[0], PatternColor);
|
|
1: SpDrawGlyphPattern(ACanvas.Handle, ARect, 8, 8, MaximizePattern[0], PatternColor);
|
|
2: SpDrawGlyphPattern(ACanvas.Handle, ARect, 8, 8, MinimizePattern[0], PatternColor);
|
|
3: SpDrawGlyphPattern(ACanvas.Handle, ARect, 8, 9, RestorePattern[0], PatternColor);
|
|
end;
|
|
end;
|
|
|
|
procedure SpDrawXPButton(ACanvas: TCanvas; ARect: TRect; Enabled, Pushed,
|
|
HotTrack, Checked, Focused, Defaulted: Boolean; SkinType: TSpTBXSkinType);
|
|
var
|
|
Flags: Cardinal;
|
|
C: TColor;
|
|
State: TSpTBXSkinStatesType;
|
|
begin
|
|
SkinType := SpTBXSkinType(SkinType);
|
|
case SkinType of
|
|
sknNone:
|
|
begin
|
|
C := ACanvas.Brush.Color;
|
|
ACanvas.Brush.Color := clBtnFace;
|
|
ACanvas.FillRect(ARect);
|
|
if Defaulted or Focused then begin
|
|
ACanvas.Brush.Color := clWindowFrame;
|
|
ACanvas.FrameRect(ARect);
|
|
InflateRect(ARect, -1, -1); // Reduce the Rect for the focus rect
|
|
end;
|
|
if Pushed or Checked then begin
|
|
ACanvas.Brush.Color := clBtnShadow;
|
|
ACanvas.FrameRect(ARect);
|
|
end
|
|
else
|
|
DrawFrameControl(ACanvas.Handle, ARect, DFC_BUTTON, DFCS_BUTTONPUSH);
|
|
ACanvas.Brush.Color := C;
|
|
end;
|
|
sknWindows:
|
|
begin
|
|
if not Enabled then Flags := PBS_DISABLED
|
|
else if Pushed or Checked then Flags := PBS_PRESSED
|
|
else if HotTrack then Flags := PBS_HOT
|
|
else if Defaulted or Focused then Flags := PBS_DEFAULTED
|
|
else Flags := PBS_NORMAL;
|
|
DrawThemeBackground(ThemeServices.Theme[teButton], ACanvas.Handle, BP_PUSHBUTTON, Flags, ARect, nil);
|
|
end;
|
|
sknSkin:
|
|
begin
|
|
State := CurrentSkin.GetState(Enabled, Pushed, HotTrack, Checked);
|
|
CurrentSkin.PaintBackground(ACanvas, ARect, skncButton, State, True, True);
|
|
end;
|
|
end;
|
|
|
|
if Focused then begin
|
|
InflateRect(ARect, -3, -3);
|
|
SpDrawFocusRect(ACanvas, ARect);
|
|
end;
|
|
end;
|
|
|
|
procedure SpDrawXPCheckBoxGlyph(ACanvas: TCanvas; ARect: TRect; Enabled: Boolean;
|
|
State: TCheckBoxState; HotTrack, Pushed: Boolean; SkinType: TSpTBXSkinType);
|
|
var
|
|
Flags: Integer;
|
|
SknState: TSpTBXSkinStatesType;
|
|
begin
|
|
SkinType := SpTBXSkinType(SkinType);
|
|
Flags := 0;
|
|
case SkinType of
|
|
sknNone:
|
|
begin
|
|
case State of
|
|
cbChecked: Flags := DFCS_BUTTONCHECK or DFCS_CHECKED;
|
|
cbGrayed: Flags := DFCS_BUTTON3STATE or DFCS_CHECKED;
|
|
cbUnChecked: Flags := DFCS_BUTTONCHECK;
|
|
end;
|
|
if not Enabled then
|
|
Flags := Flags or DFCS_INACTIVE;
|
|
if Pushed then
|
|
Flags := Flags or DFCS_PUSHED;
|
|
DrawFrameControl(ACanvas.Handle, ARect, DFC_BUTTON, Flags);
|
|
end;
|
|
sknWindows:
|
|
begin
|
|
case State of
|
|
cbChecked: Flags := CBS_CHECKEDNORMAL;
|
|
cbGrayed: Flags := CBS_MIXEDNORMAL;
|
|
cbUnChecked: Flags := CBS_UNCHECKEDNORMAL;
|
|
end;
|
|
|
|
if not Enabled then Inc(Flags, 3)
|
|
else
|
|
if Pushed then Inc(Flags, 2)
|
|
else if HotTrack then Inc(Flags);
|
|
DrawThemeBackground(ThemeServices.Theme[teButton], ACanvas.Handle, BP_CHECKBOX, Flags, ARect, nil);
|
|
end;
|
|
sknSkin:
|
|
begin
|
|
SknState := CurrentSkin.GetState(Enabled, Pushed, HotTrack, State in [cbChecked, cbGrayed]);
|
|
CurrentSkin.PaintMenuCheckMark(ACanvas, ARect, State = cbChecked, State = cbGrayed, False, SknState);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SpDrawXPRadioButtonGlyph(ACanvas: TCanvas; ARect: TRect; Enabled: Boolean;
|
|
Checked, HotTrack, Pushed: Boolean; SkinType: TSpTBXSkinType);
|
|
var
|
|
Flags: Integer;
|
|
SknState: TSpTBXSkinStatesType;
|
|
begin
|
|
SkinType := SpTBXSkinType(SkinType);
|
|
case SkinType of
|
|
sknNone:
|
|
begin
|
|
Flags := DFCS_BUTTONRADIO;
|
|
if Checked then
|
|
Flags := Flags or DFCS_CHECKED;
|
|
if not Enabled then
|
|
Flags := Flags or DFCS_INACTIVE;
|
|
if Pushed then
|
|
Flags := Flags or DFCS_PUSHED;
|
|
DrawFrameControl(ACanvas.Handle, ARect, DFC_BUTTON, Flags);
|
|
end;
|
|
sknWindows:
|
|
begin
|
|
if Checked then Flags := RBS_CHECKEDNORMAL
|
|
else Flags := RBS_UNCHECKEDNORMAL;
|
|
|
|
if not Enabled then Inc(Flags, 3)
|
|
else
|
|
if Pushed then Inc(Flags, 2)
|
|
else if HotTrack then Inc(Flags);
|
|
DrawThemeBackground(ThemeServices.Theme[teButton], ACanvas.Handle, BP_RADIOBUTTON, Flags, ARect, nil);
|
|
end;
|
|
sknSkin:
|
|
begin
|
|
SknState := CurrentSkin.GetState(Enabled, Pushed, HotTrack, Checked);
|
|
CurrentSkin.PaintMenuRadioMark(ACanvas, ARect, Checked, False, SknState);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SpDrawXPEditFrame(ACanvas: TCanvas; ARect: TRect; Enabled, HotTrack: Boolean;
|
|
SkinType: TSpTBXSkinType; ClipContent: Boolean; AutoAdjust: Boolean);
|
|
var
|
|
PartID, Flags: Integer;
|
|
BorderR: TRect;
|
|
State: TSpTBXSkinStatesType;
|
|
Entry: TSpTBXSkinOptionEntry;
|
|
const
|
|
CP_BORDER = 4; // Available only on Vista with Delphi 2007
|
|
begin
|
|
SkinType := SpTBXSkinType(SkinType);
|
|
|
|
if ClipContent then begin
|
|
BorderR := ARect;
|
|
if HotTrack then
|
|
InflateRect(BorderR, -1, -1)
|
|
else
|
|
InflateRect(BorderR, -2, -2);
|
|
ExcludeClipRect(ACanvas.Handle, BorderR.Left, BorderR.Top, BorderR.Right, BorderR.Bottom);
|
|
end;
|
|
try
|
|
case SkinType of
|
|
sknNone:
|
|
if HotTrack then
|
|
SpDrawRectangle(ACanvas, ARect, 0, clBtnShadow, clBtnHighlight, clBtnFace, clBtnFace)
|
|
else
|
|
SpDrawRectangle(ACanvas, ARect, 0, clBtnFace, clBtnFace, clBtnFace, clBtnFace);
|
|
sknWindows:
|
|
begin
|
|
if SpIsWinVistaOrUp then begin
|
|
// Use the new API on Windows Vista
|
|
PartID := CP_BORDER;
|
|
if not Enabled then Flags := CBXS_DISABLED
|
|
else if HotTrack then Flags := CBXS_HOT
|
|
else Flags := CBXS_NORMAL;
|
|
end
|
|
else begin
|
|
PartID := 0;
|
|
Flags := 0;
|
|
end;
|
|
DrawThemeBackground(ThemeServices.Theme[teComboBox], ACanvas.Handle, PartID, Flags, ARect, nil);
|
|
end;
|
|
sknSkin:
|
|
begin
|
|
State := CurrentSkin.GetState(Enabled, False, HotTrack, False);
|
|
// Try to adjust the borders if only the internal borders are specified,
|
|
// used by some controls that need to paint the edit frames like
|
|
// TSpTBXPanel (HotTrack=True), TSpTBXListBox, TSpTBXCheckListBox, etc
|
|
if AutoAdjust then begin
|
|
Entry := SkinManager.CurrentSkin.Options(skncEditFrame, State).Borders;
|
|
if (Entry.Color1 = clNone) and (Entry.Color2 = clNone) and
|
|
(Entry.Color3 <> clNone) and (Entry.Color4 <> clNone) then
|
|
begin
|
|
CurrentSkin.PaintBackground(ACanvas, ARect, skncEditFrame, State, True, False);
|
|
SpDrawRectangle(ACanvas, ARect, Entry.SkinType, Entry.Color3, Entry.Color4);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
CurrentSkin.PaintBackground(ACanvas, ARect, skncEditFrame, State, True, True);
|
|
end;
|
|
end;
|
|
finally
|
|
if ClipContent then
|
|
SelectClipRgn(ACanvas.Handle, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure SpDrawXPEditFrame(AWinControl: TWinControl; HotTracking: Boolean;
|
|
SkinType: TSpTBXSkinType; AutoAdjust, HideFrame: Boolean);
|
|
var
|
|
R: TRect;
|
|
DC: HDC;
|
|
ACanvas: TCanvas;
|
|
begin
|
|
DC := GetWindowDC(AWinControl.Handle);
|
|
try
|
|
ACanvas := TCanvas.Create;
|
|
try
|
|
ACanvas.Handle := DC;
|
|
GetWindowRect(AWinControl.Handle, R);
|
|
OffsetRect(R, -R.Left, -R.Top);
|
|
with R do
|
|
ExcludeClipRect(DC, Left + 2, Top + 2, Right - 2, Bottom - 2);
|
|
|
|
if HideFrame then begin
|
|
ACanvas.Brush.Color := TControlAccess(AWinControl).Color;
|
|
ACanvas.FillRect(R);
|
|
end
|
|
else begin
|
|
// Don't use SpDrawParentBackground to paint the background it doesn't get
|
|
// the correct WindowOrg in this particular case
|
|
PerformEraseBackground(AWinControl, ACanvas.Handle);
|
|
SpDrawXPEditFrame(ACanvas, R, AWinControl.Enabled, HotTracking, SkinType, False, AutoAdjust);
|
|
end;
|
|
finally
|
|
ACanvas.Handle := 0;
|
|
ACanvas.Free;
|
|
end;
|
|
finally
|
|
ReleaseDC(AWinControl.Handle, DC);
|
|
end;
|
|
end;
|
|
|
|
procedure SpDrawXPGrip(ACanvas: TCanvas; ARect: TRect; LoC, HiC: TColor);
|
|
var
|
|
I, J: Integer;
|
|
XCellCount, YCellCount: Integer;
|
|
R: TRect;
|
|
C: TColor;
|
|
begin
|
|
// 4 x 4 cells (Grey, White, Null)
|
|
// GG--
|
|
// GGW-
|
|
// -WW-
|
|
// ----
|
|
|
|
C := ACanvas.Brush.Color;
|
|
XCellCount := (ARect.Right - ARect.Left) div 4;
|
|
YCellCount := (ARect.Bottom - ARect.Top) div 4;
|
|
if XCellCount = 0 then XCellCount := 1;
|
|
if YCellCount = 0 then YCellCount := 1;
|
|
|
|
for J := 0 to YCellCount - 1 do
|
|
for I := 0 to XCellCount - 1 do begin
|
|
R.Left := ARect.Left + (I * 4) + 1;
|
|
R.Right := R.Left + 2;
|
|
R.Top := ARect.Top + (J * 4) + 1;
|
|
R.Bottom := R.Top + 2;
|
|
|
|
ACanvas.Brush.Color := HiC;
|
|
ACanvas.FillRect(R);
|
|
OffsetRect(R, -1, -1);
|
|
ACanvas.Brush.Color := LoC;
|
|
ACanvas.FillRect(R);
|
|
end;
|
|
ACanvas.Brush.Color := C;
|
|
end;
|
|
|
|
procedure SpDrawXPHeader(ACanvas: TCanvas; ARect: TRect; HotTrack, Pushed: Boolean; SkinType: TSpTBXSkinType);
|
|
var
|
|
Flags: Cardinal;
|
|
State: TSpTBXSkinStatesType;
|
|
begin
|
|
SkinType := SpTBXSkinType(SkinType);
|
|
case SkinType of
|
|
sknNone:
|
|
begin
|
|
DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDINNER or BDR_RAISEDOUTER, BF_RECT or BF_SOFT);
|
|
end;
|
|
sknWindows:
|
|
begin
|
|
if Pushed then Flags := HIS_PRESSED
|
|
else if HotTrack then Flags := HIS_HOT
|
|
else Flags := HIS_NORMAL;
|
|
DrawThemeBackground(ThemeServices.Theme[teHeader], ACanvas.Handle, HP_HEADERITEM, Flags, ARect, nil);
|
|
end;
|
|
sknSkin:
|
|
begin
|
|
State := CurrentSkin.GetState(True, Pushed, HotTrack, False);
|
|
if (State = sknsPushed) and CurrentSkin.Options(skncHeader, State).IsEmpty then
|
|
State := sknsHotTrack;
|
|
CurrentSkin.PaintBackground(ACanvas, ARect, skncHeader, State, True, True);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SpDrawXPListItemBackground(ACanvas: TCanvas; ARect: TRect; Selected, HotTrack, Focused: Boolean;
|
|
SkinType: TSpTBXSkinType; ForceRectBorders: Boolean; Borders: Boolean);
|
|
var
|
|
State: TSpTBXSkinStatesType;
|
|
PrevColor: TColor;
|
|
begin
|
|
PrevColor := ACanvas.Font.Color;
|
|
if SpTBXSkinType(SkinType) = sknSkin then begin
|
|
ACanvas.FillRect(ARect);
|
|
if HotTrack or Selected then begin
|
|
State := CurrentSkin.GetState(True, False, HotTrack, Selected);
|
|
ACanvas.Font.Color := CurrentSkin.GetTextColor(skncListItem, State);
|
|
if ForceRectBorders then
|
|
CurrentSkin.PaintBackground(ACanvas, ARect, skncListItem, State, True, Borders, False, [akLeft, akTop, akRight, akBottom])
|
|
else
|
|
CurrentSkin.PaintBackground(ACanvas, ARect, skncListItem, State, True, Borders);
|
|
end;
|
|
end
|
|
else begin
|
|
if Selected then begin
|
|
ACanvas.Brush.Color := clHighlight;
|
|
ACanvas.Font.Color := clHighlightText;
|
|
end;
|
|
ACanvas.FillRect(ARect);
|
|
if Focused then
|
|
SpDrawFocusRect(ACanvas, ARect);
|
|
end;
|
|
ACanvas.Font.Color := PrevColor;
|
|
end;
|
|
|
|
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
|
|
{ Skins painting }
|
|
|
|
procedure SpPaintSkinBackground(ACanvas: TCanvas; ARect: TRect; SkinOption: TSpTBXSkinOptionCategory; Vertical: Boolean);
|
|
var
|
|
Part: TSpTBXSkinOptionEntry;
|
|
SkinType: Integer;
|
|
begin
|
|
Part := SkinOption.Body;
|
|
SkinType := SkinOption.Body.SkinType;
|
|
|
|
if Vertical then
|
|
case SkinType of
|
|
1: SkinType := 2; // Vertical Gradient to Horizontal
|
|
2: SkinType := 1; // Horizontal Gradient to Vertical
|
|
|
|
3: SkinType := 4; // Vertical Glass Gradient to Horizontal
|
|
4: SkinType := 3; // Horizontal Glass Gradient to Vertical
|
|
|
|
5: SkinType := 6; // Vertical Mirror Gradient to Horizontal
|
|
6: SkinType := 5; // Horizontal Mirror Gradient to Vertical
|
|
|
|
7: SkinType := 8; // Vertical MirrorTop Gradient to Horizontal
|
|
8: SkinType := 7; // Horizontal MirrorTop Gradient to Vertical
|
|
|
|
9: SkinType := 10; // Vertical 9Pixels Gradient to Horizontal
|
|
10: SkinType := 9; // Horizontal 9Pixels Gradient to Vertical
|
|
end;
|
|
|
|
case SkinType of
|
|
0: begin // Solid
|
|
SpFillRect(ACanvas, ARect, Part.Color1);
|
|
end;
|
|
1: begin // Vertical Gradient
|
|
SpGradientFill(ACanvas, ARect, Part.Color1, Part.Color2, True);
|
|
end;
|
|
2: begin // Horizontal Gradient
|
|
SpGradientFill(ACanvas, ARect, Part.Color1, Part.Color2, False);
|
|
end;
|
|
3: begin // Vertical Glass Gradient
|
|
SpGradientFillGlass(ACanvas, ARect, Part.Color1, Part.Color2, Part.Color3, Part.Color4, True);
|
|
end;
|
|
4: begin // Horizontal Glass Gradient
|
|
SpGradientFillGlass(ACanvas, ARect, Part.Color1, Part.Color2, Part.Color3, Part.Color4, False);
|
|
end;
|
|
5: begin // Vertical Mirror Gradient
|
|
SpGradientFillMirror(ACanvas, ARect, Part.Color1, Part.Color2, Part.Color3, Part.Color4, True);
|
|
end;
|
|
6: begin // Horizontal Mirror Gradient
|
|
SpGradientFillMirror(ACanvas, ARect, Part.Color1, Part.Color2, Part.Color3, Part.Color4, False);
|
|
end;
|
|
7: begin // Vertical MirrorTop Gradient
|
|
SpGradientFillMirrorTop(ACanvas, ARect, Part.Color1, Part.Color2, Part.Color3, Part.Color4, True);
|
|
end;
|
|
8: begin // Horizontal MirrorTop Gradient
|
|
SpGradientFillMirrorTop(ACanvas, ARect, Part.Color1, Part.Color2, Part.Color3, Part.Color4, False);
|
|
end;
|
|
9: begin // Vertical 9Pixels Gradient
|
|
SpGradientFill9Pixels(ACanvas, ARect, Part.Color1, Part.Color2, Part.Color3, Part.Color4, True);
|
|
end;
|
|
10:begin // Horizontal 9Pixels Gradient
|
|
SpGradientFill9Pixels(ACanvas, ARect, Part.Color1, Part.Color2, Part.Color3, Part.Color4, False);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SpPaintSkinBorders(ACanvas: TCanvas; ARect: TRect; SkinOption: TSpTBXSkinOptionCategory;
|
|
ForceRectBorders: TAnchors = []);
|
|
var
|
|
Part: TSpTBXSkinOptionEntry;
|
|
begin
|
|
Part := SkinOption.Borders;
|
|
case Part.SkinType of
|
|
0, 1, 2: // Rectangle, Simple Rounded and Double Rounded Border
|
|
begin
|
|
SpDrawRectangle(ACanvas, ARect, Part.SkinType, Part.Color1, Part.Color2, Part.Color3, Part.Color4, ForceRectBorders);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
|
|
{ Misc }
|
|
|
|
function SpIsWinVistaOrUp: Boolean;
|
|
begin
|
|
Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 6);
|
|
end;
|
|
|
|
function SpGetDirectories(Path: WideString; L: TStringList): Boolean;
|
|
var
|
|
SearchRec: TSearchRec;
|
|
begin
|
|
Result := False;
|
|
if DirectoryExists(Path) then begin
|
|
Path := IncludeTrailingPathDelimiter(Path) + '*.*';
|
|
if FindFirst(Path, faDirectory, SearchRec) = 0 then begin
|
|
try
|
|
repeat
|
|
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
|
|
L.Add(SearchRec.Name);
|
|
until FindNext(SearchRec) <> 0;
|
|
Result := True;
|
|
finally
|
|
FindClose(SearchRec);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
|
|
{ TSpTBXSkinOptionEntry }
|
|
|
|
procedure TSpTBXSkinOptionEntry.AssignTo(Dest: TPersistent);
|
|
begin
|
|
if Dest is TSpTBXSkinOptionEntry then
|
|
with TSpTBXSkinOptionEntry(Dest) do begin
|
|
SkinType := Self.SkinType;
|
|
Color1 := Self.Color1;
|
|
Color2 := Self.Color2;
|
|
Color3 := Self.Color3;
|
|
Color4 := Self.Color4;
|
|
end
|
|
else inherited AssignTo(Dest);
|
|
end;
|
|
|
|
constructor TSpTBXSkinOptionEntry.Create;
|
|
begin
|
|
inherited;
|
|
Reset;
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptionEntry.Fill(ASkinType: Integer; AColor1, AColor2,
|
|
AColor3, AColor4: TColor);
|
|
begin
|
|
FSkinType := ASkinType;
|
|
FColor1 := AColor1;
|
|
FColor2 := AColor2;
|
|
FColor3 := AColor3;
|
|
FColor4 := AColor4;
|
|
end;
|
|
|
|
function TSpTBXSkinOptionEntry.IsEmpty: Boolean;
|
|
begin
|
|
Result := (FColor1 = clNone) and (FColor2 = clNone) and (FColor3 = clNone) and (FColor4 = clNone);
|
|
end;
|
|
|
|
function TSpTBXSkinOptionEntry.IsEqual(AOptionEntry: TSpTBXSkinOptionEntry): Boolean;
|
|
begin
|
|
Result := (FSkinType = AOptionEntry.SkinType) and
|
|
(FColor1 = AOptionEntry.Color1) and (FColor2 = AOptionEntry.Color2) and
|
|
(FColor3 = AOptionEntry.Color3) and (FColor4 = AOptionEntry.Color4);
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptionEntry.Lighten(Amount: Integer);
|
|
begin
|
|
if FColor1 <> clNone then FColor1 := SpLighten(FColor1, Amount);
|
|
if FColor2 <> clNone then FColor2 := SpLighten(FColor2, Amount);
|
|
if FColor3 <> clNone then FColor3 := SpLighten(FColor3, Amount);
|
|
if FColor4 <> clNone then FColor4 := SpLighten(FColor4, Amount);
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptionEntry.Reset;
|
|
begin
|
|
FSkinType := 0;
|
|
FColor1 := clNone;
|
|
FColor2 := clNone;
|
|
FColor3 := clNone;
|
|
FColor4 := clNone;
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptionEntry.ReadFromString(S: string);
|
|
var
|
|
L: TStringList;
|
|
begin
|
|
Reset;
|
|
L := TStringList.Create;
|
|
try
|
|
L.CommaText := S;
|
|
try
|
|
if L.Count > 0 then FSkinType := StrToIntDef(L[0], 0);
|
|
if L.Count > 1 then FColor1 := StringToColor(L[1]);
|
|
if L.Count > 2 then FColor2 := StringToColor(L[2]);
|
|
if L.Count > 3 then FColor3 := StringToColor(L[3]);
|
|
if L.Count > 4 then FColor4 := StringToColor(L[4]);
|
|
except
|
|
// do nothing
|
|
end;
|
|
finally
|
|
L.Free;
|
|
end;
|
|
end;
|
|
|
|
function TSpTBXSkinOptionEntry.WriteToString: string;
|
|
begin
|
|
Result := Format('%d, %s, %s, %s, %s', [FSkinType,
|
|
SpColorToString(FColor1), SpColorToString(FColor2),
|
|
SpColorToString(FColor3), SpColorToString(FColor4)]);
|
|
end;
|
|
|
|
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
|
|
{ TSpTBXThemeOptionCategory }
|
|
|
|
procedure TSpTBXSkinOptionCategory.AssignTo(Dest: TPersistent);
|
|
begin
|
|
if Dest is TSpTBXSkinOptionCategory then
|
|
with TSpTBXSkinOptionCategory(Dest) do begin
|
|
Body.Assign(Self.Body);
|
|
Borders.Assign(Self.Borders);
|
|
TextColor := Self.TextColor;
|
|
end
|
|
else inherited AssignTo(Dest);
|
|
end;
|
|
|
|
constructor TSpTBXSkinOptionCategory.Create;
|
|
begin
|
|
inherited;
|
|
FBody := TSpTBXSkinOptionEntry.Create;
|
|
FBorders := TSpTBXSkinOptionEntry.Create;
|
|
FTextColor := clNone;
|
|
end;
|
|
|
|
destructor TSpTBXSkinOptionCategory.Destroy;
|
|
begin
|
|
FreeAndNil(FBody);
|
|
FreeAndNil(FBorders);
|
|
inherited;
|
|
end;
|
|
|
|
function TSpTBXSkinOptionCategory.IsEmpty: Boolean;
|
|
begin
|
|
Result := FBody.IsEmpty and FBorders.IsEmpty and (FTextColor = clNone);
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptionCategory.Reset;
|
|
begin
|
|
FBody.Reset;
|
|
FBorders.Reset;
|
|
FTextColor := clNone;
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptionCategory.SaveToIni(MemIni: TMemIniFile; Section, Ident: string);
|
|
begin
|
|
if not IsEmpty then begin
|
|
MemIni.WriteString(Section, Ident + '.Body', Body.WriteToString);
|
|
MemIni.WriteString(Section, Ident + '.Borders', Borders.WriteToString);
|
|
MemIni.WriteString(Section, Ident + '.TextColor', SpColorToString(TextColor));
|
|
end;
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptionCategory.LoadFromIni(MemIni: TMemIniFile; Section, Ident: string);
|
|
begin
|
|
Reset;
|
|
if Ident = '' then Ident := SSpTBXSkinStatesString[sknsNormal];
|
|
|
|
Body.ReadFromString(MemIni.ReadString(Section, Ident + '.Body', ''));
|
|
Borders.ReadFromString(MemIni.ReadString(Section, Ident + '.Borders', ''));
|
|
TextColor := StringToColor(MemIni.ReadString(Section, Ident + '.TextColor', 'clNone'));
|
|
end;
|
|
|
|
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
|
|
{ TSpTBXThemeOptions }
|
|
|
|
procedure TSpTBXSkinOptions.AssignTo(Dest: TPersistent);
|
|
var
|
|
C: TSpTBXSkinComponentsType;
|
|
S: TSpTBXSkinStatesType;
|
|
DestOp: TSpTBXSkinOptions;
|
|
begin
|
|
if Dest is TSpTBXSkinOptions then begin
|
|
DestOp := TSpTBXSkinOptions(Dest);
|
|
for C := Low(C) to High(C) do
|
|
for S := Low(S) to High(S) do
|
|
DestOp.FOptions[C, S].Assign(Options(C, S));
|
|
DestOp.ColorBtnFace := FColorBtnFace;
|
|
DestOp.FloatingWindowBorderSize := FFloatingWindowBorderSize;
|
|
DestOp.OfficeIcons := FOfficeIcons;
|
|
DestOp.OfficeMenu := FOfficeMenu;
|
|
DestOp.OfficeStatusBar := FOfficeStatusBar;
|
|
DestOp.FSkinAuthor := FSkinAuthor;
|
|
DestOp.FSkinName := FSkinName;
|
|
end
|
|
else inherited AssignTo(Dest);
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptions.BroadcastChanges;
|
|
begin
|
|
if Self = SkinManager.CurrentSkin then
|
|
SkinManager.BroadcastSkinNotification;
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptions.CopyOptions(AComponent, ToComponent: TSpTBXSkinComponentsType);
|
|
var
|
|
S: TSpTBXSkinStatesType;
|
|
begin
|
|
for S := Low(S) to High(S) do
|
|
FOptions[AComponent, S].AssignTo(FOptions[ToComponent, S]);
|
|
end;
|
|
|
|
constructor TSpTBXSkinOptions.Create;
|
|
var
|
|
C: TSpTBXSkinComponentsType;
|
|
S: TSpTBXSkinStatesType;
|
|
begin
|
|
inherited;
|
|
FSkinName := 'Default';
|
|
FColorBtnFace := clBtnFace;
|
|
FFloatingWindowBorderSize := 4;
|
|
for C := Low(C) to High(C) do
|
|
for S := Low(S) to High(S) do
|
|
FOptions[C, S] := TSpTBXSkinOptionCategory.Create;
|
|
|
|
FillOptions;
|
|
end;
|
|
|
|
destructor TSpTBXSkinOptions.Destroy;
|
|
var
|
|
C: TSpTBXSkinComponentsType;
|
|
S: TSpTBXSkinStatesType;
|
|
begin
|
|
for C := Low(C) to High(C) do
|
|
for S := Low(S) to High(S) do
|
|
FreeAndNil(FOptions[C, S]);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptions.FillOptions;
|
|
begin
|
|
// Used by descendants to fill the skin options
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptions.Reset(ForceResetSkinProperties: Boolean);
|
|
var
|
|
C: TSpTBXSkinComponentsType;
|
|
S: TSpTBXSkinStatesType;
|
|
begin
|
|
if ForceResetSkinProperties then begin
|
|
FColorBtnFace := clBtnFace;
|
|
FFloatingWindowBorderSize := 4;
|
|
FOfficeIcons := False;
|
|
FOfficeMenu := False;
|
|
FOfficeStatusBar := False;
|
|
end;
|
|
|
|
for C := Low(C) to High(C) do
|
|
for S := Low(S) to High(S) do
|
|
FOptions[C, S].Reset;
|
|
end;
|
|
|
|
function TSpTBXSkinOptions.Options(Component: TSpTBXSkinComponentsType; State: TSpTBXSkinStatesType): TSpTBXSkinOptionCategory;
|
|
begin
|
|
if CSpTBXSkinComponents[Component].States = [sknsNormal] then
|
|
State := sknsNormal;
|
|
Result := FOptions[Component, State];
|
|
end;
|
|
|
|
function TSpTBXSkinOptions.Options(Component: TSpTBXSkinComponentsType): TSpTBXSkinOptionCategory;
|
|
begin
|
|
Result := FOptions[Component, sknsNormal];
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptions.SaveToFile(Filename: WideString);
|
|
var
|
|
MemIni: TMemIniFile;
|
|
begin
|
|
MemIni := TMemIniFile.Create(Filename);
|
|
try
|
|
SaveToMemIni(MemIni);
|
|
MemIni.UpdateFile;
|
|
finally
|
|
MemIni.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptions.SaveToMemIni(MemIni: TMemIniFile);
|
|
var
|
|
C: TSpTBXSkinComponentsType;
|
|
S: TSpTBXSkinStatesType;
|
|
begin
|
|
MemIni.WriteString('Skin', 'Name', FSkinName);
|
|
MemIni.WriteString('Skin', 'Author', FSkinAuthor);
|
|
MemIni.WriteString('Skin', 'ColorBtnFace', SpColorToString(FColorBtnFace));
|
|
MemIni.WriteInteger('Skin', 'FloatingWindowBorderSize', FFloatingWindowBorderSize);
|
|
MemIni.WriteBool('Skin', 'OfficeIcons', FOfficeIcons);
|
|
MemIni.WriteBool('Skin', 'OfficeMenu', FOfficeMenu);
|
|
MemIni.WriteBool('Skin', 'OfficeStatusBar', FOfficeStatusBar);
|
|
|
|
for C := Low(C) to High(C) do begin
|
|
for S := Low(S) to High(S) do
|
|
if S in CSpTBXSkinComponents[C].States then
|
|
FOptions[C, S].SaveToIni(MemIni, CSpTBXSkinComponents[C].Name, SSpTBXSkinStatesString[S]);
|
|
end;
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptions.SaveToStrings(L: TStrings);
|
|
var
|
|
MemIni: TMemIniFile;
|
|
begin
|
|
MemIni := TMemIniFile.Create('');
|
|
try
|
|
MemIni.SetStrings(L); // Transfer L contents to MemIni
|
|
SaveToMemIni(MemIni);
|
|
L.Clear;
|
|
MemIni.GetStrings(L); // Transfer MemIni contents to L
|
|
finally
|
|
MemIni.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptions.LoadFromFile(Filename: WideString);
|
|
var
|
|
L: TStringList;
|
|
begin
|
|
if FileExists(Filename) then begin
|
|
L := TStringList.Create;
|
|
try
|
|
L.LoadFromFile(Filename);
|
|
LoadFromStrings(L);
|
|
finally
|
|
L.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptions.LoadFromStrings(L: TStrings);
|
|
var
|
|
MemIni: TMemIniFile;
|
|
C: TSpTBXSkinComponentsType;
|
|
S: TSpTBXSkinStatesType;
|
|
begin
|
|
MemIni := TMemIniFile.Create('');
|
|
try
|
|
MemIni.SetStrings(L);
|
|
|
|
FSkinName := MemIni.ReadString('Skin', 'Name', '');
|
|
FSkinAuthor := MemIni.ReadString('Skin', 'Author', '');
|
|
FColorBtnFace := StringToColor(MemIni.ReadString('Skin', 'ColorBtnFace', 'clBtnFace'));
|
|
FFloatingWindowBorderSize := MemIni.ReadInteger('Skin', 'FloatingWindowBorderSize', 4);
|
|
FOfficeIcons := MemIni.ReadBool('Skin', 'OfficeIcons', False);
|
|
FOfficeMenu := MemIni.ReadBool('Skin', 'OfficeMenu', False);
|
|
FOfficeStatusBar := MemIni.ReadBool('Skin', 'OfficeStautsBar', False);
|
|
|
|
for C := Low(C) to High(C) do begin
|
|
for S := Low(S) to High(S) do
|
|
if S in CSpTBXSkinComponents[C].States then
|
|
FOptions[C, S].LoadFromIni(MemIni, CSpTBXSkinComponents[C].Name, SSpTBXSkinStatesString[S]);
|
|
end;
|
|
|
|
BroadcastChanges;
|
|
finally
|
|
MemIni.Free;
|
|
end;
|
|
end;
|
|
|
|
function TSpTBXSkinOptions.GetOfficeIcons: Boolean;
|
|
// OfficeIcons is used to paint the menu items icons with Office XP shadows.
|
|
begin
|
|
Result := FOfficeIcons and (SkinManager.GetSkinType = sknSkin);
|
|
end;
|
|
|
|
function TSpTBXSkinOptions.GetOfficeMenu: Boolean;
|
|
// When OfficeMenu is True the height of the separators on popup menus
|
|
// is 6 pixels, otherwise the size is 10 pixels.
|
|
// And when the item is disabled the hottrack is not painted.
|
|
begin
|
|
Result := FOfficeMenu and (SkinManager.GetSkinType = sknSkin);
|
|
end;
|
|
|
|
function TSpTBXSkinOptions.GetOfficePopup: Boolean;
|
|
// OfficePopup is used to paint the PopupWindow with Office XP style.
|
|
// It is also used to paint the opened toolbar item with shadows.
|
|
begin
|
|
Result := (SkinManager.GetSkinType = sknSkin) and not Options(skncOpenToolbarItem).IsEmpty;
|
|
end;
|
|
|
|
function TSpTBXSkinOptions.GetOfficeStatusBar: Boolean;
|
|
// OfficeStatusBar is used to paint the StatusBar panels with Office XP style.
|
|
var
|
|
T: TSpTBXSkinType;
|
|
begin
|
|
T := SkinManager.GetSkinType;
|
|
Result := (FOfficeStatusBar and (T = sknSkin)) or (T = sknNone);
|
|
end;
|
|
|
|
function TSpTBXSkinOptions.GetFloatingWindowBorderSize: Integer;
|
|
begin
|
|
if SkinManager.GetSkinType = sknSkin then
|
|
Result := FFloatingWindowBorderSize
|
|
else
|
|
Result := 4;
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptions.SetFloatingWindowBorderSize(const Value: Integer);
|
|
begin
|
|
FFloatingWindowBorderSize := Value;
|
|
if FFloatingWindowBorderSize < 0 then FFloatingWindowBorderSize := 0;
|
|
if FFloatingWindowBorderSize > 4 then FFloatingWindowBorderSize := 4;
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptions.GetDropDownArrowSize(out DropDownArrowSize,
|
|
DropDownArrowMargin, SplitBtnArrowSize: Integer);
|
|
begin
|
|
DropDownArrowSize := 8; // TB2Item.tbDropdownArrowWidth
|
|
DropDownArrowMargin := 3; // TB2Item.tbDropdownArrowMargin
|
|
|
|
SplitBtnArrowSize := 12; // TB2Item.tbDropdownComboArrowWidth + 1
|
|
if SkinManager.GetSkinType = sknWindows then
|
|
SplitBtnArrowSize := SplitBtnArrowSize + 1;
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptions.GetMenuItemMargins(ACanvas: TCanvas; ImgSize: Integer;
|
|
out MarginsInfo: TSpTBXMenuItemMarginsInfo);
|
|
var
|
|
TextMetric: TTextMetric;
|
|
H, M2: Integer;
|
|
SkinType: TSpTBXSkinType;
|
|
begin
|
|
if ImgSize = 0 then
|
|
ImgSize := 16;
|
|
|
|
FillChar(MarginsInfo, SizeOf(MarginsInfo), 0);
|
|
SkinType := SkinManager.GetSkinType;
|
|
|
|
if (SkinType = sknWindows) and SpIsWinVistaOrUp then begin
|
|
// Vista-like spacing
|
|
MarginsInfo.Margins := Rect(1, 3, 1, 3); // MID_MENUITEM
|
|
MarginsInfo.ImageTextSpace := 5 + 1; // TMI_MENU_IMGTEXTSPACE
|
|
MarginsInfo.LeftCaptionMargin := 3; // TMI_MENU_LCAPTIONMARGIN
|
|
MarginsInfo.RightCaptionMargin := 3; // TMI_MENU_RCAPTIONMARGIN
|
|
end
|
|
else
|
|
if (SkinType = sknSkin) then begin
|
|
// Office-like spacing
|
|
MarginsInfo.Margins := Rect(1, 3, 1, 3); // MID_MENUITEM
|
|
MarginsInfo.ImageTextSpace := 5; // TMI_MENU_IMGTEXTSPACE
|
|
MarginsInfo.LeftCaptionMargin := 3; // TMI_MENU_LCAPTIONMARGIN
|
|
MarginsInfo.RightCaptionMargin := 3; // TMI_MENU_RCAPTIONMARGIN
|
|
end
|
|
else begin
|
|
MarginsInfo.Margins := Rect(0, 2, 0, 2); // MID_MENUITEM
|
|
MarginsInfo.ImageTextSpace := 1; // TMI_MENU_IMGTEXTSPACE
|
|
MarginsInfo.LeftCaptionMargin := 2; // TMI_MENU_LCAPTIONMARGIN
|
|
MarginsInfo.RightCaptionMargin := 2; // TMI_MENU_RCAPTIONMARGIN
|
|
end;
|
|
|
|
GetTextMetrics(ACanvas.Handle, TextMetric);
|
|
M2 := MarginsInfo.Margins.Top + MarginsInfo.Margins.Bottom;
|
|
MarginsInfo.GutterSize := TextMetric.tmHeight + TextMetric.tmExternalLeading + M2;
|
|
H := ImgSize + M2;
|
|
if H > MarginsInfo.GutterSize then MarginsInfo.GutterSize := H;
|
|
MarginsInfo.GutterSize := (ImgSize + M2) * MarginsInfo.GutterSize div H; // GutterSize = GetPopupMargin = ItemInfo.PopupMargin
|
|
end;
|
|
|
|
function TSpTBXSkinOptions.GetState(Enabled, Pushed, HotTrack, Checked: Boolean): TSpTBXSkinStatesType;
|
|
begin
|
|
Result := sknsNormal;
|
|
if not Enabled then Result := sknsDisabled
|
|
else begin
|
|
if Pushed then Result := sknsPushed
|
|
else
|
|
if HotTrack and Checked then Result := sknsCheckedAndHotTrack
|
|
else
|
|
if HotTrack then Result := sknsHotTrack
|
|
else
|
|
if Checked then Result := sknsChecked;
|
|
end;
|
|
end;
|
|
|
|
function TSpTBXSkinOptions.GetTextColor(Component: TSpTBXSkinComponentsType;
|
|
State: TSpTBXSkinStatesType; SkinType: TSpTBXSkinType = sknSkin): TColor;
|
|
var
|
|
Flags: Integer;
|
|
VistaColor: Cardinal;
|
|
begin
|
|
Result := clNone;
|
|
SkinType := SpTBXSkinType(SkinType);
|
|
|
|
if SkinType = sknSkin then begin
|
|
if State in CSpTBXSkinComponents[Component].States then begin
|
|
Result := Options(Component, State).TextColor;
|
|
if Result <> clNone then
|
|
Exit; // Text color is specified by the skin
|
|
end
|
|
else
|
|
Exit; // Exit if the State is not valid
|
|
end;
|
|
|
|
if State = sknsDisabled then Result := clGrayText
|
|
else Result := clBtnText;
|
|
|
|
case Component of
|
|
skncMenuItem:
|
|
if SpIsWinVistaOrUp and (SkinType = sknWindows) then begin
|
|
// Use the new API on Windows Vista
|
|
Flags := MPI_NORMAL;
|
|
if State = sknsDisabled then Flags := MPI_DISABLED
|
|
else if State in [sknsHotTrack, sknsCheckedAndHotTrack] then Flags := MPI_HOT;
|
|
GetThemeColor(ThemeServices.Theme[teMenu], MENU_POPUPITEM, Flags, TMT_TEXTCOLOR, VistaColor);
|
|
Result := TColor(VistaColor);
|
|
end
|
|
else
|
|
if State <> sknsDisabled then begin
|
|
Result := clMenuText;
|
|
if SkinType <> sknSkin then
|
|
if State in [sknsHotTrack, sknsCheckedAndHotTrack, sknsPushed] then
|
|
Result := clHighlightText;
|
|
end;
|
|
skncMenuBarItem:
|
|
if SpIsWinVistaOrUp and (SkinType = sknWindows) then begin
|
|
// Use the new API on Windows Vista
|
|
Flags := MBI_NORMAL;
|
|
if State = sknsDisabled then Flags := MBI_DISABLED
|
|
else if State in [sknsHotTrack, sknsCheckedAndHotTrack] then Flags := MBI_HOT;
|
|
GetThemeColor(ThemeServices.Theme[teMenu], MENU_BARITEM, Flags, TMT_TEXTCOLOR, VistaColor);
|
|
Result := TColor(VistaColor);
|
|
end
|
|
else
|
|
if State <> sknsDisabled then begin
|
|
Result := clMenuText;
|
|
if SkinType = sknWindows then
|
|
if State in [sknsHotTrack, sknsPushed, sknsChecked, sknsCheckedAndHotTrack] then
|
|
Result := clHighlightText;
|
|
end;
|
|
skncToolbarItem:
|
|
if State <> sknsDisabled then Result := clMenuText;
|
|
skncButton:
|
|
if (SkinType = sknWindows) then begin
|
|
Flags := PBS_NORMAL;
|
|
case State of
|
|
sknsDisabled: Flags := PBS_DISABLED;
|
|
sknsHotTrack: Flags := PBS_HOT;
|
|
sknsPushed, sknsChecked, sknsCheckedAndHotTrack: Flags := PBS_PRESSED;
|
|
end;
|
|
GetThemeColor(ThemeServices.Theme[teButton], BP_PUSHBUTTON, Flags, TMT_TEXTCOLOR, VistaColor);
|
|
Result := TColor(VistaColor);
|
|
end;
|
|
skncListItem:
|
|
if SkinType <> sknSkin then
|
|
if State in [sknsChecked, sknsCheckedAndHotTrack] then
|
|
Result := clHighlightText;
|
|
skncDockablePanelTitleBar, skncStatusBar, skncTabToolbar:
|
|
if SkinType = sknSkin then
|
|
Result := GetTextColor(skncToolbarItem, State, SkinType); // Use skncToolbarItem to get the default text color
|
|
skncWindowTitleBar:
|
|
if SkinType = sknSkin then
|
|
Result := GetTextColor(skncToolbarItem, State, SkinType) // Use skncToolbarItem to get the default text color
|
|
else
|
|
if State = sknsDisabled then Result := clInactiveCaptionText
|
|
else Result := clCaptionText;
|
|
end;
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptions.PaintBackground(ACanvas: TCanvas; ARect: TRect;
|
|
Component: TSpTBXSkinComponentsType; State: TSpTBXSkinStatesType;
|
|
Background, Borders: Boolean; Vertical: Boolean = False;
|
|
ForceRectBorders: TAnchors = []);
|
|
var
|
|
BackgroundRect: TRect;
|
|
Op: TSpTBXSkinOptionCategory;
|
|
begin
|
|
Op := Options(Component, State);
|
|
|
|
if Op.Borders.IsEmpty then
|
|
Borders := False;
|
|
if Op.Body.IsEmpty then
|
|
Background := False;
|
|
|
|
if Background then begin
|
|
BackgroundRect := ARect;
|
|
if Borders then
|
|
InflateRect(BackgroundRect, -1, -1);
|
|
SpPaintSkinBackground(ACanvas, BackgroundRect, Op, Vertical);
|
|
end;
|
|
|
|
if Borders then
|
|
SpPaintSkinBorders(ACanvas, ARect, Op, ForceRectBorders);
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptions.PaintMenuCheckMark(ACanvas: TCanvas; ARect: TRect;
|
|
Checked, Grayed, MenuItemStyle: Boolean; State: TSpTBXSkinStatesType);
|
|
var
|
|
X, Y: Integer;
|
|
PenC, BrushC, CheckColor: TColor;
|
|
Flags: Integer;
|
|
VistaCheckSize: TSize;
|
|
begin
|
|
if MenuItemStyle and SpIsWinVistaOrUp and (SkinManager.GetSkinType = sknWindows) then begin
|
|
// Use the new API on Windows Vista
|
|
if State = sknsDisabled then Flags := MC_CHECKMARKDISABLED
|
|
else Flags := MC_CHECKMARKNORMAL;
|
|
VistaCheckSize.cx := 0;
|
|
VistaCheckSize.cy := 0;
|
|
GetThemePartSize(ThemeServices.Theme[teMenu], ACanvas.Handle, MENU_POPUPCHECK, Flags, nil, TS_TRUE, VistaCheckSize);
|
|
ARect := SpCenterRect(ARect, VistaCheckSize.cx, VistaCheckSize.cy);
|
|
DrawThemeBackground(ThemeServices.Theme[teMenu], ACanvas.Handle, MENU_POPUPCHECK, Flags, ARect, nil);
|
|
end
|
|
else begin
|
|
X := ARect.Left + (ARect.Right - ARect.Left) div 2 - 1;
|
|
Y := ARect.Top + (ARect.Bottom - ARect.Top) div 2 + 1;
|
|
|
|
PenC := ACanvas.Pen.Color;
|
|
BrushC := ACanvas.Brush.Color;
|
|
try
|
|
if MenuItemStyle then begin
|
|
CheckColor := clMenuText; // On sknNone it's clMenuText even when disabled
|
|
case SkinManager.GetSkinType of
|
|
sknWindows:
|
|
CheckColor := GetTextColor(skncCheckBox, State);
|
|
sknSkin:
|
|
CheckColor := GetTextColor(skncMenuItem, State);
|
|
end;
|
|
ACanvas.Brush.Color := CheckColor;
|
|
ACanvas.Pen.Color := CheckColor;
|
|
ACanvas.Polygon([Point(X - 3, Y - 2), Point(X - 1, Y), Point(X + 3, Y - 4),
|
|
Point(X + 3, Y - 3), Point(X - 1, Y + 1), Point(X - 3, Y - 1), Point(X - 3, Y -2)]);
|
|
end
|
|
else begin
|
|
CheckColor := GetTextColor(skncCheckBox, State);
|
|
ACanvas.Brush.Color := CheckColor;
|
|
ACanvas.Pen.Color := CheckColor;
|
|
PaintBackground(ACanvas, ARect, skncCheckBox, State, True, True);
|
|
if Checked then
|
|
ACanvas.Polygon([Point(X - 2, Y), Point(X, Y + 2), Point(X + 4, Y - 2),
|
|
Point(X + 4, Y - 4), Point(X, Y), Point(X - 2, Y - 2), Point(X - 2, Y)])
|
|
else
|
|
if Grayed then begin
|
|
InflateRect(ARect, -3, -3);
|
|
// ACanvas.Brush.Color := Options(skncCheckBox, sknsChecked).Borders.Color1;
|
|
ACanvas.FillRect(ARect);
|
|
end;
|
|
end;
|
|
finally
|
|
ACanvas.Pen.Color := PenC;
|
|
ACanvas.Brush.Color := BrushC;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptions.PaintMenuRadioMark(ACanvas: TCanvas; ARect: TRect;
|
|
Checked, MenuItemStyle: Boolean; State: TSpTBXSkinStatesType);
|
|
var
|
|
X, Y: Integer;
|
|
PenC, BrushC, CheckColor, FrameColor: TColor;
|
|
Flags: Integer;
|
|
VistaCheckSize: TSize;
|
|
begin
|
|
if MenuItemStyle and SpIsWinVistaOrUp and (SkinManager.GetSkinType = sknWindows) then begin
|
|
// Use the new API on Windows Vista
|
|
if State = sknsDisabled then Flags := MC_BULLETDISABLED
|
|
else Flags := MC_BULLETNORMAL;
|
|
VistaCheckSize.cx := 0;
|
|
VistaCheckSize.cy := 0;
|
|
GetThemePartSize(ThemeServices.Theme[teMenu], ACanvas.Handle, MENU_POPUPCHECK, Flags, nil, TS_TRUE, VistaCheckSize);
|
|
ARect := SpCenterRect(ARect, VistaCheckSize.cx, VistaCheckSize.cy);
|
|
DrawThemeBackground(ThemeServices.Theme[teMenu], ACanvas.Handle, MENU_POPUPCHECK, Flags, ARect, nil);
|
|
end
|
|
else begin
|
|
PenC := ACanvas.Pen.Color;
|
|
BrushC := ACanvas.Brush.Color;
|
|
try
|
|
if MenuItemStyle then begin
|
|
CheckColor := clMenuText; // On sknNone it's clMenuText even when disabled
|
|
case SkinManager.GetSkinType of
|
|
sknWindows:
|
|
CheckColor := GetTextColor(skncRadioButton, State);
|
|
sknSkin:
|
|
CheckColor := GetTextColor(skncMenuItem, State);
|
|
end;
|
|
ACanvas.Brush.Color := CheckColor;
|
|
ACanvas.Pen.Color := CheckColor;
|
|
X := ARect.Left + (ARect.Right - ARect.Left) div 2;
|
|
Y := ARect.Top + (ARect.Bottom - ARect.Top) div 2;
|
|
ACanvas.RoundRect(X - 3, Y - 3, X + 3, Y + 3, 2, 2);
|
|
end
|
|
else begin
|
|
CheckColor := GetTextColor(skncRadioButton, State);
|
|
FrameColor := Options(skncRadioButton, State).Borders.Color1;
|
|
if State = sknsDisabled then FrameColor := CheckColor;
|
|
if not Checked then CheckColor := clNone;
|
|
|
|
// Keep it simple make the radio 13x13
|
|
ARect.Left := ARect.Left + (ARect.Right - ARect.Left - 13) div 2;
|
|
ARect.Right := ARect.Left + 13;
|
|
ARect.Top := ARect.Top + (ARect.Bottom - ARect.Top - 13) div 2;
|
|
ARect.Bottom := ARect.Top + 13;
|
|
X := ARect.Left;
|
|
Y := ARect.Top;
|
|
|
|
// Background
|
|
BeginPath(ACanvas.Handle);
|
|
ACanvas.Polyline([Point(X, Y + 8), Point(X, Y + 4), Point(X + 1, Y + 3),
|
|
Point(X + 1, Y + 2), Point(X + 2, Y + 1), Point(X + 3, Y + 1),
|
|
Point(X + 4, Y), Point(X + 8, Y), Point(X + 9, Y + 1),
|
|
Point(X + 10, Y + 1), Point(X + 11, Y + 2), Point(X + 11, Y + 3),
|
|
Point(X + 12, Y + 4), Point(X + 12, Y + 8), Point(X + 11, Y + 9),
|
|
Point(X + 11, Y + 10), Point(X + 10, Y + 11), Point(X + 9, Y + 11),
|
|
Point(X + 8, Y + 12), Point(X + 4, Y + 12), Point(X + 3, Y + 11),
|
|
Point(X + 2, Y + 11), Point(X + 1, Y + 10), Point(X + 1, Y + 8)]);
|
|
EndPath(ACanvas.Handle);
|
|
SelectClipPath(ACanvas.Handle, RGN_COPY);
|
|
PaintBackground(ACanvas, ARect, skncRadioButton, State, True, False);
|
|
SelectClipPath(ACanvas.Handle, 0);
|
|
SelectClipRgn(ACanvas.Handle, 0);
|
|
|
|
// Frame
|
|
ACanvas.Brush.Color := FrameColor;
|
|
ACanvas.Pen.Color := FrameColor;
|
|
ACanvas.Polyline([Point(X, Y + 8), Point(X, Y + 4), Point(X + 1, Y + 3),
|
|
Point(X + 1, Y + 2), Point(X + 2, Y + 1), Point(X + 3, Y + 1),
|
|
Point(X + 4, Y), Point(X + 8, Y), Point(X + 9, Y + 1),
|
|
Point(X + 10, Y + 1), Point(X + 11, Y + 2), Point(X + 11, Y + 3),
|
|
Point(X + 12, Y + 4), Point(X + 12, Y + 8), Point(X + 11, Y + 9),
|
|
Point(X + 11, Y + 10), Point(X + 10, Y + 11), Point(X + 9, Y + 11),
|
|
Point(X + 8, Y + 12), Point(X + 4, Y + 12), Point(X + 3, Y + 11),
|
|
Point(X + 2, Y + 11), Point(X + 1, Y + 10), Point(X + 1, Y + 8)]);
|
|
|
|
// Radio
|
|
if CheckColor <> clNone then begin
|
|
ACanvas.Brush.Color := CheckColor;
|
|
ACanvas.Pen.Color := CheckColor;
|
|
X := (ARect.Left + ARect.Right) div 2;
|
|
Y := (ARect.Top + ARect.Bottom) div 2 + 1;
|
|
ACanvas.RoundRect(X - 2, Y - 3, X + 3, Y + 2, 2, 2);
|
|
end;
|
|
end;
|
|
finally
|
|
ACanvas.Pen.Color := PenC;
|
|
ACanvas.Brush.Color := BrushC;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TSpTBXSkinOptions.PaintWindowFrame(ACanvas: TCanvas; ARect: TRect;
|
|
IsActive, DrawBody: Boolean; BorderSize: Integer = 4);
|
|
var
|
|
C: TColor;
|
|
R: TRect;
|
|
I: Integer;
|
|
State: TSpTBXSkinStatesType;
|
|
Op: TSpTBXSkinOptionEntry;
|
|
begin
|
|
if IsActive then
|
|
State := sknsNormal
|
|
else
|
|
if Options(skncWindow, sknsDisabled).IsEmpty then
|
|
State := sknsNormal
|
|
else
|
|
State := sknsDisabled;
|
|
|
|
C := ACanvas.Brush.Color;
|
|
if DrawBody then
|
|
PaintBackground(ACanvas, ARect, skncWindow, State, True, False);
|
|
R := ARect;
|
|
Op := Options(skncWindow, State).Borders;
|
|
for I := 1 to BorderSize do begin
|
|
if I = 1 then ACanvas.Brush.Color := Op.Color1
|
|
else if I = 2 then ACanvas.Brush.Color := Op.Color2
|
|
else if I = 3 then ACanvas.Brush.Color := Op.Color3
|
|
else if I >= 4 then ACanvas.Brush.Color := Op.Color4;
|
|
ACanvas.FrameRect(R);
|
|
InflateRect(R, -1, -1);
|
|
end;
|
|
ACanvas.Brush.Color := C;
|
|
end;
|
|
|
|
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
|
|
{ TSpTBXSkinsListEntry }
|
|
|
|
destructor TSpTBXSkinsListEntry.Destroy;
|
|
begin
|
|
SkinClass := nil;
|
|
FreeAndNil(SkinStrings);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
|
|
{ TSpTBXSkinsList }
|
|
|
|
destructor TSpTBXSkinsList.Destroy;
|
|
begin
|
|
// Free all the skins options
|
|
while Count > 0 do
|
|
Delete(0);
|
|
inherited;
|
|
end;
|
|
|
|
function TSpTBXSkinsList.AddSkin(SkinName: string; SkinClass: TSpTBXSkinOptionsClass): Integer;
|
|
var
|
|
K: TSpTBXSkinsListEntry;
|
|
begin
|
|
Result := -1;
|
|
if (SkinName <> '') and (IndexOf(SkinName) = -1) then begin
|
|
K := TSpTBXSkinsListEntry.Create;
|
|
try
|
|
K.SkinClass := SkinClass;
|
|
Result := AddObject(SkinName, K); // the list owns K
|
|
except
|
|
K.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TSpTBXSkinsList.AddSkin(SkinOptions: TStrings): Integer;
|
|
var
|
|
K: TSpTBXSkinsListEntry;
|
|
S: string;
|
|
begin
|
|
Result := -1;
|
|
K := TSpTBXSkinsListEntry.Create;
|
|
try
|
|
K.SkinStrings := TStringList.Create;
|
|
S := SkinOptions.Values['Name '];
|
|
if S = '' then
|
|
S := SkinOptions.Values['Name'];
|
|
S := Trim(S);
|
|
if (S <> '') and (IndexOf(S) = -1) then begin
|
|
K.SkinStrings.Assign(SkinOptions);
|
|
Result := AddObject(S, K); // the list owns K
|
|
end
|
|
else
|
|
K.Free;
|
|
except
|
|
K.Free;
|
|
end;
|
|
end;
|
|
|
|
function TSpTBXSkinsList.AddSkinFromFile(Filename: WideString): Integer;
|
|
var
|
|
L: TStringList;
|
|
begin
|
|
L := TStringList.Create;
|
|
try
|
|
L.LoadFromFile(Filename);
|
|
Result := AddSkin(L);
|
|
finally
|
|
L.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TSpTBXSkinsList.AddSkinsFromFolder(Folder: WideString);
|
|
var
|
|
L: TStringList;
|
|
I: Integer;
|
|
S: string;
|
|
begin
|
|
L := TStringList.Create;
|
|
try
|
|
if SpGetDirectories(Folder, L) then begin
|
|
for I := 0 to L.Count - 1 do begin
|
|
S := IncludeTrailingPathDelimiter(Folder) + L[I] + '\Skin.ini';
|
|
if FileExists(S) then
|
|
AddSkinFromFile(S);
|
|
end;
|
|
end;
|
|
finally
|
|
L.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TSpTBXSkinsList.Delete(Index: Integer);
|
|
begin
|
|
if (Index > -1) and (Index < Count) then
|
|
SkinOptions[Index].Free;
|
|
inherited Delete(Index);
|
|
end;
|
|
|
|
procedure TSpTBXSkinsList.GetSkinNames(SkinNames: TStrings);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
SkinNames.BeginUpdate;
|
|
try
|
|
SkinNames.Clear;
|
|
SkinNames.Add('Default');
|
|
for I := 0 to Count - 1 do
|
|
SkinNames.Add(Strings[I]);
|
|
finally
|
|
SkinNames.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TSpTBXSkinsList.GetSkinOption(Index: Integer): TSpTBXSkinsListEntry;
|
|
begin
|
|
Result := TSpTBXSkinsListEntry(Objects[Index]);
|
|
end;
|
|
|
|
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
|
|
{ TSpTBXSkinManager }
|
|
|
|
constructor TSpTBXSkinManager.Create;
|
|
begin
|
|
FNotifies := TList.Create;
|
|
FCurrentSkin := TSpTBXSkinOptions.Create;
|
|
FSkinsList := TSpTBXSkinsList.Create;
|
|
end;
|
|
|
|
destructor TSpTBXSkinManager.Destroy;
|
|
begin
|
|
FreeAndNil(FNotifies);
|
|
FreeAndNil(FCurrentSkin);
|
|
FreeAndNil(FSkinsList);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TSpTBXSkinManager.AddSkinNotification(AObject: TObject);
|
|
begin
|
|
if FNotifies.IndexOf(AObject) < 0 then FNotifies.Add(AObject);
|
|
end;
|
|
|
|
procedure TSpTBXSkinManager.RemoveSkinNotification(AObject: TObject);
|
|
begin
|
|
FNotifies.Remove(AObject);
|
|
end;
|
|
|
|
procedure TSpTBXSkinManager.Broadcast;
|
|
var
|
|
Msg: TMessage;
|
|
I: Integer;
|
|
begin
|
|
if FNotifies.Count > 0 then begin
|
|
Msg.Msg := WM_SPSKINCHANGE;
|
|
Msg.WParam := 0;
|
|
Msg.LParam := 0;
|
|
Msg.Result := 0;
|
|
for I := 0 to FNotifies.Count - 1 do
|
|
TObject(FNotifies[I]).Dispatch(Msg);
|
|
end;
|
|
if Assigned(FOnSkinChange) then FOnSkinChange(Self);
|
|
end;
|
|
|
|
procedure TSpTBXSkinManager.BroadcastSkinNotification;
|
|
begin
|
|
Broadcast;
|
|
end;
|
|
|
|
procedure TSpTBXSkinManager.LoadFromFile(Filename: WideString);
|
|
begin
|
|
FCurrentSkin.LoadFromFile(Filename);
|
|
end;
|
|
|
|
procedure TSpTBXSkinManager.SaveToFile(Filename: WideString);
|
|
begin
|
|
FCurrentSkin.SaveToFile(Filename);
|
|
end;
|
|
|
|
function TSpTBXSkinManager.GetCurrentSkinName: string;
|
|
begin
|
|
Result := FCurrentSkin.SkinName;
|
|
end;
|
|
|
|
function TSpTBXSkinManager.GetSkinType: TSpTBXSkinType;
|
|
begin
|
|
Result := SpTBXSkinType(sknSkin);
|
|
end;
|
|
|
|
function TSpTBXSkinManager.IsDefaultSkin: Boolean;
|
|
begin
|
|
Result := CurrentSkinName = 'Default';
|
|
end;
|
|
|
|
function TSpTBXSkinManager.IsXPThemesEnabled: Boolean;
|
|
begin
|
|
Result := ThemeServices.ThemesAvailable and UxTheme.UseThemes;
|
|
end;
|
|
|
|
procedure TSpTBXSkinManager.SetSkin(SkinName: string);
|
|
var
|
|
I: Integer;
|
|
K: TSpTBXSkinsListEntry;
|
|
begin
|
|
if not SameText(SkinName, CurrentSkinName) then
|
|
if SameText(SkinName, 'Default') then
|
|
SetToDefaultSkin
|
|
else begin
|
|
I := FSkinsList.IndexOf(SkinName);
|
|
if I > -1 then begin
|
|
K := FSkinsList.SkinOptions[I];
|
|
if Assigned(K.SkinClass) then begin
|
|
FCurrentSkin.Free;
|
|
FCurrentSkin := K.SkinClass.Create;
|
|
Broadcast;
|
|
end
|
|
else
|
|
if Assigned(K.SkinStrings) then begin
|
|
FCurrentSkin.Free;
|
|
FCurrentSkin := TSpTBXSkinOptions.Create;
|
|
FCurrentSkin.LoadFromStrings(K.SkinStrings);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TSpTBXSkinManager.SetToDefaultSkin;
|
|
begin
|
|
FCurrentSkin.Free;
|
|
FCurrentSkin := TSpTBXSkinOptions.Create;
|
|
Broadcast;
|
|
end;
|
|
|
|
procedure TSpTBXSkinManager.ChangeControlSkinType(Control: TWinControl;
|
|
SkinType: TSpTBXSkinType; Recursive: Boolean = True);
|
|
|
|
procedure ChangeSkinTypeProperty(Component: TComponent; TM: TSpTBXSkinType);
|
|
var
|
|
S: string;
|
|
PropInfo: PPropInfo;
|
|
begin
|
|
if Length(Component.ClassName) > 6 then begin
|
|
S := Copy(Component.ClassName, 1, 6);
|
|
if SameText(S, 'TSpTBX') then begin
|
|
PropInfo := GetPropInfo(Component, 'SkinType');
|
|
if (PropInfo <> nil) and (PropInfo.PropType^.Kind = tkEnumeration) then
|
|
SetOrdProp(Component, PropInfo, Integer(TM));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
I: Integer;
|
|
C: TControl;
|
|
begin
|
|
for I := 0 to Control.ControlCount - 1 do begin
|
|
C := Control.Controls[I];
|
|
ChangeSkinTypeProperty(C, SkinType);
|
|
if Recursive and (C is TWinControl) then
|
|
ChangeControlSkinType(C as TWinControl, SkinType, Recursive);
|
|
end;
|
|
end;
|
|
|
|
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
|
|
{ TSpTBXSkinSwitcher }
|
|
|
|
constructor TSpTBXSkinSwitcher.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
SkinManager.AddSkinNotification(Self);
|
|
end;
|
|
|
|
destructor TSpTBXSkinSwitcher.Destroy;
|
|
begin
|
|
SkinManager.RemoveSkinNotification(Self);
|
|
inherited;
|
|
end;
|
|
|
|
function TSpTBXSkinSwitcher.GetSkin: string;
|
|
begin
|
|
Result := SkinManager.CurrentSkinName;
|
|
end;
|
|
|
|
procedure TSpTBXSkinSwitcher.SetSkin(const Value: string);
|
|
begin
|
|
SkinManager.SetSkin(Value);
|
|
end;
|
|
|
|
procedure TSpTBXSkinSwitcher.WMSpSkinChange(var Message: TMessage);
|
|
begin
|
|
if Assigned(FOnSkinChange) then FOnSkinChange(Self);
|
|
end;
|
|
|
|
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
|
|
{ Stock Objects }
|
|
|
|
procedure InitializeStock;
|
|
begin
|
|
StockBitmap := TBitmap.Create;
|
|
StockBitmap.Width := 8;
|
|
StockBitmap.Height := 8;
|
|
|
|
@SpPrintWindow := GetProcAddress(GetModuleHandle(user32), 'PrintWindow');
|
|
|
|
if not Assigned(FInternalSkinManager) then
|
|
FInternalSkinManager := TSpTBXSkinManager.Create;
|
|
end;
|
|
|
|
procedure FinalizeStock;
|
|
begin
|
|
FreeAndNil(StockBitmap);
|
|
FreeAndNil(FInternalSkinManager);
|
|
end;
|
|
|
|
initialization
|
|
InitializeStock;
|
|
{$IFDEF SYSTEM_GRADIENT}
|
|
FMsimg32Library := LoadLibrary(msimg32);
|
|
if FMsimg32Library <> 0 then
|
|
GradientFillSystem := GetProcAddress(FMsimg32Library, 'GradientFill')
|
|
{$ENDIF}
|
|
|
|
finalization
|
|
FinalizeStock;
|
|
{$IFDEF SYSTEM_GRADIENT}
|
|
if FMsimg32Library <> 0 then
|
|
FreeLibrary(FMsimg32Library);
|
|
{$ENDIF}
|
|
|
|
end.
|