abtrend.pas

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

  Bmp.Canvas.Pen.Mode := FCursorLinePenMode;
  Bmp.Canvas.moveTo(CursorX-x, -1);

  if (opDate in Options) and (opTime in Options) then
    Bmp.Canvas.LineTo(CursorX-x, Bmp.Height - hRelScaleFont * 2 - 2)
  else if (opDate in Options) or (opTime in Options) then
    Bmp.Canvas.LineTo(CursorX-x, Bmp.Height - hRelScaleFont - 2)
  else
    Bmp.Canvas.LineTo(CursorX-x, Bmp.Height);

  Canvas.Draw(rTrend.Left+x, rTrend.Top, Bmp);
  CursorLastX := CursorX;

  Bmp.Free;
end;       }

procedure TAbTrend.DrawCursorLine(Full : Boolean);
var
  Bmp               : TBitmap;
  x, x2 : Integer;
begin
  if Full then begin
    x := 0;
    x2 := BmpTrend.Width;
  end else begin
    if CursorLastX < CursorX then begin
       x  := CursorLastX;
       x2 := CursorX+1;
    end else begin
       x2 := CursorLastX+1;
       x  := CursorX;
    end;
  end;

  Bmp := TBitmap.Create;
  Bmp.Width := x2 - x;
  Bmp.Height := BmpTrend.Height;

  //Bmp.Canvas.Draw(x,0, BmpTrend);
  Bmp.Canvas.CopyRect(Rect(0,0,Bmp.Width,Bmp.Height),BmpTrend.Canvas,Rect(x,0,x2,Bmp.Height));

  Bmp.Canvas.Pen.Color := ColorCursorLine;
  Bmp.Canvas.Pen.Mode := FCursorLinePenMode;
  Bmp.Canvas.moveTo(CursorX-x, -1);

  if (opDate in Options) and (opTime in Options) then
    Bmp.Canvas.LineTo(CursorX-x, Bmp.Height - hRelScaleFont * 2 - 2)
  else if (opDate in Options) or (opTime in Options) then
    Bmp.Canvas.LineTo(CursorX-x, Bmp.Height - hRelScaleFont - 2)
  else
    Bmp.Canvas.LineTo(CursorX-x, Bmp.Height);

  Canvas.Draw(rTrend.Left+x, rTrend.Top, Bmp);
  CursorLastX := CursorX;

  Bmp.Free;
end;


procedure TAbTrend.SetCursorLine(x, y: Integer);
var
  n                 : Integer;
  ARecord: PSignRec;
begin
  if (not (opCursorOnRec in FOptions) and Flowing) or (not CursorLine) or GetNewData  then
    Exit;

  if (CursorX = x - rTrend.Left) then exit;    // no change
  CursorLinePos := x - rTrend.Left + TrendOffset;
  CursorX := x - rTrend.Left;

  if AbInRect(x, y, rTrend) then
  begin
    if (CursorLinePos >= (RecordList.Count)) or (CursorLinePos < 0) then
    begin
      inTrend := false;
      ValueAtCursor.FDataValid := false;
      if Assigned(FOnNewCursorPos) then FOnNewCursorPos(self);
      //Canvas.Draw(rTrend.Left, rTrend.Top, BmpTrend);
    end    // if (CursorLinePos >= (RecordList.Count)) or (CursorLinePos < 0)
    else
    begin
      inTrend := true;
      DrawCursorLine(false);
      ARecord := RecordList.Items[CursorLinePos];
            {check for separator-line}
      ValueAtCursor.FDataValid := (ARecord^.Time <> sepTime);
      ValueAtCursor.FRecordNo := CursorLinePos;
      ValueAtCursor.FTime := ARecord^.Time;

      for n := 1 to 8 do
        ValueAtCursor.FValueCh[n] :=
          FChannel[n].AbsDigitToValue(ARecord^.Ch[n]);
      if Assigned(FOnNewCursorPos) then FOnNewCursorPos(self);
    end;
  end
  else  // if AbInRect(x, y, rTrend) then
    if inTrend then
    begin
      inTrend := false;
      ValueAtCursor.FDataValid := false;
      if Assigned(FOnNewCursorPos) then FOnNewCursorPos(self);
      Canvas.Draw(rTrend.Left, rTrend.Top, BmpTrend);
    end;

end;

procedure TAbTrend.MouseMove(Shift: TShiftState; x, y: Integer);
begin
  inherited MouseMove(Shift, x, y);
  SetCursorLine(x, y);
end;


