dynamicskinform.pas

一套及时通讯的原码

    procedure SwitchChangeStateEvent(IDName: String; State: TSwitchState);
    procedure TrackBarChangeValueEvent(IDName: String; Value: Integer);
    procedure FrameRegulatorChangeValueEvent(IDName: String; Value: Integer);
    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 LinkControlsToAreas;
    procedure SetDefaultCaptionText(AValue: String);

    procedure SkinMainMenuClose;
    procedure SkinMenuClose2;

    procedure ArangeMinimizedChilds;

    function GetAutoRenderingInActiveImage: Boolean;

    procedure SetAlphaBlendValue(Value: Byte);
    procedure SetAlphaBlend(Value: Boolean);
  public
    SkinMenu: TspSkinMenu;
    FForm: TForm;
    ObjectList, AreaList: 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: TspActiveSkinObject);

    procedure SetFormStyle(FS: TFormStyle);
    procedure LinkControlToArea(AreaName: String; Control: TControl);
    procedure UnLinkControlFromArea(Control: TControl);
    procedure UpdateMainMenu(ARedraw: Boolean);
    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 Paint(DC: HDC);
    procedure PaintNCSkin;
    procedure PaintBG(DC: HDC);
    procedure PaintBG2(DC: HDC);
    //
    procedure PaintNCDefault;
    procedure PaintBGDefault(DC: HDC);
    procedure PaintMDIBGDefault(DC: HDC);
    procedure CalcDefRects;
    //
    procedure SetSupportNCArea(Value: Boolean);

    procedure SetEnabled(AIDName: String; Value: Boolean);
    procedure CaptionSetText(AIDName, AText: String);
    procedure AnimateStart(AIDName: String);
    procedure AnimateStop(AIDName: String);
    procedure BitLabelSetText(AIDName: String; AValue: String);
    procedure GaugeSetValue(AIDName: String; AValue: Integer);
    procedure FrameGaugeSetValue(AIDName: String; AValue: Integer);
    procedure ButtonSetDown(AIDName: String; ADown: Boolean);
    function ButtonGetDown(AIDName: String): Boolean;
    procedure SwitchSetState(AIDName: String; AState: TSwitchState);
    function SwitchGetState(AIDName: String): TSwitchState;
    function TrackBarGetValue(AIDName: String): Integer;
    procedure TrackBarSetValue(AIDName: String; AValue: Integer);
    function FrameRegulatorGetValue(AIDName: String): Integer;
    procedure FrameRegulatorSetValue(AIDName: String; AValue: Integer);
    procedure LabelSetText(AIDName, ATextValue: String);
    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 ShowIcon: Boolean read FShowIcon write SetShowIcon;
    property MaximizeOnFullScreen: Boolean
      read FMaximizeOnFullScreen write FMaximizeOnFullScreen;
    property SkinHint: TspSkinHint read FSkinHint write FSkinHint;
    property ShowObjectHint: Boolean read FShowObjectHint write FShowObjectHint;
    property UseSkinCursors: Boolean read FUseSkinCursors write FUseSkinCursors;
    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: TspTrayIcon read FTrayIcon write SetTrayIcon;
    property UseDefaultSysMenu: Boolean
      read FUseDefaultSysMenu write FUseDefaultSysMenu;
    property MainMenuBar: TspSkinMainMenuBar read FMainMenuBar write FMainMenuBar;
    property SupportNCArea: Boolean read FSupportNCArea
                                    write SetSupportNCArea;

    property AlphaBlendAnimation: Boolean read
      FAlphaBlendAnimation write FAlphaBlendAnimation;                                  
    property AlphaBlendValue: Byte read FAlphaBlendValue
                                   write SetAlphaBlendValue;
    property AlphaBlend: Boolean read FAlphaBlend
                                       write SetAlphaBlend;

    property MenusAlphaBlend: Boolean
      read FMenusAlphaBlend write SetMenusAlphaBlend;

    property MenusAlphaBlendAnimation: Boolean
      read FMenusAlphaBlendAnimation write SetMenusAlphaBlendAnimation;

    property MenusAlphaBlendValue: Byte
      read FMenusAlphaBlendValue write SetMenusAlphaBlendValue;
      
    property MainMenu: TMainMenu read FMainMenu write SetMainMenu;
    property SystemMenu: TPopupMenu read FSystemMenu write FSystemMenu;
    property SkinData: TspSkinData read FSD write SetSkinData;
    property MenusSkinData: TspSkinData read FMSD write SetMenusSkinData;
    property MinHeight: Integer read FMinHeight write  FMinHeight;
    property MinWidth: Integer read FMinWidth write  FMinWidth;
    property Sizeable: Boolean read FSizeable write FSizeable;
    property DraggAble: Boolean read FDraggAble write FDraggAble;
    property Magnetic: Boolean read  FMagnetic write FMagnetic;
    property MagneticSize: Byte read  FMagneticSize write FMagneticSize;
    property BorderIcons: TspBorderIcons read FBorderIcons write SetBorderIcons;

    property OnChangeClientRect: TChangeClientRectEvent
      read FOnChangeClientRect write FOnChangeClientRect;

    property OnChangeSkinData: TNotifyEvent read FOnChangeSkinData
                                            write FOnChangeSkinData;

    property OnMouseUpEvent: TspMouseUpEvent read FOnMouseUpEvent
                                           write FOnMouseUpEvent;
    property OnMouseDownEvent: TMouseDownEvent read FOnMouseDownEvent
                                               write FOnMouseDownEvent;
    property OnMouseMoveEvent: TMouseMoveEvent read FOnMouseMoveEvent
                                               write FOnMouseMoveEvent;
    property OnMouseEnterEvent: TMouseEnterEvent read FOnMouseEnterEvent
                                                 write FOnMouseEnterEvent;
    property OnMouseLeaveEvent: TMouseLeaveEvent read FOnMouseLeaveEvent
                                                 write FOnMouseLeaveEvent;
    property OnPaintEvent: TPaintEvent read FOnPaintEvent
                                       write FOnPaintEvent;
    property OnSwitchChangeStateEvent: TSwitchChangeStateEvent
                                       read FOnSwitchChangeStateEvent
                                       write FOnSwitchChangeStateEvent;
    property OnTrackBarChangeValueEvent: TTrackBarChangeValueEvent
                                       read FOnTrackBarChangeValueEvent
                                       write FOnTrackBarChangeValueEvent;
    property OnFrameRegulatorChangeValueEvent: TFrameRegulatorChangeValueEvent
                                       read FOnFrameRegulatorChangeValueEvent
                                       write FOnFrameRegulatorChangeValueEvent;
    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 GetDynamicSkinFormComponent(AForm: TForm): TspDynamicSkinForm;
  function GetMDIChildDynamicSkinFormComponent: TspDynamicSkinForm;
  function GetMDIChildDynamicSkinFormComponent2: TspDynamicSkinForm;

  implementation

