diintform.pas

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

unit DiintForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls,EventThread, Driver, EVENT, PARAS;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    labDeviceName: TLabel;
    btnSelectDev: TButton;
    GroupBox2: TGroupBox;
    lsvInt: TListView;
    btnDisable: TButton;
    GroupBox3: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    cmbPort: TComboBox;
    Edit1: TEdit;
    btnScan: TButton;
    btnStop: TButton;
    txtData: TEdit;
    btnExit: TButton;
    tmrDIScan: TTimer;
    tmrDIInt: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure btnSelectDevClick(Sender: TObject);
    procedure lsvIntChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure btnDisableClick(Sender: TObject);
    procedure btnScanClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure tmrDIScanTimer(Sender: TObject);
    procedure tmrDIIntTimer(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    m_dwBoardID:    Longword;
    m_usMaxChanNum: Smallint;
    m_lDriverHandle: Longint;
    m_dwErrCde:      Integer;
    m_ErrMsg: array[0..80] of char;
    m_ulDeviceNum:   Longint;
    m_DevFeatures: DEVFEATURES;
    m_ptDevFeatures: PT_DeviceGetFeatures;
    m_dwEventChan: Longint;
    m_dwEventCount: array[0..24] of Longint;
    m_dwStartTime: Longint;
    m_dwCurrentTime: Longint;
    m_EventThread: TEventThread;

    constructor Create();
    function DoesErr(var lErrCode: LongInt): integer;
    procedure ReleaseSrc();
  end;

var
  Form1: TForm1;

implementation

//uses EventThread, Driver, EVENT, PARAS;

{$R *.dfm}

constructor TForm1.Create();
begin
    m_lDriverHandle := 0;
    m_EventThread := nil;
    inherited Create(Owner);
end;

function TForm1.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);
      Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
      DoesErr := 1;
   end
   else
      DoesErr := 0;
end;


procedure TForm1.FormCreate(Sender: TObject);
var
   i: Integer;
   szDescription: array[0..80] of char;
   ListItem: TListItem;
   ptDioSetPortMode: PT_DioSetPortMode;

begin
   ReleaseSrc();
   //1. Select Device
   DRV_SelectDevice(Handle, True, m_ulDeviceNum, szDescription);
   labDeviceName.Caption := szDescription;

   //2. Open Device
   m_dwErrCde := DRV_DeviceOpen(m_ulDeviceNum, m_lDriverHandle);
   if (DoesErr(m_dwErrCde) = 1) then
      Exit;
   //3. Get Device Feature
   m_ptDevFeatures.buffer := @m_DevFeatures;
   m_ptDevFeatures.size := sizeof(DEVFEATURES);
   m_dwErrCde := DRV_DeviceGetFeatures(m_lDriverHandle, m_ptDevFeatures);
   if (DoesErr(m_dwErrCde) = 1) then
      Exit;

   //4. Store some device specific parameters
   m_dwBoardID := m_DevFeatures.dwBoardID;
   m_usMaxChanNum := m_DevFeatures.usMaxDIChl;
   if (m_dwBoardID <> BD_PCM3780) then
   begin
      Application.MessageBox('Function Not supported','Warning');
      Exit;
   end;

   //5. Set all the Port to DI mode
   ptDioSetPortMode.dir := 0;
   for i := 0 to m_usMaxChanNum div 8 -1 do
   begin
      ptDioSetPortMode.port := i;
      m_dwErrCde := DRV_DioSetPortMode(m_lDriverHandle, ptDioSetPortMode);
      if (DoesErr(m_dwErrCde)=1)then
         Exit;
   end;

   //6. Updata UI
   cmbPort.Clear;
   for i := 0 to m_usMaxChanNum div 8 -1 do
   begin
      cmbPort.Items.Add(IntToStr(i));
   end;
   cmbPort.ItemIndex := 0;

   lsvInt.Clear;
   for i:=0 to m_usMaxChanNum-1 do
   begin
      ListItem := lsvInt.Items.Add();
      ListItem.Caption := 'Port'+ IntToStr(i div 8)+'_Chan'+IntToStr(i mod 8);
      ListItem.SubItems.Add('0');
   end;

   btnStop.Enabled := false;



end;

procedure TForm1.btnSelectDevClick(Sender: TObject);
begin
        FormCreate(Sender);
end;

procedure TForm1.lsvIntChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
var
   ptEnableEvent: PT_EnableEvent;
   dwChecked: Longint;
   dwExitCode: Cardinal;
