自己写了个Delphi仪表盘

1. unit Instruments;
2. 
   
3. 
   
4. interface
5. 
   
6. 
   
7. uses
8.   Classes, Controls, Graphics, Types,
9.   SysUtils, Dialogs;
10. 
    
11. 
    
12. type
13. 
    
14. 
    
15.   TInstrumentContext = packed record
16.     MixValue: Real;
17.     MaxValue: Real;
18.     defaultValue: Real;
19.     Inctrment: Real;
20.     AOwner: TComponent;
21.     AParent: TWinControl;
22.     AHeight: Integer;
23.     AWidth: Integer;
24.   end;
25. 
    
26. 
    
27. 
    
28. 
    
29.   TInstrument = class(TCustomControl)
30.   private
31. //    FEData: TInstrumentContext;
32.     FCurValue: Real;
33.     FMixValue: Real;
34.     FMaxValue: Real;
35.     FIncrement: Real;
36.     FUnit: string;
37.     FCenter: TPoint;
38.     FRadius: Integer;
39.     procedure DrawCircle(Center: TPoint; Radius: Integer);
40.   protected
41.     procedure Paint; override;
42.     procedure DrawWatch;
43.     procedure DrawRuling;
44.     procedure DrawPointer;
45.   public
46.     constructor Create(EquipContext: TInstrumentContext; AUnit: string);
47.     function SpeedUp: Real;
48.     function SpeedDown: Real;
49.     procedure KeyPress(var Key: Char); override;
50.   published
51. //    property EData: TInstrumentContext read FEData write FEData;
52.     property CurSpeed: Real read FCurValue write FCurValue;
53.     property MixSpeed: Real read FMixValue;
54.     property MaxSpeed: Real read FMaxValue;
55.     property Increment: Real read FIncrement write FIncrement;
56.     property EUnit: string read FUnit;
57.     function PosCenter: TPoint;
58.   end;
59. 
    
60. 
    
61. const
62.   RulingWidth = 20;
63. 
    
64. 
    
65. implementation
66. 
    
67. 
    
68. { TInstrument }
69. 
    
70. 
    
71. function TInstrument.PosCenter: TPoint;
72. begin
73.   Result.X := ClientWidth div 2;
74.   Result.Y := ClientHeight div 2;
75.   FCenter := Result;
76.   FRadius := ClientWidth div 2;
77. end;
78. 
    
79. 
    
80. constructor TInstrument.Create(EquipContext: TInstrumentContext;
81.   AUnit: string);
82.   function Min(A, B: Integer): Integer;
83.   begin
84.     if A>B then
85.       Result := B
86.     else
87.       Result := A;
88.   end;
89. begin
90.   inherited Create(EquipContext.AOwner);
91.   with EquipContext do
92.   begin
93.     FCurValue := defaultValue;
94.     FMaxValue := MaxValue;
95.     FMixValue := MixValue;
96.     FIncrement := Inctrment;
97.     FUnit := AUnit;
98.     Parent := AParent;
99.     Height := Min(AHeight, AWidth);
100.     Width := Height;
101.   end;
102.   PosCenter;
103.   DoubleBuffered := True;
104. end;
105. 
     
106. 
     
107. procedure TInstrument.DrawPointer;
108. var
109.   iPointer: array[0..2] of TPoint;
110.   a: Real;
111. begin
112.   a := 0.75*PI-1.5*PI*FCurValue/FMaxValue;
113.   iPointer[0].X := Round((FRadius-RulingWidth)*(1-Sin(a)))+(FCenter.X-FRadius+RulingWidth);
114.   iPointer[0].Y := Round((FRadius-RulingWidth)*(1-Cos(a)))+(FCenter.Y-FRadius+RulingWidth);
115.   iPointer[1].X := Round((FRadius/20)*(1+Sin(a-0.5*PI)) + (FCenter.X-FRadius/20));
116.   iPointer[2].X := Round((FRadius/20)*(1-Sin(a-0.5*PI)) + (FCenter.X-FRadius/20));
117.   iPointer[1].Y := Round((FRadius/20)*(1+Cos(a-0.5*PI)) + (FCenter.X-FRadius/20));
118.   iPointer[2].Y := Round((FRadius/20)*(1-Cos(a-0.5*PI)) + (FCenter.X-FRadius/20));
119.   Canvas.Brush.Color := clBlack;
120.   Canvas.Pen.Style := psClear;
121.   DrawCircle(FCenter, Trunc(FRadius/10));
122.   Canvas.Polygon(iPointer);
123. end;
124. 
     
