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

📄 unit1.pas

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

interface

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

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    editDevName: TEdit;
    btnSelDev: TButton;
    GroupBox2: TGroupBox;
    cmbCounter: TComboBox;
    GroupBox3: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    editStartPort: TEdit;
    editPortCount: TEdit;
    GroupBox4: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    editStartCntr: TEdit;
    editCntrCount: TEdit;
    GroupBox5: TGroupBox;
    lsvCntr: TListView;
    lsvDI: TListView;
    btnStart: TButton;
    btnStop: TButton;
    btnClose: TButton;
    editCompData: TEdit;
    Label1: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    cmbInt: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure btnSelDevClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure CheckEvent();
    procedure btnCloseClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  m_ErrCde: Longint;
  m_DriverHandle: Longint;
  m_szErrMsg: array [0..79] of char;
  m_ulDevNum: Longint;
  m_bContinue: Boolean;
  m_CurCounter: SHORT;
  m_InterruptSrc: Longint;
  m_StartPort: Longint;
  m_PortCount: Longint;
  m_StartCntr: Longint;
  m_CntrCount: Longint;
  Thread  : TCheckThread;
  ptEnableEvent : PT_EnableEvent;     // Enable event
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
        DeviceName: array [0..49] of char;
begin
        m_ulDevNum := 0;
        DRV_SelectDevice(Handle, FALSE, m_ulDevNum, DeviceName);
        editDevName.Text := DeviceName;
        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;
        cmbCounter.ItemIndex := 0;
        cmbInt.ItemIndex := 0;
        btnStop.Enabled := False;
end;
procedure TForm1.btnSelDevClick(Sender: TObject);
var
        DeviceName: array [0..49] of char;
begin
        DRV_SelectDevice(Handle, FALSE, m_ulDevNum, DeviceName);
        editDevName.Text := DeviceName;
        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;
end;

procedure TForm1.btnStartClick(Sender: TObject);
var
        dwEventID: Longint;
        ulSize: Longint;
        iSize: Integer;
        pCompData: array of Longint;
begin
        lsvDI.Items.Clear();
        lsvCntr.Items.Clear();
        
        m_StartPort := StrToInt(editStartPort.Text);
        m_PortCount := StrToInt(editPortCount.Text);
        m_StartCntr := StrToInt(editStartCntr.Text);
        m_CntrCount := StrToInt(editCntrCount.Text);
        m_CurCounter := cmbCounter.ItemIndex;

        dwEventID := 0;
        case cmbInt.ItemIndex of
        0: dwEventID := ADS_EVT_OVERFLOW_CNT0 + m_CurCounter;
        1: dwEventID := ADS_EVT_UNDERFLOW_CNT0 + m_CurCounter;
        2: dwEventID := ADS_EVT_INDEX_CNT0 + m_CurCounter;
        3: dwEventID := ADS_EVT_OVERCOMPARE_CNT0 + m_CurCounter;
        4: dwEventID := ADS_EVT_UNDERCOMPARE_CNT0 + m_CurCounter;
        5: dwEventID := ADS_EVT_DI_INTERRUPT0;
        6: dwEventID := ADS_EVT_DI_INTERRUPT1;
        7: dwEventID := ADS_EVT_DI_INTERRUPT2;
        8: dwEventID := ADS_EVT_DI_INTERRUPT3;
        9: dwEventID := ADS_EVT_INTERRUPT_TIMER4;
        end;

        m_InterruptSrc := dwEventID;

        if ((dwEventID >= ADS_EVT_DI_INTERRUPT0) and (dwEventID <= ADS_EVT_DI_INTERRUPT3 )) then
        begin
                m_ErrCde := AdxDioEnableEventAndSpecifyDiPorts(m_DriverHandle,
                        dwEventID, m_StartPort, m_PortCount);

                m_ErrCde := AdxDioEnableEventAndSpecifyEventCounter(m_DriverHandle,
                        dwEventID, m_StartCntr, m_CntrCount);
        end
        else
        begin
                m_ErrCde := AdxCntrEnableEventAndSpecifyEventCounter(m_DriverHandle,
                        dwEventID, m_StartCntr, m_CntrCount);
        end;
        if (m_ErrCde <> SUCCESS) then
        begin
                DRV_GetErrorMessage(m_ErrCde, @m_szErrMsg[0]);
                MessageBox(Handle, m_szErrMsg, 'Driver Message', MB_OK);
        end;

        if ((dwEventID = ADS_EVT_OVERCOMPARE_CNT0 + m_CurCounter) or (dwEventID = ADS_EVT_UNDERCOMPARE_CNT0 + m_CurCounter)) then
        begin
                // Set Compare Data
                m_ErrCde := DRV_DeviceGetProperty(m_DriverHandle, CFG_CntrCompareData, NIL, ulSize);
                if (m_ErrCde = SUCCESS) then
                begin
                        iSize := ulSize div SizeOf(ulSize);
                        SetLength(pCompData, iSize);
                        m_ErrCde := DRV_DeviceGetProperty(m_DriverHandle, CFG_CntrCompareData, @pCompData[0], ulSize);
                        pCompData[m_CurCounter] := StrToInt(editCompData.Text);
                        m_ErrCde := DRV_DeviceSetProperty(m_DriverHandle, CFG_CntrCompareData, @pCompData[0], ulSize);
                end;
        end;

        btnSelDev.Enabled := false;
        btnStart.Enabled := false;
        btnStop.Enabled := true;
        btnClose.Enabled := false;
        
        m_bContinue := true;
        Thread := TCheckThread.Create(False);
