unit MainUnit;

interface

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

type
  TForm1 = class(TForm)
    ChannelCheckF: TCheckBox;
    NameEditF: TEdit;
    RangeComboF: TComboBox;
    ChannelCheckE: TCheckBox;
    NameEditE: TEdit;
    RangeComboE: TComboBox;
    ChannelCheckD: TCheckBox;
    NameEditD: TEdit;
    RangeComboD: TComboBox;
    ChannelCheckC: TCheckBox;
    NameEditC: TEdit;
    RangeComboC: TComboBox;
    ChannelCheckB: TCheckBox;
    NameEditB: TEdit;
    RangeComboB: TComboBox;
    ChannelCheckA: TCheckBox;
    NameEditA: TEdit;
    RangeComboA: TComboBox;
    ChannelCheck9: TCheckBox;
    NameEdit9: TEdit;
    RangeCombo9: TComboBox;
    ChannelCheck8: TCheckBox;
    NameEdit8: TEdit;
    RangeCombo8: TComboBox;
    ChannelCheck7: TCheckBox;
    NameEdit7: TEdit;
    RangeCombo7: TComboBox;
    ChannelCheck6: TCheckBox;
    NameEdit6: TEdit;
    RangeCombo6: TComboBox;
    ChannelCheck5: TCheckBox;
    NameEdit5: TEdit;
    RangeCombo5: TComboBox;
    ChannelCheck4: TCheckBox;
    NameEdit4: TEdit;
    RangeCombo4: TComboBox;
    ChannelCheck3: TCheckBox;
    NameEdit3: TEdit;
    RangeCombo3: TComboBox;
    ChannelCheck2: TCheckBox;
    NameEdit2: TEdit;
    RangeCombo2: TComboBox;
    ChannelCheck1: TCheckBox;
    NameEdit1: TEdit;
    RangeCombo1: TComboBox;
    ChannelCheck0: TCheckBox;
    NameEdit0: TEdit;
    RangeCombo0: TComboBox;
    RateScroll: TScrollBar;
    RateLabel: TLabel;
    HeaderLabel: TLabel;
    CardCombo: TComboBox;
    Label1: TLabel;
    LogCheck: TCheckBox;
    StartButton: TButton;
    SaveEm: TSaveDialog;
    AcqTime: TTimer;
    ExitButton: TButton;
    procedure FormCreate(Sender: TObject);
    procedure RateScrollChange(Sender: TObject);
    procedure ChannelCheckClick(Sender: TObject);
    procedure LogCheckClick(Sender: TObject);
    procedure StartButtonClick(Sender: TObject);
    procedure StopButtonClick(Sender: TObject);
    procedure AcqTimeTimer(Sender: TObject);
    procedure FlashTimeTimer(Sender: TObject);
    procedure CardComboChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ExitButtonClick(Sender: TObject);
  private
    ChannelCheck: array[0..15] of TCheckBox;
    NameEdit: array[0..15] of TEdit;
    RangeCombo: array[0..15] of TComboBox;

    procedure Enable;
    procedure Disable;
    procedure SetPointList;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  Registry, ACCES32;

const
  CardKey = 'Software\PCIFind\NTioPCi\Parameters\';

type
  TPCI_COMMON_CONFIG = record
    VendorID : word;
    DeviceID : word;
    Command : word;
    Status : word;
    RevisionID : byte;
    ProgIf : byte;
    SubClass : byte;
    BaseClass : byte;
    CacheLineSize : byte;
    LatencyTimer : byte;
    HeaderType : byte;
    BIST : byte;
    BaseAddresses : Array[0..5] of dword;
    Reserved1 : Array[0..1] of dword;
    RomBaseAddress : dword;
    Reserved2 : Array[0..1] of dword;
    InterruptLine : byte;
    InterruptPin : byte;
    MinimumGrant : byte;
    MaximumLatency : byte;
  end;

var
  ChannelMask: Word = $00FF;
  LogFile: String;
  Fil: TFileStream;
  ChannelsToRead: array of record
    Index: Byte;
    Range: Byte;
  end;
  CardData: array of TPCI_COMMON_CONFIG;
  Base: LongWord;
  DetectedBases : array [0..32] of LongWord;
  Acquiring: Boolean;
  fifoInPlay : Boolean;

