abtank.pas

著名的虚拟仪表控件,包含全部源码, 可以在,delphi2007 下安装运行

    ValueChange;
  end;
end;

procedure TAbTank.SetFontUnitCol(Value: TColor);
begin
  if FFontUnitCol <> Value then
  begin
    FFontUnitCol := Value;
    ValueChange;
  end;
end;

procedure TAbTank.SetOptions(Value: TTankOptions);
begin
  if FOptions <> Value then
  begin
    FOptions := Value;
    ValueChange;
  end;
end;

destructor TAbTank.Destroy;
begin
  FTankSettings.Free;
  FBevelValue.Free;
  DeleteObject(ClipRgn);
  inherited Destroy;
end;


procedure TAbTank.Paint;
var
  ClientArea        : TRect;
begin
  inherited Paint;                      // stores left/top position

  DeleteObject(ClipRgn);

  PixPerPPT := (Height - TankSettings.PenWidth * 2) / 1000;

  ClientArea := Rect(Left, Top, Left + Width, Top + Height);

  if TankSettings.Style = tsHorizontal then
  begin
    r1 := Width div 3;
    r2 := Height;
    ClipRgn := CreateRoundRectRgn(ClientArea.Left, ClientArea.Top,
      ClientArea.Right, ClientArea.Bottom, r1, r2);
  end
  else
    if TankSettings.Style = tsVertical then
    begin
      r1 := Width;
      r2 := Height div 3;
      ClipRgn := CreateRoundRectRgn(ClientArea.Left, ClientArea.Top,
        ClientArea.Right, ClientArea.Bottom, r1, r2);
    end
    else
      if TankSettings.Style = tsRectangle then
      begin
        ClipRgn := CreateRectRgn(ClientArea.Left, ClientArea.Top,
          ClientArea.Right, ClientArea.Bottom);
      end
      else
        if TankSettings.Style = tsRoundRect then
        begin
          if Width < Height then
          begin
            r1 := Width div 3;
          end
          else
          begin
            r1 := Height div 3;
          end;
          ClipRgn := CreateRoundRectRgn(ClientArea.Left, ClientArea.Top,
            ClientArea.Right, ClientArea.Bottom, r1, r1);
        end
        else
          if TankSettings.Style = tsCrater then
          begin
            r1 := (Width - TankSettings.FCraterWidth) div 2;
            crater[1] := Point(ClientArea.Left, ClientArea.Top);
            crater[2] := Point(ClientArea.Right, ClientArea.Top);
            crater[3] := Point(ClientArea.Left + r1 + TankSettings.FCraterWidth,
              ClientArea.Bottom - TankSettings.FCraterWidth div 2);
            crater[4] := Point(ClientArea.Left + r1 + TankSettings.FCraterWidth,
              ClientArea.Bottom);
            crater[5] := Point(ClientArea.Left + r1, ClientArea.Bottom);
            crater[6] := Point(ClientArea.Left + r1, ClientArea.Bottom -
              TankSettings.FCraterWidth div 2);

            ClipRgn := CreatePolygonRgn(crater[1], 6, WINDING);
          end
          else
            if TankSettings.Style = tsEllipse then
            begin
              ClipRgn := CreateEllipticRgn(ClientArea.Left, ClientArea.Top,
                ClientArea.Right, ClientArea.Bottom);
            end;
  FirstDraw := false;

  ValueChange;
end;

procedure TAbTank.ValueChange;
var
  TempBmp           : TBitmap;
  Pos               : Smallint;
  PosPPH            : Smallint;
  h, w              : Integer;
  r                 : TRect;
  cl                : TColor;
