mainform.pas

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

   chValue: SmallInt;

begin
   ptDioGetCurrentDOByte.port := cmbPort.ItemIndex;
   ptDioGetCurrentDOByte.value := @chValue;
   m_ErrCde := DRV_DioGetCurrentDOByte(m_DeviceHandle, ptDioGetCurrentDOByte);

   if (DoesErr(m_ErrCde) = 1) then
      Exit;

   txtPortStatus.Text := Format('%2.2x', [chValue]);
   if ((chValue and (1 shl 0)) <> 0) then
      chkDI0.Checked := true
   else
      chkDI0.Checked := False;
   if ((chValue and (1 shl 1)) <> 0) then
      chkDI1.Checked := true
   else
      chkDI1.Checked := False;
   if ((chValue and (1 shl 2)) <> 0) then
      chkDI2.Checked := true
   else
      chkDI2.Checked := False;
   if ((chValue and (1 shl 3)) <> 0) then
      chkDI3.Checked := true
   else
      chkDI3.Checked := False;
   if ((chValue and (1 shl 4)) <> 0) then
      chkDI4.Checked := true
   else
      chkDI4.Checked := False;
   if ((chValue and (1 shl 5)) <> 0) then
      chkDI5.Checked := true
   else
      chkDI5.Checked := False;
   if ((chValue and (1 shl 6)) <> 0) then
      chkDI6.Checked := true
   else
      chkDI6.Checked := False;
   if ((chValue and (1 shl 6)) <> 0) then
      chkDI6.Checked := true
   else
      chkDI6.Checked := False;
   if ((chValue and (1 shl 7)) <> 0) then
      chkDI7.Checked := true
   else
      chkDI7.Checked := False;
end;

procedure TfrmMain.cmbPortChange(Sender: TObject);
begin
   btnReadClick(Sender);
end;

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

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   if (Assigned(chkThread)) then
   begin
      GetExitCodeThread(chkThread.Handle, dwExitCode);
      if (dwExitCode = STILL_ACTIVE) then
      begin
         TerminateThread(chkThread.Handle, dwExitCode);
         chkThread.Terminate();
         chkThread.Destroy;
         chkThread := nil;
      end;
      m_ErrCde := DRV_WatchdogStop(m_DeviceHandle);
      if (DoesErr(m_ErrCde) = 1) then
         Exit;

      ptEnableEvent.EventType := ADS_EVT_WATCHDOG_OVERRUN;
      ptEnableEvent.Enabled := 0;
      ptEnableEvent.Count := 1;
      m_ErrCde := DRV_EnableEvent(m_DeviceHandle, ptEnableEvent);
   end;

end;

procedure TfrmMain.textEditChange(Sender: TEdit);
var
   lStart: Longint;
   lLength: Longint;
   strHex: string;
begin

   if (Length(Sender.Text) > 4) then
   begin
      //Out of value bound
      lStart := Sender.SelStart;
      lLength := Sender.SelLength;
      if lStart <> 0 then
         lStart := lStart - 1;

      Sender.Text := IntToHex(Sender.Tag, 4);

      Sender.SelStart := lStart;
      Sender.SelLength := lLength;
   end;

   if (Length(Sender.Text) = 0) then
   begin
      // 0 Value
      Sender.Text := '0';
      Sender.SelStart := 0;
   end;
   strHex := '$' + Sender.Text;
   lStart := StrToInt(strHex);
   Sender.Tag := lStart;
end;

procedure TfrmMain.txtP1Change(Sender: TObject);
begin
   textEditChange(txtP1);

end;

procedure TfrmMain.txtEditKeyPress(var Key: Char);
var
   Asckey: BYTE;
   i: Integer;

begin

   Asckey := BYTE(Key);

   if ((Asckey >= BYTE('0')) and (Asckey <= BYTE('9'))) then
      exit;

   if ((Asckey >= BYTE('A')) and (Asckey <= BYTE('F'))) then
      exit;

   if ((Asckey >= BYTE('a')) and (Asckey <= BYTE('f'))) then
   begin
      for i := 0 to (BYTE('a') - BYTE('A') - 1) do
      begin
         Dec(Key);
      end;
      exit;
   end;

   Key := Low(Key);
end;

procedure TfrmMain.txtP1KeyPress(Sender: TObject; var Key: Char);
begin
   txtEditKeyPress(Key);
end;

