📄 gifbutton.pas
字号:
if Spacing = -1 then
begin
TotalSize := Point(ClientSize.X - (Margin + GlyphRect.Right),
ClientSize.Y - (Margin + GlyphRect.Bottom));
if Layout in [blGlyphLeft, blGlyphRight] then
Spacing := (TotalSize.X - TextSize.X) div 2
else
Spacing := (TotalSize.Y - TextSize.Y) div 2;
end;
end;
case Layout of
blGlyphLeft:
begin
GlyphRect.Left := Margin;
TextPos.X := GlyphRect.Left + GlyphRect.Right + Spacing;
end;
blGlyphRight:
begin
GlyphRect.Left := ClientSize.X - Margin - GlyphRect.Right;
TextPos.X := GlyphRect.Left - Spacing - TextSize.X;
end;
blGlyphTop:
begin
GlyphRect.Top := Margin;
TextPos.Y := GlyphRect.Top + GlyphRect.Bottom + Spacing;
end;
blGlyphBottom:
begin
GlyphRect.Top := ClientSize.Y - Margin - GlyphRect.Bottom;
TextPos.Y := GlyphRect.Top - Spacing - TextSize.Y;
end;
end;
{ fixup the result variables }
Inc(GlyphRect.Left, Client.Left + Offset.X);
Inc(GlyphRect.Top, Client.Top + Offset.Y);
Inc(GlyphRect.Right, GlyphRect.Left);
Inc(GlyphRect.Bottom, GlyphRect.Top);
OffsetRect(TextBounds, TextPos.X + Client.Left + Offset.X,
TextPos.Y + Client.Top + Offset.X);
end;
{ return the text rectangle }
function TGIFButton.DoDraw(Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
State: TButtonState; Transparent: Boolean; BiDiFlags: Longint): TRect;
begin
CalcButtonLayout(Canvas, Client, Offset, Caption, Layout, Margin, Spacing,
GlyphRect, Result, BiDiFlags);
DrawButtonGlyph(Canvas, GlyphRect);
DrawButtonText(Canvas, Caption, Result, State, BiDiFlags);
end;
procedure TGIFButton.DrawItem(const DrawItemStruct: TDrawItemStruct);
var
IsDown, IsDefault: Boolean;
State: TButtonState;
R: TRect;
Flags: Longint;
begin
FCanvas.Handle := DrawItemStruct.hDC;
R := FCanvas.ClipRect;
AnimationUpdate := AnimationUpdate and EqualRect(r, GlyphRect);
if (AnimationUpdate) then
begin
DrawButtonGlyph(FCanvas, GlyphRect);
AnimationUpdate := False;
end else
begin
R := ClientRect;
with DrawItemStruct do
begin
IsDown := itemState and ODS_SELECTED <> 0;
IsDefault := itemState and ODS_FOCUS <> 0;
if not Enabled then State := bsDisabled
else if IsDown then State := bsDown
else State := bsUp;
end;
Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
if IsDown then Flags := Flags or DFCS_PUSHED;
if DrawItemStruct.itemState and ODS_DISABLED <> 0 then
Flags := Flags or DFCS_INACTIVE;
{ DrawFrameControl doesn't allow for drawing a button as the
default button, so it must be done here. }
if IsFocused or IsDefault then
begin
FCanvas.Pen.Color := clWindowFrame;
FCanvas.Pen.Width := 1;
FCanvas.Brush.Style := bsClear;
FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
{ DrawFrameControl must draw within this border }
InflateRect(R, -1, -1);
end;
{ DrawFrameControl does not draw a pressed button correctly }
if IsDown then
begin
FCanvas.Pen.Color := clBtnShadow;
FCanvas.Pen.Width := 1;
FCanvas.Brush.Color := clBtnFace;
FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
InflateRect(R, -1, -1);
end
else
DrawFrameControl(DrawItemStruct.hDC, R, DFC_BUTTON, Flags);
if IsFocused then
begin
R := ClientRect;
InflateRect(R, -1, -1);
end;
FCanvas.Font := Self.Font;
if IsDown then
OffsetRect(R, 1, 1);
{$IFDEF VER120}
DoDraw(FCanvas, R, Point(0,0), Caption, FLayout, FMargin,
FSpacing, State, False, DrawTextBiDiModeFlags(0));
{$ELSE}
DoDraw(FCanvas, R, Point(0,0), Caption, FLayout, FMargin,
FSpacing, State, False, DT_LEFT);
{$ENDIF}
if IsFocused and IsDefault then
begin
R := ClientRect;
InflateRect(R, -4, -4);
FCanvas.Pen.Color := clWindowFrame;
FCanvas.Brush.Color := clBtnFace;
DrawFocusRect(FCanvas.Handle, R);
end;
end;
if (csDesigning in ComponentState) then
DrawFocusRect(FCanvas.Handle, GlyphRect);
FCanvas.Handle := 0;
end;
procedure TGIFButton.CMFontChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;
procedure TGIFButton.CMEnabledChanged(var Message: TMessage);
begin
inherited;
if (Enabled) then
FGlyph.DrawOptions := FGlyph.DrawOptions + [goAnimate]
else
FGlyph.DrawOptions := FGlyph.DrawOptions - [goAnimate];
Invalidate;
end;
procedure TGIFButton.CMVisibleChanged(var Message: TMessage);
begin
inherited;
if ((not Visible) or (Parent = nil)) and (Assigned(FCurrentGlyph)) then
FCurrentGlyph.StopDraw;
end;
procedure TGIFButton.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
end;
function TGIFButton.GetPalette: HPALETTE;
begin
Result := FCurrentGlyph.Palette;
end;
procedure TGIFButton.SetGlyph(Index: integer; Value: TGIFImage);
begin
case (Index) of
1: FGlyph.Assign(Value);
2: FGlyphMouseOver.Assign(Value);
end;
FModifiedGlyph := True;
AnimationUpdate := False;
Invalidate;
end;
procedure TGIFButton.GlyphChanged(Sender: TObject);
begin
if (not Visible) or (Parent = nil) then
// Ignore updates when hidden or destroying
exit;
AnimationUpdate := True;
if (FModifiedGlyph) then
// Repaint everything to recalculate GlyphRect
Invalidate
else
// Only repaint glyph
InvalidateRect(Handle, @GlyphRect, False);
end;
procedure TGIFButton.SetStyle(Value: TButtonStyle);
begin
if Value <> FStyle then
begin
FStyle := Value;
Invalidate;
end;
end;
procedure TGIFButton.SetLayout(Value: TButtonLayout);
begin
if FLayout <> Value then
begin
FLayout := Value;
Invalidate;
end;
end;
procedure TGIFButton.SetSpacing(Value: Integer);
begin
if FSpacing <> Value then
begin
FSpacing := Value;
Invalidate;
end;
end;
procedure TGIFButton.SetMargin(Value: Integer);
begin
if (Value <> FMargin) and (Value >= - 1) then
begin
FMargin := Value;
Invalidate;
end;
end;
procedure TGIFButton.CMMouseEnter(var msg: TMessage);
begin
if FInsideButton then
exit;
FInsideButton := True;
if (Assigned(FOnMouseEnter)) then
FOnMouseEnter(Self);
if (Assigned(FCurrentGlyph)) then
FCurrentGlyph.StopDraw;
FModifiedGlyph := True;
FCurrentGlyph := FGlyphMouseOver;
Invalidate;
end;
procedure TGIFButton.CMMouseLeave(var msg: TMessage);
begin
if not(FInsideButton) then
exit;
FInsideButton := False;
if (Assigned(FOnMouseExit)) then
FOnMouseExit(Self);
if (Assigned(FCurrentGlyph)) then
FCurrentGlyph.StopDraw;
FModifiedGlyph := True;
FCurrentGlyph := FGlyph;
Invalidate;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -