unit HSImageButton;//  ***************************************************************************////  支持PNG的Graphicbutton////  版本: 1.0//  作者: 刘志林//  修改日期: 2016-07-12//  QQ: 17948876//  E-mail: lzl_17948876@hotmail.com//  博客: http://www.cnblogs.com/hs-kill/////  !!! 若有修改,请通知作者,谢谢合作 !!!////  ---------------------------------------------------------------------------////  说明://    1.通过绑定ImageList来显示图标//    2.通过Imagelist对PNG的支持来显示PNG图标//    3.支持4种状态切换 (Normal/Hot/Pressed/Disabled)//    4.支持图片位置排列 (ImageAlignment)//    5.支持SpeedButton的Group模式//    6.版本兼容至D2010////  ***************************************************************************interfaceuses  System.Classes, System.SysUtils, System.Types,{$IF RTLVersion >= 29}  System.ImageList,{$ENDIF}  Winapi.Messages, Winapi.Windows,  Vcl.Controls, Vcl.StdCtrls, Vcl.Buttons, Vcl.Graphics, Vcl.Forms,  Vcl.Themes, Vcl.ImgList, Vcl.ActnList;type  THSImageButton = class;  THSImageButtonActionLink = class(TControlActionLink)  protected    FClient: THSImageButton;    procedure AssignClient(AClient: TObject); override;    function IsCheckedLinked: Boolean; override;    function IsGroupIndexLinked: Boolean; override;    function IsImageIndexLinked: Boolean; override;    procedure SetGroupIndex(Value: Integer); override;    procedure SetChecked(Value: Boolean); override;    procedure SetImageIndex(Value: Integer); override;  public    constructor Create(AClient: TObject); override;  end;  THSImageButtonActionLinkClass = class of THSImageButtonActionLink;  THSImageButton = class(TGraphicControl)  private    FGroupIndex: Integer;    FDown: Boolean;    FDragging: Boolean;    FAllowAllUp: Boolean;    FSpacing: Integer;    FTransparent: Boolean;    FMargin: Integer;    FFlat: Boolean;    FMouseInControl: Boolean;    FImageAlignment: TImageAlignment;    FImages: TCustomImageList;    FImageMargins: TImageMargins;    FImageIndex: TImageIndex;    FPressedImageIndex: TImageIndex;    FDisabledImageIndex: TImageIndex;    FHotImageIndex: TImageIndex;    FImageChangeLink: TChangeLink;    procedure GlyphChanged(Sender: TObject);    procedure UpdateExclusive;    procedure SetDown(Value: Boolean);    procedure SetFlat(Value: Boolean);    procedure SetAllowAllUp(Value: Boolean);    procedure SetGroupIndex(Value: Integer);    procedure SetSpacing(Value: Integer);    procedure SetTransparent(Value: Boolean);    procedure SetMargin(Value: Integer);    procedure UpdateTracking;    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;    procedure CMButtonPressed(var Message: TMessage); message CM_BUTTONPRESSED;    procedure SetImageAlignment(const Value: TImageAlignment);    procedure SetImageIndex(const Value: TImageIndex);    procedure SetImageMargins(const Value: TImageMargins);    procedure SetImages(const Value: TCustomImageList);    procedure SetDisabledImageIndex(const Value: TImageIndex);    procedure SetHotImageIndex(const Value: TImageIndex);    procedure SetPressedImageIndex(const Value: TImageIndex);  protected    FState: TButtonState;    procedure Notification(AComponent: TComponent; Operation: TOperation); override;    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;    function GetActionLinkClass: TControlActionLinkClass; override;    procedure Loaded; override;    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;      X, Y: Integer); override;    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;      X, Y: Integer); override;    procedure Paint; override;    property MouseInControl: Boolean read FMouseInControl;    procedure ImageMarginsChange(Sender: TObject);    procedure ImageListChange(Sender: TObject);  public    constructor Create(AOwner: TComponent); override;    destructor Destroy; override;    procedure Click; override;  published    property Action;    property Align;    property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;    property Anchors;    property BiDiMode;    property Constraints;    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;    property Down: Boolean read FDown write SetDown default False;    property Caption;    property Enabled;    property Flat: Boolean read FFlat write SetFlat default False;    property Font;    property Images: TCustomImageList read FImages write SetImages;    property ImageAlignment: TImageAlignment read FImageAlignment write SetImageAlignment default iaLeft;    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;    property HotImageIndex: TImageIndex read FHotImageIndex write SetHotImageIndex default -1;    property PressedImageIndex: TImageIndex read FPressedImageIndex write SetPressedImageIndex default -1;    property DisabledImageIndex: TImageIndex read FDisabledImageIndex write SetDisabledImageIndex default -1;    property ImageMargins: TImageMargins read FImageMargins write SetImageMargins;    property Margin: Integer read FMargin write SetMargin default -1;    property ParentFont;    property ParentShowHint;    property ParentBiDiMode;    property PopupMenu;    property ShowHint;    property Spacing: Integer read FSpacing write SetSpacing default 4;    property Transparent: Boolean read FTransparent write SetTransparent default True;    property Visible;    property StyleElements;    property OnClick;    property OnDblClick;    property onm ouseActivate;    property onm ouseDown;    property onm ouseEnter;    property onm ouseLeave;    property onm ouseMove;    property onm ouseUp;  end;implementation{ THSImageButton }constructor THSImageButton.Create(AOwner: TComponent);begin  inherited Create(AOwner);  SetBounds(0, 0, 23, 22);  ControlStyle := [csCaptureMouse, csDoubleClicks];  ParentFont := True;  Color := clBtnFace;  FSpacing := 4;  FMargin := -1;  FTransparent := True;  FImageIndex := -1;  FDisabledImageIndex := -1;  FPressedImageIndex := -1;  FHotImageIndex := -1;  FImageMargins := TImageMargins.Create;  FImageMargins.OnChange := ImageMarginsChange;  FImageChangeLink := TChangeLink.Create;  FImageChangeLink.OnChange := ImageListChange;end;destructor THSImageButton.Destroy;begin  FreeAndNil(FImageChangeLink);  FreeAndNil(FImageMargins);  inherited Destroy;end;const  DownStyles: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER);  FillStyles: array[Boolean] of Integer = (BF_MIDDLE, 0);procedure THSImageButton.Paint;  function DoGlassPaint: Boolean;  var    nLParent: TWinControl;  begin    Result := csGlassPaint in ControlState;    if Result then    begin      nLParent := Parent;      while (nLParent <> nil) and not nLParent.DoubleBuffered do        nLParent := nLParent.Parent;      Result := (nLParent = nil) or not nLParent.DoubleBuffered or (nLParent is TCustomForm);    end;  end;var  nPaintRect, nTextRect: TRect;  nDrawFlags, nImageIndex: Integer;  nOffset, nTmpPoint: TPoint;  nLGlassPaint: Boolean;  nTMButton: TThemedButton;  nTMToolBar: TThemedToolBar;  nDetails: TThemedElementDetails;  nLStyle: TCustomStyleServices;  nLColor: TColor;  nLFormats: TTextFormat;  nTextFlg: DWORD;{$IF RTLVersion >= 27}  nDefGrayscaleFactor: Byte;{$ENDIF}begin  {Copy As TSpeedButton.Paint}  if not Enabled then  begin    FState := bsDisabled;    FDragging := False;  end  else if FState = bsDisabled then    if FDown and (GroupIndex <> 0) then      FState := bsExclusive    else      FState := bsUp;  Canvas.Font := Self.Font;  Canvas.Brush.Style := bsClear;  if ThemeControl(Self) then  begin    nLGlassPaint := DoGlassPaint;    if not nLGlassPaint then      if Transparent then        StyleServices.DrawParentBackground(0, Canvas.Handle, nil, True)      else        PerformEraseBackground(Self, Canvas.Handle)    else      FillRect(Canvas.Handle, ClientRect, GetStockObject(BLACK_BRUSH));    if not Enabled then      nTMButton := tbPushButtonDisabled    else      if FState in [bsDown, bsExclusive] then        nTMButton := tbPushButtonPressed      else        if MouseInControl then          nTMButton := tbPushButtonHot        else          nTMButton := tbPushButtonNormal;    nTMToolBar := ttbToolbarDontCare;    if FFlat or TStyleManager.IsCustomStyleActive then    begin      case nTMButton of        tbPushButtonDisabled:          nTMToolBar := ttbButtonDisabled;        tbPushButtonPressed:          nTMToolBar := ttbButtonPressed;        tbPushButtonHot:          nTMToolBar := ttbButtonHot;        tbPushButtonNormal:          nTMToolBar := ttbButtonNormal;      end;    end;    nPaintRect := ClientRect;    if nTMToolBar = ttbToolbarDontCare then    begin      nDetails := StyleServices.GetElementDetails(nTMButton);      StyleServices.DrawElement(Canvas.Handle, nDetails, nPaintRect);      StyleServices.GetElementContentRect(Canvas.Handle, nDetails, nPaintRect, nPaintRect);    end    else    begin      nDetails := StyleServices.GetElementDetails(nTMToolBar);      if not TStyleManager.IsCustomStyleActive then      begin        StyleServices.DrawElement(Canvas.Handle, nDetails, nPaintRect);        // Windows theme services doesn‘t paint disabled toolbuttons        // with grayed text (as it appears in an actual toolbar). To workaround,        // retrieve nDetails for a disabled nTMButton for drawing the caption.        if (nTMToolBar = ttbButtonDisabled) then          nDetails := StyleServices.GetElementDetails(nTMButton);      end      else      begin        // Special case for flat speedbuttons with custom styles. The assumptions        // made about the look of ToolBar buttons may not apply, so only paint        // the hot and pressed states , leaving normal/disabled to appear flat.        if not FFlat or ((nTMButton = tbPushButtonPressed) or (nTMButton = tbPushButtonHot)) then          StyleServices.DrawElement(Canvas.Handle, nDetails, nPaintRect);      end;      StyleServices.GetElementContentRect(Canvas.Handle, nDetails, nPaintRect, nPaintRect);    end;    nOffset := Point(0, 0);    if nTMButton = tbPushButtonPressed then    begin      // A pressed "flat" speed nTMButton has white text in XP, but the Themes      // API won‘t render it as such, so we need to hack it.      if (nTMToolBar <> ttbToolbarDontCare) and not CheckWin32Version(6) then        Canvas.Font.Color := clHighlightText      else        if FFlat then          nOffset := Point(1, 0);    end;  end  else  begin    nPaintRect := Rect(1, 1, Width - 1, Height - 1);    if not FFlat then    begin      nDrawFlags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;      if FState in [bsDown, bsExclusive] then        nDrawFlags := nDrawFlags or DFCS_PUSHED;      DrawFrameControl(Canvas.Handle, nPaintRect, DFC_BUTTON, nDrawFlags);    end    else    begin      if (FState in [bsDown, bsExclusive]) or        (FMouseInControl and (FState <> bsDisabled)) or        (csDesigning in ComponentState) then        DrawEdge(Canvas.Handle, nPaintRect, DownStyles[FState in [bsDown, bsExclusive]],          FillStyles[Transparent] or BF_RECT)      else if not Transparent then      begin        Canvas.Brush.Color := Color;        Canvas.FillRect(nPaintRect);      end;      InflateRect(nPaintRect, -1, -1);    end;    if FState in [bsDown, bsExclusive] then    begin      if (FState = bsExclusive) and (not FFlat or not FMouseInControl) then      begin        Canvas.Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);        Canvas.FillRect(nPaintRect);      end;      nOffset.X := 1;      nOffset.Y := 1;    end    else    begin      nOffset.X := 0;      nOffset.Y := 0;    end;    nLStyle := StyleServices;  end;  nTextRect := ClientRect;  nPaintRect := ClientRect;  nPaintRect := Rect(nPaintRect.Left + FImageMargins.Left + 1,    nPaintRect.Top + FImageMargins.Top + 1,    nPaintRect.Right - FImageMargins.Right - 1,    nPaintRect.Bottom - FImageMargins.Bottom - 1);  if Images <> nil then  begin{$IF RTLVersion >= 27}    nDefGrayscaleFactor := Images.GrayscaleFactor;    Images.GrayscaleFactor := $FF;{$ENDIF}    nTmpPoint := nPaintRect.CenterPoint;    case FImageAlignment of      iaLeft:      begin        nTextRect.Left := nPaintRect.Left + Images.Width;        nTmpPoint := Point(nPaintRect.Left, nPaintRect.Top + (nPaintRect.Height - Images.Height) div 2);      end;      iaRight:      begin        nTextRect.Right := nPaintRect.Right - Images.Width;        nTmpPoint := Point(nTextRect.Right, nPaintRect.Top + (nPaintRect.Height - Images.Height) div 2);      end;      iaTop:      begin        nTextRect.Top := nPaintRect.Top + Images.Height;        nTmpPoint := Point(nPaintRect.Left + (nPaintRect.Width - Images.Width) div 2, nPaintRect.Top);      end;      iaBottom:      begin        nTextRect.Bottom := nPaintRect.Bottom - Images.Height;        nTmpPoint := Point(nPaintRect.Left + (nPaintRect.Width - Images.Width) div 2, nTextRect.Bottom);      end;      iaCenter:      begin        nTmpPoint := Point(nPaintRect.Left + (nPaintRect.Width - Images.Width) div 2,          nPaintRect.Top + (nPaintRect.Height - Images.Height) div 2);      end;    end;    if not Enabled then    begin      if FDisabledImageIndex > -1 then        Images.Draw(Canvas, nTmpPoint.X, nTmpPoint.Y, FDisabledImageIndex, True)      else        Images.Draw(Canvas, nTmpPoint.X, nTmpPoint.Y, FImageIndex, False);    end    else    begin      if FState in [bsDown, bsExclusive] then        nImageIndex := FPressedImageIndex      else if MouseInControl then        nImageIndex := FHotImageIndex      else        nImageIndex := FImageIndex;      if nImageIndex = -1 then        nImageIndex := FImageIndex;      Images.Draw(Canvas, nTmpPoint.X, nTmpPoint.Y, nImageIndex, True);    end;{$IF RTLVersion >= 27}    Images.GrayscaleFactor := nDefGrayscaleFactor;{$ENDIF}  end;  nTextFlg := DT_VCENTER or DT_SINGLELINE or DT_CENTER;  {Copy As TButtonGlyphc.DrawButtonText.DoDrawText}  if ThemeControl(Self) then  begin    if (FState = bsDisabled) or (not StyleServices.IsSystemStyle and (seFont in StyleElements)) then    begin      if not StyleServices.GetElementColor(nDetails, ecTextColor, nLColor) or (nLColor = clNone) then        nLColor := Canvas.Font.Color;    end    else      nLColor := Canvas.Font.Color;    nLFormats := TTextFormatFlags(nTextFlg);    if nLGlassPaint then      Include(nLFormats, tfComposited);    StyleServices.DrawText(Canvas.Handle, nDetails, Text, nTextRect, nLFormats, nLColor);  end  else  begin    if FState = bsDisabled then      Canvas.Font.Color := clGrayText    else      Canvas.Font.Color := clWindowText;    Winapi.Windows.DrawText(Canvas.Handle, Text, Length(Text), nTextRect, nTextFlg);  end;end;procedure THSImageButton.UpdateTracking;var  P: TPoint;begin  if FFlat then  begin    if Enabled then    begin      GetCursorPos(P);      FMouseInControl := not (FindDragTarget(P, True) = Self);      if FMouseInControl then        Perform(CM_MOUSELEAVE, 0, 0)      else        Perform(CM_MOUSEENTER, 0, 0);    end;  end;end;procedure THSImageButton.Loaded;var  State: TButtonState;begin  inherited Loaded;  if Enabled then    State := bsUp  else    State := bsDisabled;end;procedure THSImageButton.MouseDown(Button: TMouseButton; Shift: TShiftState;  X, Y: Integer);begin  inherited MouseDown(Button, Shift, X, Y);  if (Button = mbLeft) and Enabled then  begin    if not FDown then    begin      FState := bsDown;      Invalidate;    end;    FDragging := True;  end;end;procedure THSImageButton.MouseMove(Shift: TShiftState; X, Y: Integer);var  NewState: TButtonState;begin  inherited MouseMove(Shift, X, Y);  if FDragging then  begin    if not FDown then NewState := bsUp    else NewState := bsExclusive;    if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then      if FDown then NewState := bsExclusive else NewState := bsDown;    if NewState <> FState then    begin      FState := NewState;      Invalidate;    end;  end  else if not FMouseInControl then    UpdateTracking;end;procedure THSImageButton.MouseUp(Button: TMouseButton; Shift: TShiftState;  X, Y: Integer);var  DoClick: Boolean;begin  inherited MouseUp(Button, Shift, X, Y);  if FDragging then  begin    FDragging := False;    DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);    if FGroupIndex = 0 then    begin      { Redraw face in-case mouse is captured }      FState := bsUp;      FMouseInControl := False;      if DoClick and not (FState in [bsExclusive, bsDown]) then        Invalidate;    end    else      if DoClick then      begin        SetDown(not FDown);        if FDown then Repaint;      end      else      begin        if FDown then FState := bsExclusive;        Repaint;      end;    if DoClick then Click;    UpdateTracking;  end;end;procedure THSImageButton.Notification(AComponent: TComponent;  Operation: TOperation);begin  inherited Notification(AComponent, Operation);  if Operation = opRemove then  begin    if AComponent = FImages then    begin      FImages := nil;    end;  end;end;procedure THSImageButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);begin  inherited ActionChange(Sender, CheckDefaults);  if Sender is TCustomAction then    with TCustomAction(Sender) do    begin      if not CheckDefaults or (Self.ImageIndex = -1) then        Self.ImageIndex := ImageIndex;    end;end;procedure THSImageButton.Click;begin  inherited Click;end;function THSImageButton.GetActionLinkClass: TControlActionLinkClass;begin  Result := THSImageButtonActionLink;end;procedure THSImageButton.GlyphChanged(Sender: TObject);begin  Invalidate;end;procedure THSImageButton.ImageListChange(Sender: TObject);begin  Invalidate;end;procedure THSImageButton.ImageMarginsChange(Sender: TObject);begin  Invalidate;end;procedure THSImageButton.UpdateExclusive;var  Msg: TMessage;begin  if (FGroupIndex <> 0) and (Parent <> nil) then  begin    Msg.Msg := CM_BUTTONPRESSED;    Msg.WParam := FGroupIndex;    Msg.LParam := LPARAM(Self);    Msg.Result := 0;    Parent.Broadcast(Msg);  end;end;procedure THSImageButton.SetDisabledImageIndex(const Value: TImageIndex);begin  FDisabledImageIndex := Value;  Invalidate;end;procedure THSImageButton.SetDown(Value: Boolean);begin  if FGroupIndex = 0 then Value := False;  if Value <> FDown then  begin    if FDown and (not FAllowAllUp) then Exit;    FDown := Value;    if Value then    begin      if FState = bsUp then Invalidate;      FState := bsExclusive    end    else    begin      FState := bsUp;      Repaint;    end;    if Value then UpdateExclusive;  end;end;procedure THSImageButton.SetFlat(Value: Boolean);begin  if Value <> FFlat then  begin    FFlat := Value;    Invalidate;  end;end;procedure THSImageButton.SetGroupIndex(Value: Integer);begin  if FGroupIndex <> Value then  begin    FGroupIndex := Value;    UpdateExclusive;  end;end;procedure THSImageButton.SetHotImageIndex(const Value: TImageIndex);begin  FHotImageIndex := Value;  Invalidate;end;procedure THSImageButton.SetImageAlignment(const Value: TImageAlignment);begin  FImageAlignment := Value;  Invalidate;end;procedure THSImageButton.SetImageIndex(const Value: TImageIndex);begin  FImageIndex := Value;  Invalidate;end;procedure THSImageButton.SetImageMargins(const Value: TImageMargins);begin  FImageMargins := Value;  Invalidate;end;procedure THSImageButton.SetImages(const Value: TCustomImageList);begin  if Value <> FImages then  begin    if Images <> nil then      Images.UnRegisterChanges(FImageChangeLink);    FImages := Value;    if Images <> nil then    begin      Images.RegisterChanges(FImageChangeLink);      Images.FreeNotification(Self);    end;    Invalidate;  end;end;procedure THSImageButton.SetMargin(Value: Integer);begin  if (Value <> FMargin) and (Value >= -1) then  begin    FMargin := Value;    Invalidate;  end;end;procedure THSImageButton.SetPressedImageIndex(const Value: TImageIndex);begin  FPressedImageIndex := Value;  Invalidate;end;procedure THSImageButton.SetSpacing(Value: Integer);begin  if Value <> FSpacing then  begin    FSpacing := Value;    Invalidate;  end;end;procedure THSImageButton.SetTransparent(Value: Boolean);begin  if Value <> FTransparent then  begin    FTransparent := Value;    if Value then      ControlStyle := ControlStyle - [csOpaque] else      ControlStyle := ControlStyle + [csOpaque];    Invalidate;  end;end;procedure THSImageButton.SetAllowAllUp(Value: Boolean);begin  if FAllowAllUp <> Value then  begin    FAllowAllUp := Value;    UpdateExclusive;  end;end;procedure THSImageButton.WMLButtonDblClk(var Message: TWMLButtonDblClk);begin  inherited;  if FDown then DblClick;end;procedure THSImageButton.CMButtonPressed(var Message: TMessage);var  Sender: THSImageButton;begin  if Message.WParam = WPARAM(FGroupIndex) then  begin    Sender := THSImageButton(Message.LParam);    if Sender <> Self then    begin      if Sender.Down and FDown then      begin        FDown := False;        FState := bsUp;        if (Action is TCustomAction) then          TCustomAction(Action).Checked := False;        Invalidate;      end;      FAllowAllUp := Sender.AllowAllUp;    end;  end;end;procedure THSImageButton.CMDialogChar(var Message: TCMDialogChar);begin  with Message do    if IsAccel(CharCode, Caption) and Enabled and Visible and      (Parent <> nil) and Parent.Showing then    begin      Click;      Result := 1;    end else      inherited;end;procedure THSImageButton.CMEnabledChanged(var Message: TMessage);const  NewState: array[Boolean] of TButtonState = (bsDisabled, bsUp);begin  UpdateTracking;  Repaint;end;procedure THSImageButton.CMFontChanged(var Message: TMessage);begin  Invalidate;end;procedure THSImageButton.CMMouseEnter(var Message: TMessage);var  NeedRepaint: Boolean;begin  inherited;  { Don‘t draw a border if DragMode <> dmAutomatic since this button is meant to    be used as a dock client. }  NeedRepaint := FFlat and not FMouseInControl and Enabled and (DragMode <> dmAutomatic) and (GetCapture = 0);  { Windows XP introduced hot states also for non-flat buttons. }  if (NeedRepaint or StyleServices.Enabled) and not (csDesigning in ComponentState) then  begin    FMouseInControl := True;    if Enabled then      Repaint;  end;end;procedure THSImageButton.CMMouseLeave(var Message: TMessage);var  NeedRepaint: Boolean;begin  inherited;  NeedRepaint := FFlat and FMouseInControl and Enabled and not FDragging;  { Windows XP introduced hot states also for non-flat buttons. }  if NeedRepaint or StyleServices.Enabled then  begin    FMouseInControl := False;    if Enabled then      Repaint;  end;end;procedure THSImageButton.CMTextChanged(var Message: TMessage);begin  Invalidate;end;{ THSImageButtonActionLink }procedure THSImageButtonActionLink.AssignClient(AClient: TObject);begin  inherited AssignClient(AClient);  FClient := AClient as THSImageButton;end;constructor THSImageButtonActionLink.Create(AClient: TObject);begin  inherited Create(AClient);end;function THSImageButtonActionLink.IsCheckedLinked: Boolean;begin  Result := inherited IsCheckedLinked and (FClient.GroupIndex <> 0) and    FClient.AllowAllUp and (FClient.Down = TCustomAction(Action).Checked);end;function THSImageButtonActionLink.IsGroupIndexLinked: Boolean;begin  Result := inherited IsGroupIndexLinked and (FClient is THSImageButton) and    (FClient.GroupIndex = TCustomAction(Action).GroupIndex);end;function THSImageButtonActionLink.IsImageIndexLinked: Boolean;begin  Result := inherited IsImageIndexLinked and    (FClient.ImageIndex = TCustomAction(Action).ImageIndex);end;procedure THSImageButtonActionLink.SetChecked(Value: Boolean);begin  if IsCheckedLinked then THSImageButton(FClient).Down := Value;end;procedure THSImageButtonActionLink.SetGroupIndex(Value: Integer);begin  if IsGroupIndexLinked then THSImageButton(FClient).GroupIndex := Value;end;procedure THSImageButtonActionLink.SetImageIndex(Value: Integer);begin  if IsImageIndexLinked then THSImageButton(FClient).ImageIndex := Value;end;end.