abrmeter.pas

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

  if (SectorSettings.Sector2To - SectorSettings.Sector2From > 4) and
    (SectorSettings.Sector2To > 0) and (SectorSettings.Sector2From < 1000) then
  begin
    can.Brush.Color := SectorSettings.Sector2Color;
    can.Pen.Color := SectorSettings.Sector2Color;
    if (SectorSettings.Sector2From < 0) then
    begin
      A1 := A;
      A2 := Round(WPP * AbMinInt(1000, SectorSettings.Sector2To));
    end
    else
    begin
      A1 := A + Round(WPP * SectorSettings.Sector2From);
      A2 := Round(WPP * (AbMinInt(1000, SectorSettings.Sector2To) -
        SectorSettings.Sector2From));
    end;
    AbRoundSector(can, rSector, A1, A2);
  end;

  if (SectorSettings.Sector3To - SectorSettings.Sector3From > 4) and
    (SectorSettings.Sector3To > 0) and (SectorSettings.Sector3From < 1000) then
  begin
    can.Brush.Color := SectorSettings.Sector3Color;
    can.Pen.Color := SectorSettings.Sector3Color;
    if (SectorSettings.Sector3From < 0) then
    begin
      A1 := A;
      A2 := Round(WPP * AbMinInt(1000, SectorSettings.Sector3To));
    end
    else
    begin
      A1 := A + Round(WPP * SectorSettings.Sector3From);
      A2 := Round(WPP * (AbMinInt(1000, SectorSettings.Sector3To) -
        SectorSettings.Sector3From));
    end;
    AbRoundSector(can, rSector, A1, A2);
  end;


  DeleteObject(regn1);
  regn1 := CreateRectRgnIndirect(Cliprect);
  SelectClipRgn(can.Handle, regn1);

  DeleteObject(KombiRgn);
  DeleteObject(regn1);
  DeleteObject(regn2);

  Can.Pen.Color := ScaleSettings.Color;
  Can.Pen.Width := ScaleSettings.PenW1;
  can.Brush.Style := bsClear;

  if ScaleSettings.DrawLine then
    if MeterType <> Ab360Meter then begin
      can.Arc(ScaleSettings.LinePos[0].x, ScaleSettings.LinePos[0].y,
        ScaleSettings.LinePos[1].x, ScaleSettings.LinePos[1].y,
        ScaleSettings.LinePos[2].x, ScaleSettings.LinePos[2].y,
        ScaleSettings.LinePos[3].x, ScaleSettings.LinePos[3].y);
    end else
      can.Ellipse(rSector.Left, rSector.Top, rSector.Right, rSector.Bottom);
end;


procedure TAbRMeter.CalcSize;
var
  w                 : Smallint;
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;

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

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

  if AutoSize then
  begin
    min_w := ScaleSettings.TextH * 10;
  end
  else
  begin
    w := Width;
    if opBevelOuter in FOptions then w := w - BevelOuter.TotalWidth * 2;
    if opBevelInner in FOptions then w := w - BevelInner.TotalWidth * 2;
    min_w := w;
    min_w := AbMaxInt(min_w, ScaleSettings.TextH * 7);
  end;
  min_h := Round((min_w - ScaleSettings.TextW) / HeightFactor +
    ScaleSettings.TextH);


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

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

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


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

end;


procedure TAbRMeter.Paint;
var
  r, rTmp, rScl                 : TRect;
  y                 : Smallint;
  space             : Smallint;
  n                 : Integer;
  ah                : Integer;          // arrow half
