frmmain.pas

usb4711A数据采集卡的DI转换通道程序

unit frmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Driver, Event, Paras;

type
  TForm1 = class(TForm)
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    GroupBox1: TGroupBox;
    editDevName: TEdit;
    btnSelDev: TButton;
    GroupBox2: TGroupBox;
    scrollChanSpin: TScrollBar;
    editChan: TEdit;
    GroupBox3: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    editScanTime: TEdit;
    editScanData: TEdit;
    btnStart: TButton;
    btnStop: TButton;
    GroupBox4: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    editCount_IDI0: TEdit;
    editCount_IDI1: TEdit;
    editCount_DI0: TEdit;
    editCount_DI1: TEdit;
    editIntCount_DI1: TEdit;
    editIntCount_DI0: TEdit;
    editIntCount_IDI1: TEdit;
    editIntCount_IDI0: TEdit;
    btnEnable1: TButton;
    btnEnable2: TButton;
    btnEnable3: TButton;
    btnEnable4: TButton;
    btnDisable4: TButton;
    btnDisable3: TButton;
    btnDisable2: TButton;
    btnDisable1: TButton;
    btnClose: TButton;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure btnSelDevClick(Sender: TObject);
    procedure scrollChanSpinChange(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnEnable1Click(Sender: TObject);
    procedure btnEnable2Click(Sender: TObject);
    procedure btnEnable3Click(Sender: TObject);
    procedure btnEnable4Click(Sender: TObject);
    procedure btnDisable1Click(Sender: TObject);
    procedure btnDisable2Click(Sender: TObject);
    procedure btnDisable3Click(Sender: TObject);
    procedure btnDisable4Click(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  m_ErrCde: Longint;			{ Return error code }
  m_DriverHandle: Longint;		{ driver handle }
  m_ptDioReadPortByte: PT_DioReadPortByte;
  m_szErrMsg: array [0..79] of char;	{ Use for MESSAGEBOX function }
  m_bHiPriority: Boolean;		{ Evnt thread's priority }
  m_ulDevNum: Longint;
  m_bContinue: Boolean;
  m_bFlag: Boolean;            { thread flag }
  m_bDI0Flag: Boolean;
  m_bDI1Flag: Boolean;
  m_bIDI0Flag: Boolean;
  m_bIDI1Flag: Boolean;
  m_StartFlag: Boolean;        { Start button pressed flag }
  ptCheckEvent: PT_CheckEvent;
  usStartFlag: SHORT;

implementation
uses GetEvent;

var
  EventTread: TGetEvent;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  ratio: Real;
  szBuf_IDI: array [0..3] of string[20];
  DeviceName: array [0..49] of char;
  dwBoardID: DWORD;
  dwCount: Longint;
begin
  editScanTime.Text := '1000';
  editChan.Text := '0';
  editCount_DI1.Text := '1';
  editCount_DI0.Text := '1';
  editCount_IDI0.Text := '1';
  editCount_IDI1.Text := '1';
  m_DriverHandle := 0;          { driver handle }
  m_bContinue    := FALSE;
  m_bHiPriority  := FALSE;
  m_bFlag     := FALSE;
  m_bDI0Flag  := FALSE;
  m_bDI1Flag  := FALSE;
  m_bIDI0Flag := FALSE;
  m_bIDI1Flag := FALSE;
  m_StartFlag := FALSE;

  for i := 0 to 3 do
  begin
    ratio := 0.0;
    szBuf_IDI[i] := Format('%.3f', [ratio]);
  end;

  editIntCount_IDI0.Text := szBuf_IDI[0];
  editIntCount_IDI1.Text := szBuf_IDI[1];
  editIntCount_DI0.Text := szBuf_IDI[2];
  editIntCount_DI1.Text := szBuf_IDI[3];

  m_ulDevNum := 0;
  DRV_SelectDevice( Handle, FALSE, m_ulDevNum, DeviceName );
  editDevName.Text := DeviceName;
  scrollChanSpin.Position := 0;
  m_ErrCde := DRV_DeviceOpen( m_ulDevNum, m_DriverHandle );
  if ( m_ErrCde <> SUCCESS ) then
  begin
     DRV_GetErrorMessage(m_ErrCde, @m_szErrMsg[0]);
     MessageBox(Handle, m_szErrMsg, 'Device Open', MB_OK);
  end;

  dwCount := sizeof( DWORD );
  m_ErrCde := DRV_DeviceGetProperty( m_DriverHandle, CFG_BoardID, @dwBoardID, dwCount );
  if ( m_ErrCde <> SUCCESS ) then
  begin
     DRV_GetErrorMessage(m_ErrCde, @m_szErrMsg[0]);
     MessageBox(Handle, m_szErrMsg, 'Device GetProperty', MB_OK);
  end;
  if ( BD_PCI1736UP = dwBoardID )  then
  begin
        btnEnable3.Enabled := false;
        btnEnable4.Enabled := false;
  end
  else
  begin
        btnEnable3.Enabled := true;
        btnEnable4.Enabled := true;
  end;

end;

procedure TForm1.btnSelDevClick(Sender: TObject);
var
  DeviceName: array [0..49] of char;
  dwBoardID: DWORD;
  dwCount: Longint;
begin
  if ( m_DriverHandle <> NULL ) then
     DRV_DeviceClose( m_DriverHandle );
  DRV_SelectDevice( Handle, FALSE, m_ulDevNum, DeviceName );
  editDevName.Text := DeviceName;
  m_ErrCde := DRV_DeviceOpen( m_ulDevNum, m_DriverHandle);
  dwCount := sizeof( DWORD );
  m_ErrCde := DRV_DeviceGetProperty( m_DriverHandle, CFG_BoardID, @dwBoardID, dwCount );
  if ( m_ErrCde <> SUCCESS ) then
  begin
     DRV_GetErrorMessage(m_ErrCde, @m_szErrMsg[0]);
     MessageBox(Handle, m_szErrMsg, 'Device GetProperty', MB_OK);
  end;
  if ( BD_PCI1736UP = dwBoardID )  then
  begin
        btnEnable3.Enabled := false;
        btnEnable4.Enabled := false;
  end
  else
  begin
        btnEnable3.Enabled := true;
        btnEnable4.Enabled := true;
  end;
end;

procedure TForm1.scrollChanSpinChange(Sender: TObject);
begin
  editChan.Text :=  IntToStr(scrollChanSpin.Position);
end;

procedure TForm1.btnStartClick(Sender: TObject);
begin
  m_StartFlag := TRUE;
  Timer1.Enabled := TRUE;
  Timer1.Interval := StrToInt(editScanTime.Text);
  btnStart.Enabled := FALSE;
  btnStop.Enabled := TRUE;
  btnSelDev.Enabled := FALSE;
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
  Timer1.Enabled := FALSE;
  m_StartFlag := FALSE;
  btnStart.Enabled := TRUE;
  btnStop.Enabled := FALSE;
  if ( not(m_bDI0Flag or m_bDI1Flag or m_bIDI1Flag or m_bIDI0Flag or m_StartFlag )) then
  begin
     btnSelDev.Enabled := TRUE;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  gwValue: SHORT;		{ input value }
  szBuf: string[10];
begin
  m_ptDioReadPortByte.port := StrToInt(editChan.Text);
  m_ptDioReadPortByte.value := @gwValue;

  m_ErrCde := DRV_DioReadPortByte(m_DriverHandle, m_ptDioReadPortByte);
  if (m_ErrCde<> 0) then
  begin
    DRV_GetErrorMessage(m_ErrCde, @m_szErrMsg[0]);
    Timer1.Enabled := FALSE;
    MessageBox(Handle, m_szErrMsg, 'Driver Message', MB_OK);
  end
  else
  begin
     szBuf := Format('%02X', [gwValue]);
     editScanData.Text := szBuf;
  end;
end;

procedure TForm1.btnEnable1Click(Sender: TObject);
var
  EventSetting: PT_EnableEvent;
begin
  m_bIDI0Flag   := TRUE;
  usStartFlag  := 1;
  EventSetting.Enabled   := 1;
  EventSetting.Count     := StrToInt(editCount_IDI0.Text);

  EventSetting.EventType := ADS_EVT_INTERRUPT_IDI0;
  m_ErrCde := DRV_EnableEvent( m_DriverHandle, EventSetting );
  if ( m_ErrCde <> 0) then
  begin
     DRV_GetErrorMessage( m_ErrCde, @m_szErrMsg[0] );
     MessageBox(Handle, m_szErrMsg, 'Driver Message', MB_OK );
     exit;
  end;

  btnDisable1.Enabled := TRUE;
  btnEnable1.Enabled := FALSE;
  btnSelDev.Enabled := FALSE;

  if ( m_bFlag = FALSE ) then
  begin
     m_bContinue := TRUE;
     EventTread := TGetEvent.Create(False);
  end;
end;

procedure TForm1.btnEnable2Click(Sender: TObject);
var
  EventSetting: PT_EnableEvent;
begin
  m_bIDI1Flag   := TRUE;
  usStartFlag  := 1;
  EventSetting.Enabled   := 1;
  EventSetting.Count     := StrToInt(editCount_IDI1.Text);

  EventSetting.EventType := ADS_EVT_INTERRUPT_IDI1;
  m_ErrCde := DRV_EnableEvent( m_DriverHandle, EventSetting );
  if ( m_ErrCde <> 0) then
  begin
     DRV_GetErrorMessage( m_ErrCde, @m_szErrMsg[0] );
     MessageBox(Handle, m_szErrMsg, 'Driver Message', MB_OK );
     exit;
  end;

  btnDisable2.Enabled := TRUE;
  btnEnable2.Enabled := FALSE;
  btnSelDev.Enabled := FALSE;

  if ( m_bFlag = FALSE ) then
  begin
     m_bContinue := TRUE;
     EventTread := TGetEvent.Create(False);
  end;
end;

procedure TForm1.btnEnable3Click(Sender: TObject);
var
  EventSetting: PT_EnableEvent;
begin
  m_bDI0Flag   := TRUE;
  usStartFlag  := 1;
  EventSetting.Enabled   := 1;
  EventSetting.Count     := StrToInt(editCount_DI0.Text);

  EventSetting.EventType := ADS_EVT_INTERRUPT_DI0;
  m_ErrCde := DRV_EnableEvent( m_DriverHandle, EventSetting );
  if ( m_ErrCde <> 0) then
  begin
     DRV_GetErrorMessage( m_ErrCde, @m_szErrMsg[0] );
     MessageBox(Handle, m_szErrMsg, 'Driver Message', MB_OK );
     exit;
  end;

  btnDisable3.Enabled := TRUE;
  btnEnable3.Enabled := FALSE;
  btnSelDev.Enabled := FALSE;

  if ( m_bFlag = FALSE ) then
  begin
     m_bContinue := TRUE;
     EventTread := TGetEvent.Create(False);
  end;
end;

procedure TForm1.btnEnable4Click(Sender: TObject);
var
  EventSetting: PT_EnableEvent;
begin
  m_bDI1Flag   := TRUE;
  usStartFlag  := 1;
  EventSetting.Enabled   := 1;
  EventSetting.Count     := StrToInt(editCount_DI1.Text);

  EventSetting.EventType := ADS_EVT_INTERRUPT_DI1;
  m_ErrCde := DRV_EnableEvent( m_DriverHandle, EventSetting );
  if ( m_ErrCde <> 0) then
  begin
     DRV_GetErrorMessage( m_ErrCde, @m_szErrMsg[0] );
     MessageBox(Handle, m_szErrMsg, 'Driver Message', MB_OK );
     exit;
  end;

  btnDisable4.Enabled := TRUE;
  btnEnable4.Enabled := FALSE;
  btnSelDev.Enabled := FALSE;

  if ( m_bFlag = FALSE ) then
  begin
     m_bContinue := TRUE;
     EventTread := TGetEvent.Create(False);
  end;
end;

procedure TForm1.btnDisable1Click(Sender: TObject);
var
  EventSetting: PT_EnableEvent;
  flag: Boolean;
begin
  flag := FALSE;
  m_bIDI1Flag := FALSE;
  EventTread.Terminate;

  if ( not(m_bDI0Flag or m_bDI1Flag or m_bIDI0Flag or m_bIDI1Flag )) then
  begin
    m_bContinue := FALSE;
    m_bFlag := FALSE;
    if ( not m_StartFlag ) then
    begin
      btnSelDev.Enabled := TRUE;
    end;
  end;
  usStartFlag := 0;
  while ( not flag ) do
  begin
    btnDisable1.Enabled := FALSE;
    btnEnable1.Enabled := TRUE;

    EventSetting.EventType := ADS_EVT_INTERRUPT_IDI0;
    EventSetting.Enabled   := 0;
    m_ErrCde := DRV_EnableEvent( m_DriverHandle, EventSetting );

    if ( m_ErrCde <> 0 ) then
    begin
      DRV_GetErrorMessage( m_ErrCde, @m_szErrMsg[0] );
      MessageBox(Handle, m_szErrMsg, 'Driver Message', MB_OK );
      exit;
    end;
    flag := TRUE;
  end;
end;

procedure TForm1.btnDisable2Click(Sender: TObject);
var
  EventSetting: PT_EnableEvent;
  flag: Boolean;
begin
  flag := FALSE;
  m_bIDI1Flag := FALSE;
  EventTread.Terminate;

  if ( not(m_bDI0Flag or m_bDI1Flag or m_bIDI0Flag or m_bIDI1Flag )) then
  begin
    m_bContinue := FALSE;
    m_bFlag := FALSE;
    if ( not m_StartFlag ) then
    begin
      btnSelDev.Enabled := TRUE;
    end;
  end;
  usStartFlag := 0;
  while ( not flag ) do
  begin
    btnDisable2.Enabled := FALSE;
    btnEnable2.Enabled := TRUE;

    EventSetting.EventType := ADS_EVT_INTERRUPT_IDI1;
    EventSetting.Enabled   := 0;
    m_ErrCde := DRV_EnableEvent( m_DriverHandle, EventSetting );

    if ( m_ErrCde <> 0 ) then
    begin
      DRV_GetErrorMessage( m_ErrCde, @m_szErrMsg[0] );
      MessageBox(Handle, m_szErrMsg, 'Driver Message', MB_OK );
      exit;
    end;
    flag := TRUE;
  end;
end;

procedure TForm1.btnDisable3Click(Sender: TObject);
var
  EventSetting: PT_EnableEvent;
  flag: Boolean;
begin
  flag := FALSE;
  m_bDI0Flag := FALSE;
  EventTread.Terminate;

  if ( not(m_bDI0Flag or m_bDI1Flag or m_bIDI0Flag or m_bIDI1Flag )) then
  begin
    m_bContinue := FALSE;
    m_bFlag := FALSE;
    if ( not m_StartFlag ) then
    begin
      btnSelDev.Enabled := TRUE;
    end;
  end;
  usStartFlag := 0;
  while ( not flag ) do
  begin
    btnDisable3.Enabled := FALSE;
    btnEnable3.Enabled := TRUE;

    EventSetting.EventType := ADS_EVT_INTERRUPT_DI0;
    EventSetting.Enabled   := 0;
    m_ErrCde := DRV_EnableEvent( m_DriverHandle, EventSetting );

    if ( m_ErrCde <> 0 ) then
    begin
      DRV_GetErrorMessage( m_ErrCde, @m_szErrMsg[0] );
      MessageBox(Handle, m_szErrMsg, 'Driver Message', MB_OK );
      exit;
    end;
    flag := TRUE;
  end;
end;

procedure TForm1.btnDisable4Click(Sender: TObject);
var
  EventSetting: PT_EnableEvent;
  flag: Boolean;
begin
  flag := FALSE;
  m_bDI1Flag := FALSE;
  EventTread.Terminate;

  if ( not(m_bDI0Flag or m_bDI1Flag or m_bIDI0Flag or m_bIDI1Flag )) then
  begin
    m_bContinue := FALSE;
    m_bFlag := FALSE;
    if ( not m_StartFlag ) then
    begin
      btnSelDev.Enabled := TRUE;
    end;
  end;
  usStartFlag := 0;
  while ( not flag ) do
  begin
    btnDisable4.Enabled := FALSE;
    btnEnable4.Enabled := TRUE;

    EventSetting.EventType := ADS_EVT_INTERRUPT_DI1;
    EventSetting.Enabled   := 0;
    m_ErrCde := DRV_EnableEvent( m_DriverHandle, EventSetting );

    if ( m_ErrCde <> 0 ) then
    begin
      DRV_GetErrorMessage( m_ErrCde, @m_szErrMsg[0] );
      MessageBox(Handle, m_szErrMsg, 'Driver Message', MB_OK );
      exit;
    end;
    flag := TRUE;
  end;
end;

procedure TForm1.btnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  m_bContinue := FALSE;
  if( usStartFlag = 1 ) then
  begin
    usStartFlag := 0;
    if ( m_bIDI0Flag = TRUE ) then
    begin
      btnDisable1Click(Sender);
    end;
    if ( m_bIDI1Flag = TRUE ) then
    begin
      btnDisable2Click(Sender);
    end;
    if ( m_bDI0Flag = TRUE ) then
    begin
      btnDisable3Click(Sender);
    end;
    if ( m_bDI1Flag = TRUE ) then
    begin
      btnDisable4Click(Sender);
    end;
  end;
  Sleep(50);
  if ( m_DriverHandle <> NULL ) then
     DRV_DeviceClose( m_DriverHandle );
end;

end.