delphi - 有 `ProgressButton`吗？

Question

我想要一个具有双重功能的按钮作为进度条。

+ =......

例如随着任务的进展，按钮会填充绿色背景。
我知道我可以创建自己的，但如果有现成的东西，我很乐意使用它。

有人知道符合要求的免费或商业组件吗？

我希望它能在 Delphi-2007 中工作，但如果它仅在 XE2 中可用，那也可以。

更新
TMS 有一个允许透明的glassbutton。如果你在下面放置一个深绿色的形状(带圆角)，它看起来就像我想要的效果。
只需增加形状的宽度以适应进度即可开始工作。

当我有时间时，我会制作一个填充颜色并放置链接的按钮。

Answer 1

我已经为你创建了一个。这没什么酷的，因为我没有太多组件编写的经验，所以请照原样:)

有两个可用组件:

• TProgressButton - 具有进度条的基本支持
• TProgressGlyphButton - 与上面相同，具有字形支持

以下属性对于这两个组件都有效:

• ProgressMin - 进度条的下限
• ProgressMax - 进度条上限
• ProgressValue - 当前进度条值
• ProgressAlpha - 进度条不透明度(范围 0-175，其中 175 是最大可见度)
• ProgressColor - 进度条的颜色
• ProgressColored - 启用 ProgressColor 的标志
• ProgressMargins - 按钮内边框和外边框之间的边距进展情况

这些属性仅对 TProgressGlyphButton 有效。 :

• 图像 - 包含按钮状态图像的图像列表(禁用、默认、正常、热、按下)
  - 如果没有足够的图像用于所有状态，则仅为所有状态绘制第一个图像<
• ImageTop - 字形的垂直缩进，仅当 ImageAlign 设置为 iaCustom 时有效
• ImageLeft - 字形的垂直缩进，仅当 ImageAlign 设置为 iaCustom 时有效
• ImageAlign - 字形对齐样式
  - iaLeft 将字形向左对齐，并根据垂直字形居中的结果缩进
  - iaRight 将字形向右对齐，并根据垂直字形居中的结果缩进
  - iaCustom 允许您手动指定字形坐标(请参阅上面的属性)

Font 属性会影响文本渲染，因此您可以更改字体样式、颜色或其他内容。请注意，该组件仅需要与启用的 Windows 主题一起使用。

两个组件都包含演示和源代码；由于帖子长度的限制，我无法在这里发布更新的代码。所以我把原来的留在这里。

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   Progress Button - 0.0.0.1   ////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

unit ProgressButton;

interface

uses Windows, Messages, Classes, Controls, Forms, Graphics, StdCtrls,
  SysUtils, ExtCtrls, CommCtrl, UxTheme, Themes;