125. 
     
126. procedure TInstrument.DrawRuling;
127. var
128.   CurV, a: Real;
129.   X, Y: Integer;
130. begin
131.   Canvas.Pen.Style := psSolid;
132.   CurV := 0;
133.   repeat
134.     a := 0.75*PI-1.5*PI*CurV/FMaxValue;
135.     X := Trunc((FRadius-1)*(1-Sin(a)))+(FCenter.X-FRadius+1);
136.     Y := Trunc((FRadius-1)*(1-Cos(a)))+(FCenter.Y-FRadius+1);
137.     Canvas.MoveTo(FCenter.X, FCenter.Y);
138.     Canvas.LineTo(X, Y);
139.     CurV := CurV + Trunc(FMaxValue/10);
140.   until CurV > FMaxValue;
141.   CurV := 0;
142.   repeat
143.     a := 0.75*PI-1.5*PI*CurV/FMaxValue;
144.     X := Trunc((FRadius-10)*(1-Sin(a)))+(FCenter.X-FRadius+10);
145.     Y := Trunc((FRadius-10)*(1-Cos(a)))+(FCenter.Y-FRadius+10);
146.     Canvas.MoveTo(FCenter.X, FCenter.Y);
147.     Canvas.LineTo(X, Y);
148.     CurV := CurV + Trunc(FMaxValue/50);
149.   until CurV > FMaxValue;
150.   Canvas.Pen.Style := psClear;
151.   Canvas.Brush.Color := clWhite;
152.   DrawCircle(FCenter, FRadius-RulingWidth);
153. end;
154. 
     
155. 
     
156. procedure TInstrument.DrawWatch;
157. begin
158.   Canvas.Brush.Color := clLime;
159.   Canvas.Pen.Style := psClear;
160.   Canvas.Pie(FCenter.X-FRadius, FCenter.Y-FRadius,
161.              FCenter.X+FRadius, FCenter.Y+FRadius,
162.              FCenter.X+1, FCenter.Y-1,
163.              FCenter.X-1, FCenter.Y+1);
164.   Canvas.Brush.Color := clYellow;
165.   Canvas.Pie(FCenter.X-FRadius, FCenter.Y-FRadius,
166.              FCenter.X+FRadius, FCenter.Y+FRadius,
167.              FCenter.X+1, FCenter.Y,
168.              FCenter.X+1, FCenter.Y-1);
169.   Canvas.Brush.Color := clRed;
170.   Canvas.Pie(FCenter.X-FRadius, FCenter.Y-FRadius,
171.              FCenter.X+FRadius, FCenter.Y+FRadius,
172.              FCenter.X+1, FCenter.Y+1,
173.              FCenter.X+1, FCenter.Y);
174. end;
175. 
     
176. 
     
177. procedure TInstrument.Paint;
178. begin
179.   DrawWatch;
180.   DrawRuling;
181.   DrawPointer;
182. end;
183. 
     
184. 
     
185. function TInstrument.SpeedUp: Real;
186. begin
187.   FCurValue := FCurValue + FIncrement;
188.   if FCurValue > FMaxValue then
189.     FCurValue := FMaxValue;
190.   Result := FCurValue;
191.   Invalidate;
192. end;
193. 
     
194. 
     
195. function TInstrument.SpeedDown: Real;
196. begin
197.   FCurValue := FCurValue - FIncrement;
198.   if FCurValue < FMixValue then
199.     FCurValue := FMixValue;
200.   Result := FCurValue;
201.   Invalidate;
202. end;
203. 
     
204. 
     
205. procedure TInstrument.DrawCircle(Center: TPoint; Radius: Integer);
206. begin
207.   Canvas.Ellipse(Center.X-Radius, Center.Y-Radius,
208.                  Center.X+Radius, Center.Y+Radius);
209. end;
210. 
     
211. 
     
212. procedure TInstrument.KeyPress(var Key: Char);
213. begin
214.   inherited;
215.   if (Key = 'W') or (Key = 'w') then
216.     SpeedUp
217.   else if (Key = 'S') or (Key = 's') then
218.     SpeedDown; 
219. end;
220. 
     
221. 
     
222. end.