Mega Code Archive
Gauge bar with a different look
<![CDATA[
Title: Gauge bar with a different look
Question: Can I have a different GaugeBar ???
Answer:
unit AGGauge;
interface
uses
SysUtils, Classes, Controls, Graphics, Windows;
type
TOrientation = (goHorizontal,goVertical);
TAGGauge = class(TGraphicControl)
private
FBarColor : TColor;
FBorderColor : TColor;
FInactiveBarColor: TColor;
FGap : Integer;
FOrientation : TOrientation;
FProgress : Integer;
procedure SetBarColor(Value: TColor);
procedure SetBorderColor(Value: TColor);
procedure SetInactiveBarColor(Value: TColor);
procedure SetGap(const Value: Integer);
procedure SetOrientation(Value: TOrientation);
procedure SetProgress(Value: Integer);
protected
{ Protected declarations }
public
constructor Create(AOwner: TComponent); override;
procedure Paint; override;
published
property Anchors;
property BarColor: TColor read FBarColor write SetBarColor;
property BorderColor: TColor read FBorderColor write SetBorderColor;
property Gap: Integer read FGap write SetGap;
property InactiveBarColor: TColor read FInactiveBarColor write SetInactiveBarColor;
property Orientation: TOrientation read FOrientation write SetOrientation;
property Progress: Integer read FProgress write SetProgress;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Alain', [TAGGauge]);
end;
{ TAGGauge }
constructor TAGGauge.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FBarColor := clBlack;
FBorderColor := clBlack;
FInactiveBarColor := clSilver;
FGap := 2;
FOrientation := goHorizontal;
FProgress := 50;
end;
procedure TAGGauge.Paint;
var
I : Integer;
Spc : Integer;
Haut : Integer;
Larg : Integer;
NewRect: TRect;
TmpRect: TRect;
begin
inherited;
Canvas.Brush.Color := FBorderColor;
NewRect := ClientRect;
Canvas.FrameRect(NewRect);
InflateRect(NewRect,FGap * -1,FGap * -1);
Spc := 0;
if FOrientation = goHorizontal then
begin
Larg := NewRect.Right - NewRect.Left;
for I := 0 to Larg do
begin
if (FProgress 0) and (I Canvas.Brush.Color := FBarColor
else
Canvas.Brush.Color := FInactiveBarColor;
TmpRect.Top := NewRect.Top;
TmpRect.Bottom := NewRect.Bottom;
TmpRect.Left := NewRect.Left + Spc;
TmpRect.Right := NewRect.Left + FGap + Spc;
if TmpRect.Right = ClientRect.Right then
break;
Canvas.FillRect(TmpRect);
Spc := Spc + (FGap * 2);
end;
end
else
begin
Haut := NewRect.Bottom - NewRect.Top;
for I := 0 to Haut do
begin
if (FProgress 0) and (I Canvas.Brush.Color := FBarColor
else
Canvas.Brush.Color := FInactiveBarColor;
TmpRect.Left := NewRect.Left;
TmpRect.Right := NewRect.Right;
TmpRect.Top := NewRect.Bottom - FGap - Spc;
TmpRect.Bottom := NewRect.Bottom - Spc;
if TmpRect.Top break;
Canvas.FillRect(TmpRect);
Spc := Spc + (FGap * 2);
end;
end;
end;
procedure TAGGauge.SetBarColor(Value: TColor);
begin
if Value = FBarColor then exit;
FBarColor := Value;
Invalidate;
end;
procedure TAGGauge.SetBorderColor(Value: TColor);
begin
if Value = FBorderColor then exit;
FBorderColor := Value;
Invalidate;
end;
procedure TAGGauge.SetGap(const Value: Integer);
begin
if Value = FGap then exit;
FGap := Value;
if FGap FGap := 1;
Invalidate;
end;
procedure TAGGauge.SetInactiveBarColor(Value: TColor);
begin
if Value = FInactiveBarColor then exit;
FInactiveBarColor := Value;
Invalidate;
end;
procedure TAGGauge.SetOrientation(Value: TOrientation);
begin
if Value = FOrientation then exit;
FOrientation := Value;
Invalidate;
end;
procedure TAGGauge.SetProgress(Value: Integer);
begin
if Value = FProgress then exit;
FProgress := Value;
if FProgress else
if FProgress 100 then FProgress := 100;
Invalidate;
end;
end.
]]>