pngbutton png按钮

于 2018-12-04 17:43:11 发布
阅读量1.2k 收藏
点赞数 1
分类专栏： delphi 文章标签： pngbutton png按钮

自定义组件-支持PNG图片的多态GraphicButton
按钮功能使用TButton也可以解决, 但是TButton是会获得焦点的, 很多时候我们要求按钮不获得焦点, 而Speedbutton又不支持PNG图片

所以按照TSpeedbutton的代码, 重新封装了一个:

复制代码
unit HSImageButton;

// ***************************************************************************
//
// 支持PNG的Graphicbutton
//
// 版本: 1.0
// 作者: 刘志林
// 修改日期: 2016-07-12
// QQ: 17948876
// E-mail: lzl_17948876@hotmail.com
// 博客: 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,
{KaTeX parse error: Expected 'EOF', got '}' at position 20: …TLVersion >= 29}̲ System.Image…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 OnMouseActivate;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
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;
{KaTeX parse error: Expected 'EOF', got '}' at position 20: …TLVersion >= 27}̲ nDefGrayscal…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 := KaTeX parse error: Expected '}', got 'EOF' at end of input: 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;

{KaTeX parse error: Expected 'EOF', got '}' at position 20: …TLVersion >= 27}̲ Images.Gra…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§;
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.

评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值