type
  TButtonState = (bsDisabled, bsDefault, bsNormal, bsButtonHot, bsPressed);
  TBufferType = (btProgress, btButton, btCaption);
  TBufferTypes = set of TBufferType;

  TProgressButton = class(TButton)
  private
    FDrawBuffer: TBitmap;
    FButtonBuffer: TBitmap;
    FProgressBuffer: TBitmap;
    FProgressMin: Integer;
    FProgressMax: Integer;
    FProgressValue: Integer;
    FProgressAlpha: Integer;
    FProgressColor: TColor;
    FProgressColored: Boolean;
    FProgressMargins: Integer;
    FProgressSpacing: Integer;

    FButtonState: TButtonState;
    FFocusInControl: Boolean;
    FMouseInControl: Boolean;

    procedure PrepareButtonBuffer;
    procedure PrepareProgressBuffer;
    procedure PrepareDrawBuffers(const BufferTypes: TBufferTypes);

    procedure SetProgressMin(Value: Integer);
    procedure SetProgressMax(Value: Integer);
    procedure SetProgressValue(Value: Integer);
    procedure SetProgressAlpha(Value: Integer);
    procedure SetProgressColor(Value: TColor);
    procedure SetProgressColored(Value: Boolean);
    procedure SetProgressMargins(Value: Integer);

    function GetButtonState(const ItemState: UINT): TButtonState;

    procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
    procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
    procedure CMTextChanged(var Msg: TMessage); message CM_TEXTCHANGED;
    procedure WMLButtonDblClk(var Msg: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMWindowPosChanged(var Msg: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;

  protected
    procedure Loaded; override;
    procedure SetButtonStyle(Value: Boolean); override;
    procedure CreateParams(var Params: TCreateParams); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ProgressMin: Integer read FProgressMin write SetProgressMin default 0;
    property ProgressMax: Integer read FProgressMax write SetProgressMax default 100;
    property ProgressValue: Integer read FProgressValue write SetProgressValue default 0;
    property ProgressAlpha: Integer read FProgressAlpha write SetProgressAlpha default 75;
    property ProgressColor: TColor read FProgressColor write SetProgressColor default $00804000;
    property ProgressColored: Boolean read FProgressColored write SetProgressColored default False;
    property ProgressMargins: Integer read FProgressMargins write SetProgressMargins default 1;
  end;

procedure Register;

implementation


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.Create - component constructor   ///////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// AOwner - component owner

constructor TProgressButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  if csDesigning in ComponentState then
    if not ThemeServices.ThemesEnabled then
      begin
        raise EInvalidOperation.Create(
          'Hi, I''m the ProgressButton control, but I cannot be loaded because' + sLineBreak +
          'you don''t have the Windows Themes enabled and my initial developer' + sLineBreak +
          'was so lazy to paint me without them.');
      end;

  Width := 185;
  Height := 25;

  FProgressMin := 0;
  FProgressMax := 100;
  FProgressValue := 0;
  FProgressAlpha := 75;
  FProgressColor := $00804000;
  FProgressColored := False;
  FProgressMargins := 1;
  FButtonState := bsNormal;

  if Win32MajorVersion >= 6 then
    FProgressSpacing := 1
  else
    FProgressSpacing := 2;

  FDrawBuffer := TBitmap.Create;
  FDrawBuffer.PixelFormat := pf32Bit;
  FButtonBuffer := TBitmap.Create;
  FButtonBuffer.PixelFormat := pf32Bit;
  FProgressBuffer := TBitmap.Create;
  FProgressBuffer.PixelFormat := pf32Bit;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.Destroy - component destructor   ///////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

destructor TProgressButton.Destroy;
begin
  inherited Destroy;
  FDrawBuffer.Free;
  FButtonBuffer.Free;
  FProgressBuffer.Free;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.PrepareButtonBuffer - prepare the button bitmap to be drawn   //////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

procedure TProgressButton.PrepareButtonBuffer;
var
  ThemedButton: TThemedButton;
  ThemedDetails: TThemedElementDetails;
begin
  ThemedButton := tbButtonDontCare;

  case FButtonState of
    bsDisabled: ThemedButton := tbPushButtonDisabled;
    bsDefault: ThemedButton := tbPushButtonDefaulted;
    bsNormal: ThemedButton := tbPushButtonNormal;
    bsButtonHot: ThemedButton := tbPushButtonHot;
    bsPressed: ThemedButton := tbPushButtonPressed;
  end;

  PerformEraseBackground(Self, FButtonBuffer.Canvas.Handle);

  ThemedDetails := ThemeServices.GetElementDetails(ThemedButton);
  ThemeServices.DrawElement(FButtonBuffer.Canvas.Handle, ThemedDetails, ClientRect, nil);
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.PrepareProgressBuffer - prepare the progress bitmap to be drawn   //////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

procedure TProgressButton.PrepareProgressBuffer;
var
  ProgressBar: TRect;
  ProgressChunk: TRect;
  ThemedDetails: TThemedElementDetails;

  procedure ColorizeBitmap(const Bitmap: TBitmap; const Color: TColor);
  type
    PPixelRec = ^TPixelRec;
    TPixelRec = packed record
      B: Byte;
      G: Byte;
      R: Byte;
      Alpha: Byte;
    end;
  var
    X: Integer;
    Y: Integer;
    R: Integer;
    G: Integer;
    B: Integer;
    Gray: Byte;
    Pixel: PPixelRec;
  begin
    R := GetRValue(Color);
    G := GetGValue(Color);
    B := GetBValue(Color);

    for Y := ProgressChunk.Top to ProgressChunk.Bottom - 1 do
    begin
      Pixel := Bitmap.ScanLine[Y];
      Inc(Pixel, FProgressMargins + FProgressSpacing);
      for X := ProgressChunk.Left to ProgressChunk.Right - 1 do
      begin
        Gray := Round((0.299 * Pixel.R) + (0.587 * Pixel.G) + (0.114 * Pixel.B));

        if (Win32MajorVersion >= 6) or ((Win32MajorVersion < 6) and (Gray < 240)) then
        begin
          Pixel.R := MulDiv(R, Gray, 255);
          Pixel.G := MulDiv(G, Gray, 255);
          Pixel.B := MulDiv(B, Gray, 255);
        end;

        Inc(Pixel);
      end;
    end;
  end;

begin
  ProgressBar := Rect(
    ClientRect.Left + FProgressMargins,
    ClientRect.Top + FProgressMargins,
    ClientRect.Right - FProgressMargins,
    ClientRect.Bottom - FProgressMargins);

  ProgressChunk := Rect(
    ProgressBar.Left + FProgressSpacing,
    ProgressBar.Top + FProgressSpacing,
    ProgressBar.Left + FProgressSpacing + Trunc((FProgressValue - FProgressMin) / (FProgressMax - FProgressMin) * (ProgressBar.Right - ProgressBar.Left - (2 * FProgressSpacing))),
    ProgressBar.Bottom - FProgressSpacing);

  PerformEraseBackground(Self, FProgressBuffer.Canvas.Handle);

  ThemedDetails := ThemeServices.GetElementDetails(tpBar);
  ThemeServices.DrawElement(FProgressBuffer.Canvas.Handle, ThemedDetails, ProgressBar, nil);
  ThemedDetails := ThemeServices.GetElementDetails(tpChunk);
  ThemeServices.DrawElement(FProgressBuffer.Canvas.Handle, ThemedDetails, ProgressChunk, nil);

  if FProgressColored then
    ColorizeBitmap(FProgressBuffer, FProgressColor);
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.PrepareDrawBuffers - prepare the bitmaps to be drawn and render caption   //////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// BufferTypes - set of buffer (element) types 

procedure TProgressButton.PrepareDrawBuffers(const BufferTypes: TBufferTypes);
var
  TextBounds: TRect;
  BlendFunction: TBlendFunction;
begin
  if (csLoading in ComponentState) or (not Assigned(Parent)) then
    Exit;

  FDrawBuffer.Width := Width;
  FDrawBuffer.Height := Height;
  FButtonBuffer.Width := Width;
  FButtonBuffer.Height := Height;
  FProgressBuffer.Width := Width;
  FProgressBuffer.Height := Height;

  if btProgress in BufferTypes then
    PrepareProgressBuffer;
  if btButton in BufferTypes then
    PrepareButtonBuffer;

  BitBlt(FDrawBuffer.Canvas.Handle, 0, 0, Width, Height, FProgressBuffer.Canvas.Handle, 0, 0, SRCCOPY);

  BlendFunction.BlendOp := AC_SRC_OVER;
  BlendFunction.BlendFlags := 0;
  BlendFunction.SourceConstantAlpha := 255 - FProgressAlpha;
  BlendFunction.AlphaFormat := 0;

  AlphaBlend(FDrawBuffer.Canvas.Handle, 0, 0, Width, Height, FButtonBuffer.Canvas.Handle, 0, 0, Width, Height,
    BlendFunction);

  if Caption <> '' then
  begin
    TextBounds := ClientRect;

    if Enabled then
      FDrawBuffer.Canvas.Font.Color := Font.Color
    else
      FDrawBuffer.Canvas.Font.Color := clGrayText;

    SelectObject(FDrawBuffer.Canvas.Handle, Font.Handle);

    SetBkMode(FDrawBuffer.Canvas.Handle, TRANSPARENT);
    //Edit by johan
    //Uncomment if you like your buttons to be pressed.
    (*if (FButtonState = bsPressed) then OffsetRect(TextBounds,1,1); (**)
    //End of edit
    DrawText(FDrawBuffer.Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
  end;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.SetProgressMin - setter for ProgressMin property   /////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// Value - value to be set

procedure TProgressButton.SetProgressMin(Value: Integer);
begin
  if FProgressMin <> Value then
  begin
    if Value > FProgressMax then
      Exit;

    FProgressMin := Value;
    if FProgressValue < Value then
      FProgressValue := Value;

    PrepareDrawBuffers([btProgress]);
    Invalidate;
  end;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.SetProgressMax - setter for ProgressMax property   /////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// Value - value to be set

procedure TProgressButton.SetProgressMax(Value: Integer);
begin
  if FProgressMax <> Value then
  begin
    if Value < FProgressMin then
      Exit;

    FProgressMax := Value;
    if FProgressValue > Value then
      FProgressValue := Value;

    PrepareDrawBuffers([btProgress]);
    Invalidate;
  end;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.SetProgressValue - setter for ProgressValue property   /////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// Value - value to be set

procedure TProgressButton.SetProgressValue(Value: Integer);
begin
  if Value < FProgressMin then
    Value := FProgressMin
  else
  if Value > FProgressMax then
    Value := FProgressMax;

  if FProgressValue <> Value then
  begin
    FProgressValue := Value;
    PrepareDrawBuffers([btProgress]);
    Invalidate;
  end;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.SetProgressAlpha - setter for ProgressAlpha property   /////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// Value - value to be set

procedure TProgressButton.SetProgressAlpha(Value: Integer);
begin
  if Value < 0 then
    Value := 0
  else
  if Value > 175 then
    Value := 175;

  if FProgressAlpha <> Value then
  begin
    FProgressAlpha := Value;
    PrepareDrawBuffers([btProgress]);
    Invalidate;
  end;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.SetProgressColor - setter for ProgressColor property   /////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// Value - value to be set

procedure TProgressButton.SetProgressColor(Value: TColor);
begin
  if Value <> FProgressColor then
  begin
    FProgressColor := Value;
    PrepareDrawBuffers([btProgress]);
    Invalidate;
  end;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.SetProgressColored - setter for ProgressColored property   /////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// Value - value to be set

procedure TProgressButton.SetProgressColored(Value: Boolean);
begin
  if Value <> FProgressColored then
  begin
    FProgressColored := Value;
    PrepareDrawBuffers([btProgress]);
    Invalidate;
  end;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.SetProgressMargins - setter for ProgressMargins property   /////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// Value - value to be set

procedure TProgressButton.SetProgressMargins(Value: Integer);
begin
  if Value <> FProgressMargins then
  begin
    if (Width - (2 * Value) <= 0) or (Height - (2 * Value) <= 0) or (Value < 0) then
      Exit;

    FProgressMargins := Value;
    PrepareDrawBuffers([btProgress]);
    Invalidate;
  end;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.GetButtonState - helper function for translating item state to internal button state   /////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// Result - current button state
// ItemState - item state passed from the CNDrawItem method

function TProgressButton.GetButtonState(const ItemState: UINT): TButtonState;
begin
  if not Enabled then
    Result := bsDisabled
  else
  begin
    if (ItemState and ODS_SELECTED <> 0) then
      Result := bsPressed
    else
    if FMouseInControl then
      Result := bsButtonHot
    else
    if FFocusInControl or (ItemState and ODS_FOCUS <> 0) then
      Result := bsDefault
    else
      Result := bsNormal;
  end;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.CNDrawItem - control message fired when the custom control changes its state   /////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// Msg - message structure

procedure TProgressButton.CNDrawItem(var Msg: TWMDrawItem);
var
  ButtonState: TButtonState;
begin
  if not Assigned(Parent) then
    Exit;

  ButtonState := GetButtonState(Msg.DrawItemStruct^.itemState);

  if FButtonState <> ButtonState then
  begin
    FButtonState := ButtonState;
    PrepareDrawBuffers([btButton]);
  end;

  BitBlt(Msg.DrawItemStruct^.hDC, 0, 0, Width, Height, FDrawBuffer.Canvas.Handle, 0, 0, SRCCOPY);
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.CMMouseEnter - control message fired when the mouse cursor enters the control   ////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// Msg - message structure

procedure TProgressButton.CMMouseEnter(var Msg: TMessage);
begin
  inherited;
  if not (csDesigning in ComponentState) then
  begin
    FMouseInControl := True;
    Repaint;
  end;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.CMMouseLeave - control message fired when the mouse cursor leaves the control   ////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// Msg - message structure

procedure TProgressButton.CMMouseLeave(var Msg: TMessage);
begin
  inherited;
  if not (csDesigning in ComponentState) then
  begin
    FMouseInControl := False;
    Repaint;
  end;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.CMFontChanged - control message fired when the font is changed   ///////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// Msg - message structure

procedure TProgressButton.CMFontChanged(var Msg: TMessage);
begin
  inherited;
  PrepareDrawBuffers([btCaption]);
  Invalidate;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.CMTextChanged - control message fired when the caption is changed   ////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// Msg - message structure

procedure TProgressButton.CMTextChanged(var Msg: TMessage);
begin
  inherited;
  PrepareDrawBuffers([btCaption]);
  Invalidate;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.WMLButtonDblClk - window message fired when the left mouse button is double-clicked   //////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// Msg - message structure

procedure TProgressButton.WMLButtonDblClk(var Msg: TWMLButtonDblClk);
begin
  Perform(WM_LBUTTONDOWN, Msg.Keys, Longint(Msg.Pos));
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.WMWindowPosChanged - window message fired when the window size / position is changed   /////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// Msg - message structure

procedure TProgressButton.WMWindowPosChanged(var Msg: TWMWindowPosChanged);
begin
  inherited;
  PrepareDrawBuffers([btButton, btProgress]);
  Invalidate;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.Loaded - method fired when the component loading finishes   ////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

procedure TProgressButton.Loaded;
begin
  inherited;
  PrepareDrawBuffers([btButton, btProgress]);
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.SetButtonStyle - function called from parent's CMFocusChanged   ////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// Value - value to be set

procedure TProgressButton.SetButtonStyle(Value: Boolean);
begin
  if Value <> FFocusInControl then
  begin
    FFocusInControl := Value;
    Invalidate;
  end;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   TProgressButton.CreateParams - override the create parameters   ////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// Params - create parameters

procedure TProgressButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or BS_OWNERDRAW;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////   Register - registration procedure   ////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

procedure Register;
begin
  RegisterComponents('StackOverflow', [TProgressButton]);
end;

end.

这是latest version 。我现在没有时间描述它并完成演示。它最终继承自TCustomButton，支持 Action 图像(有一个新属性ImageSource，它指定将用作图像源的内容，isNone = no图像；isAction = 图像取自操作的图像列表；isCustom = 使用Images 列表。

未完待续:)

它可能是这样的: