Delphi 圆圈图形进度条控件

List item

unit CircleProgress;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms;

const
FORE_COLOR = clTeal;
BACK_COLOR = clSilver;
PEN_WIDTH = 4;

type
TCircleProgress = class(TGraphicControl)
private
{ Private declarations }
FMinValue: Longint;
FMaxValue: Longint;
FCurValue: Longint;
FPenWidth: Integer;
FShowText: Boolean;
FForeColor: TColor;
FBackColor: TColor;
FFullCover: Boolean;

procedure SetShowText(const Value: Boolean);
procedure SetForeColor(const Value: TColor);
procedure SetBackColor(const Value: TColor);
procedure SetFullCover(const Value: Boolean);
procedure SetMinValue(const Value: Longint);
procedure SetMaxValue(const Value: Longint);
procedure SetProgress(const Value: Longint);
procedure SetPenWidth(const Value: Integer);
//绘制
procedure DrawBackground(const ACanvas: TCanvas);
procedure DrawProgress(const ACanvas: TCanvas);

protected
{ Protected declarations }
procedure Paint; override;
procedure Resize; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
property Align;
property Anchors;
property BackColor: TColor read FBackColor write SetBackColor default BACK_COLOR;
property FullCover: Boolean read FFullCover write SetFullCover default False;
property Color;
property Constraints;
property Enabled;
property ForeColor: TColor read FForeColor write SetForeColor default FORE_COLOR;
property Font;
property MinValue: Longint read FMinValue write SetMinValue default 0;
property MaxValue: Longint read FMaxValue write SetMaxValue default 100;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PenWidth: Integer read FPenWidth write SetPenWidth;
property PopupMenu;
property Progress: Longint read FCurValue write SetProgress;
property ShowHint;
property ShowText: Boolean read FShowText write SetShowText default True;
property Visible;
end;

procedure Register;

implementation

uses
Math, Consts, GDIPOBJ, GDIPAPI;

procedure Register;
begin
RegisterComponents(‘Samples’, [TCircleProgress]);
end;

{ TCircleProgress }

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

ControlStyle := ControlStyle + [csFramed, csOpaque];
{ default values }
FMinValue := 0;
FMaxValue := 100;
FCurValue := 0;
FShowText := True;
FForeColor := FORE_COLOR;
FBackColor := BACK_COLOR;
FPenWidth := PEN_WIDTH;
Width := 100;
Height := 100;
end;

procedure TCircleProgress.DrawBackground(const ACanvas: TCanvas);
var
g: TGPGraphics;
p: TGPPen;
r: TGPRectF;
pw: Integer;
begin
//背景
ACanvas.Brush.Color := Self.Color;
//ACanvas.FillRect(Self.ClientRect);
ACanvas.Ellipse(0,0,Width,Height);
//轨道
g := TGPGraphics.Create(ACanvas.Handle);
pw := FPenWidth;
if not FFullCover then
Inc(pw, 2);
p := TGPPen.Create(ColorRefToARGB(FBackColor), pw);
try
r := MakeRect(pw / 2, pw / 2, Self.Width - pw - 1, Self.Height - pw - 1);
g.SetSmoothingMode(SmoothingModeAntiAlias);
g.DrawEllipse(p, r);
finally
p.Free;
g.Free;
end;
end;

procedure TCircleProgress.DrawProgress(const ACanvas: TCanvas);
procedure DrawPercent(g: TGPGraphics);
var
percent: Integer;
sb: TGPSolidBrush;
fm: TGPFontFamily;
f: TGPFont;
sf: TGPStringFormat;
begin
percent := Round(FCurValue * 100 / (FMaxValue - FMinValue));
sb := TGPSolidBrush.Create(ColorRefToARGB(Font.Color));
fm := TGPFontFamily.Create(Self.Font.Name);
f := TGPFont.Create(fm, Self.Font.Size, FontStyleRegular, UnitPoint);
sf := TGPStringFormat.Create();
sf.SetAlignment(StringAlignmentCenter);
sf.SetLineAlignment(StringAlignmentCenter);
g.DrawString(Format(‘%d%’, [percent]), -1, f, MakeRect(0.0, 0.0, Self.Width, Self.Height), sf, sb);
end;

var
g: TGPGraphics;
p: TGPPen;
pw: Integer;
r: TGPRectF;
angle: Single;
begin
g := TGPGraphics.Create(ACanvas.Handle);
p := TGPPen.Create(ColorRefToARGB(FForeColor), FPenWidth);
try
pw := FPenWidth;
if not FFullCover then
pw := pw + 2;
r := MakeRect(pw / 2, pw / 2, Self.Width - pw - 1, Self.Height - pw - 1);

g.SetSmoothingMode(SmoothingModeHighQuality);
angle := (FCurValue - FMinValue) * 360 / FMaxValue;
g.DrawArc(p, r, -90, angle);

//画百分比
if FShowText then
  DrawPercent(g);

finally
p.Free;
g.Free;
end;
end;

procedure TCircleProgress.Paint;
begin
inherited;

//bmp := TBitmap.Create;
try
//bmp.Height := Height;
//bmp.Width := Width;
//DrawBackground(Canvas);
DrawProgress(Canvas);

//Canvas.CopyMode := cmSrcCopy;
//Canvas.Draw(0, 0, bmp)

finally
//bmp.Free;
end;
end;

procedure TCircleProgress.ReSize;
begin
inherited;

