spcategorybuttons.pas

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

{    property InterfaceData: IInterface read FInterfaceData write FInterfaceData; }
    procedure ScrollIntoView; override;
    property Category: TspButtonCategory read GetCategory;
  published
    property ButtonGroup: TspSkinCategoryButtons read GetButtonGroup;
  end;

  TspButtonCollection = class(TCollection)
  private
    FCategory: TspButtonCategory;
    function GetItem(Index: Integer): TspButtonItem;
    procedure SetItem(Index: Integer; const Value: TspButtonItem);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
{    procedure Notify(Item: TCollectionItem;
      Action: TCollectionNotification); override;}
  public
    constructor Create(const ACategory: TspButtonCategory);
    function Add: TspButtonItem;
    function AddItem(Item: TspButtonItem; Index: Integer): TspButtonItem;
    function Insert(Index: Integer): TspButtonItem;
    property Items[Index: Integer]: TspButtonItem read GetItem write SetItem; default;
    property Category: TspButtonCategory read FCategory;
  end;

  TspButtonCategory = class(TCollectionItem)
  private
    FCaption: string;
    FCollapsed: Boolean;
    FItems: TspButtonCollection;
    FStart: Integer;
    FEnd: Integer;
    FData: Pointer;
{    FInterfaceData: IInterface;}
    function GetCategories: TspButtonCategories;
    procedure SetItems(const Value: TspButtonCollection);
    procedure SetCollapsed(const Value: Boolean);
    procedure SetCaption(const Value: string);
  protected
    procedure SetIndex(Value: Integer); override;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure ScrollIntoView;
    function IndexOf(const Caption: string): Integer;
    property Categories: TspButtonCategories read GetCategories;
    property Data: Pointer read FData write FData;
{    property InterfaceData: IInterface read FInterfaceData write FInterfaceData;}
    procedure Assign(Source: TPersistent); override;
  published
    property Caption: string read FCaption write SetCaption;
    property Collapsed: Boolean read FCollapsed write SetCollapsed;
    property Items: TspButtonCollection read FItems write SetItems;
  end;

  TspButtonCategories = class(TCollection)
  private
    FButtonGroup: TspSkinCategoryButtons;
    FOriginalID: Integer;
    function GetItem(Index: Integer): TspButtonCategory;
    procedure SetItem(Index: Integer; const Value: TspButtonCategory);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(const ButtonGroup: TspSkinCategoryButtons);
    function Add: TspButtonCategory;
    function AddItem(Item: TspButtonCategory; Index: Integer): TspButtonCategory;
    procedure BeginUpdate; override;
    function Insert(Index: Integer): TspButtonCategory;
    function IndexOf(const Caption: string): Integer;
    property Items[Index: Integer]: TspButtonCategory read GetItem write SetItem; default;
    property ButtonGroup: TspSkinCategoryButtons read FButtonGroup;
  end;

{ TspButtonItemActionLink }

  TspButtonItemActionLink = class(TActionLink)
  protected
    FClient: TspBaseButtonItem;
    procedure AssignClient(AClient: TObject); override;
    function IsCaptionLinked: Boolean; override;
    function IsHintLinked: Boolean; override;
    function IsImageIndexLinked: Boolean; override;
    function IsOnExecuteLinked: Boolean; override;
    procedure SetCaption(const Value: string); override;
    procedure SetHint(const Value: string); override;
    procedure SetImageIndex(Value: Integer); override;
    procedure SetOnExecute(Value: TNotifyEvent); override;
  public
    function DoShowHint(var HintStr: string): Boolean; virtual;
  end;

implementation

{$R spCategoryButtons.res} { Contains the Copy DragCursor }

{ TspSkinCategoryButtons }

constructor TspSkinCategoryButtons.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIs9XOS := Is9XOs;
  if FIs9XOS
  then
    begin
      FMouseTimer := TTimer.Create(Self);
      FMouseTimer.Enabled := False;
      FMouseTimer.Interval := 100;
      FMouseTimer.OnTimer := OnMouseTimerEvent;
    end;
  FButtonsSkinDataName := 'resizetoolbutton';
  FCategorySkinDataName := 'resizetoolpanel';
  FUseSkinFont := True;
  Font.Name := 'Arial';
  FShowBorder := False;
  FScrollBarPos := 0;
  Width := 100;
  Height := 100;
  ControlStyle := [csDoubleClicks, csCaptureMouse, csDisplayDragImage, csAcceptsControls];
  FSkinScrollBar := nil;
  FButtonCategories := GetButtonCategoriesClass.Create(Self);
  FButtonWidth := 24;
  FButtonHeight := 24;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
  FDoubleBuffered := True;
  FDragImageList := TDragImageList.Create(nil);
  FButtonOptions := [spboShowCaptions, spboVerticalCategoryCaptions];
  FHotButtonColor := SP_XP_BTNACTIVECOLOR;
  TabStop := True;
end;

procedure TspSkinCategoryButtons.OnMouseTimerEvent(Sender: TObject);
var
  P: TPoint;
begin
  GetCursorPos(P);
  if WindowFromPoint(P) <> Self.Handle
  then
    begin
      FMouseTimer.Enabled := False;
      SendMessage(Handle, WM_MOUSELEAVE, 0, 0);
    end;
end;

procedure TspSkinCategoryButtons.WMNCPAINT(var Message: TMessage);
begin
  if FShowBorder
  then
    PaintBorder(0, False)
  else
    inherited;
end;

procedure TspSkinCategoryButtons.PaintBorder;
begin
  if (SkinData <> nil) and (not SkinData.Empty) and
     (SkinData.GetControlIndex('panel') <> -1)
  then
    PaintSkinBorder(ADC, AUseExternalDC)
  else
    PaintDefaultBorder(ADC, AUseExternalDC);
end;

procedure TspSkinCategoryButtons.PaintDefaultBorder;
var
  DC: HDC;
  Cnvs: TControlCanvas;
  R: TRect;
begin

  if not AUseExternalDC
  then
    DC := GetWindowDC(Handle)
  else
    DC := ADC;

  Cnvs := TControlCanvas.Create;
  Cnvs.Handle := DC;
  R := Rect(0, 0, Width, Height);
  InflateRect(R, -2, -2);

  if R.Bottom > R.Top
  then
    ExcludeClipRect(Cnvs.Handle,R.Left, R.Top, R.Right, R.Bottom);

  with Cnvs do
  begin
    Pen.Color := clBtnShadow;
    Brush.Style := bsClear;
    Rectangle(0, 0, Width, Height);
    Pen.Color := clBtnFace;
    Rectangle(1, 1, Width - 1, Height - 1);
  end;

  Cnvs.Handle := 0;

  if not AUseExternalDC
  then
   ReleaseDC(Handle, DC);

  Cnvs.Free;
end;


procedure TspSkinCategoryButtons.PaintSkinBorder;
var
  LeftBitMap, TopBitMap, RightBitMap, BottomBitMap: TBitMap;
  DC: HDC;
  Cnvs: TControlCanvas;
  OX, OY: Integer;
  PanelData: TspDataSkinPanelControl;
  CIndex: Integer;
  FSkinPicture: TBitMap;
  NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
  NewClRect: TRect;
