Quelltext /~heha/messtech/mio_dde.zip/daqwavo.pas

library daqwavo; {$N+,E-} {MATLAB setzt ohnehin Koprozessor voraus}
{$D Matlab-MEX: Ansteuerung NI-DAQ-Karte (h#s 12/99)}
{Benutzte Funktionen:
 WFM_Scale, WFM_Load, WFM_Rate, WFM_ClockRate, WFM_Group_Control, WFM_Check
}
uses pasmex,winprocs,wintypes,win31,wdaq,wutils;

const
 IgnoreBadParams: Boolean=false;
 NoMessage: Boolean=true;
 hintp: THandle=0;		{globales Speicherhandle fr Waveform}
 warten: Boolean=false;
var
 CatchBuf: TCatchBuf;
 chans: Integer;
 LastSample: Integer;		{Hier: nur ein Kanal}

procedure Error(s: PChar);
 begin
  mexVPrintf('DAQWAVO.DLL: FEHLER: %s'#10,s,4);
  Throw(CatchBuf,-1);
 end;

procedure Warning(s: PChar);
 begin
  mexVPrintf('DAQWAVO.DLL: WARNUNG: %s'#10,s,4);
 end;

function GetUpdateModus(chan:Integer):Integer;
  far; external 'DAQDAC' index 5;

function R2I(pm: PMatrix; min,max: Integer; r: PInteger; hir:Integer):Boolean;
 var
  zp: HPDouble;
 begin
  R2I:=false;
  if not mxIsNumeric(pm) then exit;
  if mxGetN(pm)<>1 then exit;
  zp:=mxGetPr(pm);
  hir:=wutils.min(hir,mxGetM(pm));
  while hir<>0 do begin
   if (zp^<min) or (zp^>max) then exit;
   r^:=Round(zp^);
   Inc(r);
   Inc(zp);
   Dec(hir);
  end;
  R2I:=true;
 end;

function MakeSampleList(pm: PMatrix; const chan: array of Integer;
  chans: Integer; scale: Double):THandle;
{$IFDEF FAST}
 external; {$L MkSamLst}
{$ELSE}
{Konvertiert die Matrix in eine Mehrkanal-Integer-Sampleliste via AO_VScale;
 der Speicher wird mit GlobalAlloc angefordert}
 var
  zp,zp0: HPDouble;
  m,i,j: Integer;
  n,il: LongInt;
  hip: THandle;
  ip, ip0: PInteger;
 procedure zp0_init;
  begin
   j:=m; zp0:=zp;
  end;
 procedure zp0_inc;
  begin
   if j<=1 then begin
    zp0_init;
   end else begin
    dec(j);
    IncHP(PChar(zp0),sizeof(Double));
   end;
  end;
 begin
  m:=mxGetM(pm);
  n:=mxGetN(pm);
  zp:=mxGetPr(pm);
  if IsBadHugeReadPtr(zp,n*m*sizeof(Double))
  then Error('IsBadHugeReadPtr');
  if NI_DAQ_Mem_Alloc(hip,2,n*chans,1,1)<>0
  then Error('Speicher reicht nicht!');
  NI_DAQ_Mem_Lock(hip,ip);
  ip0:=ip;
  asm int 3 end;
{$IFDEF CORRECT}
  for il:=n downto 1 do begin
   zp0_init;
   for i:=0 to chans-1 do begin
    AO_VScale(1,chan[i],zp0^,ip0^);
    IncHP(PChar(ip0),sizeof(Integer));
    if i<>chans-1 then zp0_inc;
   end;
   IncHP(PChar(zp),sizeof(Double)*m);
  end;
{$ELSE}
  if m<>chans then Error('Zeilenzahl mu gleich sein!');
  if m<>1 then Warning('Umrechnung erfolgt nur nach erster Kanalnummer');
  WFM_Scale(1,chan[0],n*m,1,zp,ip);

{$ENDIF}
  NI_DAQ_Mem_Unlock(hip);
  MakeSampleList:=hip;
 end;
{$ENDIF}

procedure MatYield;
 var
  Msg: TMsg;
 begin
  if PeekMessage(Msg,0,0,0,PM_REMOVE) then
  case Msg.message of
   WM_Command: ;			{verschlucken}
   WM_KeyDown: case Msg.wParam of	{verschlucken, aber mit Tasten raus}
    VK_Cancel: Throw(CatchBuf,-2);
    Word('C'): if GetKeyState(VK_Control)<>0 then begin	{^C}
     PostMessage(Msg.hWnd,Msg.message,Msg.wParam,Msg.lParam);
     Throw(CatchBuf,-2);		{^C an Matlab durchreichen}
    end;
   end{case};
   WM_KeyUp: ;				{verschlucken}
   else DispatchMessage(Msg);
  end{case};
 end;

procedure FreeHIntP;
 begin
  if hintp<>0 then begin
   WFM_Group_Control(1,1,0);
   NI_DAQ_Mem_Free(hintp);
   hintp:=0;
  end;
 end;

procedure mexFunction(nlhs:Integer; var plhs:TMatArr;
  nrhs:Integer; const prhs:TMatArr); export;
 const
  tb: array[-1..5] of Single=(5E6,0,1E6,1E5,1E4,1E3,1E2);
 var
  chan: array[0..1] of Integer;
  intp: PInteger;
  rate: Double;
  operation,iterations: Integer;
  nsamples,timeout: LongInt;
  vsrec: record
   timebase: Integer;
   updateinterval: LongInt;
  end;
  wfmStopped: Bool;
  itersDone,pointsDone: LongInt;
  s: TS255;
 begin
  if Catch(CatchBuf)=0
  then case nrhs of
   3,4: begin		{Kanal, Samples, Rate [,Wiederholungen]}
    chans:=mxGetN(prhs[0]);
    if chans>2 then begin
     Warning('Kanal-Vektor zu lang - nur zwei Kanle werden benutzt');
     chans:=2;
    end;
    if not R2I(prhs[0],0,1,@chan[0],chans)
    then Error('Kanalnummer ungltig!');
    if (chans>1) and (chan[0]=chan[1])
    then Error('Kanle mssen verschieden sein!');

    iterations:=1;
    if (nrhs=4) and not R2I(prhs[3],-$7FFF,$7FFF,@iterations,1)
    then Error('Wiederholungen ungltig');
    warten:=iterations<0;
    if warten then asm neg iterations end;

    rate:=mxGetScalar(prhs[2]);
    if rate<0 then begin
     rate:=-rate;
     IgnoreBadParams:=true;
    end;
    AO_VScale(1,chan[0],4,operation);
    FreeHIntP;
{    timeout:=GetTickCount; MessageBeep($FFFF);}
    hintp:=MakeSampleList(prhs[1],chan[0],chans,operation/4);
{    timeout:=GetTickCount-timeout;
    wvsprintf(s,'MakeSampleList: %ld ms',timeout);
    Warning(s);}

    nsamples:=mxGetN(prhs[1])*chans;
{    timeout:=GetTickCount; MessageBeep($FFFF);}
{    WFM_Op(1,chans,@chan[0],intp,mxGetN(prhs[1])*chans,iterations,rate);}
    operation:=1;
    if nsamples>2048 then operation:=0;
    if (operation=0) and (rate>200)
    and not IgnoreBadParams then case MessageBox(hWndMatlabCmd,
      'Parameter-Kombination kann oder wird'#10+
      'zum Absturz fhren - fortfahren?'#10#10+
      '{[Abbruch] = [Ja] und keine weiteren Fragen}','DAQWAVO',
      MB_YesNoCancel or MB_IconQuestion) of
     IDNo: Error('Abbruch');
     IDCancel: IgnoreBadParams:=true;
    end;
    NI_DAQ_Mem_Lock(hintp,Pointer(intp));
    WFM_Load(1,chans,@chan[0],intp,nsamples,iterations,operation);
    IncHP(PChar(intp),(nsamples-1)*sizeof(Integer));	{letzter Wert}
    LastSample:=intp^;
    NI_DAQ_Mem_Unlock(hintp);
    with vsrec do begin
     WFM_Rate(rate,0,timebase,updateinterval);
     WFM_ClockRate(1,1,0,timebase,updateinterval,0);
     if not NoMessage
     then mexVPrintf('DAQWAVO: MESSAGE: timebase=%d, updateinterval=%ld'#10,
       vsrec,sizeof(vsrec));
     if nlhs<>0 then begin	{tatschliche Samplerate liefern}
      plhs[0]:=mxCreateFull(1,1,false);
      mxGetPr(plhs[0])^:=tb[timebase]/updateinterval;
     end;
    end;
    if GetUpdateModus(chan[0])=0
    then begin
     WFM_Group_Control(1,1,1);	{START}
     if warten then repeat
      WFM_Check(1,chan[0],wfmStopped,itersDone,pointsDone);
      if wfmStopped then break;
      MatYield;			{macht Throw() bei ^C}
     until false;
    end else begin
     if not NoMessage
     then mexVPrintf('DAQWAVO: MESSAGE: Ausgabe erfolgt erst nach DAQWAVO(1)'#10,
       vsrec,0);
    end;
{    timeout:=GetTickCount-timeout;}
{    wvsprintf(s,'WFM_Op: %ld ms',timeout);
    Warning(s);
    MessageBeep($FFFF);}

   end;
   1: begin
    if not R2I(prhs[0],0,4,@operation,1)
    then Error('falscher Befehlscode');
    if operation=3 then begin
     NoMessage:=not NoMessage;
     exit;
    end;
    if hintp=0 then Error('keine Wellenform geladen');
    case operation of
     0: FreeHIntP;
     1: if warten then repeat
      WFM_Group_Control(1,1,operation);
      WFM_Check(1,chan[0],wfmStopped,itersDone,pointsDone);
      if wfmStopped then break;
      MatYield;			{macht Throw() bei ^C}
     until false;
     else WFM_Group_Control(1,1,operation);
    end{case};
   end;
{   2: begin
    timeout:=Round(mxGetScalar(prhs[1])/55E-3);
    if timeout<0 then timeout:=-1;
    Timeout_Config(1,timeout);
   end;}
   else mexVPrintf(
    '1 Parameter: 0=stop, 1=start, 2=pause, 4=resume'#10+
{    '2 Parameter: <0> <timeout> in s, -1=unendlich'#10+}
    '3..4 Parameter: <Kanle(0,1)> <Sampledaten als Matrix in V>'#10+
    ' <Samplerate in Hz> [<Wiederholungen, sonst 1>]'#10+
    ' negative <Wiederholungen>: Warten auf Ende'#10+
    'Mehr Info: help daq'#10,chan,0);
  end;
 end;

var
 OldExit: Pointer;

procedure NewExit; far;
{globalen Speicher freigeben}
 begin
  ExitProc:=OldExit;
  FreeHIntP;
 end;

exports
 set_entry_point index 2,
 mexFunction 	 index 3,
 mexAtExitFcn	 index 4;

begin
 OldExit:=ExitProc;
 ExitProc:=@NewExit;
end.
Vorgefundene Kodierung: UTF-80