coolgauge.pas

很好地delphi书籍源码

unit CoolGauge;

interface
 uses
  SysUtils, Classes, Controls,Graphics;

type
  TGaugeStyle=(csRoundRect,csEllipse);
  TPos=(csUp,csDown,csRight);
  TPointerDir=(pdLeft,pdRight,pdUp);
  TCoolGauge = class(TCustomControl)
    private
     FPen:TPen ;
     FBrush:TBrush ;
     FGaugeStyle:TGaugeStyle ;
     FPointerDir: TPointerDir;
     Radius:integer;
     FTextNum:integer;
     FCaption:string;
     FPos:TPos;
     Value:double;
     procedure SetPen(Value:TPen );
     procedure SetBrush(Value:TBrush);
     procedure SetGaugeStyle(Value:TGaugeStyle );
     protected
     procedure UpdateIt(Sender:TObject) ;
     procedure Paint; override;
   public
     procedure Show(v:double) ;
     constructor Create(AOwner:TComponent);override;
{ Public declarations }
   published
     property Width default 100;
     property Height default 100;
     property Pos:TPos read FPos write FPos default csUp;
     property PointerDir:TPointerDir read FPointerDir write FPointerDir;
     property Caption:String  read FCaption write FCaption ;
     property Align;
     property ParentColor;
     property PopupMenu;
     property ShowHint;
     property Visible;
     property OnClick;
     property OnDblClick;
     property Pen:TPen read FPen write SetPen ;
     property Brush:TBrush read FBrush write SetBrush;
     property GaugeStyle:TGaugeStyle read FGaugeStyle write SetGaugeStyle default csEllipse;
 end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('MyComponent', [TCoolGauge]);
end;

{ TCoolGauge }

constructor TCoolGauge.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  Width:=100;
  Height:=100;
  Radius:=100;
  FPen:=TPen.Create;
  FBrush:=TBrush.Create;
  FPen.OnChange:=UpdateIt;
  FBrush.OnChange:=UpdateIt;
  FGaugeStyle:=csEllipse;
  Value:=0;
  FTextNum:=0;
  FPos:=csUp;
  FPointerDir:=pdLeft;
end;

procedure TCoolGauge.Paint;
var
  i,X0,Y0,X1,Y1,X2,Y2,Beg_x,Beg_y:integer;
  Angle,xx1,yy1,xx2,yy2:double;
begin
  Canvas.Pen:=FPen;
  Canvas.Brush:=FBrush;
  FTextNum:=Length(FCaption) div 2;
  if Width>=Height then
  begin
    Radius:=Height;
    X1:=(Width-Height) div 2; Y1:=0;
    X2:=Radius+(Width-Height) div 2 ; Y2:=Radius;
  end else
  begin
    Radius:=Width ;
    X1:=0; Y1:=(Height-Width) div 2;
    X2:=Radius; Y2:=Radius+(Height-Width) div 2;
  end;
  if (FGaugeStyle=csEllipse) then
  begin
    Canvas.Ellipse(X1,Y1,X2,Y2);
    Canvas.Ellipse(X1+3,Y1+3,X2-3,Y2-3);
  end;
  if(FGaugeStyle=csRoundRect) then
  begin
    Canvas.RoundRect(X1,Y1,X2,Y2,Radius div 4,Radius div 4);
    Canvas.RoundRect(X1+3,Y1+3,X2-3,Y2-3,Width div 4-3,Radius  div 4-3);
  end;
  //在圆心处画一小圆
  X0:=Width div 2;
  Y0:=Height div 2;
  Canvas.Ellipse(X0-4,Y0-4,X0+4,Y0+4);
  case FPos of
    csUp: Beg_y:=Height div 2-20;
    csDown: Beg_y:=Height div 2+5;
    csRight:
    begin
      Beg_x:=Width div 2+5;
      Beg_y:=Height div 2-5;
    end;
  end;
  if (FPos<>csRight) then
  begin
    if(FTextNum mod 2)=1 then
      Beg_x:=Width div 2 - 5*FTextNum-5
    else
      Beg_x:=Width div 2 - 5*FTextNum;
  end;
  Canvas.TextOut(Beg_x,Beg_y,FCaption);
  for i:=-6 to 6 do
  begin
    Angle:=0.01745*i*30;
    xx1:=X1+0.5*Radius*(1-cos(Angle));
    xx2:=X1+0.5*Radius*(1-0.8*cos(Angle));
    yy1:=Y1+0.5*Radius*(1-sin(Angle));
    yy2:=Y1+0.5*Radius*(1-0.8*sin(Angle));
    Canvas.MoveTo(Round(xx1),Round(yy1));
    Canvas.LineTo(Round(xx2),Round(yy2));
  end;
  //指针初始位置在Value处
  Angle:=3*Value*0.0175;
  case FPointerDir of
    pdLeft:
    begin
      xx1:=X1+0.5*Radius*(1-0.7*cos(Angle));
      yy1:=Y1+0.5*Radius*(1-0.7*sin(Angle));
    end;
    pdRight:
    begin
      xx1:=X1+0.5*Radius*(1+0.7*cos(Angle));
      yy1:=Y1+0.5*Radius*(1-0.7*sin(Angle));
    end;
    pdUp:
    begin
      xx1:=X1+0.5*Radius*(1+0.7*sin(Angle));
      yy1:=Y1+0.5*Radius*(1-0.7*cos(Angle));
    end;
  end;
  Canvas.MoveTo(Width div 2,Height div 2);
  Canvas.LineTo(Round(xx1),Round(yy1));
