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

📄 main.pas

📁 16 relay output channels and 16 isolated digital input channels LED indicators to show activated
💻 PAS
📖 第 1 页 / 共 2 页
字号:
      2:
      begin
        if (sWaveCh2.wWaveform <> 4) then
        begin
          usEnabledChannel := usEnabledChannel or $04;
          SetRealBuffer(lpVoltageBuf[2], gulConvNum, @sWaveCh2);
          usChannelCount := usChannelCount + 1;
        end
        else
          continue;
      end;
      3:
      begin
        if (sWaveCh3.wWaveform <> 4) then
        begin
          usEnabledChannel := usEnabledChannel or $08;
          SetRealBuffer(lpVoltageBuf[3], gulConvNum, @sWaveCh3);
          usChannelCount := usChannelCount + 1;
        end
        else
          continue;
      end;
    end;

    { call FAOScale for transfer voltage to binary data }
    with ptFAOScale do
    begin
      tempPtr := lpVoltageBuf[i];
      VoltArray := tempPtr;
      tempPtr := lpBuf[i];
      BinArray  := tempPtr;
      chan      := i;
      count     := gulConvNum;
    end;
    ErrCde := DRV_FAOScale(DriverHandle, ptFAOScale);
    if (DoesErr(ErrCde) <> 0) then
    begin
      MyFreeBuffer();
      DRV_DeviceClose(DriverHandle);
      exit;
    end;
  end;

  { Allocate memory for common buffer of 4 channel }
  hCommonBuf := GlobalAlloc(GHND, sizeof(SHORT) * gulConvNum * usChannelCount);
  if(hCommonBuf = 0) then
  begin
    Application.MessageBox('Not enough memory for buffer', 'High Speed', MB_OK);
    MyFreeBuffer();
    DRV_DeviceClose(DriverHandle);
    exit;
  end;

  { Lock down buffer }
  lpCommonBuf := GlobalLock(hCommonBuf);
  if (lpCommonBuf = NIL) then
  begin
    Application.MessageBox('Not enough memory for buffer', 'High Speed', MB_OK);
    MyFreeBuffer();
    GlobalFree(hCommonBuf);
    DRV_DeviceClose(DriverHandle);
    exit;
  end;

  { set 4 buffer to 1 common buffer }
  SetMultiToOneBuffer(usEnabledChannel, gulConvNum);

  { Step 3: Enable event feature }
  with ptEnableEvent do
  begin
    EventType := ADS_EVT_INTERRUPT  or
                 ADS_EVT_BUFCHANGE  or
                 ADS_EVT_TERMINATED or
                 ADS_EVT_OVERRUN;
    Enabled   := gwEvtFlag;
    Count     := 1;
  end;
  ErrCde := DRV_EnableEvent(DriverHandle, ptEnableEvent);
  if (DoesErr(ErrCde) <> 0) then
  begin
    MyFreeBuffer();
    DRV_DeviceClose(DriverHandle);
    exit;
  end;

  { Step 4: call FAOWaveFormStart for start action }
  { Default setting - }
  { conversion number = 2048 * 4 }
  { Enabled Channel = 0,1,2,3 }
  { pacer rate = 1000 Hz }
  { output waveform number = 30 }

  with ptFAOWaveFormStart do
  begin
    TrigSrc    := gwExtTrig;		       { triggering }
    SampleRate := gdwPacerRate;		       { pacer rate = 1K }
    Count      := gulConvNum * usChannelCount; { DA conversion number }
    WaveCount  := gwWaveFormCount;	       { Waveform number }
    tempPtr    := PINT(lpCommonBuf);           { analog output data }
    Buffer     := tempPtr;
    EnabledChannel := usEnabledChannel;        { which channel }
  end;
  ErrCde := DRV_FAOWaveFormStart(DriverHandle, ptFAOWaveFormStart);
  if (DoesErr(ErrCde) <> 0) then
  begin
    MyFreeBuffer();
    GlobalUnlock(hCommonBuf);
    GlobalFree(hCommonBuf);
    DRV_DeviceClose(DriverHandle);
    exit;
  end;

  { if event feature is enabled , then create one thread. }
  if (gwEvtFlag <> 0) then
  begin
    TGetEvent.Create(False);
    bThreadloop := TRUE;
  end;

  Run.Enabled := FALSE;
  Stop.Enabled := TRUE;     { Enable stop buttons }

  { if event feature is enabled }
  { Start up timer }
  if (gwEvtFlag <> 0) then
  begin
    Tmr.Enabled := TRUE;
    bRunTimer := TRUE;
  end;
end;

procedure TFrmMain.StopClick(Sender: TObject);
var
bflag: Boolean;
begin
  {  Stop D/A conversion }
  ErrCde := DRV_FAOTerminate(DriverHandle);
  if (ErrCde <> 0) then
  begin
    DoesErr(ErrCde);
    MyFreeBuffer();
    GlobalUnlock(hCommonBuf);
    GlobalFree(hCommonBuf);
    DRV_DeviceClose(DriverHandle);
    exit;
  end;     
