请选择 进入手机版 | 继续访问电脑版

Lazarus中文社区

 找回密码
 立即注册

QQ登录

只需一步,快速开始

Lazarus IDE and 组件 下载地址版权申明
查看: 5670|回复: 12

[Lazarus实战宝典] 开源控件大家做(4) 仪表盘

[复制链接]

该用户从未签到

发表于 2012-6-1 17:57:21 | 显示全部楼层 |阅读模式
下面的是仪表盘的控件的代码:
  1. unit Mymeter;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5.   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,windows;
  6. const
  7.    orid=5;   
  8. type
  9.   TMymeter = class(TPaintBox)
  10.   private
  11.     { Private declarations }
  12.     FA1:integer;                   // 圆环的分度
  13.     FColorA1:Tcolor;             // 圆环的分度左半颜色
  14.     FColorA2:Tcolor;             // 圆环的分度右半颜色
  15.     FDialcolor:Tcolor;           // 表盘刻度线的颜色
  16.     FTitlecolor:Tcolor;          // 表盘标题的颜色
  17.     FValuecolor:Tcolor;        // 数字示值的颜色
  18.     FBKcolor:Tcolor;             // 表盘的背景颜色
  19.     FNeedlecolor:Tcolor;       // 指针颜色
  20.     FMinvalue,FMaxvalue,          // 表盘的最小,最大值
  21.     FValue:Single;                      // 表盘的当前值
  22.     FDistance:integer;              // 用于调整的
  23.     FDivide_number:integer;      // 表盘的分度
  24.     FXWidth,FYHeight:integer;   // 表盘的长宽
  25.     FCX,FCY,FCR,FCRWidth:integer;   // FCX,FCY 为指针的圆心位置,FCR半径,FCRWidth 圆弧宽度
  26.     procedure PaintCir();      
  27.     procedure Paintbigdial;     
  28.     procedure Paintsmalldial;   
  29.     procedure PaintNeedle(A:single);
  30.     procedure setbkground;   
  31.     procedure SA1(A:integer);     
  32.     procedure SColorA1(A:Tcolor);   
  33.     procedure SColorA2(A:Tcolor);     
  34.     procedure SBKColor(A:Tcolor);     
  35.     procedure SNeedlecolor(A:Tcolor);   
  36.     procedure SDialcolor(A:Tcolor);     
  37.     procedure SMinvalue(A:single);
  38.     procedure SMaxvalue(A:single);
  39.     procedure SDivide_number(A:integer);
  40.     procedure SValue(A:single);
  41.     procedure SCRWidth(A:integer);
  42.     procedure SDistance(A:integer);
  43.   protected
  44.     { Protected declarations }
  45.     procedure PlotArc(const fCanvas: TCanvas;
  46.                       const Center: TPoint;
  47.                       const Radius: Integer;
  48.                       const StartAngle: Single;
  49.                       const StopAngle: Single);
  50.   public
  51.     { Public declarations }
  52.     constructor Create(AOwner: TComponent); override;
  53.     destructor   Destroy;override;
  54.     procedure Paint; override;
  55.     procedure init;     
  56.   published
  57.     { Published declarations }
  58.     property A1: integer Read FA1 Write SA1;
  59.     property ColorA1: Tcolor Read FColorA1 write SColorA1;
  60.     property ColorA2: Tcolor Read FColorA2 write SColorA2;
  61.     property BKcolor: Tcolor Read FBKcolor write SBKColor;
  62.     property Needlecolor:Tcolor read FNeedlecolor write SNeedlecolor;
  63.     property Dialcolor :Tcolor read FDialcolor write SDialcolor;
  64.     property Minvalue : Single Read FMinvalue write SMinvalue ;
  65.     property Maxvalue : Single Read FMaxvalue write SMaxvalue ;
  66.     property Divide_number:integer read FDivide_number write Sdivide_number;
  67.     property Value : Single Read FValue write SValue;
  68.     property CRWidth :integer Read FCRWidth write SCRWidth;
  69.     property Distance:integer Read FDistance write SDistance;
  70.   end;
  71. procedure Register;
  72. implementation
  73. procedure Register;
  74. begin
  75.   {$I mymeter_icon.lrs}
  76.   RegisterComponents('fpccn',[TMymeter]);
  77. end;
  78. constructor  TMymeter.Create(AOwner: TComponent);
  79. begin
  80.    FA1:=30;
  81.    FColorA1:=clLime;
  82.    FColorA2:= Clred;
  83.    FBKColor:=clyellow;
  84.    FNeedlecolor:=clblue;
  85.    FDialcolor:=clblack;               
  86.    FValuecolor:=clblack;
  87.    FCRWidth := 6;
  88.    FMinvalue:=0.0;
  89.    FMaxvalue:=50.0;
  90.    FValue:=0.0;
  91.    FXWidth:=self.Width;
  92.    FYHeight:=self.Height;
  93.    FDistance:=10;
  94.    FDivide_number:=5;
  95.    init;
  96.   inherited;
  97. end;
  98. destructor TMymeter.Destroy;
  99. begin
  100.   inherited   Destroy;
  101. end;
  102. procedure TMymeter.PlotArc(const fCanvas: TCanvas;
  103.                            const Center: TPoint;
  104.                            const Radius: Integer;
  105.                            const StartAngle: Single;
  106.                            const StopAngle: Single);
  107. function GetPositionForAngle(const Angle: Single): TPoint;
  108. var
  109.   CosAngle: single;
  110.   SinAngle: single;
  111. begin
  112.   SinAngle:=sin((angle-90)*PI/180);    // 将坐标旋转90,符合视觉
  113.   CosAngle:=cos((angle-90)*PI/180);
  114.   Result.X := Round(Center.X + Radius * SinAngle);
  115.   Result.Y := Round(Center.Y - Radius * CosAngle);
  116. end;
  117. var
  118.   Index: Integer;
  119. begin
  120.   with GetPositionForAngle(StartAngle) do fCanvas.MoveTo(X, Y);
  121.   for Index := round(StartAngle) to round(StopAngle) do
  122.     with GetPositionForAngle(Index) do fCanvas.LineTo(X, Y);
  123.   with GetPositionForAngle(StopAngle) do fCanvas.LineTo(X, Y);
  124. end;
  125. procedure TMymeter.SA1(A:integer);
  126. begin
  127.   if FA1=A then exit;
  128.   FA1:=A;
  129.   if (FA1 < round(FMinvalue)) then FA1:= round(FMinvalue);
  130.   if (FA1> round(FMaxvalue)) then FA1:= round(FMaxvalue); //A1非法输入时初始化
  131.   Refresh;
  132. end;
  133. procedure TMymeter.SColorA1(A:Tcolor);
  134. begin
  135.   if FColorA1=A then exit;
  136.   FColorA1:=A;
  137.   Refresh;
  138. end;
  139. procedure TMymeter.SColorA2(A:Tcolor);
  140. begin
  141.   if FColorA2=A then exit;
  142.   FColorA2:=A;
  143.   Refresh;
  144. end;
  145. procedure TMymeter.SNeedlecolor(A:Tcolor);
  146. begin
  147.   if FNeedlecolor=A then exit;
  148.   FNeedlecolor:=A;
  149.   Refresh;
  150. end;
  151. procedure TMymeter.SBKColor(A:Tcolor);
  152. begin
  153.   if FBKColor=A then exit;
  154.   FBKColor:=A;
  155.   Refresh;
  156. end;
  157. procedure TMymeter.SDialcolor(A:Tcolor);     
  158. begin
  159.   if FDialcolor=A then exit;
  160.   FDialcolor:=A;
  161.   Refresh;
  162. end;
  163. procedure TMymeter.Sminvalue(A:single);
  164. begin
  165.   if FMinvalue=A then exit;
  166.   FMinvalue:=A;
  167.   Refresh;
  168. end;
  169. procedure TMymeter.Smaxvalue(A:single);
  170. begin
  171.   if FMaxvalue=A then exit;
  172.   FMaxvalue:=A;
  173.   Refresh;
  174. end;
  175. procedure TMymeter.Sdivide_number(A:integer);
  176. begin
  177.   if FDivide_number=A then exit;
  178.   FDivide_number:=A;
  179.   Refresh;
  180. end;
  181. procedure TMymeter.Svalue(A:single);
  182. var
  183.    temp1,temp2:tcolor;
  184. begin
  185.   if (Fvalue=A) then exit;
  186.   if (A < FMinvalue) then A:=FMinvalue
  187.   else if (A > FMaxvalue) then A:=FMaxvalue;
  188.   temp1:=FNeedlecolor;
  189.   temp2:=canvas.Font.Color;
  190.   FNeedlecolor:=FBKColor;
  191.   canvas.Font.Color:=FBKColor;
  192.   PaintNeedle(Fvalue);   
  193.   Fvalue:=A;
  194.   FNeedlecolor:=temp1;
  195.   canvas.Font.Color:=temp2;
  196.   PaintNeedle(Fvalue);   
  197. end;
  198. procedure TMymeter.SCRWidth(A:integer);
  199. begin
  200.   if (FCRWidth=A) then exit;
  201.   FCRWidth:=A;
  202.   Refresh;
  203. end;
  204. procedure TMymeter.Sdistance(A:integer);
  205. begin
  206.   if (FDistance=A) then exit;
  207.   FDistance:=A;
  208.   Refresh;
  209. end;
  210. procedure TMymeter.init;
  211. begin
  212.   FXWidth:=self.Width;
  213.   FYHeight:=self.Height;
  214.   FCR:=((FXwidth - FCRWidth- Fdistance) * 4 div 5) div 2;   
  215.   FCX :=  FXwidth div 2;
  216.   if  (FCRWidth > 20) then FCY :=FYHeight - FCRWidth
  217.   else FCY :=FYHeight - 20;
  218. end;
  219. procedure TMymeter.PaintCir();  
  220. var                           
  221.   i,a: Integer;
  222.   kk:Tpoint;
  223. begin
  224.   kk.x:=FCX;
  225.   kk.y:=FCY;
  226.   with Canvas do
  227.   begin
  228.     Pen.Style := psSolid;
  229.     Pen.Width:=2;
  230.     a:=round((FA1 - FMinvalue) * 180 / (FMaxvalue - FMinvalue));
  231.     for i:=1 to FCRWidth do
  232.     begin
  233.       Pen.Color := ColorA1;
  234.       PlotArc(canvas,kk,FCR+i+FCRWidth div 2,0,a);   
  235.       Pen.Color := ColorA2;
  236.       PlotArc(canvas,kk,FCR+i+FCRWidth div 2,a,180);     
  237.     end;
  238.     Pen.Width:=1;
  239.     Pen.Color := clblack;
  240.     PlotArc(canvas,kk,FCR+ FCRWidth div 2,0,180);
  241.     PlotArc(canvas,kk,FCR + FCRWidth + FCRWidth div 2 + 1,0,180);
  242.   end;
  243. end;
  244. procedure TMymeter.Paintbigdial;
  245. var
  246.   x,y,x1,y1,x2,y2,y3,Len:integer;
  247.   radian, isValue, A,B,C,D,E:single;
  248.   strtemp:string;
  249. begin
  250.   with Canvas do
  251.   begin
  252.     Brush.Style:=bsclear;
  253.     Pen.Width:=2;
  254.     Pen.Color :=  FDialcolor;
  255.     if (FDivide_number<>0) then B:=180 / FDivide_number   
  256.     else B:=90;
  257.     C:=(FMaxvalue-FMinvalue) / FDivide_number ;
  258.     Len:=FCR + FCRWidth + FCRWidth div 2;
  259.     for y3:=0 to FDivide_number do
  260.     begin
  261.       A:=B * y3;
  262.       E:=A-90;
  263.       radian:= E * PI / 180;            
  264.       x:=Round(Len*sin(radian));
  265.       y:=Round(Len*cos(radian));
  266.       x1:=Round((Len-FCRWidth )*sin(radian));
  267.       y1:=Round((Len-FCRWidth )*cos(radian));
  268.       Pen.Width:=2;
  269.       Pen.Color :=  FDialcolor;
  270.       MoveTo(FCX+x1,FCY-y1);
  271.       LineTo(FCX+x,FCY-y);
  272.       if ((y3 = 0) or (y3=FDivide_number)) then
  273.       begin
  274.         E:=A-90;
  275.         radian:= E * PI / 180;            
  276.         x2:=Round((Len+FCRWidth)*sin(radian))-font.Size;
  277.         y2:=Round((Len+FCRWidth)*cos(radian))+font.Size;
  278.       end
  279.       else begin
  280.              E:=A-90 -2;
  281.              radian:= E * PI / 180;            
  282.              x2:=Round((Len+FCRWidth+5)*sin(radian));
  283.              y2:=Round((Len+FCRWidth+5)*cos(radian));
  284.       end;
  285.       isvalue:= FMinvalue + y3 * C;
  286.       Pen.Width:=1;
  287.       Pen.Color := FValuecolor;
  288.       if ((y3 = 0) or (y3=FDivide_number)) then D:=0
  289.       else D:= 90- A;
  290.       font.Orientation:=round(D*10) ;   
  291.       strtemp := format('%0.0f',[isvalue]);
  292.       TextOut(FCX+x2,FCY-y2,strtemp);
  293.     end;
  294.     font.Orientation:=0;   
  295.   end;
  296. end;
  297. procedure TMymeter.Paintsmalldial;
  298. var
  299.   x,y,x1,y1,x2,Len:integer;
  300.   radian,A,B: single;
  301. begin
  302.   with Canvas do
  303.   begin
  304.     Pen.Width:=1;
  305.     Pen.Color := FDialcolor;
  306.     Len:=FCR+FCRWidth;
  307.     if (FDivide_number<>0) then B:=180 / (FDivide_number *orid)
  308.     else B:=90;
  309.     for x2:=0 to (FDivide_number * orid) do
  310.     begin
  311.       A:= B * x2;
  312.       radian:= (A-90)*PI/180;
  313.       x:=Round((Len)*sin(radian));
  314.       y:=Round((Len)*cos(radian));
  315.       x1:=Round((Len-FCRWidth/2)*sin(radian));
  316.       y1:=Round((Len-FCRWidth/2)*cos(radian));
  317.       MoveTo(FCX+x1,FCY-y1);
  318.       LineTo(FCX+x,FCY-y);
  319.     end;
  320.   end;
  321. end;
  322. procedure TMymeter.PaintNeedle(A:single);
  323. var
  324.   x,y:integer;
  325.   radian,B: single;
  326. begin
  327.   with Canvas do
  328.   begin
  329.     Pen.Width:=3;
  330.     Pen.Color := FNeedlecolor;
  331.     if  (A=FMaxvalue) then B:=180
  332.     else B:= (A -FMinvalue) * 180 / (FMaxvalue-FMinvalue);      
  333.     radian:= (B-90) * Pi /180;
  334.     x:=Round(FCR*sin(radian));
  335.     y:=Round(FCR*cos(radian));
  336.     MoveTo(FCX,FCY);
  337.     LineTo(FCX+x,FCY-y);
  338.   end;
  339. end;
  340. procedure TMymeter.Setbkground;
  341. begin
  342.   with Canvas do
  343.   begin
  344.     pen.Width:=self.Width;
  345.     pen.Color:=FBKcolor;
  346.     Rectangle(self.ClientRect);
  347.   end;
  348. end;
  349. procedure TMymeter.Paint;  
  350. begin
  351.   inherited;
  352.   self.Canvas.Brush.Style:=bsclear;
  353.   init;         
  354.   Setbkground;   
  355.   PaintCir;
  356.   Paintsmalldial;     
  357.   Paintbigdial;      
  358.   PaintNeedle(Fvalue);
  359.   inherited Paint;
  360. end;
  361. end.