begin

  inherited ValueChange;
  if not (Visible or (csDesigning in Componentstate)) or FirstDraw then Exit;

  Pos := Height - TankSettings.PenWidth - Round(PixPerPPT * PPT);
  PosPPH := Height - TankSettings.PenWidth - Round(PixPerPPT * (PPT * PPH*0.01));

  r := ClientRect;
  TempBmp := TBitmap.Create;
  TempBmp.Width := Width;
  TempBmp.Height := Height;

  with TempBmp do
  begin
    Canvas.Brush.Color := TankSettings.BkColor;
    Canvas.Pen.Color := TankSettings.BkColor;
    Canvas.Brush.Style := bsSolid;
    Canvas.Rectangle(0, 0, Width, Height);

    cl := TankSettings.Color;
    if (opUseSectorColors in FOptions) then
    begin
      if (InSector1 or InSector2 or InSector3) then
        cl := ActSectorCol;
    end;

    Canvas.Brush.Color := cl;
    Canvas.Pen.Color := cl;
    Canvas.Rectangle(0, Pos, Width, PosPPH);

    Canvas.Brush.Color := FPPHColor;
    Canvas.Pen.Color := FPPHColor;
    Canvas.Rectangle(0, PosPPH, Width, Height);


    Canvas.Pen.Color := TankSettings.PenColor;
    Canvas.Pen.Width := TankSettings.PenWidth * 2;
    Canvas.Brush.Style := bsClear;
    if TankSettings.Style = tsHorizontal then
    begin
      r1 := Width div 3;
      r2 := Height;
      Canvas.RoundRect(ClientRect.Left, ClientRect.Top,
        ClientRect.Right, ClientRect.Bottom, r1, r2);
    end
    else
      if TankSettings.Style = tsVertical then
      begin
        r1 := Width;
        r2 := Height div 3;
        Canvas.RoundRect(ClientRect.Left, ClientRect.Top,
          ClientRect.Right, ClientRect.Bottom, r1, r2);
      end
      else
        if TankSettings.Style = tsRectangle then
        begin
          Canvas.Rectangle(ClientRect.Left, ClientRect.Top,
            ClientRect.Right + 1, ClientRect.Bottom + 1);
        end
        else
          if TankSettings.Style = tsRoundRect then
          begin
            if Width < Height then
            begin
              r1 := Width div 3;
            end
            else
            begin
              r1 := Height div 3;
            end;
            Canvas.RoundRect(ClientRect.Left, ClientRect.Top,
              ClientRect.Right, ClientRect.Bottom, r1, r1);
          end
          else
            if TankSettings.Style = tsCrater then
            begin
              r1 := (Width - TankSettings.FCraterWidth) div 2;
              crater[1] := Point(ClientRect.Left, ClientRect.Top);
              crater[2] := Point(ClientRect.Right, ClientRect.Top);
              crater[3] := Point(ClientRect.Left + r1 +
                TankSettings.FCraterWidth,
                ClientRect.Bottom - TankSettings.FCraterWidth div 2);
              crater[4] := Point(ClientRect.Left + r1 +
                TankSettings.FCraterWidth,
                ClientRect.Bottom);
              crater[5] := Point(ClientRect.Left + r1, ClientRect.Bottom);
              crater[6] := Point(ClientRect.Left + r1, ClientRect.Bottom -
                TankSettings.FCraterWidth div 2);

              Canvas.Polygon(crater);
            end
            else
              if TankSettings.Style = tsEllipse then
              begin
                Canvas.Ellipse(ClientRect.Left, ClientRect.Top,
                  ClientRect.Right, ClientRect.Bottom);
              end;

    if opValue in FOptions then
    begin
      Canvas.Font := Font;
      sValue.cx := Canvas.TextWidth(SignalSettings.ValueSizeStr);
      sValue.cy := Canvas.Textheight(SignalSettings.ValueSizeStr);
      if opUnit in FOptions then
        sUnit.cx := Canvas.TextWidth(SignalSettings.ValueUnit)
      else
        sUnit.cx := 0;
      sUnit.cy := Canvas.Textheight(SignalSettings.ValueUnit);

      h := FBevelValue.TotalWidth * 2 + sValue.cy;
      w := sValue.cy div 3;
      rValue.Left := (r.Left + (r.Right - r.Left - sValue.cx - sUnit.cx - w) div
        2 - w) + VIndOffsX;
      rValue.Top := (r.Top + (r.Bottom - r.Top - h) div 2) + VIndOffsY;
      rValue.Right := rValue.Left + sValue.cx + BevelValue.TotalWidth * 2 + w +
        w;
      rValue.Bottom := rValue.Top + h;

      FBevelValue.PaintFilledBevel(Canvas, rValue);

      Canvas.Font.Color := FFontUnitCol;
      Canvas.Brush.Style := bsClear;
      if opUnit in FOptions then
        Canvas.textout(rValue.Right + w, rValue.Top, SignalSettings.ValueUnit);
      rValue.Left := rValue.Left + w;
      rValue.Right := rValue.Right - w;

      Canvas.Font.Color := Font.Color;
      if csDesigning in Componentstate then
        AbTextOut(TempBmp.Canvas, rValue.Right, rValue.Top,
          SignalSettings.ValueSizeStr, toTopRight)
      else
        AbTextOut(TempBmp.Canvas, rValue.Right, rValue.Top, ValueStr,
          toTopRight);

    end;
  end;

  SelectClipRgn(Canvas.Handle, ClipRgn);
  Canvas.Draw(0, 0, TempBmp);
  TempBmp.Free;

end;

procedure TAbTank.ParamChange(Sender: TObject);
begin
  inherited ParamChange(Sender);
  Invalidate;
end;

procedure TAbTank.Change2(Sender: TObject);
begin
  if (csDesigning in componentState) then ParamChange(self) else ValueChange;
end;

end.