abtrend.pas

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

  Canvas.Draw(rTrend.Left, rTrend.Top, BmpTrend);
end;

procedure TAbTrend.MoveY(Percent: Integer);
begin
  FYOffset := FYOffset + Round(Percent * FZoomV);
  Change;
end;

procedure TAbTrend.SetYDefault;
begin
  FYOffset := 0;
  FZoomV := 1;
  Change;
end;

procedure TAbTrend.DrawCurves(RecordFrom, RecordTo: Integer);
var
  n, y              : Integer;
  Signal            : PSignRec;
  Max, y0Pos        : Integer;
  StrTimePos        : Integer;
  AbsY0, AbsY100    : Integer;
  yDate, yTime      : Integer;

  procedure PaintChannel(no, noFilled: Integer);
  var
    n               : Integer;
    yLast           : Integer;
    Min             : Integer;
  begin
    if not FChannel[no].Visible then Exit;
    if PointPos < 0 then PointPos := 0;
    Min := PointPos + TrendOffset;
    if Min > RecordList.Count - 1 then
    begin
      TrendOffset := 0;
    end;
    Min := PointPos + TrendOffset;

    Signal := RecordList.Items[Min];

    if (opTime in Options) or (opDate in Options) then y := y0Pos - 4
    else y := y0Pos;

    y := y - Round((Signal^.Ch[no] * FChannel[no].PixelPerDigit) /
      FZoomV);
    yLast := y;

    BmpTrend.Canvas.Pen.Color := FChannel[no].Color;

    if (no = noFilled) then begin
      BmpTrend.Canvas.Pen.Width := 1;
      BmpTrend.Canvas.moveTo(PointPos, y0Pos - 4 );
    end else begin
      BmpTrend.Canvas.Pen.Width := FChannel[no].PenWidth;
      if ((no = 7) and (opCh7isUL in Options)) then
      begin
        BmpTrend.Canvas.moveTo(PointPos, AbsY100);
      end
      else
        if ((no = 8) and (opCh8isLL in Options)) then
        begin
          BmpTrend.Canvas.moveTo(PointPos, AbsY0);
        end
        else
          BmpTrend.Canvas.moveTo(PointPos, y);
    end;



    for n := PointPos to Max do
    begin
      Signal := RecordList.Items[RecordFrom + n];
      if (opTime in Options) or (opDate in Options) then y := y0Pos - 4
      else y := y0Pos;
      y := y - Round((Signal^.Ch[no] * FChannel[no].PixelPerDigit) /FZoomV);

      if (no = noFilled) then
      begin
        BmpTrend.Canvas.moveTo(n, y0Pos - 4);
        y := AbMinInt(y, AbsY0);
      end
      else
        if ((no = 7) and (opCh7isUL in Options)) then
        begin
          BmpTrend.Canvas.moveTo(n, AbsY100);
          y := AbMinInt(y, AbsY0) + 1;
        end
        else
          if ((no = 8) and (opCh8isLL in Options)) then
          begin
            BmpTrend.Canvas.moveTo(n, AbsY0);
            y := AbMinInt(y, AbsY0) - 1;
          end
          else
            BmpTrend.Canvas.LineTo(n, yLast);

      BmpTrend.Canvas.LineTo(n, y);
      yLast := y;
    end;

  end;

