Delphi-PRAXiS - Delphi Suche Progressbar mit Min,Max vom Typ Double

Hallo Leute,

ich habe eine Fremdkomponente mit Source und habe sie mir
entsprechend umgebaut.
Ich dachte nicht das es so Problemlos ist.

Herlichen Dank an alle.

Gruß Kostas

unit Progbr3d;

interface

{$A+} { Word align data }
{$B-} { Complete Boolean Evaluation Directive }
{$D-} { Debug Information Directive }
{$L-} { Local Symbol Information Directive }
{$R-} { Range checking off }
{$S-} { Stack checking off }
{$T-} { We don't need (nor want) this type checking! }

uses
WinTypes, WinProcs, Classes, Graphics, Controls, ExtCtrls, Forms,
SysUtils, Dialogs;

type
ProgressBar3DOrientation = (BarHorizontal, BarVertical);

ProgressBar3D = class(TCustomPanel)
private
{ Private declarations }
FProgress : Double;
FMinValue : Double;
FMaxValue : Double;
FShowText : Boolean;
FBackColor : TColor;
FBarColor : TColor;
FBorderColor: TColor;
FOrientation: ProgressBar3DOrientation;
FHeight : Integer;
FWidth : Integer;
FValueChange: TNotifyEvent;
FPrefix : String;
FNachkomma : Integer;

procedure SetBounds(Left,Top,fWidth,fHeight: integer); override;
procedure SetHeight(Value: Integer); virtual;
procedure SetWidth(Value: Integer); virtual;
procedure SetNachkomma(Value: Integer); virtual;
procedure SetMaxValue(Value: Double); virtual;
procedure SetMinValue(Value: Double); virtual;
procedure SetProgress(Value: Double); virtual;
{}procedure SetPrefix(Value: String); virtual;
procedure SetOrientation(Value: ProgressBar3DOrientation);
procedure SetShowText(Value: Boolean);
procedure SetBackColor(Value: TColor);
procedure SetBarColor(Value: TColor);
procedure SetBorderColor(Value: TColor);

function GetPercentDone: Double;
protected
{ Protected declarations }
procedure Paint; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AddProgress(Value: Double);
procedure SetMinMaxValue(MinValue,MaxValue: Double);
published
{ Published declarations }
property PercentDone: Double read GetPercentDone;
property Align;
property Cursor;
property Enabled;
property Font;
property Height default 25;
property Width default 100;
property Prefix: String read FPrefix write SetPrefix;
property Nachkomma: Integer read FNachkomma write SetNachkomma default 0;
property MaxValue: Double read FMaxValue write SetMaxValue;
property MinValue: Double read FMinValue write SetMinValue;
property Progress: Double read FProgress write SetProgress;
property ShowText: Boolean read FShowText write SetShowText default True;
property BarColor: TColor read FBarColor write SetBarColor default clBtnFace;
property BackColor: TColor read FBackColor write SetBackColor default clBtnFace;
property BorderColor: TColor read FBorderColor write SetBorderColor default clBtnFace;
property Orientation: ProgressBar3DOrientation read FOrientation write SetOrientation default BarHorizontal;
property OnValueChange: TNotifyEvent read FValueChange write FValueChange;
property Visible;
property Hint;
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 ProgressBar3D.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FBackColor := clBtnFace;
FBarColor := clBtnFace;
FBorderColor := clBtnFace;
Height := 25;
Width := 100;
FOrientation := BarHorizontal;
Font.Color := clBlue;
Caption := ' ';
FMinValue := 0;
FMaxValue := 100;
FProgress := 0;
FShowText := True;
FPrefix := '';
FNachkomma := 0;
end;

destructor ProgressBar3D.Destroy;
begin
inherited Destroy;
end;

procedure ProgressBar3D.SetBackColor(Value: TColor);
begin
FBackColor := Value;
Invalidate;
end;

procedure ProgressBar3D.SetBorderColor(Value: TColor);
begin
FBorderColor := Value;
Invalidate;
end;

procedure ProgressBar3D.SetBarColor(Value: TColor);
begin
FBarColor := Value;
Invalidate;
end;

procedure ProgressBar3D.SetHeight(Value: integer);
begin
if Value <> fHeight then
begin
FHeight:= Value;
SetBounds(Left, Top, Width, FHeight);
Invalidate;
end
end;

procedure ProgressBar3D.SetWidth(Value: integer);
begin
if Value <> fWidth then
begin
FWidth:= Value;
SetBounds(Left, Top, FWidth, Height);
Invalidate;
end
end;

procedure ProgressBar3D.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; { Case }
inherited SetBounds(Left, Top, FWidth, FHeight);
end;

procedure ProgressBar3D.SetOrientation(Value: ProgressBar3DOrientation);
var
x: Integer;
begin
if Value <> FOrientation then
begin
FOrientation := Value;
SetBounds(Left, Top, Height, Width);
Invalidate;
end
end;

procedure ProgressBar3D.SetMaxValue(Value: Double);
begin
if Value <> FMaxValue then
begin
FMaxValue := Value;
Invalidate;
end
end;

{}procedure ProgressBar3D.SetPrefix(Value: String);
begin
if Value <> FPrefix then
begin
FPrefix := Value;
Invalidate;
end
end;

{}procedure ProgressBar3D.SetNachkomma(Value: Integer);
begin
if Value <> Fnachkomma then
begin
Fnachkomma := Value;
Invalidate;
end
end;

procedure ProgressBar3D.SetMinValue(Value: Double);
begin
if Value <> FMinValue then
begin
FMinValue := Value;
Invalidate;
end
end;

procedure ProgressBar3D.SetMinMaxValue(MinValue, MaxValue: Double);
begin
FMinValue := MinValue;
FMaxValue := MaxValue;
FProgress := 0;
Repaint;
end;

{ This function solves for x in the equation "x is y% of z". }
function SolveForX(Y, Z: Double): Double;
begin
SolveForX := (Z * (Y * 0.01));
end;

{ This function solves for y in the equation "x is y% of z". }
function SolveForY(X, Z: Double): Double;
begin
if Z = 0 then SolveForY := 0
else SolveForY := ((X * 100) / Z);
end;

function ProgressBar3D.GetPercentDone: Double;
begin
GetPercentDone := SolveForY(FProgress - FMinValue, FMaxValue - FMinValue);
end;

procedure ProgressBar3D.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:= FBorderColor;
with ClientRect do
begin
Pen.Style:= psSolid;
Pen.Width:= 1;
Pen.Color:= clBlack;

Rectangle(Left,Top,Right,Bottom);

Pen.Color:= clGray;

Brush.Color:= FBackColor;
// Rectangle(Left + 3, Top + 3, Right - 3, Bottom - 3); kostas
Rectangle(Left, Top, Right, Bottom);
Pen.Color:= clWhite;
MoveTo(Left, Bottom);
LineTo(Right, Bottom);
LineTo(Right, Top);

// MoveTo(Left + 4, Bottom - 4); kostas
// LineTo(Right - 4, Bottom - 4);
// LineTo(Right - 4, Top + 2);

Pen.Color:= clBlack;
if Orientation = BarHorizontal then w:= Right - Left { + 1; }
else w:= Bottom - Top;
FillSize:= Trunc(SolveForX(PercentDone, W));

if FillSize > 0 then
begin
Brush.Color:= FBarColor;
case orientation of
BarHorizontal:
begin
Rectangle(Left,Top,FillSize,Bottom);
{ Draw the 3D Percent stuff }
{ UpperRight, LowerRight, LowerLeft }
Pen.Color:= clGray;
Pen.Width:= 1;
MoveTo(FillSize, Top);
LineTo(FillSize, Bottom);
// Pen.Width:= 2; kostas
// MoveTo(FillSize - 2, Top + 2);
// LineTo(FillSize - 2, Bottom - 2);

LineTo(Left, Bottom);
{ LowerLeft, UpperLeft, UpperRight }
Pen.Color:= clWhite;
Pen.Width:= 1;
MoveTo(Left, Bottom);
LineTo(Left, Top);
LineTo(FillSize, Top);

// LineTo(Left + 2, Bottom - 2); kostas
// { 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; { Case }
end;
if ShowText then
begin
Brush.Style := bsClear;
Font := Self.Font;
Font.Color := Self.Font.Color;

TheText:= FPrefix + Format('%*.*f%%', [8, FNachkomma, (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; { Try }
end; { With }
end;

procedure ProgressBar3D.SetProgress(Value: Double);
begin
if (FProgress <> Value) and (Value >= FMinValue) and (Value <= FMaxValue) then
begin
FProgress:= Value;
Invalidate;
end
end;

procedure ProgressBar3D.AddProgress(Value: Double);
begin
Progress:= fProgress + Value;
Refresh;
end;

procedure ProgressBar3D.SetShowText(Value: Boolean);
begin
if Value <> FShowText then
begin
FShowText:= Value;
Refresh;
end
end;

procedure Register;
begin
RegisterComponents('kostas', [ProgressBar3D]);
end;

end.