end;

procedure TForm1.btnStopClick(Sender: TObject);
var
        dwEventID: Longint;
begin
        dwEventID := m_InterruptSrc;
        if ((dwEventID >= ADS_EVT_DI_INTERRUPT0) and (dwEventID <= ADS_EVT_DI_INTERRUPT3)) then
             m_ErrCde := AdxDioDisableEvent(m_DriverHandle, dwEventID)
        else
             m_ErrCde := AdxCntrDisableEvent(m_DriverHandle, dwEventID);

        if (m_ErrCde <> SUCCESS) then
        begin
                DRV_GetErrorMessage(m_ErrCde, @m_szErrMsg[0]);
                MessageBox(Handle, m_szErrMsg, 'Driver Message', MB_OK);
        end;

        m_bContinue := false;
        if (Thread <> Nil) then
                Thread.Terminate;

        btnSelDev.Enabled := true;
        btnStart.Enabled := true;
        btnStop.Enabled := false;
        btnClose.Enabled := true;

end;

procedure TForm1.CheckEvent();
var
        ptCheckEvent: PT_CheckEvent;
        usEventType: Word;
        pData: array[0..2] of Byte;
        pCntrData: array[0..3] of Longint;
        i: SHORT;
        usTmp: SHORT;
        pListItem: TListItem;
        ulTmp: Longint;
begin
        ptCheckEvent.EventType := @usEventType;
        ptCheckEvent.Milliseconds := 1000;

        while ( m_bContinue) do
        begin
                if (DRV_CheckEvent(m_DriverHandle, ptCheckEvent) = SUCCESS) then
                begin
                        if ((usEventType >= ADS_EVT_DI_INTERRUPT0) and (usEventType <= ADS_EVT_DI_INTERRUPT3)) then
                        begin
                                AdxDioGetLatestEventDiPortsState(m_DriverHandle, usEventType, pData[0], m_PortCount);
                                lsvDI.Items.Clear();
                                for i := 0 to m_PortCount - 1 do
                                begin
                                        usTmp := i + m_StartPort;
                                        pListItem := lsvDI.Items.Add();
                                        pListItem.Caption := Format('Port%d',[usTmp]);
                                        usTmp := pData[i];
                                        pListItem.SubItems.Add(Format('%d', [usTmp]));
                                end;
                        end;
                        if ((usEventType <> ADS_EVT_NO_EVENT) and (usEventType <> ADS_EVT_TIME_OUT) ) then
                        begin
                                AdxCntrGetLatestEventCounterValue(m_DriverHandle, usEventType, pCntrData[0], m_CntrCount);
                                lsvCntr.Items.Clear();
                                for i := 0 to m_CntrCount - 1 do
                                begin
                                        usTmp := i + m_StartCntr;
                                        pListItem := lsvCntr.Items.Add();
                                        pListItem.Caption := Format('Counter%d', [usTmp]);
                                        ulTmp := pCntrData[i];
                                        pListItem.SubItems.Add (IntToStr(ulTmp));
                                end;
                        end;
                end;
        end;
end;

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

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
        m_bContinue := FALSE;
        if (Thread <> Nil) then
                Thread.Terminate;

        if ( m_DriverHandle <> NULL ) then
                DRV_DeviceClose(m_DriverHandle);        
end;

end.


⌨️ 快捷键说明

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