自己写了个Delphi仪表盘

最新推荐文章于 2024-06-05 19:39:38 发布

chenjiuzhi7943

最新推荐文章于 2024-06-05 19:39:38 发布

阅读量515

点赞数

原文链接：https://my.oschina.net/YuntianZ/blog/130114

版权

unit Instruments;
interface
uses
Classes, Controls, Graphics, Types,
SysUtils, Dialogs;
type
TInstrumentContext = packed record
MixValue: Real;
MaxValue: Real;
defaultValue: Real;
Inctrment: Real;
AOwner: TComponent;
AParent: TWinControl;
AHeight: Integer;
AWidth: Integer;
end;
TInstrument = class(TCustomControl)
private
// FEData: TInstrumentContext;
FCurValue: Real;
FMixValue: Real;
FMaxValue: Real;
FIncrement: Real;
FUnit: string;
FCenter: TPoint;
FRadius: Integer;
procedure DrawCircle(Center: TPoint; Radius: Integer);
protected
procedure Paint; override;
procedure DrawWatch;
procedure DrawRuling;
procedure DrawPointer;
public
constructor Create(EquipContext: TInstrumentContext; AUnit: string);
function SpeedUp: Real;
function SpeedDown: Real;
procedure KeyPress(var Key: Char); override;
published
// property EData: TInstrumentContext read FEData write FEData;
property CurSpeed: Real read FCurValue write FCurValue;
property MixSpeed: Real read FMixValue;
property MaxSpeed: Real read FMaxValue;
property Increment: Real read FIncrement write FIncrement;
property EUnit: string read FUnit;
function PosCenter: TPoint;
end;
const
RulingWidth = 20;
implementation
{ TInstrument }
function TInstrument.PosCenter: TPoint;
begin
Result.X := ClientWidth div 2;
Result.Y := ClientHeight div 2;
FCenter := Result;
FRadius := ClientWidth div 2;
end;
constructor TInstrument.Create(EquipContext: TInstrumentContext;
AUnit: string);
function Min(A, B: Integer): Integer;
begin
if A>B then
Result := B
else
Result := A;
end;
begin
inherited Create(EquipContext.AOwner);
with EquipContext do
begin
FCurValue := defaultValue;
FMaxValue := MaxValue;
FMixValue := MixValue;
FIncrement := Inctrment;
FUnit := AUnit;
Parent := AParent;
Height := Min(AHeight, AWidth);
Width := Height;
end;
PosCenter;
DoubleBuffered := True;
end;
procedure TInstrument.DrawPointer;
var
iPointer: array[0..2] of TPoint;
a: Real;
begin
a := 0.75*PI-1.5*PI*FCurValue/FMaxValue;
iPointer[0].X := Round((FRadius-RulingWidth)*(1-Sin(a)))+(FCenter.X-FRadius+RulingWidth);
iPointer[0].Y := Round((FRadius-RulingWidth)*(1-Cos(a)))+(FCenter.Y-FRadius+RulingWidth);
iPointer[1].X := Round((FRadius/20)*(1+Sin(a-0.5*PI)) + (FCenter.X-FRadius/20));
iPointer[2].X := Round((FRadius/20)*(1-Sin(a-0.5*PI)) + (FCenter.X-FRadius/20));
iPointer[1].Y := Round((FRadius/20)*(1+Cos(a-0.5*PI)) + (FCenter.X-FRadius/20));
iPointer[2].Y := Round((FRadius/20)*(1-Cos(a-0.5*PI)) + (FCenter.X-FRadius/20));
Canvas.Brush.Color := clBlack;
Canvas.Pen.Style := psClear;
DrawCircle(FCenter, Trunc(FRadius/10));
Canvas.Polygon(iPointer);
end;
procedure TInstrument.DrawRuling;
var
CurV, a: Real;
X, Y: Integer;
begin
Canvas.Pen.Style := psSolid;
CurV := 0;
repeat
a := 0.75*PI-1.5*PI*CurV/FMaxValue;
X := Trunc((FRadius-1)*(1-Sin(a)))+(FCenter.X-FRadius+1);
Y := Trunc((FRadius-1)*(1-Cos(a)))+(FCenter.Y-FRadius+1);
Canvas.MoveTo(FCenter.X, FCenter.Y);
Canvas.LineTo(X, Y);
CurV := CurV + Trunc(FMaxValue/10);
until CurV > FMaxValue;
CurV := 0;
repeat
a := 0.75*PI-1.5*PI*CurV/FMaxValue;
X := Trunc((FRadius-10)*(1-Sin(a)))+(FCenter.X-FRadius+10);
Y := Trunc((FRadius-10)*(1-Cos(a)))+(FCenter.Y-FRadius+10);
Canvas.MoveTo(FCenter.X, FCenter.Y);
Canvas.LineTo(X, Y);
CurV := CurV + Trunc(FMaxValue/50);
until CurV > FMaxValue;
Canvas.Pen.Style := psClear;
Canvas.Brush.Color := clWhite;
DrawCircle(FCenter, FRadius-RulingWidth);
end;
procedure TInstrument.DrawWatch;
begin
Canvas.Brush.Color := clLime;
Canvas.Pen.Style := psClear;
Canvas.Pie(FCenter.X-FRadius, FCenter.Y-FRadius,
FCenter.X+FRadius, FCenter.Y+FRadius,
FCenter.X+1, FCenter.Y-1,
FCenter.X-1, FCenter.Y+1);
Canvas.Brush.Color := clYellow;
Canvas.Pie(FCenter.X-FRadius, FCenter.Y-FRadius,
FCenter.X+FRadius, FCenter.Y+FRadius,
FCenter.X+1, FCenter.Y,
FCenter.X+1, FCenter.Y-1);
Canvas.Brush.Color := clRed;
Canvas.Pie(FCenter.X-FRadius, FCenter.Y-FRadius,
FCenter.X+FRadius, FCenter.Y+FRadius,
FCenter.X+1, FCenter.Y+1,
FCenter.X+1, FCenter.Y);
end;
procedure TInstrument.Paint;
begin
DrawWatch;
DrawRuling;
DrawPointer;
end;
function TInstrument.SpeedUp: Real;
begin
FCurValue := FCurValue + FIncrement;
if FCurValue > FMaxValue then
FCurValue := FMaxValue;
Result := FCurValue;
Invalidate;
end;
function TInstrument.SpeedDown: Real;
begin
FCurValue := FCurValue - FIncrement;
if FCurValue < FMixValue then
FCurValue := FMixValue;
Result := FCurValue;
Invalidate;
end;
procedure TInstrument.DrawCircle(Center: TPoint; Radius: Integer);
begin
Canvas.Ellipse(Center.X-Radius, Center.Y-Radius,
Center.X+Radius, Center.Y+Radius);
end;
procedure TInstrument.KeyPress(var Key: Char);
begin
inherited;
if (Key = 'W') or (Key = 'w') then
SpeedUp
else if (Key = 'S') or (Key = 's') then
SpeedDown;
end;
end.