You've already forked lazarus-ccr
b4ebb7fc97
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6559 8e941d3f-bd1b-0410-a28a-d453659cc2b4
1277 lines
33 KiB
ObjectPascal
1277 lines
33 KiB
ObjectPascal
unit A3nalogGauge;
|
|
|
|
{$DEFINE TICKER}
|
|
|
|
{$IFDEF FPC}
|
|
{$MODE DELPHI}
|
|
{$IFNDEF WINDOWS}
|
|
{$UNDEF TICKER}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF LCL}
|
|
LCLIntf, LCLType, LCLProc, LMessages,
|
|
{$IFDEF TICKER} Windows,{$ENDIF} // for QueryPerformanceCounter
|
|
{$ELSE}
|
|
Windows, Messages,
|
|
{$ENDIF}
|
|
SysUtils, Classes, Graphics, Controls;
|
|
|
|
type
|
|
TAntialiased = (aaNone, aaBiline, aaTriline, aaQuadral);
|
|
|
|
TStyle = (agsLeftStyle, agsRightStyle, agsCenterStyle);
|
|
|
|
TFaceOption = (
|
|
foShowMargin, foShowCircles, foShowMainTicks, foShowSubTicks,
|
|
foShowIndicatorMin, foShowIndicatorMid, foShowIndicatorMax,
|
|
foShowValues, foShowCenter, foShowFrame, foShow3D, foShowCaption
|
|
);
|
|
TFaceOptions = set of TFaceOption;
|
|
|
|
const
|
|
DEFAULT_FACE_OPTIONS = [
|
|
foShowMainTicks, foShowSubTicks, foShowIndicatorMax,
|
|
foShowValues, foShowCenter, foShowFrame, foShow3D, foShowCaption
|
|
];
|
|
|
|
type
|
|
TA3nalogGauge = class(TCustomControl)
|
|
private
|
|
// face elements colors
|
|
FMinColor: TColor;
|
|
FMidColor: TColor;
|
|
FMaxColor: TColor;
|
|
FFaceColor: TColor;
|
|
FTicksColor: TColor;
|
|
FValueColor: TColor;
|
|
FCaptionColor: TColor;
|
|
FArrowColor: TColor;
|
|
FMarginColor: TColor;
|
|
FCenterColor: TColor;
|
|
FCircleColor: TColor;
|
|
FFrameColor: TColor;
|
|
// face elements sizes, etc.
|
|
FCenterRadius: Integer;
|
|
FCircleRadius: Integer;
|
|
FScaleAngle: Integer;
|
|
FMargin: Integer;
|
|
FStyle: TStyle;
|
|
FArrowWidth: Integer;
|
|
FNumMainTicks: Integer;
|
|
FLengthMainTicks: Integer;
|
|
FLengthSubTicks: Integer;
|
|
FFaceOptions: TFaceOptions;
|
|
FCaptionFont: TFont;
|
|
// values
|
|
FPosition: Single;
|
|
FScaleValue: Integer;
|
|
FMinimum: Integer;
|
|
FMaximum: Integer;
|
|
FCaption: string;
|
|
// event handlers
|
|
FOverMax: TNotifyEvent;
|
|
FOverMin: TNotifyEvent;
|
|
// anti-aliasing mode
|
|
FAntiAliased: TAntialiased;
|
|
// internal bitmaps
|
|
FBackBitmap: TBitmap;
|
|
FFaceBitmap: TBitmap;
|
|
FAABitmap: TBitmap;
|
|
{$IFDEF LCL}
|
|
FBitmapsValid: Boolean;
|
|
{$ENDIF}
|
|
{$IFDEF TICKER}
|
|
// performance tracking
|
|
FTicker: Int64;
|
|
FPeriod: Int64;
|
|
FFrames: Integer;
|
|
FOnFrames: TNotifyEvent;
|
|
{$ENDIF}
|
|
// set properties
|
|
procedure SetFrameColor(C: TColor);
|
|
procedure SetFMinColor(C: TColor);
|
|
procedure SetFMidColor(C: TColor);
|
|
procedure SetFMaxColor(C: TColor);
|
|
procedure SetFFaceColor(C: TColor);
|
|
procedure SetFTicksColor(C: TColor);
|
|
procedure SetFValueColor(C: TColor);
|
|
procedure SetFCaptionColor(C: TColor);
|
|
procedure SetFArrowColor(C: TColor);
|
|
procedure SetFMarginColor(C: TColor);
|
|
procedure SetFCenterColor(C: TColor);
|
|
procedure SetFCircleColor(C: TColor);
|
|
procedure SetFCenterRadius(I: Integer);
|
|
procedure SetFCircleRadius(I: Integer);
|
|
procedure SetFScaleAngle(I: Integer);
|
|
procedure SetFMargin(I: Integer);
|
|
procedure SetFStyle(S: TStyle);
|
|
procedure SetFArrowWidth(I: Integer);
|
|
procedure SetFNumMainTicks(I: Integer);
|
|
procedure SetFLengthMainTicks(I: Integer);
|
|
procedure SetFLengthSubTicks(I: Integer);
|
|
procedure SetFFaceOptions(O: TFaceOptions);
|
|
procedure SetFPosition(V: Single);
|
|
procedure SetFScaleValue(I: Integer);
|
|
procedure SetFMaximum(I: Integer);
|
|
procedure SetFMinimum(I: Integer);
|
|
procedure SetFCaption(const S: string);
|
|
procedure SetFAntiAliased(V: TAntialiased);
|
|
procedure SetCaptionFont(AValue: TFont);
|
|
function GetAAMultiplier: Integer;
|
|
|
|
protected
|
|
procedure CaptionFontChanged(Sender: TObject);
|
|
procedure DrawScale(Bitmap: TBitmap; K: Integer);
|
|
procedure DrawArrow(Bitmap: TBitmap; K: Integer);
|
|
procedure FastAntiAliasPicture;
|
|
procedure Loaded; override;
|
|
procedure RedrawArrow;
|
|
procedure RedrawScale;
|
|
procedure Paint; override;
|
|
procedure Resize; override;
|
|
{$IFDEF LCL}
|
|
procedure FontChanged(Sender: TObject); override;
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
{$ELSE}
|
|
procedure CMFontChanged(var Msg: TMessage); message CM_FontChanged;
|
|
procedure WMEraseBkGnd(var Msg: TMessage); message WM_ERASEBKGND;
|
|
{$ENDIF}
|
|
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
published
|
|
property Angle: Integer
|
|
read FScaleAngle write SetFScaleAngle default 120;
|
|
property AntiAliased: TAntialiased
|
|
read FAntiAliased write SetFAntiAliased default aaNone;
|
|
property ArrowColor: TColor
|
|
read FArrowColor write SetFArrowColor default clBlack;
|
|
property ArrowWidth: Integer
|
|
read FArrowWidth write SetFArrowWidth default 1;
|
|
property Caption: string read FCaption write SetFCaption;
|
|
property CaptionColor: TColor
|
|
read FCaptionColor write SetFCaptionColor default clBlack;
|
|
property CaptionFont: TFont
|
|
read FCaptionFont write SetCaptionFont;
|
|
property CenterColor: TColor
|
|
read FCenterColor write SetFCenterColor default clDkGray;
|
|
property CenterRadius: Integer
|
|
read FCenterRadius write SetFCenterRadius default 8;
|
|
property CircleColor: TColor
|
|
read FCircleColor write SetFCircleColor default clBlue;
|
|
property CircleRadius: Integer
|
|
read FCircleRadius write SetFCircleRadius default 3;
|
|
property FaceColor: TColor
|
|
read FFaceColor write SetFFaceColor default clBtnFace;
|
|
property FaceOptions: TFaceOptions
|
|
read FFaceOptions write SetFFaceOptions default DEFAULT_FACE_OPTIONS;
|
|
property FrameColor: TColor
|
|
read FFrameColor write SetFramecolor default clBtnShadow;
|
|
property IndMaximum: Integer
|
|
read FMaximum write SetFMaximum default 80;
|
|
property IndMinimum: Integer
|
|
read FMinimum write SetFMinimum default 20;
|
|
property LengthMainTicks: Integer
|
|
read FLengthMainTicks write SetFLengthMainTicks default 15;
|
|
property LengthSubTicks: Integer
|
|
read FLengthSubTicks write SetFLengthSubTicks default 8;
|
|
property Margin: Integer
|
|
read FMargin write SetFMargin default 10;
|
|
property MarginColor: TColor
|
|
read FMarginColor write SetFMarginColor default clSilver;
|
|
property MaxColor: TColor
|
|
read FMaxColor write SetFMaxColor default clRed;
|
|
property MidColor: TColor
|
|
read FMidColor write SetFMidColor default clYellow;
|
|
property MinColor: TColor
|
|
read FMinColor write SetFMinColor default clGreen;
|
|
property NumberMainTicks: Integer
|
|
read FNumMainTicks write SetFNumMainTicks default 5;
|
|
property Position: Single read FPosition write SetFPosition;
|
|
property Scale: Integer
|
|
read FScaleValue write SetFScaleValue default 100;
|
|
property Style: TStyle
|
|
read FStyle write SetFStyle default agsCenterStyle;
|
|
property TicksColor: TColor
|
|
read FTicksColor write SetFTicksColor default clBlack;
|
|
property ValueColor: TColor
|
|
read FValueColor write SetFValueColor default clBlack;
|
|
property OnOverMax: TNotifyEvent read FOverMax write FOverMax;
|
|
property OnOverMin: TNotifyEvent read FOverMin write FOverMin;
|
|
{$IFDEF TICKER}
|
|
property OnFrames: TNotifyEvent read FOnFrames write FOnFrames;
|
|
property Frames: Integer read FFrames;
|
|
{$ENDIF}
|
|
|
|
property Align;
|
|
property Anchors;
|
|
{$IFDEF LCL}
|
|
property BorderSpacing;
|
|
{$ENDIF}
|
|
property Font;
|
|
property Height default 180;
|
|
property Width default 225;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF LCL}
|
|
IntfGraphics, fpimage,
|
|
{$ENDIF}
|
|
Math;
|
|
|
|
{$IFNDEF LCL}
|
|
function GetTickCount64: Int64;
|
|
begin
|
|
Result := GetTickCount;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
{ TA3nalogGauge }
|
|
|
|
constructor TA3nalogGauge.Create(AOwner: TComponent);
|
|
var
|
|
w, h: Integer;
|
|
begin
|
|
inherited;
|
|
FBackBitmap := TBitmap.Create;
|
|
FFaceBitmap := TBitmap.Create;
|
|
FAABitmap := nil;
|
|
//*****************************defaults:****************************************
|
|
{$IFDEF LCL}
|
|
with GetControlClassDefaultSize do begin
|
|
SetInitialBounds(0, 0, CX, CY);
|
|
w := CX;
|
|
h := CY;
|
|
end;
|
|
{$ELSE}
|
|
w := 225;
|
|
h := 180;
|
|
Width := w;
|
|
Height := h;
|
|
{$ENDIF}
|
|
FBackBitmap.Width := w;
|
|
FBackBitmap.Height := h;
|
|
FBackBitmap.Canvas.Brush.Style := bsClear;
|
|
FBackBitmap.Canvas.Brush.Color := Self.Color;
|
|
FFaceBitmap.Width := w;
|
|
FFaceBitmap.Height := h;
|
|
FFaceColor := clBtnFace;
|
|
FFrameColor := clBtnShadow;
|
|
FTicksColor := clBlack;
|
|
FValueColor := clBlack;
|
|
FCaptionColor := clBlack;
|
|
FArrowColor := clBlack;
|
|
FMarginColor := clSilver; //Black;
|
|
FCenterColor := clDkGray;
|
|
FCircleColor := clBlue;
|
|
FMinColor := clGreen;
|
|
FMidColor := clYellow;
|
|
FMaxColor := clRed;
|
|
FArrowWidth := 1;
|
|
FPosition := 0;
|
|
FMargin := 10;
|
|
FStyle := agsCenterStyle;
|
|
FScaleValue := 100;
|
|
FMaximum := 80;
|
|
FMinimum := 20;
|
|
FScaleAngle := 120;
|
|
FCircleRadius := 3;
|
|
FCenterRadius := 8;
|
|
FNumMainTicks := 5;
|
|
FLengthMainTicks := 15;
|
|
FLengthSubTicks := 8;
|
|
FCaption := '';
|
|
FFaceOptions := DEFAULT_FACE_OPTIONS;
|
|
FAntiAliased := aaNone;
|
|
FCaptionFont := TFont.Create;
|
|
FCaptionFont.OnChange := CaptionFontChanged;
|
|
{$IFDEF TICKER}
|
|
FTicker := -1;
|
|
FFrames := 0;
|
|
if not QueryPerformanceFrequency(FPeriod) then
|
|
FPeriod := 0;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
destructor TA3nalogGauge.Destroy;
|
|
begin
|
|
FBackBitmap.Free;
|
|
FFaceBitmap.Free;
|
|
FAABitmap.Free;
|
|
FCaptionFont.Free;
|
|
inherited;
|
|
end;
|
|
{ ------------------------------------------------------------------------- }
|
|
procedure SetPenStyles(Pen: TPen; Width: Integer; Color: TColor);
|
|
var
|
|
HP: HPen;
|
|
LB: TLOGBRUSH;
|
|
begin
|
|
{$IFDEF LCL}
|
|
Pen.Width := Width;
|
|
Pen.Color := Color;
|
|
{$ELSE}
|
|
LB.lbStyle := BS_SOLID;
|
|
LB.lbColor := Color;
|
|
LB.lbHatch := 0;
|
|
HP := ExtCreatePen(PS_GEOMETRIC or PS_SOLID or PS_ENDCAP_FLAT or
|
|
PS_JOIN_ROUND, Width, LB, 0, nil);
|
|
if HP = 0 then begin
|
|
Pen.Width := Width;
|
|
Pen.Color := Color
|
|
end else
|
|
Pen.Handle := HP;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TA3nalogGauge.CaptionFontChanged(Sender: TObject);
|
|
begin
|
|
RedrawScale;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.DrawScale(Bitmap: TBitmap; K: Integer);
|
|
var
|
|
I, J, X, Y, N, M, W, H, R: Integer;
|
|
Max, Min: Int64;
|
|
A, C, dA: Single;
|
|
hFnt, hCapFnt, hTxt, wTxt: Integer;
|
|
cosA, sinA: Extended;
|
|
cosB, sinB: Extended;
|
|
tm: TTextMetric;
|
|
pt: TPoint;
|
|
txt: String;
|
|
txtDist: Integer;
|
|
begin
|
|
W := Bitmap.Width;
|
|
H := Bitmap.Height;
|
|
Max := FMaximum;
|
|
Min := FMinimum;
|
|
N := FNumMainTicks*5;
|
|
M := FMargin * K;
|
|
R := FCircleRadius * K;
|
|
txtDist := 10;
|
|
|
|
with Bitmap do begin
|
|
Canvas.Brush.Color := FFaceColor;
|
|
Canvas.FillRect(Canvas.ClipRect);
|
|
Canvas.Font.Assign(Font);
|
|
GetTextMetrics(Canvas.Handle, tm);
|
|
hfnt := tm.tmHeight * K;
|
|
Canvas.Font.Height := hFnt;
|
|
|
|
{ draw frame }
|
|
if foShowFrame in FFaceOptions then begin
|
|
if foShow3D in FFaceOptions then begin
|
|
Canvas.Pen.Width := 2*K;
|
|
Canvas.Pen.Color := clBtnShadow;
|
|
Canvas.MoveTo(W, 0);
|
|
Canvas.LineTo(0, 0);
|
|
Canvas.LineTo(0, H);
|
|
Canvas.Pen.Color := clBtnHighlight;
|
|
Canvas.LineTo(W, H);
|
|
Canvas.LineTo(W, 0);
|
|
end else begin
|
|
Canvas.Pen.Width := K;
|
|
Canvas.Pen.Color := FFrameColor;
|
|
Canvas.Rectangle(0, 0, W, H);
|
|
end;
|
|
end;
|
|
|
|
{ draw margins }
|
|
if foShowMargin in FFaceOptions then begin
|
|
Canvas.Pen.Color := FMarginColor;
|
|
Canvas.Pen.Width := K;
|
|
Canvas.Rectangle(M, M, W - M, H - M);
|
|
end;
|
|
|
|
{ calculate center of scale }
|
|
case fStyle of
|
|
agsRightStyle:
|
|
begin
|
|
A := 0;
|
|
C := W - M;
|
|
X := W - M;
|
|
Y := H - M;
|
|
if H > W then
|
|
J := W - 2*M
|
|
else
|
|
J := H - 2*M;
|
|
if FScaleAngle > 90 then FScaleAngle := 90;
|
|
end;
|
|
agsLeftStyle:
|
|
begin
|
|
A := 90;
|
|
C := M;
|
|
X := M;
|
|
Y := H - M;
|
|
if H > W then
|
|
J := W - 2*M
|
|
else
|
|
J := H - 2*M;
|
|
if FScaleAngle > 90 then FScaleAngle := 90;
|
|
end;
|
|
agsCenterStyle:
|
|
begin
|
|
X := W div 2;
|
|
A := (180 - fScaleAngle)/2;
|
|
C := W/2;
|
|
if FScaleAngle >= 180 then begin
|
|
J := (W - 2*M) div 2;
|
|
Y := H div 2;
|
|
end else begin
|
|
J := Round(((W - 2*M)/2) / cos(A*pi/180));
|
|
if J > H - 2*M then J := H - 2*M;
|
|
Y := (H - J) div 2 + J;
|
|
end;
|
|
end;
|
|
else
|
|
raise Exception.Create('Style unknown.');
|
|
end;{case}
|
|
|
|
{ Draw caption }
|
|
if (foShowCaption in FFaceOptions) then begin
|
|
SinCos(DegToRad(A + FScaleAngle/2), sinA, cosA);
|
|
Canvas.Font.Assign(FCaptionFont);
|
|
GetTextMetrics(Canvas.Handle, tm);
|
|
hCapFnt := tm.tmHeight * K;
|
|
Canvas.Font.Height := hcapFnt;
|
|
Canvas.Font.Color := FCaptionColor;
|
|
pt := Point(Round(C - J/2 * cosA), Round(Y - J/2 * sinA));
|
|
Canvas.TextOut(pt.X - Canvas.TextWidth(FCaption) div 2, pt.Y, FCaption);
|
|
end;
|
|
|
|
{ Draw min/max indicator arcs }
|
|
if (foShowIndicatorMax in FFaceOptions) then begin
|
|
SetPenStyles(Canvas.Pen, 4 * K, FMaxColor);
|
|
SinCos(DegToRad(A + FScaleAngle), sinA, cosA);
|
|
SinCos(DegToRad(A + Max*FScaleAngle/FScaleValue), sinB, cosB);
|
|
Canvas.Arc(X - J, Y - J, X + J, Y + J,
|
|
Round(C - J * cosA),
|
|
Round(Y - J * sinA),
|
|
Round(C - J * cosB),
|
|
Round(Y - J * sinB)
|
|
);
|
|
end;
|
|
if (foShowIndicatorMid in FFaceOptions) and (FMinimum < FMaximum) then begin
|
|
SetPenStyles(Canvas.Pen, 4 * K, FMidColor);
|
|
SinCos(DegToRad(A + Max*FScaleAngle/FScaleValue), sinA, cosA);
|
|
SinCos(DegToRad(A + Min*FScaleAngle/FScaleValue), sinB, cosB);
|
|
Canvas.Arc(X - J, Y - J, X + J, Y + J,
|
|
Round(C - J * cosA),
|
|
Round(Y - J * sinA),
|
|
Round(C - J * cosB),
|
|
Round(Y - J * sinB)
|
|
);
|
|
end;
|
|
if (foShowIndicatorMin in FFaceOptions) then begin
|
|
SinCos(DegToRad(A + Min*FScaleAngle/FScaleValue), sinA, cosA);
|
|
SinCos(DegToRad(A), sinB, cosB);
|
|
SetPenStyles(Canvas.Pen, 4 * K, FMinColor);
|
|
Canvas.Arc(X - J, Y - J, X + J, Y + J,
|
|
Round(C - J * cosA),
|
|
Round(Y - J * sinA),
|
|
Round(C - J * cosB),
|
|
Round(Y - J * sinB)
|
|
);
|
|
end;
|
|
Canvas.Pen.Color := FTicksColor;
|
|
Canvas.Pen.Width := K;
|
|
|
|
{ Draw subticks }
|
|
if foShowSubTicks in fFaceOptions then
|
|
for I := 0 to N do begin
|
|
SinCos(DegToRad(A + I*FScaleAngle/N), sinA, cosA);
|
|
Canvas.MoveTo(Round(C-(J-FLengthSubTicks*K)*cosA), Round(Y-(J-FLengthSubTicks*K)*sinA));
|
|
Canvas.LineTo(round(C-(J-K)*cosA), round(Y-(J-K)*sinA));
|
|
end;
|
|
|
|
{ Draw main ticks }
|
|
for I := 0 to FNumMainTicks do begin
|
|
dA := I * FScaleAngle / FNumMainTicks;
|
|
if foShowMainTicks in fFaceOptions then begin
|
|
SinCos(DegToRad(A + dA), sinA, cosA);
|
|
Canvas.MoveTo(Round(C-(J-FLengthMainTicks*K)*cosA), Round(Y-(J-FLengthMainTicks*K)*sinA));
|
|
Canvas.LineTo(Round(C-(J-K)*cosA), Round(Y-(J-K)*sinA));
|
|
end;
|
|
|
|
{ Draw circles }
|
|
if foShowCircles in fFaceOptions then begin
|
|
SinCos(DegToRad(A + dA), sinA, cosA);
|
|
Canvas.Brush.Color := FCircleColor;
|
|
pt := Point(Round(C - J*cosA), Round(Y - J*sinA));
|
|
Canvas.Ellipse(pt.X - R, pt.Y - R, pt.X + R, pt.Y + R);
|
|
end;
|
|
|
|
{ Draw main tick values }
|
|
if foShowValues in fFaceOptions then begin
|
|
Canvas.Font.Assign(Self.Font);
|
|
Canvas.Font.Height := hFnt;
|
|
hTxt := Canvas.TextHeight('Tg');
|
|
Canvas.Brush.Style := bsClear;
|
|
SinCos(DegToRad(A + dA), sinA, cosA);
|
|
txt := FormatFloat('0', I * fScaleValue div fNumMainTicks);
|
|
wTxt := Canvas.TextWidth(txt);
|
|
Canvas.TextOut(
|
|
Round(C-(J-(FLengthMainTicks+txtDist)*K-I)*cosA) - wTxt div 2,
|
|
Round(Y-(J-(FLengthMainTicks+txtDist)*K)*sinA) - hTxt div 2,
|
|
txt
|
|
);
|
|
end;
|
|
end;
|
|
end
|
|
end;
|
|
|
|
procedure TA3nalogGauge.DrawArrow(Bitmap: TBitmap; K: Integer);
|
|
var
|
|
J, X, Y, M, W, H, R: Integer;
|
|
A, C: Single;
|
|
cosA, sinA: Extended;
|
|
begin
|
|
M := FMargin * K;
|
|
R := FCenterRadius * K;
|
|
W := Bitmap.Width;
|
|
H := Bitmap.Height;
|
|
|
|
with Bitmap do begin
|
|
case FStyle of
|
|
agsRightStyle:
|
|
begin
|
|
A := 0;
|
|
C := W - M;
|
|
X := W - M; // X, Y: position of center circle
|
|
Y := H - M;
|
|
if H > W then
|
|
J := W - 2*M // J: Arrow length
|
|
else
|
|
J := H - 2*M;
|
|
if FScaleAngle > 90 then FScaleAngle := 90;
|
|
end;
|
|
agsLeftStyle:
|
|
begin
|
|
A := 90;
|
|
C := M;
|
|
X := M;
|
|
Y := H - M;
|
|
if H > W then
|
|
J := W - 2*M
|
|
else
|
|
J := H - 2*M;
|
|
if FScaleAngle > 90 then FScaleAngle := 90;
|
|
end;
|
|
agsCenterStyle:
|
|
begin
|
|
X := W div 2;
|
|
A := (180 - fScaleAngle)/2;
|
|
C := W/2;
|
|
if FScaleAngle >= 180 then begin
|
|
J := (W - 2*M) div 2;
|
|
Y := H div 2;
|
|
end else begin
|
|
J := Round(((W - 2*M)/2)/cos(A*pi/180));
|
|
if J > H - 2*M then J := H - 2*M;
|
|
Y := (H - J) div 2 + J;
|
|
end;
|
|
end;
|
|
else
|
|
raise Exception.Create('Style unknown');
|
|
end;{case}
|
|
|
|
SinCos((A + FPosition*FScaleAngle/FScaleValue)*pi/180, sinA, cosA);
|
|
Canvas.Pen.Width := FArrowWidth * K;
|
|
Canvas.Pen.Color := FArrowColor;
|
|
Canvas.MoveTo(X, Y);
|
|
Canvas.LineTo(Round(C - J*cosA), Round(Y - J*sinA));
|
|
|
|
{ Draw center }
|
|
if foShowCenter in FFaceOptions then begin
|
|
Canvas.Brush.Color := FCenterColor;
|
|
Canvas.Pen.Width := 1;
|
|
Canvas.Ellipse(X - R, Y - R, X + R, Y + R);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.RedrawArrow;
|
|
{$IFDEF TICKER}
|
|
var
|
|
F: Integer;
|
|
ticker: Int64;
|
|
begin
|
|
if FTicker < 0 then
|
|
if FPeriod = 0 then
|
|
FTicker := GetTickCount64
|
|
else
|
|
QueryPerformanceCounter(FTicker);
|
|
{$ELSE}
|
|
begin
|
|
{$ENDIF}
|
|
BitBlt(
|
|
FFaceBitmap.Canvas.Handle, 0, 0,
|
|
FBackBitmap.Width,
|
|
FBackBitmap.Height,
|
|
FBackBitmap.Canvas.Handle, 0, 0,
|
|
SRCCOPY
|
|
);
|
|
DrawArrow(FFaceBitmap, GetAAMultiplier);
|
|
|
|
if FAntialiased <> aaNone then
|
|
FastAntiAliasPicture;
|
|
|
|
{$IFNDEF LCL}
|
|
Paint;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TICKER}
|
|
if FPeriod = 0 then begin
|
|
ticker := GetTickCount64;
|
|
if ticker < FTicker then ticker := ticker + $100000000;
|
|
F := 1000 div (ticker - FTicker)
|
|
end else begin
|
|
QueryPerformanceCounter(ticker);
|
|
F := FPeriod div (ticker - FTicker)
|
|
end;
|
|
if F <> FFrames then begin
|
|
FFrames := F;
|
|
if Assigned(FOnFrames) then FOnFrames(Self)
|
|
end;
|
|
FTicker := -1;
|
|
|
|
Invalidate;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TA3nalogGauge.RedrawScale;
|
|
begin
|
|
{$IFDEF TICKER}
|
|
if FPeriod = 0 then
|
|
FTicker := GetTickCount64
|
|
else
|
|
QueryPerformanceCounter(FTicker);
|
|
{$ENDIF}
|
|
DrawScale(FBackBitmap, GetAAMultiplier);
|
|
RedrawArrow;
|
|
{$IFDEF LCL}
|
|
FBitmapsValid := true;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF LCL}
|
|
procedure TA3nalogGauge.FastAntiAliasPicture;
|
|
var
|
|
intfImgAA: TLazIntfImage;
|
|
intfImgFace: TLazIntfImage;
|
|
totR, totG, totB: Integer;
|
|
x, dx, cx: Integer;
|
|
y, dy, cy: Integer;
|
|
k, k2: Integer;
|
|
imgHandle, imgMaskHandle: HBitmap;
|
|
clr: TFPColor;
|
|
begin
|
|
intfImgAA := TLazIntfImage.Create(FAABitmap.Width, FAABitmap.Height);
|
|
intfImgFace := TLazIntfImage.Create(FFaceBitmap.Width, FFaceBitmap.Height);
|
|
try
|
|
intfImgAA.LoadFromBitmap(FAABitmap.Handle, FAABitmap.MaskHandle);
|
|
intfImgFace.LoadFromBitmap(FFaceBitmap.Handle, FFaceBitmap.MaskHandle);
|
|
k := GetAAMultiplier;
|
|
k2 := k * k;
|
|
y := 0;
|
|
while y < intfImgAA.Height do begin
|
|
cy := y * k;
|
|
x := 0;
|
|
while x < intfImgAA.Width do begin
|
|
cx := x * k;
|
|
totR := 0;
|
|
totG := 0;
|
|
totB := 0;
|
|
for dy := 0 to k-1 do begin
|
|
for dx := 0 to k-1 do begin
|
|
clr := intfImgFace.Colors[cx+dx, cy+dy];
|
|
totR := totR + clr.Red;
|
|
totG := totG + clr.Green;
|
|
totB := totB + clr.Blue;
|
|
end;
|
|
end;
|
|
clr := FPColor(totR div k2, totG div k2, totB div k2);
|
|
intfImgAA.Colors[x, y] := clr;
|
|
inc(x);
|
|
end;
|
|
inc(y);
|
|
end;
|
|
intfimgAA.CreateBitmaps(imgHandle, imgMaskHandle, false);
|
|
FAABitmap.Handle := imgHandle;
|
|
FAABitmap.MaskHandle := imgMaskHandle;
|
|
finally
|
|
intfImgAA.Free;
|
|
intfImgFace.Free;
|
|
end;
|
|
end;
|
|
|
|
// This code is faster than the version above, but crashes after a few seconds.
|
|
{
|
|
procedure TA3nalogGauge.FastAntiAliasPicture;
|
|
const
|
|
MaxPixelCount = MaxInt div SizeOf(TRGBTriple);
|
|
type
|
|
PRGBArray = ^TRGBArray;
|
|
TRGBArray = array[0..MaxPixelCount-1] of TRGBTriple;
|
|
var
|
|
intfImgAA: TLazIntfImage;
|
|
intfImgFace: TLazIntfImage;
|
|
totR, totG, totB: Integer;
|
|
x, cx: Integer;
|
|
y, cy: Integer;
|
|
i, ci: Integer;
|
|
k, k2: Integer;
|
|
imgHandle, imgMaskHandle: HBitmap;
|
|
Row1, Row2, Row3, Row4, DestRow: PRGBArray;
|
|
begin
|
|
intfImgAA := TLazIntfImage.Create(FAABitmap.Width, FAABitmap.Height);
|
|
intfImgFace := TLazIntfImage.Create(FFaceBitmap.Width, FFaceBitmap.Height);
|
|
try
|
|
intfImgAA.LoadFromBitmap(FAABitmap.Handle, FAABitmap.MaskHandle);
|
|
FAABitmap.Clear; //ReleaseHandle;
|
|
intfImgFace.LoadFromBitmap(FFaceBitmap.Handle, FFaceBitmap.MaskHandle);
|
|
k := GetAAMultiplier;
|
|
k2 := k * k;
|
|
for y := 0 to intfImgAA.Height - 1 do begin
|
|
// We compute samples of k x k pixels
|
|
cy := y * k;
|
|
// Get pointer to rows in supersampled image
|
|
Row1 := intfImgFace.GetDataLineStart(cy);
|
|
if k > 1 then Row2 := intfImgFace.GetDataLineStart(cy + 1);
|
|
if k > 2 then Row3 := intfImgFace.GetDataLineStart(cy + 2);
|
|
if k > 3 then Row4 := intfImgFace.GetDataLineStart(cy + 3);
|
|
// Get a pointer to destination row in output image
|
|
DestRow := intfImgAA.GetDataLineStart(y);
|
|
// For each column...
|
|
for x := 0 to intfImgAA.Width - 1 do begin
|
|
// We compute samples of k x k pixels
|
|
cx := x * k;
|
|
// Initialize result colur
|
|
totR := 0;
|
|
totG := 0;
|
|
totB := 0;
|
|
if k > 3 then begin
|
|
for i := 0 to 3 do begin
|
|
ci := cx + i;
|
|
inc(totR, Row1[ci].rgbtRed + Row2[ci].rgbtRed + Row3[ci].rgbtRed + Row4[ci].rgbtRed);
|
|
inc(totG, Row1[ci].rgbtGreen + Row2[ci].rgbtGreen + Row3[ci].rgbtGreen + Row4[ci].rgbtGreen);
|
|
inc(totB, Row1[ci].rgbtBlue + Row2[ci].rgbtBlue + Row3[ci].rgbtBlue + Row4[ci].rgbtBlue);
|
|
end;
|
|
end else
|
|
if k > 2 then begin
|
|
for i := 0 to 2 do begin
|
|
ci := cx + i;
|
|
inc(totR, Row1[ci].rgbtRed + Row2[ci].rgbtRed + Row3[ci].rgbtRed);
|
|
inc(totG, Row1[ci].rgbtGreen + Row2[ci].rgbtGreen + Row3[ci].rgbtGreen);
|
|
inc(totB, Row1[ci].rgbtBlue + Row2[ci].rgbtBlue + Row3[ci].rgbtBlue);
|
|
end;
|
|
end else
|
|
if k > 1 then begin
|
|
for i := 0 to 1 do begin
|
|
ci := cx + i;
|
|
inc(totR, Row1[ci].rgbtRed + Row2[ci].rgbtRed);
|
|
inc(totG, Row1[ci].rgbtGreen + Row2[ci].rgbtGreen);
|
|
inc(totB, Row1[ci].rgbtBlue + Row2[ci].rgbtBlue);
|
|
end;
|
|
end;
|
|
DestRow[x].rgbtRed := totR div k2;
|
|
DestRow[x].rgbtGreen := totG div k2;
|
|
DestRow[x].rgbtBlue := totB div k2;
|
|
end;
|
|
end;
|
|
intfimgAA.CreateBitmaps(imgHandle, imgMaskHandle, false);
|
|
FAABitmap.Handle := imgHandle;
|
|
FAABitmap.MaskHandle := imgMaskHandle;
|
|
except
|
|
intfImgAA.Free;
|
|
intfImgFace.Free;
|
|
end;
|
|
end;
|
|
}
|
|
{$ELSE}
|
|
const
|
|
MaxPixelCount = MaxInt div SizeOf(TRGBTriple);
|
|
|
|
type
|
|
PRGBArray = ^TRGBArray;
|
|
TRGBArray = array[0..MaxPixelCount-1] of TRGBTriple;
|
|
|
|
procedure TA3nalogGauge.FastAntiAliasPicture;
|
|
var
|
|
x, y, cx, cy, cxi: Integer;
|
|
totr, totg, totb: Integer;
|
|
Row1, Row2, Row3, Row4, DestRow: PRGBArray;
|
|
i, k: Integer;
|
|
begin
|
|
// For each row
|
|
K := GetAAMultiplier;
|
|
Row2 := nil;
|
|
Row3 := nil;
|
|
Row4 := nil;
|
|
for Y := 0 to FAABitmap.Height - 1 do begin
|
|
// We compute samples of K x K pixels
|
|
cy := y*K;
|
|
// Get pointers to actual, previous and next rows in supersampled bitmap
|
|
Row1 := FFaceBitmap.ScanLine[cy];
|
|
if K > 1 then Row2 := FFaceBitmap.ScanLine[cy+1];
|
|
if K > 2 then Row3 := FFaceBitmap.ScanLine[cy+2];
|
|
if K > 3 then Row4 := FFaceBitmap.ScanLine[cy+3];
|
|
// Get a pointer to destination row in output bitmap
|
|
DestRow := FAABitmap.ScanLine[y];
|
|
// For each column...
|
|
for x := 0 to FAABitmap.Width - 1 do begin
|
|
// We compute samples of 3 x 3 pixels
|
|
cx := x*K;
|
|
// Initialize result color
|
|
totr := 0; totg := 0; totb := 0;
|
|
if K > 3 then begin
|
|
for i := 0 to 3 do begin
|
|
cxi := cx + i;
|
|
totr := totr + Row1[cxi].rgbtRed + Row2[cxi].rgbtRed + Row3[cxi].rgbtRed + Row4[cxi].rgbtRed;
|
|
totg := totg + Row1[cxi].rgbtGreen + Row2[cxi].rgbtGreen + Row3[cxi].rgbtGreen + Row4[cxi].rgbtGreen;
|
|
totb := totb + Row1[cxi].rgbtBlue + Row2[cxi].rgbtBlue + Row3[cxi].rgbtBlue + Row4[cxi].rgbtBlue;
|
|
end;
|
|
DestRow[x].rgbtRed := totr div 16;
|
|
DestRow[x].rgbtGreen := totg div 16;
|
|
DestRow[x].rgbtBlue := totb div 16;
|
|
end else if K > 2 then begin
|
|
for i := 0 to 2 do begin
|
|
cxi := cx + i;
|
|
totr := totr + Row1[cxi].rgbtRed + Row2[cxi].rgbtRed + Row3[cxi].rgbtRed;
|
|
totg := totg + Row1[cxi].rgbtGreen + Row2[cxi].rgbtGreen + Row3[cxi].rgbtGreen;
|
|
totb := totb + Row1[cxi].rgbtBlue + Row2[cxi].rgbtBlue + Row3[cxi].rgbtBlue;
|
|
end;
|
|
DestRow[x].rgbtRed := totr div 9;
|
|
DestRow[x].rgbtGreen := totg div 9;
|
|
DestRow[x].rgbtBlue := totb div 9;
|
|
end else if K > 1 then begin
|
|
for i := 0 to 1 do begin
|
|
cxi := cx + i;
|
|
totr := totr + Row1[cxi].rgbtRed + Row2[cxi].rgbtRed;
|
|
totg := totg + Row1[cxi].rgbtGreen + Row2[cxi].rgbtGreen;
|
|
totb := totb + Row1[cxi].rgbtBlue + Row2[cxi].rgbtBlue;
|
|
end;
|
|
DestRow[x].rgbtRed := totr div 4;
|
|
DestRow[x].rgbtGreen := totg div 4;
|
|
DestRow[x].rgbtBlue := totb div 4;
|
|
end else begin
|
|
DestRow[x].rgbtRed := Row1[cx].rgbtRed;
|
|
DestRow[x].rgbtGreen := Row1[cx].rgbtGreen;
|
|
DestRow[x].rgbtBlue := Row1[cx].rgbtBlue;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TA3nalogGauge.Loaded;
|
|
begin
|
|
inherited;
|
|
RedrawScale;
|
|
//Invalidate;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.Paint;
|
|
begin
|
|
{$IFDEF LCL}
|
|
if not FBitmapsValid then
|
|
RedrawScale;
|
|
{$ENDIF}
|
|
|
|
if FAntiAliased = aaNone then
|
|
Canvas.Draw(0, 0, FFaceBitmap)
|
|
else
|
|
Canvas.Draw(0, 0, FAABitmap);
|
|
end;
|
|
|
|
{$IFNDEF LCL} (*
|
|
procedure TA3nalogGauge.WMSize(var Message: TWMSize);
|
|
var
|
|
K: Integer;
|
|
begin
|
|
if Width < 60 then Width := 60;
|
|
if Height < 50 then Height := 50;
|
|
if FAntiAliased = aaNone then begin
|
|
FBackBitmap.Width := Width;
|
|
FBackBitmap.Height := Height;
|
|
FFaceBitmap.Width := Width;
|
|
FFaceBitmap.Height := Height;
|
|
end else begin
|
|
K := GetAAMultiplier;
|
|
FBackBitmap.Width := Width * K;
|
|
FBackBitmap.Height := Height * K;
|
|
FFaceBitmap.Width := Width * K;
|
|
FFaceBitmap.Height := Height * K;
|
|
FAABitmap.Width := Width;
|
|
FAABitmap.Height := Height;
|
|
end;
|
|
RedrawScale;
|
|
inherited;
|
|
end;
|
|
*)
|
|
|
|
procedure TA3nalogGauge.CMFontChanged(var Msg: TMessage);
|
|
begin
|
|
RedrawScale;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.WMEraseBkGnd(var Msg: TMessage);
|
|
begin
|
|
Msg.Result := 1;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF LCL}
|
|
procedure TA3nalogGauge.FontChanged(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
RedrawScale;
|
|
end;
|
|
|
|
class function TA3nalogGauge.GetControlClassDefaultSize: TSize;
|
|
begin
|
|
Result.CX := 225;
|
|
Result.CY := 180;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TA3nalogGauge.Resize;
|
|
var
|
|
K: Integer;
|
|
begin
|
|
if Width < 60 then
|
|
Width := 60;
|
|
if Height < 50 then
|
|
Height := 50;
|
|
|
|
if FAntiAliased = aaNone then begin
|
|
FBackBitmap.Width := Width;
|
|
FBackBitmap.Height := Height;
|
|
FFaceBitmap.Width := Width;
|
|
FFaceBitmap.Height := Height;
|
|
end else begin
|
|
K := GetAAMultiplier;
|
|
FBackBitmap.Width := Width * K;
|
|
FBackBitmap.Height := Height * K;
|
|
FFaceBitmap.Width := Width * K;
|
|
FFaceBitmap.Height := Height * K;
|
|
FAABitmap.Width := Width;
|
|
FAABitmap.Height := Height;
|
|
end;
|
|
{$IFDEF LCL}
|
|
FBitmapsValid := false;
|
|
{$ELSE}
|
|
RedrawScale;
|
|
{$ENDIF}
|
|
inherited;
|
|
end;
|
|
//{$ENDIF}
|
|
|
|
procedure TA3nalogGauge.SetCaptionFont(AValue: TFont);
|
|
begin
|
|
FCaptionFont.Assign(AValue);
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFrameColor(C: TColor);
|
|
begin
|
|
if C <> FFrameColor then begin
|
|
FFrameColor := C;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFMinColor(C: TColor);
|
|
begin
|
|
if C <> FMinColor then begin
|
|
FMinColor := C;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFMidColor(C: TColor);
|
|
begin
|
|
if C <> FMidColor then begin
|
|
FMidColor := C;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFMaxColor(C: TColor);
|
|
begin
|
|
if C <> FMaxColor then begin
|
|
FMaxColor := C;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFFaceColor(C: TColor);
|
|
begin
|
|
if C <> FFaceColor then begin
|
|
FFaceColor := C;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFTicksColor(C: TColor);
|
|
begin
|
|
if C <> FTicksColor then begin
|
|
FTicksColor := C;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFValueColor(C: TColor);
|
|
begin
|
|
if C <> FValueColor then begin
|
|
FValueColor := C;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFCaptionColor(C: TColor);
|
|
begin
|
|
if C <> FCaptionColor then begin
|
|
FCaptionColor := C;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFArrowColor(C: TColor);
|
|
begin
|
|
if C <> FArrowColor then begin
|
|
FArrowColor := C;
|
|
RedrawArrow;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFMarginColor(C: TColor);
|
|
begin
|
|
if C <> FMarginColor then begin
|
|
FMarginColor := C;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFCenterColor(C: TColor);
|
|
begin
|
|
if C <> FCenterColor then begin
|
|
FCenterColor := C;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFCircleColor(C: TColor);
|
|
begin
|
|
if C <> FCircleColor then begin
|
|
FCircleColor := C;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFCenterRadius(I: Integer);
|
|
begin
|
|
if I <> FCenterRadius then begin
|
|
FCenterRadius := I;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFCircleRadius(I: Integer);
|
|
begin
|
|
if I <> FCircleRadius then begin
|
|
FCircleRadius := I;
|
|
RedrawScale;
|
|
end
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFScaleAngle(I: Integer);
|
|
begin
|
|
if I <> FScaleAngle then begin
|
|
if (I > 10) and (I <= 360) then
|
|
FScaleAngle := I;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFMargin(I: Integer);
|
|
begin
|
|
if I <> FMargin then begin
|
|
FMargin := I;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFStyle(S: TStyle);
|
|
begin
|
|
if S <> FStyle then begin
|
|
FStyle := S;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFArrowWidth(I: Integer);
|
|
begin
|
|
if I <> FArrowWidth then begin
|
|
if I < 1 then
|
|
FArrowWidth := 1
|
|
else
|
|
if I > 5 then
|
|
FArrowWidth := 5
|
|
else
|
|
FArrowWidth := i;
|
|
RedrawArrow;
|
|
end
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFNumMainTicks(I: Integer);
|
|
begin
|
|
if I <> FNumMainTicks then begin
|
|
FNumMainTicks := I;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFLengthMainTicks(I: Integer);
|
|
begin
|
|
if I <> FLengthMainTicks then begin
|
|
FLengthMainTicks := I;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFLengthSubTicks(I: Integer);
|
|
begin
|
|
if I <> FLengthSubTicks then begin
|
|
FLengthSubTicks := I;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFFaceOptions(O: TFaceOptions);
|
|
begin
|
|
if O <> FFaceOptions then begin
|
|
FFaceOptions := O;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFPosition(V: Single);
|
|
begin
|
|
if V <> FPosition then begin
|
|
FPosition := V;
|
|
if (FPosition > fMaximum) and Assigned(FOverMax) then OnOverMax(Self);
|
|
if (FPosition < fMinimum) and Assigned(FOverMin) then OnOverMin(Self);
|
|
RedrawArrow;
|
|
end
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFScaleValue(I: Integer);
|
|
begin
|
|
if I <> FScaleValue then begin
|
|
if I > 1 then begin
|
|
FScaleValue := I;
|
|
if FMaximum >= FScaleValue then FMaximum := FScaleValue - 1;
|
|
if FMinimum > FScaleValue - FMaximum then FMinimum := FScaleValue - fMaximum;
|
|
end;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFMaximum(I: Integer);
|
|
begin
|
|
if I <> FMaximum then begin
|
|
if (I > 0) and (I < FScaleValue) then
|
|
FMaximum := I;
|
|
RedrawScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFMinimum(I: Integer);
|
|
begin
|
|
if I <> FMinimum then begin
|
|
if (I > 0) and (I < FScaleValue) then
|
|
FMinimum := I;
|
|
RedrawScale;
|
|
end
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFCaption(const S: string);
|
|
begin
|
|
if S <> FCaption then begin
|
|
Canvas.Font := Font;
|
|
FCaption := S;
|
|
RedrawScale;
|
|
end
|
|
end;
|
|
|
|
procedure TA3nalogGauge.SetFAntiAliased(V: TAntialiased);
|
|
var
|
|
K: Integer;
|
|
begin
|
|
if V <> FAntiAliased then begin
|
|
FAntiAliased := V;
|
|
if FAntiAliased = aaNone then begin
|
|
FreeAndNil(FAABitmap);
|
|
FreeAndNil(FBackBitmap);
|
|
FreeAndNil(FFaceBitmap);
|
|
FBackBitmap := TBitmap.Create;
|
|
FFaceBitmap := TBitmap.Create;
|
|
FBackBitmap.Width := Width;
|
|
FFaceBitmap.Width := Width;
|
|
FBackBitmap.Height := Height;
|
|
FFaceBitmap.Height := Height;
|
|
end else begin
|
|
K := GetAAMultiplier;
|
|
FBackBitmap.PixelFormat := pf24bit;
|
|
FFaceBitmap.PixelFormat := pf24bit;
|
|
FBackBitmap.Width := Width * K;
|
|
FFaceBitmap.Width := Width * K;
|
|
FBackBitmap.Height := Height * K;
|
|
FFaceBitmap.Height := Height * K;
|
|
if not Assigned(FAABitmap) then
|
|
FAABitmap := TBitmap.Create;
|
|
FAABitmap.PixelFormat := pf24bit;
|
|
FAABitmap.Width := Width;
|
|
FAABitmap.Height := Height;
|
|
end;
|
|
RedrawScale;
|
|
end
|
|
end;
|
|
|
|
function TA3nalogGauge.GetAAMultiplier: Integer;
|
|
begin
|
|
Result := ord(FAntiAliased) + 1;
|
|
{
|
|
case FAntiAliased of
|
|
aaBiline : Result := 2;
|
|
aaTriline : Result := 3;
|
|
aaQuadral : Result := 4;
|
|
else Result := 1
|
|
end
|
|
}
|
|
end;
|
|
|
|
|
|
{ Register }
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('Industrial', [TA3nalogGauge]);
|
|
end;
|
|
|
|
end.
|
|
|
|
|