businessskinform.pas

漂亮的皮肤控件 for delphi 567

    NewMaskRectArea: TRect;
    NewHitTestLTPoint,
    NewHitTestRTPoint,
    NewHitTestLBPoint,
    NewHitTestRBPoint: TPoint;
    NewDefCaptionRect: TRect;
    FMinHeight, FMinWidth: Integer;
    OldWindowProc: TWndMethod;
    FClientInstance: Pointer;
    FPrevClientProc: Pointer;
    FSD: TbsSkinData;
    FMSD: TbsSkinData;
    FMainMenu: TMainMenu;
    FSystemMenu: TPopupMenu;
    FOnChangeSkinData: TNotifyEvent;
    FOnActivate: TNotifyEvent;
    FOnDeActivate: TNotifyEvent;
    FOnChangeRollUpState: TNotifyEvent;
    FInChangeSkinData: Boolean;
    FWindowState: TWindowState;
    FMagneticSize: Byte;
    OldAppMessage: TMessageEvent;

    procedure CheckMDIMainMenu;

    procedure SetLogoBitMap(Value: TBitMap);

    procedure SetShowIcon(Value: Boolean);
    
    procedure UpDateActiveObjects;

    procedure SetMenusAlphaBlend(Value: Boolean);
    procedure SetMenusAlphaBlendAnimation(Value: Boolean);
    procedure SetMenusAlphaBlendValue(Value: Byte);

    function GetDefCaptionRect: TRect;

    function GetDefCaptionHeight: Integer;
    function GetDefButtonSize: Integer;

    function IsSizeAble: Boolean;
    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: TbsBorderIcons);
    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 CreateSysMenu;
    procedure CreateUserSysMenu;
    procedure CreateSysTrayMenu;
    function GetSystemMenu: TMenuItem;
    procedure CalcRects;
    procedure FormShortCut(var Msg: TWMKey; var Handled: Boolean);
    procedure ChangeSkinData;
    procedure CreateRollUpForm;
    procedure RestoreRollUpForm;
    procedure SetRollUpState(Value: Boolean);
    procedure SetTrayIcon(Value: TbsTrayIcon);

    procedure BeforeUpDateSkinControls(AFSD: Integer; WC: TWinControl);
    procedure UpDateSkinControls(AFSD: Integer; WC: TWinControl);

    procedure CheckObjects;
    procedure SetWindowState(Value: TWindowState);
    procedure SetSkinData(Value: TbsSkinData);
    procedure SetMenusSkinData(Value: TbsSkinData);
    procedure NewWndProc(var Message: TMessage);
    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 SetAlphaBlendValue(Value: Byte);
    procedure SetAlphaBlend(Value: Boolean);

    procedure GetIconSize(var X, Y: Integer);
    procedure GetIcon;
    procedure DrawFormIcon(Cnvs: TCanvas; X, Y: Integer);
    function GetUseSkinFontInMenu: Boolean;
    procedure SetUseSkinFontInMenu(Value: Boolean);
  protected
    InMenu: Boolean;
    InMainMenu: Boolean;

    FRgn: HRGN;
    MouseTimer: TTimer;
    MorphTimer: TTimer;
    AnimateTimer: TTimer;
    FMagnetic: Boolean;

    FOnSkinMenuOpen: TNotifyEvent;
    FOnSkinMenuClose: TNotifyEvent;
    FOnMainMenuEnter: TNotifyEvent;
    FOnMainMenuExit: TNotifyEvent;

    FOnMouseEnterEvent: TbsMouseEnterEvent;
    FOnMouseLeaveEvent: TbsMouseLeaveEvent;
    FOnMouseUpEvent : TbsMouseUpEvent;
    FOnMouseDownEvent : TbsMouseDownEvent;
    FOnMouseMoveEvent: TbsMouseMoveEvent;
    FOnPaintEvent: TbsPaintEvent;
    ActiveObject, OldActiveObject, MouseCaptureObject: Integer;
    OldWindowState: TWindowState;

    procedure DrawLogoBitMap(C: TCanvas);
    procedure CorrectCaptionText(C: TCanvas; var S: String; W: Integer);
    procedure CheckMenuVisible(var Msg: Cardinal);
    procedure FormKeyDown(Message: TMessage);
    function GetFullDragg: Boolean;
    function GetMinimizeCoord: TPoint;
    procedure PointToNCPoint(var P: TPoint);
    function CheckReturnKey: Boolean;
    function CanNextMainMenuItem: Boolean;
    function CanPriorMainMenuItem: Boolean;
    function FindHotKeyItem(CharCode: Integer): Boolean;

    procedure DoMagnetic(var L, T: Integer; W, H: Integer);

    procedure TestMouse(Sender: TObject);
    procedure TestMorph(Sender: TObject);
    procedure TestAnimate(Sender: TObject);

    procedure TestActive(X, Y: Integer; InFrm: Boolean);

    procedure MouseDown(Button: TMouseButton;  X, Y: Integer);
    procedure MouseDBlClick;
    procedure MouseMove(X, Y: Integer);
    procedure MouseUp(Button: TMouseButton; X, Y: Integer);

    function CalcRealObjectRect(R: TRect): TRect;
    procedure CalcAllRealObjectRect;

    procedure Notification(AComponent: TComponent;
                           Operation: TOperation); override;
    procedure LoadObjects;
    procedure LoadDefObjects;
    
    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 SkinMainMenuClose;
    procedure SkinMenuClose2;

    procedure ArangeMinimizedChilds;
    function GetAutoRenderingInActiveImage: Boolean;

  public
    SkinMenu: TbsSkinMenu;
    FForm: TForm;
    ObjectList: 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: TbsActiveSkinObject);
    //
    procedure SetFormStyle(FS: TFormStyle);
    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 PaintNCSkin;
    procedure PaintBG(DC: HDC);
    procedure PaintBG2(DC: HDC);
    procedure PaintBG3(DC: HDC);
    //
    procedure PaintNCDefault;
    procedure PaintBGDefault(DC: HDC);
    procedure PaintMDIBGDefault(DC: HDC);
    procedure CalcDefRects;
    //
    procedure SetEnabled(AIDName: String; Value: Boolean);
    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 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 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 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 Magnetic: Boolean read  FMagnetic write FMagnetic;
    property MagneticSize: Byte read  FMagneticSize write FMagneticSize;
    property BorderIcons: TbsBorderIcons read FBorderIcons write SetBorderIcons;

    property OnChangeSkinData: TNotifyEvent read FOnChangeSkinData
                                            write FOnChangeSkinData;

    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;
  end;

  function GetBusinessSkinFormComponent(AForm: TForm): TbsBusinessSkinForm;
  function GetMDIChildBusinessSkinFormComponent: TbsBusinessSkinForm;
  function GetMDIChildBusinessSkinFormComponent2: TbsBusinessSkinForm;
implementation
   Uses bsEffects, bsConst;

   
const
   WS_EX_LAYERED = $80000;
   MouseTimerInterval = 50;
   MorphTimerInterval = 20;
   AnimateTimerInterval = 25;
   MorphInc = 0.1;
   // effects cosnts
   InActiveBrightnessKf = 0.5;
   InActiveDarknessKf = 0.3;
   InActiveNoiseAmount = 50;
   //
   HTNCACTIVE = HTOBJECT;
   TRACKMARKEROFFSET = 5;

   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';

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

function GetBusinessSkinFormComponent;
var
  i: Integer;
begin
  Result := nil;
  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;

//============= TbsActiveSkinObject  =============//

constructor TbsActiveSkinObject.Create;
begin
  Visible := True;
  Enabled := True;
  Parent := AParent;
  SD := Parent.SkinData;
  FMorphKf := 0;
  Morphing := False;
  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;
        if (ActivePictureIndex <> - 1) and
           (ActivePictureIndex < SD.FActivePictures.Count)
        then
          ActivePicture := TBitMap(SD.FActivePictures.Items[ActivePictureIndex])
        else
          begin