📄 convert.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;
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 }
ptAiCheck : PT_FAICheck;
wActiveBuf : Word;
wStopped : Word;
lRetrieved : Longint;
wOverrun : Word;
wHalfReady : Word;
public
{ Public declarations }
bCyclic : Boolean;
hThreadGetEvent : Longint;
bConverting : Boolean;
end;
var
frmConverting: TfrmConverting;
implementation
uses Init, DataShow;
{*************************************************************
* 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;
lErrCde : Longint;
bOk : Boolean;
ptFaiData : PT_FAITransfer;
p : Pointer;
begin
{if the converting action has been stopped?}
if bConverting = False then
Exit;
{Stop checking status action}
bConverting := False;
tmrDataCounts.Enabled := False;
butTerminate.Caption := 'Waiting...';
frmConverting.Enabled := False;
{Stop getEvent thread}
if hThreadGetEvent <> 0 then
begin
bOk := GetExitCodeThread(hThreadGetEvent, i);
if (i = STILL_ACTIVE) and (bOk = True) then
begin
TerminateThread(hThreadGetEvent, 0);
CloseHandle(hThreadGetEvent);
end;
hThreadGetEvent := 0;
Sleep(0);
end;
{Get AI conversion count}
lErrCde := DRV_FAICheck(frmInit.hDevHandle, ptAiCheck);
if DoesErr(lErrCde) = 1 then
begin
DRV_FreeDMABuffer(frmInit.hDevHandle, @(frmInit.lDmaBufPtr));
DRV_DeviceClose(frmInit.hDevHandle);
Exit;
end;
{Get the AI conversion data}
With ptFaiData do
begin
overrun := @wOverrun;
count := frmInit.ptAiStart.count;
start := 0; {Start from buffer begging}
DataType := Word(frmInit.chkFloatData.Checked);
ActiveBuf := 0; {Single buffer}
{If want floating data}
if DataType = 1 Then
i := SizeOf(single)
{Else need Raw data}
else
i := SizeOf(Word);
GetMem(DataBuffer, i* count ); {Alolocate memory for data}
end;
lErrCde := DRV_FAITransfer(frmInit.hDevHandle, ptFaiData);
if DoesErr(lErrCde) = 1 then
begin
FreeMem(ptFaiData.DataBuffer);
DRV_FreeDMABuffer(frmInit.hDevHandle, @(frmInit.lDmaBufPtr));
DRV_DeviceClose(frmInit.hDevHandle);
Exit;
end;
{Save data to data show screen}
p := ptFaiData.DataBuffer;
if bCyclic = True Then
lRetrieved := ptFaiData.count - 1
else
lRetrieved := ptAiCheck.retrieved^ - 1;
frmDataShow.memData.Lines.Clear;
for i:=0 to lRetrieved do
begin
if ptFaiData.DataType = 1 then
begin
{Converting to Floating data}
frmDataShow.memData.Lines.Append(FloatToStr(Single(p^)) );
Longint(p) := Longint(p) + SizeOf(Single);
end
else
begin
{Convert to Hex data}
frmDataShow.memData.Lines.Append(IntToHex(Word(p^), 16) );
Longint(p) := Longint(p) + SizeOf(Word);
end;
end;
{Free data buffer}
FreeMem(ptFaiData.DataBuffer);
DRV_FreeDMABuffer(frmInit.hDevHandle, @(frmInit.lDmaBufPtr));
{Close device}
DRV_DeviceClose(frmInit.hDevHandle);
{Display the Data Show Form}
butTerminate.Caption := '&Terminate';
frmConverting.Enabled := True;
frmConverting.Hide;
frmInit.Enabled := True;
frmDataShow.Show;
end;
procedure TfrmConverting.butTerminateClick(Sender: TObject);
var
lErrCde : Longint;
begin
lErrCde := DRV_FAITerminate(frmInit.hDevHandle);
if DoesErr(lErrCde) = 1 then
begin
DRV_FreeDMABuffer(frmInit.hDevHandle, @(frmInit.lDmaBufPtr));
DRV_DeviceClose(frmInit.hDevHandle);
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_FAICheck(frmInit.hDevHandle, ptAiCheck);
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 := ptAiCheck.retrieved^;
{If data counts reach buffer size & not cyclic mode}
if(prgsDataCounts.Position >= prgsDataCounts.Max) and (bCyclic=False) then
begin
{terminate the action}
end;
end;
procedure TfrmConverting.FormShow(Sender: TObject);
begin
tmrDataCounts.Enabled := TRUE;
end;
procedure TfrmConverting.FormCreate(Sender: TObject);
begin
with ptAiCheck do
begin
ActiveBuf := @wActiveBuf;
stopped := @wStopped;
retrieved := @lRetrieved;
overrun := @wOverrun;
HalfReady := @wHalfReady;
end;
hThreadGetEvent := 0; {Still not create thread}
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -