Chip 2002 February/Chip_2002-02_cd1.bin/zkuste/delphi/kolekce/d45/delfi_components.exe/Delfi_gauge.pas

Pascal/Delphi Source File | 2001-11-20 | 8KB | 318 lines

// unit Delfi_gauge
//
// new gauge with more properties, styles and events ...
//
//
// version 1.0  2001 Delfi
//
// this component is freeware for non-commercial applications you use it on your own responsibility !
// you may modify this unit only for non-commercial applications
// you may not change the AUTHOR you must leave this comment here !
//
// if you improved this component add your comment after this line

unit Delfi_gauge;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  tKind_ = (Text, Bar, VerticalBar, Line, VerticalLine, pie_);
  tstyle_ = (_3d, flat, none);
  TDelfi_gauge = class(TCustomControl)
  private
    { Private declarations }
    fkind:tKind_;
    fstyle_:tstyle_;
    ftext:boolean;
    freverse:boolean;
    fposition:integer;
    fmax:integer;
    fmin:integer;
    fcolor:tcolor;
    fbarcolor:tcolor;
    fbitmap:tbitmap;
    procedure SetKind(Value: tKind_);
    procedure Setstyle(Value: tstyle_);
    procedure Settext(Value: boolean);
    procedure Setreverse(Value: boolean);
    procedure Setposition(Value: integer);
    procedure Setmax(Value: integer);
    procedure Setmin(Value: integer);
    procedure Setcolor(Value: tcolor);
    procedure Setbarcolor(Value: tcolor);
    procedure Setbitmap(Value: tbitmap);
    function GetPercentDone: Longint;
  protected
    { Protected declarations }
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    property PercentDone: Longint read GetPercentDone;
  published
    { Published declarations }
    property align;
    property Kind: tkind_ read FKind write SetKind;
    property style: tstyle_ read fstyle_ write Setstyle;
    property text: boolean read ftext write Settext;
    property reverse: boolean read freverse write Setreverse;
    property position: integer read fposition write Setposition;
    property color: tcolor read fcolor write Setcolor;
    property barcolor: tcolor read fbarcolor write Setbarcolor;
    property bitmap: tbitmap read fbitmap write Setbitmap;
    property max: integer read fmax write Setmax;
    property min: integer read fmin write Setmin;
    property ShowHint;
    property ParentShowHint;
    property Onclick;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseMove;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnExit;
    property OnEnter;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property TabOrder;
    property TabStop;
    property OnstartDock;
    property OnstartDrag;
    property Visible;
    property Popupmenu;
    property helpcontext;
    property cursor;
    property dragkind;
    property dragmode;
    property dragcursor;
  end;

procedure Register;

implementation

procedure TDelfi_gauge.SetKind(Value: tkind_);
begin
FKind := Value;
RecreateWnd;
end;

procedure TDelfi_gauge.setstyle(Value: tstyle_);
begin
fstyle_ := Value;
RecreateWnd;
end;

procedure TDelfi_gauge.Settext(Value: boolean);
begin
ftext:=value;
RecreateWnd;
end;

procedure TDelfi_gauge.setreverse(Value: boolean);
begin
freverse:=value;
RecreateWnd;
end;

procedure TDelfi_gauge.Setposition(Value: integer);
begin
fposition:=value;
RecreateWnd;
end;

procedure TDelfi_gauge.Setmax(Value: integer);
begin
fmax:=value;
RecreateWnd;
end;

procedure TDelfi_gauge.Setmin(Value: integer);
begin
fmin:=value;
RecreateWnd;
end;

function SolveForX(Y, Z: Longint): Longint;
begin
Result := Longint(Trunc( Z * (Y * 0.01) ));
end;

function SolveForY(X, Z: Longint): Longint;
begin
if Z = 0 then Result := 0
else Result := Longint(Trunc( (X * 100.0) / Z ));
end;

function TDelfi_gauge.GetPercentDone: Longint;
begin
Result :=SolveForY(fposition - fmin, FMax - FMin);
end;

procedure TDelfi_gauge.Setcolor(value : tcolor);
begin
fcolor:=value;
Paint;
end;

procedure TDelfi_gauge.Setbarcolor(value : tcolor);
begin
fbarcolor:=value;
Paint;
end;

procedure TDelfi_gauge.setbitmap(value : tbitmap);
begin
fbitmap.Assign(value);
Paint;
end;

constructor TDelfi_gauge.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
controlstyle:=controlstyle + [csOpaque];
Width := 80;
Height := 23;
ftext:=true;
fcolor:=clwhite;
fbarcolor:=clblack;
fbitmap:=tbitmap.Create;
fkind:=bar;
fmax:=100;
end;