复制代码
  仪表盘控件的图例:
   
   
    逍遥派掌门人的开源控件,欢迎各位社员交作业  

   

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?立即注册

x

评分

参与人数 1威望 +1 收起 理由
bugxiong + 1 太棒了,向你学习

查看全部评分

回复

使用道具 举报

该用户从未签到

发表于 2012-6-1 22:45:43 | 显示全部楼层
高手,值得学习
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2012-6-2 12:22:08 | 显示全部楼层
太棒了,向你学习
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2012-6-2 13:59:57 | 显示全部楼层
先谢谢了
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2012-6-4 15:08:59 | 显示全部楼层
支持,支持,希望做到iocomp那么好啊
回复 支持 反对

使用道具 举报

该用户从未签到

 楼主 发表于 2012-6-5 09:39:35 | 显示全部楼层

回 4楼(richard9902) 的帖子

richard9902:支持,支持,希望做到iocomp那么好啊 (2012-06-04 15:08) 
有更多的人参与进来才能做得更好。
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2012-6-5 15:03:17 | 显示全部楼层
努力加油
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2012-10-12 15:45:27 | 显示全部楼层
初来乍到,掌门人可要多指教啊
回复 支持 反对

使用道具 举报

该用户从未签到

 楼主 发表于 2012-10-12 16:36:33 | 显示全部楼层

回 7楼(近在眼前) 的帖子

近在眼前:初来乍到,掌门人可要多指教啊  (2012-10-12 15:45) 
欢迎老近!
你是高手了,多发点东西啊 。
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2012-12-7 13:25:03 | 显示全部楼层
线条能光滑就好了。
颜色有渐变就更好了。
那样我就直接搬运了
回复 支持 反对

使用道具 举报

QQ|手机版|小黑屋|Lazarus中国|Lazarus中文社区 ( 鄂ICP备16006501号-1

GMT+8, 2021-2-25 19:23 , Processed in 0.163426 second(s), 29 queries .

Powered by Discuz! F1.0 Build 20160930

© 2001-2021 Comsenz Inc. & Discuz! Fans

快速回复 返回顶部 返回列表