startup.pas

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

unit StartUp;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,
  PMCfg, SCCfg, Driver, ExtCtrls, Thread;

type
  TfStartUp = class(TForm)
    txtDeviceName: TEdit;
    Label1: TLabel;
    cmdSelectDevice: TButton;
    Label2: TLabel;
    txtChannel: TEdit;
    grpConfig: TGroupBox;
    GroupBox2: TGroupBox;
    Label4: TLabel;
    txtPA0Value: TEdit;
    Label5: TLabel;
    txtPA0Mask: TEdit;
    cmdPatternMatch: TButton;
    txtPA4Mask: TEdit;
    Label7: TLabel;
    txtPA4Value: TEdit;
    Label6: TLabel;
    GroupBox3: TGroupBox;
    Label3: TLabel;
    txtPB0Mask: TEdit;
    Label8: TLabel;
    txtPB4Mask: TEdit;
    cmdStatusChange: TButton;
    GroupBox4: TGroupBox;
    radPCEnable: TRadioButton;
    radPCDisable: TRadioButton;
    Label9: TLabel;
    txtScanTime: TEdit;
    Label10: TLabel;
    GroupBox5: TGroupBox;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    txtPMCount: TEdit;
    txtSCCount: TEdit;
    txtINTCount: TEdit;
    txtData: TEdit;
    cmdStart: TButton;
    cmdExit: TButton;
    cmdStop: TButton;
    tmrScan: TTimer;
    procedure cmdExitClick(Sender: TObject);
    procedure cmdPatternMatchClick(Sender: TObject);
    procedure cmdStatusChangeClick(Sender: TObject);
    procedure cmdStartClick(Sender: TObject);
    procedure cmdStopClick(Sender: TObject);
    procedure cmdSelectDeviceClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure txtScanTimeChange(Sender: TObject);
    procedure txtChannelChange(Sender: TObject);
    procedure tmrScanTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    lDeviceNumber   : Longint;
    ptEnableEventEx : PT_EnableEventEx;     {Enable event}
    ptEnableEvent   : PT_EnableEvent;       {Enable event}

    ptDioReadPortByte : PT_DioReadPortByte;
    wDiValue : Smallint;

  	wThread : TWatchThread;
  	TData   :   PT_ThreadData;
  public
    { Public declarations }
    ghDev          : Longint;       {Device handle for every device}
  end;

var
  fStartUp: TfStartUp;

implementation
{************************************************************}
{ Function : Convert Hex string to Integer. It will termined }
{            at first invalied character.                    }
{            Function will stop convertion at first invalied }
{            character.                                      }
{ Input    : sVal, IN, Hex string for convertion.            }
{ Return   : Integer value after convertion                  }
{************************************************************}
Function HexToInt(const sVal : string) : Integer;
Var
   i,k,iRet : Integer;
   cVal : Char;
Begin
   iRet := 0;

   {Convert every valid character}
   For i:=1 to Length(sVal) do
   Begin
      cVal := sVal[i];

      if (cVal >= '0') And (cVal <= '9') then
         k := Byte(cVal) - Byte('0')
      Else if (cVal >= 'a') and (cVal <= 'f') then
         k := Byte(cVal) - Byte('a') + 10
      Else if (cVal >= 'A') and (cVal <= 'F') then
         k := Byte(cVal) - Byte('A') + 10
      Else
         Break;

      {Accumulate convert value}
      iRet := iRet*16 + k;
   End;
   HexToInt := iRet;
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);
    Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
    DoesErr := 1;
  end
  else
    DoesErr := 0;
end;

{$R *.DFM}
procedure TfStartUp.cmdExitClick(Sender: TObject);
begin
    Application.Terminate
end;

