abprttrd.pas

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

      if Format = Inch then
      begin
        xyFactor := LogPixelScreen / 100;
      end;
  end
  else
  begin
    can.textout(0, 0, ' ');
    dc := Printer.Handle;
    LogPixelPrinter := GetDeviceCaps(dc, logpixelsx);
    if FLogPixelScreen > 0 then poFactor := LogPixelPrinter / FLogPixelScreen;
    if Format = Metric then
    begin
      xyFactor := LogPixelPrinter / 254;
    end
    else
      if Format = Inch then
      begin
        xyFactor := LogPixelPrinter / 100;
      end;
  end;
  x := Round(x * xyFactor);
  y := Round(y * xyFactor);

  r := Rect(x, y, x + Round(wInPixel * poFactor), y + Round(hInPixel *
    poFactor));

  AbBorder(r, Round(oInPixel));         {outer border}

  if (ptCaption in Options) then
  begin
    can.Font.Height := -Round(cInPixel * poFactor);
    AbTextOut(can, r.Left + (r.Right - r.Left) div 2, r.Top, FTrend.Caption,
      toTopCenter);
    r.Top := r.Top + Round((cInPixel) * poFactor);
  end;

  can.Font.Height := -Round(fInPixel * poFactor);

  MaxFontWidth := 0;
  for n := 1 to 8 do
  begin
    MaxFontWidth := AbMaxInt(MaxFontWidth,
      can.TextWidth(Trend.FChannel[n].ValueFormat));
  end;

  if (RT - RecF) > 0 then Trend.FindMinMax(RecF, RT);

  if (ptLegend in FOptions) then
  begin
    DrawLegend(can, preview);
  end;

  if (ptVerticalScale in Options) then
  begin
    AbMultiBorder(r, can.TextWidth(TimeToStr(Now)) div 2,
      MaxFontWidth div 2 + 1,
      0,
      Round(can.Textheight('X') * 2 + sInPixel * poFactor) + 2);
  end
  else
  begin
    AbMultiBorder(r, can.TextWidth(TimeToStr(Now)) div 2,
      Round(fInPixel * poFactor / 2),
      0,
      Round(can.Textheight('X') * 2 + sInPixel * poFactor));
  end;

  can.Font.Color := clBlack;
  if (ptSelScaleOnly in Options) then begin
     if (Trend.AbsScaleCh) > 0 then AbDrawScale(can, Trend.AbsScaleCh);
  end else begin
    for n := 8 downto 1 do
    begin
      if Trend.FChannel[n].Visible then
      begin
        AbDrawScale(can, n);
      end;
    end;
  end;
  AbMultiBorder(r, 0, 0, Round(tInPixel * poFactor), 0);

  if (ptColor in Options) then
  begin
    if (ptUseTrdBkCol in Options) then
    begin
      can.Brush.Color := FTrend.BevelInner.Color;
      can.Pen.Color := FTrend.BevelInner.Color;
    end
    else
    begin
      can.Brush.Color := BkColor;
      can.Pen.Color := BkColor;
    end;
    can.Brush.Style := bsSolid;
    can.Rectangle(r.Left, r.Top, r.Right, r.Bottom);
  end;


  can.Pen.Color := clBlack; //Trend.ColorGrid;
  can.Pen.Style := psDot;
  can.Brush.Style := bsClear;

  wTrend := (r.Right - r.Left);
  hTrend := (r.Bottom - r.Top);
  recStep := wTrend / (RT - RecF + 0.001);

  TimeStep := wTrend / FTimeScaleSteps;

  n := 0;
  xPos := Round(n * recStep * Trend.GridXPixel);
  while xPos <= (wTrend) do
  begin
    if Trend.ReadRecTime(Round(xPos / recStep) + FRecFrom, DT) then
    begin
      AbTextOut(can, r.Left + xPos, r.Bottom + Round(tInPixel * poFactor),
        TimeToStr(DT), toTopCenter);
      AbTextOut(can, r.Left + xPos, r.Bottom + Round(tInPixel * poFactor) +
        can.Textheight('X'), DateToStr(DT), toTopCenter);
    end
    else
      if (RT - RecF) <= 0 then
      begin
        AbTextOut(can, r.Left + xPos, r.Bottom + Round(tInPixel * poFactor),
          TimeToStr(0), toTopCenter);
        AbTextOut(can, r.Left + xPos, r.Bottom + Round(tInPixel * poFactor) +
          can.Textheight('X'), DateToStr(0), toTopCenter);
      end;
    can.Pen.Style := psDot;
    can.moveTo(r.Left + xPos, r.Top);
    can.LineTo(r.Left + xPos, r.Bottom);
    can.Pen.Style := psSolid;
    can.LineTo(r.Left + xPos, r.Bottom + Round(tInPixel * poFactor));
    Inc(n);
    xPos := Round(n * TimeStep);
  end;

  can.Pen.Color := clBlack;
  AbDrawHLines(can);
  can.Pen.Width := Round(1 * poFactor);

  can.Pen.Style := psSolid;
  can.Pen.Color := clBlack;
  can.Brush.Color := clWhite;
  can.Brush.Style := bsClear;

  dummyInt := Round(0.51 * poFactor);
  can.Rectangle(r.Left - dummyInt, r.Top - dummyInt, r.Right + dummyInt, r.Bottom
    + dummyInt);

  if (RT - RecF) > 0 then
  begin
    for nn := 8 downto 1 do
    begin
      PixPerDigit := hTrend / Trend.FChannel[nn].TotalDigit;
      can.Pen.Width := Round(Trend.FChannel[nn].PenWidth * poFactor);
      if (ptColor in FOptions) then
        can.Pen.Color := Trend.FChannel[nn].Color
      else
        can.Pen.Color := clBlack;

      for n := 0 to (RT - RecF) do
      begin
        if Trend.FChannel[nn].Visible then
        begin
          SignRec := Trend.RecordList.Items[RecF + n];
          xPos := r.Left + Round(n * recStep);
          yPos := r.Bottom - Round(SignRec^.Ch[nn] * PixPerDigit);
          if yPos < r.Top then
            yPos := r.Top
          else
            if yPos > r.Bottom then yPos := r.Bottom;
          if n = 0 then can.moveTo(xPos, yPos);
          can.LineTo(xPos, yPos);
        end;
      end;
      
    end;
  end;
  can.Pen.Width := 1;

  if tFlow then Trend.Flow := true;     {start trend flowing}

