Я создал один для вас.В этом нет ничего крутого, потому что у меня нет большого опыта написания компонентов, поэтому, пожалуйста, примите его как есть:)
Доступно два компонента:
Следующие свойства действительны дляоба компонента:
- 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
, поддерживает изображения действий (есть новое свойство ImageSource
, которое назначает то, что будет использоваться в качестве источника изображения, isNone
= нет изображения; isAction
= изображение берется из списка изображений действия;isCustom
= использует список Images
).
Продолжение следует:)
А вот как это может выглядеть: