dynamicskinform.pas

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

    Command: TStdCommand;
    RestoreRect, RestoreActiveRect, RestoreDownRect,
    RestoreInActiveRect: 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;
    LightColor: TColor;
    ActiveLightColor: TColor;
    Light: Boolean;
    StretchEffect: Boolean;
    // animation
    FIncTime: Integer;
    //
    AnimateSkinRect: TRect;
    FrameCount: Integer;
    AnimateInterval: Integer;
    CurrentFrame: Integer;
    InActiveAnimation: Boolean;
    FullFrame: Boolean;
    //
    function EnableAnimation: Boolean;
    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; virtual;
    function EnableMorphing: Boolean;
  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;
    procedure Redraw; override;
  public
    MenuItem: TMenuItem;
    FontName: String;
    FontHeight: Integer;
    FontStyle: TFontStyles;
    UnEnabledFontColor, FontColor,
    ActiveFontColor, DownFontColor: TColor;
    TextRct: TRect;
    DownRect: TRect;
    LO, RO: Integer;
    StretchEffect: Boolean;
    AnimateSkinRect: TRect;
    FrameCount: Integer;
    AnimateInterval: Integer;
    CurrentFrame: Integer;
    InActiveAnimation: Boolean;
    function EnableAnimation: Boolean;
    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;

  TspItemEnterEvent = procedure (MenuItem: TMenuItem) of object;
  TspItemLeaveEvent = procedure (MenuItem: TMenuItem) of object;

  TspSkinMainMenuBar = class(TspSkinControl)
  protected
    FUseSkinFont: Boolean;
    FOnItemMouseEnter: TspItemEnterEvent;
    FOnItemMouseLeave: TspItemLeaveEvent;
    FScrollMenu: Boolean;
    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;
    AnimateTimer: TTimer;
    ActiveObject, OldActiveObject, MouseCaptureObject: Integer;
    FOnMouseEnter, FOnMouseLeave: TNotifyEvent;
    NewItemsRect: TRect;
    FDefaultWidth: Integer;
    FDefaultHeight: Integer;
    FMergeMenu: TMainMenu;
    procedure TestAnimate(Sender: TObject);
    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 WMMOVE(var Msg: TWMMOVE); message WM_MOVE;
    procedure WMCHECKPARENTBG(var Msg: TWMEraseBkgnd); message WM_CHECKPARENTBG;
    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;
    StretchEffect: Boolean;
    ItemTransparent: Boolean;
    //
    ObjectList: TList;
    //
    ChildMenuIn: Boolean;
    //
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetChildMainMenu: TMainMenu;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure Paint; override;
    procedure CreateMenu;
    procedure ChangeSkinData; override;
    procedure BeforeChangeSkinData; override;
    procedure GetSkinData; override;
    procedure UpDateItems;
    procedure UpDateEnabledItems;
    procedure Merge(Menu: TMainMenu);
    procedure UnMerge;
  published
    property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
    property ScrollMenu: Boolean read FScrollMenu write FScrollMenu;
    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 BiDiMode;
    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 OnItemMouseEnter: TspItemEnterEvent read FOnItemMouseEnter write FOnItemMouseEnter;
    property OnItemMouseLeave: TspItemLeaveEvent read FOnItemMouseLeave write FOnItemMouseLeave;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnClick;
  end;

  TspSkinMDITabsBar = class;

  TspPositionInMonitor = (sppDefault, sppScreenCenter, sppDesktopCenter);

  TspDynamicSkinForm = class(TComponent)
  private
    FInAppHook: Boolean;
    FSkinnableForm: Boolean;
    FIsVistaOS: Boolean;
    FHaveShadow: Boolean;
    FOnCaptionPaint: TspCaptionPaintEvent;
    FRollUpBeforeMaximize: Boolean;
    FOnShortCut: TShortCutEvent;
    FStopPainting: Boolean;
    FStartShow: Boolean;
    FPositionInMonitor:  TspPositionInMonitor;
    HMagnetized: Boolean;
    VMagnetized: Boolean;
    HMagnetized2: Boolean;
    VMagnetized2: Boolean;
    FOnMouseDownCoord: TPoint;
    FMinimizeDefault: Boolean;
    FStatusBar: TspSkinStatusBar;
    FUseFormCursorInNCArea: Boolean;
    FMaxMenuItemsInWindow: Integer;
    FClientWidth, FClientHeight: Integer;
    FHideCaptionButtons: Boolean;
    FAlwaysShowInTray: Boolean;
    FLogoBitMapTransparent: Boolean;
    FLogoBitMap: TBitMap;
    FAlwaysMinimizeToTray: Boolean;
    FIcon: TIcon;
    FShowIcon: Boolean;
    ButtonsInLeft: boolean;
    FMaximizeOnFullScreen: Boolean;
    FSkinHint: TspSkinHint;
    FShowObjectHint: Boolean;
    FUseDefaultObjectHint: 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;
    FMDITabsBar: TspSkinMDITabsBar;
    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;
    FMaxHeight, FMaxWidth: Integer;

    OldWindowProc: TWndMethod;
    FClientInstance: Pointer;
    FPrevClientProc: Pointer;

    FSD: TspSkinData;
    FMSD: TspSkinData;
    FMainMenu: TMainMenu;