end;

procedure TAbPrintTrend.DrawLegend(can: TCanvas; preview: Boolean);
var
  n                 : Integer;
  xPos              : Integer;

  wChNo, wName1, wName2, wMin, wMinTime, wMax, wMaxTime, wUnit, wSpace: Integer;
  pChNo, pName1, pName2, pMin, pMinTime, pMax, pMaxTime, pUnit: Integer;
  hText             : Integer;
  wTotal, hTotal    : Integer;          {total legend width/height }

  yPos              : Integer;

  procedure Draw(x, y, chFrom, chTo: Integer);
  var
    n               : Integer;
  begin
    yPos := y;
    AbTextOut(can, x + pChNo, yPos, FLegend.Captions.FChannelNo, toTopRight);
    if (loName1 in FLegend.FOptions) then
      AbTextOut(can, x + pName1, yPos, FLegend.Captions.FName1, toTopRight);
    if (loName2 in FLegend.FOptions) then
      AbTextOut(can, x + pName2, yPos, FLegend.Captions.FName2, toTopRight);
    if (loMin in FLegend.FOptions) then
      AbTextOut(can, x + pMin, yPos, FLegend.Captions.FMin, toTopRight);
    if (loMinTime in FLegend.FOptions) then
      AbTextOut(can, x + pMinTime, yPos,
        FLegend.Captions.FMinTime, toTopRight);
    if (loMax in FLegend.FOptions) then
      AbTextOut(can, x + pMax, yPos, FLegend.Captions.FMax, toTopRight);
    if (loMaxTime in FLegend.FOptions) then
      AbTextOut(can, x + pMaxTime, yPos,
        FLegend.Captions.FMaxTime, toTopRight);
    if (loUnit in FLegend.FOptions) then
      AbTextOut(can, x + pUnit, yPos, FLegend.Captions.FlUnit, toTopRight);


    for n := chFrom to chTo do
    begin
      yPos := y + ((n - chFrom) + 1) * hText;
      if (ptColor in FOptions) then
        can.Brush.Color := Trend.FChannel[n].Color
      else
        can.Brush.Color := clWhite;
      can.Brush.Style := bsSolid;
      AbTextOut(can, x + pChNo, yPos, ' ch' + IntToStr(n) + ' ', toTopRight);
      can.Brush.Style := bsClear;
      if Trend.FChannel[n].Visible then
      begin
        if (loName1 in FLegend.FOptions) then
          AbTextOut(can, x + pName1, yPos, Trend.FChannel[n].Name1, toTopRight);
        if (loName2 in FLegend.FOptions) then
          AbTextOut(can, x + pName2, yPos, Trend.FChannel[n].Name2, toTopRight);
        if (loMin in FLegend.FOptions) then
          AbTextOut(can, x + pMin, yPos,
            FormatFloat(Trend.FChannel[n].ValueFormat,
            Trend.MinMax[n].FMin), toTopRight);
        if (loMinTime in FLegend.FOptions) then
          AbTextOut(can, x + pMinTime, yPos,
            DateTimeToStr(Trend.MinMax[n].FMinDateTime), toTopRight);
        if (loMax in FLegend.FOptions) then
          AbTextOut(can, x + pMax, yPos,
            FormatFloat(Trend.FChannel[n].ValueFormat,
            Trend.MinMax[n].FMax), toTopRight);
        if (loMaxTime in FLegend.FOptions) then
          AbTextOut(can, x + pMaxTime, yPos,
            DateTimeToStr(Trend.MinMax[n].FMaxDateTime), toTopRight);
        if (loUnit in FLegend.FOptions) then
          AbTextOut(can, x + pUnit, yPos, Trend.FChannel[n].ValueUnit,
            toTopRight);
      end
      else
        AbTextOut(can, x + pName1, yPos, '-', toTopRight);
    end;

    can.Pen.Style := psSolid;
    can.Pen.Color := clBlack;

    n := 2 + chTo - chFrom;
   {horizontal line}
    can.moveTo(x, y);
    can.LineTo(x + pUnit + wSpace div 2, y);

    yPos := y + hText;
   {horizontal line}
    can.moveTo(x, yPos);
    can.LineTo(x + pUnit + wSpace div 2, yPos);

    yPos := y + n * hText;
   {horizontal line}
    can.moveTo(x, yPos);
    can.LineTo(x + pUnit + wSpace div 2, yPos);

   {1st line}
    can.moveTo(x, y);
    can.LineTo(x, y + n * hText);

   {chNo line}
    can.moveTo(x + pChNo + wSpace div 2, y);
    can.LineTo(x + pChNo + wSpace div 2, y + n * hText);

   {Name1 line}
    can.moveTo(x + pName1 + wSpace div 2, y);
    can.LineTo(x + pName1 + wSpace div 2, y + n * hText);

   {Name2 line}
    can.moveTo(x + pName2 + wSpace div 2, y);
    can.LineTo(x + pName2 + wSpace div 2, y + n * hText);

   {Max line}
    can.moveTo(x + pMax + wSpace div 2, y);
    can.LineTo(x + pMax + wSpace div 2, y + n * hText);

   {MaxTime line}
    can.moveTo(x + pMaxTime + wSpace div 2, y);
    can.LineTo(x + pMaxTime + wSpace div 2, y + n * hText);

   {Min line}
    can.moveTo(x + pMin + wSpace div 2, y);
    can.LineTo(x + pMin + wSpace div 2, y + n * hText);

   {MinTime line}
    can.moveTo(x + pMinTime + wSpace div 2, y);
    can.LineTo(x + pMinTime + wSpace div 2, y + n * hText);

   {Unit line}
    can.moveTo(x + pUnit + wSpace div 2, y);
    can.LineTo(x + pUnit + wSpace div 2, y + n * hText);

  end;