procedure TfrmMain.txtP2Change(Sender: TObject);
begin
   textEditChange(txtP2);
end;

procedure TfrmMain.txtP2KeyPress(Sender: TObject; var Key: Char);
begin
   txtEditKeyPress(Key);
end;

procedure TfrmMain.txtP3Change(Sender: TObject);
begin
   textEditChange(txtP3);
end;

procedure TfrmMain.txtP4Change(Sender: TObject);
begin
   textEditChange(txtP4);
end;

procedure TfrmMain.txtP5Change(Sender: TObject);
begin
   textEditChange(txtP5);
end;

procedure TfrmMain.txtP6Change(Sender: TObject);
begin
   textEditChange(txtP6);
end;

procedure TfrmMain.txtP7Change(Sender: TObject);
begin
   textEditChange(txtP7);
end;

procedure TfrmMain.txtP8Change(Sender: TObject);
begin
   textEditChange(txtP8);
end;

procedure TfrmMain.txtP3KeyPress(Sender: TObject; var Key: Char);
begin
   txtEditKeyPress(Key);
end;

procedure TfrmMain.txtP4KeyPress(Sender: TObject; var Key: Char);
begin
   txtEditKeyPress(Key);
end;

procedure TfrmMain.txtP5KeyPress(Sender: TObject; var Key: Char);
begin
   txtEditKeyPress(Key);
end;

procedure TfrmMain.txtP6KeyPress(Sender: TObject; var Key: Char);
begin
   txtEditKeyPress(Key);
end;

procedure TfrmMain.txtP7KeyPress(Sender: TObject; var Key: Char);
begin
   txtEditKeyPress(Key);
end;

procedure TfrmMain.txtP8KeyPress(Sender: TObject; var Key: Char);
begin
   txtEditKeyPress(Key);
end;

procedure TfrmMain.txtWP1Change(Sender: TObject);
begin
   textEditChange(txtWP1);
end;

procedure TfrmMain.txtWP1KeyPress(Sender: TObject; var Key: Char);
begin
   txtEditKeyPress(Key);
end;

procedure TfrmMain.txtWP2KeyPress(Sender: TObject; var Key: Char);
begin
   txtEditKeyPress(Key);
end;

procedure TfrmMain.txtWP3KeyPress(Sender: TObject; var Key: Char);
begin
   txtEditKeyPress(Key);
end;

procedure TfrmMain.txtWP4KeyPress(Sender: TObject; var Key: Char);
begin
   txtEditKeyPress(Key);
end;

procedure TfrmMain.txtWP5KeyPress(Sender: TObject; var Key: Char);
begin
   txtEditKeyPress(Key);
end;

procedure TfrmMain.txtWP6KeyPress(Sender: TObject; var Key: Char);
begin
   txtEditKeyPress(Key);
end;

procedure TfrmMain.txtWP7KeyPress(Sender: TObject; var Key: Char);
begin
   txtEditKeyPress(Key);
end;

procedure TfrmMain.txtWP8KeyPress(Sender: TObject; var Key: Char);
begin
   txtEditKeyPress(Key);
end;

procedure TfrmMain.txtWP2Change(Sender: TObject);
begin
   textEditChange(txtWP2);
end;

procedure TfrmMain.txtWP3Change(Sender: TObject);
begin
   textEditChange(txtWP3);
end;

procedure TfrmMain.txtWP4Change(Sender: TObject);
begin
   textEditChange(txtWP4);
end;

procedure TfrmMain.txtWP5Change(Sender: TObject);
begin
   textEditChange(txtWP5);
end;

procedure TfrmMain.txtWP6Change(Sender: TObject);
begin
   textEditChange(txtWP6);
end;

procedure TfrmMain.txtWP7Change(Sender: TObject);
begin
   textEditChange(txtWP7);
end;

procedure TfrmMain.txtWP8Change(Sender: TObject);
begin
   textEditChange(txtWP8);
end;

procedure TfrmMain.btnSetPresetClick(Sender: TObject);
var
   strHex: string;
   Value: longInt;
