自己写了个Delphi仪表盘

原创
2013/05/13 13:09
阅读数 647
  1. unit Instruments;


  2. interface


  3. uses
  4.   Classes, Controls, Graphics, Types,
  5.   SysUtils, Dialogs;


  6. type


  7.   TInstrumentContext = packed record
  8.     MixValue: Real;
  9.     MaxValue: Real;
  10.     defaultValue: Real;
  11.     Inctrment: Real;
  12.     AOwner: TComponent;
  13.     AParent: TWinControl;
  14.     AHeight: Integer;
  15.     AWidth: Integer;
  16.   end;




  17.   TInstrument = class(TCustomControl)
  18.   private
  19. //    FEData: TInstrumentContext;
  20.     FCurValue: Real;
  21.     FMixValue: Real;
  22.     FMaxValue: Real;
  23.     FIncrement: Real;
  24.     FUnit: string;
  25.     FCenter: TPoint;
  26.     FRadius: Integer;
  27.     procedure DrawCircle(Center: TPoint; Radius: Integer);
  28.   protected
  29.     procedure Paint; override;
  30.     procedure DrawWatch;
  31.     procedure DrawRuling;
  32.     procedure DrawPointer;
  33.   public
  34.     constructor Create(EquipContext: TInstrumentContext; AUnit: string);
  35.     function SpeedUp: Real;
  36.     function SpeedDown: Real;
  37.     procedure KeyPress(var Key: Char); override;
  38.   published
  39. //    property EData: TInstrumentContext read FEData write FEData;
  40.     property CurSpeed: Real read FCurValue write FCurValue;
  41.     property MixSpeed: Real read FMixValue;
  42.     property MaxSpeed: Real read FMaxValue;
  43.     property Increment: Real read FIncrement write FIncrement;
  44.     property EUnit: string read FUnit;
  45.     function PosCenter: TPoint;
  46.   end;


  47. const
  48.   RulingWidth = 20;


  49. implementation


  50. { TInstrument }


  51. function TInstrument.PosCenter: TPoint;
  52. begin
  53.   Result.X := ClientWidth div 2;
  54.   Result.Y := ClientHeight div 2;
  55.   FCenter := Result;
  56.   FRadius := ClientWidth div 2;
  57. end;


  58. constructor TInstrument.Create(EquipContext: TInstrumentContext;
  59.   AUnit: string);
  60.   function Min(A, B: Integer): Integer;
  61.   begin
  62.     if A>B then
  63.       Result := B
  64.     else
  65.       Result := A;
  66.   end;
  67. begin
  68.   inherited Create(EquipContext.AOwner);
  69.   with EquipContext do
  70.   begin
  71.     FCurValue := defaultValue;
  72.     FMaxValue := MaxValue;
  73.     FMixValue := MixValue;
  74.     FIncrement := Inctrment;
  75.     FUnit := AUnit;
  76.     Parent := AParent;
  77.     Height := Min(AHeight, AWidth);
  78.     Width := Height;
  79.   end;
  80.   PosCenter;
  81.   DoubleBuffered := True;
  82. end;


  83. procedure TInstrument.DrawPointer;
  84. var
  85.   iPointer: array[0..2] of TPoint;
  86.   a: Real;
  87. begin
  88.   a := 0.75*PI-1.5*PI*FCurValue/FMaxValue;
  89.   iPointer[0].X := Round((FRadius-RulingWidth)*(1-Sin(a)))+(FCenter.X-FRadius+RulingWidth);
  90.   iPointer[0].Y := Round((FRadius-RulingWidth)*(1-Cos(a)))+(FCenter.Y-FRadius+RulingWidth);
  91.   iPointer[1].X := Round((FRadius/20)*(1+Sin(a-0.5*PI)) + (FCenter.X-FRadius/20));
  92.   iPointer[2].X := Round((FRadius/20)*(1-Sin(a-0.5*PI)) + (FCenter.X-FRadius/20));
  93.   iPointer[1].Y := Round((FRadius/20)*(1+Cos(a-0.5*PI)) + (FCenter.X-FRadius/20));
  94.   iPointer[2].Y := Round((FRadius/20)*(1-Cos(a-0.5*PI)) + (FCenter.X-FRadius/20));
  95.   Canvas.Brush.Color := clBlack;
  96.   Canvas.Pen.Style := psClear;
  97.   DrawCircle(FCenter, Trunc(FRadius/10));
  98.   Canvas.Polygon(iPointer);
  99. end;


  100. procedure TInstrument.DrawRuling;
  101. var
  102.   CurV, a: Real;
  103.   X, Y: Integer;
  104. begin
  105.   Canvas.Pen.Style := psSolid;
  106.   CurV := 0;
  107.   repeat
  108.     a := 0.75*PI-1.5*PI*CurV/FMaxValue;
  109.     X := Trunc((FRadius-1)*(1-Sin(a)))+(FCenter.X-FRadius+1);
  110.     Y := Trunc((FRadius-1)*(1-Cos(a)))+(FCenter.Y-FRadius+1);
  111.     Canvas.MoveTo(FCenter.X, FCenter.Y);
  112.     Canvas.LineTo(X, Y);
  113.     CurV := CurV + Trunc(FMaxValue/10);
  114.   until CurV > FMaxValue;
  115.   CurV := 0;
  116.   repeat
  117.     a := 0.75*PI-1.5*PI*CurV/FMaxValue;
  118.     X := Trunc((FRadius-10)*(1-Sin(a)))+(FCenter.X-FRadius+10);
  119.     Y := Trunc((FRadius-10)*(1-Cos(a)))+(FCenter.Y-FRadius+10);
  120.     Canvas.MoveTo(FCenter.X, FCenter.Y);
  121.     Canvas.LineTo(X, Y);
  122.     CurV := CurV + Trunc(FMaxValue/50);
  123.   until CurV > FMaxValue;
  124.   Canvas.Pen.Style := psClear;
  125.   Canvas.Brush.Color := clWhite;
  126.   DrawCircle(FCenter, FRadius-RulingWidth);
  127. end;


  128. procedure TInstrument.DrawWatch;
  129. begin
  130.   Canvas.Brush.Color := clLime;
  131.   Canvas.Pen.Style := psClear;
  132.   Canvas.Pie(FCenter.X-FRadius, FCenter.Y-FRadius,
  133.              FCenter.X+FRadius, FCenter.Y+FRadius,
  134.              FCenter.X+1, FCenter.Y-1,
  135.              FCenter.X-1, FCenter.Y+1);
  136.   Canvas.Brush.Color := clYellow;
  137.   Canvas.Pie(FCenter.X-FRadius, FCenter.Y-FRadius,
  138.              FCenter.X+FRadius, FCenter.Y+FRadius,
  139.              FCenter.X+1, FCenter.Y,
  140.              FCenter.X+1, FCenter.Y-1);
  141.   Canvas.Brush.Color := clRed;
  142.   Canvas.Pie(FCenter.X-FRadius, FCenter.Y-FRadius,
  143.              FCenter.X+FRadius, FCenter.Y+FRadius,
  144.              FCenter.X+1, FCenter.Y+1,
  145.              FCenter.X+1, FCenter.Y);
  146. end;


  147. procedure TInstrument.Paint;
  148. begin
  149.   DrawWatch;
  150.   DrawRuling;
  151.   DrawPointer;
  152. end;


  153. function TInstrument.SpeedUp: Real;
  154. begin
  155.   FCurValue := FCurValue + FIncrement;
  156.   if FCurValue > FMaxValue then
  157.     FCurValue := FMaxValue;
  158.   Result := FCurValue;
  159.   Invalidate;
  160. end;


  161. function TInstrument.SpeedDown: Real;
  162. begin
  163.   FCurValue := FCurValue - FIncrement;
  164.   if FCurValue < FMixValue then
  165.     FCurValue := FMixValue;
  166.   Result := FCurValue;
  167.   Invalidate;
  168. end;


  169. procedure TInstrument.DrawCircle(Center: TPoint; Radius: Integer);
  170. begin
  171.   Canvas.Ellipse(Center.X-Radius, Center.Y-Radius,
  172.                  Center.X+Radius, Center.Y+Radius);
  173. end;


  174. procedure TInstrument.KeyPress(var Key: Char);
  175. begin
  176.   inherited;
  177.   if (Key = 'W') or (Key = 'w') then
  178.     SpeedUp
  179.   else if (Key = 'S') or (Key = 's') then
  180.     SpeedDown; 
  181. end;


  182. end.
展开阅读全文
打赏
0
0 收藏
分享
加载中
更多评论
打赏
0 评论
0 收藏
0
分享
返回顶部
顶部