begin
  if UpdateCount <> 0 then exit;
  CalcSize;

  PPTOld := -1;

  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);

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

  rScl := r;
  if MeterType = Ab180Meter then begin
    rPointer.Bottom := r.Bottom + BevelInner.Spacing;
    ScaleSettings.RoundScala(Canvas, r, StartAngle, RotAngle);
    rPointer.Top := r.Top;
    rPointer.Left := r.Left;
    rPointer.Right := r.Right;
  end else if MeterType = Ab120Meter then begin
    r.Left := r.Left - (r.Right - r.Left) div 20;
    r.Right := r.Right + (r.Right - r.Left) div 20;
    rScl := r;
    rPointer.Bottom := r.Bottom + BevelInner.Spacing;
    ScaleSettings.RoundScala(Canvas, r, StartAngle, RotAngle);
    rPointer.Top := r.Top;
    rPointer.Left := r.Left;
    rPointer.Right := r.Right;
  end else begin                               {Meter 270 + 360}
    ScaleSettings.RoundScala(Canvas, r, StartAngle, RotAngle);
    rPointer := r;
    if MeterType = Ab120Meter then
      rPointer.Bottom := rPointer.Bottom - ScaleSettings.Font.Size;

  end;


  if opSector in Options then
  begin
   // Offset := ScaleSettings.sl1;
     rTmp := r;
    AbBorder(rTmp,ScaleSettings.sl1 + SectorSettings.Offset);
    DrawRSector(Canvas, rTmp);
  end;


  if SectorSettings.Offset < 0 then
    ScaleSettings.RoundScala(Canvas, rScl, StartAngle, RotAngle);

  if opUnit in Options then
  begin
    if (MeterType = Ab270Meter) then
    begin
      y := Round((Width - ScaleSettings.TextW) / 1.18 - ScaleSettings.TextH);
    end
    else
      y := r.Top + Round(((r.Right - r.Left)) / 3 - (ScaleSettings.TextH / 2));

    Canvas.Font := FontUnit;
    Canvas.Font.Color := FontUnit.Color;
    Canvas.Brush.Style := bsClear;
    Canvas.textout(r.Left + (r.Right - r.Left - sUnit.cx) div 2, y,
      SignalSettings.ValueUnit);
  end;

  AbArrowField(FArrowSettings.Shape, ScaleSettings.sl1 div 2, rPointer,
    ArrowStartPos);

  for n := 2 to lo(ArrowStartPos[0].x) do {turn Arrow into startposition}
    ArrowStartPos[n] := AbRotate(ArrowStartPos[n], ArrowStartPos[1],
      StartAngle, true);

  GetBkUpImage(Canvas, BmpPointerArea, rPointer);

  ah := Round(FScaleSettings.sl1 * 0.6);
  minPointerStart[0].x := ArrowStartPos[1].x;
  minPointerStart[0].y := FScaleSettings.sl1 + ah;
  minPointerStart[1].x := minPointerStart[0].x;
  minPointerStart[1].y := 1;
  minPointerStart[2].x := minPointerStart[0].x - ah;
  minPointerStart[2].y := 1;

  maxPointerStart[0].x := minPointerStart[0].x;
  maxPointerStart[0].y := minPointerStart[0].y;
  maxPointerStart[1].x := minPointerStart[0].x;
  maxPointerStart[1].y := minPointerStart[1].y;
  maxPointerStart[2].x := minPointerStart[0].x + ah;
  maxPointerStart[2].y := minPointerStart[2].y;

  minPointerStart[0] := AbRotate(minPointerStart[0], ArrowStartPos[1],
    StartAngle, true);
  minPointerStart[1] := AbRotate(minPointerStart[1], ArrowStartPos[1],
    StartAngle, true);
  minPointerStart[2] := AbRotate(minPointerStart[2], ArrowStartPos[1],
    StartAngle, true);
  maxPointerStart[0] := AbRotate(maxPointerStart[0], ArrowStartPos[1],
    StartAngle, true);
  maxPointerStart[1] := AbRotate(maxPointerStart[1], ArrowStartPos[1],
    StartAngle, true);
  maxPointerStart[2] := AbRotate(maxPointerStart[2], ArrowStartPos[1],
    StartAngle, true);

  ValueChange;
end;