begin
  if not (Visible or (csDesigning in Componentstate)) then Exit;

  if RecordList.Count - 1 <= 0 then Exit;

  if RecordFrom < 0 then RecordFrom := 0;
  if RecordTo > RecordList.Count - 1 then RecordTo := RecordList.Count - 1;

  FRecordInfo.FFirstDisplayedRec := RecordFrom;

  FRecordInfo.FLastDisplayedRec := AbMinInt(RecordFrom + MaxVisRecords,
    RecordTo);

  Max := AbMinInt(BmpTrend.Width, RecordTo - RecordFrom);

  AbsY100 := 0;
  
  AbsY0 := BmpTrend.Height - 1;
  if (opDate in Options) then AbsY0 := AbsY0 - hRelScaleFont;
  if (opTime in Options) then AbsY0 := AbsY0 - hRelScaleFont;
  //AbsY0 := AbsY0 - 1;

  // in case of no Date/Time but channelNo indication
  if (opTime in Options) or (opDate in Options) then begin
  end else
    if ((opLeftScale in Options) and (FLeftScaleCh > 0)) or
       ((opRightScale in Options) and (FAbsScaleCh > 0)) then
       AbsY0 := AbsY0 - hRelScaleFont - 4;

  y0Pos := AbsY0 + Round(YPixelOffset / FZoomV);

  if (opTime in Options) or (opDate in Options) then AbsY0 := AbsY0 - 4;

  if ((FFillChannelNo > 0) or (opCh7isUL in Options) or (opCh8isLL in Options))
    then
  begin
    if (opCh7isUL in Options) then PaintChannel(7, FFillChannelNo);
    if (opCh8isLL in Options) then PaintChannel(8, FFillChannelNo);
    if (FFillChannelNo > 0) then PaintChannel(FFillChannelNo, FFillChannelNo);
    DrawGrid(rTrend, false);
  end;

  for n := 1 to 8 do
  begin
    if (FFillChannelNo <> n) and not ((n = 7) and (opCh7isUL in Options))
      and not ((n = 8) and (opCh8isLL in Options))
      then PaintChannel(n, FFillChannelNo);
  end;

  yDate := BmpTrend.Height;
  yTime := yDate;

  if (opDate in Options) then yTime := yDate - hRelScaleFont;

  for n := PointPos to Max do
  begin
    Signal := RecordList.Items[RecordFrom + n];
    if sepTime = Signal^.Time then
    begin
      BmpTrend.Canvas.Pen.Color := FColorSeparator;
      BmpTrend.Canvas.moveTo(n, 0);
      BmpTrend.Canvas.LineTo(n, BmpTrend.Height);
    end;
    StrTimePos := n div GridXPixel;

    if (n = (StrTimePos * GridXPixel)) and (n > 0) then
    begin
      BmpTrend.Canvas.Font.Color := FColorTime;
      if (opDate in Options) then
      begin
      {  if FTimeFormat <> '' then
          AbTextOut(BmpTrend.Canvas, n, BmpTrend.Height, DateToStr(Signal^.Time),
          toBotCenter);
        else
          AbTextOut(BmpTrend.Canvas, n, BmpTrend.Height - hRelScaleFont, TimeToStr(Signal^.Time),
            toBotCenter);       }
        AbTextOut(BmpTrend.Canvas, n, yDate, DateToStr(Signal^.Time),
          toBotCenter);
      end;
      if (opTime in Options) then begin
        if FTimeFormat <> '' then
          AbTextOut(BmpTrend.Canvas, n, yTime, FormatDateTime(FTimeFormat, Signal^.Time),
            toBotCenter)
        else
          AbTextOut(BmpTrend.Canvas, n, yTime, TimeToStr(Signal^.Time),
            toBotCenter);
      end;
    end;
  end;
  BmpTrend.Canvas.Pen.Width  := 1;
  PointPos := Max;

end;

constructor TAbTrend.Create(AOwner: TComponent);
var
  n                 : Integer;