type
  PAreaInfo = ^TAreaInfo;
  TAreaInfo = record
    Control: TControl;
    AreaRect: TRect;
  end;

const
   WS_EX_LAYERED = $80000; 
   InActiveBrightnessKf = 0.5;
   InActiveDarknessKf = 0.3;
   InActiveNoiseAmount = 50;

   MorphInc = 0.1;
   MouseTimerInterval = 50;
   MorphTimerInterval = 20;
   AnimateTimerInterval = 25;
   HTNCACTIVE = HTOBJECT;
   TRACKMARKEROFFSET = 5;

   DEFCAPTIONHEIGHT = 19;
   DEFBUTTONSIZE = 17;
   DEFTOOLCAPTIONHEIGHT = 15;
   DEFTOOLBUTTONSIZE = 13;
   DEFFORMMINWIDTH = 130;

   TMI_RESTORENAME = 'TRAY_DSF_RESTORE';
   TMI_CLOSENAME = 'TRAY_DSF_CLOSE';

   MI_MINNAME = 'DSF_MINITEM';
   MI_MAXNAME = 'DSF_MAXITEM';
   MI_CLOSENAME = 'DSF_CLOSE';
   MI_RESTORENAME = 'DSF_RESTORE';
   MI_MINTOTRAYNAME = 'DSF_MINTOTRAY';
   MI_ROLLUPNAME = 'DSF_ROLLUP';

   MI_MINCAPTION = 'Mi&nimize';
   MI_MAXCAPTION = 'Ma&ximize';
   MI_CLOSECAPTION = '&Close';
   MI_RESTORECAPTION = '&Restore';
   MI_MINTOTRAYCAPTION = 'Minimize to &Tray';
   MI_ROLLUPCAPTION = 'Ro&llUp';

   MI_CHILDITEM = '_DSFCHILDITEM'; 

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

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

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

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

//============= TspActiveSkinObject  =============//

constructor TspActiveSkinObject.Create;
begin
  Parent := AParent;
  SD := Parent.SkinData;
  Enabled := True;
  Visible := True;
  FMorphKf := 0;
  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;
        Self.CursorIndex := CursorIndex;
        Self.RollUp := RollUp;
        if (ActivePictureIndex <> - 1) and
           (ActivePictureIndex < SD.FActivePictures.Count)
        then
          ActivePicture := TBitMap(SD.FActivePictures.Items[ActivePictureIndex])
        else
          begin
            ActivePicture := nil;
            ActiveSkinRect := NullRect;
          end;
      end;
      ObjectRect := SkinRect;
      if RollUp then Picture := SD.FRollUpPicture else Picture := SD.FPicture;
    end;
end;

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

procedure TspActiveSkinObject.DblClick;
begin

end;

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

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

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

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

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

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

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

procedure TspActiveSkinObject.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: TspEffectBmp;
  Buffer, ABuffer: TBitMap;