delphi – 有没有`ProgressButton`？

有两个组件可用：

> 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,255);
          Pixel.B := MulDiv(B,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,ProgressBar,nil);
  ThemedDetails := ThemeServices.GetElementDetails(tpChunk);
  ThemeServices.DrawElement(FProgressBuffer.Canvas.Handle,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,Width,Height,FProgressBuffer.Canvas.Handle,SRCCOPY);

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

  AlphaBlend(FDrawBuffer.Canvas.Handle,FButtonBuffer.Canvas.Handle,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,FDrawBuffer.Canvas.Handle,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继承，支持动作图像(有一个新的属性ImageSource，它将分配将用作图像源的内容，isNone = no image; isAction =图像来自动作的图像列表; isCustom =使用Images列表)。

未完待续 ：)

在这里它可能如下所示：