main.pas

使用研华DAQ和Delphi实现研华数据采集卡的多种功能.包括数据输入输出。内含多个源码

unit Main;

interface

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

type
  TfMain = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    txtDeviceNum: TEdit;
    txtDeviceName: TEdit;
    cmdSelectDevice: TButton;
    frmAction: TGroupBox;
    spMask0: TShape;
    Label4: TLabel;
    Label5: TLabel;
    spMask2: TShape;
    spMask3: TShape;
    spMask4: TShape;
    spMask5: TShape;
    spMask6: TShape;
    spMask7: TShape;
    spMask1: TShape;
    spChlOff0: TShape;
    spChlOff1: TShape;
    spChlOff2: TShape;
    spChlOff3: TShape;
    spChlOff4: TShape;
    spChlOff5: TShape;
    spChlOff6: TShape;
    spChlOff7: TShape;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    cmdChlOn0: TButton;
    cmdChlOn2: TButton;
    cmdChlOn6: TButton;
    cmdChlOn4: TButton;
    cmdChlOn1: TButton;
    cmdChlOn3: TButton;
    cmdChlOn5: TButton;
    cmdChlOn7: TButton;
    cmdExit: TButton;
    Label20: TLabel;
    DAQDO1: TDAQDO;
    cmbPort: TComboBox;
    Label3: TLabel;
    txtReadBack: TEdit;
    cmdReadBack: TButton;
    txtMask: TEdit;
    txtOutValue: TEdit;
    cmdByteOut: TButton;
    Label21: TLabel;

    procedure DoBitOut(iPort : Integer; iBit : Integer; bValue : Boolean);
    procedure WriteMaskValue(iMaskBits : integer; iMaskValue : integer);
    procedure UpdateBitOutButtons();
    procedure cmdExitClick(Sender: TObject);
    procedure cmdSelectDeviceClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cmdChlOn0Click(Sender: TObject);
    procedure cmdChlOn1Click(Sender: TObject);
    procedure cmdChlOn2Click(Sender: TObject);
    procedure cmdChlOn3Click(Sender: TObject);
    procedure cmdChlOn4Click(Sender: TObject);
    procedure cmdChlOn5Click(Sender: TObject);
    procedure cmdChlOn6Click(Sender: TObject);
    procedure cmdChlOn7Click(Sender: TObject);
    procedure spChlOff0MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure spChlOff1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure spChlOff2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure spChlOff3MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure spChlOff4MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure spChlOff5MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure spChlOff6MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure spChlOff7MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure cmdByteOutClick(Sender: TObject);
    procedure txtMaskChange(Sender: TObject);
    procedure spMask0MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure spMask1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure spMask2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure spMask3MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure spMask4MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure spMask5MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure spMask6MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure spMask7MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure cmdReadBackClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure cmbPortChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    bDeviceOpen : Boolean;
  end;

  PTButton = ^TButton;
  PTShape = ^TShape;
var
  fMain: TfMain;
  pcmdBitOn : array[0..7] of PTButton;
  pspMask : array[0..7] of PTShape;

implementation

{$R *.DFM}
{************************************************************}
{ Function : Convert Hex string to Integer. It will termined }
{            at first invalied character.                    }
{            Function will stop convertion at first invalied }
{            character.                                      }
{ Input    : sVal, IN, Hex string for convertion.            }
{ Return   : Integer value after convertion                  }
{************************************************************}
Function HexToInt(const sVal : string) : Integer;
Var
   i,k,iRet : Integer;
   cVal : Char;
Begin
   iRet := 0;
   k := 0;

   {Convert every valid character}
   For i:=1 to Length(sVal) do
   Begin
      cVal := sVal[i];

      if (cVal >= '0') And (cVal <= '9') then
         k := Byte(cVal) - Byte('0')
      Else if (cVal >= 'a') and (cVal <= 'f') then
         k := Byte(cVal) - Byte('a') + 10
      Else if (cVal >= 'A') and (cVal <= 'F') then
         k := Byte(cVal) - Byte('A') + 10
      Else
         Break;

      {Accumulate convert value}
      iRet := iRet*16 + k;
   End;
   
   HexToInt := iRet;
End;

{********************************************************************}
{ Function : Display error message to a dialog box.                  }
{            The format of Long string and short string in Delphi is }
{            different from Null-terminated that used in C.          }
{                                                                    }
{            The long/short string use 1'st char to denote the string}
{            length without termonated char in the tail of string.   }
{                                                                    }
{            The Null-terminated string use Null Char as a string    }
{            termonated and without string length information.       }
{                                                                    }
{            The Message box use Null-Terminated string.             }
{                                                                    }
{ Paramater: sErrMsg: In, Error message string.                      }
{ Return:    None                                                    }
{********************************************************************}
procedure ErrorMsgBox( sErrMsg : WideString);
var
   sErrString : String[51];
   sCaption   : String[51];
begin
   sErrString := sErrMsg + Char(0);
   sCaption := fMain.Caption + ' Error' + Char(0);
   Application.MessageBox(@sErrString[1], @sCaption, MB_OK or MB_ICONEXCLAMATION);
end;

{-----------------------------------------------------------------------}
{   Object methods                                                      }

procedure TfMain.DoBitOut(iPort : Integer; iBit : Integer; bValue : Boolean);
begin
   {Check device opened}
   if not bDeviceOpen then
   begin
      ErrorMsgBox('Device not open');
      Exit;
   End;

   {Output Bit}
   DAQDO1.Port := iPort;
   DAQDO1.Bit := iBit;
   DAQDO1.BitOutput(bValue);

   {Handle the user interface}
   pcmdBitOn[iBit]^.Visible := bValue;
End;

procedure TfMain.WriteMaskValue(iMaskBits : integer; iMaskValue : integer);
Var
   iValue : integer;
begin
   iValue := HexToInt(txtMask.text);
   iValue := (iValue and (not iMaskBits)) or (iMaskValue and iMaskBits);
   txtMask.text := IntToHex(iValue, 2);
end;

procedure TfMain.UpdateBitOutButtons();
var
   i : integer;
   iValue : integer;
begin
   iValue := DAQDO1.ByteReadBack();
   for i := 0 to 7 do
   begin
      if ((iValue and 1) = 1) then
         pcmdBitOn[i]^.Visible := True
      else
         pcmdBitOn[i]^.Visible := false;
         
      iValue := iValue shr 1;
   end;
end;

{--------------------------------------------------}
{ Controll message handle procedures               }

procedure TfMain.cmdExitClick(Sender: TObject);
begin
   Close;
end;

procedure TfMain.cmdSelectDeviceClick(Sender: TObject);
var
   sTmp : string[50];
   i    : integer;
begin
   {Close previous open device}
   if bDeviceOpen then
   begin
      DAQDO1.CloseDevice;
      bDeviceOpen := False;
   end;

   {Select Device from list}
   DAQDO1.SelectDevice;

   {Dispaly selection result}
   str(DAQDO1.DeviceNumber, sTmp);
   txtDeviceNum.Text := sTmp;
   txtDeviceName.Text := DAQDO1.DeviceName;

   {Disable previous selectable actions}
   frmAction.Enabled := False;
   cmbPort.Clear;