main.pas

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

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Driver, WaveSet;

type
  PSHORT = ^SHORT;
  TFrmMain = class(TForm)
    Label1: TLabel;
    Waveform: TButton;
    Run: TButton;
    Stop: TButton;
    WaveCountText: TEdit;
    Tmr: TTimer;
    Label2: TLabel;
    GroupBox1: TGroupBox;
    DevSel: TButton;
    GroupBox2: TGroupBox;
    Label3: TLabel;
    Pacer: TEdit;
    GroupBox3: TGroupBox;
    Conv: TEdit;
    GroupBox4: TGroupBox;
    WaveCount: TEdit;
    GroupBox5: TGroupBox;
    IntTrig: TRadioButton;
    ExtTrig: TRadioButton;
    GroupBox6: TGroupBox;
    EvtEnable: TRadioButton;
    EvtDisable: TRadioButton;
    procedure WaveformClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure RunClick(Sender: TObject);
    procedure StopClick(Sender: TObject);
    procedure TmrTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure DevSelClick(Sender: TObject);
    procedure PacerChange(Sender: TObject);
    procedure ConvChange(Sender: TObject);
    procedure WaveCountChange(Sender: TObject);
    procedure IntTrigClick(Sender: TObject);
    procedure ExtTrigClick(Sender: TObject);
    procedure EvtEnableClick(Sender: TObject);
    procedure EvtDisableClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  Function DoesErr(lErrCode: Longint): Integer;
  procedure SetRealBuffer(lpBuf: PSingle; num: Longint; lpWave: LPSWAVE);
  procedure SetMultiToOneBuffer(usEnabledChannel: SHORT; count: Integer);
  procedure MyFreeBuffer();

var
  FrmMain: TFrmMain;
  ErrCde: Integer;             { Return error code }
  DriverHandle: Longint = 0;   { driver handle }
  dwDeviceNum: Longint;        { Device number }
  bRunTimer: Boolean = FALSE;
  ptFAOScale: PT_FAOScale;     { FAOScale table }
  lpBuf: array[0..3] of PSHORT = (NIL, NIL, NIL, NIL);
  lpVoltageBuf: array[0..3] of PSingle = (NIL, NIL, NIL, NIL);
  hBuf: array[0..3] of HGLOBAL;
  hVoltageBuf: array [0..3] of HGLOBAL;
  lpCommonBuf: PSHORT;
  hCommonBuf: HGLOBAL;
  bThreadloop: Boolean = FALSE;
  bThreadflag: Boolean = FALSE;
  tempPtr: Pointer;
  szDescript: array[0..99] of char; { Description device }
  gwSelectDevice: SHORT = 0;      { have never selected "Select Device" button }
  gdwPacerRate: DWORD = 10000;    { pacer rate }
  gulConvNum: ULONG = 2048;       { conversion number }
  gwWaveFormCount: ULONG = 30;    { waveform count }
  gwExtTrig: SHORT = 0;           { external or internal trigger }
  gwEvtFlag: SHORT = 1;           { event enable(0) }

implementation
uses GetEvent;

{$R *.dfm}

Function DoesErr(lErrCode: Longint): Integer;
var
  szErrMsg: string[100];
  pszErrMsg: PChar;
begin
  if (lErrCode <> 0) then
  begin
    pszErrMsg := @szErrMsg;
    DRV_GetErrorMessage(lErrCode, pszErrMsg);
    Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
    DoesErr := 1;
  end
  else
    DoesErr := 0;
end;

procedure SetRealBuffer(lpBuf: PSingle; num: Longint; lpWave: LPSWAVE);
var
  i: Integer;
  r: Integer;
  half: Integer;
  slope: Real;
  x: Integer;
  y: Integer;
  lpBuff: PSingle;
begin
  lpBuff := lpBuf;
  case lpWave.wWaveform of
    0:
    begin
      for i := 0 to num - 1 do
      begin
        lpBuff^ := lpWave.fMagnitude * sin(6.2831853 * i / lpWave.wPeriod) + lpWave.fOffset;
        Inc(lpBuff);
      end;
    end;
    1:
    begin
      slope := lpWave.fMagnitude * 4.0 / lpWave.wPeriod;
      for i := 0 to num -1 do
      begin
        r := i mod lpWave.wPeriod;
        half := lpWave.wPeriod div 2;
        if (r <= half) then
          lpBuff^ := slope * r - lpWave.fMagnitude + lpWave.fOffset
        else
          lpBuff^ := slope * (lpWave.wPeriod - r) - lpWave.fMagnitude + lpWave.fOffset;
        Inc(lpBuff);
      end;
    end;
    2:
    begin
      for i := 0 to num - 1 do
      begin
        r := i mod lpWave.wPeriod;
        half := lpWave.wPeriod div 2;
        if (r <= half) then
          lpBuff^ := lpWave.fOffset - lpWave.fMagnitude
        else
          lpBuff^ := lpWave.fOffset + lpWave.fMagnitude;
        Inc(lpBuff);
      end;
    end;
    3:
    begin
      slope := lpWave.fMagnitude * 4.0 / lpWave.wPeriod;
      for i := 0 to num - 1 do
      begin
	if ((i mod 2) <> 0) then
        begin
	  y := i div 2;
          y := y + 1;
          r := y mod lpWave.wPeriod;
          half := lpWave.wPeriod div 2;
          if (r <= half) then
            lpBuff^ := slope * r - lpWave.fMagnitude + lpWave.fOffset
          else
            lpBuff^ := slope * (lpWave.wPeriod - r) - lpWave.fMagnitude + lpWave.fOffset;
        end
	else
        begin
	  x := i div 2;
	  lpBuff^ := lpWave.fMagnitude * sin(6.28318 * x / lpWave.wPeriod) + lpWave.fOffset;
        end;
        Inc(lpBuff);
      end;
    end;
  end;