procedure TAbTrend.SetGridYSteps(Value: Integer);
begin
  if (FGridYSteps <> Value) and (Value <= 10) and (Value > 0) then
  begin
    FGridYSteps := Value;
    Change;
  end;

end;

procedure TAbTrend.SetGridXPixel(Value: Integer);
begin
  if (FGridXPixel <> Value) and (Value >= 30) then
  begin
    FGridXPixel := Value;
    DrawGrid(rTrend, true);
    Canvas.Draw(rTrend.Left, rTrend.Top, BmpTrend);
  end;
end;

procedure TAbTrend.SetYOffset(Value: Integer);
begin
  if FYOffset <> Value then
  begin
    FYOffset := Value;
    Change;
  end;
end;

procedure TAbTrend.SetZoomH(Value: Single);
begin
  if (Value <> FZoomH) and (Value > 0) then
  begin
    FZoomH := Value;
    Change;
  end;
end;

procedure TAbTrend.SetZoomY(Value: Single);
begin
  if (Value <> FZoomV) and (Value > 0) then
  begin
    FZoomV := Value;
    Change;
  end;
end;


procedure TAbTrend.SetAbsScaleCh(Value: Integer);
begin
  if (Value >= 0) and (Value < 9) then
  begin
    FAbsScaleCh := Value;
    Change;
  end;
end;

procedure TAbTrend.SetLeftScaleCh(Value: Integer);
begin
  if (Value >= 0) and (Value < 9) then
  begin
    FLeftScaleCh := Value;
    Change;
  end;
end;

procedure TAbTrend.SetColorGrid(Value: TColor);
begin
  FColorGrid := Value;
  Change;
end;

procedure TAbTrend.Paint;
var
  r                 : TRect;
  h, n, Pos, w, w2  : Integer;
  Bmp               : TBitmap;
  fromV, toV        : Single;