if FPenWidth > Self.Width div 2 - 1 then
begin
FPenWidth := Self.Width div 2 - 1;
Invalidate;
end;
end;

procedure TCircleProgress.SetBackColor(const Value: TColor);
begin
if FBackColor <> Value then
begin
FBackColor := Value;
Invalidate;
end;
end;

procedure TCircleProgress.SetForeColor(const Value: TColor);
begin
if FForeColor <> Value then
begin
FForeColor := Value;
Invalidate;
end;
end;

procedure TCircleProgress.SetFullCover(const Value: Boolean);
begin
if FFullCover <> Value then
begin
FFullCover := Value;
Invalidate;
end;
end;

procedure TCircleProgress.SetMaxValue(const Value: Integer);
begin
if FMaxValue <> Value then
begin
if Value < FMinValue then
if not (csLoading in ComponentState) then
raise EInvalidOperation.CreateFmt(SOutOfRange, [FMinValue + 1, MaxInt]);

FMaxValue := Value;
if FCurValue > Value then FCurValue := Value;
Invalidate;

end;
end;

procedure TCircleProgress.SetMinValue(const Value: Integer);
begin
if FMinValue <> Value then
begin
if Value > FMaxValue then
if not (csLoading in ComponentState) then
raise EInvalidOperation.CreateFmt(SOutOfRange, [-MaxInt, FMaxValue - 1]);

FMinValue := Value;
if FCurValue < Value then FCurValue := Value;
Invalidate;

end;
end;

procedure TCircleProgress.SetPenWidth(const Value: Integer);
begin
if FPenWidth <> Value then
begin
FPenWidth := Value;
if FPenWidth < 1 then
FPenWidth := 1
else if FPenWidth > Self.Width div 2 - 1 then
FPenWidth := Self.Width div 2 - 1;
Invalidate;
end;
end;

procedure TCircleProgress.SetProgress(const Value: Integer);
begin
iF FCurValue <> Value then
begin
FCurValue := Value;
if FCurValue < FMinValue then
FCurValue := FMinValue
else if FCurValue > FMaxValue then
FCurValue := FMaxValue;

Invalidate;

end;
end;
procedure TCircleProgress.SetShowText(const Value: Boolean);
begin
if FShowText <> Value then
begin
FShowText := Value;
Invalidate;
end;
end;

procedure TCircleProgress.SetShowText(const Value: Boolean);
begin
if FShowText <> Value then
begin
FShowText := Value;
Invalidate;
end;
end;

end.

{{{DA2450F85EFC24A937F658F75EFD0A157595F62A7AE760FA5985B1124FB5E67FD8385DBDDCCE364276B3D715B610BDCAE6C9E128AE2CA03A98C4D77684C40E4E8CCB3061A5E62A6CA2E32B6F9C95F4137C9C8F9637ADD13C6E99F80859B24A9DE7197E808ADD246EE378E171EF61A185D93BA4E8117ED13C5EB3E36BED6AEB116CADF923AC27AED8CCCEC3D371D57B8B95A225AF1962A0F61866A9E810065CB31EAF7AD873DB0C41568ACF0E0E4289379CF815127490FE1FBE19BE144F4D80D50942425C23BD114781C43B6EA9EA3E6EA5D5DBD6E77BC20356A53F8ACD087193F252FF4E4F84B2174C819E339B3A5FF16CE560E17ED33AFD409BEE2F9531AEDAD4EDC63B9DC7728894E42363A6EF11679CE3275CABEA1D63918D8DE5255AAFE6245CA3E52F48BDD63450DF266D98EF117EF0040A7E828CF8176F8C8FF4007A81F50206080F74868EF6050A76F01A6BA4E42A59A9DB266A9BE42D59BDC9A5D92662A7D23B98CF7A8BA88AA5D87FD762F56CB514B522A3D6CBCFC1D975DA7CD913BB2BAEDACDC7C4C2C1D0C00F729BEB3634564E57F71C758195FB02021C0AB9D8313161A5EC3E6FE7296F9FF2177F998291303E5CAFE82B6AB5E660A2E12F69ABD93963DC61A0E4365A4556F31A64B6D3325B4E5693F7031C7F9089CBCB3A6F96FE19021177EC2E9731A73C99E4C7E2D825A026A222BEA3E71278DA7BC90B59A482BCFD0C4A8FC663E1349BCD0A56A0F49BB243373315E4F448B4F73B754FB229BC194D5DF363E97C81FCE3A74B39DCB14B041FE7FFE898F82870BC17B0117F905C3932DDA17D7C5544CA8A04FB130C1DB7117DA9EC2D6BA4EC18759F8B8C8C84868D9685C3004185FA2B5DA7EF7F9385C30742465BF559FE5FA1E62F9535F3104B8D31A52B6AFB58F61641983B9E2ECC1D7DDC60FC2675DC72D13F59BFD8CBC25E595567414C8AD870E63492CB0F4DB9E3E7A74438DDB8461E700D3533E33B64B71324A12F55462AEE8A7115F38A4947C59E5742594D548CCD3267ABE82465AFEB2465A091F01271A2F35DFF448BFB2E5FA0E92973CC70D4788497399E25A6D3335AE766EE25CD05419D3B5882C206065AF759FD4C82DC548E359B8C9D2ABD1866BBDBC5D33A4B60350C7E94CA0C4284C2320C265ABF0B4980ABDB}}}