businessskinform.pas

delphi 皮肤控件

    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;
    property RealHeight: Integer read GetRealHeight write OldHeight;
    property MinimizeDefault: Boolean read FMinimizeDefault write FMinimizeDefault;

    procedure EnableShadow(AShowShadow: Boolean; AHideFormBefore: Boolean);
    property SkinnableForm: Boolean read GetSkinnableForm;

  published
    property AlwaysResize: Boolean
     read FAlwaysResize write FAlwaysResize;
    property PositionInMonitor:  TbsPositionInMonitor read
      FPositionInMonitor write FPositionInMonitor;
    property StatusBar: TbsSkinStatusBar read FStatusBar write FStatusBar;
    property UseFormCursorInNCArea: Boolean read
      FUseFormCursorInNCArea write FUseFormCursorInNCArea;
    property MaxMenuItemsInWindow: Integer read
      FMaxMenuItemsInWindow write SetMaxMenuItemsInWindow;
    property ClientWidth: Integer read FClientWidth write FClientWidth;
    property ClientHeight: Integer read FClientHeight write FClientHeight;
    property HideCaptionButtons: Boolean read
      FHideCaptionButtons write FHideCaptionButtons;
    property AlwaysShowInTray: Boolean read FAlwaysShowInTray write FAlwaysShowInTray;
    property LogoBitMap: TBitMap read FLogoBitMap write SetLogoBitMap;
    property LogoBitMapTransparent: Boolean
      read FLogoBitMapTransparent
      write FLogoBitMapTransparent;
    property AlwaysMinimizeToTray: Boolean
      read FAlwaysMinimizeToTray write FAlwaysMinimizeToTray; 
    property UseSkinFontInMenu: boolean
      read GetUseSkinFontInMenu write SetUseSkinFontInMenu;
    property ShowIcon: Boolean read FShowIcon write SetShowIcon;
    property MaximizeOnFullScreen: Boolean
      read FMaximizeOnFullScreen write FMaximizeOnFullScreen;
    property AlphaBlend: Boolean read FAlphaBlend write SetAlphaBlend;
    property AlphaBlendAnimation: Boolean
      read FAlphaBlendAnimation write FAlphaBlendAnimation;
    property AlphaBlendValue: Byte
      read FAlphaBlendValue write SetAlphaBlendValue;
    property SkinHint: TbsSkinHint read FSkinHint write FSkinHint;
    property ShowObjectHint: Boolean read FShowObjectHint write FShowObjectHint;
    property UseDefaultObjectHint: Boolean read FUseDefaultObjectHint write FUseDefaultObjectHint;
    property MenusAlphaBlend: Boolean
      read FMenusAlphaBlend write SetMenusAlphaBlend;

    property MenusAlphaBlendAnimation: Boolean
      read FMenusAlphaBlendAnimation write SetMenusAlphaBlendAnimation;

    property MenusAlphaBlendValue: Byte
      read FMenusAlphaBlendValue write SetMenusAlphaBlendValue;
    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: TbsTrayIcon read FTrayIcon write SetTrayIcon;
    property UseDefaultSysMenu: Boolean
      read FUseDefaultSysMenu write FUseDefaultSysMenu;
    property MainMenuBar: TbsSkinMainMenuBar read FMainMenuBar write FMainMenuBar;
    property MDITabsBar: TbsSkinMDITabsBar read FMDITabsBar write FMDITabsBar;
    property SystemMenu: TPopupMenu read FSystemMenu write FSystemMenu;
    property SkinData: TbsSkinData read FSD write SetSkinData;
    property MenusSkinData: TbsSkinData read FMSD write SetMenusSkinData;
    property MinHeight: Integer read FMinHeight write  FMinHeight;
    property MinWidth: Integer read FMinWidth write  FMinWidth;
    property MaxHeight: Integer read FMaxHeight write  FMaxHeight;
    property MaxWidth: Integer read FMaxWidth write  FMaxWidth;
    property Magnetic: Boolean read  FMagnetic write FMagnetic;
    property MagneticSize: Byte read  FMagneticSize write FMagneticSize;
    property BorderIcons: TbsBorderIcons read FBorderIcons write SetBorderIcons;

    property OnCaptionPaint: TbsCaptionPaintEvent
      read FOnCaptionPaint write FOnCaptionPaint;

    property OnChangeSkinData: TNotifyEvent read FOnChangeSkinData
                                            write FOnChangeSkinData;
    property OnBeforeChangeSkinData: TNotifyEvent read FOnBeforeChangeSkinData
                                                 write FOnBeforeChangeSkinData;
    property OnAfterChangeSkinData: TNotifyEvent read FOnAfterChangeSkinData
                                                 write FOnAfterChangeSkinData;

    property OnMouseUpEvent: TbsMouseUpEvent read FOnMouseUpEvent
                                           write FOnMouseUpEvent;
    property OnMouseDownEvent: TbsMouseDownEvent read FOnMouseDownEvent
                                               write FOnMouseDownEvent;
    property OnMouseMoveEvent: TbsMouseMoveEvent read FOnMouseMoveEvent
                                               write FOnMouseMoveEvent;
    property OnMouseEnterEvent: TbsMouseEnterEvent read FOnMouseEnterEvent
                                                 write FOnMouseEnterEvent;
    property OnMouseLeaveEvent: TbsMouseLeaveEvent read FOnMouseLeaveEvent
                                                 write FOnMouseLeaveEvent;
    property OnPaintEvent: TbsPaintEvent read FOnPaintEvent
                                       write FOnPaintEvent;

    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;
    property OnActivateCustomObject: TbsActivateCustomObjectEvent
      read FOnActivateCustomObject write FOnActivateCustomObject;

    property OnMinimize: TNotifyEvent read FOnMinimize write FOnMinimize;
    property OnRestore: TNotifyEvent read FOnRestore write FOnRestore;
    property OnMaximize: TNotifyEvent read FOnMaximize write FOnMaximize;

    property OnShortCut: TShortCutEvent read FOnShortCut write FOnShortCut;
  end;

  TbsMDITab = class(TObject)
  protected
    TabsBar: TbsSkinMDITabsBar;
  public
    Active, MouseIn: Boolean;
    ObjectRect: TRect;
    Child: TCustomForm;
    Visible: Boolean;
    constructor Create(AParentBar: TbsSkinMDITabsBar; AChild: TCustomForm);
    procedure Draw(Cnvs: TCanvas);
    procedure ResizeDraw(Cnvs: TCanvas);
    procedure ButtonDraw(Cnvs: TCanvas);
  end;

  TbsMDITabMouseEnterEvent = procedure (MDITab: TbsMDITab) of object;
  TbsMDITabMouseLeaveEvent = procedure (MDITab: TbsMDITab) of object;
  TbsMDITabMouseDownEvent = procedure (Button: TMouseButton; Shift: TShiftState; MDITab: TbsMDITab) of object;
  TbsMDITabMouseUpEvent = procedure (Button: TMouseButton; Shift: TShiftState; MDITab: TbsMDITab) of object;

  TbsSkinMDITabKind = (bstkTab, bstkButton);

  TbsSkinMDITabsBar = class(TbsSkinControl)
  private
    FMinTabWidth: Integer;
    FTabKind: TbsSkinMDITabKind;
    FSupportChildMenus: Boolean;
    IsDrag: Boolean;
    DX, TabDX: Integer;
    FDown: Boolean;
    DragIndex: Integer;
    FOnTabMouseEnter: TbsMDITabMouseEnterEvent;
    FOnTabMouseLeave: TbsMDITabMouseLeaveEvent;
    FOnTabMouseUp: TbsMDITabMouseUpEvent;
    FOnTabMouseDown: TbsMDITabMouseDownEvent;
    FDefaultTabWidth: Integer;
    FDefaultHeight: Integer;
    FDefaultFont: TFont;
    ActiveTabIndex, OldTabIndex: Integer;
    FMoveTabs: Boolean;
    FUseSkinSize: Boolean;
    FUseSkinFont: Boolean;
    BSF: TbsBusinessSkinForm;
    FListButton: TbsSkinMenuSpeedButton;
    FHideListButton: TbsSkinMenuSpeedButton;
    FListMenu: TbsSkinPopupMenu;
    FHideListMenu: TbsSkinPopupMenu;
    FUpDown: TbsSkinUpDown;
    FInVisibleCount: Integer;

    procedure ShowListButton;
    procedure HideListButton;
    procedure UpdateListMenu;
    procedure OnShowListMenu(Sender: TObject);

    procedure ShowHideListButton;
    procedure HideHideListButton;
    procedure UpdateHideListMenu;
    procedure OnShowHideListMenu(Sender: TObject);

    procedure SetDefaultHeight(Value: Integer);
    procedure SetDefaultFont(Value: TFont);
    procedure CalcObjectRects;
    procedure TestActive(X, Y: Integer);
    procedure CheckActive;
    procedure SetTabKind(Value: TbsSkinMDITabKind);
    procedure MDIItemClick(Sender: TObject);
    procedure HideMDIItemClick(Sender: TObject);
  protected
    procedure CreateControlDefaultImage(B: TBitMap); override;
    procedure CreateControlSkinImage(B: TBitMap); override;
    procedure ClearObjects;
    procedure GetSkinData; override;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
                        X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    function GetMoveIndex: Integer;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure WMCHECKPARENTBG(var Msg: TWMEraseBkgnd); message WM_CHECKPARENTBG;
    procedure WMMOVE(var Msg: TWMMOVE); message WM_MOVE;
  public
    ObjectList: TList;
    Picture: TBitMap;
    TabRect, ActiveTabRect, MouseInTabRect: TRect;
    TabsBGRect: TRect;
    TabLeftOffset, TabRightOffset: Integer;
    FontName: String;
    FontStyle: TFontStyles;
    FontHeight: Integer;
    FontColor, ActiveFontColor, MouseInFontColor: TColor;
    UpDown: String;
    TabStretchEffect: Boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetTab(X, Y: Integer): TbsMDITab;
    function GetTabIndex(X, Y: Integer): Integer;
     procedure AddTab(Child: TCustomForm);
    procedure DeleteTab(Child: TCustomForm);
    procedure ChangeSkinData; override;
    procedure Paint; override;
  published
    property TabKind: TbsSkinMDITabKind read FTabKind write SetTabKind;
    property BusinessSkinForm: TbsBusinessSkinForm read BSF write BSF;
    property SupportChildMenus: Boolean
      read FSupportChildMenus write FSupportChildMenus;
    property UseSkinSize: Boolean read FUseSkinSize write FUseSkinSize;
    property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont; 
    property MoveTabs: Boolean read FMoveTabs write FMoveTabs;
    property DefaultHeight: Integer read FDefaultHeight write SetDefaultHeight;
    property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
    property DefaultTabWidth: Integer read FDefaultTabWidth write FDefaultTabWidth;
    property MinTabWidth: Integer read FMinTabWidth write FMinTabWidth;
    property Align;
    property PopupMenu;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property BiDiMode;
    property Enabled;
    property ParentShowHint;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnTabMouseEnter: TbsMDITabMouseEnterEvent
      read FOnTabMouseEnter write FOnTabMouseEnter;
    property OnTabMouseLeave: TbsMDITabMouseLeaveEvent
      read FOnTabMouseLeave write FOnTabMouseLeave;
    property OnTabMouseUp: TbsMDITabMouseUpEvent
      read FOnTabMouseUp write FOnTabMouseUp;
    property OnTabMouseDown: TbsMDITabMouseDownEvent
      read FOnTabMouseDown write FOnTabMouseDown;
    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;
    property OnContextPopup;
  end;

  TbsSkinFrame = class(TbsSkinComponent)
  private
    FFrame: TFrame;
    OldWindowProc: TWndMethod;
    FDrawBackground: Boolean;
    FCtrlsSkinData: TbsSkinData;
    procedure SetCtrlsSkinData(Value: TbsSkinData);
    procedure PaintBG(DC: HDC);
    procedure NewWndProc(var Message: TMessage);
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure CheckControlsBackground;
    procedure WMSize(var Message: TWMSIZE); message WM_SIZE;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ChangeSkinData; override;
    procedure UpdateSkinCtrls(WC: TWinControl);
  published
    property DrawBackground: Boolean read FDrawBackground write FDrawBackground;
    property CtrlsSkinData: TbsSkinData read FCtrlsSkinData write SetCtrlsSkinData;
  end;

  function GetBusinessSkinFormComponent(AForm: TCustomForm): TbsBusinessSkinForm;
  function GetMDIChildBusinessSkinFormComponent: TbsBusinessSkinForm;
  function GetMDIChildBusinessSkinFormComponent2: TbsBusinessSkinForm;