procedure TfStartUp.cmdPatternMatchClick(Sender: TObject);
begin
    with fPMConfig do
    begin
        iPA0Mask := HexToInt(txtPA0Mask.Text);
        iPA0Value := HexToInt(txtPA0Value.Text);
        iPA4Mask := HexToInt(txtPA4Mask.Text);
        iPA4Value := HexToInt(txtPA4Value.Text);

        ShowModal;

        txtPA0Mask.Text := IntToHex(iPA0Mask,2);
        txtPA0Value.Text := IntToHex(iPA0Value,2);
        txtPA4Mask.Text := IntToHex(iPA4Mask,2);
        txtPA4Value.Text := IntToHex(iPA4Value,2);
    end;
end;

procedure TfStartUp.cmdStatusChangeClick(Sender: TObject);
begin
    with fSCConfig do
    begin
        giPB0Value := HexToInt(txtPB0Mask.Text);
        giPB4Value := HexToInt(txtPB4Mask.Text);

        ShowModal;

        txtPB0Mask.Text := IntToHex(giPB0Value,2);
        txtPB4Mask.Text := IntToHex(giPB4Value,2);

    end;
end;

procedure TfStartUp.cmdStartClick(Sender: TObject);
var
  lErrCde : Longint;
  iTmp    : integer;
  bStartEvent : boolean;
begin

  bStartEvent := False;

  {1. Open device }
  lErrCde := DRV_DeviceOpen( lDeviceNumber, ghDev);
  if( DoesErr(lErrCde) = 1 ) then  Exit;

  {2. If want Enable Pattern Match event feature, enable it}
  iTmp := HexToInt(txtPA0Mask.text)+ HexToInt(txtPA4Mask.text)*256;
  if iTmp <> 0 Then
  begin
    txtPA0Mask.Tag := iTmp;    {Record that has enable this function}

    {2.1 Fill Pattern match feature needs data}
    with ptEnableEventEx.Pattern do
    begin
      EventType := ADS_EVT_PATTERNMATCH;
      EventEnabled := 1;
      Count := 1;
      EnableMask := iTmp;
      PatternValue := HexToInt(txtPA0Value.text)+HexToInt(txtPA4Value.text)*256;
    end;

    {2.2 Start up Event match function}
    lErrCde := DRV_EnableEventEx(ghDev, @ptEnableEventEx);
    if( DoesErr(lErrCde) = 1 ) then
    begin
      DRV_DeviceClose(ghDev);
      Exit;
    End;

    bStartEvent := True;
  End;

  {3. Enable Status Change event feature}
  iTmp := HexToInt(txtPB0Mask.Text) + HexToInt(txtPB4Mask.Text) * 256;
  if iTmp <> 0 then
  begin
    txtPB0Mask.Tag := iTmp; {Record that has start this function}

    {3.1 Fill status change need data}
    with ptEnableEventEx.Status  do
    begin
      EventType := ADS_EVT_STATUSCHANGE;
      EventEnabled := 1;
      Count := 1;
      EnableMask := iTmp;
    end;

    {3.2 start function}
    lErrCde := DRV_EnableEventEx(ghDev, @ptEnableEventEx);
    if( DoesErr(lErrCde) = 1 ) then
    begin
      DRV_DeviceClose(ghDev);
      Exit;
    End;

    bStartEvent := True;
  end; {End of starting Status change }

  {4. Enable Interrupt function }
  if radPCEnable.Checked then
  begin
    {4.1 Fill table for interrupt function }
    with ptEnableEvent do
    begin
      EventType := ADS_EVT_INTERRUPT;
      Enabled := 1;
      Count := 1;
    end;

    {4.2 Start Interrupt function}
    lErrCde := DRV_EnableEvent( ghDev, ptEnableEvent);
    if( DoesErr(lErrCde) = 1 ) then
    begin
      DRV_DeviceClose(ghDev);
      Exit;
    End;
    bStartEvent := True;
  end; {End of if radPCEnable.Checked}

  {5. Create thread}
  if bStartEvent Then
  begin
    TData.ghDev := ghDev;
    TData.ptxtPMCount := @txtPMCount;
    TData.ptxtSCCount := @txtSCCount;
    TData.ptxtIntCount := @txtIntCount;

    wThread:= TWatchThread.Create(TData);

  End;


  {6. Start timer for display message}
  tmrScan.Enabled := True;

  {7. Manage user interface}
  cmdStart.Enabled := False;
  cmdStop.Enabled := True;
  cmdExit.Enabled := False;
  grpConfig.Enabled := False;

  txtPMCount.Text := '';
  txtSCCount.Text := '';
  txtINTCount.Text := '';
  txtData.Text := '';
