unit Gauges;
interface
uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, StdCtrls;
type
TGaugeKind = (gkText, gkHorizontalBar, gkVerticalBar, gkPie, gkNeedle);
TGauge =
class(TGraphicControl)
private
FMinValue: Longint;
FMaxValue: Longint;
FCurValue: Longint;
FKind: TGaugeKind;
FShowText: Boolean;
FBorderStyle: TBorderStyle;
FForeColor: TColor;
FBackColor: TColor;
procedure PaintBackground(AnImage: TBitmap);
procedure PaintAsText(AnImage: TBitmap; PaintRect: TRect);
procedure PaintAsNothing(AnImage: TBitmap; PaintRect: TRect);
procedure PaintAsBar(AnImage: TBitmap; PaintRect: TRect);
procedure PaintAsPie(AnImage: TBitmap; PaintRect: TRect);
procedure PaintAsNeedle(AnImage: TBitmap; PaintRect: TRect);
procedure SetGaugeKind(Value: TGaugeKind);
procedure SetShowText(Value: Boolean);
procedure SetBorderStyle(Value: TBorderStyle);
procedure SetForeColor(Value: TColor);
procedure SetBackColor(Value: TColor);
procedure SetMinValue(Value: Longint);
procedure SetMaxValue(Value: Longint);
procedure SetProgress(Value: Longint);
function GetPercentDone: Longint;
protected
procedure Paint;
override;
public
constructor Create(AOwner: TComponent);
override;
procedure AddProgress(Value: Longint);
property PercentDone: Longint
read GetPercentDone;
published
property Align;
property Anchors;
property BackColor: TColor
read FBackColor
write SetBackColor
default clWhite;
property BorderStyle: TBorderStyle
read FBorderStyle
write SetBorderStyle
default bsSingle;
property Color;
property Constraints;
property Enabled;
property ForeColor: TColor
read FForeColor
write SetForeColor
default clBlack;
property Font;
property Kind: TGaugeKind
read FKind
write SetGaugeKind
default gkHorizontalBar;
property MinValue: Longint
read FMinValue
write SetMinValue
default 0;
property MaxValue: Longint
read FMaxValue
write SetMaxValue
default 100;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property Progress: Longint
read FCurValue
write SetProgress;
property ShowHint;
property ShowText: Boolean
read FShowText
write SetShowText
default True;
property Visible;
end;
procedure Register;
//Neu hinzufügen!
implementation
uses Consts;
//Neu hinzufügen!
procedure Register;
begin
RegisterComponents('
Samples', [TGauge]);
end;
type
TBltBitmap =
class(TBitmap)
procedure MakeLike(ATemplate: TBitmap);
end;
{ TBltBitmap }
procedure TBltBitmap.MakeLike(ATemplate: TBitmap);
begin
Width := ATemplate.Width;
Height := ATemplate.Height;
Canvas.Brush.Color := clWindowFrame;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(Rect(0, 0, Width, Height));
end;