abhmeter.pas

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

end;

procedure TAbHMeter.DrawHSector(can: TCanvas; rSector: TRect);
var
  w, x1, x2         : Smallint;
  PPP               : Single;
begin
  w := rSector.Right - rSector.Left;
  PPP := w / 1000;
  can.Brush.Style := bsSolid;
  can.Pen.Style := psClear;


  if (SectorSettings.Sector1To - SectorSettings.Sector1From > 0) and
    (SectorSettings.Sector1To > 0) and (SectorSettings.Sector1From < 1000) then
  begin
    can.Brush.Color := SectorSettings.Sector1Color;
    can.Pen.Color := SectorSettings.Sector1Color;
    x1 := Round(PPP * AbMaxInt(0, SectorSettings.Sector1From));
    x2 := Round(PPP * AbMinInt(1000, SectorSettings.Sector1To)) + 1;
    can.Rectangle(rSector.Left + x1, rSector.Top, rSector.Left + x2,
      rSector.Bottom);
  end;

  if (SectorSettings.Sector2To - SectorSettings.Sector2From > 0) and
    (SectorSettings.Sector2To > 0) and (SectorSettings.Sector2From < 1000) then
  begin
    can.Brush.Color := SectorSettings.Sector2Color;
    can.Pen.Color := SectorSettings.Sector2Color;
    x1 := Round(PPP * AbMaxInt(0, SectorSettings.Sector2From));
    x2 := Round(PPP * AbMinInt(1000, SectorSettings.Sector2To)) + 1;
    can.Rectangle(rSector.Left + x1, rSector.Top, rSector.Left + x2,
      rSector.Bottom);
  end;
  if (SectorSettings.Sector3To - SectorSettings.Sector3From > 0) and
    (SectorSettings.Sector3To > 0) and (SectorSettings.Sector3From < 1000) then
  begin
    can.Brush.Color := SectorSettings.Sector3Color;
    can.Pen.Color := SectorSettings.Sector3Color;
    x1 := Round(PPP * AbMaxInt(0, SectorSettings.Sector3From));
    x2 := Round(PPP * AbMinInt(1000, SectorSettings.Sector3To)) + 1;
    can.Rectangle(rSector.Left + x1, rSector.Top, rSector.Left + x2,
      rSector.Bottom);
  end;

  can.Pen.Style := psSolid;

end;

procedure TAbHMeter.PointerFlash;
begin
  if ((opOverflow in Options) and ((PPT > 1000) or (PPT < 0)))
    or ((opLimit in Options) and (LLimit or ULimit)) then
  begin
    AddControl(self, Freq2Hz);
    Flashing := true;
  end
  else
  begin
    Flashing := false;
    DelControl(self);
    AltPosPointer := -1;
    if Visible then DrawPointer(Canvas);
  end;
end;

procedure TAbHMeter.OverflowChange(PPT: Integer);
begin
  PointerFlash;
end;

procedure TAbHMeter.LimitChange;
begin
  PointerFlash;
end;



procedure TAbHMeter.WMFlash(var Message: TMessage);
begin
  with Message do
  begin
    if isToSmall then Exit;
    if (opOverflow in Options) and Visible then
    begin

      if lParam <> 0 then
        FlashColor := cAlarm1
      else
        FlashColor := cAlarm0;
      Canvas.Brush.Color := FlashColor;

      Canvas.Pen.Color := clBlack;
      Canvas.Pen.Width := 1;
      Canvas.Polygon(Zeiger2);
    end;
  end;
end;

procedure TAbHMeter.CalcSize;
var
  w                 : Smallint;

  procedure GetMin(var Min: Smallint; Value: Smallint);
  begin
    if Min < Value then Min := Value;
  end;

  procedure GetMax(var Max: Smallint; Value: Smallint);
  begin
    if Max < Value then Max := Value;
  end;
begin
  Canvas.Font := Font;
  sName1.cx := Canvas.TextWidth(SignalSettings.Name1);
  sName1.cy := Canvas.Textheight(SignalSettings.Name1);
  sName2.cx := Canvas.TextWidth(SignalSettings.Name2);
  sName2.cy := Canvas.Textheight(SignalSettings.Name2);

  Canvas.Font := FontUnit;

  sValue.cx := Canvas.TextWidth(SignalSettings.ValueSizeStr);
  sValue.cy := Canvas.Textheight(SignalSettings.ValueSizeStr);
  sUnit.cx := Canvas.TextWidth(SignalSettings.ValueUnit);
  sUnit.cy := Canvas.Textheight(SignalSettings.ValueUnit);

  FScaleSettings.CalcHSize(Canvas, SignalSettings.ValueFrom,
    SignalSettings.ValueTo);

  if opBevelOuter in FOptions then
  begin
    min_h := BevelOuter.TotalWidth * 2;

    w := BevelOuter.TotalWidth * 2;
  end
  else
  begin
    min_h := 0;
    w := 0;
  end;
  min_h := min_h + ScaleSettings.minHeight
    + ScaleSettings.sl1 div 2
    + ScaleSettings.TextH div 2;
  min_w := w;

  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 + ScaleSettings.TotalWidth);

  if opUnit in FOptions then
  begin
    min_h := min_h + sUnit.cy div 2;
  end;

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