procedure TDelfi_gauge.Paint;
var
String_: string;
bank:tbitmap;
MiddleX, MiddleY: Integer;
Angle: Double;
painter:integer;
piepainter:integer;
Style_:TBrushStyle;
begin
with Canvas do
begin
Brush.Color := fcolor;
FillRect(clientrect);

Style_:=Brush.Style;
Brush.Style := bsClear;
Brush.Style := Style_;

Canvas.CopyMode := cmSrcCopy    ;
draw(0,0,fbitmap);

pen.color := fbarcolor;
Brush.Color := fbarcolor;

if fstyle_ = _3d then piepainter:=4;
if fstyle_ = flat then piepainter:=2;
if fstyle_ = none then piepainter:=0;

if fstyle_ = _3d then painter:=3;
if fstyle_ = flat then painter:=2;
if fstyle_ = none then painter:=0;

if freverse = false then begin;
if fkind = Bar then FillRect(Rect(0,0,SolveForX(PercentDone,width)-painter, Height));
if fkind = VerticalBar then FillRect(Rect(0,0,width, SolveForX(PercentDone,height)-painter));
if fkind = Line then begin
canvas.MoveTo(SolveForX(PercentDone,width)-painter,0);
canvas.LineTo(SolveForX(PercentDone,width)-painter,Height);
end;
if fkind = VerticalLine then begin
canvas.MoveTo(0,SolveForX(PercentDone,height)-painter);
canvas.LineTo(width,SolveForX(PercentDone,height)-painter);
end;

if fkind = pie_ then begin
Brush.Color := Color;
Pen.Width := 1;
Ellipse(0, 0, Width-piepainter, Height-piepainter);
if PercentDone > 0 then begin
MiddleX := Width div 2;
MiddleY := width div 2;
Angle := (Pi * ((PercentDone / 50) + 0.5));
Brush.Color := fbarcolor;
Pie(0, 0, Width-piepainter, Height-piepainter,
Integer(Round(MiddleX * (1 - Cos(Angle)))),
Integer(Round(MiddleY * (1 - Sin(Angle)))), MiddleX, 0);
end;
end;
end;

if freverse = true then begin;
if fkind = Bar then FillRect(Rect(width - SolveForX(PercentDone,width),0,width-painter,height-painter));

if fkind = VerticalBar then FillRect(Rect(0,height - SolveForX(PercentDone,height)-painter,width,height));

if fkind = Line then begin
canvas.MoveTo(width - SolveForX(PercentDone,width)-painter,0);
canvas.LineTo(width - SolveForX(PercentDone,width)-painter,Height);
end;
if fkind = VerticalLine then begin
canvas.MoveTo(0,height - SolveForX(PercentDone,height)-painter);
canvas.LineTo(width,height - SolveForX(PercentDone,height)-painter);
end;

if fkind = pie_ then begin
Brush.Color := Color;
Pen.Width := 1;
Ellipse(0, 0, Width-piepainter, Height-piepainter);
if PercentDone > 0 then begin
MiddleX := Width div 2;
MiddleY := width div 2;
Angle := (Pi * ((PercentDone / 50) + 0.5));
Brush.Color := fbarcolor;
Pie(0, 0, Width-piepainter, Height-piepainter,
Integer(Round(MiddleX * (1 - Cos(Angle)))),
Integer(Round(MiddleY * (1 - Sin(Angle)))), MiddleX, 0);
end;
end;
end;

end;

String_:=inttostr(PercentDone)+ ' %';

bank:=tbitmap.create;
bank.canvas.Brush.Style := bsClear;
bank.canvas.Font.Color := clwhite;

bank.canvas.Brush.Color := clblack;
bank.canvas.FillRect(clientrect);
bank.Width:=bank.canvas.TextWidth(String_);
bank.height:=bank.canvas.Textheight(String_);

if ftext = true then bank.Canvas.textout(0,0,string_);

Canvas.CopyMode := cmSrcInvert;
Canvas.Draw(width div 2 - bank.canvas.TextWidth(String_) div 2 , height div 2 - bank.canvas.Textheight(String_) div 2 - painter div 2 , bank);
bank.Free;
end;

procedure TDelfi_gauge.CreateParams(var Params: TCreateParams);
begin
inherited;
if fstyle_ = flat then params.ExStyle:=params.ExStyle OR ws_ex_staticedge;
if fstyle_ <> flat then params.ExStyle:=params.ExStyle and not ws_ex_staticedge;

if fstyle_ = _3d then params.ExStyle:=params.ExStyle or ws_ex_clientedge;
if fstyle_ <> _3d then params.ExStyle:=params.ExStyle and not ws_ex_clientedge;
end;

procedure Register;
begin
RegisterComponents('Delfi', [TDelfi_gauge]);
end;

end.