begin
  if UpdateCount <> 0 then exit;
  FirstPaintDone := true;
  Bmp := TBitmap.Create;
  Bmp.Width := Width;
  Bmp.Height := Height;
  CursorLastX := 0;
  if (Bmp.Width < 1) or (Bmp.Height < 1) then
  begin
    Bmp.Free;
    Exit;
  end;

  r := ClientRect;

  FBevelOuter.PaintFilledBevel(Bmp.Canvas, r);

  if opCaption in FOptions then
  begin
    Bmp.Canvas.Font := CaptionFont;
    AbTextOut(Bmp.Canvas, Width div 2, r.Top, Caption, toTopCenter);
    r.Top := r.Top + Bmp.Canvas.Textheight(Caption) + FBevelOuter.Spacing;
  end
  else if (opLeftScale in Options) or (opRightScale in options) then
  begin
    Bmp.Canvas.Font := Font;
    r.Top := r.Top + Bmp.Canvas.Textheight('X');
  end;

  rRelScale.Left := r.Left;
  rRelScale.Top := r.Top + BevelInner.TotalWidth;

  Bmp.Canvas.Font := Font;

  if FAbsScaleCh = 0 then   // 0..100%
  begin
    StrAbsScale := AbRangeStr(FYOffset, 100 * FZoomV + FYOffset, FGridYSteps,
      '##0.#');
  end else begin           // channel range
    fromV := (FChannel[FAbsScaleCh].ValueFrom + (FChannel[FAbsScaleCh].TotalValue
      / 100) * FYOffset);
    toV := fromV + (FChannel[FAbsScaleCh].TotalValue * FZoomV);
    StrAbsScale := AbRangeStr(fromV, toV, FGridYSteps,
      FChannel[FAbsScaleCh].ValueFormat);
  end;

  if FLeftScaleCh = 0 then
  begin         // 0..100%
    StrRelScale := AbRangeStr(FYOffset, 100 * FZoomV + FYOffset, FGridYSteps,
      '##0.#');
  end
  else          // channel range
  begin
    fromV := (FChannel[FLeftScaleCh].ValueFrom +
      (FChannel[FLeftScaleCh].TotalValue / 100) * FYOffset);
    toV := fromV + (FChannel[FLeftScaleCh].TotalValue * FZoomV);
    StrRelScale := AbRangeStr(fromV, toV, FGridYSteps,
      FChannel[FLeftScaleCh].ValueFormat);
  end;


  AbGetMaxTokenSize(Bmp.Canvas, wRelScaleFont, hRelScaleFont, StrRelScale);
  AbGetMaxTokenSize(Bmp.Canvas, wAbsScaleFont, hAbsScaleFont, StrAbsScale);

  w := BevelOuter.Spacing;
  w := AbMinMaxInt(w, 2, 8);
  w2 := w + w div 2;
  w2 := AbMinMaxInt(w2, 4, 12);

  rAbsScale.Right := r.Right;

  if (opLeftScale in Options) then  AbMultiBorder(r, wRelScaleFont + w2, 0, 0, 0);
  if (opRightScale in Options) then AbMultiBorder(r, 0, 0, wAbsScaleFont + w2, 0);

  rRelScale.Right := r.Left;

  rRelScale.Bottom := r.Bottom - BevelInner.TotalWidth;

  if (opDate in Options) or (opTime in Options) then begin
    rRelScale.Bottom := rRelScale.Bottom - 4;
    if (opDate in Options) then
      rRelScale.Bottom := rRelScale.Bottom - hRelScaleFont ;
    if (opTime in Options) then
      rRelScale.Bottom := rRelScale.Bottom - hRelScaleFont ;
  end else  // place for the channelNo indication
    if ((opLeftScale in Options) and (FLeftScaleCh > 0)) or
       ((opRightScale in Options) and (FAbsScaleCh > 0)) then
       rRelScale.Bottom := rRelScale.Bottom - hRelScaleFont -4;


  rAbsScale.Top := r.Top + BevelInner.TotalWidth;
  rAbsScale.Bottom := rRelScale.Bottom;
  rAbsScale.Left := r.Right;


  Bmp.Canvas.Pen.Color := clBlack;

  h := rRelScale.Bottom - rRelScale.Top -1;

  for n := 1 to 8 do
    if FChannel[n].TotalDigit <> 0 then
      FChannel[n].PixelPerDigit := h / (FChannel[n].TotalDigit );

  FLimitUpper.PixelPerDigit := h / 100;
  FLimitLower.PixelPerDigit := h / 100;

  PixelPerPPT := h / 1000;
  YPixelOffset := Round((FYOffset * 10) * PixelPerPPT);


  Bmp.Canvas.Brush.Color := BevelInner.Color;
  Bmp.Canvas.Brush.Style := bsSolid;

  if (opRightScale in Options) and (FAbsScaleCh > 0) then begin
    Bmp.Canvas.Font.Color := FChannel[FAbsScaleCh].Color;
    AbTextOut(Bmp.Canvas, rAbsScale.Right, r.Bottom,
    ' Ch' + IntToStr(FAbsScaleCh) + ' ', toBotRight);
  end;
    

  if (opLeftScale in Options) and (FLeftScaleCh > 0) then begin
    Bmp.Canvas.Font.Color := FChannel[FLeftScaleCh].Color;
    AbTextOut(Bmp.Canvas, rRelScale.Right - w2, r.Bottom,
      ' Ch' + IntToStr(FLeftScaleCh) + ' ', toBotRight);
  end;
  Bmp.Canvas.Font.Color := Font.Color;
  Bmp.Canvas.Brush.Style := bsClear;

  Pos := rRelScale.Top - hAbsScaleFont;

  if (opLeftScale in Options) then
  begin
    if FLeftScaleCh = 0 then
      AbTextOut(Bmp.Canvas, rRelScale.Right - w2, Pos,
        '%', toMidRight)
    else
      AbTextOut(Bmp.Canvas, rRelScale.Right - w2, Pos,
        FChannel[FLeftScaleCh].ValueUnit, toMidRight);
  end;


  if (opRightScale in Options) then
  begin
    if FAbsScaleCh = 0 then
      AbTextOut(Bmp.Canvas, rAbsScale.Right, Pos, '%', toMidRight)
    else
      AbTextOut(Bmp.Canvas, rAbsScale.Right, Pos,
      FChannel[FAbsScaleCh].ValueUnit, toMidRight);
  end;

  for n := 0 to FGridYSteps do
  begin
    Bmp.Canvas.Font.Color := Font.Color;
    if (opLeftScale in Options) then
    begin
      Pos := rRelScale.Top + Round(n * PixelPerPPT * (1000 / FGridYSteps));
      Bmp.Canvas.moveTo(rRelScale.Right - w, Pos);
      Bmp.Canvas.LineTo(rRelScale.Right, Pos);
      AbTextOut(Bmp.Canvas, rRelScale.Right - w2, Pos,
        AbStrToken(StrRelScale, ';')
        , toMidRight);
    end;

    if (opRightScale in Options) then
    begin
      Pos := rAbsScale.Top + Round(n * PixelPerPPT * (1000 / FGridYSteps));
      Bmp.Canvas.moveTo(rAbsScale.Left + w, Pos);
      Bmp.Canvas.LineTo(rAbsScale.Left, Pos);
      AbTextOut(Bmp.Canvas, rAbsScale.Right, Pos,
        AbStrToken(StrAbsScale, ';')
        , toMidRight);
    end;
  end;

  FBevelInner.PaintFilledBevel(Bmp.Canvas, r);

  rTrend := r;

  MaxVisRecords := rTrend.Right - rTrend.Left;

  DrawGrid(rTrend, true);

  if RecordList.Count > 0 then DrawCurves(TrendOffset, RecordList.Count - 1);
  Bmp.Canvas.Draw(rTrend.Left, rTrend.Top, BmpTrend);

  Canvas.Draw(0, 0, Bmp);

  Bmp.Free;