begin
  inherited Create(AOwner);
  Parent := AOwner as TWinControl;
  FirstPaintDone := false;
  BeginUpdate;
  SetBounds(Left, Top, 500, 300);

  AbDestroy := false;


  BmpTrend := TBitmap.Create;

  FCursorLinePenMode := pmNotMask;

  FZoomH := 1;
  FZoomV := 1;

  FLimitUpper := TTrendLimit.Create;
  FLimitUpper.FValue := 90;
  FLimitUpper.FColor := clMaroon;
  FLimitUpper.FFilled := true;
  FLimitUpper.FEnabled := true;


  FLimitLower := TTrendLimit.Create;
  FLimitLower.FValue := 10;
  FLimitLower.FColor := clMaroon;
  FLimitLower.FFilled := true;
  FLimitLower.FEnabled := true;

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

  FChannel[1].Color := clLime;
  FChannel[2].Color := clYellow;
  FChannel[3].Color := clRed;
  FChannel[4].Color := clFuchsia;
  FChannel[5].Color := $004080FF;
  FChannel[6].Color := clAqua;
  FChannel[7].Color := clBtnFace;
  FChannel[8].Color := clBtnHighlight;

  FRecordInfo := TRecInfo.Create;
  FValueAtCursor := TVAtCursor.Create;

  FBevelInner := TAbSBevel.Create;
  FBevelInner.Style := bsLowered;
  FBevelInner.Spacing := 1;
  FBevelInner.Width := 2;
  FBevelInner.BevelLine := blNone;
  FBevelInner.Color := clBlack;

  FBevelOuter := TAbSBevel.Create;
  FBevelOuter.Spacing := 10;
  FBevelOuter.Width := 2;
  FBevelOuter.BevelLine := blOuter;

  FOptions := [opCaption, opGrid, opCursorOnRec, opSeparator, opLeftScale, opRightScale,opTime];

  FCaptionFont := TFont.Create;
  FCaptionFont.Name := 'Arial';
  FCaptionFont.Size := 14;
  FCaptionFont.Style := [fsUnderline];


  FGridXPixel := 60;
  FGridYSteps := 10;

  FColorCursorLine := clLime;
  FColorTime := clBtnHighlight;
  FColorGrid := clBtnShadow;

  FAbsScaleCh := 1;
  TrendOffset := 0;

  RecordList := TList.Create;
  FMaxRecords := 2000;
  FInterval := 1000;
  FInterval2 := 250;
  Int2Running := false;
  FFlow := true;

  sepTime := 0;
  FColorSeparator := clBtnHighlight;

  FCursorLine := true;

  FStartRecording := true;

  ParentFont := false;
  Caption := Name;

  if (csDesigning in Componentstate) then Loaded;

end;

procedure TAbTrend.Loaded;
var
  n                 : Integer;
begin
  inherited Loaded;

  FLimitUpper.OnChange := ParamChange;
  FLimitUpper.OnValueChange := ValueChange;
  FLimitLower.OnChange := ParamChange;
  FLimitLower.OnValueChange := ValueChange;

  for n := 1 to 8 do
  begin
    AbsolutDigitCh[n] := FChannel[n].AbsDigit;
    FChannel[n].OnChange := ParamChange;
    FChannel[n].OnValueChange := ValueChange;
  end;

  FBevelInner.OnChange := ParamChange;

  FBevelOuter.OnChange := ParamChange;
  Font.OnChange := ParamChange;

  EndUpdate;


end;

procedure TAbTrend.SetInterval(Value: Cardinal);
begin
  if (Value >= 100) and (Value <> FInterval) then
  begin
    FInterval := Value;
    if FStartRecording and not (csDesigning in Componentstate) then
    begin
      if RecordList.Count - 1 > 0 then AddSeparator(RecordList.Count - 1);
      AddControl(self, FInterval);
    end;
  end;
end;

procedure TAbTrend.SetInterval2(Value: Cardinal);
begin
  if (Value >= 100) and (Value <> FInterval2) then
  begin
    FInterval2 := Value;
  end;
end;

procedure TAbTrend.SetFlow(Value: Boolean);
begin
  FFlow := Value;
  if FFlow and FStartRecording then
    Flowing := true
  else
    Flowing := false;
end;


procedure TAbTrend.SetStartRecording(Value: Boolean);
begin
  FStartRecording := Value;
  Int2Running := false;
  if FFlow and FStartRecording then
    Flowing := true
  else
    Flowing := false;
  if FStartRecording and not (csDesigning in Componentstate) then
  begin
    AddControl(self, FInterval);
      {add separator if recordlist is not emty}
    if RecordList.Count - 1 > 0 then AddSeparator(RecordList.Count - 1);
  end
  else
    DelControl(self);
