bsskinctrls.pas

一套非常优秀的皮肤组件包

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

unit bsSkinCtrls;
                                
{$P+,S-,W-,R-}
{$WARNINGS OFF}
{$HINTS OFF}
                                  
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Menus, ExtCtrls, bsSkinData, StdCtrls, bsSkinMenus, ComCtrls, CommCtrl,
  ImgList;

const
  // Billenium Effects messages
  BE_ID           = $41A2;
  BE_BASE         = CM_BASE + $0C4A;
  CM_BEPAINT      = BE_BASE + 0; // Paint client area to Billenium Effects' DC
  CM_BENCPAINT    = BE_BASE + 1; // Paint non client area to Billenium Effects' DC
  CM_BEFULLRENDER = BE_BASE + 2; // Paint whole control to Billenium Effects' DC
  CM_BEWAIT       = BE_BASE + 3; // Don't execute effect yet
  CM_BERUN        = BE_BASE + 4; // Execute effect now!
type

  TbsControlButton = record
    R: TRect;
    MouseIn: Boolean;
    Down: Boolean;
    Visible: Boolean;
  end;

  TbsSkinWinControl = class(TWinControl)
  protected
    FSD: TbsSkinData;
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
    procedure SetSkinData(Value: TbsSkinData); virtual;
  public
    procedure ChangeSkinData; virtual;
    destructor Destroy; override;
    constructor Create(AOwner: TComponent); override;
    property SkinData: TbsSkinData read FSD write SetSkinData;
  end;

  TbsSkinControl = class(TCustomControl)                         
  protected
    FromWMPaint: Boolean;
    FSD: TbsSkinData;
    FSkinDataName: String;
    FRgn: HRgn;
    FOnMouseEnter, FOnMouseLeave: TNotifyEvent;
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
    procedure GetSkinData; virtual;
    procedure WMMOVE(var Msg: TWMMOVE); message WM_MOVE;
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure SetSkinDataName(Value: String); virtual;
    procedure SetSkinData(Value: TbsSkinData); virtual;

    procedure CreateControlDefaultImage(B: TBitMap); virtual;
    procedure CreateControlSkinImage(B: TBitMap); virtual;

  public
    FIndex: Integer;
    procedure Paint; override;
    procedure ChangeSkinData; virtual;
    procedure BeforeChangeSkinData; virtual;
    procedure AfterChangeSkinData; virtual;
    destructor Destroy; override;
    constructor Create(AOwner: TComponent); override;
  published
    property Anchors;
    property TabOrder;
    property Visible;
    property SkinData: TbsSkinData read FSD write SetSkinData;
    property SkinDataName: String read FSkinDataName write SetSkinDataName;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  end;

  TbsSkinCustomControl = class(TbsSkinControl)
  protected
    FForceBackground: Boolean;
    FDrawbackground: Boolean;
    FDefaultWidth: Integer;
    FDefaultHeight: Integer;
    FDefaultFont: TFont;
    FUseSkinFont: Boolean;

    LTPt, RTPt, LBPt, RBPt: TPoint;
    SkinRect, ClRect: TRect;
    NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
    NewClRect: TRect;
    Picture, MaskPicture: TBitMap;
    ResizeMode: Integer;
    StretchEffect: Boolean;

    procedure OnDefaultFontChange(Sender: TObject);
    procedure SetDefaultWidth(Value: Integer);
    procedure SetDefaultHeight(Value: Integer);
    procedure SetDefaultFont(Value: TFont);
    procedure DefaultFontChange; virtual;
    function GetNewRect(R: TRect): TRect;
    function GetResizeMode: Integer;
    procedure CalcSize(var W, H: Integer); virtual;

    procedure CreateSkinControlImage(B, SB: TBitMap; R: TRect);

    procedure GetSkinData; override;
    procedure CreateControlRegion;
    procedure SetControlRegion; virtual;

    procedure CreateControlDefaultImage(B: TBitMap); override;
    procedure CreateControlSkinImage(B: TBitMap); override;

    function GetRealClientWidth: Integer;
    function GetRealClientHeight: Integer;
    function GetRealClientLeft: Integer;
    function GetRealClientTop: Integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure ChangeSkinData; override;
    property RealClientRect: TRect read NewClRect;
    property RealClientWidth: integer read GetRealClientWidth;
    property RealClientHeight: integer read GetRealClientHeight;
    property RealClientLeft: integer read GetRealClientLeft;
    property RealClientTop: integer read GetRealClientTop;
    procedure Paint; override;
    property ForcebackGround: Boolean read FForceBackGround write FForceBackGround;
    property DrawbackGround: Boolean read FDrawBackground write FDrawBackground;
  published
    property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
    property DefaultWidth: Integer read FDefaultWidth write SetDefaultWidth;
    property DefaultHeight: Integer read FDefaultHeight write SetDefaultHeight;
    property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
  end;

  TbsSkinBevel = class(TBevel)
  protected
    FSD: TbsSkinData;
    FSkinDataName: String;
    FIndex: Integer;
    FDividerMode: Boolean; 
    procedure SetDividerMode(Value: Boolean);
    procedure SetSkinData(Value: TbsSkinData);
  public
    LightColor, DarkColor: TColor;
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
    procedure ChangeSkinData;
  published
    property SkinData: TbsSkinData read FSD write SetSkinData;
    property SkinDataName: String read FSkinDataName write FSkinDataName;
    property DividerMode: Boolean read FDividerMode write SetDividerMode;
  end;

  TbsSkinBorderStyle = (bvFrame, bvRaised, bvLowered, bvNone);
  TbsSkinPanelNumGlyphs = 1..2;

  TbsSkinPanel = class(TbsSkinCustomControl)
  protected
    FCMaxWidth, FCMinWidth, FCMaxHeight, FCMinHeight: Integer;
    FCheckedMode: Boolean;
    FChecked: Boolean;
    FOnChecked: TNotifyEvent;
    FGlyph: TBitMap;
    FNumGlyphs: TbsSkinPanelNumGlyphs;
    FSpacing: Integer;
    FRealHeight: Integer;
    FRollUpState: Boolean;
    FRollUpMode: Boolean;
    FCaptionMode: Boolean;
    FBorderStyle: TbsSkinBorderStyle;
    FDefaultCaptionHeight: Integer;
    FDefaultAlignment: TAlignment;
    FAutoEnabledControls: Boolean;
    procedure SetCheckedMode(Value: Boolean);
    procedure SetChecked(Value: Boolean);
    procedure SetGlyph(Value: TBitMap);
    procedure SetNumGlyphs(Value: TbsSkinPanelNumGlyphs);
    procedure SetSpacing(Value: Integer);
    procedure SetRollUpMode(Value: Boolean);
    procedure SetDefaultAlignment(Value: TAlignment);
    procedure SetDefaultCaptionHeight(Value: Integer); virtual;
    procedure SetBorderStyle(Value: TbsSkinBorderStyle);
    procedure SetRollUpState(Value: Boolean);
    procedure SetCaptionMode(Value: Boolean); virtual;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure AdjustClientRect(var Rect: TRect); override;
    procedure GetSkinData; override;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;

    procedure CreateControlDefaultImage(B: TBitMap); override;
    procedure CreateControlSkinImage(B: TBitMap); override;

    procedure HideControls;
    procedure ShowControls;

    procedure SkinDrawCheckImage(X, Y: Integer; Cnvs: TCanvas; IR: TRect; DestCnvs: TCanvas);

  public
    FontName: String;
    FontStyle: TFontStyles;
    FontHeight: Integer;
    FontColor: TColor;
    Alignment: TAlignment;
    CaptionRect: TRect;
    NewCaptionRect: TRect;
    NewRollUpMarkerRect: TRect;
    BGPictureIndex: Integer;
    CheckImageRect, UnCheckImageRect: TRect;
    FOnChangeRollUpState: TNotifyEvent;
    MarkFrameRect: TRect;
    FrameRect: TRect;
    FrameLeftOffset, FrameRightOffset: Integer;
    FrameTextRect: TRect;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ChangeSkinData; override;
    procedure DoRollUp(ARollUp: Boolean);
    procedure Paint; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    function GetSkinClientRect: TRect;
    procedure PaintskinTo(C: TCanvas; X, Y: Integer);
  published
    property RealHeight: Integer read FRealHeight write FRealHeight;
    property AutoEnabledControls: Boolean
      read FAutoEnabledControls write FAutoEnabledControls;
    property CheckedMode: Boolean read FCheckedMode write SetCheckedMode;
    property Checked: Boolean read FChecked write SetChecked;
    property DefaultAlignment: TAlignment
      read FDefaultAlignment write SetDefaultAlignment;
    property DefaultCaptionHeight: Integer
      read FDefaultCaptionHeight write SetDefaultCaptionHeight;
    property BorderStyle: TbsSkinBorderStyle
      read FBorderStyle write SetBorderStyle;
    property CaptionMode: Boolean read FCaptionMode write SetCaptionMode;
    property RollUpMode: Boolean read FRollUpMode write SetRollUpMode;
    property RollUpState: Boolean read FRollUpState write SetRollUpState;
    property Glyph: TBitMap read FGlyph write SetGlyph;
    property NumGlyphs: TbsSkinPanelNumGlyphs read FNumGlyphs write SetNumGlyphs;
    property Spacing: Integer read FSpacing write SetSpacing;
    property Caption;
    property Constraints;
    property Align;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChecked: TNotifyEvent read FOnChecked write FOnChecked;
    property OnChangeRollUpState: TNotifyEvent
      read FOnChangeRollUpState write FOnChangeRollUpState;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnDockDrop;
    property OnDockOver;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

  TbsPaintPanelEvent = procedure(Cnvs: TCanvas; R: TRect) of object;

  TbsSkinPaintPanel = class(TbsSkinPanel)
  private
    FOnPanelPaint: TbsPaintPanelEvent;
  protected
    procedure CreateControlDefaultImage(B: TBitMap); override;
    procedure CreateControlSkinImage(B: TBitMap); override;
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property OnPanelPaint: TbsPaintPanelEvent
      read FOnPanelPaint write FOnPanelPaint;
  end;

  TbsSkinStatusBar = class(TbsSkinPanel)
  private
    FSizeGrip: Boolean;
    FShowGrip: Boolean;
    procedure SetSizeGrip(Value: Boolean);
    procedure SetShowGrip(Value: Boolean);
  protected
    procedure SetSkinData(Value: TbsSkinData); override;
    procedure GetSkinData; override;
    procedure AdjustClientRect(var Rect: TRect); override;
    procedure DrawDefaultGripper(R: TRect; Cnvs: TCanvas; C1, C2: TColor);
    procedure CreateControlDefaultImage(B: TBitMap); override;
    procedure CreateControlSkinImage(B: TBitMap); override;
    function GetGripRect: TRect;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  public
    GripperRect: TRect;
    GripperTransparent: Boolean;
    GripperTransparentColor: TColor;
    constructor Create(AOwner: TComponent); override;
    property ShowGrip: Boolean read FShowGrip write SetShowGrip;
  published
    property SizeGrip: Boolean read FSizeGrip write SetSizeGrip;
  end;