implementation
   Uses bsEffects, bsConst{$IFDEF TNTUNICODE}, TntForms, TntMenus{$ENDIF};

const
   BSF_PRODUCT_VERSION = '6.07';

   WS_EX_LAYERED = $80000;
   MouseTimerInterval = 50;
   MorphTimerInterval = 25;
   AnimateTimerInterval = 25;
   MorphInc = 0.2;
   // effects cosnts
   InActiveBrightnessKf = 0.5;
   InActiveDarknessKf = 0.3;
   InActiveNoiseAmount = 50;
   //
   HTNCACTIVE = HTOBJECT;
   TRACKMARKEROFFSET = 5;
   MDITABSBARLISTBUTTONW = 15;

   DEFCAPTIONHEIGHT = 19;
   DEFBUTTONSIZE = 17;

   DEFTOOLCAPTIONHEIGHT = 15;
   DEFTOOLBUTTONSIZE = 13;

   DEFFORMMINWIDTH = 120;

   TMI_RESTORENAME = 'TRAY_BSF_RESTORE';
   TMI_CLOSENAME = 'TRAY_BSF_CLOSE';

   MI_MINNAME = 'BSF_MINITEM';
   MI_MAXNAME = 'BSF_MAXITEM';
   MI_CLOSENAME = 'BSF_CLOSE';
   MI_RESTORENAME = 'BSF_RESTORE';
   MI_MINTOTRAYNAME = 'BSF_MINTOTRAY';
   MI_ROLLUPNAME = 'BSF_ROLLUP';
   MI_CHILDITEM = '_BSFCHILDITEM';
   MI_CHILDITEMBAR = '_BSFCHILDITEMBAR';
   MI_CHILDITEMBARHIDE = '_BSFCHILDITEMBARHIDE';


   WM_MDICHANGESIZE = WM_USER + 206;
   WM_MDICHILDMAX = WM_USER + 207;
   WM_MDICHILDRESTORE = WM_USER + 208;

   // 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!

function GetBusinessSkinFormComponent;
var
  i: Integer;
begin
  Result := nil;
  if AForm <> nil then
  for i := 0 to AForm.ComponentCount - 1 do
    if AForm.Components[i] is TbsBusinessSkinForm
    then
      begin
        Result := (AForm.Components[i] as TbsBusinessSkinForm);
        Break;
      end;
end;

function GetMDIChildBusinessSkinFormComponent;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to Application.MainForm.MDIChildCount - 1 do
  begin
    Result := GetBusinessSkinFormComponent(Application.MainForm.MDIChildren[i]);
    if (Result <> nil) and (Result.WindowState = wsMaximized)
    then
      Break
    else
      Result := nil;
  end;
end;

function GetMDIChildBusinessSkinFormComponent2;
begin
  if (Application.MainForm <> nil) and (Application.MainForm.ActiveMDIChild <> nil)
  then
    Result := GetBusinessSkinFormComponent(Application.MainForm.ActiveMDIChild)
  else
   Result := nil;
end;

//============= TbsSkinComponent  ============= //