按钮功能使用TButton也可以解决, 但是TButton是会获得焦点的, 很多时候我们要求按钮不获得焦点, 而Speedbutton又不支持PNG图片
所以按照TSpeedbutton的代码, 重新封装了一个:
unit HSImageButton; // ***************************************************************************
//
// 支持PNG的Graphicbutton
//
// 版本: 1.0
// 作者: 刘志林
// 修改日期: 2016-07-12
// QQ: 17948876
// E-mail: [email protected]
// 博客: http://www.cnblogs.com/lzl_17948876/
//
// !!! 若有修改,请通知作者,谢谢合作 !!!
//
// ---------------------------------------------------------------------------
//
// 说明:
// 1.通过绑定ImageList来显示图标
// 2.通过Imagelist对PNG的支持来显示PNG图标
// 3.支持4种状态切换 (Normal/Hot/Pressed/Disabled)
// 4.支持图片位置排列 (ImageAlignment)
// 5.支持SpeedButton的Group模式
// 6.版本兼容至D2010
//
// *************************************************************************** interface uses
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 ;
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 -;
property HotImageIndex: TImageIndex read FHotImageIndex write SetHotImageIndex default -;
property PressedImageIndex: TImageIndex read FPressedImageIndex write SetPressedImageIndex default -;
property DisabledImageIndex: TImageIndex read FDisabledImageIndex write SetDisabledImageIndex default -;
property ImageMargins: TImageMargins read FImageMargins write SetImageMargins;
property Margin: Integer read FMargin write SetMargin default -;
property ParentFont;
property ParentShowHint;
property ParentBiDiMode;
property PopupMenu;
property ShowHint;
property Spacing: Integer read FSpacing write SetSpacing default ;
property Transparent: Boolean read FTransparent write SetTransparent default True;
property Visible;
property StyleElements;
property OnClick;
property OnDblClick;
property OnMouseActivate;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
end; implementation { THSImageButton } constructor THSImageButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
SetBounds(, , , );
ControlStyle := [csCaptureMouse, csDoubleClicks];
ParentFont := True;
Color := clBtnFace;
FSpacing := ;
FMargin := -;
FTransparent := True;
FImageIndex := -;
FDisabledImageIndex := -;
FPressedImageIndex := -;
FHotImageIndex := -;
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, ); 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 <> ) 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(, 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(, );
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() then
Canvas.Font.Color := clHighlightText
else
if FFlat then
nOffset := Point(, );
end;
end
else
begin
nPaintRect := Rect(, , Width - , Height - );
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, -, -);
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 := ;
nOffset.Y := ;
end
else
begin
nOffset.X := ;
nOffset.Y := ;
end; nLStyle := StyleServices;
end; nTextRect := ClientRect;
nPaintRect := ClientRect;
nPaintRect := Rect(nPaintRect.Left + FImageMargins.Left + ,
nPaintRect.Top + FImageMargins.Top + ,
nPaintRect.Right - FImageMargins.Right - ,
nPaintRect.Bottom - FImageMargins.Bottom - );
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 );
end;
iaRight:
begin
nTextRect.Right := nPaintRect.Right - Images.Width;
nTmpPoint := Point(nTextRect.Right, nPaintRect.Top + (nPaintRect.Height - Images.Height) div );
end;
iaTop:
begin
nTextRect.Top := nPaintRect.Top + Images.Height;
nTmpPoint := Point(nPaintRect.Left + (nPaintRect.Width - Images.Width) div , nPaintRect.Top);
end;
iaBottom:
begin
nTextRect.Bottom := nPaintRect.Bottom - Images.Height;
nTmpPoint := Point(nPaintRect.Left + (nPaintRect.Width - Images.Width) div , nTextRect.Bottom);
end;
iaCenter:
begin
nTmpPoint := Point(nPaintRect.Left + (nPaintRect.Width - Images.Width) div ,
nPaintRect.Top + (nPaintRect.Height - Images.Height) div );
end;
end; if not Enabled then
begin
if FDisabledImageIndex > - 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 = - 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, , )
else
Perform(CM_MOUSEENTER, , );
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 >= ) and (X < ClientWidth) and (Y >= ) 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 >= ) and (X < ClientWidth) and (Y >= ) and (Y <= ClientHeight);
if FGroupIndex = 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 = -) 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 <> ) and (Parent <> nil) then
begin
Msg.Msg := CM_BUTTONPRESSED;
Msg.WParam := FGroupIndex;
Msg.LParam := LPARAM(Self);
Msg.Result := ;
Parent.Broadcast(Msg);
end;
end; procedure THSImageButton.SetDisabledImageIndex(const Value: TImageIndex);
begin
FDisabledImageIndex := Value;
Invalidate;
end; procedure THSImageButton.SetDown(Value: Boolean);
begin
if FGroupIndex = 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 >= -) 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 := ;
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 = ); { 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 <> ) 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.