Есть ли "ProgressButton"?

Я хотел бы иметь кнопку, которая выполняет двойную функцию как индикатор выполнения.

+ =........

например. кнопка, которая заполняется зеленым фоном по мере продвижения задачи.
Я знаю, что могу создать свою собственную, но если есть что-то готовое, я бы хотел использовать это.

Кто-нибудь знает о свободном или коммерческом компоненте, который соответствует счету?

Я бы предпочел, чтобы он работал в Delphi-2007, но если он доступен только в XE2, это тоже будет нормально.

Обновление
TMS имеет glassbutton, который обеспечивает прозрачность. Если вы нанесете фигуру (с закругленными углами) в темно-зеленый цвет внизу, она будет похожа на эффект, который я хочу.
Просто увеличьте ширину формы, чтобы соответствовать прогрессу, и вы находитесь в бизнесе.

Когда у меня будет время, я сделаю кнопку, которая заполняется цветом и поднимет ссылку.

Ответ 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 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).

Продолжение:)

И вот как это может выглядеть:

Ответ 1

Ответ 2