library ddepoke;
uses PasMex32,Windows,DDEML,dde_init;
{jede dieser DLLs auf andere Basisadressen relozieren}
{$IMAGEBASE $10030000}
procedure CopyFloatXl(indata,dp: PDouble; x,y:LongInt);
{Durchgehende Doubles in XlTable-Doubles umwandeln}
begin
PrepareXlTable(dp,x,y);
x:=x*y; {Rollentausch: x=gesamt, y=Block}
while x>0 do begin
y:=SkipXlFloatHeader(dp);
CopyMemory(dp,indata,y*sizeof(Double));
Inc(dp,y); Inc(indata,y); Dec(x,y);
end;
end;
procedure mexFunction(nlhs:LongInt; var plhs:TMatArr;
nrhs:LongInt; const prhs:TMatArr); stdcall;
var
conv: HConv;
item: Hsz;
indata,data: PChar; {data kann, muss aber kein String sein!}
datalen,cf: UInt;
format: EClip;
timeout: LongInt;
inchar: Bool;
lp: PLongInt;
dp: PDouble absolute lp;
x,y: LongInt; {Matrix-Ausdehnung}
{Mehr-als-zwei-dimensionale Matrizen knnen nur mit CF_MatTable
bertragen werden}
begin
TestInputArgs(nrhs,prhs,3,5,$0E,$1D); {ncbbn}
conv:=Round(mxGetScalar(prhs[0]));
item:=ArrayToStringHandle(prhs[1]);
inchar:=mxIsChar(prhs[2]);
cf:=CF_Text; format:=Text;
if nrhs>=4 then format:=CheckClipFormat(prhs[3],cf,nil);
{testen & umwandeln in 1, 2 oder 3}
timeout:=StdTimeOut;
if nrhs=5 then timeout:=Round(mxGetScalar(prhs[4]));
data:=nil; {Compiler ist blind wegen fehlendem CASE-ELSE-Zweig...}
if inchar then begin
indata:=mxArrayToString(prhs[2]); {"verschluckt" Unicodes}
case format of
Text: begin
data:=indata; {nicht schaufeln!}
datalen:=lstrlen(data)+1;
end;
Unicode: begin
data:=Alloc_Datalen(format,x,y,datalen); {indata verwerfend}
mxGetStringW(prhs[2],PWChar(data),datalen);
end;
XlTable: begin
str_count_numbers(indata,x,y);
data:=Alloc_Datalen(format,x,y,datalen);
dp:=Pointer(data);
PrepareXlTable(dp,x,y);
str_to_numbers(indata,x,y,dp,true); {alles umwandeln!}
PutWarn(18); {Schwachsinn-Meldung}
end;
MatTable: begin
str_count_numbers(indata,x,y);
data:=Alloc_Datalen(format,x,y,datalen);
lp:=Pointer(data);
lp^:=LongInt(mxDouble_Class); inc(lp); {nur DOUBLE}
if (x=1) and (y=1) then lp^:=0 {nulldimensional = Skalar}
else begin
lp^:=2; inc(lp); {Dimensionen (fest bei Matrizen)}
lp^:=y; inc(lp);
lp^:=x;
end;
inc(lp);
str_to_numbers(indata,x,y,dp,false); {alles umwandeln!}
PutWarn(18); {Schwachsinn-Meldung}
end;
end;
end else begin
PDouble(indata):=mxGetPr(prhs[2]); {Delphi sollte hier (weg)optimieren}
x:=mxGetN(prhs[2]);
y:=mxGetM(prhs[2]);
datalen:=mxGetNumberOfDimensions(prhs[2]);
case format of
Text: begin
if datalen>2 then PutErr(15); {kann nicht umsetzen Dims>2}
data:=Alloc_datalen(format,x,y,datalen);
str_from_numbers(data,x,y,PDouble(indata),false);
end;
Unicode: PutErr(17); {Kann nicht / will nicht}
XlTable: begin
if datalen>2 then PutErr(15); {kann nicht umsetzen Dims>2}
data:=Alloc_Datalen(format,x,y,datalen);
CopyFloatXl(PDouble(indata),PDouble(data),x,y);
end;
MatTable: begin
x:=datalen;
y:=mxGetNumberOfElements(prhs[2]);
datalen:=(2+x)*sizeof(LongInt)+y*sizeof(Double);
data:=PChar(LocalAlloc(LMEM_Fixed,datalen));
lp:=Pointer(data);
lp^:=LongInt(mxDouble_Class); inc(lp); {z.Z. nur DOUBLE}
lp^:=x; inc(lp); {Dimensionen (fest bei Text)}
CopyMemory(lp,mxGetDimensions(prhs[2]),x*sizeof(LongInt));
inc(lp,x);
CopyMemory(dp,indata,y*sizeof(Double));
end;
end{case};
end{else};
plhs[0]:=mxCreateDoubleMatrix(1,1,mxReal);
mxGetPr(plhs[0])^:=LongInt(DdeClientTransaction(
data,datalen,conv,item,cf,XTYP_Poke,timeout,nil)<>0);
{BOOL-Rckgabe}
mxSetLogical(plhs[0]); {neu bei Matlab5}
FreeStringHandle(item);
if inchar then mxFree(indata);
if (not inchar) or (format<>Text) then LocalFree(Integer(data));
HandleDdeError(0); {falls etwas schiefging: anzeigen!}
end;
exports
mexFunction;
begin
DisableThreadLibraryCalls(HInstance);
end.
Vorgefundene Kodierung: UTF-8 | 0
|