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.