abvbar.pas

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

  if opName1 in FOptions then
  begin
    min_h := min_h + sName1.cy;
    w := 0;
    if opBevelOuter in FOptions then w := BevelOuter.TotalWidth * 2;
    GetMin(min_w, w + sName1.cx);
  end;
  if opName2 in FOptions then
  begin
    min_h := min_h + sName2.cy;
    w := 0;
    if opBevelOuter in FOptions then w := BevelOuter.TotalWidth * 2;
    GetMin(min_w, w + sName2.cx);
  end;

  if opBevelInner in FOptions then
  begin
    min_h := min_h + BevelInner.TotalWidth * 2;
    w := w + BevelInner.TotalWidth * 2;
    GetMin(min_w, w);
  end;


  w := 0;
  if opBevelOuter in FOptions then w := w + BevelOuter.TotalWidth * 2;
  if opBevelInner in FOptions then w := w + BevelInner.TotalWidth * 2;
  GetMin(min_w, w + BarSettings.Bevel.TotalWidth * 2 + BarSettings.minWidth);

  if opValue in FOptions then
  begin
    min_h := min_h + sValue.cy + BevelValue.TotalWidth * 2 +
      BevelInner.TotalWidth;

    GetMin(min_w, w + sValue.cx + sUnit.cx + BevelValue.TotalWidth * 2 +
      sValue.cy);
  end;

  if not AutoSize and ((Width < min_w) or (Height < min_h)) then
  begin
    if Width < min_w then
    begin
      Width := min_w;
    end;
    if Height < min_h then
    begin
      Height := min_h;
    end;
  end;

  if AutoSize and ((Width <> min_w) or (Height <> min_h)) then
  begin
    SetBounds(Left, Top, min_w, min_h);
  end;

end;

procedure TAbVBar.Paint;
var
  r                 : TRect;
  h, w, x2, Offset  : Smallint;
  space             : Smallint;
begin

  CalcSize;
  w := 0;
  r := ClientRect;

  if opBevelOuter in FOptions then
  begin
    FBevelOuter.PaintFilledBevel(Canvas, r);
    space := BevelOuter.Spacing div 2;
  end
  else
    space := 0;

  Canvas.Brush.Style := bsClear;
  Canvas.Font := Font;
  if opName2 in FOptions then
  begin
    r.Bottom := r.Bottom - sName2.cy;
    Canvas.textout(r.Left + ((r.Right - r.Left - sName2.cx) div 2),
      r.Bottom + space, SignalSettings.Name2);
  end;
  if opName1 in FOptions then
  begin
    r.Bottom := r.Bottom - sName1.cy;
    Canvas.textout(r.Left + ((r.Right - r.Left - sName1.cx) div 2),
      r.Bottom + space, SignalSettings.Name1);
  end;

  Canvas.Font := FontValue;
  if opValue in FOptions then
  begin
    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;
    rValue.Top := r.Top;
    rValue.Right := rValue.Left + sValue.cx + BevelValue.TotalWidth * 2 + w + w;
    rValue.Bottom := r.Top + h;
    FBevelValue.PaintFilledBevel(Canvas, rValue);

    Canvas.Font.Color := Font.Color;
    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;

    r.Top := r.Top + h + BevelOuter.Spacing;

  end;
  if opBevelInner in FOptions then FBevelInner.PaintFilledBevel(Canvas, r);



  Offset := 0;
  r.Top := r.Top + Offset div 2;
  r.Bottom := r.Bottom - Offset div 2;


  if (opOverflow in Options) then
  begin
    w := BarSettings.minWidth + BarSettings.Bevel.TotalWidth * 2 - 1;
    if (w + 2) > Offset then
      Offset := w - Offset + 6
    else
      Offset := 0;
    r.Top := r.Top + Offset div 2;
    r.Bottom := r.Bottom - Offset div 2;
  end
  else
    if (MinMax.MinVisible or MinMax.MaxVisible) then
    begin
      r.Top := r.Top + wMinMax div 2;
      r.Bottom := r.Bottom - wMinMax div 2;
    end;


  x2 := BarSettings.Bevel.TotalWidth * 2 + BarSettings.minWidth;

  if (MinMax.MinVisible or MinMax.MaxVisible) then
  begin
    r.Left := (Width - x2 - wMinMax) div 2 + 1;
    r.Right := r.Left + x2;
  end
  else
  begin
    r.Left := (Width - x2) div 2;
    r.Right := r.Left + x2;
  end;

  if opOverflow in Options then
  begin
    h := r.Top - 3;

    pUOverflow[0] := Point(r.Left, h);
    pUOverflow[1] := Point(r.Left + w, h);
    pUOverflow[2] := Point(r.Left + w div 2, h - w div 2);
    pUOverflow[3] := pUOverflow[0];

    h := r.Bottom + 2;
    pLOverflow[0] := Point(r.Left, h);
    pLOverflow[1] := Point(r.Left + w, h);
    pLOverflow[2] := Point(r.Left + w div 2, h + w div 2);
    pLOverflow[3] := pLOverflow[0];

    DrawOverflow(Canvas, clBtnFace, clBtnFace);
  end;


  FBarSettings.Bevel.PaintFilledBevel(Canvas, r);
  FBarSettings.BarRect := r;

  pos0 := r.Top;
  pos100 := r.Bottom;

  rBuffer.Left := r.Right;
  rBuffer.Right := r.Right + wMinMax + 1;
  rBuffer.Top := r.Top - wMinMax div 2 - 1;
  rBuffer.Bottom := r.Bottom + wMinMax div 2 + 1;

  BmpBuffer.Width := rBuffer.Right - rBuffer.Left;
  BmpBuffer.Height := rBuffer.Bottom - rBuffer.Top;
  //BmpBuffer.Canvas.CopyRect(BmpBuffer.Canvas.Cliprect, Canvas, rBuffer);
  GetBkUpImage(Canvas,BmpBuffer,rBuffer);

  ValueChange;