end;

procedure SetMultiToOneBuffer(usEnabledChannel: SHORT; count: Integer);
var
  i: Integer;
  lpTemp: PSHORT;
  lpTemp0: PSHORT;
  lpTemp1: PSHORT;
  lpTemp2: PSHORT;
  lpTemp3: PSHORT;
begin
  lpTemp := lpCommonBuf;
  lpTemp0 := lpBuf[0];
  lpTemp1 := lpBuf[1];
  lpTemp2 := lpBuf[2];
  lpTemp3 := lpBuf[3];

  for i := 0 to count - 1 do
  begin
    if (usEnabledChannel and $01 <> 0) then
    begin
      lpTemp^ := lpTemp0^ and $0fff;
      Inc(lpTemp);
    end;
    if (usEnabledChannel and $02 <> 0) then
    begin
      lpTemp^ := (lpTemp1^ or ($01 shl 12)) and $3fff;
      Inc(lpTemp);
    end;
    if (usEnabledChannel and $04 <> 0) then
    begin
      lpTemp^ := (lpTemp2^ or ($02 shl 12)) and $3fff;
      Inc(lpTemp);
    end;
    if (usEnabledChannel and $08 <> 0) then
    begin
      lpTemp^ := (lpTemp3^ or ( $03 shl 12)) and $3fff;
      Inc(lpTemp);
    end;
    Inc(lpTemp0);
    Inc(lpTemp1);
    Inc(lpTemp2);
    Inc(lpTemp3);
  end;
end;

procedure MyFreeBuffer();
var
  i: Integer;
begin
  for i := 0 to 3 do
  begin
    if (hBuf[i] <> 0) then
    begin
      GlobalFree(hBuf[i]);
      hBuf[i] := 0;
    end;
    if(hVoltageBuf[i] <> 0) then
    begin
      GlobalFree(hVoltageBuf[i]);
      hVoltageBuf[i] := 0;
    end;
  end;
end;

procedure TFrmMain.WaveformClick(Sender: TObject);
begin
  Application.CreateForm(TFrmWave, FrmWave);
  FrmWave.Show();
end;

procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  MyFreeBuffer();
end;

procedure TFrmMain.RunClick(Sender: TObject);
var
  i: Integer;
  ptEnableEvent: PT_EnableEvent;             { Enable event }
  ptFAOWaveFormStart: PT_FAOWaveFormStart;   { FAODMAStart table }
begin
  { Step 1: Device open }
  ErrCde := DRV_DeviceOpen(dwDeviceNum, DriverHandle);
  if (DoesErr(ErrCde) <> 0) then
    exit;

  { Step 2: Allocate buffer and set data to buffer }
  { Process 4 channel }
  usChannelCount := 0;    { reset channel count }
  usEnabledChannel := 0;
  for i := 0 to 3 do
  begin
    { Allocate memory used by driver }
    hBuf[i] := GlobalAlloc(GPTR, sizeof(SHORT) * gulConvNum);
    if (hBuf[i] = 0) then
    begin
      Application.MessageBox('Not enough memory for buffer', 'High Speed', MB_OK);
      DRV_DeviceClose(DriverHandle);
      exit;
    end;

    { Allocate memory for real voltage }
    hVoltageBuf[i] := GlobalAlloc(GPTR, sizeof(Real) * gulConvNum);
    if(hVoltageBuf[i] = 0) then
    begin
      Application.MessageBox('Not enough memory for buffer', 'High Speed', MB_OK);
      DRV_DeviceClose(DriverHandle);
      exit;
    end;

    lpBuf[i] := GlobalLock(hBuf[i]);
    lpVoltageBuf[i] := GlobalLock(hVoltageBuf[i]);

    case i of
      0:
      begin
        if (sWaveCh0.wWaveform <> 4) then { 4 --> No Waveform }
        begin
          usEnabledChannel := usEnabledChannel or $01;
          { set real voltage to hVoltageBuf }
          SetRealBuffer(lpVoltageBuf[0], gulConvNum, @sWaveCh0);
          usChannelCount := usChannelCount + 1;
        end
        else
          continue;
      end;
      1:
      begin
        if (sWaveCh1.wWaveform <> 4) then
        begin
          usEnabledChannel := usEnabledChannel or $02;
          SetRealBuffer(lpVoltageBuf[1], gulConvNum, @sWaveCh1);
          usChannelCount := usChannelCount + 1;
        end
        else
          continue;
      end;