⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 getevent.pas

📁 16 relay output channels and 16 isolated digital input channels LED indicators to show activated
💻 PAS
字号:
unit GetEvent;

interface

uses
  Classes, SysUtils, windows,
  Init ,Convert, Driver;

type
  TGetEvent = class(TThread)
  private
    { Private declarations }
    dwDeviceNumber : Longint;
    dwDuration     : Longint;
    bCyclic        : Boolean;

    ptAiCheck  : PT_FAICheck;
    wActiveBuf : Word;
    wStopped   : Word;
    lRetrieved : Longint;
    wOverrun   : Word;
    wHalfReady : Word;

  protected
    procedure Execute; override;

    procedure adInterruptEvent;
    procedure adBufChangeEvent;
    procedure adOverrunEvent;
    procedure adWatchdogEvent;
    procedure adTerminateEvent;
  public
    constructor Create(dwDevNum : Longint; dwDur : Longint; bCyc : Boolean);
  end;

implementation

{ Important: Methods and properties of objects in VCL can only be used in a
  method called using Synchronize, for example,

      Synchronize(UpdateCaption);

  and UpdateCaption could look like,

    procedure TGetEvent.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }

{*************************************************************
 * Function: Handle the error code. If the input error code > 0,
 *           it means some error apperent.  This function can
 *           show the error message to a message box and stop
 *           this application.
 * Input:    The error code.
 * return:   none
 ************************************************************* }
Function DoesErr(var lErrCode: LongInt): integer;
var
  szErrMsg   : string[100];
  pszErrMsg  : PChar;
begin
  {Check the pressed error code}
  If (lErrCode <> 0) Then
  begin
    pszErrMsg := @szErrMsg;
    DRV_GetErrorMessage(lErrCode, pszErrMsg);
    MessageBox(0, pszErrMsg, 'Thread Message', MB_OK);
    DoesErr := 1;
  end
  else
    DoesErr := 0;
end;

{ TGetEvent }
constructor TGetEvent.Create(dwDevNum : Longint; dwDur : Longint; bCyc : Boolean);
begin
  inherited Create(False);
  dwDeviceNumber := dwDevNum;
  dwDuration := dwDur;
  bCyclic := bCyc;

  with ptAiCheck do
  begin
    ActiveBuf  := @wActiveBuf;
    stopped    := @wStopped;
    retrieved  := @lRetrieved;
    overrun    := @wOverrun;
    HalfReady  := @wHalfReady;
  end;

  FreeOnTerminate := True;
end;

procedure TGetEvent.Execute;
var
  lTickCount  : Longint;
  dwResult    : Longint;

  ptChkEvent  : PT_CheckEvent;
  wEventType  : Word;

  wStopped   : Word;
  lRetrieved : Longint;
  wOverrun   : Word;
  wHalfReady : Word;

begin
  { Place thread code here }

  {Prepare structure for checking conversion status}
  with ptChkEvent do
  begin
    EventType    := @wEventType;
    Milliseconds := dwDuration;
  end;

  {Calculation the terminate time}
  lTickCount := GetTickCount + dwDuration + $80000000;

  {Cyclic get deiver's event}
  while (bCyclic = True) or (lTickCount > GetTickCount + $80000000) do
  begin
    {1. Get the Device event}
    if DRV_CheckEvent(frmInit.ghDev, ptChkEvent) <> 0 then
    begin
      {If cannot get event close and terminate thread}
      MessageBox(0,'Check Event Error !','Thread Message',MB_OK);
      exit;
    end;

    {2. Does it contain the Interrupt event?}
    if (wEventType and ADS_EVT_INTERRUPT) <> 0 then
      {process interrupt event}
      adInterruptEvent();

    {3. Does it contain the buffer change event?}
    if (wEventType and ADS_EVT_BUFCHANGE) <> 0 then
      {process buffer change event}
      adBufChangeEvent();

    {4. Does it contain Overrun event?}
    if (wEventType and ADS_EVT_OVERRUN) <> 0 then
      {process overrun event}
      adOverrunEvent();
    {5. Does it ccontain the Watchdog event?}
    if (wEventType and ADS_EVT_WATCHDOG) <> 0 then
      {process watchdog event}
      adWatchdogEvent();

    {6. Does it contain terminate event?}
    if (wEventType and ADS_EVT_TERMINATED) <> 0 then
    begin
      {process terminate event}
      adTerminateEvent();
      exit;
    end;
  end;

  {Exit get event loop.  Display error message and termionate GetEvent}
  MessageBox(0,'Never Get Any Event! Terminate GetEvent thread',
               'Thread Message',MB_OK);
end;

procedure TGetEvent.adInterruptEvent();
begin
  {Process Interrupt event}
  frmConverting.memEvent.Lines.Append('Interrupt generating');
end;

procedure TGetEvent.adBufChangeEvent();
var
  lErrCde : Longint;
begin
  {Process Buffer change event}

  lErrCde := DRV_FAICheck(frmInit.ghDev, ptAiCheck);
  if DoesErr(lErrCde) = 1 then
    exit;

  if wActiveBuf = 0 then
    frmConverting.memEvent.Lines.Append('Change to buffer A')
  else
    frmConverting.memEvent.Lines.Append('Change to buffer B');

end;

procedure TGetEvent.adOverrunEvent();
var
    lErrCde  : Longint;
begin
  {Process overrun event.
   This demo does not care the overrun event, just clear it}
  frmConverting.memEvent.Lines.Append('Overrunning');

  lErrCde := DRV_ClearOverrun(frmInit.ghDev);
  if DoesErr(lErrCde) = 1 then
    exit;
end;

procedure TGetEvent.adWatchdogEvent();
begin
  {Processing Watchdog event.}
  frmConverting.memEvent.Lines.Append('WatchDog Event');
end;

procedure TGetEvent.adTerminateEvent();
begin
  {Close the converting form and make it to retrieved convered data}
  frmConverting.memEvent.Lines.Append('Terminated');

  frmConverting.ghThreadGetEvent := 0;

  frmConverting.Close;
end;


end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -