- 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.
转载于:https://my.oschina.net/YuntianZ/blog/130114