begin
  wChNo := can.TextWidth(FLegend.Captions.FChannelNo);
  wName1 := can.TextWidth(FLegend.Captions.FName1);
  wName2 := can.TextWidth(FLegend.Captions.FName2);
  wMin := can.TextWidth(FLegend.Captions.FMin);
  wMinTime := can.TextWidth(FLegend.Captions.FMinTime);
  wUnit := can.TextWidth(FLegend.Captions.FlUnit);
  wSpace := can.TextWidth('X');
  hTotal := 0;

  pChNo := 0;
  pName1 := 0;
  pName2 := 0;
  pMin := 0;
  pMinTime := 0;
  pMax := 0;
  pMaxTime := 0;
  pUnit := 0;

  for n := 1 to 8 do
  begin
    wChNo := AbMaxInt(wChNo, can.TextWidth(' ch' + IntToStr(n) + ' '));
    wName1 := AbMaxInt(wName1, can.TextWidth(Trend.FChannel[n].Name1));
    wName2 := AbMaxInt(wName2, can.TextWidth(Trend.FChannel[n].Name2));
    wMin := AbMaxInt(wMin, can.TextWidth(Trend.FChannel[n].ValueFormat));
    wUnit := AbMaxInt(wUnit, can.TextWidth(Trend.FChannel[n].ValueUnit));
  end;
  wMax := wMin;
  wMinTime := AbMaxInt(wMinTime, can.TextWidth(DateTimeToStr(Now)));
  wMaxTime := wMinTime;

  hText := can.Textheight('X');

  pChNo := wChNo + wSpace div 2;
  xPos := pChNo;
  if (loName1 in FLegend.FOptions) then xPos := xPos + wName1 + wSpace;
  pName1 := xPos;
  if (loName2 in FLegend.FOptions) then xPos := xPos + wName2 + wSpace;
  pName2 := xPos;
  if (loMin in FLegend.FOptions) then xPos := xPos + wMin + wSpace;
  pMin := xPos;
  if (loMinTime in FLegend.FOptions) then xPos := xPos + wMinTime + wSpace;
  pMinTime := xPos;
  if (loMax in FLegend.FOptions) then xPos := xPos + wMax + wSpace;
  pMax := xPos;
  if (loMaxTime in FLegend.FOptions) then xPos := xPos + wMaxTime + wSpace;
  pMaxTime := xPos;
  if (loUnit in FLegend.FOptions) then xPos := xPos + wUnit + wSpace;
  pUnit := xPos;

  wTotal := xPos;

  case FLegend.FPosition of
    lpLeft:
      begin
        hTotal := Round(hText * 9 + 3 * sInPixel * poFactor);
        Draw(r.Left, r.Bottom - hTotal, 1, 8);
      end;
    lpCenter:
      begin
        hTotal := Round(hText * 9 + 3 * sInPixel * poFactor);
        xPos := r.Left + ((r.Right - r.Left) - wTotal) div 2;
        Draw(xPos, r.Bottom - hTotal, 1, 8);
      end;
    lpRight:
      begin
        hTotal := Round(hText * 9 + 3 * sInPixel * poFactor);
        Draw(r.Right - wTotal, r.Bottom - hTotal, 1, 8);
      end;
    lpSplit:
      begin
        hTotal := Round(hText * 5 + 3 * sInPixel * poFactor);
        n := ((r.Right - r.Left) - wTotal * 2) div 3;
        Draw(r.Left + n, r.Bottom - hTotal, 1, 4);
        Draw(r.Right - wTotal - n, r.Bottom - hTotal, 5, 8);
      end;
  end;                                  {case FLegendPos of}
  r.Bottom := r.Bottom - hTotal - hText - Round(lInPixel * poFactor);

