skinexctrls.pas

DynamicSkinForm.v9.15.For.Delphi.BCB 很好的皮肤控件

{*******************************************************************}
{                                                                   }
{       Almediadev Visual Component Library                         }
{       DynamicSkinForm                                             }
{       Version 9.15                                                }
{                                                                   }
{       Copyright (c) 2000-2008 Almediadev                          }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{       Home:  http://www.almdev.com                                }
{       Support: [e-mail]                                 }
{                                                                   }
{*******************************************************************}

unit SkinExCtrls;

{$P+,S-,W-,R-}
{$WARNINGS OFF}
{$HINTS OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Menus, ExtCtrls, SkinData, spUtils, SkinCtrls, StdCtrls;

type
  TspSkinAnimateGauge = class(TspSkinCustomControl)
  protected
    FImitation: Boolean;
    FCountFrames: Integer;
    FAnimationFrame: Integer;
    FAnimationPauseTimer: TTimer;
    FAnimationTimer: TTimer;
    FAnimationPause: Integer;
    FProgressText: String;
    FShowProgressText: Boolean;
    procedure OnAnimationPauseTimer(Sender: TObject);
    procedure OnAnimationTimer(Sender: TObject);
    procedure SetShowProgressText(Value: Boolean);
    procedure SetProgressText(Value: String);
    procedure GetSkinData; override;
    procedure CreateImage(B: TBitMap);
    procedure DrawProgressText(C: TCanvas);
    procedure CreateControlDefaultImage(B: TBitMap); override;
    procedure CreateControlSkinImage(B: TBitMap); override;
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
    function GetAnimationFrameRect: TRect;
    procedure CalcSize(var W, H: Integer); override;
    function CalcProgressRect: TRect;
    procedure StartInternalAnimation;
    procedure StopInternalAnimation;
  public
    ProgressRect, ProgressArea: TRect;
    NewProgressArea: TRect;
    BeginOffset, EndOffset: Integer;
    FontName: String;
    FontStyle: TFontStyles;
    FontHeight: Integer;
    FontColor: TColor;
    ProgressTransparent: Boolean;
    ProgressTransparentColor: TColor;
    ProgressStretch: Boolean;
    AnimationBeginOffset,
    AnimationEndOffset: Integer; 
    //
    AnimationSkinRect: TRect;
    AnimationCountFrames: Integer;
    AnimationTimerInterval: Integer;
    //
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure StartAnimation;
    procedure StopAnimation;
    procedure SetAnimationPause(Value: Integer);
    procedure ChangeSkinData; override;
  published
    property ProgressText: String read FProgressText write SetProgressText;
    property ShowProgressText: Boolean read FShowProgressText write SetShowProgressText;
    property AnimationPause: Integer
      read  FAnimationPause write SetAnimationPause;
    property Align;
    property Enabled;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property PopupMenu;
    property ShowHint;
  end;

  TspSkinShadowLabel = class(TspGraphicSkinControl)
  private
    FFocusControl: TWinControl;
    FAlignment: TAlignment;
    FAutoSize: Boolean;
    FLayout: TTextLayout;
    FWordWrap: Boolean;
    FShowAccelChar: Boolean;
    FUseSkinColor: Boolean;
    procedure SetAlignment(Value: TAlignment);
    procedure SetFocusControl(Value: TWinControl);
    procedure SetShowAccelChar(Value: Boolean);
    procedure SetLayout(Value: TTextLayout);
    procedure SetWordWrap(Value: Boolean);
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  protected
    procedure AdjustBounds; dynamic;
    procedure DoDrawText(Cnvs: TCanvas; var Rect: TRect; Flags: Longint); dynamic;
    function GetLabelText: string; virtual;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
     Operation: TOperation); override;
    procedure Paint; override;
    procedure SetAutoSize(Value: Boolean); 
    procedure WMMOVE(var Msg: TWMMOVE); message WM_MOVE;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property AutoSize: Boolean read FAutoSize write SetAutoSize;
    property Layout: TTextLayout read FLayout write SetLayout default tlTop;
    property Alignment: TAlignment read FAlignment write SetAlignment
      default taLeftJustify;
    property FocusControl: TWinControl read FFocusControl write SetFocusControl;
    property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default True;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
    property Caption;
    property UseSkinColor: Boolean read FUseSkinColor write FUseSkinColor;
    property Align;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ParentBiDiMode;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnStartDock;
    property OnStartDrag;
  end;


 TspSkinWaveLabel = class(TspGraphicSkinControl)
 private
   FXDiv, FYDiv, FRatioVal: Integer;
   FUseSkinColor: Boolean;
   FAntialiasing: Boolean;
   FAlignment: TAlignment;
   procedure SetAlignment(Value: TAlignment);
   procedure SetXDiv(Value: Integer);
   procedure SetYDiv(Value: Integer);
   procedure SetRatioVal(Value: Integer);
   procedure SetAntialiasing(Value: Boolean);
 protected
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure WMMOVE(var Msg: TWMMOVE); message WM_MOVE;
 public
   procedure Paint; override;
   constructor Create(AOwner: TComponent); override;
 published
   property Antialiasing: Boolean read FAntialiasing write SetAntialiasing;
   property UseSkinColor: Boolean read FUseSkinColor write FUseSkinColor;
   property XDiv: Integer read FXDiv write SetXDiv;
   property YDiv: Integer read FYDiv write SetYDiv;
   property RatioVal: Integer read FRatioVal write SetRatioVal;
   property Caption;
   property Font;
   property Align;
   property Alignment: TAlignment read FAlignment write SetAlignment;
   property Anchors;
   property Constraints;
   property DragCursor;
   property DragKind;
   property DragMode;
   property Enabled;
   property PopupMenu;
   property ShowHint;
   property Visible;
   property OnClick;
   property OnDblClick;
   property OnDragDrop;
   property OnDragOver;
   property OnEndDock;
   property OnEndDrag;
   property OnMouseDown;
   property OnMouseMove;
   property OnMouseUp;
   property OnStartDock;
   property OnStartDrag;
 end;

 TspFrameSkinControl = class(TspSkinControl)
  protected
    FRgn: HRgn;
    FFrame: Integer;
    FrameW, FrameH: Integer;
    Picture, MaskPicture: TBitMap;

    FDefaultImage: TBitMap;
    FDefaultMask: TBitMap;
    FDefaultFramesCount: Integer;
    FDefaultFramesPlacement: TFramesPlacement;

    procedure CalcDefaultFrameSize; virtual;
    procedure SetDefaultImage(Value: TBitMap);
    procedure SetDefaultMask(Value: TBitMap);
    procedure SetDefaultFramesCount(Value: Integer);
    procedure SetDefaultFramesPlacement(Value: TFramesPlacement);

    procedure SetFrame(Value: Integer);
    procedure SetControlRegion;
    procedure GetSkinData; override;
    procedure CreateControlDefaultImage(B: TBitMap); override;
    procedure CreateControlSkinImage(B: TBitMap); override;
    procedure Loaded; override;
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
  public
    SkinRect: TRect;
    FramesCount: Integer;
    FramesPlacement: TFramesPlacement;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure ChangeSkinData; override;
    property Frame: Integer read FFrame write SetFrame;
  published
    property DefaultImage: TBitMap read FDefaultImage write SetDefaultImage;
    property DefaultMask: TBitMap read FDefaultMask write SetDefaultMask;
    property DefaultFramesPlacement: TFramesPlacement
      read FDefaultFramesPlacement write SetDefaultFramesPlacement;
    property DefaultFramesCount: Integer
      read FDefaultFramesCount write SetDefaultFramesCount;
    property ShowHint;  
  end;

  TspSkinSwitchState = (swOff, swOn);

  TspSkinSwitch = class(TspFrameSkinControl)
  protected
    FAnimateTimer: TTimer;
    FState: TspSkinSwitchState;
    FOnChange: TNotifyEvent;
    FMouseIn: Boolean;
    function GetTimerInterval: Cardinal;
    procedure SetTimerInterval(Value: Cardinal);
    procedure SetState(Value: TspSkinSwitchState);
    procedure ChangeState(Value: TspSkinSwitchState);
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure DoAnimate(Sender: TObject);
    procedure Start;
    procedure Stop;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ChangeSkinData; override;
  published
    property TimerInterval: Cardinal read GetTimerInterval write SetTimerInterval;
    property State: TspSkinSwitchState read FState write SetState;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnClick;
  end;

  TspSkinAnimate = class(TspFrameSkinControl)
  protected
    FAnimateTimer: TTimer;
    FCycleMode: Boolean;
    FButtonMode: Boolean;
    FMouseIn: Boolean;
    FOnStart: TNotifyEvent;
    FOnStop: TNotifyEvent;
    FActive: Boolean;
    procedure SetActive(Value: Boolean);
    function GetTimerInterval: Cardinal;
    procedure SetTimerInterval(Value: Cardinal);
    procedure DoAnimate(Sender: TObject);
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Start;
    procedure Stop;
  published
    property Active: Boolean read FActive write SetActive;
    property Enabled;
    property CycleMode: Boolean read FCycleMode write FCycleMode;
    property ButtonMode: Boolean read FButtonMode write FButtonMode;
    property TimerInterval: Cardinal read GetTimerInterval write SetTimerInterval;
    property OnStart: TNotifyEvent read FOnStart write FOnStart;
    property OnStop: TNotifyEvent read FOnStop write FOnStop;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnClick;
  end;

  TspSkinFrameGauge = class(TspFrameSkinControl)
  protected
    FMinValue, FMaxValue, FValue: Integer;
    FVertical: Boolean;
    FOnChange: TNotifyEvent;
    procedure SetMinValue(AValue: Integer);
    procedure SetMaxValue(AValue: Integer);
    procedure SetValue(AValue: Integer);
    procedure CalcFrame;
  public
    procedure ChangeSkinData; override;
    constructor Create(AOwner: TComponent); override;
  published
    property Value: Integer read FValue write SetValue;
    property MinValue: Integer read FMinValue write SetMinValue;
    property MaxValue: Integer read FMaxValue write SetMaxValue;
    property Align;
    property Enabled;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property PopupMenu;
    property ShowHint;
  end;

  TspSkinFrameRegulator = class(TspFrameSkinControl)
  protected
    FPixInc, FValInc: Integer;
    FDown: Boolean;
    StartV, CurV, OldCurV, TempValue: Integer;
    FMinValue, FMaxValue, FValue: Integer;
    FOnChange: TNotifyEvent;
    FDefaultKind: TRegulatorKind;
    function GetRoundValue(X, Y: Integer): Integer;
    procedure CalcDefaultFrameSize; override;
    procedure SetDefaultKind(Value: TRegulatorKind);
    procedure SetMinValue(AValue: Integer);
    procedure SetMaxValue(AValue: Integer);
    procedure SetValue(AValue: Integer);
    procedure GetSkinData; 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 CalcValue;
    procedure CalcRoundValue;
    procedure CalcFrame;
  public
    Kind: TRegulatorKind;
    constructor Create(AOwner: TComponent); override;
    procedure ChangeSkinData; override;
  published
    property DefaultKind: TRegulatorKind read FDefaultKind write SetDefaultKind;
    property Value: Integer read FValue write SetValue;
    property MinValue: Integer read FMinValue write SetMinValue;
    property MaxValue: Integer read FMaxValue write SetMaxValue;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property Align;
    property Enabled;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property PopupMenu;
    property ShowHint;
  end;

  TspSkinBitLabel = class(TspSkinCustomControl)
  protected
    FAutoSize: Boolean;
    FFixLength: Integer;
    function GetFixWidth: Integer;
    procedure SetFixLength(Value: Integer);
    procedure AdjustBounds;
    procedure GetSkinData; override;
    procedure PaintLabel(B: TBitMap);
    procedure CalcSize(var W, H: Integer); override;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;

    procedure CreateControlDefaultImage(B: TBitMap); override;
    procedure CreateControlSkinImage(B: TBitMap); override;
  public
    SkinTextRect: TRect;
    SymbolWidth: Integer;
    SymbolHeight: Integer;
    Symbols: TStrings;
    procedure SetAutoSizeX(Value: Boolean);
    constructor Create(AOwner: TComponent); override;
  published
    property Caption;
    property AutoSize: Boolean read FAutoSize write SetAutoSizeX;
    property FixLength: Integer read FFixLength write SetFixLength;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

 TspSkinXFormButton = class(TspSkinButton)
 private
   FDefImage: TBitMap;
   FDefActiveImage: TBitMap;
   FDefDownImage: TBitMap;
   FDefMask: TBitMap;
   FDefActiveFontColor: TColor;
   FDefDownFontColor: TColor;
   procedure SetDefImage(Value: TBitMap);
   procedure SetDefActiveImage(Value: TBitMap);
   procedure SetDefDownImage(Value: TBitMap);
   procedure SetDefMask(Value: TBitMap);
 protected
    procedure SetControlRegion; override;
    procedure DrawDefaultButton(C: TCanvas);
    procedure CreateControlDefaultImage(B: TBitMap); override;
    procedure Loaded; override;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   procedure ChangeSkinData; override;
   procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
 published
   property DefImage: TBitMap read FDefImage write SetDefImage;
   property DefActiveImage: TBitMap read FDefActiveImage write SetDefActiveImage;
   property DefDownImage: TBitMap read FDefDownImage write SetDefDownImage;
   property DefMask: TBitMap read FDefMask write SetDefMask;
   property DefActiveFontColor: TColor
    read FDefActiveFontColor write FDefActiveFontColor;
   property DefDownFontColor: TColor
    read FDefDownFontColor write FDefDownFontColor;
 end;

  TspSkinLinkImage = class(TImage)
  private
    FURL: String;
  protected
    procedure Click; override;
  public
    constructor Create(AOwner : TComponent); override;
  published
    property URL: string read FURL write FURL;
  end;

  TspSkinLinkLabel = class(TCustomLabel)
  protected
    FMouseIn: Boolean;
    FIndex: Integer;
    FSD: TspSkinData;
    FSkinDataName: String;
    FDefaultFont: TFont;
    FUseSkinFont: Boolean;
    FDefaultActiveFontColor: TColor;
    FUseUnderLine: Boolean;
    FURL: String;
    procedure SetUseUnderLine(Value: Boolean);
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure SetSkinData(Value: TspSkinData);
    procedure SetDefaultFont(Value: TFont);
    property Transparent;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;