init.pas

usb4711A数据采集卡的DA转换通道程序

unit Init;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Mask,
  Driver;


type
  WAVE_PROPERTY = Record
    iType      : word;     {0: Sine, 1: Triangle, 2: Square}
    fMagnitude : Single;
    fOffset    : Single;
    wPeriod    : word;
  end;

  TSingleArray = array[0..MaxInt div sizeof(Single)-1] of Single;


  TfrmInit = class(TForm)
    butConvert: TButton;
    butExit: TButton;
    grpSelDev: TGroupBox;
    butChangDev: TButton;
    labDevName: TLabel;
    grpTrigSrc: TGroupBox;
    labSpeed: TLabel;
    labHz: TLabel;
    radExtTrig: TRadioButton;
    radInterTrig: TRadioButton;
    editSpeed: TMaskEdit;
    grpChecks: TGroupBox;
    chkCyclic: TCheckBox;
    chkEventEnable: TCheckBox;
    labWaveSelect: TLabel;
    labWaveform: TLabel;
    butChangeWaveForm: TButton;
    labOutChl: TLabel;
    cmbOutChl: TComboBox;
    labConvCount: TLabel;
    editConvNum: TMaskEdit;
    procedure butExitClick(Sender: TObject);
    procedure butChangDevClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure butChangeWaveFormClick(Sender: TObject);
    procedure butConvertClick(Sender: TObject);

    procedure MakeWaveForm( var fWaveBuf : array of single;
                            lCount : Longint;
                            wavProperty : WAVE_PROPERTY);
  private
    { Private declarations }
    lDeviceNumber  : Longint;
    ptDevFeatures : PT_DeviceGetFeatures;    {for getting device feature}
    dfCurDevice   : DEVFEATURES;

  public
    { Public declarations }
    ghDev          : Longint;       {Device handle for every device}
    gwavOut        : WAVE_PROPERTY; {used in Init.pas & Waveform.pas}
    gpBinOutBuf    : Pointer;
    glConvCounts : Longint;
  end;

var
  frmInit: TfrmInit;

implementation

uses Waveform, Convert, GetEvent;

{$R *.DFM}
{*************************************************************
 * Function: Handle the error code. If the input error code > 0,
 *           it means some error apperent.  This function can
 *           show the error message to a message box and stop
 *           this application.
 * Input:    The error code.
 * return:   none
 ************************************************************* }
Function DoesErr(var lErrCode: LongInt): integer;
var
  szErrMsg   : string[100];
  pszErrMsg  : PChar;
  iRet       : integer;
begin
  {Check the pressed error code}
  If (lErrCode <> 0) Then
  begin
    pszErrMsg := @szErrMsg;
    DRV_GetErrorMessage(lErrCode, pszErrMsg);
    iRet := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
    DoesErr := 1;
  end
  else
    DoesErr := 0;
end;

{************************************************************************
 * Function : According to the desired wave form property transfering to
 *            voltage and saving them to buffer.
 *            It can support Sine wave, triangle wave and square wave.
 * Input :    fWavBuf, Output, for storing the voltage after converting.
 *            lCount, Input, Total count of this buffer size.
 *            wavProperty, Input, the desired waveform property.
 * return :   none
 *************************************************************************}
procedure TfrmInit.MakeWaveForm( var fWaveBuf : array of single;
                                 lCount : Longint;
                                 wavProperty : WAVE_PROPERTY);
var
  l      : Longint;
  fSlope : Single;
  wHalf, wNow  : Word;
begin

  case wavProperty.iType of
    0 : {Sine}
    begin
      for l := 0 to lCount - 1 do
      begin
        fWaveBuf[l] := wavProperty.fMagnitude *
                       sin( 6.28318 * l / wavProperty.wPeriod) +
                       wavProperty.fOffset;
        end;
      end;

      1 : {Triangle}
      begin
        fSlope := wavProperty.fMagnitude * 4.0 / wavProperty.wPeriod;
        wHalf := wavProperty.wPeriod div 2;

        for l := 0 to lCount - 1 do
        begin
          wNow := l mod wavProperty.wPeriod;
          if wNow <= wHalf then
            fWaveBuf[l] := fSlope * wNow
                         - wavProperty.fMagnitude + wavProperty.fOffset
          else
            fWaveBuf[l] := fSlope * (wavProperty.wPeriod - wNow)
                         - wavProperty.fMagnitude + wavProperty.fOffset;
        end;
      end;

      2 : {Square}
      begin
        wHalf := wavProperty.wPeriod div 2;
        for l := 0 to lCount - 1 do
        begin
          wNow := l mod wavProperty.wPeriod;
        if wNow <= wHalf then
          fWaveBuf[l] := wavProperty.fOffset - wavProperty.fMagnitude
        else
          fWaveBuf[l] := wavProperty.fOffset + wavProperty.fMagnitude;
      end;
    end;
  end;
end;

procedure TfrmInit.butExitClick(Sender: TObject);
begin
  Close;
end;

{***************************************************************************
 * Function : Change the selected device.
 *            While changing the device, we should do:
 *              1. Showing the the name of current selection.
 *              2. Reset the control's item
 * Input :    Sender
 * Retunr :   none.
 ***************************************************************************}
procedure TfrmInit.butChangDevClick(Sender: TObject);
var
  szDeviceName : array[0..100] of char;
  lErrCde      : Longint;
  wModuleType  : Smallint;
  hDlg         : HWND;

  szTmp : String;
  i     : Smallint;