end;

procedure TfStartUp.cmdStopClick(Sender: TObject);
var
  lErrCde : Longint;
begin
  {1. Stop thread}
  If Assigned(WThread) Then WThread.Terminate;

  if ghDev <> 0 then
  begin
    {2. Stop Pattern match and Status change function }
    if ((txtPB0Mask.Tag <> 0) or (txtPA0Mask.Tag <> 0)) then
    begin
      {2.1 fill table}
      with ptEnableEventEx.Status  do
      begin
        EventType := 0;
        EventEnabled := 0;
      end;

      {2.2 stop this function}
      lErrCde := DRV_EnableEventEx(ghDev, @ptEnableEventEx);
      if( DoesErr(lErrCde) = 1 ) then
      begin
        DRV_DeviceClose(ghDev);
        Exit;
      End;

      txtPA0Mask.Tag := 0; {Record stop success}
      txtPB0Mask.Tag := 0;
    end;

    {3. Stop Interrupt functions}
    if radPCEnable.Checked then
    begin

      {3.1 fill table}
      with ptEnableEvent do
      begin
        EventType := ADS_EVT_INTERRUPT;
        Enabled := 0;
        Count := 1;
      end;

      {3.2 Disable Interrupt function}
      lErrCde := DRV_EnableEvent(ghDev, ptEnableEvent);
      if( DoesErr(lErrCde) = 1 ) then
      begin
        DRV_DeviceClose(ghDev);
        Exit;
      End;
    end;

    {4. Stop scan timer}
    tmrScan.Enabled := False;

    {5. Close device }
    DRV_DeviceClose(ghDev);
    ghDev := 0;
  End; {End if ghDev <> .... }

  {6. Manage user interface }
  cmdStop.Enabled := False;
  cmdStart.Enabled := True;
  cmdExit.Enabled := True;
  grpConfig.Enabled := True;
end;

procedure TfStartUp.cmdSelectDeviceClick(Sender: TObject);
var
  szDeviceName : array[0..100] of char;
  lErrCde      : Longint;
begin
  {Select devcie from device list}
  lErrCde := DRV_SelectDevice( Handle, True, lDeviceNumber, szDeviceName);
  if( DoesErr(lErrCde) = 1 ) then Exit;
  txtDeviceName.Text := szDeviceName;

end;

procedure TfStartUp.FormCreate(Sender: TObject);
begin
  {Select a device at starting}
  cmdSelectDeviceClick(Sender);

  {Initial table}
  ptDioReadPortByte.value := @wDiValue;

  ghDev := 0;
end;

procedure TfStartUp.txtScanTimeChange(Sender: TObject);
begin
  tmrScan.Interval := StrToInt(txtScanTime.text);
end;

procedure TfStartUp.txtChannelChange(Sender: TObject);
begin
  if txtChannel.text <> '' then
    ptDioReadPortByte.port := StrToInt(txtChannel.text);
end;
procedure TfStartUp.tmrScanTimer(Sender: TObject);
var
  lErrCde : LongInt;
begin

  {Read DIO data}
  lErrCde := DRV_DioReadPortByte(ghDev,ptDioReadPortByte);
  if (DoesErr(lErrCde) = 1) then Exit ;

  {Display data}
  txtData.Text := IntToHex(wDiValue, 2);

end;

procedure TfStartUp.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  cmdStopClick(Sender);
end;

end.