end;

procedure TFrmMain.TmrTimer(Sender: TObject);
var
  ptFAOCheck: PT_FAOCheck;
  gwActiveBuf: SHORT;     { return by FAOCheck }
  gwStopped: SHORT;       { return by FAOCheck }
  ulCurrentCount: ULONG;  { return by FAOCheck }
  gwOverrun: SHORT;       { return by FAOCheck }
  gwHalfReady: SHORT;     { return by FAOCheck }
begin
  gwActiveBuf := 0;     { return by FAOCheck }
  gwStopped := 0;       { return by FAOCheck }
  ulCurrentCount := 0;  { return by FAOCheck }
  gwOverrun := 0;       { return by FAOCheck }
  gwHalfReady := 0;     { return by FAOCheck }

  { Get transfer status }
  ptFAOCheck.ActiveBuf    := @gwActiveBuf;
  ptFAOCheck.stopped      := @gwStopped;
  ptFAOCheck.CurrentCount := @ulCurrentCount;
  ptFAOCheck.overrun      := @gwOverrun;
  ptFAOCheck.HalfReady    := @gwHalfReady;

  ErrCde := DRV_FAOCheck(DriverHandle, ptFAOCheck);
  if (ErrCde <> 0) then
  begin
    DoesErr(ErrCde);
    MyFreeBuffer();
    GlobalUnlock(hCommonBuf);
    GlobalFree(hCommonBuf);
    DRV_DeviceClose(DriverHandle);
    exit;
  end;

  { Display Data }
  WaveCountText.Text := IntToStr(ulCurrentCount);

  { if thread finish run stop instruction }
  if (not bThreadloop) then
  begin
    { if A/O process finish --> call DRV_FAOStop }
    if (gwStopped <>0 ) then
    begin
      { Step 2: Free buffer }
      MyFreeBuffer();
      GlobalUnlock(hCommonBuf);
      GlobalFree(hCommonBuf);

      { Step 3: Close driver }
      DRV_DeviceClose(DriverHandle);

      { Stop Timer }
      if (bRunTimer) then
      begin
        Tmr.Enabled := FALSE;
        bRunTimer := FALSE;
      end;
      Run.Enabled := TRUE;
    end
  end;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  if (gwSelectDevice = 0) then
  begin
    { Select Device }
    ErrCde := DRV_SelectDevice(Handle, FALSE, dwDeviceNum, @szDescript[0]);
    if (ErrCde <> SUCCESS) then
    begin
      DoesErr(ErrCde);
      exit;
    end;

    gwSelectDevice := 1;
    FrmMain.Run.Enabled := TRUE;
  end;

  { Show device description to Button text }
  DevSel.Caption := szDescript;

  { Initialize Conversion Number }
  Conv.Text := IntToStr(gulConvNum);

  { Initialize Pacer Rate }
  Pacer.Text := IntToStr(gdwPacerRate);

  { Initialize wave form count }
  if (gwWaveFormCount = INFINITE) then
    WaveCount.Text := 'INFINITE'
  else
    WaveCount.Text := IntToStr(gwWaveFormCount);

  { Initialize Triggering }
  if (gwExtTrig <> 0) then
    ExtTrig.Checked := True
  else
    IntTrig.Checked := True;

  { Initialize Message Flag }
  if (gwEvtFlag <> 0) then
    EvtEnable.Checked := True
  else
    EvtDisable.Checked := True;
end;

procedure TFrmMain.DevSelClick(Sender: TObject);
begin
  { Select Device }
  ErrCde := DRV_SelectDevice(Handle, FALSE, dwDeviceNum, @szDescript[0]);
  if (ErrCde <> SUCCESS) then
  begin
    DoesErr(ErrCde);
    exit;
  end;

  { Show device description to Button text }
  DevSel.Caption := szDescript;
end;

procedure TFrmMain.PacerChange(Sender: TObject);
begin
  gdwPacerRate := StrToInt(Pacer.Text);
end;

procedure TFrmMain.ConvChange(Sender: TObject);
begin
  gulConvNum := StrToInt(Conv.Text);
end;

procedure TFrmMain.WaveCountChange(Sender: TObject);
var
  szBuf: string[40];
begin
  szBuf := WaveCount.Text;
  if(szBuf = 'INFINITE') then
    gwWaveFormCount := INFINITE
  else
    gwWaveFormCount := StrToInt(szBuf);
end;

procedure TFrmMain.IntTrigClick(Sender: TObject);
begin
  gwExtTrig := 0;
end;

procedure TFrmMain.ExtTrigClick(Sender: TObject);
begin
  gwExtTrig := 1;
end;

procedure TFrmMain.EvtEnableClick(Sender: TObject);
begin
  gwEvtFlag := 1;
end;

procedure TFrmMain.EvtDisableClick(Sender: TObject);
begin
  gwEvtFlag := 0;
end;

end.

⌨️ 快捷键说明

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