Delphi控件源码

开发平台：

Delphi

DynamicSkinForm.pas：源码内容

{*******************************************************************}
{ }
{ Almediadev Visual Component Library }
{ DynamicSkinForm }
{ Version 4.98 }
{ }
{ }
{ Home: http://www.almdev.com }
{ Support: support@almdev.com }
{ }
{*******************************************************************}
Unit DynamicSkinForm;
{$P+,S-,W-,R-}
{$WARNINGS OFF}
{$HINTS OFF}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, SkinData, Menus, SkinMenus, SkinCtrls, SpUtils, SPEffBmp, SkinTabs,
SkinBoxCtrls, spTrayIcon, SkinHint;
type
TspBorderIcon = (biSystemMenu, biMinimize, biMaximize, biRollUp, biMinimizeToTray);
TspBorderIcons = set of TspBorderIcon;
TTrackBarChangeValueEvent = procedure(IDName: String; Value: Integer)
of object;
TFrameRegulatorChangeValueEvent = procedure(IDName: String; Value: Integer)
of object;
TSwitchState = (swOn, swOff);
TSwitchChangeStateEvent = procedure(IDName: String;
State: TSwitchState) of object;
TPaintEvent = procedure (IDName: String; Canvas: TCanvas;
ObjectRect: TRect) of object;
TMouseEnterEvent = procedure (IDName: String) of object;
TMouseLeaveEvent = procedure (IDName: String) of object;
TMainMenuItemClick = procedure (IDName: String) of object;
TspMouseUpEvent = procedure (IDName: String;
X, Y: Integer; ObjectRect: TRect;
Button: TMouseButton) of object;
TMouseDownEvent = procedure (IDName: String;
X, Y: Integer; ObjectRect: TRect;
Button: TMouseButton) of object;
TMouseMoveEvent = procedure (IDName: String; X, Y: Integer;
ObjectRect: TRect) of object;
TChangeClientRectEvent = procedure(NewClientRect: TRect) of object;
TspDynamicSkinForm = class;
TspActiveSkinObject = class(TObject)
protected
Parent: TspDynamicSkinForm;
FMorphKf: Double;
FMouseIn: Boolean;
Picture, ActivePicture: TBitMap;
procedure SetMorphKf(Value: Double);
procedure Redraw;
public
SD: TspSkinData;
IDName: String;
Hint: String;
SkinRect: TRect;
ActiveSkinRect: TRect;
Morphing: Boolean;
MorphKind: TMorphKind;
ObjectRect: TRect;
Active: Boolean;
Enabled: Boolean;
CursorIndex: Integer;
RollUp: Boolean;
Visible: Boolean;
SkinRectInAPicture: Boolean;
constructor Create(AParent: TspDynamicSkinForm; AData: TspDataSkinObject);
procedure Draw(Cnvs: TCanvas; UpDate: Boolean); virtual;
procedure DblClick; virtual;
procedure MouseDown(X, Y: Integer; Button: TMouseButton); virtual;
procedure MouseUp(X, Y: Integer; Button: TMouseButton); virtual;
procedure MouseMove(X, Y: Integer); virtual;
procedure MouseEnter; virtual;
procedure MouseLeave; virtual;
function CanMorphing: Boolean; virtual;
procedure DoMorphing;
property MorphKf: Double read FMorphKf write SetMorphKf;
end;
TspUserObject = class(TspActiveSkinObject)
public
procedure Draw(Cnvs: TCanvas; UpDate: Boolean); override;
end;
TspSkinFrameObject = class(TspActiveSkinObject)
protected
FFrame: Integer;
FrameW, FrameH: Integer;
procedure SetFrame(Value: Integer);
public
CountFrames: Integer;
FramesPlacement: TFramesPlacement;
constructor Create(AParent: TspDynamicSkinForm;
AData: TspDataSkinObject);
procedure Draw(Cnvs: TCanvas; UpDate: Boolean); override;
property Frame: Integer read FFrame write SetFrame;
end;
TspSkinFrameGaugeObject = class(TspSkinFrameObject)
protected
FValue: Integer;
function CalcFrame: Integer;
procedure SetValue(AValue: Integer);
public
MinValue: Integer;
MaxValue: Integer;
constructor Create(AParent: TspDynamicSkinForm;
AData: TspDataSkinObject);
procedure Draw(Cnvs: TCanvas; UpDate: Boolean); override;
procedure SimplySetValue(AValue: Integer);
procedure MouseEnter; override;
procedure MouseLeave; override;
property Value: Integer read FValue write SetValue;
end;
TspSkinFrameRegulatorObject = class(TspSkinFrameObject)
protected
FPixInc, FValInc: Integer;
FDown: Boolean;
StartV, CurV, TempValue: Integer;
FValue: Integer;
function CalcFrame: Integer;
procedure SetValue(AValue: Integer);
procedure CalcValue;
public
MinValue: Integer;
MaxValue: Integer;
Kind: TRegulatorKind;
constructor Create(AParent: TspDynamicSkinForm;
AData: TspDataSkinObject);
procedure Draw(Cnvs: TCanvas; UpDate: Boolean); override;
procedure SimplySetValue(AValue: Integer);
procedure MouseDown(X, Y: Integer; Button: TMouseButton); override;
procedure MouseUp(X, Y: Integer; Button: TMouseButton); override;
procedure MouseMove(X, Y: Integer); override;
property Value: Integer read FValue write SetValue;
end;
TspSkinAnimateObject = class(TspActiveSkinObject)
protected
FFrame: Integer;
FInc: Integer;
TimerInterval: Integer;
MenuItem: TMenuItem;
FPopupUp: Boolean;
procedure SetFrame(Value: Integer);
procedure DoMax;
procedure DoMin;
procedure DoRollUp;
procedure DoClose;
procedure DoCommand;
procedure TrackMenu;
public
CountFrames: Integer;
Cycle: Boolean;
ButtonStyle: Boolean;
Increment: Boolean;
Command: TStdCommand;
procedure ChangeFrame;
procedure Start;
procedure Stop;
constructor Create(AParent: TspDynamicSkinForm;
AData: TspDataSkinObject);
procedure DblCLick; override;
procedure MouseUp(X, Y: Integer; Button: TMouseButton); override;
property Frame: Integer read FFrame write SetFrame;
procedure Draw(Cnvs: TCanvas; UpDate: Boolean); override;
procedure MouseEnter; override;
procedure MouseLeave; override;
end;
TspSkinGaugeObject = class(TspActiveSkinObject)
protected
FProgressPos, FOldProgressPos: TPoint;
procedure SetValue(AValue: Integer);
function CalcProgressPos: TPoint;
public
FValue: Integer;
MinValue, MaxValue: Integer;
Kind: TGaugeKind;
procedure SimplySetValue(AValue: Integer);
constructor Create(AParent: TspDynamicSkinForm;
AData: TspDataSkinObject);
property Value: Integer read FValue write SetValue;
procedure Draw(Cnvs: TCanvas; UpDate: Boolean); override;
procedure MouseEnter; override;
procedure MouseLeave; override;
end;
TspSkinBitLabelObject = class(TspActiveSkinObject)
protected
FTextValue: String;
SymbolWidth: Integer;
SymbolHeight: Integer;
Symbols: TStrings;
public
constructor Create(AParent: TspDynamicSkinForm;
AData: TspDataSkinObject);
procedure Draw(Cnvs: TCanvas; UpDate: Boolean); override;
procedure SetTextValue(AValue: String; AUpDate: Boolean);
end;
TspSkinLabelObject = class(TspActiveSkinObject)
public
FTextValue: String;
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
FontColor: TColor;
ActiveFontColor: TColor;
Alignment: TAlignment;
constructor Create(AParent: TspDynamicSkinForm;
AData: TspDataSkinObject);
procedure MouseEnter; override;
procedure MouseLeave; override;
procedure Draw(Cnvs: TCanvas; UpDate: Boolean); override;
procedure SetTextValue(AValue: String; AUpDate: Boolean);
end;
TspSkinSwitchObject = class(TspActiveSkinObject)
protected
FState: TSwitchState;
procedure SetState(Value: TSwitchState);
public
constructor Create(AParent: TspDynamicSkinForm;
AData: TspDataSkinObject);
property State: TSwitchState read FState write SetState;
procedure SimpleSetState(Value: TSwitchState);
procedure MouseDown(X, Y: Integer; Button: TMouseButton); override;
procedure MouseEnter; override;
procedure MouseLeave; override;
end;
TspSkinTrackBarObject = class(TspActiveSkinObject)
private
FButtonPos, FOldButtonPos: TPoint;
FValue: Integer;
MoveActive: Boolean;
FOldMPoint: TPoint;
TrackKind: TTrackKind;
procedure SetButtonPos(AValue: TPoint);
procedure SetValue(AValue: Integer);
function CalcValue(APos: TPoint): Integer;
function CalcButtonPos(AValue: Integer): TPoint;
property ButtonPos: TPoint read FButtonPos write SetButtonPos;
function CalcButtonRect(P: TPoint): TRect;
public
ButtonRect: TRect;
ActiveButtonRect: TRect;
BeginPoint: TPoint;
EndPoint: TPoint;
MinValue: Integer;
MaxValue: Integer;
MouseDownChangeValue: Boolean;
constructor Create(AParent: TspDynamicSkinForm;
AData: TspDataSkinObject);
property Value: Integer read FValue write SetValue;
procedure SimplySetValue(AValue: Integer);
procedure Draw(Cnvs: TCanvas; UpDate: Boolean); override;
procedure MouseDown(X, Y: Integer; Button: TMouseButton); override;
procedure MouseUp(X, Y: Integer; Button: TMouseButton); override;
procedure MouseMove(X, Y: Integer); override;
end;
TspSkinButtonObject = class(TspActiveSkinObject)
protected
FDown: Boolean;
FPopupUp: Boolean;
procedure SetDown(Value: Boolean);
procedure TrackMenu;
public
DownRect: TRect;
DisableSkinRect: TRect;
GroupIndex: Integer;
MenuItem: TMenuItem;
constructor Create(AParent: TspDynamicSkinForm;
AData: TspDataSkinObject);
property Down: Boolean read FDown write SetDown;
procedure Draw(Cnvs: TCanvas; UpDate: Boolean); override;
procedure MouseDown(X, Y: Integer; Button: TMouseButton); override;
procedure MouseUp(X, Y: Integer; Button: TMouseButton); override;
procedure MouseEnter; override;
procedure MouseLeave; override;
end;
TspSkinMainMenuItem = class(TspActiveSkinObject)
protected
TempObjectRect: TRect;
FDown: Boolean;
OldEnabled: Boolean;
Visible: Boolean;
function SearchDown: Boolean;
procedure SearchActive;
procedure SetDown(Value: Boolean);
procedure TrackMenu;
public
MenuItem: TMenuItem;
FontName: String;
FontHeight: Integer;
FontStyle: TFontStyles;
UnEnabledFontColor, FontColor,
ActiveFontColor, DownFontColor: TColor;
TextRct: TRect;
DownRect: TRect;
LO, RO: Integer;
constructor Create(AParent: TspDynamicSkinForm; AData: TspDataSkinObject);
procedure Draw(Cnvs: TCanvas; UpDate: Boolean); override;
procedure MouseEnter; override;
procedure MouseDown(X, Y: Integer; Button: TMouseButton); override;
procedure MouseLeave; override;
end;
TspSkinStdButtonObject = class(TspSkinButtonObject)
protected
procedure DoMax;
procedure DoMin;
procedure DoClose;
procedure DoRollUp;
procedure DoCommand;
public
FSkinSupport: Boolean;
Command: TStdCommand;
RestoreRect, RestoreActiveRect, RestoreDownRect: TRect;
procedure DblClick; override;
procedure MouseDown(X, Y: Integer; Button: TMouseButton); override;
procedure MouseUp(X, Y: Integer; Button: TMouseButton); override;
constructor Create(AParent: TspDynamicSkinForm;
AData: TspDataSkinObject);
procedure Draw(Cnvs: TCanvas; UpDate: Boolean); override;
procedure DefaultDraw(Cnvs: TCanvas);
function CanMorphing: Boolean; override;
end;
TspSkinCaptionObject = class(TspActiveSkinObject)
protected
FTextValue: String;
procedure SetTextValue(Value: String);
public
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
FontColor: TColor;
ActiveFontColor: TColor;
ShadowColor: TColor;
ActiveShadowColor: TColor;
Shadow: Boolean;
Alignment: TAlignment;
TextRct: TRect;
DefaultCaption: Boolean;
FrameRect, ActiveFrameRect: TRect;
FrameLeftOffset, FrameRightOffset: Integer;
FrameTextRect: TRect;
procedure SimpleSetTextValue(Value: String);
constructor Create(AParent: TspDynamicSkinForm;
AData: TspDataSkinObject);
property TextValue: String read FTextValue write SetTextValue;
procedure MouseEnter; override;
procedure MouseLeave; override;
procedure MouseDown(X, Y: Integer; Button: TMouseButton); override;
procedure MouseUp(X, Y: Integer; Button: TMouseButton); override;
procedure Draw(Cnvs: TCanvas; UpDate: Boolean); override;
end;
TspSkinMainMenu = class(TMainMenu)
protected
DSF: TSpDynamicSkinForm;
FSD: TspSkinData;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
published
property SkinData: TspSkinData read FSD write FSD;
end;
// Menu Bar //
TspSkinMainMenuBar = class;
TspMenuBarObject = class(TObject)
protected
Parent: TspSkinMainMenuBar;
FMorphKf: Double;
FMouseIn: Boolean;
Picture: TBitMap;
FDown: Boolean;
procedure SetMorphKf(Value: Double);
procedure Redraw;
public
IDName: String;
SkinRect: TRect;
ActiveSkinRect: TRect;
DownRect: TRect;
Morphing: Boolean;
MorphKind: TMorphKind;
ObjectRect: TRect;
Active: Boolean;
Enabled: Boolean;
Visible: Boolean;
constructor Create(AParent: TspSkinMainMenuBar; AData: TspDataSkinObject);
procedure Draw(Cnvs: TCanvas); virtual;
procedure DblClick; virtual;
procedure MouseDown(X, Y: Integer; Button: TMouseButton); virtual;
procedure MouseUp(X, Y: Integer; Button: TMouseButton); virtual;
procedure MouseEnter; virtual;
procedure MouseLeave; virtual;
function CanMorphing: Boolean; virtual;
procedure DoMorphing;
property MorphKf: Double read FMorphKf write SetMorphKf;
end;
TspSkinMainMenuBarButton = class(TspMenuBarObject)
protected
FSkinSupport: Boolean;
procedure DoCommand;
public
Command: TStdCommand;
constructor Create(AParent: TspSkinMainMenuBar; AData: TspDataSkinObject);
procedure DefaultDraw(Cnvs: TCanvas);
procedure Draw(Cnvs: TCanvas); override;
procedure DblClick; override;
procedure MouseDown(X, Y: Integer; Button: TMouseButton); override;
procedure MouseUp(X, Y: Integer; Button: TMouseButton); override;
procedure MouseEnter; override;
procedure MouseLeave; override;
end;
TspSkinMainMenuBarItem = class(TspMenuBarObject)
protected
FSkinSupport: Boolean;
TempObjectRect: TRect;
OldEnabled: Boolean;
Visible: Boolean;
function SearchDown: Boolean;
procedure SearchActive;
procedure SetDown(Value: Boolean);
procedure TrackMenu;
public
MenuItem: TMenuItem;
FontName: String;
FontHeight: Integer;
FontStyle: TFontStyles;
UnEnabledFontColor, FontColor,
ActiveFontColor, DownFontColor: TColor;
TextRct: TRect;
DownRect: TRect;
LO, RO: Integer;
constructor Create(AParent: TspSkinMainMenuBar; AData: TspDataSkinObject);
procedure DefaultDraw(Cnvs: TCanvas);
procedure Draw(Cnvs: TCanvas); override;
procedure MouseEnter; override;
procedure MouseDown(X, Y: Integer; Button: TMouseButton); override;
procedure MouseLeave; override;
end;
TspSkinMainMenuBar = class(TspSkinControl)
protected
FDefItemFont: TFont;
FSkinSupport: Boolean;
ButtonsCount: Integer;
FMDIChildMax: Boolean;
FOnMainMenuItemClick: TMainMenuItemClick;
FPopupToUp: Boolean;
MenuActive: Boolean;
Scroll: Boolean;
MarkerActive: Boolean;
DSF: TspDynamicSkinForm;
FMainMenu: TMainMenu;
MorphTimer: TTimer;
MouseTimer: TTimer;
ActiveObject, OldActiveObject, MouseCaptureObject: Integer;
FOnMouseEnter, FOnMouseLeave: TNotifyEvent;
NewItemsRect: TRect;
FDefaultWidth: Integer;
FDefaultHeight: Integer;
procedure SetDefaultWidth(Value: Integer);
procedure SetDefaultHeight(Value: Integer);
procedure SetDefItemFont(Value: TFont);
procedure CloseSysMenu;
procedure AddButtons;
procedure DeleteButtons;
procedure CheckButtons(BI: TspBorderIcons);
procedure TrackScrollMenu;
procedure CalcRects;
procedure SetMainMenu(Value: TMainMenu);
procedure TestMouse(Sender: TObject);
procedure TestMorph(Sender: TObject);
procedure PaintMenuBar(Cnvs: TCanvas);
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMCloseSkinMenu(var Message: TMessage); message WM_CLOSESKINMENU;
procedure WMSize(var Message: TWMSIZE); message WM_SIZE;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure TestActive(X, Y: Integer);
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure ClearObjects;
procedure DrawSkinObject(AObject: TspMenuBarObject);
procedure MenuEnter;
procedure MenuExit;
procedure MenuClose;
function CheckReturnKey: Boolean;
procedure NextMainMenuItem;
procedure PriorMainMenuItem;
function FindHotKeyItem(CharCode: Integer): Boolean;
function GetMarkerRect: TRect;
procedure DrawMarker(Cnvs: TCanvas);
procedure MDIChildMaximize;
procedure MDIChildRestore;
public
//
SkinRect, ItemsRect: TRect;
MenuBarItem: String;
MaxButton, MinButton, SysMenuButton, CloseButton: String;
TrackMarkColor, TrackMarkActiveColor: Integer;
Picture: TBitMap;
//
ObjectList: TList;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure Paint; override;
procedure CreateMenu;
procedure ChangeSkinData; override;
procedure BeforeChangeSkinData; override;
procedure GetSkinData; override;
procedure UpDateItems;
published
property DefItemFont: TFont read FDefItemFont write SetDefItemFont;
property DefaultWidth: Integer read FDefaultWidth write SetDefaultWidth;
property DefaultHeight: Integer read FDefaultHeight write SetDefaultHeight;
property PopupToUp: Boolean read FPopupToUp write FPopupToUp;
property DynamicSkinForm: TspDynamicSkinForm read DSF write DSF;
property MainMenu: TMainMenu read FMainMenu write SetMainMenu;
property Anchors;
property Visible;
property Enabled;
property OnMainMenuItemClick: TMainMenuItemClick
read FOnMainMenuItemClick write FOnMainMenuItemClick;
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnClick;
end;
TspDynamicSkinForm = class(TComponent)
private
FIcon: TIcon;
FShowIcon: Boolean;
ButtonsInLeft: boolean;
FMaximizeOnFullScreen: Boolean;
FSkinHint: TspSkinHint;
FShowObjectHint: Boolean;
FUseSkinCursors: Boolean;
FSkinSupport: Boolean;
FDefCaptionFont: TFont;
FDefInActiveCaptionFont: TFont;
FMDIChildMaximized: Boolean;
FFormActive: Boolean;
FOnMinimizeToTray: TNotifyEvent;
FOnRestoreFromTray: TNotifyEvent;
FTrayIcon: TspTrayIcon;
FUseDefaultSysMenu: Boolean;
FSysMenu: TPopupMenu;
FSysTrayMenu: TspSkinPopupMenu;
FInShortCut: Boolean;
FMainMenuBar: TspSkinMainMenuBar;
FFullDrag: Boolean;
FFormWidth, FFormHeight: Integer;
FSizeMove: Boolean;
FSupportNCArea: Boolean;
FRollUpState, MaxRollUpState: Boolean;
FBorderIcons: TspBorderIcons;
RMTop, RMBottom, RMLeft, RMRight: TBitMap;
BlackColor: TColor;
MouseIn: Boolean;
OldBoundsRect: TRect;
OldHeight: Integer;
NewLTPoint, NewRBPoint, NewRTPoint, NewLBPoint: TPoint;
NewClRect: TRect;
NewCaptionRect, NewButtonsRect: TRect;
NewButtonsOffset: Integer;
NewButtonsInLeft: Boolean;
NewMaskRectArea: TRect;
NewHitTestLTPoint,
NewHitTestRTPoint,
NewHitTestLBPoint,
NewHitTestRBPoint: TPoint;
NewDefCaptionRect: TRect;
FSizeable: Boolean;
FMinHeight, FMinWidth: Integer;
OldWindowProc: TWndMethod;
FClientInstance: Pointer;
FPrevClientProc: Pointer;
FSD: TspSkinData;
FMSD: TspSkinData;
FMainMenu: TMainMenu;
FSystemMenu: TPopupMenu;
FDraggAble: Boolean;
FIsDragging: Boolean;
FOldX, FOldY: Integer;
FOnChangeSkinData: TNotifyEvent;
FOnActivate: TNotifyEvent;
FOnDeActivate: TNotifyEvent;
FOnChangeRollUpState: TNotifyEvent;
FInChangeSkinData: Boolean;
FWindowState: TWindowState;
FMagneticSize: Byte;
FMenusAlphaBlend: Boolean;
FMenusAlphaBlendValue: Byte;
FMenusAlphaBlendAnimation: Boolean;
FAlphaBlend: Boolean;
FAlphaBlendAnimation: Boolean;
FAlphaBlendValue: Byte;
VisibleControls: TList;
OldAppMessage: TMessageEvent;
procedure SetShowIcon(Value: Boolean);
procedure GetIconSize(var X, Y: Integer);
procedure GetIcon;
procedure DrawFormIcon(Cnvs: TCanvas; X, Y: Integer);
procedure SetMenusAlphaBlend(Value: Boolean);
procedure SetMenusAlphaBlendAnimation(Value: Boolean);
procedure SetMenusAlphaBlendValue(Value: Byte);
function GetDefCaptionRect: TRect;
function GetDefCaptionHeight: Integer;
function GetDefButtonSize: Integer;
procedure SetDefaultMenuItemHeight(Value: Integer);
function GetDefaultMenuItemHeight: Integer;
procedure SetDefaultMenuItemFont(Value: TFont);
function GetDefaultMenuItemFont: TFont;
procedure SetDefCaptionFont(Value: TFont);
procedure SetDefInActiveCaptionFont(Value: TFont);
procedure SetBorderIcons(Value: TspBorderIcons);
procedure NewAppMessage(var Msg: TMsg; var Handled: Boolean);
procedure HookApp;
procedure UnHookApp;
function GetMaximizeMDIChild: TForm;
function IsMDIChildMaximized: Boolean;
procedure ResizeMDIChilds;
function GetMDIWorkArea: TRect;
procedure UpDateForm;
procedure FormClientWindowProcHook(var Message: TMessage);
procedure TSM_Restore(Sender: TObject);
procedure TSM_Close(Sender: TObject);
procedure SM_Restore(Sender: TObject);
procedure SM_Max(Sender: TObject);
procedure SM_Min(Sender: TObject);
procedure SM_RollUp(Sender: TObject);
procedure SM_Close(Sender: TObject);
procedure SM_MinToTray(Sender: TObject);
procedure TrayIconDBLCLK(Sender: TObject);
procedure TrackSystemMenu(X, Y: Integer);
procedure UpDateActiveObjects;
procedure CreateSysMenu;
procedure CreateUserSysMenu;
procedure CreateSysTrayMenu;
function GetSystemMenu: TMenuItem;
procedure CalcRects;
procedure FormShortCut(var Msg: TWMKey; var Handled: Boolean);
procedure ChangeSkinData;
procedure SetRollUpFormRegion;
procedure CreateRollUpForm;
procedure CreateRollUpForm2;
procedure RestoreRollUpForm;
procedure RestoreRollUpForm2;
procedure SetRollUpState(Value: Boolean);
procedure SetTrayIcon(Value: TspTrayIcon);
procedure BeforeUpDateSkinControls(AFSD: Integer; WC: TWinControl);
procedure UpDateSkinControls(AFSD: Integer; WC: TWinControl);
procedure CheckObjects;
procedure SetWindowState(Value: TWindowState);
procedure SetSkinData(Value: TspSkinData);
procedure SetMenusSkinData(Value: TspSkinData);
procedure CheckSize;
procedure NewWndProc(var Message: TMessage);
function NewHitTest(P: TPoint): Integer;
function NewNCHitTest(P: TPoint): Integer;
function NewDefNCHitTest(P: TPoint): Integer;
procedure CreateNewRegion(FCanScale: Boolean);
procedure CreateNewForm(FCanScale: Boolean);
procedure FormChangeActive(AUpDate: Boolean);
procedure DoMaximize;
procedure DoNormalize;
procedure DoMinimize;
function InForm(P: TPoint): Boolean;
function PtInMask(P: TPoint): Boolean;
function CanScale: Boolean;
procedure CreateMainMenu;
procedure CheckWindowState;
protected
InMenu: Boolean;
InMainMenu: Boolean;
FRgn: HRGN;
NewMainMenuRect: TRect;
NewIconRect: TRect;
MorphTimer: TTimer;
AnimateTimer: TTimer;
MouseTimer: TTimer;
FMagnetic: Boolean;
FOnSkinMenuOpen: TNotifyEvent;
FOnSkinMenuClose: TNotifyEvent;
FOnChangeClientRect: TChangeClientRectEvent;
FOnMainMenuEnter: TNotifyEvent;
FOnMainMenuExit: TNotifyEvent;
FOnMouseEnterEvent: TMouseEnterEvent;
FOnMouseLeaveEvent: TMouseLeaveEvent;
FOnMouseUpEvent : TspMouseUpEvent;
FOnMouseDownEvent : TMouseDownEvent;
FOnMouseMoveEvent: TMouseMoveEvent;
FOnPaintEvent: TPaintEvent;
FOnSwitchChangeStateEvent: TSwitchChangeStateEvent;
FOnTrackBarChangeValueEvent: TTrackBarChangeValueEvent;
FOnFrameRegulatorChangeValueEvent: TFrameRegulatorChangeValueEvent;
ActiveObject, OldActiveObject, MouseCaptureObject: Integer;
OldWindowState: TWindowState;
procedure CorrectCaptionText(C: TCanvas; var S: String; W: Integer);
procedure CheckMenuVisible(var Msg: Cardinal);
procedure FormKeyDown(Message: TMessage);
function CanNCSupport: Boolean;
function GetFullDragg: Boolean;
function GetMinimizeCoord: TPoint;
function CanObjectTest(ARollUp: Boolean): Boolean;
procedure PointToNCPoint(var P: TPoint);
procedure ActivateMenu;
function CheckReturnKey: Boolean;
procedure NextMainMenuItem;
procedure PriorMainMenuItem;
function CanNextMainMenuItem: Boolean;
function CanPriorMainMenuItem: Boolean;
function FindHotKeyItem(CharCode: Integer): Boolean;
procedure SetMainMenu(Value: TMainMenu);
procedure StartDragg(X, Y: Integer);
procedure EndDragg;
procedure DoMagnetic(var L, T: Integer; W, H: Integer);
procedure TestCursors;
procedure TestMouse(Sender: TObject);
procedure TestMorph(Sender: TObject);
procedure TestAnimate(Sender: TObject);
procedure TestActive(X, Y: Integer; InFrm: Boolean);
procedure MouseDBlClick;
procedure MouseDown(Button: TMouseButton; X, Y: Integer);
procedure MouseMove(X, Y: Integer);
procedure MouseUp(Button: TMouseButton; X, Y: Integer);
procedure CreateRealBitMap(DestB, SourceB: TBitMap);
function CalcRealObjectRect(R: TRect): TRect;
procedure CalcAllRealObjectRect;
procedure ControlsToAreas;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure LoadObjects;
procedure LoadDefObjects;
procedure SwitchChangeStateEvent(IDName: String; State: TSwitchState);
procedure TrackBarChangeValueEvent(IDName: String; Value: Integer);
procedure FrameRegulatorChangeValueEvent(IDName: String; Value: Integer);
procedure MouseEnterEvent(IDName: String);
procedure MouseLeaveEvent(IDName: String);
procedure MouseUpEvent(IDName: String;
X, Y: Integer; ObjectRect: TRect;
Button: TMouseButton);
procedure MouseDownEvent(IDName: String;
X, Y: Integer; ObjectRect: TRect;
Button: TMouseButton);
procedure MouseMoveEvent(IDName: String; X, Y: Integer;
ObjectRect: TRect);
procedure PaintEvent(IDName: String; Canvas: TCanvas; ObjectRect: TRect);
procedure LinkControlsToAreas;
procedure SetDefaultCaptionText(AValue: String);
procedure SkinMainMenuClose;
procedure SkinMenuClose2;
procedure ArangeMinimizedChilds;
function GetAutoRenderingInActiveImage: Boolean;
procedure SetAlphaBlendValue(Value: Byte);
procedure SetAlphaBlend(Value: Boolean);
public
SkinMenu: TspSkinMenu;
FForm: TForm;
ObjectList, AreaList: TList;
procedure AddChildToMenu(Child: TCustomForm);
procedure DeleteChildFromMenu(Child: TCustomForm);
procedure MDIItemClick(Sender: TObject);
procedure UpDateChildCaptionInMenu(Child: TCustomForm);
procedure UpDateChildActiveInMenu;
function GetMinWidth: Integer;
function GetMinHeight: Integer;
function GetMaxWidth: Integer;
function GetMaxHeight: Integer;
procedure MinimizeAll;
procedure MaximizeAll;
procedure RestoreAll;
procedure Tile;
procedure Cascade;
procedure CloseAll;
function GetFormActive: Boolean;
procedure MinimizeToTray;
procedure RestoreFromTray;
procedure SkinMenuOpen;
procedure SkinMenuClose;
procedure DrawSkinObject(AObject: TspActiveSkinObject);
procedure SetFormStyle(FS: TFormStyle);
procedure LinkControlToArea(AreaName: String; Control: TControl);
procedure UnLinkControlFromArea(Control: TControl);
procedure UpdateMainMenu(ARedraw: Boolean);
procedure PopupSkinMenu(Menu: TMenu; P: TPoint);
procedure PopupSkinMenu1(Menu: TMenu; R: TRect; PopupUp: Boolean);
procedure ClearObjects;
function GetIndex(AIDName: String): Integer;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Paint(DC: HDC);
procedure PaintNCSkin;
procedure PaintBG(DC: HDC);
procedure PaintBG2(DC: HDC);
//
procedure PaintNCDefault;
procedure PaintBGDefault(DC: HDC);
procedure PaintMDIBGDefault(DC: HDC);
procedure CalcDefRects;
//
procedure SetSupportNCArea(Value: Boolean);
procedure SetEnabled(AIDName: String; Value: Boolean);
procedure CaptionSetText(AIDName, AText: String);
procedure AnimateStart(AIDName: String);
procedure AnimateStop(AIDName: String);
procedure BitLabelSetText(AIDName: String; AValue: String);
procedure GaugeSetValue(AIDName: String; AValue: Integer);
procedure FrameGaugeSetValue(AIDName: String; AValue: Integer);
procedure ButtonSetDown(AIDName: String; ADown: Boolean);
function ButtonGetDown(AIDName: String): Boolean;
procedure SwitchSetState(AIDName: String; AState: TSwitchState);
function SwitchGetState(AIDName: String): TSwitchState;
function TrackBarGetValue(AIDName: String): Integer;
procedure TrackBarSetValue(AIDName: String; AValue: Integer);
function FrameRegulatorGetValue(AIDName: String): Integer;
procedure FrameRegulatorSetValue(AIDName: String; AValue: Integer);
procedure LabelSetText(AIDName, ATextValue: String);
procedure UserObjectDraw(AIDName: String);
procedure LinkMenu(AIDName: String; AMenu: TMenu; APopupUp: Boolean);
//
property RollUpState: Boolean read FRollUpState write SetRollUpState;
property WindowState: TWindowState read FWindowState write SetWindowState;
published
property ShowIcon: Boolean read FShowIcon write SetShowIcon;
property MaximizeOnFullScreen: Boolean
read FMaximizeOnFullScreen write FMaximizeOnFullScreen;
property SkinHint: TspSkinHint read FSkinHint write FSkinHint;
property ShowObjectHint: Boolean read FShowObjectHint write FShowObjectHint;
property UseSkinCursors: Boolean read FUseSkinCursors write FUseSkinCursors;
property DefCaptionFont: TFont read FDefCaptionFont write SetDefCaptionFont;
property DefInActiveCaptionFont: TFont read FDefInActiveCaptionFont write SetDefInActiveCaptionFont;
property DefMenuItemHeight: Integer
read GetDefaultMenuItemHeight write SetDefaultMenuItemHeight;
property DefMenuItemFont: TFont
read GetDefaultMenuItemFont write SetDefaultMenuItemFont;
property TrayIcon: TspTrayIcon read FTrayIcon write SetTrayIcon;
property UseDefaultSysMenu: Boolean
read FUseDefaultSysMenu write FUseDefaultSysMenu;
property MainMenuBar: TspSkinMainMenuBar read FMainMenuBar write FMainMenuBar;
property SupportNCArea: Boolean read FSupportNCArea
write SetSupportNCArea;
property AlphaBlendAnimation: Boolean read
FAlphaBlendAnimation write FAlphaBlendAnimation;
property AlphaBlendValue: Byte read FAlphaBlendValue
write SetAlphaBlendValue;
property AlphaBlend: Boolean read FAlphaBlend
write SetAlphaBlend;
property MenusAlphaBlend: Boolean
read FMenusAlphaBlend write SetMenusAlphaBlend;
property MenusAlphaBlendAnimation: Boolean
read FMenusAlphaBlendAnimation write SetMenusAlphaBlendAnimation;
property MenusAlphaBlendValue: Byte
read FMenusAlphaBlendValue write SetMenusAlphaBlendValue;
property MainMenu: TMainMenu read FMainMenu write SetMainMenu;
property SystemMenu: TPopupMenu read FSystemMenu write FSystemMenu;
property SkinData: TspSkinData read FSD write SetSkinData;
property MenusSkinData: TspSkinData read FMSD write SetMenusSkinData;
property MinHeight: Integer read FMinHeight write FMinHeight;
property MinWidth: Integer read FMinWidth write FMinWidth;
property Sizeable: Boolean read FSizeable write FSizeable;
property DraggAble: Boolean read FDraggAble write FDraggAble;
property Magnetic: Boolean read FMagnetic write FMagnetic;
property MagneticSize: Byte read FMagneticSize write FMagneticSize;
property BorderIcons: TspBorderIcons read FBorderIcons write SetBorderIcons;
property OnChangeClientRect: TChangeClientRectEvent
read FOnChangeClientRect write FOnChangeClientRect;
property OnChangeSkinData: TNotifyEvent read FOnChangeSkinData
write FOnChangeSkinData;
property OnMouseUpEvent: TspMouseUpEvent read FOnMouseUpEvent
write FOnMouseUpEvent;
property OnMouseDownEvent: TMouseDownEvent read FOnMouseDownEvent
write FOnMouseDownEvent;
property OnMouseMoveEvent: TMouseMoveEvent read FOnMouseMoveEvent
write FOnMouseMoveEvent;
property OnMouseEnterEvent: TMouseEnterEvent read FOnMouseEnterEvent
write FOnMouseEnterEvent;
property OnMouseLeaveEvent: TMouseLeaveEvent read FOnMouseLeaveEvent
write FOnMouseLeaveEvent;
property OnPaintEvent: TPaintEvent read FOnPaintEvent
write FOnPaintEvent;
property OnSwitchChangeStateEvent: TSwitchChangeStateEvent
read FOnSwitchChangeStateEvent
write FOnSwitchChangeStateEvent;
property OnTrackBarChangeValueEvent: TTrackBarChangeValueEvent
read FOnTrackBarChangeValueEvent
write FOnTrackBarChangeValueEvent;
property OnFrameRegulatorChangeValueEvent: TFrameRegulatorChangeValueEvent
read FOnFrameRegulatorChangeValueEvent
write FOnFrameRegulatorChangeValueEvent;
property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
property OnDeActivate: TNotifyEvent read FOnDeActivate write FOnDeActivate;
property OnSkinMenuOpen: TNotifyEvent read FOnSkinMenuOpen
write FOnSkinMenuOpen;
property OnSkinMenuClose: TNotifyEvent read FOnSkinMenuClose
write FOnSkinMenuClose;
property OnChangeRollUpState: TNotifyEvent read FOnChangeRollUpState
write FOnChangeRollUpState;
property OnMainMenuEnter: TNotifyEvent read FOnMainMenuEnter
write FOnMainMenuEnter;
property OnMainMenuExit: TNotifyEvent read FOnMainMenuExit
write FOnMainMenuExit;
property OnMinimizeToTray: TNotifyEvent
read FOnMinimizeToTray write FOnMinimizeToTray;
property OnRestoreFromTray: TNotifyEvent
read FOnRestoreFromTray write FOnRestoreFromTray;
end;
function GetDynamicSkinFormComponent(AForm: TForm): TspDynamicSkinForm;
function GetMDIChildDynamicSkinFormComponent: TspDynamicSkinForm;
function GetMDIChildDynamicSkinFormComponent2: TspDynamicSkinForm;
implementation
type
PAreaInfo = ^TAreaInfo;
TAreaInfo = record
Control: TControl;
AreaRect: TRect;
end;
const
WS_EX_LAYERED = $80000;
InActiveBrightnessKf = 0.5;
InActiveDarknessKf = 0.3;
InActiveNoiseAmount = 50;
MorphInc = 0.1;
MouseTimerInterval = 50;
MorphTimerInterval = 20;
AnimateTimerInterval = 25;
HTNCACTIVE = HTOBJECT;
TRACKMARKEROFFSET = 5;
DEFCAPTIONHEIGHT = 19;
DEFBUTTONSIZE = 17;
DEFTOOLCAPTIONHEIGHT = 15;
DEFTOOLBUTTONSIZE = 13;
DEFFORMMINWIDTH = 130;
TMI_RESTORENAME = 'TRAY_DSF_RESTORE';
TMI_CLOSENAME = 'TRAY_DSF_CLOSE';
MI_MINNAME = 'DSF_MINITEM';
MI_MAXNAME = 'DSF_MAXITEM';
MI_CLOSENAME = 'DSF_CLOSE';
MI_RESTORENAME = 'DSF_RESTORE';
MI_MINTOTRAYNAME = 'DSF_MINTOTRAY';
MI_ROLLUPNAME = 'DSF_ROLLUP';
MI_MINCAPTION = 'Mi&nimize';
MI_MAXCAPTION = 'Ma&ximize';
MI_CLOSECAPTION = '&Close';
MI_RESTORECAPTION = '&Restore';
MI_MINTOTRAYCAPTION = 'Minimize to &Tray';
MI_ROLLUPCAPTION = 'Ro&llUp';
MI_CHILDITEM = '_DSFCHILDITEM';
WM_MDICHANGESIZE = WM_USER + 206;
WM_MDICHILDMAX = WM_USER + 207;
WM_MDICHILDRESTORE = WM_USER + 208;
function GetDynamicSkinFormComponent;
var
i: Integer;
begin
Result := nil;
for i := 0 to AForm.ComponentCount - 1 do
if AForm.Components[i] is TspDynamicSkinForm
then
begin
Result := (AForm.Components[i] as TspDynamicSkinForm);
Break;
end;
end;
function GetMDIChildDynamicSkinFormComponent;
var
i: Integer;
begin
Result := nil;
for i := 0 to Application.MainForm.MDIChildCount - 1 do
begin
Result := GetDynamicSkinFormComponent(Application.MainForm.MDIChildren[i]);
if (Result <> nil) and (Result.WindowState = wsMaximized)
then
Break
else
Result := nil;
end;
end;
function GetMDIChildDynamicSkinFormComponent2;
begin
if (Application.MainForm <> nil) and (Application.MainForm.ActiveMDIChild <> nil)
then
Result := GetDynamicSkinFormComponent(Application.MainForm.ActiveMDIChild)
else
Result := nil;
end;
//============= TspActiveSkinObject =============//
constructor TspActiveSkinObject.Create;
begin
Parent := AParent;
SD := Parent.SkinData;
Enabled := True;
Visible := True;
FMorphKf := 0;
if AData <> nil
then
begin
with AData do
begin
Self.IDName := IDName;
Self.Hint := Hint;
Self.SkinRectInAPicture := SkinRectInAPicture;
Self.SkinRect := SkinRect;
Self.ActiveSkinRect := ActiveSkinRect;
Self.Morphing := Morphing;
Self.MorphKind := MorphKind;
Self.CursorIndex := CursorIndex;
Self.RollUp := RollUp;
if (ActivePictureIndex <> - 1) and
(ActivePictureIndex < SD.FActivePictures.Count)
then
ActivePicture := TBitMap(SD.FActivePictures.Items[ActivePictureIndex])
else
begin
ActivePicture := nil;
ActiveSkinRect := NullRect;
end;
end;
ObjectRect := SkinRect;
if RollUp then Picture := SD.FRollUpPicture else Picture := SD.FPicture;
end;
end;
procedure TspActiveSkinObject.ReDraw;
begin
if Morphing
then Parent.MorphTimer.Enabled := True
else Parent.DrawSkinObject(Self);
end;
procedure TspActiveSkinObject.DblClick;
begin
end;
procedure TspActiveSkinObject.MouseDown(X, Y: Integer; Button: TMouseButton);
begin
Parent.MouseDownEvent(IDName, X, Y, ObjectRect, Button);
end;
procedure TspActiveSkinObject.MouseUp(X, Y: Integer; Button: TMouseButton);
begin
if FMouseIn then Parent.MouseUpEvent(IDName, X, Y, ObjectRect, Button);
end;
procedure TspActiveSkinObject.MouseMove(X, Y: Integer);
begin
Parent.MouseMoveEvent(IDName, X, Y, ObjectRect);
end;
procedure TspActiveSkinObject.MouseEnter;
begin
FMouseIn := True;
Active := True;
if not IsNullRect(ActiveSkinRect) then ReDraw;
Parent.MouseEnterEvent(IDName);
end;
procedure TspActiveSkinObject.MouseLeave;
begin
FMouseIn := False;
Active := False;
if not IsNullRect(ActiveSkinRect) then ReDraw;
Parent.MouseLeaveEvent(IDName);
end;
function TspActiveSkinObject.CanMorphing;
begin
Result := (Active and (MorphKf < 1)) or
(not Active and (MorphKf > 0));
end;
procedure TspActiveSkinObject.DoMorphing;
begin
if Active
then MorphKf := MorphKf + MorphInc
else MorphKf := MorphKf - MorphInc;
Parent.DrawSkinObject(Self);
end;
procedure TspActiveSkinObject.Draw;
procedure CreateObjectImage(B: TBitMap; AActive: Boolean);
begin
B.Width := RectWidth(ObjectRect);
B.Height := RectHeight(ObjectRect);
with B.Canvas do
begin
if AActive
then
CopyRect(Rect(0, 0, B.Width, B.Height), ActivePicture.Canvas, ActiveSkinRect)
else
if SkinRectInApicture
then
CopyRect(Rect(0, 0, B.Width, B.Height), ActivePicture.Canvas, SkinRect)
else
CopyRect(Rect(0, 0, B.Width, B.Height), Picture.Canvas, SkinRect);
end;
end;
var
PBuffer, APBuffer: TspEffectBmp;
Buffer, ABuffer: TBitMap;
ASR, SR: TRect;
begin
ASR := ActiveSkinRect;
SR := SkinRect;
if not Morphing or
((Active and (MorphKf = 1)) or (not Active and (MorphKf = 0)))
then
begin
if Active and not IsNullRect(ASR)
then
Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, ASR)
else
if UpDate or SkinRectInApicture
then
begin
if SkinRectInApicture
then
Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, SR)
else
Cnvs.CopyRect(ObjectRect, Picture.Canvas, SR);
end;
end
else
begin
Buffer := TBitMap.Create;
ABuffer := TBitMap.Create;
CreateObjectImage(Buffer, False);
CreateObjectImage(ABuffer, True);
PBuffer := TspEffectBmp.CreateFromhWnd(Buffer.Handle);
APBuffer := TspEffectBmp.CreateFromhWnd(ABuffer.Handle);
case MorphKind of
mkDefault: PBuffer.Morph(APBuffer, MorphKf);
mkGradient: PBuffer.MorphGrad(APBuffer, MorphKf);
mkLeftGradient: PBuffer.MorphLeftGrad(APBuffer, MorphKf);
mkRightGradient: PBuffer.MorphRightGrad(APBuffer, MorphKf);
mkLeftSlide: PBuffer.MorphLeftSlide(APBuffer, MorphKf);
mkRightSlide: PBuffer.MorphRightSlide(APBuffer, MorphKf);
mkPush: PBuffer.MorphPush(APBuffer, MorphKf);
end;
PBuffer.Draw(Cnvs.Handle, ObjectRect.Left, ObjectRect.Top);
PBuffer.Free;
APBuffer.Free;
Buffer.Free;
ABuffer.Free;
end;
end;
procedure TspActiveSkinObject.SetMorphKf(Value: Double);
begin
FMorphKf := Value;
if FMorphKf < 0 then FMorphKf := 0 else
if FMorphKf > 1 then FMorphKf := 1;
end;
procedure TspUserObject.Draw;
begin
Parent.PaintEvent(IDName, Cnvs, ObjectRect);
end;
//============= TspSkinTrackBarObject ============//
constructor TspSkinTrackBarObject.Create;
begin
inherited Create(AParent, AData);
with TspDataSkinTrackBar(AData) do
begin
Self.ButtonRect := ButtonRect;
Self.ActiveButtonRect := ActiveButtonRect;
Self.BeginPoint := BeginPoint;
Self.EndPoint := EndPoint;
Self.MinValue := MinValue;
Self.MaxValue := MaxValue;
Self.MouseDownChangeValue := MouseDownChangeValue;
end;
if abs(BeginPoint.Y - EndPoint.Y) < abs(EndPoint.X - BeginPoint.X)
then
TrackKind := tkHorizontal
else
TrackKind := tkVertical;
FValue := MinValue;
FButtonPos := CalcButtonPos(FValue);
end;
function TspSkinTrackBarObject.CalcButtonRect;
var
L, T: Integer;
begin
L := P.X - RectWidth(ButtonRect) div 2;
T := P.Y - RectHeight(ButtonRect) div 2;
Result := Rect(L, T,
L + RectWidth(ButtonRect), T + RectHeight(ButtonRect));
end;
function TspSkinTrackBarObject.CalcValue;
var
kf: Double;
begin
kf := 0;
case TrackKind of
tkHorizontal:
kf := (FButtonPos.X - BeginPoint.X) / (EndPoint.X - BeginPoint.X);
tkVertical:
kf := 1 - (FButtonPos.Y - EndPoint.Y) / (BeginPoint.Y - EndPoint.Y);
end;
Result := MinValue + Round((MaxValue - MinValue) * kf);
end;
function TspSkinTrackBarObject.CalcButtonPos;
var
kf: Double;
begin
kf := (Value - MinValue) / (MaxValue - MinValue);
case TrackKind of
tkHorizontal:
Result := Point(BeginPoint.X + Round((EndPoint.X - BeginPoint.X) * kf),
BeginPoint.Y);
tkVertical:
Result := Point(BeginPoint.X,
EndPoint.Y + Round((BeginPoint.Y - EndPoint.Y) *
(1 - kf)));
end;
end;
procedure TspSkinTrackBarObject.SimplySetValue;
begin
FValue := AValue;
if FValue < MinValue then FValue := MinValue;
if FValue > MaxValue then FValue := MaxValue;
FOldButtonPos := FbuttonPos;
FButtonPos := CalcButtonPos(Value);
Parent.TrackBarChangeValueEvent(IDName, FValue);
end;
procedure TspSkinTrackBarObject.SetValue;
begin
if FValue <> AValue
then
begin
FValue := AValue;
if FValue < MinValue then FValue := MinValue;
if FValue > MaxValue then FValue := MaxValue;
FOldButtonPos := FbuttonPos;
FButtonPos := CalcButtonPos(Value);
Parent.DrawSkinObject(Self);
Parent.TrackBarChangeValueEvent(IDName, FValue);
end;
end;
procedure TspSkinTrackBarObject.SetButtonPos;
begin
if (FButtonPos.X <> AValue.X) or (FButtonPos.Y <> AValue.Y)
then
begin
FOldButtonPos := FbuttonPos;
FButtonPos := AValue;
FValue := CalcValue(FButtonPos);
Parent.DrawSkinObject(Self);
Parent.TrackBarChangeValueEvent(IDName, FValue);
end;
end;
procedure TspSkinTrackBarObject.Draw;
var
BRect: TRect;
Buffer: TBitMap;
BR: TRect;
begin
if MoveActive and not IsNullRect(ActiveButtonRect)
then BRect := ActiveButtonRect
else BRect := ButtonRect;
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(SkinRect);
Buffer.Height := RectHeight(SkinRect);
BR := CalcButtonRect(FButtonPos);
//
with Buffer.Canvas do
begin
case TrackKind of
tkHorizontal:
begin
if IsNullRect(ActiveSkinRect)
then
CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
Picture.Canvas, SkinRect)
else
begin
CopyRect(Rect(0, 0, FButtonPos.X, Buffer.Height),
ActivePicture.Canvas,
Rect(ActiveSkinRect.Left, ActiveSkinRect.Top,
ActiveSkinRect.Left + FButtonPos.X, ActiveSkinRect.Bottom));
CopyRect(Rect(FButtonPos.X, 0, Buffer.Width, Buffer.Height),
Picture.Canvas,
Rect(SkinRect.Left + FButtonPos.X, SkinRect.Top,
SkinRect.Right, SkinRect.Bottom));
end;
end;
tkVertical:
begin
if IsNullRect(ActiveSkinRect)
then
CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
Picture.Canvas, SkinRect)
else
begin
CopyRect(Rect(0, 0, Buffer.Width, FButtonPos.Y),
Picture.Canvas,
Rect(SkinRect.Left, SkinRect.Top,
SkinRect.Right, SkinRect.Top + FButtonPos.Y));
CopyRect(Rect(0, FButtonPos.Y, Buffer.Width, Buffer.Height),
ActivePicture.Canvas,
Rect(ActiveSkinRect.Left, ActiveSkinRect.Top + FButtonPos.Y,
ActiveSkinRect.Right, ActiveSkinRect.Bottom));
end;
end;
end;
CopyRect(BR, ActivePicture.Canvas, BRect);
end;
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Buffer);
Buffer.Free;
end;
procedure TspSkinTrackBarObject.MouseDown(X, Y: Integer; Button: TMouseButton);
var
X1, Y1: Integer;
begin
X1 := X - ObjectRect.Left;
Y1 := Y - ObjectRect.Top;
if PtInRect(CalcButtonRect(FButtonPos), Point(X1, Y1)) and (Button = mbLeft)
then
begin
MoveActive := True;
FOldMPoint.X := X1;
FOldMPoint.Y := Y1;
if not IsNullRect(ActiveButtonRect)
then Parent.DrawSkinObject(Self);
end
else
if MouseDownChangeValue and (Button = mbLeft)
then
case TrackKind of
tkHorizontal:
begin
if X1 < BeginPoint.X then X1 := BeginPoint.X;
if X1 > EndPoint.X then X1 := EndPoint.X;
ButtonPos := Point(X1, BeginPoint.Y);
end;
tkVertical:
begin
if Y1 < EndPoint.Y then Y1 := EndPoint.Y;
if Y1 > BeginPoint.Y then Y1 := BeginPoint.Y;
ButtonPos := Point(BeginPoint.X, Y1);
end;
end;
inherited MouseDown(X, Y, Button);
end;
procedure TspSkinTrackBarObject.MouseUp(X, Y: Integer; Button: TMouseButton);
begin
if MoveActive and (Button = mbLeft)
then
begin
MoveActive := False;
if not IsNullRect(ActiveButtonRect)
then
Parent.DrawSkinObject(Self);
end;
inherited MouseUp(X, Y, Button);
end;
procedure TspSkinTrackBarObject.MouseMove(X, Y: Integer);
var
X1, Y1: Integer;
TestPos: Integer;
begin
X1 := X - ObjectRect.Left;
Y1 := Y - ObjectRect.Top;
if MoveActive
then
case TrackKind of
tkHorizontal:
begin
TestPos := FButtonPos.X + X1 - FOldMPoint.X;
if (TestPos >= BeginPoint.X) and (TestPos <= EndPoint.X)
then
ButtonPos := Point(TestPos, FButtonPos.Y);
end;
tkVertical:
begin
TestPos := FButtonPos.Y + Y1 - FOldMPoint.Y;
if (TestPos >= EndPoint.Y) and (TestPos <= BeginPoint.Y)
then ButtonPos := Point(FButtonPos.X, TestPos);
end;
end;
FOldMPoint := Point(X1, Y1);
inherited MouseMove(X, Y);
end;
//============= TspSkinSwitchObject ==============//
constructor TspSkinSwitchObject.Create;
begin
inherited Create(AParent, AData);
FState := swOff;
end;
procedure TspSkinSwitchObject.SetState;
begin
FState := Value;
if FState = swOn then Active := True else Active := False;
ReDraw;
Parent.SwitchChangeStateEvent(IDName, FState);
end;
procedure TspSkinSwitchObject.SimpleSetState(Value: TSwitchState);
begin
FState := Value;
Active := FState = swOn;
if Active then FMorphKf := 1;
end;
procedure TspSkinSwitchObject.MouseDown;
begin
if Button = mbLeft
then
if State = swOff then State := swOn else State := swOff;
inherited MouseDown(X, Y, Button);
end;
procedure TspSkinSwitchObject.MouseEnter;
begin
FMouseIn := True;
Parent.MouseEnterEvent(IDName);
end;
procedure TspSkinSwitchObject.MouseLeave;
begin
FMouseIn := False;
Parent.MouseLeaveEvent(IDName);
end;
//============= TspSkinButtonObject ============= //
constructor TspSkinButtonObject.Create;
begin
inherited Create(AParent, AData);
GroupIndex := -1;
if AData <> nil
then
with TspDataSkinButton(AData) do
begin
Self.DownRect := DownRect;
Self.DisableSkinRect := DisableSkinRect;
Self.GroupIndex := GroupIndex;
end;
MenuItem := nil;
FPopupUp := False;
end;
procedure TspSkinButtonObject.Draw;
begin
if not Enabled and not IsNullRect(DisableSkinRect)
then
Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, DisableSkinRect)
else
if (FDown and not IsNullRect(DownRect)) and
((GroupIndex <> -1) or FMouseIn)
then
Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, DownRect)
else
inherited Draw(Cnvs, UpDate);
end;
procedure TspSkinButtonObject.SetDown;
procedure DoAllUp;
var
i, j: Integer;
begin
j := GroupIndex;
if j <> -1 then
for i := 0 to Parent.ObjectList.Count - 1 do
if (TspActiveSkinObject(Parent.ObjectList.Items[i]) is TspSkinButtonObject) and
(TspActiveSkinObject(Parent.ObjectList.Items[i]).IDName <> IDName)
then
with TspSkinButtonObject(Parent.ObjectList.Items[i]) do
if (j = GroupIndex) and FDown
then
begin
SetDown(False);
Break;
end;
end;
begin
FDown := Value;
if IsNullRect(DownRect) and not FDown then Exit;
if IsNullRect(DownRect) and FDown
then
begin
DoAllUp;
Exit;
end
else
if FDown
then
begin
if Morphing then MorphKf := 1;
Parent.DrawSkinObject(Self);
DoAllUp;
end
else
begin
if (GroupIndex <> -1) or (MenuItem <> nil) then Active := False;
if Morphing and not IsNullRect(DownRect)
then
Parent.DrawSkinObject(Self);
ReDraw;
end;
end;
procedure TspSkinButtonObject.TrackMenu;
var
R: TRect;
Menu: TMenu;
P: TPoint;
begin
if MenuItem = nil then Exit;
if MenuItem.Count = 0 then Exit;
R := ObjectRect;
if Parent.FForm.FormStyle = fsMDIChild
then
begin
if Parent.FSkinSupport
then
P := Point(-Parent.NewClRect.Left, -Parent.NewClRect.Top)
else
P := Point(- 3, -Parent.GetDefCaptionHeight - 3);
P := Parent.FForm.ClientToScreen(P);
OffsetRect(R, P.X, P.Y);
end
else
OffsetRect(R, Parent.FForm.Left, Parent.FForm.Top);
Menu := MenuItem.GetParentMenu;
if Menu is TspSkinPopupMenu
then
TspSkinPopupMenu(Menu).PopupFromRect(R, FPopupUp)
else
begin
Parent.SkinMenuOpen;
if Menu is TspSkinMainMenu
then
Parent.SkinMenu.Popup(nil, TspSkinMainMenu(Menu).SkinData, 0, R, MenuItem, FPopupUp)
else
if Parent.MenusSkinData = nil
then
Parent.SkinMenu.Popup(nil, Parent.SkinData, 0, R, MenuItem, FPopupUp)
else
Parent.SkinMenu.Popup(nil, Parent.MenusSkinData, 0, R, MenuItem, FPopupUp);
end;
end;
procedure TspSkinButtonObject.MouseDown;
begin
if not Enabled then Exit;
if (Button = mbLeft) and not FDown
then
begin
SetDown(True);
TrackMenu;
end;
inherited MouseDown(X, Y, Button);
end;
procedure TspSkinButtonObject.MouseUp;
begin
if not Enabled then Exit;
if (Button <> mbLeft)
then
begin
inherited MouseUp(X, Y, Button);
Exit;
end;
if (MenuItem = nil) and FDown and (GroupIndex = -1)
then
SetDown(False);
inherited MouseUp(X, Y, Button);
end;
procedure TspSkinButtonObject.MouseEnter;
begin
FMouseIn := True;
Active := True;
if IsNullRect(DownRect) or not FDown
then
begin
if not IsNullRect(ActiveSkinRect) then ReDraw;
end
else
if not (FDown and (GroupIndex <> -1))
then
begin
if FDown
then
Parent.DrawSkinObject(Self)
else
if not IsNullRect(ActiveSkinRect) and (GroupIndex = -1) then ReDraw;
end;
Parent.MouseEnterEvent(IDName);
end;
procedure TspSkinButtonObject.MouseLeave;
begin
FMouseIn := False;
if not (FDown and not IsNullRect(DownRect) and
((MenuItem <> nil) or (GroupIndex <> -1)))
then
begin
Active := False;
if Morphing and FDown then Morphkf := 1;
if (not IsNullRect(ActiveSkinRect)) or
(not IsNullRect(DownRect) and (GroupIndex = -1)) then Redraw;
end;
Parent.MouseLeaveEvent(IDName);
end;
//============= TspSkinStdButtonObject =================//
constructor TspSkinStdButtonObject.Create;
begin
inherited Create(AParent, AData);
if AData <> nil
then
with TspDataSkinStdButton(AData) do
begin
Self.Command := Command;
Self.RestoreRect := RestoreRect;
Self.RestoreActiveRect := RestoreActiveRect;
Self.RestoreDownRect := RestoreDownRect;
FSkinSupport := True;
end
else
FSkinSupport := False;
end;
procedure TspSkinStdButtonObject.DefaultDraw(Cnvs: TCanvas);
var
Buffer: TBitMap;
R: TRect;
IX, IY: Integer;
IC: TColor;
begin
if (Command = cmSysMenu) and Parent.FShowIcon
then
begin
Parent.DrawFormIcon(Cnvs, ObjectRect.Left, ObjectRect.Top);
Exit;
end;
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(ObjectRect);
Buffer.Height := RectHeight(ObjectRect);
R := Rect(0, 0, Buffer.Width, Buffer.Height);
with Buffer.Canvas do
begin
if FDown and FMouseIn
then
begin
Frame3D(Buffer.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Brush.Color := SP_XP_BTNDOWNCOLOR;
FillRect(R);
end
else
if FMouseIn
then
begin
Frame3D(Buffer.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Brush.Color := SP_XP_BTNACTIVECOLOR;
FillRect(R);
end
else
begin
Brush.Color := clBtnFace;
FillRect(R);
end;
end;
IX := Buffer.Width div 2 - 5;
IY := Buffer.Height div 2 - 4;
if FDown and FMouseIn
then
begin
Inc(IX);
Inc(IY);
end;
if Enabled
then
IC := clBtnText
else
IC := clBtnShadow;
case Command of
cmClose:
DrawCloseImage(Buffer.Canvas, IX, IY, IC);
cmMaximize:
if Parent.WindowState = wsMaximized
then DrawRestoreImage(Buffer.Canvas, IX, IY, IC)
else DrawMaximizeImage(Buffer.Canvas, IX, IY, IC);
cmMinimize:
if Parent.WindowState = wsMinimized
then DrawRestoreImage(Buffer.Canvas, IX, IY, IC)
else DrawMinimizeImage(Buffer.Canvas, IX, IY, IC);
cmRollUp:
if Parent.RollUpState
then DrawRollUpImage(Buffer.Canvas, IX, IY, IC)
else DrawRestoreRollUpImage(Buffer.Canvas, IX, IY, IC);
cmSysMenu:
DrawSysMenuImage(Buffer.Canvas, IX, IY, IC);
end;
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Buffer);
Buffer.Free;
end;
function TspSkinStdButtonObject.CanMorphing: Boolean;
begin
if (Command = cmSysMenu) and Parent.ShowIcon and
(SkinRectInAPicture)
then
Result := False
else
Result := inherited CanMorphing;
end;
procedure TspSkinStdButtonObject.Draw;
procedure CreateRestoreObjectImage(B: TBitMap; AActive: Boolean);
begin
B.Width := RectWidth(ObjectRect);
B.Height := RectHeight(ObjectRect);
with B.Canvas do
begin
if AActive
then
CopyRect(Rect(0, 0, B.Width, B.Height), ActivePicture.Canvas, RestoreActiveRect)
else
CopyRect(Rect(0, 0, B.Width, B.Height), ActivePicture.Canvas, RestoreRect);
end;
end;
var
PBuffer, APBuffer: TspEffectBmp;
Buffer, ABuffer: TBitMap;
ASR, SR: TRect;
FRestoreMode: Boolean;
begin
if not FSkinSupport
then
begin
DefaultDraw(Cnvs);
Exit;
end;
if not Enabled
then
begin
inherited;
Exit;
end;
if (Command = cmSysMenu) and Parent.FShowIcon and SkinRectInAPicture
then
begin
Parent.DrawFormIcon(Cnvs, ObjectRect.Left, ObjectRect.Top);
FMorphKf := 0;
Exit;
end;
FRestoreMode := False;
case Command of
cmMaximize:
if Parent.WindowState = wsMaximized
then FRestoreMode := True;
cmMinimize:
if Parent.WindowState = wsMinimized
then FRestoreMode := True;
cmRollUp:
if Parent.RollUpState
then FRestoreMode := True;
end;
if IsNullRect(RestoreRect) or not FRestoreMode
then
inherited
else
begin
if FDown and not IsNullRect(RestoreDownRect) and FMouseIn
then
Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, RestoreDownRect)
else
begin
ASR := RestoreActiveRect;
SR := RestoreRect;
if not Morphing or
((Active and (MorphKf = 1)) or (not Active and (MorphKf = 0)))
then
begin
if Active and not IsNullRect(ASR)
then
Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, ASR)
else
Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, SR);
end
else
begin
Buffer := TBitMap.Create;
ABuffer := TBitMap.Create;
CreateRestoreObjectImage(Buffer, False);
CreateRestoreObjectImage(ABuffer, True);
PBuffer := TspEffectBmp.CreateFromhWnd(Buffer.Handle);
APBuffer := TspEffectBmp.CreateFromhWnd(ABuffer.Handle);
case MorphKind of
mkDefault: PBuffer.Morph(APBuffer, MorphKf);
mkGradient: PBuffer.MorphGrad(APBuffer, MorphKf);
mkLeftGradient: PBuffer.MorphLeftGrad(APBuffer, MorphKf);
mkRightGradient: PBuffer.MorphRightGrad(APBuffer, MorphKf);
mkLeftSlide: PBuffer.MorphLeftSlide(APBuffer, MorphKf);
mkRightSlide: PBuffer.MorphRightSlide(APBuffer, MorphKf);
mkPush: PBuffer.MorphPush(APBuffer, MorphKf);
end;
PBuffer.Draw(Cnvs.Handle, ObjectRect.Left, ObjectRect.Top);
PBuffer.Free;
APBuffer.Free;
Buffer.Free;
ABuffer.Free;
end;
end;
end;
end;
procedure TspSkinStdButtonObject.DoMax;
begin
if Parent.SupportNCArea
then
begin
if Parent.WindowState = wsMaximized
then Parent.WindowState := wsNormal
else Parent.WindowState := wsMaximized;
end
else
if Parent.WindowState <> wsMaximized
then Parent.WindowState := wsMaximized
else Parent.WindowState := wsNormal;
end;
procedure TspSkinStdButtonObject.DoMin;
begin
if Parent.SupportNCArea
then
begin
if Parent.WindowState = wsMinimized
then Parent.WindowState := wsNormal
else Parent.WindowState := wsMinimized;
end
else
Parent.WindowState := wsMinimized;
end;
procedure TspSkinStdButtonObject.DoClose;
begin
Parent.FForm.Close;
end;
procedure TspSkinStdButtonObject.DoRollUp;
begin
Parent.RollUpState := not Parent.RollUpState;
end;
procedure TspSkinStdButtonObject.DoCommand;
begin
case Command of
cmClose: DoClose;
cmMinimize: DoMin;
cmMaximize: DoMax;
cmRollUp: DoRollUp;
end;
end;
procedure TspSkinStdButtonObject.DblClick;
begin
if Command = cmSysMenu then DoClose;
end;
procedure TspSkinStdButtonObject.MouseDown ;
begin
if not Enabled then Exit;
if (Button = mbLeft) and not FDown
then
begin
SetDown(True);
if (Command = cmSysMenu)
then
begin
Self.MenuItem := Parent.GetSystemMenu;
TrackMenu;
end;
end;
end;
procedure TspSkinStdButtonObject.MouseUp;
begin
if (Command = cmClose)
then
begin
inherited;
if Active and (Button = mbLeft) then DoCommand;
end
else
begin
if Active and (Button = mbLeft) then DoCommand;
inherited;
end;
end;
//==============TspSkinMainMenuItem=============//
constructor TspSkinMainMenuItem.Create;
begin
inherited Create(AParent, AData);
with TspDataSkinMainMenuItem(AData) do
begin
Self.FontName := FontName;
Self.FontHeight := FontHeight;
Self.FontStyle := FontStyle;
Self.FontColor := FontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.DownFontColor := DownFontColor;
Self.TextRct := TextRct;
Self.DownRect := DownRect;
Self.LO := ItemLO;
Self.RO := ItemRO;
end;
if IsNullRect(DownRect) then
if IsNullRect(ActiveSkinRect)
then DownRect := SkinRect else DownRect := ActiveSkinRect;
if IsNullRect(ActiveSkinRect) then Morphing := False;
OldEnabled := Enabled;
Visible := True;
end;
procedure TspSkinMainMenuItem.SetDown;
begin
FDown := Value;
if FDown
then
begin
Parent.DrawSkinObject(Self);
TrackMenu;
if not Parent.InMainMenu
then
begin
Parent.InMainMenu := True;
if Assigned(Parent.FOnMainMenuEnter) then Parent.FOnMainMenuEnter(Parent);
end;
end
else
begin
Active := False;
if Morphing then MorphKf := 1;
ReDraw;
end;
end;
procedure TspSkinMainMenuItem.SearchActive;
var
i: Integer;
begin
for i := 0 to Parent.ObjectList.Count - 1 do
if (TspActiveSkinObject(Parent.ObjectList.Items[i]) is TspSkinMainMenuItem)
and (TspSkinMainMenuItem(Parent.ObjectList.Items[i]).IDName <> IDName)
and (TspSkinMainMenuItem(Parent.ObjectList.Items[i]).Active)
then
begin
TspSkinMainMenuItem(Parent.ObjectList.Items[i]).MouseLeave;
Break;
end;
end;
function TspSkinMainMenuItem.SearchDown;
var
i: Integer;
begin
Result := False;
for i := 0 to Parent.ObjectList.Count - 1 do
if (TspActiveSkinObject(Parent.ObjectList.Items[i]) is TspSkinMainMenuItem)
and (TspSkinMainMenuItem(Parent.ObjectList.Items[i]).IDName <> IDName)
and (TspSkinMainMenuItem(Parent.ObjectList.Items[i]).FDown)
then
begin
TspSkinMainMenuItem(Parent.ObjectList.Items[i]).SetDown(False);
Result := True;
Break;
end;
end;
procedure TspSkinMainMenuItem.Draw;
function CalcObjectRect(Cnvs: TCanvas): TRect;
var
w, i, j: Integer;
R, TR: TRect;
begin
w := TextRct.Left + RectWidth(SkinRect) - TextRct.Right;
with Cnvs do
begin
Font.Name := FontName;
Font.Style := FontStyle;
Font.Height := FontHeight;
end;
TR := Rect(0, 0, 0, 0);
DrawText(Cnvs.Handle, PChar(MenuItem.Caption),
Length(MenuItem.Caption), TR, DT_CALCRECT or DT_CENTER);
w := w + RectWidth(TR) + 2;
R := Rect(0, 0, 0, 0);
j := Parent.ObjectList.IndexOf(Self);
for i := j - 1 downto 0 do
if TspActiveSkinObject(Parent.ObjectList.Items[i]) is TspSkinMainMenuItem
then
begin
R.Left := TspActiveSkinObject(Parent.ObjectList.Items[i]).ObjectRect.Right;
Break;
end;
if R.Left = 0 then R.Left := Parent.NewMainMenuRect.Left;
R.Top := Parent.NewMainMenuRect.Top;
R.Right := R.Left + w;
R.Bottom := R.Top + RectHeight(SkinRect);
TempObjectRect := NullRect;
with Parent do
begin
if SupportNCArea and not UpDate and (R.Top > NewClRect.Bottom)
then
begin
TempObjectRect := R;
OffsetRect(R, 0, -NewClRect.Bottom);
end;
end;
Result := R;
end;
procedure CreateItemImage(B: TBitMap; Rct: TRect; AActive: Boolean);
var
XO, w, XCnt: Integer;
TR: TRect;
X: Integer;
begin
B.Width := RectWidth(ObjectRect);
B.Height := RectHeight(ObjectRect);
with B.Canvas do
begin
if LO <> 0 then
CopyRect(Rect(0, 0, LO, B.Height), ActivePicture.Canvas,
Rect(Rct.Left, Rct.Top, Rct.Left + LO, Rct.Bottom));
if RO <> 0 then
CopyRect(Rect(B.Width - RO, 0, B.Width, B.Height),
ActivePicture.Canvas,
Rect(Rct.Right - RO, Rct.Top, Rct.Right, Rct.Bottom));
Inc(Rct.Left, LO);
Dec(Rct.Right, RO);
w := RectWidth(Rct);
XCnt := (B.Width - LO - RO) div w;
for X := 0 to XCnt do
begin
if LO + X * w + w > B.Width - RO
then XO := LO + X * w + w - (B.Width - RO)
else XO := 0;
B.Canvas.CopyRect(Rect(LO + X * w, 0, LO + X * w + w - XO,
B.Height),
ActivePicture.Canvas,
Rect(Rct.Left, Rct.Top, Rct.Right - XO, Rct.Bottom));
end;
Brush.Style := bsClear;
if FDown
then
Font.Color := DownFontColor
else
if AActive
then Font.Color := ActiveFontColor
else
if MenuItem.Enabled
then Font.Color := FontColor
else Font.Color := UnEnabledFontColor;
Font.Name := FontName;
Font.Style := FontStyle;
Font.Height := FontHeight;
TR := TextRct;
DrawText(B.Canvas.Handle, PChar(MenuItem.Caption),
Length(MenuItem.Caption), TR, DT_CALCRECT);
Inc(TR.Right, 2);
DrawText(B.Canvas.Handle, PChar(MenuItem.Caption),
Length(MenuItem.Caption), TR, DT_CENTER or DT_VCENTER);
end;
end;
var
Buffer, ABuffer: TBitMap;
PBuffer, APBuffer: TspEffectBmp;
begin
if IsNullRect(SkinRect) or IsNullRect(TextRct) then Exit;
Buffer := TBitMap.Create;
ObjectRect := CalcObjectRect(Buffer.Canvas);
if ObjectRect.Right > Parent.NewMainMenuRect.Right
then
begin
if Visible
then
begin
OldEnabled := Enabled;
Enabled := False;
Visible := False;
end;
Buffer.Free;
Exit;
end
else
if not Visible
then
begin
Visible := True;
Enabled := OldEnabled;
end;
if FDown
then
begin
CreateItemImage(Buffer, DownRect, True);
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Buffer);
end
else
if not Morphing or
((Active and (MorphKf = 1)) or (not Active and (MorphKf = 0)))
then
begin
if Active
then
begin
if isNullRect(ActiveSkinRect)
then
CreateItemImage(Buffer, SkinRect, True)
else
CreateItemImage(Buffer, ActiveSkinRect, True);
end
else CreateItemImage(Buffer, SkinRect, False);
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Buffer);
end
else
begin
CreateItemImage(Buffer, SkinRect, False);
ABuffer := TBitMap.Create;
CreateItemImage(ABuffer, ActiveSkinRect, True);
PBuffer := TspEffectBmp.CreateFromhWnd(Buffer.Handle);
APBuffer := TspEffectBmp.CreateFromhWnd(ABuffer.Handle);
case MorphKind of
mkDefault: PBuffer.Morph(APBuffer, MorphKf);
mkGradient: PBuffer.MorphGrad(APBuffer, MorphKf);
mkLeftGradient: PBuffer.MorphLeftGrad(APBuffer, MorphKf);
mkRightGradient: PBuffer.MorphRightGrad(APBuffer, MorphKf);
mkLeftSlide: PBuffer.MorphLeftSlide(APBuffer, MorphKf);
mkRightSlide: PBuffer.MorphRightSlide(APBuffer, MorphKf);
mkPush: PBuffer.MorphPush(APBuffer, MorphKf);
end;
PBuffer.Draw(Cnvs.Handle, ObjectRect.Left, ObjectRect.Top);
PBuffer.Free;
APBuffer.Free;
ABuffer.Free;
end;
Buffer.Free;
with Parent do
begin
if SupportNCArea and not UpDate and not IsNullRect(TempObjectRect)
then
ObjectRect := TempObjectRect;
end;
end;
procedure TspSkinMainMenuItem.MouseEnter;
begin
if SearchDown
then
begin
Active := True;
FMouseIn := True;
if Morphing then MorphKf := 1;
SetDown(True);
end
else
begin
SearchActive;
FMouseIn := True;
Active := True;
ReDraw;
end;
end;
procedure TspSkinMainMenuItem.MouseLeave;
begin
Active := False;
FMouseIn := False;
if Morphing and FDown then MorphKf := 0;
Redraw;
Parent.MouseLeaveEvent(IDName);
end;
procedure TspSkinMainMenuItem.TrackMenu;
var
R: TRect;
Menu: TMenu;
P: TPoint;
begin
Parent.SkinMenuOpen;
R := ObjectRect;
if Parent.FForm.FormStyle = fsMDIChild
then
begin
if Parent.FSkinSupport
then
P := Point(-Parent.NewClRect.Left, -Parent.NewClRect.Top)
else
P := Point(- 3, -Parent.GetDefCaptionHeight - 3);
P := Parent.FForm.ClientToScreen(P);
OffsetRect(R, P.X, P.Y);
end
else
OffsetRect(R, Parent.FForm.Left, Parent.FForm.Top);
Menu := MenuItem.GetParentMenu;
if (Menu is TspSkinMainMenu) and (TspSkinMainMenu(Menu).SkinData <> nil)
then
Parent.SkinMenu.Popup(nil, TspSkinMainMenu(Menu).SkinData, 0, R, MenuItem,
TspSkinMainMenu(Menu).SkinData.MainMenuPopupUp)
else
if Parent.MenusSkinData = nil
then
Parent.SkinMenu.Popup(nil, Parent.SkinData, 0, R, MenuItem, Parent.FSD.MainMenuPopupUp)
else
Parent.SkinMenu.Popup(nil, Parent.MenusSkinData, 0, R, MenuItem, Parent.FSD.MainMenuPopupUp);
end;
procedure TspSkinMainMenuItem.MouseDown;
var
Menu: TMenu;
begin
if not Enabled then Exit;
if Button = mbLeft
then
begin
if MenuItem.Count <> 0 then SetDown(True)
else
begin
SetDown(False);
Parent.InMenu := False;
Menu := MenuItem.GetParentMenu;
Menu.DispatchCommand(MenuItem.Command);
end;
end;
inherited MouseDown(X, Y, Button);
end;
//==============TspSkinFrameObject===============//
constructor TspSkinFrameObject.Create;
begin
inherited;
FFrame := 1;
end;
procedure TspSkinFrameObject.SetFrame(Value: Integer);
begin
if Value < CountFrames then FFrame := Value;
Parent.DrawSkinObject(Self);
end;
procedure TspSkinFrameObject.Draw;
var
R: TRect;
begin
case FramesPlacement of
fpHorizontal:
R := Rect(ActiveSkinRect.Left + (FFrame - 1) * FrameW, ActiveSkinRect.Top,
ActiveSkinRect.Left + FFrame * FrameW,
ActiveSkinRect.Top + FrameH);
fpVertical:
R := Rect(ActiveSkinRect.Left, ActiveSkinRect.Top + (FFrame - 1) * FrameH,
ActiveSkinRect.Left + FrameW,
ActiveSkinRect.Top + FFrame * FrameH);
end;
Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, R);
end;
//=================TspSkinFrameGaugeObject=================//
constructor TspSkinFrameGaugeObject.Create;
begin
inherited;
FValue := 0;
with TspDataSkinFrameGaugeObject(AData) do
begin
Self.MinValue := MinValue;
Self.MaxValue := MaxValue;
Self.CountFrames := CountFrames;
Self.FramesPlacement := FramesPlacement;
end;
if CountFrames > 0 then
case FramesPlacement of
fpHorizontal:
begin
FrameW := RectWidth(ActiveSkinRect) div CountFrames;
FrameH := RectHeight(ActiveSkinRect);
end;
fpVertical:
begin
FrameH := RectHeight(ActiveSkinRect) div CountFrames;
FrameW := RectWidth(ActiveSkinRect);
end;
end;
end;
procedure TspSkinFrameGaugeObject.MouseEnter;
begin
FMouseIn := True;
Active := True;
Parent.MouseEnterEvent(IDName);
end;
procedure TspSkinFrameGaugeObject.MouseLeave;
begin
FMouseIn := False;
Active := False;
Parent.MouseLeaveEvent(IDName);
end;
procedure TspSkinFrameGaugeObject.SimplySetValue;
begin
if (FValue = AValue) or (AValue > MaxValue) or
(AValue < MinValue) then Exit;
FValue := AValue;
end;
procedure TspSkinFrameGaugeObject.SetValue;
begin
if (FValue = AValue) or (AValue > MaxValue) or
(AValue < MinValue) then Exit;
FValue := AValue;
Parent.DrawSkinObject(Self);
end;
function TspSkinFrameGaugeObject.CalcFrame;
var
FValInc: Integer;
begin
FValInc := (MaxValue - MinValue) div (CountFrames - 1);
if FValInc = 0
then
Result := 1
else
Result := Abs(FValue - MinValue) div FValInc + 1;
end;
procedure TspSkinFrameGaugeObject.Draw;
begin
if CountFrames > 1 then FFrame := CalcFrame else FFrame := 1;
inherited;
end;
//==============TspSkinFrameRegulatorObject================//
constructor TspSkinFrameRegulatorObject.Create;
begin
inherited;
FValue := 0;
with TspDataSkinFrameregulatorObject(AData) do
begin
Self.MinValue := MinValue;
Self.MaxValue := MaxValue;
Self.CountFrames := CountFrames;
Self.FramesPlacement := FramesPlacement;
Self.Kind := Kind;
end;
if CountFrames > 0 then
case FramesPlacement of
fpHorizontal:
begin
FrameW := RectWidth(ActiveSkinRect) div CountFrames;
FrameH := RectHeight(ActiveSkinRect);
end;
fpVertical:
begin
FrameH := RectHeight(ActiveSkinRect) div CountFrames;
FrameW := RectWidth(ActiveSkinRect);
end;
end;
if FValue < MinValue then FValue := MinValue;
if FValue > MaxValue then FValue := MaxValue;
end;
procedure TspSkinFrameRegulatorObject.CalcValue;
var
Offset: Integer;
Plus: Boolean;
FW: Integer;
begin
FW := 0;
case Kind of
rkRound: if FrameW > FrameH then FW := FrameH else FW := FrameW;
rkVertical: FW := FrameH;
rkHorizontal: FW := FrameW;
end;
FPixInc := FW div (CountFrames - 1);
FValInc := (MaxValue - MinValue) div (CountFrames - 1);
if FPixInc = 0 then FPixInc := 1;
if FValInc = 0 then FValInc := 1;
Plus := CurV >= StartV;
if Plus
then Offset := CurV - StartV
else Offset := StartV - CurV;
if Offset >= FPixInc
then
begin
StartV := CurV;
if Plus
then TempValue := TempValue + FValInc
else TempValue := TempValue - FValInc;
if TempValue < MinValue then TempValue := MinValue;
if TempValue > MaxValue then TempValue := MaxValue;
Value := TempValue;
end;
end;
procedure TspSkinFrameRegulatorObject.SetValue;
begin
if (FValue = AValue) or (AValue > MaxValue) or
(AValue < MinValue) then Exit;
FValue := AValue;
Parent.DrawSkinObject(Self);
Parent.FrameRegulatorChangeValueEvent(IDName, FValue);
end;
procedure TspSkinFrameRegulatorObject.SimplySetValue;
begin
if (FValue = AValue) or (AValue > MaxValue) or
(AValue < MinValue) then Exit;
FValue := AValue;
Parent.FrameRegulatorChangeValueEvent(IDName, FValue);
end;
function TspSkinFrameRegulatorObject.CalcFrame;
var
FValInc: Integer;
begin
FValInc := (MaxValue - MinValue) div (CountFrames - 1);
if FValInc = 0
then
Result := 1
else
Result := Abs(FValue - MinValue) div FValInc + 1;
end;
procedure TspSkinFrameRegulatorObject.Draw;
begin
if CountFrames > 1 then FFrame := CalcFrame else FFrame := 1;
inherited;
end;
procedure TspSkinFrameRegulatorObject.MouseDown(X, Y: Integer; Button: TMouseButton);
var
X1, Y1: Integer;
begin
X1 := X - ObjectRect.Left;
Y1 := Y - ObjectRect.Top;
FDown := True;
TempValue := FValue;
case Kind of
rkRound: StartV := X1 - Y1;
rkVertical: StartV := -Y1;
rkHorizontal: StartV := X1;
end;
inherited MouseDown(X, Y, Button);
end;
procedure TspSkinFrameRegulatorObject.MouseUp(X, Y: Integer; Button: TMouseButton);
begin
FDown := False;
inherited MouseUp(X, Y, Button);
end;
procedure TspSkinFrameRegulatorObject.MouseMove(X, Y: Integer);
var
X1, Y1: Integer;
begin
X1 := X - ObjectRect.Left;
Y1 := Y - ObjectRect.Top;
if FDown
then
begin
case Kind of
rkRound: CurV := X1 - Y1;
rkVertical: CurV := -Y1;
rkHorizontal: CurV := X1;
end;
CalcValue;
end;
inherited MouseMove(X, Y);
end;
//==============TspSkinAnimateObject==================//
constructor TspSkinAnimateObject.Create;
begin
inherited Create(AParent, AData);
Increment := True;
FFrame := 1;
FInc := AnimateTimerInterval;
TimerInterval := TspDataSkinAnimate(AData).TimerInterval;
if TimerInterval < FInc then TimerInterval := FInc;
with TspDataSkinAnimate(AData) do
begin
Self.CountFrames := CountFrames;
Self.Cycle := Cycle;
Self.ButtonStyle := ButtonStyle;
Self.Command := Command;
end;
FPopupUp := False;
MenuItem := nil;
end;
procedure TspSkinAnimateObject.DoMax;
begin
if Parent.SupportNCArea
then
begin
if Parent.WindowState = wsMaximized
then Parent.WindowState := wsNormal
else Parent.WindowState := wsMaximized;
end
else
if Parent.WindowState <> wsMaximized
then Parent.WindowState := wsMaximized
else Parent.WindowState := wsNormal;
end;
procedure TspSkinAnimateObject.DoMin;
begin
if Parent.SupportNCArea
then
begin
if Parent.WindowState = wsMinimized
then Parent.WindowState := wsNormal
else Parent.WindowState := wsMinimized;
end
else
Parent.WindowState := wsMinimized;
end;
procedure TspSkinAnimateObject.DoClose;
begin
Parent.FForm.Close;
end;
procedure TspSkinAnimateObject.DoRollUp;
begin
Parent.RollUpState := not Parent.RollUpState;
end;
procedure TspSkinAnimateObject.DoCommand;
begin
case Command of
cmClose: DoClose;
cmMinimize: DoMin;
cmMaximize: DoMax;
cmSysMenu:
begin
MenuItem := Parent.GetSystemMenu;
TrackMenu;
end;
cmDefault:
if MenuItem <> nil then TrackMenu;
cmRollUp: DoRollUp;
end;
end;
procedure TspSkinAnimateObject.TrackMenu;
var
R: TRect;
Menu: TMenu;
P: TPoint;
begin
if MenuItem = nil then Exit;
if MenuItem.Count = 0 then Exit;
R := ObjectRect;
if Parent.FForm.FormStyle = fsMDIChild
then
begin
if Parent.FSkinSupport
then
P := Point(-Parent.NewClRect.Left, -Parent.NewClRect.Top)
else
P := Point(- 3, -Parent.GetDefCaptionHeight - 3);
P := Parent.FForm.ClientToScreen(P);
OffsetRect(R, P.X, P.Y);
end
else
OffsetRect(R, Parent.FForm.Left, Parent.FForm.Top);
Menu := MenuItem.GetParentMenu;
if Menu is TspSkinPopupMenu
then
TspSkinPopupMenu(Menu).PopupFromRect(R, FPopupUp)
else
begin
Parent.SkinMenuOpen;
if Parent.MenusSkinData = nil
then
Parent.SkinMenu.Popup(nil, Parent.SkinData, 0, R, MenuItem, FPopupUp)
else
Parent.SkinMenu.Popup(nil, Parent.MenusSkinData, 0, R, MenuItem, FPopupUp);
end;
end;
procedure TspSkinAnimateObject.DblCLick;
begin
if Command = cmSysMenu then DoClose;
end;
procedure TspSkinAnimateObject.MouseUp;
begin
inherited;
if FMouseIn and ButtonStyle and (Button = mbLeft)
then DoCommand;
end;
procedure TspSkinAnimateObject.SetFrame;
begin
if Increment
then
begin
if Value > CountFrames then FFrame := 1 else FFrame := Value;
end
else
begin
if Value < 1 then FFrame := CountFrames else FFrame := Value;
end;
Parent.DrawSkinObject(Self);
end;
procedure TspSkinAnimateObject.Start;
begin
FInc := AnimateTimerInterval;
FFrame := 1;
Active := True;
if not Parent.AnimateTimer.Enabled
then
Parent.AnimateTimer.Enabled := True;
end;
procedure TspSkinAnimateObject.Stop;
begin
Frame := 1;
Active := False;
FInc := AnimateTimerInterval;
end;
procedure TspSkinAnimateObject.ChangeFrame;
begin
if FInc >= TimerInterval
then
begin
if Increment
then
begin
Frame := Frame + 1;
if not Cycle and (FFrame = CountFrames) then Active := False;
end
else
begin
Frame := Frame - 1;
if FFrame = 1 then Active := False;
end;
FInc := AnimateTimerInterval;
end
else
Inc(FInc, AnimateTimerInterval);
end;
procedure TspSkinAnimateObject.MouseEnter;
begin
FMouseIn := True;
if ButtonStyle
then
begin
Active := True;
Increment := True;
if not Parent.AnimateTimer.Enabled
then
Parent.AnimateTimer.Enabled := True;
end;
Parent.MouseEnterEvent(IDName);
end;
procedure TspSkinAnimateObject.MouseLeave;
begin
FMouseIn := False;
if ButtonStyle
then
begin
Active := True;
Increment := False;
if not Parent.AnimateTimer.Enabled
then
Parent.AnimateTimer.Enabled := True;
end;
Parent.MouseLeaveEvent(IDName);
end;
procedure TspSkinAnimateObject.Draw;
var
FW, FH: Integer;
begin
FW := RectWidth(SkinRect);
FH := RectHeight(SkinRect);
Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas,
Rect(ActiveSkinRect.Left + (FFrame - 1) * FW, ActiveSkinRect.Top,
ActiveSkinRect.Left + FFrame * FW,
ActiveSkinRect.Top + FH));
end;
//==============TspSkinGaugeObject====================//
constructor TspSkinGaugeObject.Create;
begin
inherited Create(AParent, AData);
with TspDataSkinGauge(AData) do
begin
Self.MinValue := MinValue;
Self.MaxValue := MaxValue;
Self.Kind := Kind;
end;
FValue := MinValue;
FProgressPos := CalcProgressPos;
FOldProgressPos := FProgressPos;
end;
function TspSkinGaugeObject.CalcProgressPos;
var
kf: Double;
begin
kf := (FValue - MinValue) / (MaxValue - MinValue);
case Kind of
gkHorizontal:
Result := Point(Round(RectWidth(SkinRect) * kf), 0);
gkVertical:
Result := Point(0, Round(RectHeight(SkinRect) * (1 - kf)));
end;
end;
procedure TspSkinGaugeObject.SimplySetValue;
begin
if FValue <> AValue
then
begin
FValue := AValue;
if FValue < MinValue then FValue := MinValue;
if FValue > MaxValue then FValue := MaxValue;
FOldProgressPos := FProgressPos;
FProgressPos := CalcProgressPos;
end;
end;
procedure TspSkinGaugeObject.SetValue;
begin
SimplySetValue(AValue);
Parent.DrawSkinObject(Self);
end;
procedure TspSkinGaugeObject.Draw;
var
Buffer: TbitMap;
begin
if (FValue = MinValue) and not UpDate
then
Exit
else
begin
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(ObjectRect);
Buffer.Height := RectHeight(ObjectRect);
case Kind of
gkHorizontal:
with Buffer do
begin
Canvas.CopyRect(Rect(FProgressPos.X, 0, Width, Height),
Picture.Canvas,
Rect(SkinRect.Left + FProgressPos.X,
SkinRect.Top,
SkinRect.Right, SkinRect.Bottom));
Canvas.CopyRect(Rect(0, 0, FProgressPos.X, Height),
ActivePicture.Canvas,
Rect(ActiveSkinRect.Left, ActiveSkinRect.Top,
ActiveSkinRect.Left + FProgressPos.X,
ActiveSkinRect.Bottom));
end;
gkVertical:
with Buffer do
begin
Canvas.CopyRect(Rect(0, 0, Width, FProgressPos.Y),
Picture.Canvas,
Rect(SkinRect.Left, SkinRect.Top,
SkinRect.Right,
SkinRect.Top + FProgressPos.Y));
Canvas.CopyRect(Rect(0, FProgressPos.Y, Width, Height),
ActivePicture.Canvas,
Rect(ActiveSkinRect.Left,
ActiveSkinRect.Top + FProgressPos.Y,
ActiveSkinRect.Right, ActiveSkinRect.Bottom));
end;
end;
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Buffer);
Buffer.Free;
end;
end;
procedure TspSkinGaugeObject.MouseEnter;
begin
FMouseIn := True;
Active := True;
Parent.MouseEnterEvent(IDName);
end;
procedure TspSkinGaugeObject.MouseLeave;
begin
FMouseIn := False;
Active := False;
Parent.MouseLeaveEvent(IDName);
end;
//==============TspSkinBitLabelObject=================//
constructor TspSkinBitLabelObject.Create;
begin
inherited Create(AParent, AData);
with TspDataSkinBitLabel(AData) do
begin
FTextValue := TextValue;
Self.SymbolWidth := SymbolWidth;
Self.SymbolHeight := SymbolHeight;
Self.Symbols := Symbols;
end;
end;
procedure TspSkinBitLabelObject.Draw;
var
Buffer: TBitMap;
SymbolX, SymbolY: Integer;
procedure GetSymbolPos(Ch: Char);
var
i, j: Integer;
begin
SymbolX := -1;
SymbolY := -1;
for i := 0 to Symbols.Count - 1 do
begin
j := Pos(Ch, Symbols[i]);
if j <> 0
then
begin
SymbolX := j - 1;
SymbolY := i;
Exit;
end;
end;
end;
var
i: Integer;
XO: Integer;
begin
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(SkinRect);
Buffer.Height := RectHeight(SkinRect);
with Buffer.Canvas do
begin
CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
Picture.Canvas, SkinRect);
for i := 1 to Length(FTextValue) do
begin
if (i * SymbolWidth) > Buffer.Width
then XO := i * SymbolWidth - Buffer.Width
else XO := 0;
GetSymbolPos(FTextValue[i]);
if SymbolX <> -1
then
begin
Buffer.Canvas.CopyRect(
Rect((i - 1) * SymbolWidth, 0, i * SymbolWidth - XO, SymbolHeight),
ActivePicture.Canvas,
Rect(ActiveSkinRect.Left + SymbolX * SymbolWidth,
ActiveSkinRect.Top + SymbolY * SymbolHeight,
ActiveSkinRect.Left + (SymbolX + 1) * SymbolWidth - XO,
ActiveSkinRect.Top + (SymbolY + 1) * SymbolHeight));
if XO > 0 then Break;
end;
end;
end;
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Buffer);
Buffer.Free;
end;
procedure TspSkinBitLabelObject.SetTextValue;
begin
FTextValue := AValue;
if AUpDate then Parent.DrawSkinObject(Self);
end;
//==============TspSkinLabelObject ===================//
constructor TspSkinLabelObject.Create;
begin
inherited Create(AParent, AData);
with TspDataSkinLabel(AData) do
begin
Self.FTextValue := TextValue;
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.FontColor := FontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.Alignment := Alignment;
end;
end;
procedure TspSkinLabelObject.SetTextValue;
begin
FTextValue := AValue;
if AUpDate then Parent.DrawSkinObject(Self);
end;
procedure TspSkinLabelObject.MouseEnter;
begin
FMouseIn := True;
Active := True;
if (not IsNullRect(ActiveSkinRect)) or (ActiveFontColor <> FontColor)
then
ReDraw;
Parent.MouseEnterEvent(IDName);
end;
procedure TspSkinLabelObject.MouseLeave;
begin
FMouseIn := False;
Active := False;
if not IsNullRect(ActiveSkinRect) or (ActiveFontColor <> FontColor)
then
ReDraw;
Parent.MouseLeaveEvent(IDName);
end;
procedure TspSkinLabelObject.Draw;
var
PBuffer, APBuffer: TspEffectBmp;
Buffer, ABuffer: TBitMap;
ASR, SR: TRect;
procedure DrawLabelText(R: TRect; Cnvs: TCanvas; AActive: Boolean);
var
X, Y: Integer;
begin
X := R.Left;
case Alignment of
taRightJustify: X := R.Right - Cnvs.TextWidth(FTextValue);
taCenter: X := R.Left + (R.Right - R.Left) div 2 - Cnvs.TextWidth(FTextValue) div 2;
end;
with Cnvs do
begin
Y := R.Top + (R.Bottom - R.Top) div 2 - TextHeight(FTextValue) div 2;
Brush.Style := bsClear;
Font.Name := FontName;
Font.Style := FontStyle;
Font.Height := FontHeight;
if AActive
then
Font.Color := ActiveFontColor
else
Font.Color := FontColor;
TextRect(R, X, Y, FTextValue);
end;
end;
procedure CreateLabelImage(B: TBitMap; AActive: Boolean; ATextActive: Boolean);
begin
B.Width := RectWidth(ObjectRect);
B.Height := RectHeight(ObjectRect);
with B.Canvas do
begin
if AActive
then
CopyRect(Rect(0, 0, B.Width, B.Height), ActivePicture.Canvas, ActiveSkinRect)
else
CopyRect(Rect(0, 0, B.Width, B.Height), Picture.Canvas, SkinRect);
end;
DrawLabelText(Rect(0, 0, B.Width, B.Height), B.Canvas, ATextActive);
end;
begin
ASR := ActiveSkinRect;
SR := SkinRect;
if not Morphing or
((Active and (MorphKf = 1)) or (not Active and (MorphKf = 0)))
then
begin
if Active// and not IsNullRect(ASR)
then
begin
if not IsNullRect(ASR)
then
begin
Buffer := TBitMap.Create;
CreateLabelImage(Buffer, True, True);
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Buffer);
Buffer.Free;
end
else
if (ActiveFontColor <> FontColor)
then
begin
Buffer := TBitMap.Create;
CreateLabelImage(Buffer, False, True);
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Buffer);
Buffer.Free;
end
end
else
begin
Buffer := TBitMap.Create;
CreateLabelImage(Buffer, False, False);
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Buffer);
Buffer.Free;
end;
end
else
begin
Buffer := TBitMap.Create;
ABuffer := TBitMap.Create;
CreateLabelImage(Buffer, False, False);
if isNullRect(ActiveSkinRect)
then
CreateLabelImage(ABuffer, False, True)
else
CreateLabelImage(ABuffer, True, True);
PBuffer := TspEffectBmp.CreateFromhWnd(Buffer.Handle);
APBuffer := TspEffectBmp.CreateFromhWnd(ABuffer.Handle);
case MorphKind of
mkDefault: PBuffer.Morph(APBuffer, MorphKf);
mkGradient: PBuffer.MorphGrad(APBuffer, MorphKf);
mkLeftGradient: PBuffer.MorphLeftGrad(APBuffer, MorphKf);
mkRightGradient: PBuffer.MorphRightGrad(APBuffer, MorphKf);
mkLeftSlide: PBuffer.MorphLeftSlide(APBuffer, MorphKf);
mkRightSlide: PBuffer.MorphRightSlide(APBuffer, MorphKf);
mkPush: PBuffer.MorphPush(APBuffer, MorphKf);
end;
PBuffer.Draw(Cnvs.Handle, ObjectRect.Left, ObjectRect.Top);
PBuffer.Free;
APBuffer.Free;
Buffer.Free;
ABuffer.Free;
end;
end;
//============= TspSkinCaptionObject ==================//
constructor TspSkinCaptionObject.Create;
begin
inherited Create(AParent, AData);
FTextValue := '';
with TspDataSkinCaption(AData) do
begin
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.FontColor := FontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.Alignment := Alignment;
Self.TextRct := TextRct;
Self.DefaultCaption := DefaultCaption;
Self.Shadow := Shadow;
Self.ShadowColor := ShadowColor;
Self.ActiveShadowColor := ActiveShadowColor;
Self.FrameRect := FrameRect;
Self.ActiveFrameRect := ActiveFrameRect;
Self.FrameLeftOffset := FrameLeftOffset;
Self.FrameRightOffset := FrameRightOffset;
Self.FrameTextRect := FrameTextRect;
end;
end;
procedure TspSkinCaptionObject.MouseDown;
begin
with Parent do
begin
if not SupportNCArea and
(WindowState <> wsMaximized) then StartDragg(X, Y);
MouseDownEvent(IDName, X, Y, ObjectRect, Button);
end;
end;
procedure TspSkinCaptionObject.MouseUp;
begin
with Parent do
begin
if not SupportNCArea then EndDragg;
MouseUpEvent(IDName, X, Y, ObjectRect, Button);
end;
end;
procedure TspSkinCaptionObject.SetTextValue(Value: String);
begin
FTextValue := Value;
Parent.DrawSkinObject(Self);
end;
procedure TspSkinCaptionObject.SimpleSetTextValue(Value: String);
begin
FTextValue := Value;
end;
procedure TspSkinCaptionObject.MouseEnter;
begin
FMouseIn := True;
Parent.MouseEnterEvent(IDName);
end;
procedure TspSkinCaptionObject.MouseLeave;
begin
FMouseIn := False;
Parent.MouseLeaveEvent(IDName);
end;
procedure TspSkinCaptionObject.Draw;
var
Image, ActiveImage: TBitMap;
tx, ty: Integer;
EB1, EB2: TspEffectBmp;
RealTextRect: TRect;
SR, ASR: TRect;
CaptionKind: Integer;
function GetCaptionKind: Integer;
begin
if (RectWidth(SR) = RectWidth(ObjectRect)) and
(RectHeight(SR) = RectHeight(ObjectRect))
then Result := 0 else
if (SR.Top <= SD.LTPoint.Y) and (SR.Bottom < SD.RTPoint.Y)
then Result := 1 else
if (SR.Top >= SD.LBPoint.Y) and (SR.Bottom > SD.RBPoint.Y)
then Result := 2 else
if (SR.Top <= SD.LTPoint.Y) and (SR.Bottom > SD.LBPoint.Y)
then Result := 3 else Result := 4;
end;
procedure CnvSetFont(Cnv: TCanvas; FColor: TColor);
begin
with Cnv do
begin
Font.Name := FontName;
Font.Style := FontStyle;
Font.Height := FontHeight;
Font.Color := FColor;
Font.CharSet := Parent.DefCaptionFont.Charset;
end;
end;
function CorrectText(Cnv: TCanvas; var S1: String): String;
var
w: Integer;
S: String;
begin
S := S1;
w := RectWidth(RealTextRect);
Parent.CorrectCaptionText(Cnv, S, w);
Result := S;
end;
procedure CreateCaptionHBitMap(DestB: TBitMap; SourceRect: TRect; SourceB: TBitMap);
var
X, XCnt: Integer;
w: Integer;
R: TRect;
XO, LO, RO: Integer;
begin
LO := 0;
RO := 0;
case CaptionKind of
1: begin
LO := SD.LTPoint.X - SR.Left;
RO := SR.Right - SD.RTPoint.X;
end;
2: begin
LO := SD.LBPoint.X - SR.Left;
RO := SR.Right - SD.RBPoint.X;
end;
end;
DestB.Width := RectWidth(ObjectRect);
DestB.Height := RectHeight(ObjectRect);
R := Rect(SourceRect.Left + LO, SourceRect.Top,
SourceRect.Right - RO, SourceRect.Bottom);
if (LO = 0) and (RO = 0)
then
DestB.Canvas.CopyRect(Rect(0, 0, DestB.Width, DestB.Height),
SourceB.Canvas, R)
else
begin
w := RectWidth(R);
XCnt := DestB.Width div w;
for X := 0 to XCnt do
begin
if X * w + w > DestB.Width
then XO := X * w + w - DestB.Width else XO := 0;
Dec(R.Right, XO);
DestB.Canvas.CopyRect(Rect(X * w, 0, X * w + w - XO, DestB.Height),
SourceB.Canvas, R);
end;
end;
with DestB.Canvas do
begin
if LO <> 0
then
CopyRect(Rect(0, 0, LO, DestB.Height),
SourceB.Canvas, Rect(SourceRect.Left, SourceRect.Top,
SourceRect.Left + LO, SourceRect.Bottom));
if RO <> 0
then
CopyRect(Rect(DestB.Width - RO, 0, DestB.Width, DestB.Height),
SourceB.Canvas, Rect(SourceRect.Right - RO, SourceRect.Top,
SourceRect.Right, SourceRect.Bottom));
end;
end;
procedure CreateCaptionVBitMap(DestB: TBitMap; SourceRect: TRect; SourceB: TBitMap);
var
Y, YCnt: Integer;
h: Integer;
R: TRect;
YO, TpO, BtO: Integer;
begin
TpO := 0;
BtO := 0;
case CaptionKind of
3: begin
TpO := SD.LTPoint.Y - SR.Top;
BtO := SR.Bottom - SD.LBPoint.Y;
end;
4: begin
TpO := SD.RTPoint.Y - SR.Top;
BtO := SR.Bottom - SD.RBPoint.Y;
end;
end;
DestB.Width := RectWidth(ObjectRect);
DestB.Height := RectHeight(ObjectRect);
R := Rect(SourceRect.Left, SourceRect.Top + TpO,
SourceRect.Right, SourceRect.Bottom - BtO);
h := RectHeight(R);
YCnt := DestB.Height div h;
for Y := 0 to YCnt do
begin
if Y * h + h > DestB.Height
then YO := Y * h + h - DestB.Height else YO := 0;
Dec(R.Bottom, YO);
DestB.Canvas.CopyRect(Rect(0, Y * h, DestB.Width, Y * h + h - YO),
SourceB.Canvas, R);
end;
with DestB.Canvas do
begin
if TpO <> 0
then
CopyRect(Rect(0, 0, DestB.Width, TpO),
SourceB.Canvas, Rect(SourceRect.Left, SourceRect.Top,
SourceRect.Right, SourceRect.Top + TpO));
if BtO <> 0
then
CopyRect(Rect(0, DestB.Height - BtO, DestB.Width, DestB.Height),
SourceB.Canvas, Rect(SourceRect.Left, SourceRect.Bottom - BtO,
SourceRect.Right, SourceRect.Bottom));
end;
end;
procedure CalcTextCoord(tw, th: Integer);
var
w, h: Integer;
begin
w := RectWidth(RealTextRect);
h := RectHeight(RealTextRect);
ty := h div 2 - th div 2 + RealTextRect.Top;
case Alignment of
taLeftJustify: tx := RealTextRect.Left;
taRightJustify: tx := RealTextRect.Right - tw;
taCenter: tx := w div 2 - tw div 2 + RealTextRect.Left;
end;
end;
procedure DrawCaptionText(Cnv: TCanvas; OX, OY: Integer; AActive: Boolean);
var
S1: String;
C: TColor;
F: TForm;
B: TBitMap;
FR: TRect;
begin
S1 := Parent.FForm.Caption;
if (Parent.FForm.FormStyle = fsMDIForm) and Parent.IsMDIChildMaximized
then
begin
F := Parent.GetMaximizeMDIChild;
if F <> nil then S1 := S1 + ' - [' + F.Caption + ']';
end;
if (S1 = '') or IsNullRect(TextRct) then Exit;
S1 := CorrectText(Cnv, S1);
with Cnv do
begin
CalcTextCoord(TextWidth(S1), TextHeight(S1));
tx := tx + OX;
ty := ty + OY;
Brush.Style := bsClear;
if not IsNullRect(Self.FrameRect)
then
begin
B := TBitMap.Create;
if (AActive) and not IsNullRect(ActiveFrameRect)
then FR := ActiveFrameRect
else FR := Self.FrameRect;
CreateHSkinImage(FrameLeftOffset, FrameRightOffset, B, ActivePicture, FR,
TextWidth(S1) + RectWidth(Self.FrameRect) - RectWidth(FrameTextRect),
RectHeight(Self.FrameRect));
Draw(TX - FrameTextRect.Left, TY - FrameTextRect.Top, B);
B.Free;
end;
if Shadow
then
begin
Font.Charset := Parent.FDefCaptionFont.Charset;
C := Font.Color;
if AActive
then Font.Color := ActiveShadowColor
else Font.Color := ShadowColor;
TextOut(tx + 1, ty + 1, S1);
Font.Color := C;
end;
TextOut(tx, ty, S1);
end;
end;
var
TextO: Integer;
begin
SR := SkinRect;
ASR := ActiveSkinRect;
CaptionKind := GetCaptionKind;
RealTextRect := TextRct;
Active := Parent.GetFormActive;
if not IsNullRect(TextRct)
then
begin
TextO := RectWidth(SkinRect) - TextRct.Right;
RealTextRect.Right := RectWidth(ObjectRect) - TextO;
end;
if Parent.SupportNCArea and IsNullRect(ASR)
then
begin
if Active
then CnvSetFont(Cnvs, ActiveFontColor)
else CnvSetFont(Cnvs, FontColor);
DrawCaptionText(Cnvs, ObjectRect.Left, ObjectRect.Top, Active);
end
else
if IsNullRect(ASR) or (not Active and (MorphKf = 0))
then
begin
if not UpDate
then
begin
if Active
then CnvSetFont(Cnvs, ActiveFontColor)
else CnvSetFont(Cnvs, FontColor);
DrawCaptionText(Cnvs, ObjectRect.Left, ObjectRect.Top, Active);
end
else
begin
Image := TBitMap.Create;
if not Parent.CanScale
then
begin
Image.Width := RectWidth(ObjectRect);
Image.Height := RectHeight(ObjectRect);
Image.Canvas.CopyRect(Rect(0, 0, Image.Width, Image.Height),
Picture.Canvas, SkinRect);
end
else
if CaptionKind < 3
then
CreateCaptionHBitMap(Image, SR, Picture)
else
CreateCaptionVBitMap(Image, SR, Picture);
if Active
then CnvSetFont(Image.Canvas, ActiveFontColor)
else CnvSetFont(Image.Canvas, FontColor);
DrawCaptionText(Image.Canvas, 0, 0, Active);
if Parent.GetAutoRenderingInActiveImage and not Active
then
begin
EB1 := TspEffectBmp.CreateFromhWnd(Image.Handle);
case Parent.FSD.InActiveEffect of
ieBrightness:
EB1.ChangeBrightness(InActiveBrightnessKf);
ieDarkness:
EB1.ChangeDarkness(InActiveDarknessKf);
ieGrayScale:
EB1.GrayScale;
ieNoise:
EB1.AddMonoNoise(InActiveNoiseAmount);
ieSplitBlur:
EB1.SplitBlur(1);
ieInvert:
EB1.Invert;
end;
EB1.Draw(Cnvs.Handle, ObjectRect.Left, ObjectRect.Top);
EB1.Free;
end
else
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Image);
Image.Free;
end;
end
else
begin
ActiveImage := TBitMap.Create;
if not Parent.CanScale
then
begin
ActiveImage.Width := RectWidth(ObjectRect);
ActiveImage.Height := RectHeight(ObjectRect);
ActiveImage.Canvas.CopyRect(Rect(0, 0, ActiveImage.Width, ActiveImage.Height),
ActivePicture.Canvas, ActiveSkinRect);
end
else
if CaptionKind < 3
then
CreateCaptionHBitMap(ActiveImage, ASR, ActivePicture)
else
CreateCaptionVBitMap(ActiveImage, ASR, ActivePicture);
CnvSetFont(ActiveImage.Canvas, ActiveFontColor);
DrawCaptionText(ActiveImage.Canvas, 0, 0, True);
if ((MorphKf = 0) and Active and not Morphing) or
(Active and (MorphKf = 1))
then
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, ActiveImage)
else
begin
Image := TBitMap.Create;
if not Parent.CanScale
then
begin
Image.Width := RectWidth(ObjectRect);
Image.Height := RectHeight(ObjectRect);
Image.Canvas.CopyRect(Rect(0, 0, Image.Width, Image.Height),
Picture.Canvas, SkinRect);
end
else
if CaptionKind < 3
then
CreateCaptionHBitMap(Image, SR, Picture)
else
CreateCaptionVBitMap(Image, SR, Picture);
CnvSetFont(Image.Canvas, FontColor);
DrawCaptionText(Image.Canvas, 0, 0, False);
// Morphing
EB1 := TspEffectBmp.CreateFromhWnd(Image.Handle);
EB2 := TspEffectBmp.CreateFromhWnd(ActiveImage.Handle);
case MorphKind of
mkDefault: EB1.Morph(EB2, MorphKf);
mkGradient: EB1.MorphGrad(EB2, MorphKf);
mkLeftGradient: EB1.MorphLeftGrad(EB2, MorphKf);
mkRightGradient: EB1.MorphRightGrad(EB2, MorphKf);
mkLeftSlide: EB1.MorphLeftSlide(EB2, MorphKf);
mkRightSlide: EB1.MorphRightSlide(EB2, MorphKf);
mkPush: EB1.MorphPush(EB2, MorphKf)
end;
if Parent.GetAutoRenderingInActiveImage and not Active
then
case Parent.FSD.InActiveEffect of
ieBrightness:
EB1.ChangeBrightness(InActiveBrightnessKf);
ieDarkness:
EB1.ChangeDarkness(InActiveDarknessKf);
ieGrayScale:
EB1.GrayScale;
ieNoise:
EB1.AddMonoNoise(InActiveNoiseAmount);
ieSplitBlur:
EB1.SplitBlur(1);
ieInvert:
EB1.Invert;
end;
EB1.Draw(Cnvs.Handle, ObjectRect.Left, ObjectRect.Top);
EB1.Free;
EB2.Free;
//
Image.Free;
end;
ActiveImage.Free;
end;
end;
//============= TspSkinMainMenu =============//
constructor TspSkinMainMenu.Create;
begin
inherited Create(AOwner);
DSF := nil;
FSD := nil;
end;
procedure TspSkinMainMenu.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
// ============= TspSkinMainMenuBar ================//
constructor TspMenuBarObject.Create;
begin
Parent := AParent;
Enabled := True;
Visible := True;
FMorphKf := 0;
FDown := False;
Morphing := False;
Picture := nil;
if AData <> nil then
with AData do
begin
Self.IDName := IDName;
Self.SkinRect := SkinRect;
Self.ActiveSkinRect := ActiveSkinRect;
Self.DownRect := ActiveSkinRect;
Self.Morphing := Morphing;
Self.MorphKind := MorphKind;
ObjectRect := SkinRect;
if (ActivePictureIndex <> - 1) and
(ActivePictureIndex < Parent.SkinData.FActivePictures.Count)
then
Picture := TBitMap(Parent.SkinData.FActivePictures.Items[ActivePictureIndex]);
end;
end;
procedure TspMenuBarObject.ReDraw;
begin
if Morphing
then Parent.MorphTimer.Enabled := True
else Parent.DrawSkinObject(Self);
end;
procedure TspMenuBarObject.DblClick;
begin
end;
procedure TspMenuBarObject.MouseDown(X, Y: Integer; Button: TMouseButton);
begin
end;
procedure TspMenuBarObject.MouseUp(X, Y: Integer; Button: TMouseButton);
begin
end;
procedure TspMenuBarObject.MouseEnter;
begin
FMouseIn := True;
Active := True;
ReDraw;
end;
procedure TspMenuBarObject.MouseLeave;
begin
FMouseIn := False;
Active := False;
ReDraw;
end;
function TspMenuBarObject.CanMorphing;
begin
Result := not (FDown and not IsNullRect(DownRect)) and
((Active and (MorphKf < 1)) or
(not Active and (MorphKf > 0)));
end;
procedure TspMenuBarObject.DoMorphing;
begin
if Active
then MorphKf := MorphKf + MorphInc
else MorphKf := MorphKf - MorphInc;
Draw(Parent.Canvas);
end;
procedure TspMenuBarObject.Draw;
begin
end;
procedure TspMenuBarObject.SetMorphKf(Value: Double);
begin
FMorphKf := Value;
if FMorphKf < 0 then FMorphKf := 0 else
if FMorphKf > 1 then FMorphKf := 1;
end;
// ============== TspSkinMainMenuBarButton ================ //
constructor TspSkinMainMenuBarButton.Create;
begin
inherited Create(AParent, AData);
if AData <> nil
then
with TspDataSkinMainMenuBarButton(AData) do
begin
Self.Command := Command;
Self.DownRect := DownRect;
FSkinSupport := True;
end
else
FSkinSupport := False;
end;
procedure TspSkinMainMenuBarButton.DefaultDraw(Cnvs: TCanvas);
var
Buffer: TBitMap;
R: TRect;
IX, IY: Integer;
IC: TColor;
begin