procedure TForm1.SetPointList;
var
count : Integer;
begin
    //clear any previous point list

    OutPortB (Base + $4, $48);


    if High(ChannelsToRead) = 0 then //there is only one channel to be read
    begin                           // so we have to write it twice
        OutPort(Base + $2, (ChannelsToRead[0].Index shl 4) or (ChannelsToRead[0].Range));
        OutPort(Base + $2, (ChannelsToRead[0].Index shl 4) or (ChannelsToRead[0].Range));
    end
    else
    begin
        for count := 0 to High(ChannelsToRead) do
            OutPort(Base + $2, (ChannelsToRead[count].Index shl 4) or (ChannelsToRead[count].Range))
        ;            
    end;

    //finalize the point list
    InPort(Base + $2);


end;

procedure WriteStringToFileStream(Fil: TFileStream; Data: String);
begin
  Fil.Write(Data[1], Length(Data));
end;


procedure TForm1.Disable;
var
  I: Integer;

begin
  CardCombo.Enabled := False;
  CardCombo.ParentColor := True;
  for I := 0 to 15 do begin
    ChannelCheck[I].Enabled := False;
    NameEdit[I].Enabled := False;
    NameEdit[I].ParentColor := True;
    RangeCombo[I].Enabled := False;
    RangeCombo[I].ParentColor := True;
  end;
  RateScroll.Enabled := False;
  LogCheck.Enabled := False;
end;

procedure TForm1.Enable;
var
  I: Integer;

begin
  CardCombo.Enabled := True;
  CardCombo.Color := clWindow;
  for I := 0 to 15 do begin
    ChannelCheck[I].Enabled := True;
    ChannelCheck[I].Caption := 'Channel ' + IntToStr(I);
    NameEdit[I].Enabled := True;
    NameEdit[I].Color := clWindow;
    RangeCombo[I].Enabled := True;
    RangeCombo[I].Color := clWindow;
  end;
  RateScroll.Enabled := True;
  LogCheck.Enabled := True;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
  Reg: TRegistry;
  NumDevices: Integer;
  NotFound: Boolean;
  index : Integer;

begin
  ChannelCheck[$0] := ChannelCheck0;
      NameEdit[$0] :=     NameEdit0;
    RangeCombo[$0] :=   RangeCombo0;
  ChannelCheck[$1] := ChannelCheck1;
      NameEdit[$1] :=     NameEdit1;
    RangeCombo[$1] :=   RangeCombo1;
  ChannelCheck[$2] := ChannelCheck2;
      NameEdit[$2] :=     NameEdit2;
    RangeCombo[$2] :=   RangeCombo2;
  ChannelCheck[$3] := ChannelCheck3;
      NameEdit[$3] :=     NameEdit3;
    RangeCombo[$3] :=   RangeCombo3;
  ChannelCheck[$4] := ChannelCheck4;
      NameEdit[$4] :=     NameEdit4;
    RangeCombo[$4] :=   RangeCombo4;
  ChannelCheck[$5] := ChannelCheck5;
      NameEdit[$5] :=     NameEdit5;
    RangeCombo[$5] :=   RangeCombo5;
  ChannelCheck[$6] := ChannelCheck6;
      NameEdit[$6] :=     NameEdit6;
    RangeCombo[$6] :=   RangeCombo6;
  ChannelCheck[$7] := ChannelCheck7;
      NameEdit[$7] :=     NameEdit7;
    RangeCombo[$7] :=   RangeCombo7;
  ChannelCheck[$8] := ChannelCheck8;
      NameEdit[$8] :=     NameEdit8;
    RangeCombo[$8] :=   RangeCombo8;
  ChannelCheck[$9] := ChannelCheck9;
      NameEdit[$9] :=     NameEdit9;
    RangeCombo[$9] :=   RangeCombo9;
  ChannelCheck[$A] := ChannelCheckA;
      NameEdit[$A] :=     NameEditA;
    RangeCombo[$A] :=   RangeComboA;
  ChannelCheck[$B] := ChannelCheckB;
      NameEdit[$B] :=     NameEditB;
    RangeCombo[$B] :=   RangeComboB;
  ChannelCheck[$C] := ChannelCheckC;
      NameEdit[$C] :=     NameEditC;
    RangeCombo[$C] :=   RangeComboC;
  ChannelCheck[$D] := ChannelCheckD;
      NameEdit[$D] :=     NameEditD;
    RangeCombo[$D] :=   RangeComboD;
  ChannelCheck[$E] := ChannelCheckE;
      NameEdit[$E] :=     NameEditE;
    RangeCombo[$E] :=   RangeComboE;
  ChannelCheck[$F] := ChannelCheckF;
      NameEdit[$F] :=     NameEditF;
    RangeCombo[$F] :=   RangeComboF;

   if (InPortB($61) = $AA55) then begin
      Application.MessageBox('ACCESNT.SYS not detected. Please copy ACCESNT.SYS into [NT]/system32/drivers and re-run this sample.', 'Warning', IDOK);
   end;

  for I := 0 to 15 do begin
    ChannelCheck[I].Tag := I;
    ChannelCheck[I].Caption := 'Channel ' + IntToStr(I);
    NameEdit[I].Text := 'Sensor ' + IntToStr(I);
    RangeCombo[I].ItemIndex := 0;
  end;

  NotFound := True;
  Reg := TRegistry.Create(KEY_QUERY_VALUE);
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey(CardKey, False) then try
      NumDevices := Reg.ReadInteger('NumDevices');
      if NumDevices <> 0 then begin
        SetLength(CardData, NumDevices);
        Reg.ReadBinaryData('PCICommonConfig', CardData[0], NumDevices * sizeof(TPCI_COMMON_CONFIG));
        for I := 0 to NumDevices - 1 do
        begin
          if CardData[I].DeviceID = $ACA8 then begin
            index := CardCombo.Items.Add('PCI-AI12-16('  + IntToHex(CardData[I].BaseAddresses[2] and $FFFE, 4) + ')');
            DetectedBases[index] := CardData[I].BaseAddresses[2] and $FFFE;
            NotFound := False;
          end;
          if CardData[I].DeviceID = $ACA9 then begin
            index := CardCombo.Items.Add('PCI-AI12-16A(' + IntToHex(CardData[I].BaseAddresses[2] and $FFFE, 4) + ')');
            DetectedBases[index] := CardData[I].BaseAddresses[2] and $FFFE;
            NotFound := False;
          end;
          if CardData[I].DeviceID = $ECAA then begin
            index := CardCombo.Items.Add('PCI-A12-16A(' + IntToHex(CardData[I].BaseAddresses[2] and $FFFE, 4) + ')');
            DetectedBases[index] := CardData[I].BaseAddresses[2] and $FFFE;
            NotFound := False;
          end;
        end;
      end;
    finally
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;

  if NotFound then begin
    HeaderLabel.Caption := 'No Compatible Cards Found';
    AcqTime.OnTimer := FlashTimeTimer;
    AcqTime.Enabled := True;
  end
  else begin
    StartButton.Enabled := True;
    CardCombo.ItemIndex := 0;
    CardComboChange(nil);
  end;

  fifoInPlay := false;

