Une barre de progression en relief (style prodj)

Télécharger le projet
Commenter

Description

Il existe dans le logiciel musical ProDJ un composant qui m'a inspiré cette imitation juste à titre d'exercice, et puis finalement il débarque sur DelphiFr. Précisons que ProDJ ne pourra pas être tenu responsable de la plus ou moins bonne qualité de ce composant... Il est cependant tout à fait fonctionnel.

REMARQUE IMPORTANTE !!!!
Il n'est pas nécessaire d'installer d'abord le composant pour le tester. En effet, la démo est en version QuickTest qui permet de voir globalement le fonctionnement du composant. Si celui-ci vous intéresse, il suffira d'activer certaines lignes de code dans le composant et de l'installer dans des paquets. Si vous ne savez pas comment faire, alors consultez le tutorial 86 à gauche dans la rubrique Outils&Liens.

Le composant est basé sur le modèle de la TGauge. De plus, deux propriétés permettent de le coloriser: GlobalColor et ShadowColor. Sachez également que la couleur du texte est égale à la couleur inversée de GlobalColor.

Voilà...

Source / Exemple : 


unit MdrnG;
interface
{$R MdrGauge.dcr}
uses Windows, SysUtils, Classes, Graphics, Controls;
type
  TModernGauge = class(TCustomControl)
  private
    FMin : integer;
    FMax : integer;
    FPos : integer;
    FColor : TColor;
    FShadow : TColor;
    FOnProgress : TNotifyEvent;
    procedure SetMin(Value : integer);
    procedure SetMax(Value : integer);
    procedure SetPosition(Value : integer);
    procedure SetGlobalColor(Value : TColor);
    procedure SetShadowColor(Value : TColor);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure IncrementProgress;
     function GetPercentDone: integer;
  published
    property Align;
    property Cursor;
    property Hint;
    property ParentShowHint;
    property ShowHint;
    property Visible;
    property Min: integer read FMin write SetMin;
    property Max: integer read FMax write SetMax;
    property Position: integer read FPos write SetPosition;
    property GlobalColor: TColor read FColor write SetGlobalColor;
    property ShadowColor: TColor read FShadow write SetShadowColor;
    property OnClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
  end;
procedure Register;
implementation

  function SolveForY(X, Z: Integer): integer;
  begin
    if Z=0 then Result:=0
    else Result:=trunc((X*100)/Z);
  end;
  function ReverseColor(thecolor: Integer): integer;
  begin
    ReverseColor:=rgb(255-getrvalue(thecolor),255-getgvalue(thecolor),255-getbvalue(thecolor));
  end;

constructor TModernGauge.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle:=ControlStyle + [csOpaque, csCaptureMouse, csClickEvents, csDoubleClicks];
  DoubleBuffered:=true;
  Width:=100;
  Height:=100;
  FMin:=0;
  FMax:=100;
  FPos:=25;
  FColor:=rgb(160,192,240);
  FShadow:=rgb(64,96,144);
  Canvas.Font.Name:='Arial';
  Canvas.Font.Size:=9;
  Canvas.Font.Color:=ReverseColor(FColor);
  Canvas.Font.Style:=[fsBold];
end;

procedure TModernGauge.Paint;
var s : string ;
begin
  with Canvas do begin
    CopyMode:=cmSrcCopy;
//arrière plan
    Brush.Style:=bsSolid;
    Brush.Color:=clBlack;
    Brush.Style:=bsSolid;
    Brush.Color:=clBlack;
    Rectangle(0,0,Width,Height);
//progression
    Pen.Color:=FShadow;
    Brush.Color:=FColor;
    Rectangle(2,2,(Width-2) * GetPercentDone div 100,Height-2);
//rebord blanc
    Pen.Color:=clWhite;
    if (Width-2) * GetPercentDone div 100 >=2 then
      begin
        MoveTo(2,2);
          LineTo((Width-2) * GetPercentDone div 100,2);
        MoveTo(2,2);
          LineTo(2,Height-2);
      end;
//contour relief blanc
    MoveTo(0,Height-1);
      LineTo(Width,Height-1);
    MoveTo(Width-1,0);
      LineTo(Width-1,Height);
//gris foncé
    Pen.Color:=clGray;
    MoveTo(0,0);
      LineTo(Width-2,0);
    MoveTo(0,0);
      LineTo(0,Height-2);
//écrit le "__%"
    Brush.Style:=bsClear;
    Pen.Color:=FColor;
    s:=IntToStr(GetPercentDone)+'%';
    TextOut(  (Width div 2)-(TextWidth(s) div 2),
              (Height div 2)-(TextHeight(s) div 2),
              s
           );
  end;
end;

function TModernGauge.GetPercentDone: integer;
begin
  Result:=SolveForY(FPos - FMin, FMax - FMin);
end;

procedure TModernGauge.IncrementProgress;
begin
  Position:=FPos+1;
end;

procedure TModernGauge.SetMin(Value : integer);
begin
  if Value<>FMin then
    begin
      if Value>FMax then
        Value:=FMax;
      FMin:=Value;
      if FPos<Value then
        FPos:=Value;
      Refresh;
    end;
end;

procedure TModernGauge.SetMax(Value : integer);
begin
  if Value<>FMax then
    begin
      if Value<FMin then
        Value:=FMin;
      FMax:=Value;
      if FPos>Value then
        FPos:=Value;
      Refresh;
    end;
end;

procedure TModernGauge.SetPosition(Value : integer);
var TempPercent: integer;
begin
  TempPercent:=GetPercentDone;
  if Value<FMin then
    Value:=FMin
  else
    if Value>FMax then
      Value:=FMax;
  if FPos<>Value then
    begin
      FPos:=Value;
      if TempPercent<>GetPercentDone then
        Refresh;
    end;
end;

procedure TModernGauge.SetGlobalColor(Value : TColor);
begin
  if Value<>FColor then
    begin
      FColor:=Value;
      Canvas.Font.Color:=ReverseColor(Value);
      Refresh;
    end;
end;

procedure TModernGauge.SetShadowColor(Value : TColor);
begin
  if Value<>FShadow then
    begin
      FShadow:=Value;
      Refresh;
    end;
end;

procedure Register;
begin
  RegisterComponents('Supplément', [TModernGauge]);
end;
end.

Conclusion :


Vous pouvez toujours aller voir 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)