Une barre de compression et progression de type winrar (trarbar)

Télécharger le projet
Commenter

Description

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/
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_grandvizir)