begin

  {Select devcie from device list}
  lErrCde := DRV_SelectDevice( frmInit.Handle, False, lDeviceNumber,
             @szDeviceName[0]);
  if( DoesErr(lErrCde) = 1 ) then
    Exit;

  labDevName.Caption := szDeviceName;
  butConvert.Enabled := True;

  {Get device features for filling every control's items}
  lErrCde := DRV_DeviceOpen( lDeviceNumber, ghDev);
  if( DoesErr(lErrCde) = 1 ) then
    Exit;

  lErrCde := DRV_DeviceGetFeatures(ghDev, ptDevFeatures);
  if( DoesErr(lErrCde) = 1 ) then
  begin
    DRV_DeviceClose(ghDev);
    Exit;
  end;

  {make the items of output channel selection.}
  cmbOutChl.Clear;
  for i := 0 to dfCurDevice.usMaxAOChl - 1 do
  begin
    szTmp := IntToStr(i);
    cmbOutChl.items.Add(szTmp);
  end;
  cmbOutChl.ItemIndex := 0;

  {Close the device}
  DRV_DeviceClose(ghDev);
  ghDev := 0;
end;

procedure TfrmInit.FormCreate(Sender: TObject);
begin
 {Give the initialize waveform information}
  with gwavOut Do
  begin
    iType      := 0;     {0: Sine, 1: Triangle, 2: Square}
    fMagnitude := 5.0;
    fOffset    := 0.0;
    wPeriod    := 500;
  end;

  {Fill RECORD for getting device feature in furthe using}
  ptDevFeatures.buffer := @dfCurDevice;
  ptDevFeatures.size := SizeOf(DEVFEATURES);

  {Select a device for action}
  butChangDevClick(Sender);

end;

procedure TfrmInit.butChangeWaveFormClick(Sender: TObject);
begin
  frmWaveSelect.ShowModal
end;

procedure TfrmInit.butConvertClick(Sender: TObject);
var
  ptFAoScale    : PT_FAOScale;
  ptEnableEvent : PT_EnableEvent;
  ptFAoIntStart : PT_FAOIntStart;

  lErrCde   : Longint;
  pFloatBuf : ^TSingleArray;
  lActualBufSize : Longint;
begin

  {1. Device Open}
  lErrCde := DRV_DeviceOpen( lDeviceNumber, ghDev);
  if( DoesErr(lErrCde) = 1 ) then
     Exit;

  {2. Make Analog output data}
  {  2.1 Make wave form (in floating data format)}
  glConvCounts := StrToInt(editConvNum.Text);
  GetMem(pFloatBuf, glConvCounts * SizeOf(Single));
  MakeWaveForm( pFloatBuf^, glConvCounts, gwavOut);

  {  2.2 Create buffer to store data for Interrupt transfering}
  gpBinOutBuf := Pointer(GlobalAlloc( GPTR,
                                      SizeOf(word) * glConvCounts));
  if gpBinOutBuf = nil then
  begin
    Application.MessageBox('Allocate memory for waveofrm error!', 'Error!!', MB_OK);
    FreeMem(pFloatBuf);

    DRV_DeviceClose(ghDev);
    Exit
  end;

  {  2.3 Convert floating type voltage to binary data}
  with ptFAOScale do
  begin
    chan      := cmbOutChl.ItemIndex;
    count     := glConvCounts;
    VoltArray := Pointer(pFloatBuf);
    BinArray  := gpBinOutBuf;
  end;

  lErrCde := DRV_FAOScale(ghDev, ptFAOScale);
  FreeMem(pFloatBuf);
  if( DoesErr(lErrCde) = 1 ) then
  begin
    GlobalFree(Longint(gpBinOutBuf));

    DRV_DeviceClose(ghDev);
    exit;
  end;

  {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 := Word(chkEventEnable.Checked);
    Count   := 1;
  end;

  lErrCde := DRV_EnableEvent(ghDev, ptEnableEvent);
  if DoesErr(lErrCde) = 1  then
  begin
    GlobalFree(Longint(gpBinOutBuf));

    DRV_DeviceClose(ghDev);
    Exit;
  end;

  {4. Start Analog output/INT transfering action}

  {4.1 Fill action Record }
  with ptFAoIntStart do
  begin
    TrigSrc     := Word(radExtTrig.Checked);
    SampleRate  := StrToInt(editSpeed.Text);
    chan        := cmbOutChl.ItemIndex;
    count       := glConvCounts;
    buffer      := gpBinOutBuf;
    cyclic      := word(chkCyclic.Checked);
  end;

  {4.2 Call Advantech API function to start conversion}
  lErrCde := DRV_FAOIntStart( ghDev, ptFAOIntStart);
  if DoesErr(lErrCde) = 1 then
  begin
    GlobalFree(Longint(gpBinOutBuf));

    DRV_DeviceClose(ghDev);
    Exit;
  end;

  {5. Enable Thread for getting message.}
  if chkEventEnable.Checked = True then
  begin
    with TGetEvent.Create( lDeviceNumber,
                           ptFAOIntStart.count * 1000 div ptFAOIntStart.SampleRate + 1000,
                           chkCyclic.Checked) do
      frmConverting.ghThreadGetEvent := Handle;
  end;
  Sleep(0);

  {Final: Show the converting form.}
  frmConverting.prgsDataCounts.Max := glConvCounts;
  frmConverting.prgsDataCounts.Position := 0;
  frmConverting.prgsDataCounts.Min := 0;
  //frmConverting.gbTerminate := False;

  frmConverting.ShowModal;
end;

end.