end;

procedure TCoolGauge.SetBrush(Value: TBrush);
begin
  FBrush.Assign(Value);
  Invalidate();
end;

procedure TCoolGauge.SetGaugeStyle(Value: TGaugeStyle);
begin
  if (FGaugeStyle<>Value) then
  begin
    FGaugeStyle:=Value;
    Invalidate;
  end;
end;

procedure TCoolGauge.SetPen(Value: TPen);
begin
  FPen.Assign(Value);
  Invalidate();
end;

procedure TCoolGauge.Show(v: double);
var
  Angle,xx1,yy1:double;
begin
  Canvas.Pen.Mode:=pmNotXor;
  Canvas.Pen.Color:=clBlack;
  Canvas.Pen.Width:=1;
//如果新指针值和当前指针值小于0.5 不移动指针
  if (abs(v-Value)<0.5) then exit
  else
  begin //根据Value先消除原位置处的指针
     //   Canvas.Pen.Mode:=pmNotXor;
     Angle:=3*Value*0.0175;
     case FPointerDir of
     pdLeft:
     begin
       xx1:=0.5*Radius*(1-0.7*cos(Angle));
       yy1:=0.5*Radius*(1-0.7*sin(Angle));
     end;
     pdRight:
     begin
       xx1:=0.5*Radius*(1+0.7*cos(Angle));
       yy1:=0.5*Radius*(1-0.7*sin(Angle));
     end;
     pdUp:
     begin
       xx1:=0.5*Radius*(1+0.7*sin(Angle));
       yy1:=0.5*Radius*(1-0.7*cos(Angle));
    end;
  end;
    Canvas.MoveTo(Width div 2,Height div 2);
    Canvas.LineTo(round(xx1),round(yy1));
    //根据v画出新位置处的指针
    Angle:=3*value*0.0175;
    case FPointerDir of
      pdLeft:
      begin
        xx1:=0.5*Radius*(1-0.7*cos(Angle));
        yy1:=0.5*Radius*(1-0.7*sin(Angle));
      end;
      pdRight:
      begin
        xx1:=0.5*Radius*(1+0.7*cos(Angle));
        yy1:=0.5*Radius*(1-0.7*sin(Angle));
      end;
      pdUp:
      begin
        xx1:=0.5*Radius*(1+0.7*sin(Angle));
        yy1:=0.5*Radius*(1-0.7*cos(Angle));
      end;
    end;
    Canvas.MoveTo(Width div 2,Height div 2);
    Canvas.LineTo(Round(xx1),Round(yy1));
    Value:=v;
  end;
  Refresh;
end;

procedure TCoolGauge.UpdateIt(Sender: TObject);
begin
  Invalidate();
end;

end.