businessskinform.pas

BusinessSkinForm Ver3.95 full source_汉化版_最新

    ObjectRect: TRect;
    Child: TCustomForm;
    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
    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;
    procedure SetDefaultHeight(Value: Integer);
    procedure SetDefaultFont(Value: TFont);
    procedure CalcObjectRects;
    procedure TestActive(X, Y: Integer);
    procedure CheckActive;
    procedure SetTabKind(Value: TbsSkinMDITabKind);
  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;
  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;
    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;
  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 Align;
    property PopupMenu;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    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;

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

implementation
   Uses bsEffects, bsConst;

const
   WS_EX_LAYERED = $80000;
   MouseTimerInterval = 50;
   MorphTimerInterval = 20;
   AnimateTimerInterval = 25;
   MorphInc = 0.2;
   // 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;
  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  ============= //

constructor TbsSkinComponent.Create(AOwner: TComponent);
begin
  inherited;
  FSkinData := nil;
end;

procedure TbsSkinComponent.SetSkinData(Value: TbsSkinData);
begin
  FSkinData := Value;
end;

procedure TbsSkinComponent.Notification;
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FSkinData) then FSkinData := nil;
end;

procedure TbsSkinComponent.BeforeChangeSkinData;
begin
end;

procedure TbsSkinComponent.ChangeSkinData;
begin
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.InActiveSkinRect:= InActiveSkinRect;
        Self.Morphing := Morphing;
        Self.MorphKind := MorphKind;
        if (ActivePictureIndex <> - 1) and
           (ActivePictureIndex < SD.FActivePictures.Count)
        then
          ActivePicture := TBitMap(SD.FActivePictures.Items[ActivePictureIndex])
        else
          begin
            ActivePicture := nil;
            ActiveSkinRect := NullRect;
          end;
      end;
      if Morphing and IsNullRect(ActiveSkinRect) then Morphing := False;
      ObjectRect := SkinRect;
      Picture := SD.FPicture;
    end;
end;

function TbsActiveSkinObject.EnableMorphing: Boolean;
begin
  Result := Morphing and (Parent.SkinData <> nil) and
            Parent.SkinData.EnableSkinEffects;
end;

procedure TbsActiveSkinObject.ReDraw;
begin
  if EnableMorphing
  then Parent.MorphTimer.Enabled := True
  else Parent.DrawSkinObject(Self);
end;

procedure TbsActiveSkinObject.DblClick;
begin

end;

procedure TbsActiveSkinObject.MouseDown(X, Y: Integer; Button: TMouseButton);
begin
  Parent.MouseDownEvent(IDName, X, Y, ObjectRect, Button);
end;

procedure TbsActiveSkinObject.MouseUp(X, Y: Integer; Button: TMouseButton);
begin
  if FMouseIn then Parent.MouseUpEvent(IDName, X, Y, ObjectRect, Button);
end;

procedure TbsActiveSkinObject.MouseMove(X, Y: Integer);
begin
  Parent.MouseMoveEvent(IDName, X, Y, ObjectRect);
end;

procedure TbsActiveSkinObject.MouseEnter;
begin
  FMouseIn := True;
  Active := True;
  if not IsNullRect(ActiveSkinRect) then ReDraw;
  Parent.MouseEnterEvent(IDName);
end;

procedure TbsActiveSkinObject.MouseLeave;
begin
  FMouseIn := False;
  Active := False;
  if not IsNullRect(ActiveSkinRect) then ReDraw;
  Parent.MouseLeaveEvent(IDName);
end;

function TbsActiveSkinObject.CanMorphing;
begin
  Result := (Active and (MorphKf < 1)) or
            (not Active and (MorphKf > 0));
end;

procedure TbsActiveSkinObject.DoMorphing;
begin
  if Active
  then MorphKf := MorphKf + MorphInc
  else MorphKf := MorphKf - MorphInc;
  Parent.DrawSkinObject(Self);
end;

procedure TbsActiveSkinObject.Draw;

procedure CreateObjectImage(B: TBitMap; AActive: Boolean);
begin
  B.Width := RectWidth(ObjectRect);
  B.Height := RectHeight(ObjectRect);
  with B.Canvas do
  begin
    if AActive
    then
      CopyRect(Rect(0, 0, B.Width, B.Height), ActivePicture.Canvas, ActiveSkinRect)
    else
      if SkinRectInApicture
      then
        CopyRect(Rect(0, 0, B.Width, B.Height), ActivePicture.Canvas, SkinRect)
      else
        CopyRect(Rect(0, 0, B.Width, B.Height), Picture.Canvas, SkinRect);
  end;
end;

var
  PBuffer, APBuffer: TbsEffectBmp;
  Buffer, ABuffer: TBitMap;
  ASR, SR: TRect;
begin
  ASR := ActiveSkinRect;
  SR := SkinRect;
  if Enabled and (not Parent.GetFormActive) and (not IsNullRect(InActiveSkinRect)) 
  then
    begin
      Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, InActiveSkinRect)
    end
  else
  if not EnableMorphing or
     ((Active and (MorphKf = 1)) or (not Active and (MorphKf  = 0)))
  then
    begin
      if Active and not IsNullRect(ASR)
      then
        Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, ASR)
      else
        if UpDate or SkinRectInApicture
        then
          begin
            if SkinRectInApicture
            then
              Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, SR)
            else
              Cnvs.CopyRect(ObjectRect, Picture.Canvas, SR);
          end;
    end
  else
    begin
      Buffer := TBitMap.Create;
      ABuffer := TBitMap.Create;
      CreateObjectImage(Buffer, False);
      CreateObjectImage(ABuffer, True);
      PBuffer := TbsEffectBmp.CreateFromhWnd(Buffer.Handle);
      APBuffer := TbsEffectBmp.CreateFromhWnd(ABuffer.Handle);
      case MorphKind of
        mkDefault: PBuffer.Morph(APBuffer, MorphKf);
        mkGradient: PBuffer.MorphGrad(APBuffer, MorphKf);
        mkLeftGradient: PBuffer.MorphLeftGrad(APBuffer, MorphKf);
        mkRightGradient: PBuffer.MorphRightGrad(APBuffer, MorphKf);
        mkLeftSlide: PBuffer.MorphLeftSlide(APBuffer, MorphKf);
        mkRightSlide: PBuffer.MorphRightSlide(APBuffer, MorphKf);
        mkPush: PBuffer.MorphPush(APBuffer, MorphKf);
      end;
      PBuffer.Draw(Cnvs.Handle, ObjectRect.Left, ObjectRect.Top);
      PBuffer.Free;
      APBuffer.Free;
      Buffer.Free;
      ABuffer.Free;
    end;
end;

procedure TbsActiveSkinObject.SetMorphKf(Value: Double);
begin
  FMorphKf := Value;
  if FMorphKf < 0 then FMorphKf := 0 else
  if FMorphKf > 1 then FMorphKf := 1;