end;

procedure TForm1.RateScrollChange(Sender: TObject);
begin
  RateLabel.Caption := 'Delay: ' + IntToStr(RateScroll.Position) + 'sec';
end;

procedure TForm1.ChannelCheckClick(Sender: TObject);
var
  I: Integer;

begin
  I := TCheckBox(Sender).Tag;
  if ChannelCheck[I].Checked then
    ChannelMask := ChannelMask or (1 shl I)
  else
    ChannelMask := ChannelMask and not (1 shl I)
  ;
end;

procedure TForm1.LogCheckClick(Sender: TObject);
begin
  if LogCheck.Checked then begin
    if SaveEm.Execute then begin
      LogFile := SaveEm.FileName;
      LogCheck.Caption := 'Log To File: ' + LogFile;
    end
    else
      LogCheck.Checked := False;
    ;
  end
  else begin
    LogFile := '';
    LogCheck.Caption := 'Log To File';
  end;
end;

procedure TForm1.StartButtonClick(Sender: TObject);
var
  I: Integer;
  Buf, Units: String;

begin
  if ChannelMask = 0 then begin
    Application.MessageBox('You must select at least one channel to acquire.', 'No Channels Selected', 0);
    Exit;
  end;

  SetLength(ChannelsToRead, 0);
  for I := 0 to 15 do
    if (ChannelMask and (1 shl I)) <> 0 then begin
      SetLength(ChannelsToRead, Length(ChannelsToRead) + 1);
      ChannelsToRead[High(ChannelsToRead)].Index := I;
      ChannelsToRead[High(ChannelsToRead)].Range := RangeCombo[I].ItemIndex;
    end
  ;

  if fifoInPlay = true then
    SetPointList
  ;


  if LogFile <> '' then begin
    if ChannelsToRead[0].Range = 7 then
      Units := 'mA'
    else
      Units := 'V'
    ;
    Buf := '"' + NameEdit[ChannelsToRead[0].Index].Text + '(' + Units + ')"';
    for I := 1 to High(ChannelsToRead) do begin
      if ChannelsToRead[I].Range = 7 then
        Units := 'mA'
      else
        Units := 'V'
      ;
      Buf := Buf + ',"' + NameEdit[ChannelsToRead[I].Index].Text + '(' + Units + ')"';
    end;
    if not FileExists(LogFile) then begin
      Fil := TFileStream.Create(LogFile, fmCreate or fmShareDenyNone);
      Fil.Free;
    end;
    Fil := TFileStream.Create(LogFile, fmOpenWrite or fmShareDenyNone);
    WriteStringToFileStream(Fil, '"Date","Time",' + Buf + #13#10);
  end;

  AcqTime.Interval := RateScroll.Position * 1000;
  AcqTime.Enabled := True;

  Acquiring := True;

  Disable;
  StartButton.Caption := '&Stop';
  StartButton.OnClick := StopButtonClick;
end;

procedure TForm1.StopButtonClick(Sender: TObject);
begin
  if Assigned(Fil) then Fil.Free;

  AcqTime.Enabled := False;

  Acquiring := False;

  Enable;
  StartButton.Caption := '&Start';
  StartButton.OnClick := StartButtonClick;
end;

procedure TForm1.AcqTimeTimer(Sender: TObject);
var
  I: Integer;
  Ticks: LongWord;
  Counts: SmallInt;
  Span, Offset: Real;
  SignExtend: Boolean;
  Units, Buf: String;

begin
  OutPortB(Base + 4, 0); //Disable counters
  for I := 0 to High(ChannelsToRead) do begin

    if fifoInPlay = false then //set the channel and range, otherwise the point list handles it
    begin

        OutPortB(Base + 2, (ChannelsToRead[I].Index shl 4) or ChannelsToRead[I].Range);

        Ticks := GetTickCount + 2; //allow for settle time (with change)
        while Ticks > GetTickCount do ;
    end;

    OutPortB(Base, 0); //start conversion

    Ticks := GetTickCount + 2; //wait for EOC or timeout
    while ((InPortB(Base + 4) and $80) = 0) and (Ticks > GetTickCount) do ;
    if (InPortB(Base + 4) and $80) = 0 then
      ChannelCheck[ChannelsToRead[I].Index].Caption := 'Timed out'
    else begin
      Counts := InPort(Base) and $0FFF; //mask out digital I/O

      Span := 0; Offset := 100; Units := ''; SignExtend := False;
      case ChannelsToRead[I].Range of
      0: begin Span := 20;   Offset := 0;    SignExtend := True;  end; //±10v
      1: begin Span := 10;   Offset := 0;    SignExtend := True;  end; //±5v
      2: begin Span := 5;    Offset := 0;    SignExtend := True;  end; //±2.5v
      3: begin Span := 2.5;  Offset := 0;    SignExtend := True;  end; //±1.25v
      4: begin Span := 10;   Offset := 0;    SignExtend := False; end; //0-10v
      5: begin Span := 5;    Offset := 0;    SignExtend := False; end; //0-5v
      6: begin Span := 2.5;  Offset := 1.25; SignExtend := False; end; //1.25-3.75v
      7: begin Span := 16;   Offset := 4;    SignExtend := False; end; //4-20mA
      end;

      if SignExtend then
        Counts := Counts or SmallInt($F * 2 * (Counts and $800))
      ;
      ChannelCheck[ChannelsToRead[I].Index].Caption :=
      Format('%.4f', [ (Counts / $1000) * Span + Offset ]);
      //IntToHex(Counts, 3);
    end;
    
    if Assigned(Fil) then
      if Buf = '' then
        Buf := ChannelCheck[ChannelsToRead[I].Index].Caption
      else
        Buf := Buf + ',' + ChannelCheck[ChannelsToRead[I].Index].Caption
    ;
  end;
  if Assigned(Fil) then
    WriteStringToFileStream(Fil, DateToStr(Date) + ',' + TimeToStr(Time) + ',' + Buf + #13#10)
  ;
end;

procedure TForm1.CardComboChange(Sender: TObject);
begin
  Base := DetectedBases[CardCombo.ItemIndex];

    if Pos('16A', CardCombo.Items[CardCombo.ItemIndex]) = 0 then
        fifoInPlay := false
    else
        fifoInPlay := true
    ;

end;

procedure TForm1.FlashTimeTimer(Sender: TObject);
begin
  if AcqTime.Tag = 0 then
    HeaderLabel.Font.Color := clWindowText
  else
    HeaderLabel.Font.Color := clWhite * (AcqTime.Tag mod 2)
  ;
  AcqTime.Tag := AcqTime.Tag - 1;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Acquiring then
    StopButtonClick(nil)
  ;
end;

procedure TForm1.ExitButtonClick(Sender: TObject);
begin
   Close();
end;

end.