// 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.