⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 gifbutton.pas

📁 透明按钮 透明按钮 透明按钮
💻 PAS
📖 第 1 页 / 共 2 页
字号:
    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 + -