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

📄 convert.pas

📁 usb4711A数据采集卡的DA转换通道程序
💻 PAS
字号:
unit Convert;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, Mask, ComCtrls, ExtCtrls, Gauges,
  Driver;

type
  TfrmConverting = class(TForm)
    butTerminate: TButton;
    prgsDataCounts: TProgressBar;
    tmrDataCounts: TTimer;
    memEvent: TMemo;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure butTerminateClick(Sender: TObject);
    procedure tmrDataCountsTimer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    ptAoCheck     : PT_FAOCheck;
    iWhichBuf     : Smallint;
    iStopped      : Smallint;
    lCurrentCount : Longint;
    iOverrun      : Smallint;
    iHalfReady    : Smallint;

  public
    { Public declarations }
    ghbCyclic         : Boolean;
    ghThreadGetEvent : Longint;
  end;

var
  frmConverting: TfrmConverting;


implementation

uses Init;

{*************************************************************
 * 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;


{$R *.DFM}

procedure TfrmConverting.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i         : DWORD;//integer;
  lErrCde   : Longint;
  bOk       : Boolean;
  ptFaiData : PT_FAITransfer;
  p         : Pointer;
begin
  {Stop Timer action}
  tmrDataCounts.Enabled := False;

  {Stop getEvent thread}
  if ghThreadGetEvent <> 0 then
  begin
    bOk := GetExitCodeThread(ghThreadGetEvent, i);
    if (i = STILL_ACTIVE) and (bOk = True) then
    begin
      TerminateThread(ghThreadGetEvent, 0);
      CloseHandle(ghThreadGetEvent);
    end;
    ghThreadGetEvent := 0;
    Sleep(0);
  end;

  {Close device}
  GlobalFree(Longint(frmInit.gpBinOutBuf));
  DRV_DeviceClose(frmInit.ghDev);
end;

procedure TfrmConverting.butTerminateClick(Sender: TObject);
var
  lErrCde : Longint;
begin
     //gbTerminate := True;
     lErrCde := DRV_FAOTerminate(frmInit.ghDev);
    if DoesErr(lErrCde) = 1 then
    begin
      GlobalFree(Longint(frmInit.gpBinOutBuf));
      DRV_DeviceClose(frmInit.ghDev);
      Exit;
    end;
    if not frmInit.chkEventEnable.Checked then
    begin
      Close;
    end;
end;

procedure TfrmConverting.tmrDataCountsTimer(Sender: TObject);
var
    lErrCde : Longint;
    iRet    : Integer;
begin
    lErrCde := DRV_FAOCheck(frmInit.ghDev, ptAoCheck);
    if DoesErr(lErrCde) = 1 then
    begin
        tmrDataCounts.Enabled := False;
        iRet := Application.MessageBox('Stop to get conversion status!',
                                       'Converting & transfering data message',
                                       MB_OK);
        Exit;
    end;
    prgsDataCounts.Position := lCurrentCount;
end;

procedure TfrmConverting.FormShow(Sender: TObject);
begin
     tmrDataCounts.Enabled := TRUE;
end;

procedure TfrmConverting.FormCreate(Sender: TObject);
begin
  with ptAoCheck do
  begin
    ActiveBuf     := @iWhichBuf;
    stopped       := @iStopped;
    CurrentCount  := @lCurrentCount;
    overrun       := @iOverrun;
    HalfReady     := @iHalfready;
  end;
  //gbTerminate := False;
  ghThreadGetEvent := 0;         {Still not create thread}
end;

end.

⌨️ 快捷键说明

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