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

📄 mainform.pas

📁 16 relay output channels and 16 isolated digital input channels LED indicators to show activated
💻 PAS
📖 第 1 页 / 共 2 页
字号:
   }

   end;
end;

procedure TfrmMain.btnFallingClick(Sender: TObject);
var
   DiDlg: TDISettingDlg;

begin
   Application.CreateForm(TDISettingDlg, DiDlg);
   for i := 0 to m_DIPortNum - 1 do
   begin
      if (DIFallingTrigger[i] = $FF) then
         DiDlg.chklstPort.Checked[i] := True;
      for j := 0 to 7 do
      begin
         if ((DIFallingTrigger[i] and (1 shl j)) <> 0) then
            DiDlg.chklstChan.Checked[i * 8 + j] := True
         else
            DiDlg.chklstChan.Checked[i * 8 + j] := False;
      end;
   end;
   DiDlg.labInfo.Caption := 'Enable or disable Falling trigger for every DI channel:';
   if (mrOK = DiDlg.ShowModal())  then
   begin
   for i := 0 to m_DIChanNum - 1 do
   begin
      if (DiDlg.chklstChan.Checked[i]) then
         DIFallingTrigger[i div 8] := DIFallingTrigger[i div 8] or (1 shl (i mod 8))
      else
         DIFallingTrigger[i div 8] := DIFallingTrigger[i div 8] and (not (1 shl (i mod 8)));
   end;
   SetlstTrigger();
   ulDataLength := sizeof(Byte) * 16;
   DRV_DeviceSetProperty(m_DeviceHandle, CFG_DiTriggerEnableFallingForAll,
      @(DIFallingTrigger[0]), ulDataLength);
   //or
   {
      ulDataLength := sizeof(Byte) ;
      for i:=0 to 15 do
         DRV_DeviceSetProperty( m_DeviceHandle, CFG_DiTriggerEnableRisingPort0+i,
         &(DIFallingTrigger[i]) , ulDataLength);
   }

end;
end;

procedure TfrmMain.btnFilterClick(Sender: TObject);
var
   DiDlg: TDISettingDlg;

begin
   Application.CreateForm(TDISettingDlg, DiDlg);
   for i := 0 to m_DIPortNum - 1 do
   begin
      if (DIFilterEnable[i] = $FF) then
         DiDlg.chklstPort.Checked[i] := True;
      for j := 0 to 7 do
      begin
         if ((DIFilterEnable[i] and (1 shl j)) <> 0) then
            DiDlg.chklstChan.Checked[i * 8 + j] := True
         else
            DiDlg.chklstChan.Checked[i * 8 + j] := False;
      end;
   end;
   DiDlg.labInfo.Caption := 'Enable or disable Filter for every DI channel:';
   if( mrOK = DiDlg.ShowModal()) then
   begin
   for i := 0 to m_DIChanNum - 1 do
   begin
      if (DiDlg.chklstChan.Checked[i]) then
         DIFilterEnable[i div 8] := DIFilterEnable[i div 8] or (1 shl (i mod 8))
      else
         DIFilterEnable[i div 8] := DIFilterEnable[i div 8] and (not (1 shl (i mod 8)));
   end;
   SetlstFilter();
   ulDataLength := sizeof(DWORD);
   DRV_DeviceSetProperty(m_DeviceHandle, CFG_DiFilterIntervalCounter,
      @m_FilterCounter, ulDataLength);
   ulDataLength := sizeof(Byte) * 16;
   DRV_DeviceSetProperty(m_DeviceHandle, CFG_DiFilterEnableForAll,
      @(DIFilterEnable[0]), ulDataLength);

   //or
     {
   ulDataLength := sizeof(Byte);
   for i := 0 to 15 do
   begin
      DRV_DeviceSetProperty(m_DeviceHandle, CFG_DiFilterEnablePort0 + i,
         @(DIFilterEnable[i]), ulDataLength);
   end;
   }
   end;

end;

procedure TfrmMain.lstIntChannelChange(Sender: TObject; Item: TListItem;
   Change: TItemChange);
var
   EventSetting: PT_EnableEvent;
   usTemp: Integer;
   dwExitCode: DWORD;