begin

   if(Item.Checked)then
      dwChecked := 1
   else
      dwChecked := 0;

   //prevent the undesirable access when this control initializing
   if((m_dwEventChan and ($01 shl Item.Index))= (dwChecked shl Item.Index) )then
      Exit;
   
   //Enable or Disable Event

   if(Item.Index >= 0)then
   begin
      if(Item.Checked)then
      begin
         ptEnableEvent.Enabled := 1;
         m_dwEventChan := m_dwEventChan or ($01 shl Item.Index);
      end
      else
      begin
         ptEnableEvent.Enabled := 0;
         m_dwEventChan := m_dwEventChan and (not($01 shl Item.Index))
      end;
      ptEnableEvent.EventType := ADS_EVT_INTERRUPT_DI0 + Item.Index;
      ptEnableEvent.Count := 1;
      m_dwEventCount[Item.Index] := 0;
      m_dwErrCde := DRV_EnableEvent(m_lDriverHandle, ptEnableEvent);
      if (DoesErr(m_dwErrCde)=1)then
         Exit;

      //Create Thread and Enable timer
      if((m_dwEventChan<>0) and (m_EventThread = nil))then
      begin
         m_EventThread := TEventThread.Create(False);
         tmrDIInt.Enabled := true;
      end;

      //Terminate the thread and timer when all the events are disabled
      if((m_dwEventChan = 0) and (m_EventThread <> nil))then
      begin
         GetExitCodeThread(m_EventThread.Handle, dwExitCode );
         if( dwExitCode = STILL_ACTIVE )then
         begin
	    TerminateThread(m_EventThread.Handle, 4);
            m_EventThread.Destroy;
            m_EventThread := nil;
            m_dwEventCount[Item.Index] := 0;
         end;
         // Disable the timer
         tmrDIInt.Enabled := false;
      end;
   end;
end;

procedure TForm1.btnDisableClick(Sender: TObject);
var
   ptEnableEvent: PT_EnableEvent;
   dwExitCode: Cardinal;
   i: Integer;
begin
   // 1. Exit the Thread
   if(m_EventThread <> nil)then
      begin
         GetExitCodeThread(m_EventThread.Handle, dwExitCode );
         if( dwExitCode = STILL_ACTIVE )then
         begin
	    TerminateThread(m_EventThread.Handle, 4);
            m_EventThread.Destroy;
            m_EventThread := nil;
         end;
   end;

   //2. Disable the events
   ptEnableEvent.Enabled := 0;
   ptEnableEvent.Count := 1;

   for i := 0 to m_usMaxChanNum-1 do
   begin
      ptEnableEvent.EventType := ADS_EVT_INTERRUPT_DI0+i;
      m_dwErrCde := DRV_EnableEvent(m_lDriverHandle, ptEnableEvent);
      if (DoesErr(m_dwErrCde)=1)then
         Exit;
   end;

   //3. Update UI
   for i := 0 to m_usMaxChanNum-1 do
   begin
     lsvInt.Items.Item[i].Checked := false;
      m_dwEventCount[i] := 0;
   end;

   // 4. Disable the timer
   tmrDIInt.Enabled := false;
   m_dwEventChan := 0;

end;

procedure TForm1.btnScanClick(Sender: TObject);
begin
   tmrDIScan.Enabled := true;
   btnStop.Enabled := true;
   btnScan.Enabled := false;
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
   tmrDIScan.Enabled := false;
   btnStop.Enabled := false;
   btnScan.Enabled := true;
end;

procedure TForm1.tmrDIScanTimer(Sender: TObject);
var
   ptDioReadPortByte: PT_DioReadPortByte;
   usData: Smallint;
begin

   ptDioReadPortByte.port := cmbPort.ItemIndex;
   ptDioReadPortByte.value := @usData;
   m_dwErrCde := DRV_DioReadPortByte(m_lDriverHandle, ptDioReadPortByte);
   if (DoesErr(m_dwErrCde)=1)then
   begin
         btnStopClick(Sender);
         Exit;
   end;
   txtData.Text := IntToHex(usData, 2)+'(H)';
end;

procedure TForm1.tmrDIIntTimer(Sender: TObject);
var
   ratio: single;
   dwTime: DWORD;
   i: Integer;
begin
    m_dwCurrentTime := GetTickCount();
    dwTime := m_dwCurrentTime - m_dwStartTime;
    if(dwTime > 1000)then
    begin
       m_dwStartTime := m_dwCurrentTime;
       for i := 0 to m_usMaxChanNum-1 do
       begin
          ratio := (m_dwEventCount[i] / dwTime) * 1000.0;
          lsvInt.Items.Item[i].SubItems[0] := Format('%.3f', [ratio]);
          m_dwEventCount[i] := 0;
       end;
     end;
end;

procedure TForm1.btnExitClick(Sender: TObject);
begin
    Application.Terminate;
end;

procedure TForm1.ReleaseSrc();
var
    dwExitCode: DWORD;
begin
   //Stop Timer
   tmrDIScan.Enabled := false;
   tmrDIInt.Enabled := false;
   //Stop Thread
   if(m_EventThread <> nil)then
   begin
       GetExitCodeThread(m_EventThread.Handle, dwExitCode );
        if( dwExitCode = STILL_ACTIVE )then
            TerminateThread(m_EventThread.Handle,0);
       m_EventThread.Destroy;
       m_EventThread := nil;
   end;

   if (m_lDriverHandle <> 0)then
   begin
      DRV_DeviceClose(m_lDriverHandle);
      m_lDriverHandle := 0;
   end;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    ReleaseSrc();
end;

end.