自己写了个Delphi仪表盘

原创
Yuntian_Z.
工作日志
2013/05/13 13:09
阅读数 647
  1. unit Instruments;


  4. interface


  7. uses
  8.   Classes, Controls, Graphics, Types,
  9.   SysUtils, Dialogs;


  12. type


  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;




  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;


  61. const
  62.   RulingWidth = 20;


  65. implementation


  68. { TInstrument }


  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;


  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;


  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;


  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;


  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;


  177. procedure TInstrument.Paint;
  178. begin
  179.   DrawWatch;
  180.   DrawRuling;
  181.   DrawPointer;
  182. end;


  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;


  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;


  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;


  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;


  222. end.
展开阅读全文
Delphi仪表速度表

© 著作权归作者所有

举报
打赏
0 赞
0 收藏
分享
加载中
取消
发布
更多评论

其他人还在看

更多精彩内容

没搞清楚网络I/O模型？那怎么入门Netty

本文是Netty系列笔记第2篇 Netty是网络应用框架，所以从最本质的角度来看，是对网络I/O模型的封装使用。 因此，要深刻理解Netty的高性能，也必须从网络I/O模型说起。 看完本文，可以回答这三个问题： 五种I/O模型...
0
3

怎么提升写代码的能力

作者 | 毕玄 来源|阿里巴巴云原生公众号 对于程序员而言，我始终认为代码是展现能力的关键，一个优秀程序员写的代码，和一个普通程序员写的代码是很容易看出差别的，代码作为程序员的硬实力和名片的展示，怎么提升...
0
3

WebRTC 的现状和未来：专访 W3C WebRTC Chair Bernard Aboba

WebRTC 无疑推动和改变了互联网视频，而这仅仅是刚刚开始，除了大家熟悉的 WebRTC-PC、Simulcast 和 SVC，有太多的新技术和新架构出现在 WebRTC 新的标准中，比如 WebTransport、WebCodecs、AV1、E2EE、SFrame、M...
0
1

JAR冲突问题的解决以及运行状态下如何查看加载的类

今天碰到群里小伙伴问，线上程序好像有多个不同版本的Netty包，怎么去看到底加载了哪一个？ 在说如何看之前，先来说说，当你开始意识到项目里有多个不同版本的Jar包，都是因为遇到了这几个异常： java.lang.NoSu...
0
3

测试一年多，上线就崩溃！微服务到底应该怎么测试？

简介： 只有了解风险，才能及时应对，保障服务高可用。 不久前，也就是11月16日，澳大利亚交易所（Australian Securities Exchange, ASX）上线了一个新的交易系统，但因为出现故障而被迫关闭。这是其 2016 年因硬...
0
2

亿级大表在线不锁表变更字段与索引

摘要：在业界中有一个比较成熟的工具，针对大表的场景，可以在线进行Alter变更，且不会出现锁表的风险。除此之外，它还有其他的一些优点，让我们开始探索吧。 背景 大家在日常工作中，往往需要对数据库的表结构做...
0
3

应用层安全架构设计-访问控制

权限控制，或者说访问控制，广泛应用于各个系统中。抽象地说，是某个主体（subject）对某个客体（object）需要实施某种操作（operation），而系统对这种操作的限制就是权限控制。 在网络中，为了保护网络资源的安...
0
1

数据库高可用架构了解一下

看多了应用服务的高可用架构，我们来看看数据库的高可用吧。 数据存储高可用的方案本质都是通过将数据复制到多个存储设备，通过数据冗余的方式来实现高可用。常见的高可用架构有主备、主从、主主、集群、分区等，...
0
0

说说 Ruby 与 Serverless

本文来源：ServerlessLife 公众号。 引言 最近查阅 Serverless 相关资讯，注意到一个 Ruby Serverless 框架——Jets。 心中便有一些疑问：为什么会有这个项目？它是用来做什么的？作为一门小众语言，有哪些 Serv...
0
0

万亿级数据库MongoDB集群性能数十倍提升及机房多活容灾实践

说明： 本文是2020年深圳Qcon全球软件开发大会《专题：现代数据架构》专场、dbaplus专场：万亿级数据库MongoDB集群性能优化实践、mongodb2020年终盛会分享，分享内容如下(体验万亿级mongodb服务层、存储引擎、高并...
2
4
查看更多
加载更多

关于作者

Yuntian_Z.
Lv1
Yuntian_Z.
私信
提问
文章
1
经验值
0
粉丝
0
关注
0

作者的专辑

全部
工作日志(1)
源创计划
立即入驻

自媒体入驻开源社区，

获百万流量，打造个人技术品牌

推荐关注

换一批
朝如青丝暮成雪
朝如青丝暮成雪
文章 227
访问 23.7W
恋恋美食
恋恋美食
文章 189
访问 81.7W
宝贝女儿
宝贝女儿
文章 10
访问 1.5K
toby520
toby520
文章 5
访问 6K
Anur
Anur
文章 43
访问 20.7W
打赏
0 评论
0 收藏
0 赞
分享
ad close
返回顶部
顶部