怎么又有人问这个?
写了一个你试试,以后大概可以按照自已的思路写一些了!!!
unit XMMeter;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls,StdCtrls,math;
Type TValuechanged=Procedure(sender:tobject;old_number,new_number:single) of object;
type
TXMMeter = class(TGraphicControl)
private
{ Private declarations }
Ffirstcolor,Fsecondcolor,Fthirdcolor,Fbackcolor,fCorecolor:tcolor;
Fminvalue,Fmaxvalue,Flowvalidvalue,Fhighvalidvalue:integer;
Fcoresize,Fbandwidth:integer;
Fvalue:single;
Funit:string;
Ffont:Tfont;
Ftickercolor:Tcolor;
Feventvalue:Tvaluechanged;
Fsmoothview:boolean;
Fbitmap:tbitmap;
Fpincolor:Tcolor;
Fpinsize:integer;
Procedure Setfirstpartcolor(color:tcolor);
Procedure setsecondpartcolor(color:tcolor);
Procedure SetthirdPartcolor(color:tcolor);
Procedure Setminvalue(n:integer);
procedure setmaxvalue(n:integer);
Procedure Setlowvalidvalue(n:integer);
Procedure SetHighvalidvalue(n:integer);
Procedure setvalue(n:Single);
Procedure setUnit(s:string);
Procedure setbackcolor(color:Tcolor);
Procedure SetCoresize(size:integer);
Procedure SetCorecolor(color:tcolor);
Procedure SetBandwidth(size:integer);
procedure WMSize(var Message: TWMSize);message WM_SIZE;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
Procedure setfont(f:Tfont);
Procedure settickercolor(color:tcolor);
procedure Antialising(C: TCanvas; Rect: TRect; Percent:integer);
Procedure Setsmoothview(v:boolean);
// Procedure BlurView;
Procedure DrawMeterMap;
procedure setpincolor(color:Tcolor);
Procedure setpinsize(size:integer);
procedure DrawColorFade(StartColor, StopColor: TColor; iLeft, iTop, iRight, iBottom: integer);
protected
{ Protected declarations }
public
{ Public declarations }
Constructor Create(AOwner: TComponent); override;
destructor Destroy;override;
published
{ Published declarations }
Property FirstPartColor:Tcolor read Ffirstcolor write setfirstPartColor default $004DB1F4 ;
Property SecondPartColor:Tcolor read FSecondcolor Write SetSecondPartColor default $0052B873;
Property ThirdPartColor:tcolor Read FThirdcolor write Setthirdpartcolor default clred;
Property Minvalue:integer read Fminvalue write SetMinvalue ;
Property Maxvalue:integer read Fmaxvalue write SetMaxvalue ;
Property LowValidvalue :integer read Flowvalidvalue write setlowvalidvalue;
Property Highvalidvalue:integer read Fhighvalidvalue write Sethighvalidvalue;
Property backcolor:tcolor read Fbackcolor Write setbackcolor default clblack;
Property Value:Single read Fvalue write setvalue;
Property Unitstring:string read Funit write setUnit;
Property CoreSize:integer read Fcoresize write SetCoresize;
Property Corecolor:Tcolor read Fcorecolor write Setcorecolor default clwhite;
Property Bandwidth:Integer Read Fbandwidth write Setbandwidth default 4;
Property Font:tfont read Ffont write Setfont ;
Property Tickercolor:Tcolor read Ftickercolor write settickercolor;
Property Onvaluechanged:Tvaluechanged read Feventvalue write Feventvalue;
Property SmoothView:boolean read Fsmoothview write setsmoothview;
Property Pincolor:Tcolor read Fpincolor write setpincolor;
Property Pinsize:integer read Fpinsize write setpinsize;
end;
procedure Register;
implementation
//uses Ugraphiceffect;
Procedure Txmmeter.setpincolor (color:Tcolor);
begin
Fpincolor:=color;
invalidate;
end;
Procedure txmmeter.settickercolor(color:Tcolor);
begin
Ftickercolor:=color;
invalidate;
end;
Destructor Txmmeter.destroy;
begin
Ffont.free;
//Fbitmap.free;
inherited;
end;
{
Procedure Txmmeter.BlurView ;
var
ray : array [0..8] of integer;
i:integer;
begin
ray[0] :=1; // Set filter values
ray[1] := 1; // from string grid.
ray[2] := 1;
ray[3] := 1;
ray[4] := 1;
ray[5] := 1;
ray[6] := 1;
ray[7] := 1;
ray[8] := 1;
// dst.transparent:=false;
for i:= 0 to 16 do
ConvolveM(ray,9,Fbitmap);
end;
}
Procedure Txmmeter.setfont(f:Tfont);
begin
FFont.assign(F);
invalidate;
end;
Constructor Txmmeter.Create(aowner:tcomponent);
begin
Inherited Create(Aowner);
(*Fbitmap:=tbitmap.create;
Fbitmap.width:=100;
Fbitmap.height:=50;*)
Width:=100;
height:=50;
Fmaxvalue:=100;
Fminvalue:=0;
//canvas.Lock;
Ffirstcolor:=$004DB1F4; //过低
Fsecondcolor:=$0052B873; //合格
Fthirdcolor:=clred; //过高
Fbackcolor:=clblack;//背景色
Fcorecolor:=clwhite;
Fbandwidth:=4;//宽度
Flowvalidvalue:=40; ////
FhighValidvalue:=70; //
Fcoresize:=10;
Ftickercolor:=clred;
//有效段为从40-70这项
//canvas.unlock;
Ffont:=tfont.create;
Ffont.name:='arial black' ;
Ffont.size:=9;
FFont.color:=clwhite;
Fpincolor:=clblue;
Fpinsize:=2;
invalidate;
end;
Procedure Txmmeter.WMPaint(var Message: TWMPaint);
var
Fnum:single;
x1,y1,x2,y2:integer;
x3,y3,x4,y4:integer;
x5,y5,x6,y6:integer;
s_value:string;
begin
width:=2*height;
Drawmetermap;
inherited;
// blurview;
// canvas.brush.style:=bsclear;
// Fbitmap.TransparentColor :=clwhite;
// fbitmap.transparent:=true;
// canvas.draw(0,0,Fbitmap);
end;
Procedure txmmeter.Setfirstpartcolor (color:tcolor);
begin
Ffirstcolor:=color;
invalidate;
end;
Procedure Txmmeter.setsecondpartcolor (color:tcolor);
begin
Fsecondcolor:=color;
Invalidate;
end;
Procedure txmmeter.SetthirdPartcolor (color:tcolor);
begin
Fthirdcolor:=color;
invalidate;
end;
Procedure txmmeter.Setminvalue (n:integer);
begin
if n>=Fmaxvalue then exit;
Fminvalue:=n;
invalidate;
end;
Procedure txmmeter.setmaxvalue (n:integer);
begin
if n<=Fminvalue then exit;
Fmaxvalue:=n;
invalidate;
end;
Procedure Txmmeter.Setlowvalidvalue (n:integer);
begin
if ( N<=Fminvalue ) or (n>=Fmaxvalue) or (n>=Fhighvalidvalue) then exit;
Flowvalidvalue:=n;
invalidate;
end;
Procedure Txmmeter.Sethighvalidvalue (n:integer);
begin
if ( N>=Fmaxvalue ) or (n<=Fminvalue) or (n<=Flowvalidvalue) then exit;
Fhighvalidvalue:=n;
invalidate;
end;
Procedure Txmmeter.setvalue (n:single);
var
old_n:single;
begin
if N<Fminvalue then n:=Fminvalue;
if N>Fmaxvalue then n:=Fmaxvalue;
old_n:=Fvalue;
Fvalue:=n;
Invalidate;
if assigned(Feventvalue) then
if old_n <>n then
Feventvalue(self,old_n,n);
end;
Procedure Txmmeter.setUnit (s:string);
begin
if s=Funit then exit;
Funit:=s;
invalidate;
end;
Procedure Txmmeter.setbackcolor (color:tcolor);
begin
Fbackcolor:=color;
INvalidate;
end;
Procedure txmmeter.SetCoresize (size:integer);
begin
if size>Height div 2 then exit;
Fcoresize:=size;
invalidate;
end;
Procedure txmmeter.SetCorecolor (color:Tcolor);
begin
Fcorecolor:=color;
invalidate;
end;
Procedure txmmeter.SetBandwidth (size:integer);
begin
Fbandwidth:=size;
invalidate;
end;
Procedure Txmmeter.WMSize (var Message: TWMSize);
begin
inherited;
if height<25 then height:=25;
width:=2*height;
end;
procedure Txmmeter.Antialising(C: TCanvas; Rect: TRect; Percent:
Integer);
var
l, p: Integer;
R, G, B: Integer;
R1, R2, G1, G2, B1, B2: Byte;
begin
with c do
begin
for l := Rect.Top to Rect.Bottom do
begin
for p := Rect.Left to Rect.Right do
begin
R1 := GetRValue(Pixels[p, l]);
G1 := GetGValue(Pixels[p, l]);
B1 := GetBValue(Pixels[p, l]);
//Pixel links
//Pixel left
R2 := GetRValue(Pixels[p - 1, l]);
G2 := GetGValue(Pixels[p - 1, l]);
B2 := GetBValue(Pixels[p - 1, l]);
if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
begin
R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
Pixels[p - 1, l] := RGB(R, G, B);
end;
//Pixel rechts
//Pixel right
R2 := GetRValue(Pixels[p + 1, l]);
G2 := GetGValue(Pixels[p + 1, l]);
B2 := GetBValue(Pixels[p + 1, l]);
if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
begin
R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
Pixels[p + 1, l] := RGB(R, G, B);
end;
//Pixel oben
//Pixel up
R2 := GetRValue(Pixels[p, l - 1]);
G2 := GetGValue(Pixels[p, l - 1]);
B2 := GetBValue(Pixels[p, l - 1]);
if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
begin
R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
Pixels[p, l - 1] := RGB(R, G, B);
end;
//Pixel unten
//Pixel down
R2 := GetRValue(Pixels[p, l + 1]);
G2 := GetGValue(Pixels[p, l + 1]);
B2 := GetBValue(Pixels[p, l + 1]);
if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
begin
R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
Pixels[p, l + 1] := RGB(R, G, B);
end;
end;
end;
end;
end;
Procedure txmmeter.setsmoothview(v:boolean);
begin
Fsmoothview:=v;
invalidate;
end;
procedure txmmeter.DrawMeterMap ;
var
Fnum:single;
x1,y1,x2,y2:integer;
x3,y3,x4,y4:integer;
x5,y5,x6,y6:integer;
s_value:string;
hdrawrgn:Hrgn;
begin
//Fbitmap.width:=width;
//Fbitmap.height:=height;
with canvas do
begin
if assigned(ffont) then
Font.assign(Ffont);
pen.width:=1;
brush.style:=bssolid;
brush.color:=Fbackcolor;
pen.color:=Fbackcolor;
Ellipse(Fbandwidth div 2,Fbandwidth div 2,width-fbandwidth div 2,height*2-fbandwidth div 2);
//画渐变的表盘
// Hdrawrgn:=CreateEllipticRgn(Fbandwidth,Fbandwidth,width-Fbandwidth,height-Fbandwidth);
// selectcliprgn(Handle,hdrawrgn);
// DrawColorFade(clwhite,clblack,0,0,width,height);
//画中心圆
// selectcliprgn(Handle,0);
brush.color:=Fcorecolor;
pen.color:=fcorecolor;
ellipse(width div 2-Fcoresize,height-Fcoresize,width div 2+Fcoresize,height+Fcoresize);
//画第一部分
pen.width:= Fbandwidth;
Pen.color:=Ffirstcolor;
Fnum:=Flowvalidvalue /(Fmaxvalue-Fminvalue);
if Flowvalidvalue<=(Fmaxvalue-fminvalue) div 2 then
begin
x1:=height-abs(trunc(height*cos(fnum*pi))) ;
y1:=height-abs(trunc(height*sin(fnum*pi)));
end
else
begin
x1:=height+abs(trunc(height*cos(fnum*pi)));
y1:=height-abs(trunc(height*sin(fnum*pi)));
end;
x2:=0;
y2:=height;
arc(Fbandwidth div 2,Fbandwidth div 2,height*2-fbandwidth div 2,width-Fbandwidth div 2,x1,y1,x2,y2);
//画第二部分
Pen.color:=Fsecondcolor;
Fnum:=Fhighvalidvalue /(Fmaxvalue-Fminvalue);
if Fhighvalidvalue<=(fmaxvalue-fminvalue) div 2 then
begin
x3:=height-abs(trunc(height*cos(fnum*pi))) ;
y3:=height-abs(trunc(height*sin(fnum*pi)));
end
else
begin
x3:=height+abs(trunc(height*cos(fnum*pi)));
y3:=height-abs(trunc(height*sin(fnum*pi)));
end;
x4:=x1;
y4:=y1;
arc(Fbandwidth div 2,Fbandwidth div 2,height*2-fbandwidth div 2,width-Fbandwidth div 2,x3,y3,x4,y4);
//画第三部分
pen.color:=Fthirdcolor;
// Fnum:=(Fmaxvalue-Fhighvalidvalue) /(Fmaxvalue-Fminvalue);
x5:=x3;//Height+trunc (height *cos(Pi-Fnum*PI)) ;
y5:=y3;//height-trunc(height*sin(pi-Fnum*pi));
x6:=width;
y6:=2*height;
arc(Fbandwidth div 2,Fbandwidth div 2,height*2-fbandwidth div 2,width-Fbandwidth div 2,x6,y6,x5,y5);
//画出value 指针
pen.width:=1;
pen.color:=Ftickercolor;
brush.color:=Ftickercolor;
Fnum:=Fvalue /(Fmaxvalue-Fminvalue);
if Fvalue<=(fmaxvalue-Fminvalue) div 2 then
begin
x1:=height-abs(trunc(height*cos(fnum*pi))) ;
y1:=height-abs(trunc(height*sin(fnum*pi)));
end
else
begin
x1:=height+abs(trunc(height*cos(fnum*pi)));
y1:=height-abs(trunc(height*sin(fnum*pi)));
end;
Polygon([point(width div 2 -2,height), Point(width div 2+2,height),
Point(x1, y1)]);
//画出单位及数值
brush.style:=bsclear;
if Funit<>'' then
begin
x1:=textwidth(Funit);
y1:=textheight(funit);
textout((width-x1) div 2,(height-y1) div 2 ,Funit);
end ;
s_value:=formatfloat('00.0',Fvalue);
x1:=(width-textwidth(s_value)) div 2;
textout(x1,(height-textheight('0')) div 2+textheight('0') div 2 +4 ,s_value);
//画中心圆pin点
brush.color:=Fpincolor;
pen.color:=Fpincolor;
ellipse(width div 2-Fpinsize,height-Fpinsize,width div 2+Fpinsize,height+Fpinsize);
Canvas.Brush.Style := bsclear;
if Fsmoothview then
Antialising(canvas,canvas.cliprect,20);
end;
end;
Procedure Txmmeter.setpinsize (size:integer);
begin
if size>Fcoresize then exit;
if size<0 then exit;
Fpinsize:=size;
invalidate;
end;
procedure Txmmeter.DrawColorFade(StartColor, StopColor: TColor; iLeft, iTop, iRight, iBottom: integer);
var
iCounter, iBuffer, iFillStep: integer;
bR1, bG1, bB1, bR2, bG2, bB2: byte;
aColor1, aColor2: LongInt;
dCurrentR, dCurrentG, dCurrentB, dRStep, dGStep, dBStep: double;
aOldStyle: TPenStyle;
iHeight, iDrawBottom: integer;
begin
iHeight := (iBottom - iTop);
aOldStyle := Canvas.Pen.Style; Canvas.Pen.Style := psClear;
aColor1 := ColorToRGB(StartColor); bR1 := GetRValue(aColor1); bG1 := GetGValue(aColor1); bB1 := GetBValue(aColor1);
aColor2 := ColorToRGB(StopColor); bR2 := GetRValue(aColor2); bG2 := GetGValue(aColor2); bB2 := GetBValue(aColor2);
dCurrentR := bR1; dCurrentG := bG1; dCurrentB := bB1;
dRStep := (bR2-bR1) / 31; dGStep := (bG2-bG1) / 31; dBStep := (bB2-bB1) / 31;
iFillStep := (iHeight div 31) + 1;
for iCounter := 0 to 31 do
begin
iBuffer := iCounter * iHeight div 31;
Canvas.Brush.Color := rgb(trunc(dCurrentR), trunc(dCurrentG), trunc(dCurrentB));
dCurrentR := dCurrentR + dRStep; dCurrentG := dCurrentG + dGStep; dCurrentB := dCurrentB + dBStep;
iDrawBottom := iTop + iBuffer + iFillStep; if iDrawBottom > iBottom then iDrawBottom := iBottom;
Canvas.FillRect(Rect(iLeft, iTop + iBuffer, iRight, iDrawBottom));
end;
Canvas.Pen.Style := aOldStyle;
end;
procedure Register;
begin
RegisterComponents('Samples', [TXMMeter]);
end;
end.