end;


procedure TAbPrintTrend.PaintBoxPaint(Sender: TObject);
var
  Bmp               : TBitmap;
begin
  if Assigned(FTrend) then
  begin
    Bmp := TBitmap.Create;
    Bmp.Width := Round(wInPixel * FPreviewZoom);
    Bmp.Height := Round(hInPixel * FPreviewZoom);
    r := Bmp.Canvas.Cliprect;

    DrawTrend(Bmp.Canvas, 0, 0, true);

    PreviewPaintBox.SetBounds(PreviewPaintBox.Left,
      PreviewPaintBox.Top,
      Round(wInPixel * FPreviewZoom),
      Round(hInPixel * FPreviewZoom));

    PreviewPaintBox.Canvas.Draw(0, 0, Bmp);
    Bmp.Free;
  end;
end;

procedure TAbPrintTrend.SetTrend(Value: TAbTrend);
begin
  if FTrend <> Value then
  begin
    FTrend := Value;
    if Value <> nil then Value.FreeNotification(self);
  end;
  if Assigned(FPreviewPaintBox) then FPreviewPaintBox.Invalidate;
end;

procedure TAbPrintTrend.SetPreviewPaintBox(Value: TPaintBox);
begin
  if Assigned(FPreviewPaintBox) then
  begin
    FPreviewPaintBox.OnPaint := nil;
    FPreviewPaintBox.Invalidate;
  end;


  FPreviewPaintBox := Value;
  if Value <> nil then Value.FreeNotification(self);

  if FPreviewPaintBox <> nil then
  begin
    FPreviewPaintBox.OnPaint := PaintBoxPaint;