procedure TAbRMeter.ValueChange;
begin
  vChange := true;
  inherited ValueChange;
  if isToSmall then Exit;

  if Assigned(BmpPointerArea) and Visible then
  begin
    DrawPointer(Canvas, FScaleSettings.PointerColor);
    PPTOld := PPT;
  end;
  vChange := false;

end;

procedure TAbRMeter.DrawPointer(can: TCanvas; Col: TColor);
var
  TempBmp           : TBitmap;
  cl                : TColor;
  Pos, posMin, posMax : Single;
  //posUL, posLL: Single;
begin
  if isToSmall then Exit;

  if Assigned(BmpPointerArea) then
  begin
    if BmpPointerArea.Width < 2 then Exit;

    TempBmp := TBitmap.Create;
    TempBmp.Assign(BmpPointerArea);

    Pos := (RotAngle / 1000) * PPT;
    posMax := (RotAngle / 1000) * MaxPPT;
    posMin := (RotAngle / 1000) * MinPPT;

    {  calculation of lower/upper limitation
    posUL := (RotAngle / 1000) * ULimitPPT;
    posLL := (RotAngle / 1000) * LLimitPPT;
    }

    minPointer[0] := AbRotate(minPointerStart[0], ArrowStartPos[1], posMin,
      true);
    minPointer[1] := AbRotate(minPointerStart[1], ArrowStartPos[1], posMin,
      true);
    minPointer[2] := AbRotate(minPointerStart[2], ArrowStartPos[1], posMin,
      true);
    maxPointer[0] := AbRotate(maxPointerStart[0], ArrowStartPos[1], posMax,
      true);
    maxPointer[1] := AbRotate(maxPointerStart[1], ArrowStartPos[1], posMax,
      true);
    maxPointer[2] := AbRotate(maxPointerStart[2], ArrowStartPos[1], posMax,
      true);


    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 Flashing then
    begin
      TempBmp.Canvas.Brush.Color := FlashColor;
      if (hi(ArrowStartPos[0].x) and 1 > 0) then
        TempBmp.Canvas.Pen.Color := FlashColor
      else
        TempBmp.Canvas.Pen.Color := FArrowSettings.ColorPen;

    end
    else
    begin
      TempBmp.Canvas.Pen.Color := FArrowSettings.ColorPen;
      TempBmp.Canvas.Brush.Color := FArrowSettings.ColorBrush;
    end;

    AbArrowDraw(TempBmp.Canvas, Pos, ArrowStartPos, ArrowActPos, true);

      {draw circle at centerpoint if diameter > 0}
    if lo(ArrowStartPos[0].y) > 0 then
    begin
      TempBmp.Canvas.Brush.Color := FArrowSettings.ColorCP1Brush;
      TempBmp.Canvas.Pen.Color := FArrowSettings.ColorCP1Pen;
      TempBmp.Canvas.Ellipse(ArrowActPos[1].x - lo(ArrowStartPos[0].y),
        ArrowActPos[1].y - lo(ArrowStartPos[0].y),
        ArrowActPos[1].x + lo(ArrowStartPos[0].y),
        ArrowActPos[1].y + lo(ArrowStartPos[0].y));
    end;

    if hi(ArrowStartPos[0].y) > 0 then
    begin
      TempBmp.Canvas.Brush.Color := FArrowSettings.ColorCP2Brush;
      TempBmp.Canvas.Pen.Color := FArrowSettings.ColorCP2Pen;
      TempBmp.Canvas.Ellipse(ArrowActPos[1].x - hi(ArrowStartPos[0].y),
        ArrowActPos[1].y - hi(ArrowStartPos[0].y),
        ArrowActPos[1].x + hi(ArrowStartPos[0].y),
        ArrowActPos[1].y + hi(ArrowStartPos[0].y));
    end;

    if can <> nil then can.Draw(rPointer.Left, rPointer.Top, TempBmp);
    TempBmp.Free;
  end;

end;


procedure TAbRMeter.ParamChange(Sender: TObject);
begin
  inherited ParamChange(Sender);
  if UpdateCount = 0 then Invalidate;
end;

end.