end;

procedure TAbTrend.DrawGrid(r: TRect; Erase: Boolean);
var
  n, Pos, pos0      : Integer;
begin
  BmpTrend.Width := r.Right - r.Left;
  BmpTrend.Height := r.Bottom - r.Top;

  if (BmpTrend.Width < 1) and (BmpTrend.Height < 1) then Exit;


  with BmpTrend.Canvas do
  begin
    Brush.Color := BevelInner.Color;
    pen.Width := 1;
    if Erase then
    begin
      Rectangle(-1, -1, BmpTrend.Width + 1, BmpTrend.Height + 1);
         {upper limit}
      pos0 := Round(PixelPerPPT * 1000) + Round(YPixelOffset / FZoomV);
      if LimitUpper.Enabled then
      begin
        Pos := pos0 - Round((LimitUpper.Value * LimitUpper.PixelPerDigit) /
          FZoomV);
        Brush.Color := LimitUpper.Color;
        Pen.Color := LimitUpper.Color;
        if LimitUpper.Filled then
        begin
          Rectangle(-1, -1, BmpTrend.Width + 1, Pos);
        end
        else
        begin
          moveTo(-1, Pos);
          LineTo(Width + 1, Pos);
        end;
      end;

      if LimitLower.Enabled then
      begin
        Pos := pos0 - Round((LimitLower.Value * LimitLower.PixelPerDigit) /
          FZoomV);
        Brush.Color := LimitLower.Color;
        Pen.Color := LimitLower.Color;
        if LimitLower.Filled then
        begin
          if (Pos < PixelPerPPT * 1000) then
            Rectangle(-1, Pos, BmpTrend.Width + 1, Round(PixelPerPPT * 1000));
        end
        else
        begin
          moveTo(-1, Pos);
          LineTo(Width + 1, Pos);
        end;
      end;
    end;

    if (opGrid in Options) then
    begin
      Pen.Color := FColorGrid;
      Pen.Style := psDot;
      Brush.Style := bsClear;
      for n := 0 to FGridYSteps do
      begin
        Pos := Round(n * PixelPerPPT * (1000 / FGridYSteps));
        moveTo(0, Pos);
        LineTo(Width + 1, Pos);
      end;
      n := 0;
      while n < BmpTrend.Width do
      begin
        moveTo(n, -1);
        LineTo(n, Round(PixelPerPPT * 1000));
        n := n + FGridXPixel;
      end;

      BmpTrend.Canvas.Pen.Style := psSolid;
    end;
  end;
  PointPos := 0;
end;

procedure TAbTrend.ParamChange(Sender: TObject);
begin
//  if (UpdateCount = 0) then  exit;
  //inherited ParamChange(self);
  if FirstPaintDone then Paint;
end;

procedure TAbTrend.ValueChange(Sender: TObject);
var
  n                 : Integer;
begin
  for n := 1 to 8 do
    AbsolutDigitCh[n] := FChannel[n].AbsDigit;
end;


procedure TAbTrend.SetCaptionFont(Value: TFont);
begin
  FCaptionFont.Assign(Value);
  Change;
end;

procedure TAbTrend.SetOptions(Value: TTrendOptions);
begin
  FOptions := Value;
  Change;
end;


destructor TAbTrend.Destroy;
var
  n                 : Integer;
begin
  AbDestroy := true;

  for n := 1 to 8 do
  begin
    FChannel[n].Free;
    MinMax[n].Free;
  end;

  FBevelInner.Free;
  FBevelOuter.Free;

   {free up Records}
  ClearRecords;
  RecordList.Free;

  FCaptionFont.Free;
  BmpTrend.Free;

  FRecordInfo.Free;
  FValueAtCursor.Free;

  FLimitUpper.Free;
  FLimitLower.Free;

  DelControl(self);

  inherited Destroy;
end;

end.