end;


procedure TAbVBar.ValueChange;
var
  TempBmp           : TBitmap;
  posMin, posMax : Smallint;
  //posUL, posLL: Smallint;
  PixPerPPT         : Single;
  y1, y2            : Integer;
  cl                : TColor;
begin
  inherited ValueChange;
  if Assigned(BmpBuffer) then
    if BmpBuffer.Width < 2 then Exit;
  if Canvas = nil then exit;
  
  if not (Visible or (csDesigning in Componentstate)) then Exit;
  BarSettings.Value := ValueStr;

  y1 := pos0 - rBuffer.Top;
  y2 := (pos100 - rBuffer.Top);
  PixPerPPT := (((y2 - y1) + 1) / 1000);

  posMax := y2 - Round(PixPerPPT * MaxPPT);
  posMin := y2 - Round(PixPerPPT * MinPPT);

    {  calculation of lower/upper limitation
  posUL := y2 - Round(PixPerPPT * ULimitPPT);
  posLL := y2 - Round(PixPerPPT * LLimitPPT);
  }

  TempBmp := TBitmap.Create;
  TempBmp.Assign(BmpBuffer);
  if (TempBmp.Width < 1) or (TempBmp.Height < 1) then Exit;

  minPointer[0].x := 0;
  minPointer[0].y := posMin;
  minPointer[1].x := minPointer[0].x + wMinMax;
  minPointer[1].y := posMin;
  minPointer[2].x := minPointer[1].x;
  minPointer[2].y := posMin + wMinMax div 2;

  maxPointer[0].x := 0;
  maxPointer[0].y := posMax;
  maxPointer[1].x := maxPointer[0].x + wMinMax;
  maxPointer[1].y := posMax;
  maxPointer[2].x := maxPointer[1].x;
  maxPointer[2].y := posMax - wMinMax div 2;

  if MinMax.FMinVisible then
  begin
    if MinMax.UseSectorCol and SectorSettings.CheckSectorColor(MinPPT, cl) then
      TempBmp.Canvas.Brush.Color := cl
    else
      TempBmp.Canvas.Brush.Color := MinMax.FMinColor;
    TempBmp.Canvas.Polygon(minPointer);
  end;

  if MinMax.FMaxVisible then
  begin
    if MinMax.UseSectorCol and SectorSettings.CheckSectorColor(MaxPPT, cl) then
      TempBmp.Canvas.Brush.Color := cl
    else
      TempBmp.Canvas.Brush.Color := MinMax.FMaxColor;
    TempBmp.Canvas.Polygon(maxPointer);
  end;

  if Canvas <> nil then Canvas.Draw(rBuffer.Left, rBuffer.Top, TempBmp);
  //TempBmp.Free;

  if (opUseSectorCol in FBarSettings.Options)
    and (InSector1 or InSector2 or InSector3) then
    FBarSettings.SectorCol := ActSectorCol
  else
    FBarSettings.SectorCol := FBarSettings.Color;

  FBarSettings.PaintBar(Canvas, PPT);
  if opValue in FOptions then
  begin
    //TempBmp := TBitmap.Create;
    TempBmp.Width := rValue.Right - rValue.Left;
    TempBmp.Height := rValue.Bottom - rValue.Top;
    TempBmp.Canvas.Font := FontValue;
    with TempBmp.Canvas do
    begin
      Brush.Style := bsSolid;
      Brush.Color := FBevelValue.Color;
      Pen.Color := FBevelValue.Color;
      Rectangle(0, 0, Width, Height);
      Brush.Style := bsClear;
      if csDesigning in Componentstate then
        textout(TempBmp.Width - TextWidth(SignalSettings.ValueSizeStr), 0,
          SignalSettings.ValueSizeStr)
      else
        textout(TempBmp.Width - TextWidth(ValueStr), 0, ValueStr);
    end;
    if Canvas <> nil then Canvas.Draw(rValue.Left, rValue.Top, TempBmp);
  end;
  TempBmp.Free;

end;

procedure TAbVBar.ParamChange(Sender: TObject);
begin
  inherited ParamChange(Sender);
  if Assigned(BarSettings) then BarSettings.ppt0 := SignalSettings.GetPPT(0);
  Invalidate;
end;


end.