abvmeter.pas

来自「著名的虚拟仪表控件,包含全部源码, 可以在,delphi2007 下安装运行」· PAS 代码 · 共 677 行 · 第 1/2 页

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

  if (SectorSettings.Sector2To - SectorSettings.Sector2From > 0) and
    (SectorSettings.Sector2To > 0) and (SectorSettings.Sector2From < 1000) then
  begin
    can.Brush.Color := SectorSettings.Sector2Color;
    y1 := Round(PPP * AbMaxInt(0, SectorSettings.Sector2From)) - 1;
    y2 := Round(PPP * AbMinInt(1000, SectorSettings.Sector2To));
    can.Rectangle(rSector.Left, rSector.Bottom - y1, rSector.Right,
      rSector.Bottom - y2);
  end;

  if (SectorSettings.Sector3To - SectorSettings.Sector3From > 0) and
    (SectorSettings.Sector3To > 0) and (SectorSettings.Sector3From < 1000) then
  begin
    can.Brush.Color := SectorSettings.Sector3Color;
    y1 := Round(PPP * AbMaxInt(0, SectorSettings.Sector3From)) - 1;
    y2 := Round(PPP * AbMinInt(1000, SectorSettings.Sector3To));
    can.Rectangle(rSector.Left, rSector.Bottom - y1, rSector.Right,
      rSector.Bottom - y2);
  end;

  can.Pen.Style := psSolid;

end;

procedure TAbVMeter.PointerFlash;
begin
  if isToSmall then Exit;
  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 TAbVMeter.OverflowChange(PPT: Integer);
begin
  PointerFlash;
end;

procedure TAbVMeter.LimitChange;
begin
  PointerFlash;
end;

procedure TAbVMeter.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 TAbVMeter.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 := FontValue;
  sValue.cx := Canvas.TextWidth(SignalSettings.ValueSizeStr);
  sValue.cy := Canvas.Textheight(SignalSettings.ValueSizeStr);
  sUnit.cx := Canvas.TextWidth(SignalSettings.ValueUnit);
  sUnit.cy := Canvas.Textheight(SignalSettings.ValueUnit);
  if not (opUnit in FOptions) then sUnit.cx := 0;

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

  if opBevelOuter in FOptions then
  begin
    min_h := BevelOuter.TotalWidth * 2
      + ScaleSettings.minHeight + ScaleSettings.sl1;

    w := BevelOuter.TotalWidth * 2;
  end
  else
  begin
    min_h := ScaleSettings.minHeight;
    w := 0;
  end;
  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 + ScaleSettings.sl1 div 2 + 1);

  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 div 3);
  end;


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

end;


procedure TAbVMeter.Paint;
var
  rScale, r, rS     : TRect;
  h, w, x1, x2, Offset: Smallint;
  space             : Smallint;

begin
  if (UpdateCount <> 0) then exit;
  CalcSize;

  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);
  rBuffer := r;                         // Meter inner Rectangle

  Offset := ScaleSettings.sl1;
  r.Top := r.Top + Offset div 2;
  r.Bottom := r.Bottom - Offset div 2 - 1;

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

  x2 := 30;

  rScale := r;
  rScale.Bottom := rScale.Bottom;
  x1 := (Width - FScaleSettings.TotalWidth - ScaleSettings.sl1 div 2) div 2;


  if FScaleSettings.PosLeftTop then
  begin
    rScale.Left := x1;
    rScale.Right := rScale.Left + FScaleSettings.TotalWidth;
    rPointer.Left := rScale.Right - ScaleSettings.sl1 div 2;
    rPointer.Right := rPointer.Left + ScaleSettings.sl1;
    rPointer.Top := rScale.Top - ScaleSettings.sl1 div 2;
    rPointer.Bottom := rScale.Bottom + ScaleSettings.sl1 div 2 + 1;
    if opSector in Options then
    begin
      rS := rScale;
      rS.Left := rS.Right - FScaleSettings.sl2 + 1;
      rS.Right := rS.Right;
      DrawVSector(Canvas, rS);
    end;
    FScaleSettings.VertiScala(Canvas, rScale);
    r.Left := rScale.Left;
    r.Right := r.Left + x2;
  end
  else
  begin
    rScale.Left := x1 + ScaleSettings.sl1 div 2;
    rScale.Right := rScale.Left + FScaleSettings.TotalWidth;
    rPointer.Left := rScale.Left - ScaleSettings.sl1 div 2;
    rPointer.Right := rPointer.Left + ScaleSettings.sl1;
    rPointer.Top := rScale.Top - ScaleSettings.sl1 div 2;
    rPointer.Bottom := rScale.Bottom + ScaleSettings.sl1 div 2;
    if opSector in Options then
    begin
      rS := rScale;
      rS.Left := rS.Left;
      rS.Right := rS.Left + FScaleSettings.sl2;
      DrawVSector(Canvas, rS);
    end;
    FScaleSettings.VertiScala(Canvas, rScale);
    r.Right := rScale.Left - ScaleSettings.BarSpace;
  end;

  GetBkUpImage(Canvas,BmpBuffer,rBuffer);

  AltPosPointer := -1;
  ValueChange;
end;

procedure TAbVMeter.ValueChange;
var
  TempBmp           : TBitmap;
begin
  inherited ValueChange;
  if isToSmall then exit;
  if not (Visible or (csDesigning in Componentstate)) then Exit;

  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);
    TempBmp.Free;
  end;
  if Canvas <> nil then DrawPointer(Canvas);

end;


procedure TAbVMeter.ParamChange(Sender: TObject);

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


end.