abtrend.pas

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

unit AbTrend;                    

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

{$I abks.inc}


interface

uses
  Windows,
  Classes, Graphics, Controls, extctrls, Messages, SysUtils, Forms,
  {****** Abakus VCL - Units ******}
  _GClass, _AbInfo, _AbProc, AbFlashT;

type

  TTrendOption = (opCaption, opGrid, opCursorOnRec, opSeparator, opDate,
    opTime, opCh7isUL, opCh8isLL, opLeftScale, opRightScale, opShowLast);
  TTrendOptions = set of TTrendOption;

  TTrendLimit = class(TPersistent)
  private
    FValue: Single;
    FColor: TColor;
    FFilled: Boolean;
    FEnabled: Boolean;
    FOnChange: TNotifyEvent;
    FOnValueChange: TNotifyEvent;
    PixelPerDigit: Single;
  protected
    procedure SetValue(Value: Single);
    procedure SetColor(Value: TColor);
    procedure SetFilled(Value: Boolean);
    procedure SetEnabled(Value: Boolean);
  published
    property Value: Single read FValue write SetValue;
    property Color: TColor read FColor write SetColor;
    property Filled: Boolean read FFilled write SetFilled;
    property Enabled: Boolean read FEnabled write SetEnabled;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnValueChange: TNotifyEvent read FOnValueChange write
    FOnValueChange;
  end;

  TRecInfo = class(TPersistent)         {general info's about record-list}
  private
    FFirstDisplayedRec: Integer;        {first painted point}
    FLastDisplayedRec: Integer;         {last painted point}
    FTotalRecords: Cardinal;            {total number of stored records}
    FFirstRecord: TDateTime;            {DateTime of the first record}
    FLastRecord: TDateTime;             {DateTime of the last  record}
  published
    property FirstDisplayedRec: Integer read FFirstDisplayedRec write
    FFirstDisplayedRec;
    property LastDisplayedRec: Integer read FLastDisplayedRec write
    FLastDisplayedRec;
    property TotalRecords: Cardinal read FTotalRecords write FTotalRecords;
    property FirstRecord: TDateTime read FFirstRecord write FFirstRecord;
    property LastRecord: TDateTime read FLastRecord write FLastRecord;
  end;


  TVAtCursor = class(TPersistent)       {Value at Cursor position}
  private
    FDataValid: Boolean;
    FRecordNo: Integer;
    FTime: TDateTime;
  protected
    procedure SetValueCh1(Value: Single);
    function GetValueCh1: Single;
    procedure SetValueCh2(Value: Single);
    function GetValueCh2: Single;
    procedure SetValueCh3(Value: Single);
    function GetValueCh3: Single;
    procedure SetValueCh4(Value: Single);
    function GetValueCh4: Single;
    procedure SetValueCh5(Value: Single);
    function GetValueCh5: Single;
    procedure SetValueCh6(Value: Single);
    function GetValueCh6: Single;
    procedure SetValueCh7(Value: Single);
    function GetValueCh7: Single;
    procedure SetValueCh8(Value: Single);
    function GetValueCh8: Single;
  public
    FValueCh: array[1..8] of Single;
  published
    property DataValid: Boolean read FDataValid write FDataValid;
    property RecordNo: Integer read FRecordNo write FRecordNo;
    property Time: TDateTime read FTime write FTime;
    property ValueCh1: Single read GetValueCh1 write SetValueCh1;
    property ValueCh2: Single read GetValueCh2 write SetValueCh2;
    property ValueCh3: Single read GetValueCh3 write SetValueCh3;
    property ValueCh4: Single read GetValueCh4 write SetValueCh4;
    property ValueCh5: Single read GetValueCh5 write SetValueCh5;
    property ValueCh6: Single read GetValueCh6 write SetValueCh6;
    property ValueCh7: Single read GetValueCh7 write SetValueCh7;
    property ValueCh8: Single read GetValueCh8 write SetValueCh8;
  end;

  ChArray = array[1..8] of Smallint;    {Array for signal-digit 1..8}
  PSignRec = ^SignRec;
  SignRec = record
    Time: TDateTime;                    {TimeDate of this rec}
    Ch: ChArray;                        {FChannel[1..8] Digit}
  end;

  TAbTrend = class(TAbGraphicControl)
  private
    {properties}
    FAbsScaleCh: Integer;
    FLeftScaleCh: Integer;
    FBevelInner: TAbSBevel;
    FBevelOuter: TAbSBevel;
    FCaptionFont: TFont;
    FColorCursorLine: TColor;
    FColorGrid: TColor;
    FColorSeparator: TColor;            {color for the separator-lines}
    FColorTime: TColor;
    FCursorLinePenMode: TPenMode;
    FCursorLine: Boolean;
    FFillChannelNo: Integer;
    FFlow: Boolean;
    FGridXPixel: Integer;
    FGridYSteps: Integer;
    FInterval: Cardinal;
    FInterval2: Cardinal;               {2nd interval}
    FMaxRecords: Integer;               {Max no of records (ram) }
    FOptions: TTrendOptions;
    FRecordInfo: TRecInfo;
    FStartRecording: Boolean;
    FValueAtCursor: TVAtCursor;         {Value at cursorline}
    FLimitUpper: TTrendLimit;           {upper limitation}
    FLimitLower: TTrendLimit;           {lower limitation}

    {events}
    FOnInterval: TNotifyEvent;          { before draw }
    FOnMaxRecords: TNotifyEvent; { if max number of Records reached, before
                                         block delete}
    FOnNewCursorPos: TNotifyEvent;      { on enter/move/exit trend}
    FOnRecNoChanged: TNotifyEvent; { on load/erase/add record, called each
                                         time the number of records has changed}

    {var}
    FZoomH: Single;                     {hoizontal zoom}
    FZoomV: Single;                     {vertical zoom}
    FYOffset: Integer;                  {y offset in Percent}

    FTimeFormat : String;

    Flowing: Boolean;                   {Flow & StartRecording are true}

    StrRelScale: string;
    StrAbsScale: string;

    AbDestroy: Boolean;                 {true when destroy}


    rTrend: TRect;
    rRelScale: TRect;
    rAbsScale: TRect;

    wRelScaleFont: Integer;
    hRelScaleFont: Integer;
    wAbsScaleFont: Integer;
    hAbsScaleFont: Integer;

    YPixelOffset: Integer;

    AbsolutDigitCh: array[1..8] of Smallint;

    inTrend: Boolean;                   {true if cursorline is shown}
    CursorLinePos: Integer;             {record Position of the Cursorline}
    CursorX: Integer;                   {xpos of the cursorline}
    CursorLastX : Integer;              {last x-position}

    PointPos: Integer; {position of the last point to draw in TrendBmp}
    TrendOffset: Integer;               {offset to the first displayed point}

    sepTime: TDateTime;                 {dummy-time for record separator-lines}

    Int2Count: Integer; {count down number of records with interval 2}
    Int2Running: Boolean;

    PixelPerPPT: Single;


    GetNewData : Boolean;

    FirstPaintDone : Boolean;

  protected
    { Protected-Deklarationen}
    procedure SetChannel1(Value: TChSettings);
    function GetChannel1: TChSettings;
    procedure SetChannel2(Value: TChSettings);
    function GetChannel2: TChSettings;
    procedure SetChannel3(Value: TChSettings);
    function GetChannel3: TChSettings;
    procedure SetChannel4(Value: TChSettings);
    function GetChannel4: TChSettings;
    procedure SetChannel5(Value: TChSettings);
    function GetChannel5: TChSettings;
    procedure SetChannel6(Value: TChSettings);
    function GetChannel6: TChSettings;
    procedure SetChannel7(Value: TChSettings);
    function GetChannel7: TChSettings;
    procedure SetChannel8(Value: TChSettings);
    function GetChannel8: TChSettings;

    procedure SetAbsScaleCh(Value: Integer);
    procedure SetLeftScaleCh(Value: Integer);
    procedure SetCaptionFont(Value: TFont);
    procedure SetColorCursorLine(Value: TColor);
    procedure SetColorGrid(Value: TColor);
    procedure SetColorSeparator(Value: TColor);
    procedure SetColorTime(Value: TColor);
    procedure SetCursorLinePenMode(Value: TPenMode);
    procedure SetFillChannelNo(Value: Integer);
    procedure SetFlow(Value: Boolean);
    procedure SetGridXPixel(Value: Integer);
    procedure SetGridYSteps(Value: Integer);
    procedure SetOptions(Value: TTrendOptions);
    procedure SetInterval(Value: Cardinal);
    procedure SetInterval2(Value: Cardinal);
    procedure SetMaxRecords(Value: Integer);
    procedure SetStartRecording(Value: Boolean);
    procedure SetYOffset(Value: Integer);
    procedure SetZoomH(Value: Single);
    procedure SetZoomY(Value: Single);

    procedure SetTimeFormat(Value : String);

    procedure RecordNoChanged;

    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; x, y: Integer);
      override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; x, y:
      Integer);
      override;
    procedure MouseMove(Shift: TShiftState; x, y: Integer); override;

    procedure Paint; override;
    procedure DrawGrid(r: TRect; Erase: Boolean);
    procedure DrawCurves(RecordFrom, RecordTo: Integer);


    procedure DrawCursorLine(Full : Boolean);
    procedure ParamChange(Sender: TObject); override;
    procedure ValueChange(Sender: TObject);

    {events}

    procedure WMFlash(var Message: TMessage); message WM_FLASH;
    procedure CMTextChanged(var msg: TMessage); message CM_TEXTCHANGED;
    procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
  public
    { Public-Deklarationen}
    BmpTrend: TBitmap;
    RecordList: TList;                  {record-list}
    ARecord: PSignRec;                  {a new record}
    MaxVisRecords: Integer; {maximum visible records (width of the display)}
    MinMax: array[1..8] of TMinMax;
    FChannel: array[1..8] of TChSettings;
    DiffTime: LongInt;
    DeleteTilRecord : Integer;  // contains the number of record's to delete (see MaxRecord's )
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;

    procedure SetCursorLine(x, y: Integer);

    procedure AddSeparator(Pos: Integer); {add separator lines}

    function FindMinMax(FromRec, ToRec: Integer): Boolean;

    function ValueToDigit(Ch: Integer; Value: Single): Smallint;
    function DigitToValue(Ch: Integer; Digit: Smallint): Single;

    function AddDigit(d1, d2, d3, d4, d5, d6, d7, d8: Smallint): Boolean;
    function AddValue(v1, v2, v3, v4, v5, v6, v7, v8: Single): Boolean;
    function ReadDigit(RecNo: Integer; var t: TDateTime; var d1, d2, d3, d4, d5,
      d6, d7, d8: Smallint): Boolean;
    function ReadValue(RecNo: Integer; var t: TDateTime; var v1, v2, v3, v4, v5,
      v6, v7, v8: Single): Boolean;
    function ReadRecTime(RecNo: Integer; var t: TDateTime): Boolean;
    procedure PaintRecords(RecordFrom, RecordTo: Integer);
    procedure GetData;

    procedure ClearRecords;             {clears all records}
    procedure DeleteRecords(no: Integer);  {deletes number of records from the begin of the list}
    function LoadFromFile(FileName: string): Integer; {add's records from file}
    function LoadFromFileEx(FileName: string; ClearList: Boolean): Integer; {add's records from file}
    procedure MoveX(NoOffRecords: Integer);
    procedure MoveY(Percent: Integer);
    procedure RunInterval2(NoOffRecords: Integer);
      { NoOffRecords with interval 2,
                                                      then normal interval again}
    function SaveToFile(FileName: string): Integer;  {save's total list of records to file}
    function SavePartToFile(FileName: string; FromRecord, ToRecord: Integer):
    Integer;
    procedure SetYDefault;
    procedure ZoomY(Value: Single);
    procedure ZoomYIn;
    procedure ZoomYOut;
  published
    { Published-Deklarationen }

    property Visible;
    property LimitUpper: TTrendLimit read FLimitUpper write FLimitUpper;
    property LimitLower: TTrendLimit read FLimitLower write FLimitLower;
    property Align;
    property AbsScaleCh: Integer read FAbsScaleCh write SetAbsScaleCh default 1;
    property LeftScaleCh: Integer read FLeftScaleCh write SetLeftScaleCh;
    property BevelInner: TAbSBevel read FBevelInner write FBevelInner;
    property BevelOuter: TAbSBevel read FBevelOuter write FBevelOuter;
    property Caption;
    property CaptionFont: TFont read FCaptionFont write SetCaptionFont;
    property Channel1: TChSettings read GetChannel1 write SetChannel1;
    property Channel2: TChSettings read GetChannel2 write SetChannel2;
    property Channel3: TChSettings read GetChannel3 write SetChannel3;
    property Channel4: TChSettings read GetChannel4 write SetChannel4;
    property Channel5: TChSettings read GetChannel5 write SetChannel5;
    property Channel6: TChSettings read GetChannel6 write SetChannel6;
    property Channel7: TChSettings read GetChannel7 write SetChannel7;
    property Channel8: TChSettings read GetChannel8 write SetChannel8;
    property ColorCursorLine: TColor read FColorCursorLine write
    SetColorCursorLine default clLime;
    property CursorLine: Boolean read FCursorLine write FCursorLine;
    property CursorLinePenMode: TPenMode read FCursorLinePenMode write
    SetCursorLinePenMode;
    property ColorGrid: TColor read FColorGrid write SetColorGrid default
    clBtnShadow;
    property ColorSeparator: TColor read FColorSeparator write SetColorSeparator
    default clBtnHighlight;
    property ColorTime: TColor read FColorTime write SetColorTime default
    clBtnHighlight;
    property FillChannelNo: Integer read FFillChannelNo write SetFillChannelNo;
    property Flow: Boolean read FFlow write SetFlow;
    property Font;
    property GridXPixel: Integer read FGridXPixel write SetGridXPixel;
    property GridYSteps: Integer read FGridYSteps write SetGridYSteps default
    10;
    property Interval: Cardinal read FInterval write SetInterval default 1000;
    property Interval2: Cardinal read FInterval2 write SetInterval2 default 250;
    property MaxRecords: Integer read FMaxRecords write SetMaxRecords default
    2000;
    property Options: TTrendOptions read FOptions write SetOptions;
    property RecordInfo: TRecInfo read FRecordInfo write FRecordInfo;
    property StartRecording: Boolean read FStartRecording write
    SetStartRecording;
    property ValueAtCursor: TVAtCursor read FValueAtCursor write FValueAtCursor;

    property TimeFormat : String read FTimeFormat write SetTimeFormat;

    property OnInterval: TNotifyEvent read FOnInterval write FOnInterval;
    property OnMaxRecords: TNotifyEvent read FOnMaxRecords write FOnMaxRecords;
    property OnNewCursorPos: TNotifyEvent read FOnNewCursorPos write
    FOnNewCursorPos;
    property OnRecNoChanged: TNotifyEvent read FOnRecNoChanged write
    FOnRecNoChanged;
    property OnMouseMove;
    property OnMouseDown;
    property OnMouseUp;
  end;

implementation

procedure TVAtCursor.SetValueCh1(Value: Single);
begin
  FValueCh[1] := Value;
end;

function TVAtCursor.GetValueCh1: Single;
begin
  result := FValueCh[1];
end;

procedure TVAtCursor.SetValueCh2(Value: Single);
begin
  FValueCh[2] := Value;
end;

function TVAtCursor.GetValueCh2: Single;
begin
  result := FValueCh[2];
end;

procedure TVAtCursor.SetValueCh3(Value: Single);
begin
  FValueCh[3] := Value;
end;

function TVAtCursor.GetValueCh3: Single;
begin
  result := FValueCh[3];
end;

procedure TVAtCursor.SetValueCh4(Value: Single);
begin
  FValueCh[4] := Value;
end;

function TVAtCursor.GetValueCh4: Single;
begin
  result := FValueCh[4];
end;

procedure TVAtCursor.SetValueCh5(Value: Single);
begin
  FValueCh[5] := Value;
end;

function TVAtCursor.GetValueCh5: Single;
begin
  result := FValueCh[5];
end;

procedure TVAtCursor.SetValueCh6(Value: Single);
begin
  FValueCh[6] := Value;
end;

function TVAtCursor.GetValueCh6: Single;
begin
  result := FValueCh[6];
end;

procedure TVAtCursor.SetValueCh7(Value: Single);
begin
  FValueCh[7] := Value;
end;

function TVAtCursor.GetValueCh7: Single;
begin
  result := FValueCh[7];
end;

procedure TVAtCursor.SetValueCh8(Value: Single);
begin
  FValueCh[8] := Value;
end;

function TVAtCursor.GetValueCh8: Single;
begin
  result := FValueCh[8];
end;



procedure TTrendLimit.SetValue(Value: Single);
begin
  if FValue <> Value then
  begin
    FValue := Value;
    if Assigned(FOnChange) then FOnChange(self);
  end;
end;

procedure TTrendLimit.SetColor(Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    if Assigned(FOnChange) then FOnChange(self);
  end;
end;

procedure TTrendLimit.SetFilled(Value: Boolean);
begin
  if FFilled <> Value then
  begin
    FFilled := Value;
    if Assigned(FOnChange) then FOnChange(self);
  end;
end;

procedure TTrendLimit.SetEnabled(Value: Boolean);
begin
  if FEnabled <> Value then
  begin
    FEnabled := Value;
    if Assigned(FOnChange) then FOnChange(self);
  end;
end;

procedure TAbTrend.SetChannel1(Value: TChSettings);
begin
  FChannel[1] := Value;
end;

function TAbTrend.GetChannel1: TChSettings;
begin
  result := FChannel[1];
end;

procedure TAbTrend.SetChannel2(Value: TChSettings);
begin
  FChannel[2] := Value;
end;

function TAbTrend.GetChannel2: TChSettings;
begin
  result := FChannel[2];
end;


procedure TAbTrend.SetChannel3(Value: TChSettings);
begin
  FChannel[3] := Value;
end;

function TAbTrend.GetChannel3: TChSettings;
begin
  result := FChannel[3];
end;


procedure TAbTrend.SetChannel4(Value: TChSettings);