begin
  CIndex := SkinData.GetControlIndex('panel');
  PanelData := TspDataSkinPanelControl(SkinData.CtrlList[CIndex]);

  if not AUseExternalDC
  then
    DC := GetWindowDC(Handle)
  else
    DC := ADC;

  Cnvs := TControlCanvas.Create;
  Cnvs.Handle := DC;
  LeftBitMap := TBitMap.Create;
  TopBitMap := TBitMap.Create;
  RightBitMap := TBitMap.Create;
  BottomBitMap := TBitMap.Create;
  //
  with PanelData do
  begin
  OX := Width - RectWidth(SkinRect);
  OY := Height - RectHeight(SkinRect);
  NewLTPoint := LTPoint;
  NewRTPoint := Point(RTPoint.X + OX, RTPoint.Y);
  NewLBPoint := Point(LBPoint.X, LBPoint.Y + OY);
  NewRBPoint := Point(RBPoint.X + OX, RBPoint.Y + OY);
  NewClRect := Rect(ClRect.Left, ClRect.Top,
    ClRect.Right + OX, ClRect.Bottom + OY);
  //
  FSkinPicture := TBitMap(FSD.FActivePictures.Items[panelData.PictureIndex]);
  CreateSkinBorderImages(LTPoint, RTPoint, LBPoint, RBPoint, ClRect,
      NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
      LeftBitMap, TopBitMap, RightBitMap, BottomBitMap,
      FSkinPicture, SkinRect, Width, Height,
      LeftStretch, TopStretch, RightStretch, BottomStretch);
  end;
  if NewClRect.Bottom > NewClRect.Top
  then
    ExcludeClipRect(Cnvs.Handle,
      NewClRect.Left, NewClRect.Top, NewClRect.Right, NewClRect.Bottom);

  Cnvs.Draw(0, 0, TopBitMap);
  Cnvs.Draw(0, TopBitMap.Height, LeftBitMap);
  Cnvs.Draw(Width - RightBitMap.Width, TopBitMap.Height, RightBitMap);
  Cnvs.Draw(0, Height - BottomBitMap.Height, BottomBitMap);
  //
  TopBitMap.Free;
  LeftBitMap.Free;
  RightBitMap.Free;
  BottomBitMap.Free;
  Cnvs.Handle := 0;
  if not AUseExternalDC
  then
    ReleaseDC(Handle, DC);
  Cnvs.Free;
end;


procedure TspSkinCategoryButtons.WMSIZE;
begin
  inherited;
  if FShowBorder then PaintBorder(0, False);
end;

procedure TspSkinCategoryButtons.WMNCCALCSIZE;
var
  PanelData: TspDataSkinPanelControl;
  CIndex: Integer;
begin
  if FShowBorder
  then
    begin
      if (SkinData <> nil) and (not SkinData.Empty) and
         (SkinData.GetControlIndex('panel') <> -1)
      then
        begin
          CIndex := SkinData.GetControlIndex('panel');
          PanelData := TspDataSkinPanelControl(SkinData.CtrlList[CIndex]);
          with PanelData, TWMNCCALCSIZE(Message).CalcSize_Params^.rgrc[0] do
          begin
            Inc(Left, ClRect.Left);
            Inc(Top,  ClRect.Top);
            Dec(Right, RectWidth(SkinRect) - ClRect.Right);
            Dec(Bottom, RectHeight(SkinRect) - ClRect.Bottom);
            if Right < Left then Right := Left;
            if Bottom < Top then Bottom := Top;
          end;
        end
      else
        begin
          with TWMNCCALCSIZE(Message).CalcSize_Params^.rgrc[0] do
          begin
            Inc(Left, 2);
            Inc(Top,  2);
            Dec(Right, 2);
            Dec(Bottom, 2);
            if Right < Left then Right := Left;
            if Bottom < Top then Bottom := Top;
          end;
        end;
    end
  else
    inherited;
end;

procedure TspSkinCategoryButtons.WMEraseBkgnd;
begin
  if not FromWMPaint
  then
    PaintWindow(Message.DC);
end;

procedure TspSkinCategoryButtons.SetShowBorder;
begin
  if FShowBorder <> Value
  then
    begin
      FShowBorder := Value;
      RecreateWnd;
      AdjustScrollBar;
      Resize;
    end;
end;

procedure TspSkinCategoryButtons.ChangeSkinData;
begin
  FSkinDataName := '';
  inherited;

  if FSkinScrollBar <> nil
  then
    begin
      FSkinScrollBar.SkinData := Self.Skindata;
    end;

  if FShowBorder then ReCreateWnd;

  Resize;

  if FSkinScrollBar <> nil
  then
    begin
      AdjustScrollBar;
    end;
end;


function TspSkinCategoryButtons.GetScrollSize: Integer;
begin
  if FSkinScrollBar = nil then Result := 0
  else
    if FButtonFlow = bscbfVertical
    then
      Result := FSkinScrollBar.Width
    else
      Result := FSkinScrollBar.Height;
end;

procedure TspSkinCategoryButtons.SetBounds;
begin
  inherited;
  if HandleAllocated then 
  if ((FButtonWidth > 0) or (spboFullSize in FButtonOptions)) and (FButtonHeight > 0)
  then
    begin
      Resize;