abprttrd.pas

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

unit AbPrtTrd;

{******************************************************************************}
{ Abakus VCL                                                                   }
{                            Component TAbPrintTrend                           }
{                                                                              }
{******************************************************************************}
{        e-Mail: [e-mail] , Web: http://www.abaecker.com            }
{------------------------------------------------------------------------------}
{          (c) Copyright 1998..2001 A.Baecker, All rights Reserved             }
{******************************************************************************}

interface

uses
  Windows,
  Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  extctrls, Printers, AbTrend, _AbProc, _AbInfo;

type
  TFormat = (Inch, Metric, Pixel);
  TLegendPos = (lpSplit, lpLeft, lpCenter, lpRight);

  TLegendOpt = (loName1, loName2, loMin, loMinTime, loMax, loMaxTime, loUnit);
  TLegendOptions = set of TLegendOpt;

  TPrtTrdOption = (ptCaption, ptLegend, ptColor, ptVerticalScale, ptSelScaleOnly,
    ptUseTrdBkCol);
  TPrtTrdOptions = set of TPrtTrdOption;


  TLegendCaptions = class(TPersistent)  {general info's about record-list}
  private
    FChannelNo: string;
    FName1: string;
    FName2: string;
    FMin: string;
    FMinTime: string;
    FMax: string;
    FMaxTime: string;
    FlUnit: string;
  protected
    FOnChange: TNotifyEvent;
    procedure Change(Sender: TObject);
    constructor Create;
    procedure SetChannelNo(Value: string);
    procedure SetName1(Value: string);
    procedure SetName2(Value: string);
    procedure SetMin(Value: string);
    procedure SetMinTime(Value: string);
    procedure SetMax(Value: string);
    procedure SetMaxTime(Value: string);
    procedure SetlUnit(Value: string);
  published
    property ChannelNo: string read FChannelNo write SetChannelNo;
    property Name1: string read FName1 write SetName1;
    property Name2: string read FName2 write SetName2;
    property Min: string read FMin write SetMin;
    property MinTime: string read FMinTime write SetMinTime;
    property Max: string read FMax write SetMax;
    property MaxTime: string read FMaxTime write SetMaxTime;
    property lUnit: string read FlUnit write SetlUnit;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TLegend = class(TPersistent)
  private
    FCaptions: TLegendCaptions;
    FOptions: TLegendOptions;
    FPosition: TLegendPos;
    FMargin: Integer;
    FOnChange: TNotifyEvent;
    procedure Change(Sender: TObject);
    procedure SetCaptions(Value: TLegendCaptions);
    procedure SetOptions(Value: TLegendOptions);
    procedure SetPosition(Value: TLegendPos);
    procedure SetMargin(Value: Integer);
  protected

  public
    constructor Create;
    destructor Destroy; override;
  published
    property Captions: TLegendCaptions read FCaptions write SetCaptions;
    property Options: TLegendOptions read FOptions write SetOptions;
    property Position: TLegendPos read FPosition write SetPosition;
    property Margin: Integer read FMargin write SetMargin;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TAbPrintTrend = class(TComponent)
  private
    { Private-Deklarationen }
    FAbInfo: TAbInfo;
    FFormat: TFormat;
    FWidth: Integer;
    FHeight: Integer;
    FTrend: TAbTrend;
    FFont: TFont;
    FLegend: TLegend;
    FBkColor: TColor;
    FLogPixelScreen: Integer;           {resolution of the screen in dpi}

    LogPixelPrinter: Integer;           {resolution of the printer in dpi}

    FFontSize: Integer;                 {fontsize in inch, metric or Pixel}
    FFontSizeCaption: Integer; {fontsize caption in inch, metric or Pixel}
    FOnSettingsChange: TNotifyEvent;
    FOnAfterBeginDoc: TNotifyEvent;
    FOnBeforeEndDoc: TNotifyEvent;
    FPreviewPaintBox: TPaintBox;
    FPreviewZoom: Single;               {zoom 0,1..10}
    FScaleSpacing: Integer;
    FTrendSpace: Integer;
    FOuterBorder: Integer;
    FOptions: TPrtTrdOptions;
    FTimeScaleSteps: Integer;

    FRecFrom: Integer;                  {first record to print}
    FRecTo: Integer;                    {last record to print}

    wInPixel: Integer;                  {width in Pixel}
    hInPixel: Integer;                  {height in Pixel}
    fInPixel: Integer;                  {fontSize in pixel}
    sInPixel: Integer;                  {ScaleSpacing in Pixel}
    tInPixel: Integer;                  {trend-Scale Space in pixel}
    oInPixel: Integer;                  {outer space in Pixel}
    cInPixel: Integer;                  {caption Fontsize in Pixel}
    lInPixel: Integer;                  {Legend space in pixel}

    MaxFontWidth: Integer;              {max width of ScaleText}
    poFactor: Single;                   {factor LogPixelPrinter / LogPixelScreen}

    r: TRect;

  protected
    { Protected-Deklarationen }
    procedure SetFormat(Value: TFormat);
    procedure SetHeight(Value: Integer);
    procedure SetWidth(Value: Integer);
    procedure SetLogPixelScreen(Value: Integer);
    procedure SetFontSize(Value: Integer);
    procedure SetFontSizeCaption(Value: Integer);
    procedure SetPreviewPaintBox(Value: TPaintBox);
    procedure SetScaleSpacing(Value: Integer);
    procedure SetTrendSpace(Value: Integer);
    procedure SetTrend(Value: TAbTrend);
    procedure SetOuterBorder(Value: Integer);
    procedure SetRecFrom(Value: Integer);
    procedure SetRecTo(Value: Integer);
    procedure SetTimeScaleSteps(Value: Integer);
    procedure SetOptions(Value: TPrtTrdOptions);
    procedure SetFont(Value: TFont);
    procedure SetPreviewZoom(Value: Single);
    procedure SetBkColor(Value: TColor);
    procedure ParamChange(Sender: TObject);
    procedure PaintBoxPaint(Sender: TObject);
    procedure PaintPreview;
    procedure CalcPixelSize;
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
    procedure AbDrawHLines(can: TCanvas);
    procedure AbDrawScale(can: TCanvas; {canvas}
      no: Integer                       {Channel number}
      );
    procedure DrawLegend(can: TCanvas; preview: Boolean);
    procedure DrawTrend(can: TCanvas; x, y: Integer; preview: Boolean);
  public
    { Public-Deklarationen }
    procedure PrintTrend(x, y: Integer);
    procedure ExPrintTrend(x, y: Integer);
    procedure DrawTrendBmp(Bmp: TBitmap);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AbInfo: TAbInfo read FAbInfo write FAbInfo stored false;
    {Format for the properties FontSize, FontSizeCaption,
    Height, LegendSpace, OuterBorder, ScaleSpacing, TrendSpace and Width in
    Inch, Metric or Pixel}
    property Format: TFormat read FFormat write SetFormat;
    {Height of the trend incl. legend and caption. <BR><BR>See also: Format}
    property Height: Integer read FHeight write SetHeight;
    {Width of the trend. <BR><BR>See also: Format}
    property Width: Integer read FWidth write SetWidth;
    {Link to the trend you like to print.}
    property Trend: TAbTrend read FTrend write SetTrend;
    {Logical pixel of the screen. <BR>
     By default this property gets the solution of the screen from the windows-settings.
     You may change the default settings to adjust the correct screen(bmp)-size if you use the
     Format Inch or Pixel.}
    property LogPixelScreen: Integer read FLogPixelScreen write
    SetLogPixelScreen;
    {Font size, used for the scale and legend. <BR><BR>See also: Format}
    property FontSize: Integer read FFontSize write SetFontSize;
    {Trend caption font size. <BR><BR>See also: Format}
    property FontSizeCaption: Integer read FFontSizeCaption write
    SetFontSizeCaption;
    {Space between the trend channels. <BR><BR>See also: Format}
    property ScaleSpacing: Integer read FScaleSpacing write SetScaleSpacing;
    {Space between the trend and scale + time. <BR><BR>See also: Format}
    property TrendSpace: Integer read FTrendSpace write SetTrendSpace;
    {Print preview paintbox. Link this property to a painbox if you like to see a preview of
     the trend. This preview can be zoomed with the PreviewZoom property.
     <BR><BR>See also: PreviewZoom}
    property PreviewPaintBox: TPaintBox read FPreviewPaintBox write
    SetPreviewPaintBox;
    {Space arround the thend (incl. scale, caption and legend).}
    property OuterBorder: Integer read FOuterBorder write SetOuterBorder;
    {This event occurs each time you change the settings of the component.}
    property OnSettingsChange: TNotifyEvent read FOnSettingsChange write
    FOnSettingsChange;
    {Number of the first record you like to print. <BR><BR>See also: RecTo}
    property RecFrom: Integer read FRecFrom write SetRecFrom;
    {Number of the last record you like to print. <BR><BR>
    Note: If you adjust a to hight number the displayed records will be limited to the last record.
    <BR><BR>See also: RecFrom}
    property RecTo: Integer read FRecTo write SetRecTo;
    {Set of options.}
    property Options: TPrtTrdOptions read FOptions write SetOptions;
    {Number of steps for the time-scale. Default=10.}
    property TimeScaleSteps: Integer read FTimeScaleSteps write
    SetTimeScaleSteps;
    {Font for the trend Caption and scales. <BR><BR>
    Note: The size/height property of the font will be ignored. Use FontSize and FontSizeCaption to adjust.
    <BR><BR>See also: FontSize, FontSizeCaption}
    property Font: TFont read FFont write SetFont;
    {Zoom factor of the trend-preview. Limit: 0.1-10.<BR>
    This property influence only the preview and not the printed trend.<BR><BR>
    Example: With PreviewZoom of 0.5 the preview is 50% of the original size.}
    property PreviewZoom: Single read FPreviewZoom write SetPreviewZoom;
    property Legend: TLegend read FLegend write FLegend;
    property BkColor: TColor read FBkColor write SetBkColor;
    property OnAfterBeginDoc: TNotifyEvent read FOnAfterBeginDoc write
    FOnAfterBeginDoc;
    property OnBeforeEndDoc: TNotifyEvent read FOnBeforeEndDoc write
    FOnBeforeEndDoc;
  end;


implementation

procedure TAbPrintTrend.Notification(AComponent: TComponent; Operation:
  TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then
  begin
    if (AComponent = FPreviewPaintBox) then FPreviewPaintBox := nil;
    if (AComponent = FTrend) then
    begin
      FTrend := nil;
      if Assigned(FPreviewPaintBox) then FPreviewPaintBox.Invalidate;
    end;
  end;
end;

procedure TAbPrintTrend.CalcPixelSize;
begin
  if FFormat = Metric then
  begin
    wInPixel := Round(FWidth * (FLogPixelScreen / 254));
    hInPixel := Round(FHeight * (FLogPixelScreen / 254));
    fInPixel := Round(FFontSize * (FLogPixelScreen / 254));
    sInPixel := Round(FScaleSpacing * (FLogPixelScreen / 254));
    tInPixel := Round(FTrendSpace * (FLogPixelScreen / 254));
    oInPixel := Round(FOuterBorder * (FLogPixelScreen / 254));
    cInPixel := Round(FFontSizeCaption * (FLogPixelScreen / 254));
    lInPixel := Round(FLegend.FMargin * (FLogPixelScreen / 254));
  end
  else
    if FFormat = Inch then
    begin
      wInPixel := Round(FWidth * (FLogPixelScreen / 100));
      hInPixel := Round(FHeight * (FLogPixelScreen / 100));
      fInPixel := Round(FFontSize * (FLogPixelScreen / 100));
      sInPixel := Round(FScaleSpacing * (FLogPixelScreen / 100));
      tInPixel := Round(FTrendSpace * (FLogPixelScreen / 100));
      oInPixel := Round(FOuterBorder * (FLogPixelScreen / 100));
      cInPixel := Round(FFontSizeCaption * (FLogPixelScreen / 100));
      lInPixel := Round(FLegend.FMargin * (FLogPixelScreen / 100));
    end
    else
    begin
      wInPixel := FWidth;
      hInPixel := FHeight;
      fInPixel := FFontSize;
      sInPixel := FScaleSpacing;
      tInPixel := FTrendSpace;
      oInPixel := FOuterBorder;
      cInPixel := FFontSizeCaption;
      lInPixel := FLegend.FMargin;
    end;
end;

procedure TAbPrintTrend.PaintPreview;
begin
  if not (Assigned(FPreviewPaintBox) and Assigned(FTrend)) then Exit;
  PaintBoxPaint(self);
end;

procedure TAbPrintTrend.SetRecFrom(Value: Integer);
begin
  if FRecFrom <> Value then
  begin
    if Value >= 0 then FRecFrom := Value;
    ParamChange(self);
  end;
end;

procedure TAbPrintTrend.SetRecTo(Value: Integer);
begin
  if FRecTo <> Value then
  begin
    FRecTo := Value;
    ParamChange(self);
  end;
end;

procedure TAbPrintTrend.SetTimeScaleSteps(Value: Integer);
begin
  if FTimeScaleSteps <> Value then
  begin
    FTimeScaleSteps := Value;
    ParamChange(self);
  end;
end;


procedure TAbPrintTrend.SetFont(Value: TFont);
begin
  if FFont <> Value then
  begin
    FFont.Assign(Value);
    ParamChange(self);
  end;
end;

procedure TAbPrintTrend.SetPreviewZoom(Value: Single);
begin
  if FPreviewZoom <> Value then
  begin
    if (Value >= 0.1) and (Value <= 10) and (Value <> 0) then
      FPreviewZoom := Value;
    ParamChange(self);
  end;
end;

procedure TAbPrintTrend.SetOptions(Value: TPrtTrdOptions);
begin
  if FOptions <> Value then
  begin
    FOptions := Value;
    ParamChange(self);
  end;
end;

procedure TAbPrintTrend.SetOuterBorder(Value: Integer);
begin
  FOuterBorder := Value;
  CalcPixelSize;
  ParamChange(self);
end;

procedure TAbPrintTrend.SetBkColor(Value: TColor);
begin
  if FBkColor <> Value then
  begin
    FBkColor := Value;
    ParamChange(self);
  end;
end;

procedure TAbPrintTrend.DrawTrendBmp(Bmp: TBitmap);
var
  dummy             : Single;
begin
  dummy := FPreviewZoom;
  FPreviewZoom := 1;
  Bmp.Width := wInPixel;
  Bmp.Height := hInPixel;
  Bmp.Canvas.Rectangle(-1, -1, Bmp.Width + 1, Bmp.Height + 1);
  DrawTrend(Bmp.Canvas, 0, 0, true);
  FPreviewZoom := dummy;
end;

procedure TAbPrintTrend.PrintTrend(x, y: Integer);
begin
  Printer.BeginDoc;
  Printer.Title := Name + ' - ' + Trend.Caption;
  if Assigned(FOnAfterBeginDoc) then OnAfterBeginDoc(self);
  DrawTrend(Printer.Canvas, x, y, false);
  if Assigned(FOnBeforeEndDoc) then OnBeforeEndDoc(self);
  Printer.EndDoc;
end;

procedure TAbPrintTrend.ExPrintTrend(x, y: Integer);
begin
  DrawTrend(Printer.Canvas, x, y, false);
end;


procedure TAbPrintTrend.DrawTrend(can: TCanvas; x, y: Integer; preview:
  Boolean);
var
  n, nn, xPos, yPos : Integer;
  tFlow             : Boolean;
  recStep           : Single;
  wTrend            : Integer;
  hTrend            : Integer;
  PixPerDigit       : Single;
  SignRec           : PSignRec;
  dummyInt          : Integer;
  TimeStep          : Single;
  DT                : TDateTime;
  dc                : THandle;
  RecF, RT          : Integer;
  xyFactor          : Single;
begin

  can.Font.Assign(FFont);

  can.Brush.Style := bsSolid;
  can.Brush.Color := clWhite;
  can.Pen.Color := clWhite;

  if preview then can.Rectangle(r.Left, r.Top, r.Right, r.Bottom);

  RecF := FRecFrom;
  RT := AbMinInt(FRecTo, FTrend.RecordList.Count - 1);


  tFlow := Trend.Flow;
  if tFlow then Trend.Flow := false;    {stop trend flowing}

  poFactor := 1;
  xyFactor := 1;
  if preview then
  begin
    if FPreviewPaintBox <> nil then
      if (can <> Printer.Canvas) then poFactor := FPreviewZoom;
    if Format = Metric then
    begin
      xyFactor := LogPixelScreen / 254;
    end
    else