Mega Code Archive
Winrargauge [component]
<![CDATA[
//drony@mynet.com
//icq:266148308
unit WinRarGauge;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls ;
type
TPercentLimit = 0..100;
TOnPercentModify = procedure (Sender:TObject; Percent: Integer)
of object ;
type
TWinRarGauge = class(TGraphicControl)
private
FPercent : TPercentLimit;
FOnChange : TOnPercentModify ;
procedure SetPercent( Value : TPercentLimit ) ;
procedure Draw(Canvas: TCanvas; Rect: TRect; Percent: Integer);
protected
procedure Paint ; override ;
procedure PercentChanged ; dynamic ;
public
constructor Create( AOwner : TComponent ) ; override ;
destructor Destroy; override;
published
property Percent : TPercentLimit
read FPercent
write SetPercent;
property OnChange : TOnPercentModify
read FOnChange
write FOnChange ;
property Align;
property Color;
property Visible;
end;
procedure Register;
implementation
PROCEDURE TWinRarGauge.Draw(Canvas: Tcanvas; Rect: TRect; Percent: Integer);
var MemI: TImage;
procedure DrawBorder(Canvas: TCanvas; Rect: TRect);
begin
with Canvas, Rect do
begin
Pen.Color := $009090B0; {First Border}
MoveTo(Left,Bottom-3);
LineTo(Left,Top);
LineTo(Right-2,Top);
LineTo(Right-2,Bottom-3);
LineTo(Left,Bottom-3);
Pen.Color := $005F5F5F; {Bottom Gray Line}
MoveTo(Left, Bottom-2);
LineTo(Right, Bottom-2);
Pen.Color := $00000000; {Black Shadow}
MoveTo(Left+1, Bottom-1);
LineTo(Right-1, Bottom-1);
LineTo(Right-1, Top+1);
Pen.Color := $007F7F9F; {Second Border}
MoveTo(Left+1, Bottom-4);
LineTo(Left+1, Top+1);
LineTo(Right-3, Top+1);
LineTo(Right-3, Bottom-4);
LineTo(Left+1, Bottom-4);
Brush.Color := $006D6D8D; {Background Fill}
Pen.Color := $006D6D8D;
Rectangle(Left+2, Bottom-4, Right-3, Top+2);
end;
end;
procedure DrawBar(Canvas: TCanvas ; Rect: TRect; Percent: Integer);
var BLength : Integer ;
begin
if Percent = 0 then Exit;
with Canvas, Rect do
begin
BLength := (Right - 1) * Percent div 100;
Pen.Color := $00FFFFFF; {Left and Top White line}
MoveTo(Left, Bottom-3);
LineTo(Left, Top);
LineTo(BLength, Top);
Pen.Color := $00EFE7E0; {Second Border}
Rectangle(Left+1, Bottom-2, BLength, Top+1);
Pen.Color := $00DCD5D0; {Bar Foreground}
Brush.Color := Pen.Color;
Rectangle(Left+2, Bottom-3, BLength-1, Top+2);
Pen.Color := $005F5F5F; {2 Vertical Lines after it...}
MoveTo(Left+BLength, Bottom-2);
LineTo(Left+BLength, Top-1);
Pen.Color := $007F7F9F;
MoveTo(Left+BLength+1, Bottom-3);
LineTo(Left+BLength+1, Top-1);
Pen.Color := $00000000; {Redraw the ending black line}
MoveTo(Right-1, Bottom-1);
LineTo(Right-1, Top+1);
Pen.Color := Color; {2 DarkGray dots at end when bar reaches 100%}
MoveTo(Right-1, Top+1);
LineTo(Right-1, Top-1);
end;
end;
BEGIN
MemI := TImage.Create(Self);
MemI.Width:=Width;
MemI.Height:=Height;
with MemI.Canvas do
begin
Brush.Color := Color;
FillRect(ClipRect); {Fill the canvas background}
DrawBorder(MemI.Canvas, Rect);
DrawBar(MemI.Canvas, Rect, Percent);
end;
Canvas.Draw(0,0,MemI.Picture.Graphic);
MemI.Free;
END;
constructor TWinRarGauge.Create ( AOwner : TComponent );
begin
inherited Create(AOwner);
Color := clBtnFace;
FPercent := 0 ;
Width := 200 ;
Height := 15 ;
end;
destructor TWinRarGauge.Destroy;
begin
inherited Destroy;
end;
procedure TWinRarGauge.SetPercent (Value : TPercentLimit );
begin
if FPercent <> Value then
begin
if (Value <= 100) and (Value >= 0) then
begin
FPercent := Value;
PercentChanged ; {Set event}
Paint;
end;
end;
end;
procedure TWinRarGauge.PercentChanged ;
begin
if Assigned (FOnChange) then
FOnChange(Self,FPercent);
end;
procedure TWinRarGauge.Paint ;
var Rect : TRect;
begin
inherited Paint;
Rect := ClientRect;
Draw(Canvas, Rect, FPercent);
end;
procedure Register;
begin
RegisterComponents('Plus', [TWinRarGauge]);
end;
end.
]]>