// The Unofficial Newsletter of Delphi Users - Issue #12 - February 23rd, 1996
unit Percnt3d;
(*
TPercnt3D by Lars Posthuma; December 26, 1995.
Copyright 1995, Lars Posthuma.
All rights reserved.
This source code may be freely distributed and used. The author
accepts no responsibility for its use or misuse.
No warranties whatsoever are offered for this unit.
If you make any changes to this source code please inform me at:
LPosthuma@COL.IB.COM.
*)
interface
uses
WinTypes, WinProcs, Classes, Graphics, Controls, ExtCtrls, Forms, SysUtils, Dialogs;
type
TPercnt3DOrientation = (BarHorizontal,BarVertical);
TPercnt3D = class(TCustomPanel)
private
{ Private declarations }
fProgress : Integer;
fMinValue : Integer;
fMaxValue : Integer;
fShowText : Boolean;
fOrientation : TPercnt3DOrientation;
fHeight : Integer;
fWidth : Integer;
fValueChange : TNotifyEvent;
procedure SetBounds(Left,Top,fWidth,fHeight: integer); override;
procedure SetHeight(value: Integer); virtual;
procedure SetWidth(value: Integer); virtual;
procedure SetMaxValue(value: Integer); virtual;
procedure SetMinValue(value: Integer); virtual;
procedure SetProgress(value: Integer); virtual;
procedure SetOrientation(value: TPercnt3DOrientation);
procedure SetShowText(value: Boolean);
function GetPercentDone: Longint;
protected
{ Protected declarations }
procedure Paint; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AddProgress(Value: Integer);
property PercentDone: Longint read GetPercentDone;
procedure SetMinMaxValue(Minvalue,MaxValue: Integer);
published
{ Published declarations }
property Align;
property Cursor;
property Color default clBtnFace;
property Enabled;
property Font;
property Height default 25;
property Width default 100;
property MaxValue: Integer
read fMaxValue write SetMaxValue
default 100;
property MinValue: Integer
read fMinValue write SetMinValue
default 0;
property Progress: Integer
read fProgress write SetProgress
default 0;
property ShowText: Boolean
read fShowText write SetShowText
default True;
property Orientation: TPercnt3DOrientation {}
read fOrientation write SetOrientation
default BarHorizontal;
property OnValueChange: TNotifyEvent {Userdefined Method}
read fValueChange write fValueChange;
property Visible;
property Hint;
property ParentColor;
property ParentFont;
property ParentShowHint;
property ShowHint;
property Tag;
property OnClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
procedure Register;
implementation
constructor TPercnt3D.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Color := clBtnFace; {Set initial (default) values}
Height := 25;
Width := 100;
fOrientation := BarHorizontal;
Font.Color := clBlue;
Caption := ' ';
fMinValue := 0;
fMaxValue := 100;
fProgress := 0;
fShowText := True;
end;
destructor TPercnt3D.Destroy;
begin
inherited Destroy
end;
procedure TPercnt3D.SetHeight(value: integer);
begin
if value <> fHeight then begin
fHeight:= value;
SetBounds(Left,Top,Width,fHeight);
Invalidate;
end
end;
procedure TPercnt3D.SetWidth(value: integer);
begin
if value <> fWidth then begin
fWidth:= value;
SetBounds(Left,Top,fWidth,Height);
Invalidate;
end
end;
procedure TPercnt3D.SetBounds(Left,Top,fWidth,fHeight : integer);
Procedure SwapWH(Var Width, Height: Integer);
Var
TmpInt: Integer;
begin
TmpInt:= Width;
Width := Height;
Height:= TmpInt;
end;
Procedure SetMinDims(Var XValue,YValue: Integer; XValueMin,YValueMin: Integer);
begin
if XValue < XValueMin
then XValue:= XValueMin;
if YValue < YValueMin
then YValue:= YValueMin;
end;
begin
case fOrientation of
BarHorizontal: begin
if fHeight > fWidth
then SwapWH(fWidth,fHeight);
SetMinDims(fWidth,fHeight,50,20);
end;
BarVertical : begin
if fWidth > fHeight
then SwapWH(fWidth,fHeight);
SetMinDims(fWidth,fHeight,20,50);
end;
end;
inherited SetBounds(Left,Top,fWidth,fHeight);
end;
procedure TPercnt3D.SetOrientation(value : TPercnt3DOrientation);
Var
x: Integer;
begin
if value <> fOrientation then begin
fOrientation:= value;
SetBounds(Left,Top,Height,Width); {Swap Width/Height}
Invalidate;
end
end;
procedure TPercnt3D.SetMaxValue(value: integer);
begin
if value <> fMaxValue then begin
fMaxValue:= value;
Invalidate;
end
end;
procedure TPercnt3D.SetMinValue(value: integer);
begin
if value <> fMinValue then begin
fMinValue:= value;
Invalidate;
end
end;
procedure TPercnt3D.SetMinMaxValue(MinValue, MaxValue: integer);
begin
fMinValue:= MinValue;
fMaxValue:= MaxValue;
fProgress:= 0;
Repaint; { Always Repaint }
end;
{ This function solves for x in the equation "x is y% of z". }
function SolveForX(Y, Z: Longint): Integer;
begin
SolveForX:= Trunc( Z * (Y * 0.01) );
end;
{ This function solves for y in the equation "x is y% of z". }
function SolveForY(X, Z: Longint): Integer;
begin
if Z = 0
then SolveForY:= 0
else SolveForY:= Trunc( (X * 100) / Z );
end;
function TPercnt3D.GetPercentDone: Longint;
begin
GetPercentDone:= SolveForY(fProgress - fMinValue, fMaxValue - fMinValue);
end;
procedure TPercnt3D.Paint;
var
TheImage: TBitmap;
FillSize: Longint;
W,H,X,Y : Integer;
TheText : string;
begin
with Canvas do begin
TheImage:= TBitmap.Create;
try
TheImage.Height:= Height;
TheImage.Width := Width;
with TheImage.Canvas do begin
Brush.Color:= Color;
with ClientRect do begin
{ Paint the background }
{ Select Black Pen to outline Window }
Pen.Style:= psSolid;
Pen.Width:= 1;
Pen.Color:= clBlack;
{ Bounding rectangle in black }
Rectangle(Left,Top,Right,Bottom);
{ Draw the inner bevel }
Pen.Color:= clGray;
Rectangle(Left + 3, Top + 3, Right - 3, Bottom - 3);
Pen.Color:= clWhite;
MoveTo(Left + 4, Bottom - 4);
LineTo(Right - 4, Bottom - 4);
LineTo(Right - 4, Top + 2);
{ Draw the 3D Percent stuff }
{ Outline the Percent Bar in black }
Pen.Color:= clBlack;
if Orientation = BarHorizontal
then w:= Right - Left { + 1; }
else w:= Bottom - Top;
FillSize:= SolveForX(PercentDone, W);
if FillSize > 0 then begin
case orientation of
BarHorizontal: begin
Rectangle(Left,Top,FillSize,Bottom);
{ Draw the 3D Percent stuff }
{ UpperRight, LowerRight, LowerLeft }
Pen.Color:= clGray;
Pen.Width:= 2;
MoveTo(FillSize - 2, Top + 2);
LineTo(FillSize - 2, Bottom - 2);
LineTo(Left + 2, Bottom - 2);
{ LowerLeft, UpperLeft, UpperRight }
Pen.Color:= clWhite;
Pen.Width:= 1;
MoveTo(Left + 1, Bottom - 3);
LineTo(Left + 1, Top + 1);
LineTo(FillSize - 2, Top + 1);
end;
BarVertical: begin
FillSize:= Height - FillSize;
Rectangle(Left,FillSize,Right,Bottom);
{ Draw the 3D Percent stuff }
{ LowerLeft, UpperLeft, UpperRight }
Pen.Color:= clGray;
Pen.Width:= 2;
MoveTo(Left + 2, FillSize + 2);
LineTo(Right - 2, FillSize + 2);
LineTo(Right - 2, Bottom - 2);
{ UpperRight, LowerRight, LowerLeft }
Pen.Color:= clWhite;
Pen.Width:= 1;
MoveTo(Left + 1,FillSize + 2);
LineTo(Left + 1,Bottom - 2);
LineTo(Right - 2,Bottom - 2);
end;
end;
end;
if ShowText = True then begin
Brush.Style:= bsClear;
Font := Self.Font;
Font.Color := Self.Font.Color;
TheText:= Format('%d%%', [PercentDone]);
X:= (Right - Left + 1 - TextWidth(TheText)) div 2;
Y:= (Bottom - Top + 1 - TextHeight(TheText)) div 2;
TextRect(ClientRect, X, Y, TheText);
end;
end;
end;
Canvas.CopyMode:= cmSrcCopy;
Canvas.Draw(0,0,TheImage);
finally
TheImage.Destroy;
end;
end;
end;
procedure TPercnt3D.SetProgress(value: Integer);
begin
if (fProgress <> value) and (value >= fMinValue) and (value <= fMaxValue) then begin
fProgress:= value;
Invalidate;
end;
end;
procedure TPercnt3D.AddProgress(value: Integer);
begin
Progress:= fProgress + value;
Refresh;
end;
procedure TPercnt3D.SetShowText(value: Boolean);
begin
if value <> fShowText then begin
fShowText:= value;
Refresh;
end;
end;
procedure Register;
begin
RegisterComponents('DDG', [TPercnt3D]);
end;
end.
