Une jauge de progression et de compression comme celle qu'on trouve dans WinRAR... super pratique et très belle par ailleurs!
Pour installer le composant:
http://www.delphifr.com/tutorial.aspx?id=86
Source / Exemple :
unit rar_bar;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, Consts;
type
TRarBar = class(TCustomControl)
private
FMinValue: Integer;
FMaxValue: Integer;
FCurValue: Integer;
FRatValue: Integer;
FBackColor: TColor;
FOnProgress: TNotifyEvent;
procedure PaintBackground;
procedure PaintProgress;
procedure PaintRate;
procedure SetBackColor(Value: TColor);
procedure SetMinValue(Value: Longint);
procedure SetMaxValue(Value: Longint);
procedure SetProgress(Value: Longint);
procedure SetRate(Value: Longint);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
procedure IncrementProgress;
procedure IncrementRate;
function GetPercentDone: integer;
function GetRatePercentDone: integer;
published
property Align;
property Enabled;
property ShowHint;
property Hint;
property Visible;
property ParentShowHint;
property PopupMenu;
property BackColor: TColor read FBackColor write SetBackColor default clBtnFace;
property Min: Longint read FMinValue write SetMinValue default 0;
property Max: Longint read FMaxValue write SetMaxValue default 100;
property Position: Longint read FCurValue write SetProgress;
property Rate: Longint read FRatValue write SetRate;
{évènements}
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
end;
var RarBmp : TBitmap;
procedure Register;
implementation
function SolveForY(X, Z: Integer): integer;
begin
if Z=0 then Result := 0
else Result:=trunc((X*100)/Z);
end;
constructor TRarBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque, csCaptureMouse,
csClickEvents, csDoubleClicks];
FMinValue:=0;
FMaxValue:=100;
FCurValue:=0;
FRatValue:=0;
FBackColor:=clBtnFace;
Width:=177;
Height:=17;
end;
function TRarBar.GetPercentDone: integer;
begin
Result := SolveForY(FCurValue - FMinValue, FMaxValue - FMinValue);
end;
function TRarBar.GetRatePercentDone: integer;
begin
Result := SolveForY(FRatValue - FMinValue, FMaxValue - FMinValue);
end;
procedure TRarBar.Paint;
begin
with Canvas do
begin
rarbmp.Height:=Height;
rarbmp.Width:=Width;
PaintBackground;
PaintProgress;
PaintRate;
Canvas.Draw(0,0,RarBmp);
if Assigned(FOnProgress) then FOnProgress(Self);
Refresh;
end;
end;
procedure TRarBar.PaintBackground;
begin
with RarBmp.Canvas do
begin
{--- arrière plan ---}
Brush.Style:=bsSolid;
Brush.Color:=FBackColor;
Pen.Color:=FBackColor;
RarBmp.Canvas.Rectangle(0,0,Width,Height);
{--- fond noir ---}
Brush.Style:=bsSolid;
Brush.Color:=clBlack;
Pen.Width:=1;
Pen.Color:=clBlack;
RarBmp.Canvas.Rectangle(1,2,Width,Height);
{--- contour beige ---}
Brush.Style:=bsClear;
Pen.Width:=1;
Pen.Color:=$9898B8;
RarBmp.Canvas.Rectangle(0,0,Width-1,Height-2);
{--- contour beige ---}
Brush.Style:=bsClear;
Pen.Width:=1;
Pen.Color:=$9898B8;
RarBmp.Canvas.Rectangle(0,0,Width-1,Height-2);
{--- contour pourpre ---}
Brush.Style:=bsClear;
Pen.Width:=1;
Pen.Color:=$8080A0;
RarBmp.Canvas.Rectangle(1,1,Width-2,Height-3);
{--- remplissage ---}
Brush.Style:=bsSolid;
Brush.Color:=$707098;
Pen.Color:=$707098;
Pen.Width:=1;
RarBmp.Canvas.Rectangle(2,2,Width-3,Height-4);
{--- ligne grise ---}
Pen.Color:=$606060;
Pen.Width:=1;
RarBmp.Canvas.MoveTo(0,Height-2);
RarBmp.Canvas.LineTo(Width-1,Height-2);
end;
end;
procedure TRarBar.PaintProgress;
var i, wi : integer;
begin
with RarBmp.Canvas do
begin
i:=GetPercentDone;
{--- trace bordure gauche ---}
if i>0 then
begin
{--- ligne blanche ---}
Pen.Color:=clWhite;
Pen.Width:=1;
RarBmp.Canvas.MoveTo(0,0);
RarBmp.Canvas.LineTo(0,Height-2);
{--- ligne violasse ---}
Pen.Color:=$F0E8E8;
Pen.Width:=1;
RarBmp.Canvas.MoveTo(1,0);
RarBmp.Canvas.LineTo(1,Height-2);
end;
{--- trace le remplissage ---}
wi:=((Width-3)*i) div 100+2;
{--- ligne blanche ---}
Pen.Color:=clWhite;
Pen.Width:=1;
RarBmp.Canvas.MoveTo(2,0);
RarBmp.Canvas.LineTo(wi,0);
{--- ligne violasse ---}
Pen.Color:=$F0E8E8;
Pen.Width:=1;
//haut
RarBmp.Canvas.MoveTo(2,1);
RarBmp.Canvas.LineTo(wi,1);
//bas
RarBmp.Canvas.MoveTo(2,Height-3);
RarBmp.Canvas.LineTo(wi,Height-3);
{--- remplissage ---}
Brush.Style:=bsSolid;
Brush.Color:=$D8D8D8;
Pen.Color:=$D8D8D8;
Pen.Width:=1;
RarBmp.Canvas.Rectangle(2,2,wi,Height-3);
{--- trace du marqueur relief ---}
if wi>2 then
begin
Pixels[1,0]:=clWhite;
Pixels[wi-1,0]:=clWhite;
Pen.Width:=1;
Pen.Color:=$F0E8E8;
MoveTo(wi-1,1);
LineTo(wi-1,Height-3);
end;
if wi<Width-2 then
begin
Pixels[wi+1,0]:=$9898B8;
Pixels[wi+1,Height-3]:=$9898B8;
end;
if (wi>2) and (wi<Width-2) then
begin
Pen.Color:=$8080A0;
MoveTo(wi+1,1);
LineTo(wi+1,Height-4);
Pen.Color:=$606060;
MoveTo(wi,0);
LineTo(wi,Height-2);
end;
end;
end;
procedure TRarBar.PaintRate;
var i, wi : integer;
begin
with RarBmp.Canvas do
begin
i:=GetRatePercentDone;
{--- trace bordure gauche ---}
if i>0 then
begin
{--- ligne jaune ---}
Pen.Color:=$C0FFFF;
Pen.Width:=1;
RarBmp.Canvas.MoveTo(0,0);
RarBmp.Canvas.LineTo(0,Height-2);
{--- ligne orangée ---}
Pen.Color:=$B8D8E8;
Pen.Width:=1;
RarBmp.Canvas.MoveTo(1,0);
RarBmp.Canvas.LineTo(1,Height-2);
end;
{--- trace le remplissage ---}
wi:=((Width-3)*i) div 100+2;
if wi>2 then
Pixels[1,0]:=$C0FFFF;
{--- ligne jaune ---}
Pen.Color:=$C0FFFF;
Pen.Width:=1;
RarBmp.Canvas.MoveTo(2,0);
RarBmp.Canvas.LineTo(wi,0);
{--- ligne orangée ---}
Pen.Color:=$B8D8E8;
Pen.Width:=1;
//haut
RarBmp.Canvas.MoveTo(2,1);
RarBmp.Canvas.LineTo(wi,1);
//bas
RarBmp.Canvas.MoveTo(2,Height-3);
RarBmp.Canvas.LineTo(wi,Height-3);
{--- remplissage ---}
Brush.Style:=bsSolid;
Brush.Color:=$A0C0D0;
Pen.Color:=$A0C0D0;
Pen.Width:=1;
RarBmp.Canvas.Rectangle(2,2,wi,Height-3);
end;
end;
procedure TRarBar.SetMinValue(Value: Longint);
begin
if Value <> FMinValue 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;
if FRatValue < Value then FRatValue := Value;
Refresh;
end;
end;
procedure TRarBar.SetMaxValue(Value: Longint);
begin
if Value <> FMaxValue 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;
if FRatValue > Value then FRatValue := Value;
Refresh;
end;
end;
procedure TRarBar.SetProgress(Value: Longint);
var TempPercent: integer;
begin
TempPercent := GetPercentDone; { remember where we were }
if Value < FMinValue then
Value := FMinValue
else if Value > FMaxValue then
Value := FMaxValue;
if FCurValue <> Value then
begin
FCurValue := Value;
if TempPercent <> GetPercentDone then { only Refresh if percentage changed }
Refresh;
end;
end;
procedure TRarBar.SetRate(Value: Longint);
var TempPercent: integer;
begin
TempPercent := GetRatePercentDone; { remember where we were }
if Value < FMinValue then
Value := FMinValue
else if Value > FMaxValue then
Value := FMaxValue;
if FRatValue <> Value then
begin
FRatValue := Value;
if TempPercent <> GetRatePercentDone then { only Refresh if percentage changed }
Refresh;
end;
end;
procedure TRarBar.SetBackColor(Value: TColor);
begin
if Value <> FBackColor then
begin
FBackColor:=Value;
Refresh;
end;
end;
procedure TRarBar.IncrementProgress;
begin
Position:=FCurValue+1;
end;
procedure TRarBar.IncrementRate;
begin
Position:=FRatValue+1;
end;
procedure Register;
begin
RegisterComponents('Win32', [TRarBar]);
end;
initialization
rarbmp:=TBitmap.Create;
finalization
rarbmp.Free;
end.
Conclusion :
Vous pouvez toujours visiter
http://altert.family.free.fr/
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.