unit1.pas

16 relay output channels and 16 isolated digital input channels LED indicators to show activated

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    editSelDev: TEdit;
    btnSelDev: TButton;
    GroupBox2: TGroupBox;
    btnSetTimer: TButton;
    editTimerInt: TEdit;
    Label1: TLabel;
    editRealTimer: TEdit;
    Label2: TLabel;
    labUnit: TLabel;
    GroupBox4: TGroupBox;
    Label3: TLabel;
    editEventCount: TEdit;
    btnEnable: TButton;
    btnDisable: TButton;
    btnClose: TButton;
    rdoMs: TRadioButton;
    rdoUs: TRadioButton;
    rdoS: TRadioButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnSelDevClick(Sender: TObject);
    procedure btnSetTimerClick(Sender: TObject);
    procedure rdoUsClick(Sender: TObject);
    procedure rdoMsClick(Sender: TObject);
    procedure rdoSClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnEnableClick(Sender: TObject);
    procedure btnDisableClick(Sender: TObject);
  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_usUnit: SHORT;

implementation
uses GetEvent;

var
  EventThread: TGetEvent;

{$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);
        editSelDev.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;

        m_usUnit := 1;
        rdoUs.Checked := TRUE;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
        m_bContinue := FALSE;
        if (EventThread <> Nil) then
                EventThread.Terminate;
        
        if ( m_DriverHandle <> NULL ) then
                DRV_DeviceClose(m_DriverHandle);
end;

procedure TForm1.btnSelDevClick(Sender: TObject);
var
        DeviceName: array [0..49] of char;
begin
        DRV_SelectDevice(Handle, FALSE, m_ulDevNum, DeviceName);
        editSelDev.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.btnSetTimerClick(Sender: TObject);
var
        ulTimerInterval: Longint;
        ulSize: Longint;
        usDividor: SHORT;
        fFreq: Real;
        fFreqBase: Real;
        pTimerFreq: array of Single;
        iSize: Integer;
        ptTimerCountSetting: PT_TimerCountSetting;
begin
        if (m_usUnit = 3) then// s
                ulTimerInterval := StrToInt(editTimerInt.Text) * 1000000
        else
        begin
                if (m_usUnit = 2) then // ms
                        ulTimerInterval := StrToInt(editTimerInt.Text) * 1000
                else // us
                        ulTimerInterval := StrToInt(editTimerInt.Text);
        end;


      	fFreq := 1000000.0 / ulTimerInterval; // HZ
        if (fFreq > 5000.0) then
                fFreqBase := 50000.0; // 50khz
        if ((fFreq <= 5000.0) and (fFreq > 500.0)) then
                fFreqBase := 5000.0; // 5khz
        if ((fFreq <= 500.0) and (fFreq > 50.0)) then
                fFreqBase := 500.0; // 500hz
        if ((fFreq <= 50.0) and (fFreq > 5.0)) then
                fFreqBase := 50.0; // 50hz
        if (fFreq <= 5.0) then
                fFreqBase := 5.0; // 5hz

        usDividor := Trunc(ulTimerInterval * fFreqBase / 1000000.0 + 0.5);
        if (usDividor = 0) then
                usDividor := 1;

        // Set Timer Base
        m_ErrCde := DRV_DeviceGetProperty(m_DriverHandle, CFG_CntrClockFrequency, NIL, ulSize);
        iSize := ulSize div SizeOf(Single);
        SetLength(pTimerFreq, iSize);
        m_ErrCde := DRV_DeviceGetProperty(m_DriverHandle, CFG_CntrClockFrequency, pTimerFreq, ulSize);
        pTimerFreq[4] := fFreq;
        m_ErrCde := DRV_DeviceSetProperty(m_DriverHandle, CFG_CntrClockFrequency, pTimerFreq, ulSize);
        if (m_ErrCde <> SUCCESS) then
        begin
                DRV_GetErrorMessage(m_ErrCde, @m_szErrMsg[0]);
                MessageBox(Handle, m_szErrMsg, 'Drvier Message', MB_OK);
        end;

        // Set timer dividor
        ptTimerCountSetting.counter := 4;
        ptTimerCountSetting.Count := usDividor;
        m_ErrCde := DRV_TimerCountSetting(m_DriverHandle, ptTimerCountSetting);
        if (m_ErrCde <> SUCCESS) then
        begin
                DRV_GetErrorMessage(m_ErrCde, @m_szErrMsg[0]);
                MessageBox(Handle, m_szErrMsg, 'Drvier Message', MB_OK);
        end;

        // real timer interval
        ulTimerInterval := Trunc(1000000 / Trunc(fFreqBase) * usDividor);
        if (ulTimerInterval < 1000) then
                labUnit.Caption := 'us';
        if ((ulTimerInterval >= 1000) and (ulTimerInterval < 1000000)) then
        begin
                ulTimerInterval := Trunc(ulTimerInterval / 1000);
                labUnit.Caption := 'ms';
        end;
        if (ulTimerInterval >= 1000000) then
        begin
                ulTimerInterval := Trunc(ulTimerInterval / 1000000);
                labUnit.Caption := 's';
        end;

        editRealTimer.Text := IntToStr(ulTimerInterval);
                
end;

procedure TForm1.rdoUsClick(Sender: TObject);
begin
        m_usUnit :=  1;
end;

procedure TForm1.rdoMsClick(Sender: TObject);
begin
        m_usUnit := 2;
end;

procedure TForm1.rdoSClick(Sender: TObject);
begin
        m_usUnit := 3;
end;

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

procedure TForm1.btnEnableClick(Sender: TObject);
var
        ptEventSetting: PT_EnableEvent;
begin
        // reset counter
        m_ErrCde := DRV_CounterReset(m_DriverHandle, 0);

        // Enable Event
        ptEventSetting.Count := 1;
        ptEventSetting.Enabled := 1;
        ptEventSetting.EventType := ADS_EVT_INTERRUPT_TIMER4;
        m_ErrCde := DRV_EnableEvent(m_DriverHandle, ptEventSetting);
        if (m_ErrCde <> SUCCESS) then
        begin
                DRV_GetErrorMessage(m_ErrCde, @m_szErrMsg[0]);
                MessageBox(Handle, m_szErrMsg, 'Drvier Message', MB_OK);
        end;

        btnSelDev.Enabled := false;
        btnEnable.Enabled := false;
        btnDisable.Enabled := true;
        btnClose.Enabled := false;

        m_bContinue := true;
        EventThread := TGetEvent.Create(False);

end;

procedure TForm1.btnDisableClick(Sender: TObject);
var
        ptEnableEvent: PT_EnableEvent;
begin
        btnSelDev.Enabled := true;
        btnEnable.Enabled := true;
        btnDisable.Enabled := false;
        btnClose.Enabled := true;

        ptEnableEvent.EventType := ADS_EVT_INTERRUPT_TIMER4;
        ptEnableEvent.Enabled := 0;
        m_ErrCde := DRV_EnableEvent(m_DriverHandle, ptEnableEvent);

        m_bContinue := false;
        EventThread.Terminate;
end;

end.