end;

procedure TAbTrend.GetData;
var
  n                 : Integer;
begin
  if AbDestroy then Exit;
  try
    GetNewData := true;
    if ((RecordList.Count - 1) >= FMaxRecords) and Flow then
    begin
    {create event before delete,... time to save list items from 0..DeleteTilRecord}
      DeleteTilRecord := RecordList.Count - 1 - (MaxRecords - GridXPixel);
      if Assigned(FOnMaxRecords) then FOnMaxRecords(self);


      DeleteRecords(DeleteTilRecord);

      PointPos := 0;
      TrendOffset := 0;
      DrawGrid(rTrend, true);
      DrawCurves(TrendOffset, RecordList.Count - 1);
    end;

    New(ARecord);
    ARecord^.Time := Now;

    for n := 1 to 8 do
      ARecord^.Ch[n] := AbsolutDigitCh[n];

    RecordList.Add(ARecord);
    RecordNoChanged;

    n := TrendOffset;
    if Flow and ((RecordList.Count - 1) > (BmpTrend.Width + TrendOffset)) then
    begin                               {adjust offset}
      while (RecordList.Count - 1) > (BmpTrend.Width + TrendOffset) do
        TrendOffset := TrendOffset + GridXPixel;
      PointPos := 0;
    end;

    if (TrendOffset + PointPos < RecordList.Count - 1) then
    begin
      if n <> TrendOffset then DrawGrid(rTrend, true);
      DrawCurves(TrendOffset, RecordList.Count - 1);
      //if Visible then Canvas.Draw(rTrend.Left, rTrend.Top, BmpTrend);
      if inTrend then DrawCursorLine(Visible)
      else if Visible then Canvas.Draw(rTrend.Left, rTrend.Top, BmpTrend);
    end;
  finally
    GetNewData := false;
  end;
end;

procedure TAbTrend.WMFlash(var Message: TMessage);
begin
  if (csDesigning in Componentstate) then Exit;
  with Message do
  begin
    DiffTime := lParam;
    if FStartRecording then
    begin
      if Int2Running then
      begin
        Dec(Int2Count);
        if Int2Count <= 0 then
        begin
          Int2Running := false;
          AddControl(self, FInterval);
          AddSeparator(RecordList.Count - 1);
        end;
      end;
      GetData;
      if Assigned(FOnInterval) then FOnInterval(self);
    end;
  end;
end;


procedure TAbTrend.SetColorCursorLine(Value: TColor);
begin
  if FColorCursorLine <> Value then
  begin
    FColorCursorLine := Value;
  end;
end;

procedure TAbTrend.SetCursorLinePenMode(Value: TPenMode);
begin
  if FCursorLinePenMode <> Value then
  begin
    FCursorLinePenMode := Value;
  end;
end;

procedure TAbTrend.SetColorSeparator(Value: TColor);
begin
  if FColorSeparator <> Value then
  begin
    FColorSeparator := Value;
  end;
end;


procedure TAbTrend.SetColorTime(Value: TColor);
begin
  if FColorTime <> Value then
  begin
    FColorTime := Value;
    Change;
  end;
end;

procedure TAbTrend.MouseUp(Button: TMouseButton; Shift: TShiftState; x, y:
  Integer);
begin
  inherited MouseUp(Button, Shift, x, y);
  if Button = mbLeft then
  begin
  end;
end;

procedure TAbTrend.MouseDown(Button: TMouseButton; Shift: TShiftState; x, y:
  Integer);
begin
  inherited MouseDown(Button, Shift, x, y);
  if Button = mbLeft then
  begin
  end;
end;
{
procedure TAbTrend.DrawCursorLine;
var
  Bmp               : TBitmap;
  x, x2 : Integer;
begin

  if CursorLastX < CursorX then begin
     x  := CursorLastX;
     x2 := CursorX+1;
  end else begin
     x2 := CursorLastX+1;
     x  := CursorX;
  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;