end;


procedure TAbHMeter.Paint;
var
  r, rS             : TRect;
  x2                : Smallint;
  space             : Smallint;
begin
  CalcSize;
  x2 := 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;

  if opBevelInner in FOptions then FBevelInner.PaintFilledBevel(Canvas, r);
  rBuffer := r;                         // Meter inner Rectangle

  isToSmall := (r.right - r.left < 2) or (r.Bottom - r.top < 2);
  if not isToSmall then begin

    if FScaleSettings.PosLeftTop then
    begin
      rScale.Top := r.Top + ScaleSettings.sl1 div 2;
      rScale.Bottom := rScale.Top + ScaleSettings.minHeight;

      space := AbMaxInt(ScaleSettings.TextW,ScaleSettings.sl1) div 2 ;
      rScale.Left := r.Left + Space;
      rScale.Right := r.Right - Space -1 ;

      rPointer.Left := rScale.Left - ScaleSettings.sl1 div 2;
      rPointer.Right := rScale.Right + ScaleSettings.sl1 div 2;
      rPointer.Top := rScale.Bottom - ScaleSettings.sl1 div 2;
      rPointer.Bottom := rPointer.Top + ScaleSettings.sl1 + 1;


      if opSector in Options then
      begin
        rS := rScale;
        rS.Top := (rS.Bottom - FScaleSettings.sl2) + 2;
        rS.Bottom := rS.Top + FScaleSettings.sl2 - 1;
        DrawHSector(Canvas, rS);
      end;
      FScaleSettings.HorizScala(Canvas, rScale);
      r.Left := rScale.Left;
      r.Right := r.Left + x2;
      if opUnit in FOptions then
      begin
        Canvas.Font := FontUnit;
        Canvas.Font.Color := FontUnit.Color;
        Canvas.Brush.Style := bsClear;
        AbTextOut(Canvas, Width div 2, rPointer.Bottom - sUnit.cy div 5,
          SignalSettings.ValueUnit, toTopCenter);
      end;
    end
    else
    begin
      rScale.Top := r.Top + ScaleSettings.sl1 div 2;
      if opUnit in FOptions then
      begin
        rScale.Top := r.Top;
        Canvas.Font := FontUnit;
        Canvas.Font.Color := FontUnit.Color;
        Canvas.Brush.Style := bsClear;
        AbTextOut(Canvas, Width div 2, rScale.Top - sUnit.cy div 5,
          SignalSettings.ValueUnit, toTopCenter);
        rScale.Top := rScale.Top + Round(sUnit.cy / 1.8) +
          ScaleSettings.sl1 div 2 + 1;
      end;


      rScale.Bottom := r.Top + ScaleSettings.minHeight;
      space := AbMaxInt(ScaleSettings.TextW,ScaleSettings.sl1) div 2 ;
      rScale.Left := r.Left + Space;
      rScale.Right := r.Right - Space -1;
  //    rScale.Left := r.Left + ScaleSettings.TextW div 2;
  //    rScale.Right := r.Right - ScaleSettings.TextW div 2;

      rPointer.Left := rScale.Left - ScaleSettings.sl1 div 2;
      rPointer.Right := rScale.Right + ScaleSettings.sl1 div 2;
      rPointer.Top := rScale.Top - ScaleSettings.sl1 div 2 + 1;
      rPointer.Bottom := rPointer.Top + ScaleSettings.sl1;


      if opSector in Options then
      begin
        rS := rScale;
        rS.Top := rS.Top;
        rS.Bottom := rS.Top + FScaleSettings.sl2;
        DrawHSector(Canvas, rS);
      end;
      FScaleSettings.HorizScala(Canvas, rScale);
      r.Left := rScale.Left;
      r.Right := r.Left + x2;
    end;

     // save inner rect
    GetBkUpImage(Canvas,BmpBuffer,rBuffer);
  end; // if not isToSmall
  AltPosPointer := -1;

  if not isToSmall then ValueChange;

end;

procedure TAbHMeter.ValueChange;
begin
  inherited ValueChange;

  if Visible or (csDesigning in Componentstate) then DrawPointer(Canvas);
end;


procedure TAbHMeter.ParamChange(Sender: TObject);

begin
  inherited ParamChange(Sender);
  if UpdateCount = 0 then Invalidate;
end;

end.