begin
   strHex := '$' + txtP1.Text;
   Value := StrToInt(strHex);
   DOpresetStatus[0] := Value and $FF;
   DOpresetStatus[1] := (Value shr 8) and $FF;

   strHex := '$' + txtP2.Text;
   Value := StrToInt(strHex);
   DOpresetStatus[2] := Value and $FF;
   DOpresetStatus[3] := (Value shr 8) and $FF;

   strHex := '$' + txtP3.Text;
   Value := StrToInt(strHex);
   DOpresetStatus[4] := Value and $FF;
   DOpresetStatus[5] := (Value shr 8) and $FF;

   strHex := '$' + txtP4.Text;
   Value := StrToInt(strHex);
   DOpresetStatus[6] := Value and $FF;
   DOpresetStatus[7] := (Value shr 8) and $FF;

   strHex := '$' + txtP5.Text;
   Value := StrToInt(strHex);
   DOpresetStatus[8] := Value and $FF;
   DOpresetStatus[9] := (Value shr 8) and $FF;

   strHex := '$' + txtP6.Text;
   Value := StrToInt(strHex);
   DOpresetStatus[10] := Value and $FF;
   DOpresetStatus[11] := (Value shr 8) and $FF;

   strHex := '$' + txtP7.Text;
   Value := StrToInt(strHex);
   DOpresetStatus[12] := Value and $FF;
   DOpresetStatus[13] := (Value shr 8) and $FF;

   strHex := '$' + txtP8.Text;
   Value := StrToInt(strHex);
   DOpresetStatus[14] := Value and $FF;
   DOpresetStatus[15] := (Value shr 8) and $FF;

   ulDataLength := sizeof(BYTE) * 16;
   m_ErrCde := DRV_DeviceSetProperty(m_DeviceHandle, CFG_DoPresetValue,
      @(DOpresetStatus[0]), ulDataLength);

   if (DoesErr(m_ErrCde) = 1) then
      Exit;

end;

procedure TfrmMain.btnWatchdogSetClick(Sender: TObject);
var
   strHex: string;
   Value: longInt;
begin
   strHex := '$' + txtWP1.Text;
   Value := StrToInt(strHex);
   DOWatchdogStatus[0] := Value and $FF;
   DOWatchdogStatus[1] := (Value shr 8) and $FF;

   strHex := '$' + txtWP2.Text;
   Value := StrToInt(strHex);
   DOWatchdogStatus[2] := Value and $FF;
   DOWatchdogStatus[3] := (Value shr 8) and $FF;

   strHex := '$' + txtWP3.Text;
   Value := StrToInt(strHex);
   DOWatchdogStatus[4] := Value and $FF;
   DOWatchdogStatus[5] := (Value shr 8) and $FF;

   strHex := '$' + txtWP4.Text;
   Value := StrToInt(strHex);
   DOWatchdogStatus[6] := Value and $FF;
   DOWatchdogStatus[7] := (Value shr 8) and $FF;

   strHex := '$' + txtWP5.Text;
   Value := StrToInt(strHex);
   DOWatchdogStatus[8] := Value and $FF;
   DOWatchdogStatus[9] := (Value shr 8) and $FF;

   strHex := '$' + txtWP6.Text;
   Value := StrToInt(strHex);
   DOWatchdogStatus[10] := Value and $FF;
   DOWatchdogStatus[11] := (Value shr 8) and $FF;

   strHex := '$' + txtWP7.Text;
   Value := StrToInt(strHex);
   DOWatchdogStatus[12] := Value and $FF;
   DOWatchdogStatus[13] := (Value shr 8) and $FF;

   strHex := '$' + txtWP8.Text;
   Value := StrToInt(strHex);
   DOWatchdogStatus[14] := Value and $FF;
   DOWatchdogStatus[15] := (Value shr 8) and $FF;

   ulDataLength := sizeof(BYTE) * 16;
   m_ErrCde := DRV_DeviceSetProperty(m_DeviceHandle, CFG_DoWatchdogValue,
      @(DOWatchdogStatus[0]), ulDataLength);

   if (DoesErr(m_ErrCde) = 1) then
      Exit;

end;

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

procedure TfrmMain.txtWatchdogCounterChange(Sender: TObject);
begin
WatchdogCounter := StrToInt64(txtWatchdogCounter.Text);
   ulDataLength := sizeof(DWORD);
   m_ErrCde := DRV_DeviceSetProperty(m_DeviceHandle, CFG_WatchdogCounter,
      @WatchdogCounter, ulDataLength);
   labWatchdogTimer.Caption := Format('%0.0f',[WatchdogCounter*0.0001]);
 end;

procedure TfrmMain.txtAutoTimerChange(Sender: TObject);
begin
   AutoFeedTimer.Interval := StrToInt(txtAutoTimer.Text);
end;

end.