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

📄 convert.pas

📁 16 relay output channels and 16 isolated digital input channels LED indicators to show activated
💻 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 + -