begin

   if( bDIEnableINT[Item.Index] =  Item.Checked) then
     exit;
   EventSetting.EventType := ADS_EVT_INTERRUPT_DI0 + Item.Index;
   if (Item.Checked) then
   begin
      EventSetting.Enabled := 1;
      EventSetting.Count := 1;
      dwEventCount[Item.Index] := 0;
      DIInterruptEnable[Item.Index div 8] := DIInterruptEnable[Item.Index div 8]
         or (1 shl (Item.Index mod 8));
   end
   else
   begin
      EventSetting.Enabled := 0;
      EventSetting.Count := 0;
      DIInterruptEnable[Item.Index div 8] := DIInterruptEnable[Item.Index div 8]
         and (not (1 shl (Item.Index mod 8)));
   end;
   m_ErrCde := DRV_EnableEvent(m_DeviceHandle, EventSetting);
   if (DoesErr(m_ErrCde) = 1) then
      Exit;

   if (Assigned(chkThread) = False) then
   begin
      chkThread := CheckThread.Create(true);
      chkThread.Priority :=tpHighest;
         chkThread.Resume();
      dwStartTime := GetTickCount();
      IntTimer.Enabled := true;
   end;

   usTemp := 0;
   for i := 0 to 15 do
      usTemp := usTemp or DIInterruptEnable[i];

   if ((usTemp = 0) and Assigned(chkThread)) then
   begin
      GetExitCodeThread(chkThread.Handle, dwExitCode);
      if (dwExitCode = STILL_ACTIVE) then
      begin
         TerminateThread(chkThread.Handle, dwExitCode);
         chkThread.Terminate();
         chkThread.Free;
         IntTimer.Enabled := False;
          chkThread := nil;
      end;
   end;
end;

procedure TfrmMain.CheckEventProc();
var
   ptCheckEvent: PT_CheckEvent;
   usEventType: Smallint;
   indx: Smallint;
begin

   ptCheckEvent.EventType := @usEventType;
   ptCheckEvent.Milliseconds := INFINITE;

   while (true) do
   begin
      DRV_CheckEvent(m_DeviceHandle, ptCheckEvent);

      indx := usEventType - ADS_EVT_INTERRUPT_DI0;
      if ((indx >= 0) and (indx < 128)) then
         dwEventCount[indx] := dwEventCount[indx] + 1;

   end;

end;

procedure TfrmMain.IntTimerTimer(Sender: TObject);
var
   ratio: single;
begin

   dwCurrentTime := GetTickCount();
   dwTime := dwCurrentTime - dwStartTime;

   if (dwTime > 1000) then
   begin
      dwStartTime := dwCurrentTime;
      for i := 0 to 127 do
      begin
         ratio := dwEventCount[i] * 1000.0 / dwTime;
         szBuff := Format('%0.1f', [ratio]);
         dwEventCount[i] := 0;
         lstIntChannel.Items[i].SubItems[2] := szBuff;
      end;

   end;

end;

procedure TfrmMain.btnStopAllClick(Sender: TObject);
var
   dwExitCode: DWORD;
begin
   for i := 0 to m_DIChanNum-1 do
   begin
      if(lstIntChannel.Items[i].Checked )   then
       lstIntChannel.Items[i].Checked:= False;
   end;

   if (Assigned(chkThread)) then
   begin
      GetExitCodeThread(chkThread.Handle, dwExitCode);
      if (dwExitCode = STILL_ACTIVE) then
      begin
         TerminateThread(chkThread.Handle, dwExitCode);
         chkThread.Terminate();
         chkThread.Free;
         chkThread := nil;
         IntTimer.Enabled := False;
      end;
   end;
end;

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

procedure TfrmMain.ScanTimerTimer(Sender: TObject);
var
   DIValue: Smallint;
   ptDioReadPortByte: PT_DioReadPortByte;
begin

   ptDioReadPortByte.port := cmbPort.ItemIndex;
   ptDioReadPortByte.value := @DIValue;
   DRV_DioReadPortByte(m_DeviceHandle, ptDioReadPortByte);
   szBuff := Format('%2.2xH', [DIValue]);
   editScanData.Text := szBuff;

end;

procedure TfrmMain.btnStartClick(Sender: TObject);
begin
   ScanTimer.Enabled := True;
   btnStart.Enabled := False;
   btnStop.Enabled := True;
   ScanTimer.Interval := StrToInt(editScanTime.Text);
end;

procedure TfrmMain.btnStopClick(Sender: TObject);
begin
   ScanTimer.Enabled := False;
   btnStart.Enabled := True;
   btnStop.Enabled := False;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
   btnSelDevClick(Sender);
end;

procedure TfrmMain.txtFilterCounterChange(Sender: TObject);
var
   fFilterKHz: Single;
begin
   fFilterKHz := StrToFloat(txtFilterCounter.Text);
   labFilterHz.Caption := Format('%0.3f', [10000.0 / (fFilterKHz * 2.0)]);
   m_FilterCounter := StrToInt64( txtFilterCounter.Text );
    ulDataLength := sizeof(DWORD);
   DRV_DeviceSetProperty(m_DeviceHandle, CFG_DiFilterIntervalCounter,
      @m_FilterCounter, ulDataLength);
end;

end.

⌨️ 快捷键说明

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