From bfdb140f638aefd97e385f7addc7ebf1ff80d248 Mon Sep 17 00:00:00 2001 From: Erich Eckner Date: Mon, 25 Aug 2014 16:29:58 +0200 Subject: Initialer Commit --- epostunit.pas | 5184 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 5184 insertions(+) create mode 100644 epostunit.pas (limited to 'epostunit.pas') diff --git a/epostunit.pas b/epostunit.pas new file mode 100644 index 0000000..7f19d20 --- /dev/null +++ b/epostunit.pas @@ -0,0 +1,5184 @@ +unit epostunit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fileunit, werteunit, typenunit, process; + +type + TBmpHeader = packed record + bfType1 : byte; + bfType2 : byte; + bfSize : longint; + bfReserved1 : word; + bfReserved2 : word; + bfOffBits : longint; + biSize : longint; + biWidth : longint; + biHeight : longint; + biPlanes : word; + biBitCount : word; + biCompression : longint; + biSizeImage : longint; + biXPelsPerMeter : longint; + biYPelsPerMeter : longint; + biClrUsed : longint; + biClrImportant : longint; + end ; + tPalette = record + name: string; + farben: tRGBArray; + end; + pTPalette = ^tPalette; + tWerte = class; + tLiKo = array of record + alpha: extended; + werte: tWerte; + end; + pTLiKo = ^tLiKo; + pTWerteArray = ^TWerteArray; + TWerteArray = array of tWerte; + tKontur = class(tObject) + private + function rxmin: extended; + function rxmax: extended; + function rtmin: extended; + function rtmax: extended; + function sortiere_nach_y(mt: longint): boolean; overload; + function sortiere_nach_y(mt,von,bis: longint): boolean; overload; + public + farbe: tRGB; + orte: tExtPointArray; + bezeichner: string; + function init(st: boolean; var f: tInputfile; w: pTWerteArray; mt: longint): boolean; + function liesVonDatei(st: boolean; s: string; xmi,xma,tmi,tma: extended): boolean; + function erzeugeAusWerten(st: boolean; s: string; w: pTWerteArray; mt: longint; _xmin,_xmax,_tmin,_tmax: string): boolean; + property xmin: extended read rxmin; + property xmax: extended read rxmax; + property tmin: extended read rtmin; + property tmax: extended read rtmax; + constructor create; + destructor destroy; override; + end; + tKonturenArray = array of tKontur; + pTKonturenArray = ^tKonturenArray; + tLeseThread = class; + tWerte = class(tObject) +{ + Diese Klasse ist die benutzerseitige Variante von tLLWerte und benutzt + letztere. Sie übernimmt auch die Parallelisierung. +} + private + leseThread: tLeseThread; + function findeAlleDateien(nam: string; var dat: tGenerischeInputDateiInfoArray; Vorlage: tGenerischeInputDateiInfo): boolean; + function ermittleExterneInputParameter(var f: tInputfile; out dateien: tGenerischeInputDateiInfoArray): boolean; + function ermittleInterneInputParameter(var dateien: tGenerischeInputDateiInfoArray): boolean; + procedure initVerzerrung(quelle: tWerte; xMin,xMax,tMin,tMax,x0Abs,t0Abs,mt: longint; oberst: boolean; epsilon: extended; verzerrung: tVerzerrung; ZPs: tPointArray; ZGs: tExtPointArray; ZAs: tExtendedArray); + function rXsteps: longint; + procedure wXsteps(xs: longint); + function rTsiz: longint; + procedure wTsiz(ts: longint); + function rXstart: extended; + procedure wXstart(xs: extended); + function rXstop: extended; + procedure wXstop(xs: extended); + function rTstart: extended; + procedure wTstart(ts: extended); + function rTstop: extended; + procedure wTstop(ts: extended); + function rNp: extended; + procedure wNp(np: extended); + function rBeta: extended; + procedure wBeta(beta: extended); + function rMinw: extended; + procedure wMinw(miw: extended); + function rMaxw: extended; + procedure wMaxw(maw: extended); + function callBackGetValue(s: string): extended; + function xscale: extended; + function tscale: extended; + function dichtenParameterErkannt(st: boolean; s: string; threads,xmin,xmax,tmin,tmax: longint): boolean; + public + eWerte: tLLWerteDouble; + sWerte: tLLWerteSingle; + Genauigkeit: tGenauigkeit; + bezeichner: string; + Konturen: pTKonturenArray; + constructor create(Kont: pTKonturenArray); overload; + constructor create(original: tWerte; xmin,xmax: longint); overload; + destructor destroy; override; + procedure warteAufBeendigungDesLeseThreads; + procedure kopiereVon(st: boolean; original: tWerte); overload; + procedure kopiereVon(st: boolean; original: tWerte; xmin,xmax: longint); overload; + function ladeDateien(st: boolean; var f: tInputfile; pl: boolean): boolean; + function ladeAscii(st: boolean; datei: string): boolean; + function berechneLiKo(st: boolean; var f: tInputfile; threads: longint; const wertes: pTWerteArray): boolean; + function berechneQuotient(st: boolean; var f: tInputfile; threads, dividend, divisor: longint; const wertes: pTWerteArray): boolean; + function berechneKorrelation(st: boolean; var f: tInputfile; threads: longint; const quelle: tWerte): boolean; + procedure ermittleMinMaxDichten(st: boolean; threads: longint; symmetrisch: boolean); overload; + procedure ermittleMinMaxDichten(st: boolean; threads,xmin,xmax,tmin,tmax: longint; symmetrisch: boolean); overload; + function fft(threads: longint; senkrecht,invers: boolean; const vor,nach: tFFTDatenordnung; const fen: tFenster; out pvFehler: extended; Warn: tWarnstufe): boolean; overload; + function fft(threads,xmin,xmax,tmin,tmax: longint; senkrecht,invers: boolean; const vor,nach: tFFTDatenordnung; const fen: tFenster; out pvFehler: extended; Warn: tWarnstufe): boolean; overload; + function berechneZeitfrequenzanalyse(st: boolean; var f: tInputfile; threads: longint; const quelle: tWerte; Warn: tWarnstufe): boolean; + function berechneVerzerrung(st: boolean; var f: tInputfile; threads: longint; const quelle: tWerte): boolean; + function berechneIntegral(st: boolean; var f: tInputfile; threads: longint; const quelle: tWerte): boolean; + function berechneFFT(st: boolean; var f: tInputfile; threads: longint; Warn: tWarnstufe): boolean; + function berechneFFT2d(st: boolean; var f: tInputfile; threads: longint; Warn: tWarnstufe): boolean; + function erzeugeLinearesBild(st: boolean; var f: tInputfile; maxThreads: longint): boolean; + function erzeugeAscii(st: boolean; var f: tInputfile): boolean; + function erzeugeLineout(st: boolean; params: string): boolean; + procedure spiegle(threads: longint); overload; + procedure spiegle(threads,tmin,tmax: longint); overload; + procedure fft2dNachbearbeitung(threads: longint; nb: tFFTDatenordnung); + procedure schreibeWert(var f: textfile; x,y: longint); + function exprtofloat(st: boolean; s: string): extended; + function paramsdump: string; + procedure beendeLeseThreadWennFertig; + property _xsteps: longint read rXsteps write wXsteps; + property _tsiz: longint read rTsiz write wTsiz; + property _xstart: extended read rXstart write wXstart; + property _xstop: extended read rXstop write wXstop; + property _tstart: extended read rTstart write wTstart; + property _tstop: extended read rTstop write wTstop; + property _np: extended read rNp write wNp; + property _beta: extended read rBeta write wBeta; + property _minw: extended read rMinw write wMinw; + property _maxw: extended read rMaxw write wMaxw; + end; + tAchse = record + Lage: TLage; + Striche: Longint; + Faktor: extended; + end; + tBeschriftungsschritt = record + bis,faktor: extended; + schritte: longint; + linear: boolean; + end; + tLogThread = class(tThread) + fertig: boolean; + constructor create; + destructor destroy; override; + procedure execute; override; + procedure stExecute; virtual; abstract; + end; + tLiKoThread = class(tLogThread) + wertes: pTWerteArray; + liKo: pTLiKo; + xMi,xMa,tMi,tMa,tOf,xOf: longint; + pW: tWerte; + constructor create(lk: pTLiKo; ws: pTWerteArray; pWerte: tWerte; xMin,xMax,tMin,tMax,xOff,tOff: longint); + procedure stExecute; override; + end; + tQuotientThread = class(tLogThread) + wertes: pTWerteArray; + eps: extended; + xMi,xMa,tMi,tMa,tOf,xOf: longint; + dend,sor,quot: tWerte; + constructor create(dividend, divisor, quotient: tWerte; epsilon: extended; xMin,xMax,tMin,tMax,xOff,tOff: longint); + procedure stExecute; override; + end; + tBilderthread = class(tLogThread) + nummer,mt,breite,wbreite,hoehe, + whoehe,gesbreite,lof,oof,rof,uof: longint; + w: tWerte; + xmi,xma,tmi,tma,xpmi,xpma: Longint; + xz,yz: extended; + nb: tBearbeitungen; + farben: trgbArray; + werte: tExtendedArray; + anzahlen: tLongintArray; + pal: tRGBArray; + rahmen: boolean; + beschr: pTBeschriftungen; + constructor create(i,maxthreads,ibreite,ihoehe,lo,oo,ro,uo: longint; const we: tWerte; xmin,xmax,tmin,tmax: Longint; xzoom,yzoom: extended; Nachbearbeitung: tBearbeitungen; palette: pTPalette; beschri: pTBeschriftungen; rm: boolean); + destructor destroy; override; + procedure stExecute; override; + end; + tDichteThread = class(tLogThread) + maxDichte,minDichte: extended; + xmin,xmax,tmin,tmax: longint; + w: tWerte; + constructor create(xmi,xma,tmi,tma: longint; const werte: tWerte); + procedure stExecute; override; + end; + tSpiegelThread = class(tLogThread) + tmin,tmax: longint; + pW: tWerte; + constructor create(tmi,tma: longint; pWerte: tWerte); + procedure stExecute; override; + end; + tFFT2dNBThread = class(tLogThread) + xmin,xmax: longint; + pW: tWerte; + nb: tFFTDatenordnung; + constructor create(xmi,xma: longint; pWerte: tWerte; endordnung: tFFTDatenordnung); + procedure stExecute; override; + end; + tFFTThread = class(tLogThread) + xMi,xMa,tMi,tMa: longint; + vo,na: tFFTDatenordnung; + fen: tFenster; + erfolg,sen,inv: boolean; + pW: tWerte; + pvFehler: extended; + constructor create(werte: tWerte; xMin,xMax,tMin,tMax: longint; senkrecht,invers: boolean; const vor,nach: tFFTDatenordnung; const fenster: tFenster); + procedure stExecute; override; + end; + tKorrelThread = class(tLogThread) + wl: tWavelet; + xMi,xMa,tMi,tMa,tOf,xOf: longint; + qu,zi: tWerte; + pvFehler: extended; + constructor create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax,xOff,tOff: longint; wavelet: tWavelet); + procedure stExecute; override; + end; + tKonturAusWertenThread = class(tLogThread) + w: tWerte; + s: extended; + xmi,xma,tmi,tma: longint; + punkte: tExtPointArray; + constructor create(werte: tWerte; schwelle: extended; xmin, xmax, tmin, tmax: longint); + destructor destroy; override; + procedure stExecute; override; + end; + tIntegralThread = class(tLogThread) + qu,zi: tWerte; + xmi,xma,tmi,tma,xof,tof: longint; + rtg: tIntegrationsRichtung; + constructor create(quelle, ziel: tWerte; xmin, xmax, tmin, tmax, xoff, toff: longint; richtung: tIntegrationsRichtung); + procedure stExecute; override; + end; + tSortiereNachYThread = class(tLogThread) + Kont: tKontur; + vo,bi,mt: longint; + erfolg: boolean; + constructor create(K: tKontur; threads,von,bis: longint); + procedure stExecute; override; + end; + tBefehlThread = class(tLogThread) + bg: boolean; + p: tProcess; + constructor create(cmd: string; out erfolg: boolean); + destructor destroy; override; + procedure stExecute; override; + end; + tLeseThread = class(tLogThread) + w: tWerte; + inputs: tGenerischeInputDateiInfoArray; + constructor create(we: tWerte; inps: tGenerischeInputDateiInfoArray); + destructor destroy; override; + procedure stExecute; override; + end; + tVerzerrInitThread = class(tLogThread) + qu,zi: tWerte; + ZPs: tPointArray; + ZGs: tExtPointArray; + ZAs: tExtendedArray; + xMi,xMa,tMi,tMa,x0,t0,mt: longint; // bzgl. Ziel + eps: extended; + verz: tVerzerrung; + constructor create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax,x0Abs,t0Abs,threads: longint; epsilon: extended; verzerrung: tVerzerrung; zielpositionen: tPointArray; zielgewichte: tExtPointArray); + procedure stExecute; override; + destructor destroy; override; + end; + tVerzerrThread = class(tLogThread) + qu,zi: tWerte; + ZPs: tPointArray; + ZGs: tExtPointArray; + ZAs: tExtendedArray; + xMi,xMa,tMi,tMa: longint; // bzgl. Ziel + vb,nb: tBearbeitungen; + constructor create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax: longint; zielpositionen: tPointArray; zielgewichte: tExtPointArray; zielanzahlen: tExtendedArray; Vorbearbeitungen,Nachbearbeitungen: tBearbeitungen); + procedure stExecute; override; + end; + +function neuePalette(var f: tInputfile): boolean; +function initBmpHeader(w,h: longint): tBmpHeader; +procedure schreibeBmpHeader(var f: file; w,h: longint); +function findePalette(out Palette: pTPalette; name: string): boolean; +function erzeugeLegende(st: boolean; var f: tInputfile; datei: string; Qu: tWerte; minDichte,maxDichte: extended; nb: tBearbeitungen; pal: pTPalette): boolean; +function strToFftDo(out fftDo: tFFTDatenordnung; s: string): boolean; +function findeWerte(s: String; pws: pTWerteArray; Kont: pTKonturenArray; darfErstellen: boolean): integer; +function findeKontur(s: String; pks: pTKonturenArray; darfErstellen: boolean): integer; +function externerBefehl(st: boolean; s: string): boolean; +procedure warte_auf_externeBefehle; + +var Paletten: array of tPalette; + behalteLogs: boolean; + externeBefehle: array of tBefehlThread; + +implementation + +uses math; + +// tWerte ********************************************************************** + +constructor tWerte.create(Kont: pTKonturenArray); +var ps: pTExtrainfos; +begin + inherited create; + getmem(ps,sizeof(tExtrainfos)); + ps^:=tExtrainfos.create; + Genauigkeit:=gSingle; + leseThread:=nil; + sWerte:=tLLWerteSingle.create(ps); + eWerte:=tLLWerteDouble.create(ps); + Konturen:=Kont; + bezeichner:=''; +end; + +constructor tWerte.create(original: tWerte; xmin,xmax: longint); +var ps: pTExtrainfos; + pSi: pTLLWerteSingle; + pEx: pTLLWerteDouble; +begin + inherited create; + original.warteAufBeendigungDesLeseThreads; + getmem(ps,sizeof(tExtrainfos)); + ps^:=tExtrainfos.create; + leseThread:=nil; + Genauigkeit:=original.Genauigkeit; + Konturen:=original.Konturen; + case Genauigkeit of + gSingle: begin + pSi:=@(original.sWerte); + sWerte:=tLLWerteSingle.create(pSi,ps,xmin,xmax); + eWerte:=tLLWerteDouble.create(ps); + end; + gExtended: begin + sWerte:=tLLWerteSingle.create(ps); + pEx:=@(original.eWerte); + eWerte:=tLLWerteDouble.create(pEx,ps,xmin,xmax); + end; + end{of case}; + if original.bezeichner='' then bezeichner:='' + else bezeichner:=original.bezeichner+''''; +end; + +destructor tWerte.destroy; +begin + warteAufBeendigungDesLeseThreads; + if eWerte.params<>sWerte.params then begin + eWerte.params^.free; + freemem(eWerte.params,sizeof(tExtrainfos)); + end; + sWerte.params^.free; + freemem(sWerte.params,sizeof(tExtrainfos)); + eWerte.free; + sWerte.free; + inherited destroy; +end; + +procedure tWerte.warteAufBeendigungDesLeseThreads; +begin + if assigned(leseThread) then begin + gibAus('Warte auf Beendigung des Lesethreads von '''+bezeichner+''' ...',3); + while not leseThread.fertig do + sleep(100); + leseThread.free; + leseThread:=nil; + gibAus('... ist fertig',3); + end; +end; + +procedure tWerte.kopiereVon(st: boolean; original: tWerte); overload; +begin + kopiereVon(st,original,0,original._xsteps-1); +end; + +procedure tWerte.kopiereVon(st: boolean; original: tWerte; xmin,xmax: longint); overload; +var pSi: pTLLWerteSingle; + pEx: pTLLWerteDouble; +begin + original.warteAufBeendigungDesLeseThreads; + Genauigkeit:=original.Genauigkeit; + case Genauigkeit of + gSingle: begin + pSi:=@(original.sWerte); + sWerte.kopiereVon(st,pSi,xmin,xmax); + end; + gExtended: begin + pEx:=@(original.eWerte); + eWerte.kopiereVon(st,pEx,xmin,xmax); + end; + end{of case}; + if original.bezeichner='' then bezeichner:='' + else bezeichner:=original.bezeichner+''''; +end; + +function tWerte.rXsteps: longint; +begin + case genauigkeit of + gSingle: result:=sWerte.params^.xsteps; + gExtended: result:=eWerte.params^.xsteps; + end{of case}; +end; + +procedure tWerte.wXsteps(xs: longint); +begin + sWerte.params^.xsteps:=xs; + eWerte.params^.xsteps:=xs; +end; + +function tWerte.rTsiz: longint; +begin + case genauigkeit of + gSingle: result:=sWerte.params^.tsiz; + gExtended: result:=eWerte.params^.tsiz; + end{of case}; +end; + +procedure tWerte.wTsiz(ts: longint); +begin + sWerte.params^.tsiz:=ts; + eWerte.params^.tsiz:=ts; +end; + +function tWerte.rXstart: extended; +begin + case genauigkeit of + gSingle: result:=sWerte.params^.xstart; + gExtended: result:=eWerte.params^.xstart; + end{of case}; +end; + +procedure tWerte.wXstart(xs: extended); +begin + case genauigkeit of + gSingle: sWerte.params^.xstart:=xs; + gExtended: eWerte.params^.xstart:=xs; + end{of case}; +end; + +function tWerte.rXstop: extended; +begin + case genauigkeit of + gSingle: result:=sWerte.params^.xstop; + gExtended: result:=eWerte.params^.xstop; + end{of case}; +end; + +procedure tWerte.wXstop(xs: extended); +begin + case genauigkeit of + gSingle: sWerte.params^.xstop:=xs; + gExtended: eWerte.params^.xstop:=xs; + end{of case}; +end; + +function tWerte.rTstart: extended; +begin + case genauigkeit of + gSingle: result:=sWerte.params^.tstart; + gExtended: result:=eWerte.params^.tstart; + end{of case}; +end; + +procedure tWerte.wTstart(ts: extended); +begin + case genauigkeit of + gSingle: sWerte.params^.tstart:=ts; + gExtended: eWerte.params^.tstart:=ts; + end{of case}; +end; + +function tWerte.rTstop: extended; +begin + case genauigkeit of + gSingle: result:=sWerte.params^.tstop; + gExtended: result:=eWerte.params^.tstop; + end{of case}; +end; + +procedure tWerte.wTstop(ts: extended); +begin + case genauigkeit of + gSingle: sWerte.params^.tstop:=ts; + gExtended: eWerte.params^.tstop:=ts; + end{of case}; +end; + +function tWerte.rNp: extended; +begin + case genauigkeit of + gSingle: result:=sWerte.params^.np; + gExtended: result:=eWerte.params^.np; + end{of case}; +end; + +procedure tWerte.wNp(np: extended); +begin + case genauigkeit of + gSingle: sWerte.params^.np:=np; + gExtended: eWerte.params^.np:=np; + end{of case}; +end; + +function tWerte.rBeta: extended; +begin + case genauigkeit of + gSingle: result:=sWerte.params^.beta; + gExtended: result:=eWerte.params^.beta; + end{of case}; +end; + +procedure tWerte.wBeta(beta: extended); +begin + case genauigkeit of + gSingle: sWerte.params^.beta:=beta; + gExtended: eWerte.params^.beta:=beta; + end{of case}; +end; + +function tWerte.rMinw: extended; +begin + case genauigkeit of + gSingle: result:=sWerte.params^.minw; + gExtended: result:=eWerte.params^.minw; + end{of case}; +end; + +procedure tWerte.wMinw(miw: extended); +begin + case genauigkeit of + gSingle: sWerte.params^.minw:=miw; + gExtended: eWerte.params^.minw:=miw; + end{of case}; +end; + +function tWerte.rMaxw: extended; +begin + case genauigkeit of + gSingle: result:=sWerte.params^.maxw; + gExtended: result:=eWerte.params^.maxw; + end{of case}; +end; + +procedure tWerte.wMaxw(maw: extended); +begin + case genauigkeit of + gSingle: sWerte.params^.maxw:=maw; + gExtended: eWerte.params^.maxw:=maw; + end{of case}; +end; + +function tWerte.findeAlleDateien(nam: string; var dat: tGenerischeInputDateiInfoArray; Vorlage: tGenerischeInputDateiInfo): boolean; +var err: longint; + s,prae,post: string; + i,mi,ma: longint; + sr: tSearchRec; +begin + result:=false; + if pos('{',nam)>0 then begin + s:=copy(nam,pos('{',nam)+1,pos('}',nam)-pos('{',nam)-1); + if pos('..',s)=0 then begin + gibAus('Syntaxfehler im Dateinamen!',3); + exit; + end; + mi:=strtoint(copy(s,1,pos('..',s)-1)); + ma:=strtoint(copy(s,pos('..',s)+length('..'),length(s))); + prae:=copy(nam,1,pos('{',nam)-1); + post:=copy(nam,pos('}',nam)+1,length(nam)); + for i:=mi to ma do + result:=findeAlleDateien(prae+inttostr(i)+post,dat,Vorlage) or result; + if not result then begin + gibAus('Keine Datei passt zum Muster '''+nam+'''!',3); + exit; + end; + end + else begin + err:=findfirst(nam,$3f,sr); + if err<>0 then begin + findclose(sr); + gibAus('Keine Datei passt zum Muster '''+nam+'''!',3); + exit; + end; + while err=0 do begin + setlength(dat,length(dat)+1); + if Vorlage is tTraceInputDateiInfo then + dat[length(dat)-1]:=tTraceInputDateiInfo.create(Vorlage); + if Vorlage is tSpaceTimeInputDateiInfo then + dat[length(dat)-1]:=tSpaceTimeInputDateiInfo.create(Vorlage); + if Vorlage is tPipeInputDateiInfo then + dat[length(dat)-1]:=tPipeInputDateiInfo.create(Vorlage); + dat[length(dat)-1].Name:=extractfilepath(nam)+extractfilename(sr.Name); + err:=findnext(sr); + end; + findclose(sr); + result:=true; + end; +end; + +function tWerte.ermittleExterneInputParameter(var f: tInputfile; out dateien: tGenerischeInputDateiInfoArray): boolean; +// Parameter ermitteln, die in der Config-Datei stehen +var s: string; + ne,be,maxAmp: extended; + Vorlagen: tInputDateiInfoVorlagen; + g: textfile; + erfolg: Word; + i: Longint; + mitGewalt: boolean; +procedure aufraeumen; +var ii: longint; +begin + if assigned(Vorlagen) then Vorlagen.free; + for ii:=0 to length(dateien)-1 do + if assigned(dateien[ii]) then + dateien[ii].free; + setlength(dateien,0); +end; + +begin + result:=false; + setlength(dateien,0); + Vorlagen:=tInputDateiInfoVorlagen.create; + Vorlagen.params:=sWerte.params; + ne:=0; + maxAmp:=0; + sWerte.params^.beta:=-1; + sWerte.params^.maxW:=0; + sWerte.params^.minW:=0; + sWerte.params^.np:=0; + sWerte.params^.tstart:=0; + sWerte.params^.tstop:=0; + sWerte.params^.xstart:=0; + sWerte.params^.xstop:=0; + mitGewalt:=false; + repeat + if not f.gibZeile(s) then begin + gibAus('Unerwartetes Dateiende!',3); + aufraeumen; + exit; + end; + if s='Ende' then + break; + if s='mit Gewalt' then begin + mitGewalt:=true; + continue; + end; + if pos('Genauigkeit:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + if not Vorlagen.GenauigkeitFromStr(s) then begin + aufraeumen; + exit; + end; + if (Genauigkeit=gSingle) and (Vorlagen.Genauigkeit=gExtended) then + Genauigkeit:=gExtended; + continue; + end; + if pos('Faktor:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do + delete(s,1,1); + Vorlagen.faktor:=exprtofloat(false,s); + continue; + end; + if pos('tmin:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do + delete(s,1,1); + Vorlagen.tstart:=exprtofloat(false,s); + continue; + end; + if pos('tmax:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do + delete(s,1,1); + Vorlagen.tstop:=exprtofloat(false,s); + continue; + end; + if pos('xmin:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do + delete(s,1,1); + Vorlagen.xstart:=exprtofloat(false,s); + continue; + end; + if pos('xmax:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do + delete(s,1,1); + Vorlagen.xstop:=exprtofloat(false,s); + continue; + end; + if pos('Name:',s)=1 then begin + delete(s,1,pos(':',s)); + bezeichner:=trim(s); + continue; + end; + if pos('Inputparameterdatei:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do + delete(s,1,1); + if (not mitGewalt) and (not fileexists(extractfilepath(s)+'times-1')) and + ((Vorlagen.Fehlerbehebungskommando='') or + (sysutils.ExecuteProcess(Vorlagen.Fehlerbehebungsprogramm,Vorlagen.Fehlerbehebungsparameter,[])<>0) or + not fileexists(extractfilepath(s)+'times-1')) then begin + gibAus('Die Simulation in '''+extractfilepath(s)+''' ist nicht abgeschlossen!',3); + aufraeumen; + exit; + end; + assignfile(g,s); + reset(g); + erfolg:=0; + while not eof(g) do begin + readln(g,s); + if pos('#',s)>0 then delete(s,pos('#',s),length(s)); + while pos(' ',s)=1 do delete(s,1,1); + if pos('Gamma ',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)>0 do delete(s,pos(' ',s),1); + Vorlagen.faktor:=1/power(strtofloat(s),3); + erfolg:=erfolg or 1; + continue; + end; + if pos('Beta ',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)>0 do delete(s,pos(' ',s),1); + be:=strtofloat(s); + erfolg:=erfolg or 2; + continue; + end; + if pos('n_el_over_nc ',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)>0 do delete(s,pos(' ',s),1); + ne:=strtofloat(s); + erfolg:=erfolg or 4; + continue; + end; + if pos('.a0 ',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do + delete(s,1,1); + if strtofloat(s)>maxAmp then begin + maxAmp:=strtofloat(s); + erfolg:=erfolg or 8; + end; + continue; + end; + if pos('pulse component # ',s)=1 then begin + erfolg:=erfolg and (not 8); + continue; + end; + if odd(erfolg shr 3) and (pos('.frequency ',s)=1) then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do + delete(s,1,1); + Vorlagen.groeszenFaktor:=strtofloat(s); + erfolg:=erfolg and (not 8); + continue; + end; + end; + close(g); + if erfolg<>7 then begin + gibAus('Die Inputparameterdatei enthält die gesuchten Parameter nicht!',3); + aufraeumen; + exit; + end; + ne:=sqrt(ne)/Vorlagen.groeszenFaktor; + if (sWerte.params^.np<>0) and (ne<>sWerte.params^.np) then begin + gibAus('Die Plasmafrequenzen in den Eingangsdateien unterscheiden sich ('+floattostr(sWerte.params^.np)+' vs. '+floattostr(ne)+')!',3); + aufraeumen; + exit; + end; + sWerte.params^.np:=ne; + if (sWerte.params^.beta<>-1) and (be<>sWerte.params^.beta) then begin + gibAus('Die Bezugssystemgeschwindigkeiten in den Eingangsdateien unterscheiden sich ('+floattostr(sWerte.params^.beta)+' vs. '+floattostr(be)+')!',3); + aufraeumen; + exit; + end; + sWerte.params^.beta:=be; + continue; + end; + if pos('Fehlerbehebungskommando:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + Vorlagen.Fehlerbehebungskommando:=s; + continue; + end; + if pos('Spurnummer:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + Vorlagen.SpurNummer:=strtoint(s); + continue; + end; + if pos('Feldnummer:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + Vorlagen.FeldNummer:=strtoint(s); + continue; + end; + if pos('Feld:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + Vorlagen.FeldNummer:=-1; + for i:=0 to length(FeldgroeszenNamen)-1 do + if uppercase(s)=FeldgroeszenNamen[i] then begin + Vorlagen.FeldNummer:=i; + break; + end; + if Vorlagen.FeldNummer>=0 then continue; + gibAus('Unbekannte Feldgröße '''+s+'''!',3); + aufraeumen; + exit; + end; + if pos('Analysator:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + Vorlagen.Analysator:=s; + continue; + end; + if pos('SpaceTime-Datei:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + if fileexists(s) then begin + setlength(dateien,length(dateien)+1); + dateien[length(dateien)-1]:=tSpaceTimeInputDateiInfo.create(Vorlagen.SpaceTimeVorlage); + dateien[length(dateien)-1].Name:=s; + continue; + end; + if not findeAlleDateien(s,dateien,Vorlagen.SpaceTimeVorlage) then begin + aufraeumen; + exit; + end; + continue; + end; + if pos('Trace-Datei:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + if fileexists(s) then begin + setlength(dateien,length(dateien)+1); + dateien[length(dateien)-1]:=tTraceInputDateiInfo.create(Vorlagen.TraceVorlage); + dateien[length(dateien)-1].Name:=s; + continue; + end; + if not findeAlleDateien(s,dateien,Vorlagen.TraceVorlage) then begin + aufraeumen; + exit; + end; + continue; + end; + if pos('Pipe:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + setlength(dateien,length(dateien)+1); + dateien[length(dateien)-1]:=tPipeInputDateiInfo.create(Vorlagen.PipeVorlage); + dateien[length(dateien)-1].Name:=s; + continue; + end; + gibAus('Verstehe Parameter '''+s+''' nicht beim Einlesen!',3); + aufraeumen; + exit; + until false; + Vorlagen.free; + result:=true; +end; + +function tWerte.ermittleInterneInputParameter(var Dateien: tGenerischeInputDateiInfoArray): boolean; +// Parameter ermitteln, die aus der einzulesenden Datei hervorgehen +var i,j,k,num,tmpi,br,SpAnz: longint; + tmps: single; + tmpe: extended; + f: file; + Positionen: tLongintArray; + Sortiert: tGenerischeInputDateiInfoArray; + ipp,ipap: tProcess; + buf: array of byte; + s,t: string; +begin + result:=false; + genauigkeit:=gSingle; + for i:=0 to length(dateien)-1 do + genauigkeit:=tGenauigkeit(max(byte(genauigkeit),byte(dateien[i].genauigkeit))); + tmpi:=0; + num:=0; + tmps:=0; + SpAnz:=-1; + setlength(Positionen,length(dateien)); + for i:=0 to length(Positionen)-1 do + Positionen[i]:=-1; + for i:=0 to length(dateien)-1 do begin + if dateien[i] is tPipeInputDateiInfo then begin + ipp:=tProcess.create(nil); // dieser Prozess generiert die Daten + ipp.Executable:=(dateien[i] as tPipeInputDateiInfo).Executable; + ipp.Parameters.Text:=(dateien[i] as tPipeInputDateiInfo).ParametersText; + ipp.Options:=ipp.Options + [poUsePipes]; + ipap:=tProcess.create(nil); // dieser Prozess analysiert die Daten + ipap.Executable:=(dateien[i] as tPipeInputDateiInfo).AnalysatorExecutable; + ipap.Parameters.Text:=(dateien[i] as tPipeInputDateiInfo).AnalysatorParametersText; + ipap.Options:=ipp.Options + [poUsePipes]; + ipp.execute; + ipap.execute; + s:=''; + br:=0; + while (ipp.running or (ipp.Output.NumBytesAvailable > 0)) and ipap.running do begin + if ipap.Output.NumBytesAvailable>0 then begin + setlength(s,br+ipap.Output.NumBytesAvailable); + br:=br+ipap.Output.Read(s[br+1],length(s)-br); + continue; + end; + if ipp.Output.NumBytesAvailable > 0 then begin + setlength(buf,ipp.Output.NumBytesAvailable); + setlength(buf,ipp.Output.Read(buf[0],length(buf))); + j:=0; + k:=-1; + while (j0) do begin + k:=ipap.Input.Write(buf[j],length(buf)-j); + j:=j+k; + end; + sleep(100); // SEHR DRECKIG !!! + continue; + end; + sleep(100); + end; + + if not ipap.running then + ipp.CloseOutput; + if not ipp.running then + ipap.CloseInput; + + setlength(buf,0); + + while ipap.running or (ipap.Output.NumBytesAvailable>0) do begin + setlength(s,br+ipap.Output.NumBytesAvailable); + br:=br+ipap.Output.Read(s[br+1],length(s)-br); + if ipap.running then + sleep(100); + end; + + ipp.free; + ipap.free; + + dateien[i].groeszenFaktor:=1; + + s:=s+#10; + while (pos(#13,s)>0) or (pos(#10,s)>0) do begin + t:=copy(s,1,max(pos(#13,s),pos(#10,s))-1); + if pos(#13,t)>0 then t:=copy(t,1,pos(#13,t)-1); + if pos(#10,t)>0 then t:=copy(t,1,pos(#10,t)-1); + delete(s,1,length(t)+1); + t:=trim(t); + if pos('Channels',t)=1 then begin + delete(t,1,pos(':',t)); + t:=trim(t); + dateien[i].xsteps:=strtoint(t); + continue; + end; + if pos('Sample Rate',t)=1 then begin + delete(t,1,pos(':',t)); + dateien[i].groeszenFaktor:=dateien[i].groeszenFaktor/strtofloat(trim(t)); + continue; + end; + if pos('Precision',t)=1 then begin + delete(t,1,pos(':',t)); + t:=trim(t); + if rightStr(t,4)<>'-bit' then begin + gibAus('Ich verstehe die Genauigkeitsangabe '''+t+''' nicht bei einer Pipe!',3); + exit; + end; + delete(t,length(t)-3,4); + (dateien[i] as tPipeInputDateiInfo).bytesPerSample:=ceil(strtofloat(trim(t))/8); + continue; + end; + if pos('Duration',t)=1 then begin + delete(t,1,pos(':',t)); + delete(t,1,pos('=',t)); + t:=trim(t); + t:=leftStr(t,pos(' ',t)-1); + dateien[i].tsiz:=strtoint(t); + dateien[i].groeszenFaktor:=dateien[i].groeszenFaktor*dateien[i].tsiz; + continue; + end; + if pos('Sample Encoding',t)=1 then begin + delete(t,1,pos(':',t)); + t:=trim(t); + if t='32-bit Signed Integer PCM' then begin + (dateien[i] as tPipeInputDateiInfo).Kodierung:=k32BitSignedInteger; + continue; + end; + gibAus('Ich kenne die Kodierung '''+t+''' nicht bei einer Pipe!',3); + exit; + end; + end; + num:=0; + repeat + k:=-1; + for j:=0 to i-1 do + if Positionen[j]=num then begin + inc(k); + inc(num); + end; + until k=-1; + Positionen[i]:=num; + end; + if (dateien[i] is tSpaceTimeInputDateiInfo) or + (dateien[i] is tTraceInputDateiInfo) then begin + if (dateien[i].xsteps<>dateien[i].xmax-dateien[i].xmin+1) or + (dateien[i].tsiz<>dateien[i].tmax-dateien[i].tmin+1) then begin + gibAus('Nur einen Teil der Datei einzulesen ist für SpaceTime- und Trace-Dateien noch nicht implementiert!',3); + exit; + end; + assign(f,dateien[i].Name); + reset(f,1); + blockread(f,num,sizeof(longint)); + if dateien[i] is tTraceInputDateiInfo then begin + blockread(f,tmpi,sizeof(longint)); + if spAnz<0 then spAnz:=tmpi; + dateien[i].xsteps:=1; + if spAnz<>tmpi then begin + gibAus('Falsche Anzahl an Spuren ('+inttostr(tmpi)+' statt '+inttostr(spAnz)+') in Datei '''+dateien[i].Name+'''!',3); + close(f); + exit; + end; + if ((dateien[i] as TTraceInputDateiInfo).Spurnummer<0) or ((dateien[i] as TTraceInputDateiInfo).Spurnummer>=spAnz) then begin + gibAus('Ausgewählte Spurnummer ('+inttostr((dateien[i] as TTraceInputDateiInfo).Spurnummer)+') liegt außerhalb des verfügbaren Bereiches (0..'+inttostr(spAnz-1)+')!',3); + close(f); + exit; + end; + if ((dateien[i] as TTraceInputDateiInfo).Feldnummer<0) or ((dateien[i] as TTraceInputDateiInfo).Feldnummer>=length(FeldgroeszenNamen)) then begin + gibAus('Ausgewählte Feldnummer ('+inttostr((dateien[i] as TTraceInputDateiInfo).Feldnummer)+') liegt außerhalb des verfügbaren Bereiches (0..'+inttostr(length(FeldgroeszenNamen)-1)+')!',3); + close(f); + exit; + end; + end; + blockread(f,tmpi,sizeof(longint)); + dateien[i].tsiz:=tmpi; + if dateien[i] is tSpaceTimeInputDateiInfo then begin + case dateien[i].Genauigkeit of + gSingle: begin + blockread(f,tmps,sizeof(single)); + tmpe:=tmps; + end; + gExtended: blockread(f,tmpe,sizeof(extended)); + end{of case}; + tmpe:=tmpe*dateien[i].groeszenFaktor; + if i=0 then _xstart:=tmpe; + if tmpe<>_xstart then begin + gibAus('Falscher linker Rand in '''+dateien[i].Name+''', nämlich '+myfloattostr(tmpe)+' statt '+myfloattostr(_xstart)+'.',3); + close(f); + exit; + end; + case dateien[i].Genauigkeit of + gSingle: begin + blockread(f,tmps,sizeof(single)); + tmpe:=tmps; + end; + gExtended: blockread(f,tmpe,sizeof(extended)); + end{of case}; + tmpe:=tmpe*dateien[i].groeszenFaktor; + if i=0 then _xstop:=tmpe; + if tmpe<>_xstop then begin + gibAus('Falscher rechter Rand in '''+dateien[i].Name+''', nämlich '+myfloattostr(tmpe)+' statt '+myfloattostr(_xstop)+'.',3); + close(f); + exit; + end; + blockread(f,tmpi,sizeof(longint)); + dateien[i].xsteps:=tmpi; + end; + close(f); + for j:=0 to i-1 do + if Positionen[j]=num then begin + gibAus('Datei '''+dateien[i].Name+''' ist redundant zu '''+dateien[j].Name+'''.',3); + exit; + end; + Positionen[i]:=num; + end; + end; + + _tsiz:=0; + _xsteps:=dateien[0].xsteps; + for i:=0 to length(dateien)-1 do begin + if dateien[i].xsteps<>_xsteps then begin + gibAus('Falsche Anzahl an x-Werten in '''+dateien[i].Name+''', nämlich '+inttostr(dateien[i].xsteps)+' statt '+inttostr(_xsteps)+'.',3); + exit; + end; + _tsiz:=_tsiz+dateien[i].tsiz; + if dateien[i].groeszenFaktor<>dateien[0].groeszenFaktor then begin + gibAus('Die Dateien haben nicht alle den gleichen Größenfaktor!',3); + exit; + end; + end; + + _tstart:=Positionen[0]*dateien[0].groeszenFaktor; + _tstop:=(Positionen[0]+1)*dateien[0].groeszenFaktor; + for i:=1 to length(Positionen)-1 do begin + _tstart:=min(_tstart,Positionen[i]*dateien[i].groeszenFaktor); + _tstop:=max(_tstop,(Positionen[i]+1)*dateien[i].groeszenFaktor); + end; + if 0<>round(_tstart+length(dateien)*dateien[0].groeszenFaktor-_tstop) then begin + gibAus('Die Dateien decken nicht den kompletten Zeitbereich von '+inttostr(round(_tstart))+'T bis '+inttostr(round(_tstop))+'T ab!',3); + exit; + end; + setlength(sortiert,length(dateien)); + for i:=0 to length(Positionen)-1 do + sortiert[Positionen[i]-round(_tstart/dateien[i].groeszenFaktor)]:=dateien[i]; + for i:=0 to length(Positionen)-1 do begin + dateien[i]:=sortiert[i]; + if i=0 then begin + dateien[i].t0abs:=0; + sWerte.params^.tsiz_:=dateien[i].tmax-dateien[i].tmin+1; + sWerte.params^.xsteps_:=dateien[i].xmax-dateien[i].xmin+1; + end + else begin + dateien[i].t0abs:= + dateien[i-1].t0abs + dateien[i-1].tsiz; + sWerte.params^.tsiz_:= + sWerte.params^.tsiz_ + dateien[i].tmax-dateien[i].tmin+1; + if sWerte.params^.xsteps_<>dateien[i].xmax-dateien[i].xmin+1 then begin + gibAus('Die Dateien haben unterschiedliche Anzahlen an x-Werten im ausgewählten Bereich!',3); + exit; + end; + end; + end; + + result:=true; +end; + +procedure tWerte.initVerzerrung(quelle: tWerte; xMin,xMax,tMin,tMax,x0Abs,t0Abs,mt: longint; oberst: boolean; epsilon: extended; verzerrung: tVerzerrung; ZPs: tPointArray; ZGs: tExtPointArray; ZAs: tExtendedArray); +var i,j: longint; + vits: array[boolean] of tVerzerrInitThread; + b: boolean; +begin + if mt<=1 then begin + for i:=0 to _tsiz-1 do + for j:=0 to _xsteps-1 do + ZAs[j + i*_xsteps]:=0; + for i:=tMin to tMax do begin + for j:=xMin to xMax do begin + ZGs[j+i*quelle._xsteps]:=verzerrung.ziel(j,i); + ZPs[j+i*quelle._xsteps].x:=floor(ZGs[j+i*quelle._xsteps].x); + ZPs[j+i*quelle._xsteps].y:=floor(ZGs[j+i*quelle._xsteps].y); + ZGs[j+i*quelle._xsteps].x:= + ZGs[j+i*quelle._xsteps].x - ZPs[j+i*quelle._xsteps].x; + ZGs[j+i*quelle._xsteps].y:= + ZGs[j+i*quelle._xsteps].y - ZPs[j+i*quelle._xsteps].y; + ZPs[j+i*quelle._xsteps].x:=ZPs[j+i*quelle._xsteps].x - x0Abs; // Zielpositionen um die Nullposition verschieben + ZPs[j+i*quelle._xsteps].y:=ZPs[j+i*quelle._xsteps].y - t0Abs; + ZAs[ZPs[j+i*quelle._xsteps].x + ZPs[j+i*quelle._xsteps].y*_xsteps]:= + ZAs[ZPs[j+i*quelle._xsteps].x + ZPs[j+i*quelle._xsteps].y*_xsteps] + (1-ZGs[j+i*quelle._xsteps].x)*(1-ZGs[j+i*quelle._xsteps].y); + ZAs[ZPs[j+i*quelle._xsteps].x + 1 + ZPs[j+i*quelle._xsteps].y*_xsteps]:= + ZAs[ZPs[j+i*quelle._xsteps].x + 1 + ZPs[j+i*quelle._xsteps].y*_xsteps] + ZGs[j+i*quelle._xsteps].x*(1-ZGs[j+i*quelle._xsteps].y); + ZAs[ZPs[j+i*quelle._xsteps].x + (ZPs[j+i*quelle._xsteps].y + 1)*_xsteps]:= + ZAs[ZPs[j+i*quelle._xsteps].x + (ZPs[j+i*quelle._xsteps].y + 1)*_xsteps] + (1-ZGs[j+i*quelle._xsteps].x)*ZGs[j+i*quelle._xsteps].y; + ZAs[ZPs[j+i*quelle._xsteps].x + 1 + (ZPs[j+i*quelle._xsteps].y + 1)*_xsteps]:= + ZAs[ZPs[j+i*quelle._xsteps].x + 1 + (ZPs[j+i*quelle._xsteps].y + 1)*_xsteps] + ZGs[j+i*quelle._xsteps].x*ZGs[j+i*quelle._xsteps].y; + end; + end; + end + else begin + for b:=false to true do + vits[b]:= + tVerzerrInitThread.create( + quelle, + self, + byte(not b)*xMin + byte(b)*((xMax+xMin) div 2 + 1), + byte(not b)*((xMax+xMin) div 2) + byte(b)*xMax, + tMin, + tMax, + x0Abs, + t0Abs, + mt div 2 + byte(odd(mt) and b), + epsilon, + verzerrung, + ZPs, + ZGs); + while not (vits[false].fertig and vits[true].fertig) do + sleep(100); + for i:=0 to length(ZAs)-1 do + ZAs[i]:= + vits[false].ZAs[i] + + vits[true].ZAs[i]; + for b:=false to true do + vits[b].free; + end; + if oberst then + for i:=0 to length(ZAs)-1 do + ZAs[i]:=max(ZAs[i],epsilon); +end; + +function tWerte.xscale: extended; +begin + result:=(_xstop-_xstart)/(_xsteps-1); +end; + +function tWerte.tscale: extended; +begin + result:=(_tstop-_tstart)/(_tsiz-1); +end; + +function tWerte.dichtenParameterErkannt(st: boolean; s: string; threads,xmin,xmax,tmin,tmax: longint): boolean; +begin + result:=true; + if pos('maximale und minimale Dichten bestimmen',s)=1 then begin + delete(s,1,length('maximale und minimale Dichten bestimmen')); + ermittleMinMaxDichten(st,threads,xmin,xmax,tmin,tmax,trim(s)='(symmetrisch)'); + exit; + end; + if pos('Minimaldichte:',s)=1 then begin + delete(s,1,pos(':',s)); + s:=trim(s); + _minW:=exprtofloat(st,s); + exit; + end; + if pos('Maximaldichte:',s)=1 then begin + delete(s,1,pos(':',s)); + s:=trim(s); + _maxW:=exprtofloat(st,s); + exit; + end; + result:=false; +end; + +function tWerte.ladeDateien(st: boolean; var f: tInputfile; pl: boolean): boolean; +var inputs: tGenerischeInputDateiInfoArray; + +procedure aufraeumen; +var ii: longint; +begin + for ii:=0 to length(inputs)-1 do + if assigned(inputs[ii]) then + inputs[ii].free; + setlength(inputs,0); +end; + +begin + result:=false; + warteaufBeendigungDesLeseThreads; + Genauigkeit:=gSingle; + if not ermittleExterneInputParameter(f,inputs) then begin + aufraeumen; + exit; + end; + if not ermittleInterneInputParameter(inputs) then begin + aufraeumen; + exit; + end; + if not st then begin + case Genauigkeit of + gSingle: + sWerte.holeRam(3); + gExtended: + eWerte.holeRam(3); + end{of case}; + if pl then + leseThread:=tLeseThread.create(self,inputs) + else + case Genauigkeit of + gSingle: + sWerte.liesDateien(inputs); + gExtended: + eWerte.liesDateien(inputs); + end{of case}; + end; + aufraeumen; + result:=true; +end; + +function tWerte.ladeAscii(st: boolean; datei: string): boolean; +var i,j,k: integer; + Zeit: extended; + g: textfile; + s,t: string; +begin + result:=false; + warteaufBeendigungDesLeseThreads; + Genauigkeit:=gExtended; + _tsiz:=-100; + _tstart:=-100; + _tstop:=-100; + _xsteps:=-100; + _xstart:=-100; + _xstop:=-100; + _np:=-100; + _beta:=-100; + assignFile(g,datei); + reset(g); + while not eof(g) do begin + readln(g,s); + if pos('#',s)>0 then delete(s,pos('#',s),length(s)); + while pos(' ',s)=1 do delete(s,1,1); + if s='' then continue; + if s='Header Ende' then break; + if pos('tsiz',s)=1 then begin + delete(s,1,length('tsiz')); + while pos(' ',s)=1 do delete(s,1,1); + _tsiz:=strtoint(s); + continue; + end; + if pos('tstart',s)=1 then begin + delete(s,1,length('tstart')); + while pos(' ',s)=1 do delete(s,1,1); + _tstart:=exprtofloat(st,s); + continue; + end; + if pos('tstop',s)=1 then begin + delete(s,1,length('tstop')); + while pos(' ',s)=1 do delete(s,1,1); + _tstop:=exprtofloat(st,s); + continue; + end; + if pos('xsteps',s)=1 then begin + delete(s,1,length('xsteps')); + while pos(' ',s)=1 do delete(s,1,1); + _xsteps:=strtoint(s); + continue; + end; + if pos('xstart',s)=1 then begin + delete(s,1,length('xstart')); + while pos(' ',s)=1 do delete(s,1,1); + _xstart:=exprtofloat(st,s); + continue; + end; + if pos('xstop',s)=1 then begin + delete(s,1,length('xstop')); + while pos(' ',s)=1 do delete(s,1,1); + _xstop:=exprtofloat(st,s); + continue; + end; + if pos('np',s)=1 then begin + delete(s,1,length('np')); + while pos(' ',s)=1 do delete(s,1,1); + _np:=exprtofloat(st,s); + continue; + end; + if pos('beta',s)=1 then begin + delete(s,1,length('beta')); + while pos(' ',s)=1 do delete(s,1,1); + _beta:=exprtofloat(st,s); + continue; + end; + if pos('Name',s)=1 then begin + delete(s,1,length('Name')); + bezeichner:=trim(s); + continue; + end; + gibAus('Verstehe Option '''+s+''' in Asci-Input-Datei '''+datei+''' nicht!',3); + closefile(g); + exit; + end; + if (_tsiz=-100) or (_tstart=-100) or (_tstop=-100) or (_xsteps=-100) or (_xstart=-100) or (_xstop=-100) or (_np=-100) or (_beta=-100) then begin + gibAus('Ungenügende Informationen über Raumzeitfenster in Asci-Input-Datei '''+datei+'''!',3); + closefile(g); + exit; + end; + if not st then begin + eWerte.holeRam(3); + gibAus('Datei einlesen ...',3); + end; + Zeit:=now; + s:=''; + i:=0; + repeat + if eof(g) then begin + gibAus('Unerwartetes Dateiende in Asci-Input-Datei '''+datei+'''!',3); + closefile(g); + exit; + end; + readln(g,t); + for j:=1 to length(t) do + case t[j] of + '{': inc(i); + '}': dec(i); + end; + s:=s+t; + until (i=0) and (length(s)>0); + if not eof(g) then begin + gibAus('Zu viele Zeilen in Asci-Input-Datei '''+datei+'''!',3); + closefile(g); + exit; + end; + closefile(g); + k:=1; + while s[k]<>'{' do inc(k); + inc(k); + for i:=0 to _tsiz-1 do begin + while s[k]<>'{' do inc(k); + for j:=0 to _xsteps-1 do begin + t:=''; + while not (s[k] in [',','}']) do begin + if s[k] in ['-','0'..'9','e','E','.'] then t:=t+s[k]; + if s[k] = '^' then t:=t+'E'; + inc(k); + end; + if (s[k]='}') xor (j=_xsteps-1) then begin + gibAus('Falsche Anzahl an Datenspalten in Asci-Input-Datei '''+datei+''' in Datenzeile '+inttostr(i+1)+'!',3); + exit; + end; + if (pos(',',t)>0) and (pos('e',t)=0) and (pos('E',t)=0) then t:=t+'0'; + if not st then + eWerte.werte[j+i*_tsiz]:=strtofloat(t); + inc(k); + end; + end; + gibAus('... fertig '+ZeitDarstellen(now-Zeit),3); + result:=true; +end; + +function tWerte.berechneLiKo(st: boolean; var f: tInputfile; threads: longint; const wertes: pTWerteArray): boolean; +var i,xmin,xmax,tmin,tmax: longint; + liKo: tLiKo; + s: string; + fertig: boolean; + liKoThreads: array of tLiKoThread; + Zeit: extended; +begin + result:=false; + warteaufBeendigungDesLeseThreads; + setlength(liKo,0); + Genauigkeit:=gExtended; + _xsteps:=0; + _tsiz:=0; + Zeit:=now; + repeat + if not f.gibZeile(s) then begin + gibAus('Unerwartetes Dateiende!',3); + exit; + end; + if s='Ende' then break; + if pos('Name:',s)=1 then begin + delete(s,1,pos(':',s)); + bezeichner:=trim(s); + continue; + end; + if pos('xmin:',s)=1 then + begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + xmin:=min(_xsteps-1,max(0,round((exprtofloat(st,s)-_xstart)*(_xsteps-1)/(_xstop-_xstart)))); + continue; + end; + if pos('xmax:',s)=1 then + begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + xmax:=min(_xsteps-1,max(0,round((exprtofloat(st,s)-_xstart)*(_xsteps-1)/(_xstop-_xstart)))); + continue; + end; + if pos('tmin:',s)=1 then + begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + tmin:=min(_tsiz-1,max(0,round((exprtofloat(st,s)-_tstart)*_tsiz/(_tstop-_tstart)))); + continue; + end; + if pos('tmax:',s)=1 then + begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + tmax:=min(_tsiz-1,max(0,round((exprtofloat(st,s)-_tstart)*_tsiz/(_tstop-_tstart)))); + continue; + end; + setlength(liKo,length(liKo)+1); + i:=findeWerte(copy(s,1,pos(' ',s)-1),wertes,Konturen,false); + if i<0 then + exit; + delete(s,1,pos(' ',s)); + while pos(' ',s)=1 do delete(s,1,1); + liKo[length(liKo)-1].alpha:=wertes^[i].exprtofloat(st,s); + while i<0 do i:=i+length(wertes^)-1; + liKo[length(liKo)-1].werte:=wertes^[i mod (length(wertes^)-1)]; + if _xsteps=0 then begin + _xsteps:=liKo[length(liKo)-1].werte._xsteps; + _xstart:=liKo[length(liKo)-1].werte._xstart; + _xstop:=liKo[length(liKo)-1].werte._xstop; + xmin:=0; + xmax:=_xsteps-1; + end; + if _tsiz=0 then begin + _tsiz:=liKo[length(liKo)-1].werte._tsiz; + _tstart:=liKo[length(liKo)-1].werte._tstart; + _tstop:=liKo[length(liKo)-1].werte._tstop; + tmin:=0; + tmax:=_tsiz-1; + end; + if _xsteps<>liKo[length(liKo)-1].werte._xsteps then begin + gibAus('Unterschiedliche Anzahl an x-Schritten: '+inttostr(_xsteps)+' bisher vs. '+inttostr(liKo[length(liKo)-1].werte._xsteps)+' bei '+inttostr(i)+'!',3); + exit; + end; + if _tsiz<>liKo[length(liKo)-1].werte._tsiz then begin + gibAus('Unterschiedliche Anzahl an t-Schritten: '+inttostr(_tsiz)+' bisher vs. '+inttostr(liKo[length(liKo)-1].werte._tsiz)+' bei '+inttostr(i)+'!',3); + exit; + end; + if liKo[length(liKo)-1].werte.Genauigkeit<>liKo[0].werte.Genauigkeit then begin + gibAus('Ich bin dumm, ich kann nur Werte mit gleicher Genauigkeit zusammenrechnen!',3); + exit; + end; + if liKo[length(liKo)-1].werte._xstart<>liKo[0].werte._xstart then begin + gibAus('Anfangspostionen passen nicht zusammen ('+floattostr(liKo[0].werte._xstart)+' bisher vs. '+floattostr(liKo[length(liKo)-1].werte._xstart)+' bei '+inttostr(i)+')!',3); + exit; + end; + if liKo[length(liKo)-1].werte._xstop<>liKo[0].werte._xstop then begin + gibAus('Endpostionen passen nicht zusammen ('+floattostr(liKo[0].werte._xstop)+' bisher vs. '+floattostr(liKo[length(liKo)-1].werte._xstop)+' bei '+inttostr(i)+')!',3); + exit; + end; + if liKo[length(liKo)-1].werte._tstart<>liKo[0].werte._tstart then begin + gibAus('Anfangszeiten passen nicht zusammen ('+floattostr(liKo[0].werte._tstart)+' bisher vs. '+floattostr(liKo[length(liKo)-1].werte._tstart)+' bei '+inttostr(i)+')!',3); + exit; + end; + if liKo[length(liKo)-1].werte._tstop<>liKo[0].werte._tstop then begin + gibAus('Endzeiten passen nicht zusammen ('+floattostr(liKo[0].werte._tstop)+' bisher vs. '+floattostr(liKo[length(liKo)-1].werte._tstop)+' bei '+inttostr(i)+')!',3); + exit; + end; + until false; + + if length(liKo)=0 then begin + gibAus('Leere Linearkombination!',3); + exit; + end; + _xsteps:=xmax-xmin+1; + _tsiz:=tmax-tmin+1; + _xstart:=liKo[0].werte._xstart + xmin/(liKo[0].werte._xsteps-1)*(liKo[0].werte._xstop-liKo[0].werte._xstart); + _xstop:=liKo[0].werte._xstart + xmax/(liKo[0].werte._xsteps-1)*(liKo[0].werte._xstop-liKo[0].werte._xstart); + _tstart:=liKo[0].werte._tstart + tmin/(liKo[0].werte._tsiz-1)*(liKo[0].werte._tstop-liKo[0].werte._tstart); + _tstop:=liKo[0].werte._tstart + tmax/(liKo[0].werte._tsiz-1)*(liKo[0].werte._tstop-liKo[0].werte._tstart); + _np:=liKo[0].werte._np; + _beta:=liKo[0].werte._beta; + if st then begin + result:=true; + exit; + end; + eWerte.holeRam(3); + gibAus('Berechne ...',3); + Zeit:=now; + setlength(liKoThreads,threads); + for i:=0 to length(liKoThreads)-1 do + liKoThreads[i]:=tLiKoThread.create(@liKo,wertes,self,round(i*_xsteps/threads),round((i+1)*_xsteps/threads-1),0,_tsiz-1,xmin,tmin); + repeat + sleep(100); + fertig:=true; + for i:=0 to length(liKoThreads)-1 do + fertig:=fertig and liKoThreads[i].fertig; + until fertig; + for i:=0 to length(liKoThreads)-1 do + liKoThreads[i].free; + gibAus('... fertig '+ZeitDarstellen(now-Zeit),3); + result:=true; +end; + +function tWerte.berechneQuotient(st: boolean; var f: tInputfile; threads, dividend, divisor: longint; const wertes: pTWerteArray): boolean; +var i,xmin,xmax,tmin,tmax: longint; + s: string; + fertig: boolean; + quotientThreads: array of tQuotientThread; + Zeit,epsilon: extended; +begin + result:=false; + warteaufBeendigungDesLeseThreads; + Zeit:=now; + _xsteps:=wertes^[dividend]._xsteps; + xmin:=0; + xmax:=_xsteps-1; + _xstart:=wertes^[dividend]._xstart; + _xstop:=wertes^[dividend]._xstop; + _tsiz:=wertes^[dividend]._tsiz; + tmin:=0; + tmax:=_tsiz-1; + _tstart:=wertes^[dividend]._tstart; + _tstop:=wertes^[dividend]._tstop; + _np:=wertes^[dividend]._np; + _beta:=wertes^[dividend]._beta; + epsilon:=1e-9; + Zeit:=now; + repeat + if not f.gibZeile(s) then begin + gibAus('Unerwartetes Dateiende!',3); + exit; + end; + if s='Ende' then break; + if pos('Name:',s)=1 then begin + delete(s,1,pos(':',s)); + bezeichner:=trim(s); + continue; + end; + if pos('xmin:',s)=1 then + begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + xmin:=min(_xsteps-1,max(0,round((exprtofloat(st,s)-_xstart)*(_xsteps-1)/(_xstop-_xstart)))); + continue; + end; + if pos('xmax:',s)=1 then + begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + xmax:=min(_xsteps-1,max(0,round((exprtofloat(st,s)-_xstart)*(_xsteps-1)/(_xstop-_xstart)))); + continue; + end; + if pos('tmin:',s)=1 then + begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + tmin:=min(_tsiz-1,max(0,round((exprtofloat(st,s)-_tstart)*_tsiz/(_tstop-_tstart)))); + continue; + end; + if pos('tmax:',s)=1 then + begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + tmax:=min(_tsiz-1,max(0,round((exprtofloat(st,s)-_tstart)*_tsiz/(_tstop-_tstart)))); + continue; + end; + if pos('epsilon:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + epsilon:=strtoint(s); + continue; + end; + gibAus('Verstehe Option '''+s+''' nicht bei Teile!',3); + exit; + until false; + + _xsteps:=xmax-xmin+1; + _tsiz:=tmax-tmin+1; + if // (wertes[dividend]^.genauigkeit<>wertes[divisor]^.genauigkeit) or + (wertes^[dividend]._xstart<>wertes^[divisor]._xstart) or + (wertes^[dividend]._xstop<>wertes^[divisor]._xstop) or + (wertes^[dividend]._tstart<>wertes^[divisor]._tstart) or + (wertes^[dividend]._tstop<>wertes^[divisor]._tstop) or + (wertes^[dividend]._xsteps<>wertes^[divisor]._xsteps) or + (wertes^[dividend]._tsiz<>wertes^[divisor]._tsiz) then begin +// gibAus('Dividend und Divisor haben verschiedene Abmessungen oder verschiedene Genauigkeiten, sowas verstehe ich nicht!',3); + gibAus('Dividend und Divisor haben verschiedene Abmessungen, sowas verstehe ich nicht!',3); + exit; + end; + _xstart:=wertes^[dividend]._xstart + xmin/(wertes^[dividend]._xsteps-1)*(wertes^[dividend]._xstop-wertes^[dividend]._xstart); + _xstop:=wertes^[dividend]._xstart + xmax/(wertes^[dividend]._xsteps-1)*(wertes^[dividend]._xstop-wertes^[dividend]._xstart); + _tstart:=wertes^[dividend]._tstart + tmin/(wertes^[dividend]._tsiz-1)*(wertes^[dividend]._tstop-wertes^[dividend]._tstart); + _tstop:=wertes^[dividend]._tstart + tmax/(wertes^[dividend]._tsiz-1)*(wertes^[dividend]._tstop-wertes^[dividend]._tstart); + _np:=wertes^[dividend]._np; + _beta:=wertes^[dividend]._beta; + Genauigkeit:=gExtended; + if st then begin + result:=true; + exit; + end; + eWerte.holeRam(3); + gibAus('Berechne ...',3); + Zeit:=now; + setlength(quotientThreads,threads); + for i:=0 to length(quotientThreads)-1 do + quotientThreads[i]:=tQuotientThread.create(wertes^[dividend],wertes^[divisor],self,epsilon,round(i*_xsteps/threads),round((i+1)*_xsteps/threads-1),0,_tsiz-1,xmin,tmin); + repeat + sleep(100); + fertig:=true; + for i:=0 to length(quotientThreads)-1 do + fertig:=fertig and quotientThreads[i].fertig; + until fertig; + for i:=0 to length(quotientThreads)-1 do + quotientThreads[i].free; + gibAus('... fertig '+ZeitDarstellen(now-Zeit),3); + result:=true; +end; + +function tWerte.berechneKorrelation(st: boolean; var f: tInputfile; threads: longint; const quelle: tWerte): boolean; +var i,xmin,xmax,tmin,tmax: longint; + s: string; + wavelet: tWavelet; + fertig: boolean; + ausrichtung: word; // 0 = zentriert, 1 = anfangsbündig, 2 = endbündig + korrelThreads: array of tKorrelThread; + Zeit,pvFehler: extended; + pSi: pTLLWerteSingle; + pEx: pTLLWerteDouble; +begin + result:=false; + warteaufBeendigungDesLeseThreads; + genauigkeit:=gExtended; + wavelet:=tWavelet.create; + wavelet.mitFFT:=false; + Zeit:=now; + wavelet.freq:=0; + wavelet.tfwhm:=1; + wavelet.typ:=wtSin2; + _xsteps:=quelle._xsteps; + xmin:=0; + xmax:=_xsteps-1; + _xstart:=quelle._xstart; + _xstop:=quelle._xstop; + _tsiz:=quelle._tsiz; + tmin:=0; + tmax:=_tsiz-1; + _tstart:=quelle._tstart; + _tstop:=quelle._tstop; + _np:=quelle._np; + _beta:=quelle._beta; + ausrichtung:=0; + repeat + if not f.gibZeile(s) then begin + gibAus('Unerwartetes Dateiende!',3); + exit; + end; + if s='Ende' then break; + if pos('Name:',s)=1 then begin + delete(s,1,pos(':',s)); + bezeichner:=trim(s); + continue; + end; + if pos('xmin:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + xmin:=min(_xsteps-1,max(0,round((exprtofloat(st,s)-_xstart)*(_xsteps-1)/(_xstop-_xstart)))); + continue; + end; + if pos('xmax:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + xmax:=min(_xsteps-1,max(0,round((exprtofloat(st,s)-_xstart)*(_xsteps-1)/(_xstop-_xstart)))); + continue; + end; + if pos('tmin:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + tmin:=min(_tsiz-1,max(0,round((exprtofloat(st,s)-_tstart)*_tsiz/(_tstop-_tstart)))); + continue; + end; + if pos('tmax:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + tmax:=min(_tsiz-1,max(0,round((exprtofloat(st,s)-_tstart)*_tsiz/(_tstop-_tstart)))); + continue; + end; + if pos('freq:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + wavelet.freq:=exprtofloat(st,s)/(_tsiz-1)*(_tstop-_tstart); + continue; + end; + if pos('tfwhm:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + wavelet.tfwhm:=round(exprtofloat(st,s)*(_tsiz-1)/(_tstop-_tstart)); + continue; + end; + if pos('Wavelettyp:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + if not wavelet.setzeTyp(s) then exit; + continue; + end; + if pos('mit FFT',s)=1 then begin + wavelet.mitFFT:=true; + delete(s,1,length('mit FFT')); + while pos(' ',s)=1 do delete(s,1,1); + if s='' then continue; + if s='zentriert' then begin + ausrichtung:=0; + continue; + end; + if s='anfangsbündig' then begin + ausrichtung:=1; + continue; + end; + if s='endbündig' then begin + ausrichtung:=2; + continue; + end; + gibAus('Kenne Ausrichtung '''+s+''' nicht für die FFT bei einer Korrelationsberechnung!',3); + exit; + end; + if s='ohne FFT' then begin + wavelet.mitFFT:=false; + continue; + end; + gibAus('Verstehe Option '''+s+''' nicht!',3); + exit; + until false; + + _xsteps:=xmax-xmin+1; + if wavelet.mitFFT then begin + i:=1; + while 2*i<=tmax-tmin+1 do + i:=i*2; + case ausrichtung of + 0: begin + tmin:=(tmax+1+tmin-i) div 2; + tmax:=tmin+i-1; + end; + 1: tmax:=tmin+i-1; + 2: tmin:=tmax-i+1; + end{of case}; + if (tmin<0) or (tmax>=_tsiz) then begin + gibAus('Der ausgewählte Bereich liegt irgendwie außerhalb der Grenzen, das sollte nicht passieren! ('+inttostr(tmin)+'-'+inttostr(tmax)+' aus 0-'+inttostr(_tsiz-1)+')',3); + gibAus('selbst: '+paramsDump,3); + gibAus('Quelle: '+quelle.paramsDump,3); + exit; + end; + _tsiz:=tmax-tmin+1; + end; + if st then begin + result:=true; + exit; + end; + if wavelet.mitFFT then begin + gibAus('Fordere '+inttostr(floor(_tsiz*_xsteps*sizeof(extended)/1024/1024))+' MB RAM an ('+inttostr(_xsteps)+' x-Schritte mal '+inttostr(_tsiz)+' t-Schritte). ...',3); + gibAus(paramsDump,3); + gibAus(quelle.paramsDump,3); + case quelle.genauigkeit of + gSingle: begin + pSi:=@(quelle.sWerte); + eWerte.kopiereVon(st,pSi,xmin,xmax,tmin,tmax); + end; + gExtended: begin + pEx:=@(quelle.eWerte); + eWerte.kopiereVon(st,pEx,xmin,xmax,tmin,tmax); + end; + end{of case}; + gibAus('... fertig '+ZeitDarstellen(now-Zeit)+', berechne ...',3); + end + else begin + genauigkeit:=gExtended; + _tsiz:=tmax+1-tmin; + eWerte.holeRam(3); + gibAus('Berechne ...',3); + end; + Zeit:=now; + wavelet.werte.params^.tsiz:=_tsiz; + if not wavelet.berechneWerte then begin + gibAus('Es traten Fehler bei der Waveletberechnung auf!',3); + exit; + end; + setlength(korrelThreads,threads); + for i:=0 to length(korrelThreads)-1 do + korrelThreads[i]:=tKorrelThread.create(quelle,self,round(i*_xsteps/threads),round((i+1)*_xsteps/threads-1),0,_tsiz-1,xmin,tmin,wavelet); + repeat + sleep(100); + fertig:=true; + for i:=0 to length(korrelThreads)-1 do + fertig:=fertig and korrelThreads[i].fertig; + until fertig; + pvFehler:=0; + for i:=0 to length(korrelThreads)-1 do begin + pvFehler:=pvFehler+korrelThreads[i].pvFehler; + korrelThreads[i].free; + end; + gibAus(' (Parseval-Fehler = '+floattostr(pvFehler/length(korrelThreads))+')',3); + wavelet.free; + gibAus('... fertig '+ZeitDarstellen(now-Zeit),3); + result:=true; +end; + +procedure tWerte.ermittleMinMaxDichten(st: boolean; threads: longint; symmetrisch: boolean); +begin + ermittleMinMaxDichten(st,threads,0,_xsteps-1,0,_tsiz-1,symmetrisch); +end; + +procedure tWerte.ermittleMinMaxDichten(st: boolean; threads,xmin,xmax,tmin,tmax: longint; symmetrisch: boolean); +var i,j: longint; + DTs: array of tDichteThread; + fertig: boolean; + Zeit: extended; +begin + if st then begin + if _minW>=_maxW then _maxW:=_minW+1; + exit; + end; + warteaufBeendigungDesLeseThreads; + Zeit:=now; + setlength(DTs,threads); + gibAus('Ermittle maximale und minimale Dichten ...',3); + j:=xmin; + for i:=0 to length(DTs)-1 do + begin + DTs[i]:=tDichteThread.create(j,Byte(i=length(DTs)-1)*xmax + Byte(itmax+1-tmin then + fen.berechneWerte(tmax+1-tmin); + end + else begin + if length(fen.Werte)<>xmax+1-xmin then + fen.berechneWerte(xmax+1-xmin); + end; + setlength(fftThreads,threads); + if senkrecht then begin + for i:=0 to threads-1 do + fftThreads[i]:= + tFFTThread.create( + self, + xmin+round((xmax+1-xmin)/threads*i), + xmin+round((xmax+1-xmin)/threads*(i+1)-1), + tmin, + tmax, + senkrecht, + invers, + vor, + nach, + fen); + end + else begin + for i:=0 to threads-1 do + fftThreads[i]:= + tFFTThread.create( + self, + xmin, + xmax, + tmin+round((tmax+1-tmin)/threads*i), + tmin+round((tmax+1-tmin)/threads*(i+1)-1), + senkrecht, + invers, + vor, + nach, + fen); + end; + repeat + sleep(100); + fertig:=true; + for i:=0 to length(fftThreads)-1 do + fertig:=fertig and fftThreads[i].fertig; + until fertig; + result:=true; + pvFehler:=0; + for i:=0 to length(fftThreads)-1 do begin + if Warn=wsStreng then + result:=result and fftThreads[i].erfolg; + pvFehler:=pvFehler+fftThreads[i].pvFehler; + fftThreads[i].free; + end; + pvFehler:=pvFehler/length(fftThreads); + gibAus(' (Parseval-Fehler = '+floattostr(pvFehler)+')',1); + gibAus('Alle FFTThreads fertig!',1); +end; + +function tWerte.berechneZeitfrequenzanalyse(st: boolean; var f: tInputfile; threads: longint; const quelle: tWerte; Warn: tWarnstufe): boolean; +var i,j,tmin,tmax,tOf,Schritt: longint; + Zeit,pvFehler,freqMax: extended; + Fenster: tFenster; + s: string; +begin + result:=false; + if (not st) and (quelle._xsteps<>1) and (quelle._tsiz<>1) then begin + gibAus('Eine Zeitfrequenzanalyse geht nur auf eindimensionalen Daten! ('+inttostr(quelle._xsteps)+'x'+inttostr(quelle._tsiz)+')',3); + exit; + end; + warteaufBeendigungDesLeseThreads; + Zeit:=now; + Fenster.Breite:=0; + Fenster.aktiv:=false; + Fenster.Rand:=0; + Schritt:=round(sqrt(quelle._tsiz)); + tmin:=0; + tmax:=quelle._tsiz-1; + freqMax:=quelle._tsiz/(quelle._tstop-quelle._tstart); + Genauigkeit:=gExtended; + repeat + if not f.gibZeile(s) then begin + gibAus('Unerwartetes Dateiende!',3); + exit; + end; + if s='Ende' then break; + if pos('Name:',s)=1 then begin + delete(s,1,pos(':',s)); + bezeichner:=trim(s); + continue; + end; + if pos('Threadanzahl:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do + delete(s,1,1); + threads:=strtoint(s); + continue; + end; + if pos('Fenster:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do + delete(s,1,1); + Fenster.Breite:=round(quelle.exprtofloat(st,copy(s,1,pos(';',s)-1))*(quelle._tsiz-1)/(quelle._tstop-quelle._tstart)); + delete(s,1,pos(';',s)); + while pos(' ',s)=1 do + delete(s,1,1); + Fenster.Rand:=round(quelle.exprtofloat(st,s)*(quelle._tsiz-1)/(quelle._tstop-quelle._tstart)); + Fenster.aktiv:=true; + continue; + end; + if pos('Schritt:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do + delete(s,1,1); + Schritt:=round(quelle.exprtofloat(st,s)*(quelle._tsiz-1)/(quelle._tstop-quelle._tstart)); + continue; + end; + if (quelle._xsteps=1) then begin + if pos('xmin:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + tmin:=round((quelle.exprtofloat(st,s)-quelle._xstart)*(quelle._xsteps-1)/(quelle._xstop-quelle._xstart)); + continue; + end; + if pos('xmax:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + tmax:=round((quelle.exprtofloat(st,s)-quelle._xstart)*(quelle._xsteps-1)/(quelle._xstop-quelle._xstart)); + continue; + end; + if (pos('wmax:',s)=1) or (pos('omegamax:',s)=1) or (pos('ωmax:',s)=1) then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + freqmax:=quelle.exprtofloat(st,s); + continue; + end; + end; + if (quelle._tsiz=1) then begin + if pos('tmin:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + tmin:=round((quelle.exprtofloat(st,s)-quelle._tstart)*(quelle._tsiz-1)/(quelle._tstop-quelle._tstart)); + continue; + end; + if pos('tmax:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + tmax:=round((quelle.exprtofloat(st,s)-quelle._tstart)*(quelle._tsiz-1)/(quelle._tstop-quelle._tstart)); + continue; + end; + if pos('kmax:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + freqmax:=quelle.exprtofloat(st,s); + continue; + end; + end; + gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer Zeitfrequenzanalyse!',3); + exit; + until false; + tmin:=max(0,tmin); + tmax:=min(quelle._tsiz-1,tmax); + Schritt:=max(1,Schritt); + if not st then begin + _tsiz:=round(power(2,ceil(ln(Fenster.Breite)/ln(2)))); + _xsteps:=1 + ((tmax-tmin+1-(Fenster.Breite-1)) div Schritt); + if _xsteps<=0 then begin + gibAus('Das angegebene Fenster passt nicht zwischen Anfangs- und Endzeit! ('+ + floattostrtrunc(Fenster.Breite/(quelle._tsiz-1)*(quelle._tstop-quelle._tstart),2,true)+'>='+ + floattostrtrunc((tmax-tmin+1)/(quelle._tsiz-1)*(quelle._tstop-quelle._tstart),2,true)+')',3); + exit; + end; + if quelle._tsiz<>1 then begin + _xstart:=quelle._tstart + tmin/(quelle._tsiz-1)*(quelle._tstop-quelle._tstart); + _xstop:= quelle._tstart + tmax/(quelle._tsiz-1)*(quelle._tstop-quelle._tstart); + _tstart:=0; + _tstop:=_tsiz/(quelle._tsiz-1)*(quelle._tstop-quelle._tstart); + end + else begin + _xstart:=quelle._xstart + tmin/(quelle._xsteps-1)*(quelle._xstop-quelle._xstart); + _xstop:= quelle._xstart + tmax/(quelle._xsteps-1)*(quelle._xstop-quelle._xstart); + _tstart:=0; + _tstop:=_tsiz/(quelle._xsteps-1)*(quelle._xstop-quelle._xstart); + end; + tOf:=(_tsiz-Fenster.Breite) div 2; + eWerte.holeRam(3); + gibAus('kopiere Inhalt ...',3); + for j:=0 to tOf-1 do + for i:=0 to _xsteps-1 do + eWerte.werte[i+j*_xsteps]:=0; + for j:=tOf+Fenster.Breite to _tsiz-1 do + for i:=0 to _xsteps-1 do + eWerte.werte[i+j*_xsteps]:=0; + case quelle.Genauigkeit of + gSingle: + for i:=0 to _xsteps-1 do + for j:=0 to Fenster.Breite-1 do begin + eWerte.werte[i + (j+tOf)*_xsteps]:= + quelle.sWerte.werte[i*Schritt+j+tmin]; + end; + gExtended: + for i:=0 to _xsteps-1 do + for j:=0 to Fenster.Breite-1 do + eWerte.werte[i + (j+tOf)*_xsteps]:= + quelle.eWerte.werte[i*Schritt+j+tmin]; + end{of case}; + gibAus('... fertig, berechne Fouriertransformation ...',3); + if not fft(threads,true,false,doRes,doBetrQdr,Fenster,pvFehler,Warn) then begin + gibAus('Es traten Fehler auf!',3); + exit; + end; + _tstop:=(_tsiz div 2-1)/(_tstop-_tstart)/2; + _tstart:=0; + gibAus(' (Parseval-Fehler = '+floattostr(pvFehler)+')',3); + if (_tstop<=freqmax) or (freqmax<=0) then + _tsiz:=_tsiz div 2 + else begin + freqmax:=_tstop * round((_tsiz div 2)/_tstop*freqmax) / (_tsiz div 2); + _tsiz:=round((_tsiz div 2)/_tstop*freqmax); + _tstop:=freqmax; + end; + eWerte.holeRAM(0); + end; + gibAus('... fertig '+ZeitDarstellen(now-Zeit),3); + result:=true; +end; + +function tWerte.berechneVerzerrung(st: boolean; var f: tInputfile; threads: longint; const quelle: tWerte): boolean; +var i,j: longint; + grenzen: t2x2Longint; + ZPs: tPointArray; // Zielpositionen + ZGs: tExtPointArray; // Zielgewichte + ZAs: tExtendedArray; // Anzahl Quellen, die auf entsprechende Zielposition abgebildet werden + Zeit,epsilon: extended; + Vorbearbeitung, + Nachbearbeitung: tBearbeitungen; + verzerrung: tVerzerrung; + s: string; + verzerrThreads: array of tVerzerrThread; + fertig: boolean; +procedure aufraeumen; +var ii: longint; +begin + for ii:=0 to length(verzerrThreads)-1 do + if assigned(verzerrThreads[ii]) then + verzerrThreads[ii].free; + setlength(verzerrThreads,0); + for ii:=0 to Vorbearbeitung.count-1 do + if assigned(Vorbearbeitung[ii]) then + Vorbearbeitung[ii].free; + Vorbearbeitung.free; + for ii:=0 to Nachbearbeitung.count-1 do + if assigned(Nachbearbeitung[ii]) then + Nachbearbeitung[ii].free; + Nachbearbeitung.free; + if assigned(verzerrung) then + verzerrung.free; + setlength(ZPs,0); + setlength(ZGs,0); + setlength(ZAs,0); +end; +begin + result:=false; + warteaufBeendigungDesLeseThreads; + gibAus('Verzerrung berechnen ... ',3); + Zeit:=now; + verzerrung:=tVerzerrung.create; + epsilon:=1e-9; + Genauigkeit:=gExtended; + Vorbearbeitung:=tBearbeitungen.create; + Nachbearbeitung:=tBearbeitungen.create; + repeat + if not f.gibZeile(s) then begin + gibAus('Unerwartetes Dateiende!',3); + aufraeumen; + exit; + end; + if s='Ende' then break; + if quelle.dichtenParameterErkannt(st,s,threads,0,_xsteps-1,0,_tsiz-1) then continue; + if pos('Name:',s)=1 then begin + delete(s,1,pos(':',s)); + bezeichner:=trim(s); + continue; + end; + if pos('Threadanzahl:',s)=1 then begin + delete(s,1,pos(':',s)); + threads:=strtoint(trim(s)); + continue; + end; + if pos('Epsilon:',s)=1 then begin + delete(s,1,pos(':',s)); + epsilon:=exprtofloat(st,trim(s)); + continue; + end; + if pos('Abbildung:',s)=1 then begin + delete(s,1,pos(':',s)); + if not verzerrung.initAbbildung(st,trim(s),quelle.xscale,quelle.tscale,@(exprtofloat)) then begin + gibAus('Syntaxfehler in der Funktion '''+s+'''!',3); + aufraeumen; + exit; + end; + if not st then begin + gibAus(verzerrung.dumpParams,3); + for i:=0 to 1 do + for j:=0 to 1 do + gibAus(inttostr(i*(quelle._xsteps-1))+';'+inttostr(j*(quelle._tsiz-1))+' -> '+floattostr(verzerrung.ziel(i*(quelle._xsteps-1),j*(quelle._tsiz-1)).x)+';'+floattostr(verzerrung.ziel(i*(quelle._xsteps-1),j*(quelle._tsiz-1)).y),3); + end; + continue; + end; + if pos('Nachbearbeitung:',s)=1 then begin + delete(s,1,pos(':',s)); + s:=trim(s); + Nachbearbeitung.addNew; + if not Nachbearbeitung.last.init(st,s,f,@exprtofloat) then begin + aufraeumen; + exit; + end; + continue; + end; + if pos('Vorbearbeitung:',s)=1 then begin + delete(s,1,pos(':',s)); + s:=trim(s); + Vorbearbeitung.addNew; + if not Vorbearbeitung.last.init(st,s,f,@exprtofloat) then begin + aufraeumen; + exit; + end; + continue; + end; + gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer Verzerrung!',3); + aufraeumen; + exit; + until false; + if not st then begin + gibAus('... Zielausdehnung berechnen ... ',3); + verzerrung.berechneZielausdehnung(quelle._xsteps,quelle._tsiz,grenzen); + _xsteps:=grenzen['x','y']-grenzen['x','x']+2; + _tsiz:=grenzen['y','y']-grenzen['y','x']+2; + if (_xsteps<=0) or (_tsiz<=0) then begin + gibAus('Es passt kein Rechteck des Ziels vollständig in die Quelldaten!',3); + aufraeumen; + exit; + end; + _xstart:=quelle._xstart; // eher unzuverlässig, was sollte man auch jetzt von diesen Werten erwarten? + _xstop:= quelle._xstop; + _tstart:=quelle._tstart; + _tstop:= quelle._tstop; + eWerte.holeRam(3); + gibAus('Positionen und Gewichte initialisieren ...',3); + setlength(ZPs,quelle._xsteps*quelle._tsiz); + setlength(ZGs,quelle._xsteps*quelle._tsiz); + setlength(ZAs,_xsteps*_tsiz); + initVerzerrung(quelle,0,quelle._xsteps-1,0,quelle._tsiz-1,grenzen['x','x'],grenzen['y','x'],threads,true,epsilon,verzerrung,ZPs,ZGs,ZAs); + gibAus('... fertig, Threads starten',3); + setlength(verzerrThreads,threads); + for i:=0 to length(verzerrThreads)-1 do + verzerrThreads[i]:=tVerzerrThread.create(quelle,self,round(i/length(verzerrThreads)*_xsteps),round((i+1)/length(verzerrThreads)*_xsteps-1),0,_tsiz-1,ZPs,ZGs,ZAs,Vorbearbeitung,Nachbearbeitung); + repeat + fertig:=true; + for i:=0 to length(verzerrThreads)-1 do + fertig:=fertig and verzerrThreads[i].fertig; + if not fertig then sleep(100); + until fertig; + end; + aufraeumen; + gibAus('... fertig '+ZeitDarstellen(now-Zeit),3); + result:=true; +end; + +function tWerte.berechneIntegral(st: boolean; var f: tInputfile; threads: longint; const quelle: tWerte): boolean; +var i,tmin,tmax,xmin,xmax: longint; + Zeit: extended; + s: string; + rtg: tIntegrationsRichtung; + intThreads: array of tIntegralThread; + fertig: boolean; +begin + result:=false; + warteaufBeendigungDesLeseThreads; + Zeit:=now; + tmin:=0; + tmax:=quelle._tsiz-1; + xmin:=0; + xmax:=quelle._xsteps-1; + Genauigkeit:=gExtended; + rtg:=irHorizontal; + repeat + if not f.gibZeile(s) then begin + gibAus('Unerwartetes Dateiende!',3); + exit; + end; + if s='Ende' then break; + if pos('Name:',s)=1 then begin + delete(s,1,pos(':',s)); + bezeichner:=trim(s); + continue; + end; + if pos('Threadanzahl:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do + delete(s,1,1); + threads:=strtoint(s); + continue; + end; + if pos('xmin:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + xmin:=round((quelle.exprtofloat(st,s)-quelle._xstart)*(quelle._xsteps-1)/(quelle._xstop-quelle._xstart)); + continue; + end; + if pos('xmax:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + xmax:=round((quelle.exprtofloat(st,s)-quelle._xstart)*(quelle._xsteps-1)/(quelle._xstop-quelle._xstart)); + continue; + end; + if pos('tmin:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + tmin:=round((quelle.exprtofloat(st,s)-quelle._tstart)*(quelle._tsiz-1)/(quelle._tstop-quelle._tstart)); + continue; + end; + if pos('tmax:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + tmax:=round((quelle.exprtofloat(st,s)-quelle._tstart)*(quelle._tsiz-1)/(quelle._tstop-quelle._tstart)); + continue; + end; + if pos('Richtung:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + if s='horizontal' then begin + rtg:=irHorizontal; + continue; + end; + if s='einfall' then begin + rtg:=irEinfall; + continue; + end; + if s='ausfall' then begin + rtg:=irAusfall; + continue; + end; + end; + gibAus('Verstehe Option '''+s+''' nicht bei Berechnung eines Integrals!',3); + exit; + until false; + tmin:=max(0,tmin); + tmax:=min(quelle._tsiz-1,tmax); + xmin:=max(0,xmin); + xmax:=min(quelle._xsteps-1,xmax); + if not st then begin + _tsiz:=tmax-tmin+1; + _xsteps:=xmax-xmin+1; + _xstart:=quelle._xstart + xmin/(quelle._xsteps-1)*(quelle._xstop-quelle._xstart); + _xstop:= quelle._xstart + xmax/(quelle._xsteps-1)*(quelle._xstop-quelle._xstart); + _tstart:=quelle._tstart + tmin/(quelle._tsiz-1)*(quelle._tstop-quelle._tstart); + _tstop:= quelle._tstart + tmax/(quelle._tsiz-1)*(quelle._tstop-quelle._tstart); + + eWerte.holeRam(3); + gibAus('Berechne Integrale ...',3); + setlength(intThreads,threads); + for i:=0 to length(intThreads)-1 do + intThreads[i]:= + tIntegralThread.create( + quelle, + self, + xmin, + xmax, + tmin+round( i /length(intThreads)*(tmax+1-tmin)), + tmin+round((i+1)/length(intThreads)*(tmax+1-tmin)-1), + xmin, + tmin, + rtg); + repeat + fertig:=true; + for i:=0 to length(intThreads)-1 do + fertig:=fertig and intThreads[i].fertig; + if not fertig then sleep(100); + until fertig; + + for i:=0 to length(intThreads)-1 do + intThreads[i].free; + + gibAus('... fertig '+ZeitDarstellen(now-Zeit),3); + end; + result:=true; +end; + +function tWerte.berechneFFT(st: boolean; var f: tInputfile; threads: longint; Warn: tWarnstufe): boolean; +var i: longint; + Zeit,pvFehler: extended; + NB: tFFTDatenordnung; + Fenster: tFenster; + senkrecht: boolean; + s: string; +begin + result:=false; + warteaufBeendigungDesLeseThreads; + Zeit:=now; + NB:=doBetrQdr; + Fenster.Breite:=0; + Fenster.Rand:=0; + Fenster.aktiv:=false; + senkrecht:=true; + repeat + if not f.gibZeile(s) then begin + gibAus('Unerwartetes Dateiende!',3); + end; + if s='FFTEnde' then break; + if pos('Name:',s)=1 then begin + delete(s,1,pos(':',s)); + bezeichner:=trim(s); + continue; + end; + if pos('Nachbereitung:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do + delete(s,1,1); + if not strToFftDo(NB,s) then exit; + continue; + end; + if pos('Fenster:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do + delete(s,1,1); + if senkrecht then + Fenster.Rand:=round(exprtofloat(st,s)*(_tsiz-1)/(_tstop-_tstart)) + else + Fenster.Rand:=round(exprtofloat(st,s)*(_xsteps-1)/(_xstop-_xstart)); + Fenster.aktiv:=true; + continue; + end; + if s='senkrecht' then begin + senkrecht:=true; + continue; + end; + if s='waagerecht' then begin + senkrecht:=false; + continue; + end; + gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer FFT!',3); + exit; + until false; + if senkrecht then + Fenster.Breite:=_tsiz - Fenster.Rand + else + Fenster.Breite:=_xsteps - Fenster.Rand; + if not st then begin + gibAus('berechne FFT ...',3); + if not fft(threads,senkrecht,false,doRes,NB,Fenster,pvFehler,Warn) then begin + gibAus('Es traten Fehler auf!',3); + exit; + end; + gibAus(' (Parseval-Fehler = '+floattostr(pvFehler)+')',3); + end; + i:=1; + while 2*i<=_tsiz do + i:=i*2; + _tstop:=_tstart+(_tstop-_tstart)*(i-1)/(_tsiz-1); + _tsiz:=i; + if not st then begin + gibAus('Die Länge wird von '+inttostr(_tsiz)+' auf '+inttostr(i)+' Zeitschritte gekürzt!',3); + eWerte.holeRam(0); + gibAus('... fertig! '+ZeitDarstellen(now-Zeit),3); + end; + _tstop:=(_tsiz-1)/(_tstop-_tstart); + _tstart:=0; + result:=true; +end; + +function tWerte.berechneFFT2d(st: boolean; var f: tInputfile; threads: longint; Warn: tWarnstufe): boolean; +var i,k: longint; + Zeit,pvFehler: extended; + NB,preOrd: tFFTDatenordnung; + Fensters: array[boolean] of tFenster; + s: string; + b,spiegeln: boolean; +begin + result:=false; + warteaufBeendigungDesLeseThreads; + Zeit:=now; + NB:=doBetrQdr; + for b:=false to true do begin + Fensters[b].Breite:=0; + Fensters[b].Rand:=0; + Fensters[b].aktiv:=false; + end; + spiegeln:=false; + repeat + if not f.gibZeile(s) then begin + gibAus('Unerwartetes Dateiende!',3); + end; + if s='FFTEnde' then break; + if pos('Name:',s)=1 then begin + delete(s,1,pos(':',s)); + bezeichner:=trim(s); + continue; + end; + if pos('Nachbereitung:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do + delete(s,1,1); + if not strToFftDo(NB,s) then exit; + continue; + end; + if (pos('-Fenster:',s)=2) and (s[1] in ['x','t']) then begin + b:=s[1]='t'; + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do + delete(s,1,1); + if b then Fensters[b].Rand:=round(exprtofloat(st,s)*(_tsiz-1)/(_tstop-_tstart)) + else Fensters[b].Rand:=round(exprtofloat(st,s)*(_xsteps-1)/(_xstop-_xstart)); + Fensters[b].aktiv:=true; + continue; + end; + if s='x-Spiegelung' then begin + spiegeln:=true; + continue; + end; + gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer zweidimensionalen FFT!',3); + exit; + until false; + Fensters[false].Breite:=_tsiz-Fensters[false].Breite; + Fensters[true].Breite:=_xsteps-Fensters[true].Breite; + if NB=doResIms then preOrd:=doResIms + else preOrd:=doResSmi; + + if st then begin + result:=true; + exit; + end; + + i:=1; + while 2*i<=_tsiz do + i:=i*2; + if _tsiz>i then begin + gibAus('Die Länge wird von '+inttostr(_tsiz)+' auf '+inttostr(i)+' Zeitschritte gekürzt!',3); + _tstop:=_tstart+(_tstop-_tstart)*(i-1)/(_tsiz-1); + _tsiz:=i; + eWerte.holeRam(0); + end; + i:=1; + while 2*i<=_xsteps do + i:=i*2; + if _xsteps>i then begin + gibAus('Die Breite wird von '+inttostr(_xsteps)+' auf '+inttostr(i)+' Ortsschritte gekürzt!',3); + _xstop:=_xstart+(_xstop-_xstart)*(i-1)/(_xsteps-1); + for k:=1 to _tsiz-1 do + Move(eWerte.werte[k*_xsteps],eWerte.werte[k*i],i*sizeof(extended)); + _xsteps:=i; + eWerte.holeRam(0); + end; + gibAus('... fertig! '+ZeitDarstellen(now-Zeit),3); + if spiegeln then begin + gibAus('Werte spiegeln ...',3); +(* for i:=0 to xsteps div 2 -1 do + for j:=0 to tsiz-1 do begin + t1:=eWerte[i+j*xsteps]; + eWerte[i+j*xsteps]:=eWerte[xsteps-1-i+j*xsteps]; + eWerte[xsteps-1-i+j*xsteps]:=t1; + end;*) + spiegle(threads); + gibAus('... fertig! '+ZeitDarstellen(now-Zeit),3); + end; + gibAus('berechne t-FFT ...',3); + if not fft(threads,0,_xsteps-1,0,_tsiz-1,true,false,doRes,preOrd,Fensters[true],pvFehler,Warn) then begin + gibAus('Es traten Fehler auf!',3); + exit; + end; + gibAus(' (Parseval-Fehler = '+floattostr(pvFehler)+')',3); + _tstop:=(_tsiz-1)/(_tstop-_tstart); + _tstart:=0; + gibAus('... fertig! '+ZeitDarstellen(now-Zeit),3); + gibAus('berechne x-FFT ...',3); + if not fft(threads,0,_xsteps-1,0,_tsiz-1,false,false,doRes,preOrd,Fensters[false],pvFehler,Warn) then begin + gibAus('Es traten Fehler auf!',3); + exit; + end; + gibAus(' (Parseval-Fehler = '+floattostr(pvFehler)+')',3); + _xstop:=(_xsteps-1)/(_xstop-_xstart); + _xstart:=0; + gibAus('... fertig! '+ZeitDarstellen(now-Zeit),3); + gibAus('Wertenachbearbeiten ...',3); + case genauigkeit of + gSingle: sWerte.fft2dNachbearbeitungA(NB); + gExtended: eWerte.fft2dNachbearbeitungA(NB); + end{of case}; + case NB of + doBetr,doBetrQdr: + fft2dNachbearbeitung(threads,nb); // die Hauptarbeit + end{of case}; + gibAus('... fertig! '+ZeitDarstellen(now-Zeit),3); + result:=true; +end; + +function tWerte.erzeugeLinearesBild(st: boolean; var f: tInputfile; maxThreads: longint): boolean; +var s,datei: string; + i,j,k,schriftgroesze: longint; + xzoom,yzoom,wert,schritt,miw,maw,Zeit: extended; + xmin,xmax,tmin,tmax,xp,tp: longint; + breite,hoehe,lof,rof,oof,uof: longint; + Palette: pTPalette; + Nachbearbeitung: tBearbeitungen; + BilderThreads: array of TBilderthread; + fertig,Rahmen: boolean; + img: file; + Achsen: array of TAchse; + fontRenderer: tFontRenderer; + beschriftungen: array of tBeschriftung; + verwKonturen: tLongintArray; + +procedure aufraeumen; +var ii: longint; +begin + for ii:=0 to Nachbearbeitung.count-1 do + if assigned(Nachbearbeitung[ii]) then + Nachbearbeitung[ii].free; + Nachbearbeitung.free; + for ii:=0 to length(BilderThreads)-1 do + if assigned(BilderThreads[ii]) then + BilderThreads[ii].free; + setlength(BilderThreads,0); + for ii:=0 to length(beschriftungen)-1 do + if assigned(beschriftungen[ii]) then + beschriftungen[ii].free; + setlength(beschriftungen,0); + setlength(Achsen,0); + if assigned(fontRenderer) then + fontRenderer.free; +end; + +begin + result:=false; + warteaufBeendigungDesLeseThreads; + Zeit:=now; + if not st then + gibAus('erzeuge lineares Bild ...',3); + datei:=''; + xzoom:=1; + yzoom:=1; + xmin:=0; + xmax:=_xsteps-1; + tmin:=0; + tmax:=_tsiz-1; + schriftgroesze:=24; + Nachbearbeitung:=tBearbeitungen.create; + findePalette(Palette,'Graustufen'); + setlength(Achsen,0); + setlength(verwKonturen,0); + setlength(beschriftungen,0); + setlength(BilderThreads,0); + Rahmen:=false; + fontRenderer:=nil; + repeat + if not f.gibZeile(s) then begin + gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); + aufraeumen; + exit; + end; + if pos('Datei:',s)=1 then begin + delete(s,1,pos(':',s)); + datei:=trim(s); + continue; + end; + if pos('Vergrößerung:',s)=1 then begin + delete(s,1,pos(':',s)); + s:=trim(s); + xzoom:=exprtofloat(st,s); + yzoom:=exprtofloat(st,s); + continue; + end; + if pos('x-Vergrößerung:',s)=1 then begin + delete(s,1,pos(':',s)); + s:=trim(s); + xzoom:=exprtofloat(st,s); + continue; + end; + if pos('t-Vergrößerung:',s)=1 then begin + delete(s,1,pos(':',s)); + s:=trim(s); + yzoom:=exprtofloat(st,s); + continue; + end; + if self.dichtenParameterErkannt(st,s,maxThreads,xmin,xmax,tmin,tmax) then continue; + if pos('xmin:',s)=1 then begin + delete(s,1,pos(':',s)); + s:=trim(s); + xmin:=min(_xsteps-1,max(0,round((exprtofloat(st,s)-_xstart)*(_xsteps-1)/(_xstop-_xstart)))); + continue; + end; + if pos('xmax:',s)=1 then begin + delete(s,1,pos(':',s)); + s:=trim(s); + xmax:=min(_xsteps-1,max(0,round((exprtofloat(st,s)-_xstart)*(_xsteps-1)/(_xstop-_xstart)))); + continue; + end; + if pos('tmin:',s)=1 then begin + delete(s,1,pos(':',s)); + s:=trim(s); + tmin:=min(_tsiz-1,max(0,round((exprtofloat(st,s)-_tstart)*(_tsiz-1)/(_tstop-_tstart)))); + continue; + end; + if pos('tmax:',s)=1 then begin + delete(s,1,pos(':',s)); + s:=trim(s); + tmax:=min(_tsiz-1,max(0,round((exprtofloat(st,s)-_tstart)*(_tsiz-1)/(_tstop-_tstart)))); + continue; + end; + if pos('Palette:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + if not findePalette(Palette,s) then begin + gibAus('Kenne Palette '''+s+''' nicht!',3); + aufraeumen; + exit; + end; + continue; + end; + if pos('Schriftgröße:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + schriftgroesze:=strtoint(s); + continue; + end; + if s='Rahmen' then begin + Rahmen:=true; + continue; + end; + if pos('Nachbearbeitung:',s)=1 then begin + delete(s,1,pos(':',s)); + s:=trim(s); + Nachbearbeitung.addNew; + if not Nachbearbeitung.last.init(st,s,f,@exprtofloat) then begin + aufraeumen; + exit; + end; + continue; + end; + if pos('Legende:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + if not erzeugeLegende(st,f,s,self,_minW,_maxW,Nachbearbeitung,Palette) then begin + aufraeumen; + exit; + end; + continue; + end; + if pos('Achse:',s)=1 then begin + delete(s,1,length('Achse:')); + while pos(' ',s)=1 do delete(s,1,1); + setlength(Achsen,length(Achsen)+1); + if pos('oben',s)=1 then begin + Achsen[length(Achsen)-1].Lage:=lOben; + delete(s,1,length('oben')); + end + else if pos('unten',s)=1 then begin + Achsen[length(Achsen)-1].Lage:=lUnten; + delete(s,1,length('unten')); + end + else if pos('links',s)=1 then begin + Achsen[length(Achsen)-1].Lage:=lLinks; + delete(s,1,length('links')); + end + else if pos('rechts',s)=1 then begin + Achsen[length(Achsen)-1].Lage:=lRechts; + delete(s,1,length('rechts')); + end + else begin + gibAus('Ungültiger Parameter '''+s+''' für eine Achse!',3); + aufraeumen; + exit; + end; + s:=trim(s); + case s[length(s)] of + '+': Achsen[length(Achsen)-1].faktor:=1/2; + '-': Achsen[length(Achsen)-1].faktor:=2; + else Achsen[length(Achsen)-1].faktor:=1; + end{of case}; + if Achsen[length(Achsen)-1].faktor<>1 then delete(s,length(s),1); + Achsen[length(Achsen)-1].Striche:=strtoint(s); + continue; + end; + if pos('Kontur:',s)=1 then begin + delete(s,1,pos(':',s)); + s:=s+' '; + while pos(' ',s)=1 do delete(s,1,1); + while pos(' ',s)>0 do begin + setlength(verwKonturen,length(verwKonturen)+1); + verwKonturen[length(verwKonturen)-1]:=findeKontur(copy(s,1,pos(' ',s)-1),Konturen,false); + if (verwKonturen[length(verwKonturen)-1]<0) or (verwKonturen[length(verwKonturen)-1]>=length(Konturen^)) then begin + gibAus('Die Kontur '''+copy(s,1,pos(' ',s)-1)+''' gibt es nicht!',3); + aufraeumen; + exit; + end; + delete(s,1,pos(' ',s)); + while pos(' ',s)=1 do delete(s,1,1); + end; + continue; + end; + if s='Ende' then break; + gibAus('Verstehe Option '''+s+''' nicht bei Erzeugung eines linearen Bildes!',3); + aufraeumen; + exit; + until false; + + if st then begin + result:=true; + aufraeumen; + exit; + end; + + if _maxW=_minW then begin + gibAus('Zu geringe Dynamik um Dichten auflösen zu können!',3); + aufraeumen; + exit; + end; + xmin:=max(xmin,0); + xmax:=min(xmax,_xsteps-1); + tmin:=max(tmin,0); + tmax:=min(tmax,_tsiz-1); + gibAus('('+inttostr(xmin)+'-'+inttostr(xmax)+'x'+inttostr(tmin)+'-'+inttostr(tmax)+')',3); + gibAus(' ('+floattostr(_xstart)+'-'+floattostr(_xstop)+' x '+floattostr(_tstart)+'-'+floattostr(_tstop)+')',3); + breite:=round((xmax-xmin)*xzoom)+1; + hoehe:=round((tmax-tmin)*yzoom)+1; + + if (breite=1) or (hoehe=1) then begin + gibAus('Keine/kaum Bildpunkte innerhalb der festgelegten Grenzen!',3); + aufraeumen; + exit; + end; + gibAus(inttostr(breite)+' x '+inttostr(hoehe)+' Pixel',3); + + fontRenderer:=tFontRenderer.create(schriftgroesze); + + setlength(Beschriftungen,0); + for i:=0 to length(Achsen)-1 do + begin + if Achsen[i].Lage in [lOben,lUnten] then + begin + maw:=xMax/(_xsteps-1)*(_xstop-_xstart)+_xstart; + miw:=xMin/(_xsteps-1)*(_xstop-_xstart)+_xstart; + end + else + begin + maw:=tMax/(_tsiz-1)*(_tstop-_tstart)+_tstart; + miw:=tMin/(_tsiz-1)*(_tstop-_tstart)+_tstart; + end; + schritt:=(maw-miw)/Achsen[i].Striche; + j:=round(ln(schritt)/ln(10)); + schritt:=Achsen[i].faktor*power(10,j); + wert:=ceil(miw/schritt)*schritt; + while wert<=maw do + begin + setlength(beschriftungen,length(beschriftungen)+1); + beschriftungen[length(beschriftungen)-1]:=tBeschriftung.create; + beschriftungen[length(beschriftungen)-1].bBreite:=Breite; + beschriftungen[length(beschriftungen)-1].bHoehe:=Hoehe; + beschriftungen[length(beschriftungen)-1].Rahmen:=Rahmen; + with beschriftungen[length(beschriftungen)-1] do + begin + fontRend:=fontRenderer; + lage:=Achsen[i].lage; + position:=(wert-miw)/(maw-miw); + if lage in [lOben,lUnten] then position:=position*bBreite + else position:=position*bHoehe; + inhalt:=floattostr(wert); + end; + wert:=wert+schritt; + end; + end; + gibAus(inttostr(length(Beschriftungen))+' Zahlen an den Achsen',3); + lof:=Byte(Rahmen); + rof:=Byte(Rahmen); + oof:=Byte(Rahmen); + uof:=Byte(Rahmen); + for i:=0 to length(beschriftungen)-1 do + with Beschriftungen[i] do + begin + lof:=max(lof,-links); + rof:=max(rof,1+rechts-bBreite); + oof:=max(oof,-oben); + uof:=max(uof,1+unten-bHoehe); + end; + if lof+oof+rof+uof>0 then + gibAus('Extra-Ränder: '+inttostr(lof)+' Pixel links, '+inttostr(oof)+' Pixel oben, '+inttostr(rof)+' Pixel rechts und '+inttostr(uof)+' Pixel unten.',3); + + setlength(Bilderthreads,maxThreads); + for i:=0 to length(Bilderthreads)-1 do + Bilderthreads[i]:=tBilderthread.create(i,length(Bilderthreads),breite,hoehe,lof,oof,rof,uof,self,xmin,xmax,tmin,tmax,xzoom,yzoom,Nachbearbeitung,palette,@Beschriftungen,rahmen); + for i:=0 to length(Bilderthreads)-1 do begin + gibAus('starte Thread '+inttostr(i)+' ...',1); + Bilderthreads[i].suspended:=false; + gibAus('... ok!',1); + end; + repeat + sleep(100); + fertig:=true; + for i:=0 to length(Bilderthreads)-1 do + fertig:=fertig and Bilderthreads[i].fertig; + until fertig; + gibAus('Alle Threads beendet, Konturen einfügen ...',1); + for i:=0 to length(verwKonturen)-1 do + for j:=0 to length(konturen^[verwKonturen[i]].orte)-1 do begin + xp:=round((_xsteps-1)*(konturen^[verwKonturen[i]].orte[j].x-_xstart)/(_xstop-_xstart)); + tp:=round((_tsiz-1) * (konturen^[verwKonturen[i]].orte[j].y-_tstart)/(_tstop-_tstart)); + + if (xmin<=xp) and (xp<=xmax) and (tmin<=tp) and (tp<=tmax) then begin + k:=0; + xp:=xp-xmin; + tp:=tp-tmin; + while (k=Bilderthreads[k+1].xpmi) do + inc(k); + Bilderthreads[k].farben[(tp+oof)*Bilderthreads[k].Breite + xp - Bilderthreads[k].xpmi]:= + konturen^[verwKonturen[i]].farbe; + end; + end; + gibAus('fertig, speichere Bild ...',1); + assign(img,datei); + rewrite(img,1); + schreibeBmpHeader(img,breite+lof+rof,hoehe+oof+uof); + for j:=-oof to uof+hoehe-1 do begin + for i:=0 to length(Bilderthreads)-1 do + blockwrite(img,Bilderthreads[i].farben[(j+oof)*Bilderthreads[i].Breite],3*Bilderthreads[i].Breite); + i:=0; + blockwrite(img,i,(4-(((lof+breite+rof)*3) mod 4)) mod 4); + end; + close(img); + gibAus('... Threads freigeben ...',1); + aufraeumen; + + result:=true; + gibAus('... fertig '+ZeitDarstellen(now-Zeit),3); +end; + +function tWerte.erzeugeAscii(st: boolean; var f: tInputfile): boolean; +var datei,s,separator: string; + outf: textfile; + i,j: longint; + xmin,xmax,tmin,tmax: longint; + Zeit: extended; + mitKoordinaten: byte; +begin + result:=false; + warteaufBeendigungDesLeseThreads; + Zeit:=now; + gibAus('erzeuge Ascii-Datei ...',3); + datei:=''; + xmin:=0; + xmax:=_xsteps-1; + tmin:=0; + tmax:=_tsiz-1; + mitKoordinaten:=0; + separator:=','; + repeat + if not f.gibZeile(s) then begin + gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); + exit; + end; + if pos('Datei:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + datei:=s; + continue; + end; + if pos('xmin:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + xmin:=round((exprtofloat(st,s)-_xstart)*(_xsteps-1)/(_xstop-_xstart)); + continue; + end; + if pos('xmax:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + xmax:=round((exprtofloat(st,s)-_xstart)*(_xsteps-1)/(_xstop-_xstart)); + continue; + end; + if pos('tmin:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + tmin:=round((exprtofloat(st,s)-_tstart)*(_tsiz-1)/(_tstop-_tstart)); + continue; + end; + if pos('tmax:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + tmax:=round((exprtofloat(st,s)-_tstart)*(_tsiz-1)/(_tstop-_tstart)); + continue; + end; + if (s='Koordinaten einfügen') and ((_xsteps=1) or (_tsiz=1)) then begin + mitKoordinaten:=byte(_xsteps=1)*2 + byte(_tsiz=1); + continue; + end; + if pos('Separator:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + if s='Leerzeichen' then begin + Separator:=' '; + continue; + end; + if s='Tab' then begin + Separator:=#9; + continue; + end; + Separator:=s; + continue; + end; + if s='Ende' then break; + gibAus('Verstehe Option '''+s+''' nicht bei Erzeugung einer Ascii-Datei!',3); + exit; + until false; + + if st then begin + result:=true; + exit; + end; + + assign(outf,datei); + rewrite(outf); + case mitKoordinaten of + 0: + case Genauigkeit of + gSingle: + for i:=max(0,tmin) to min(_tsiz-1,tmax) do begin + s:=''; + for j:=max(0,xmin) to min(_xsteps-1,xmax) do + s:=s+floattostr(sWerte.werte[i*_xsteps+j])+separator; + delete(s,length(s),1); + writeln(outf,s); + end; + gExtended: + for i:=max(0,tmin) to min(_tsiz-1,tmax) do begin + s:=''; + for j:=max(0,xmin) to min(_xsteps-1,xmax) do + s:=s+floattostr(eWerte.werte[i*_xsteps+j])+separator; + delete(s,length(s),1); + writeln(outf,s); + end; + end{of Case}; + 1: + case Genauigkeit of + gSingle: + for i:=max(0,xmin) to min(_xsteps-1,xmax) do + writeln(outf,floattostr(i*(_xstop-_xstart)/_xsteps+_xstart)+separator+floattostr(sWerte.werte[i])); + gExtended: + for i:=max(0,xmin) to min(_xsteps-1,xmax) do + writeln(outf,floattostr(i*(_xstop-_xstart)/_xsteps+_xstart)+separator+floattostr(eWerte.werte[i])); + end{of Case}; + 2: + case Genauigkeit of + gSingle: + for i:=max(0,tmin) to min(_tsiz-1,tmax) do + writeln(outf,floattostr(i*(_tstop-_tstart)/_tsiz+_tstart)+separator+floattostr(sWerte.werte[i])); + gExtended: + for i:=max(0,tmin) to min(_tsiz-1,tmax) do + writeln(outf,floattostr(i*(_tstop-_tstart)/_tsiz+_tstart)+separator+floattostr(eWerte.werte[i])); + end{of Case}; + 3: + case Genauigkeit of + gSingle: + writeln(outf,floattostr(_xstart)+separator+floattostr(_tstart)+separator+floattostr(sWerte.werte[0])); + gExtended: + writeln(outf,floattostr(_xstart)+separator+floattostr(_tstart)+separator+floattostr(sWerte.werte[0])); + end{of Case}; + end{of Case}; + close(outf); + gibAus('... fertig '+ZeitDarstellen(now-Zeit),3); + result:=true; +end; + +function tWerte.erzeugeLineout(st: boolean; params: string): boolean; +var ab: array[boolean,boolean] of longint; + s: string; + f: textfile; + Zeit: extended; + i: longint; +begin + result:=false; + warteaufBeendigungDesLeseThreads; + Zeit:=now; + if not st then begin + gibAus('erzeuge Lineout ...',3); + gibAus('insgesamt: '+floattostr(_xstart)+'-'+floattostr(_xstop)+'x'+floattostr(_tstart)+'-'+floattostr(_tstop),3); + end; + + while pos(' ',params)=1 do delete(params,1,1); + if pos('(',params)=1 then begin + delete(params,1,1); + while pos(' ',params)=1 do delete(params,1,1); + s:=copy(params,1,pos(',',params)-1); + while pos(' ',s)>0 do + delete(s,pos(' ',s),1); + ab[false,false]:=max(0,min(_xsteps-1,round((exprtofloat(st,s)-_xstart)/(_xstop-_xstart)*(_xsteps-1)))); + delete(params,1,pos(',',params)); + while pos(' ',params)=1 do delete(params,1,1); + s:=copy(params,1,pos(')',params)-1); + while pos(' ',s)>0 do + delete(s,pos(' ',s),1); + ab[false,true]:=max(0,min(_tsiz-1,round((exprtofloat(st,s)-_tstart)/(_tstop-_tstart)*(_tsiz-1)))); + delete(params,1,pos(')',params)); + while pos(' ',params)=1 do delete(params,1,1); + end + else begin + ab[false,false]:=_xsteps-1; + ab[false,true]:=_tsiz-1; + end; + if pos('(',params)=1 then begin + delete(params,1,1); + while pos(' ',params)=1 do delete(params,1,1); + s:=copy(params,1,pos(',',params)-1); + while pos(' ',s)>0 do + delete(s,pos(' ',s),1); + ab[true,false]:=max(0,min(_xsteps-1,round((exprtofloat(st,s)-_xstart)/(_xstop-_xstart)*(_xsteps-1)))); + delete(params,1,pos(',',params)); + while pos(' ',params)=1 do delete(params,1,1); + s:=copy(params,1,pos(')',params)-1); + while pos(' ',s)>0 do + delete(s,pos(' ',s),1); + ab[true,true]:=max(0,min(_tsiz-1,round((exprtofloat(st,s)-_tstart)/(_tstop-_tstart)*(_tsiz-1)))); + delete(params,1,pos(')',params)); + while pos(' ',params)=1 do delete(params,1,1); + end + else begin + ab[true,false]:=ab[false,false]; + ab[true,true]:=ab[false,true]; + ab[false,false]:=0; + ab[false,true]:=0; + end; + + if st then begin + result:=true; + exit; + end; + + s:='... schreibe in '''+params+''' ('; + for i:=0 to 3 do begin + s:=s+inttostr(ab[odd(i div 2),odd(i)]); + if not odd(i) then s:=s+',' + else if i=1 then s:=s+')--('; + end; + gibAus(s+') ...',3); + + assignFile(f,params); + rewrite(f); + if abs(ab[true,true]-ab[false,true])>abs(ab[true,false]-ab[false,false]) then begin + if ab[true,true]>ab[false,true] then begin + for i:=ab[false,true] to ab[true,true] do + schreibeWert(f,round(ab[false,false]+i/(ab[true,true]-ab[false,true])*(ab[true,false]-ab[false,false])),i); + end + else + for i:=ab[false,true] downto ab[true,true] do + schreibeWert(f,round(ab[false,false]+i/(ab[true,true]-ab[false,true])*(ab[true,false]-ab[false,false])),i); + end + else begin + if ab[true,false]>ab[false,false] then begin + for i:=ab[false,false] to ab[true,false] do + schreibeWert(f,i,round(ab[false,true]+i/(ab[true,false]-ab[false,false])*(ab[true,true]-ab[false,true]))); + end + else + for i:=ab[false,false] downto ab[true,false] do + schreibeWert(f,i,round(ab[false,true]+i/(ab[true,false]-ab[false,false])*(ab[true,true]-ab[false,true]))); + end; + closefile(f); + gibAus('... fertig '+ZeitDarstellen(now-Zeit),3); + result:=true; +end; + +procedure tWerte.schreibeWert(var f: textfile; x,y: longint); +begin + case Genauigkeit of + gSingle: sWerte.schreibeWert(f,x,y); + gExtended: eWerte.schreibeWert(f,x,y); + end{of Case}; +end; + +procedure tWerte.spiegle(threads: longint); +begin + spiegle(threads,0,_tsiz-1); +end; + +procedure tWerte.spiegle(threads,tmin,tmax: longint); +var i: longint; + sts: array of tSpiegelthread; + fertig: boolean; +begin + warteaufBeendigungDesLeseThreads; + setlength(sts,threads); + for i:=0 to length(sts)-1 do + sts[i]:=tSpiegelthread.create( + tmin+round(i*(tmax+1-tmin)/length(sts)), + tmin+round((i+1)*(tmax+1-tmin)/length(sts))-1, + self); + repeat + sleep(100); + fertig:=true; + for i:=0 to length(sts)-1 do + fertig:=fertig and sts[i].fertig; + until fertig; + for i:=0 to length(sts)-1 do + sts[i].free; + gibAus('Alle Spiegelthreads fertig!',1); +end; + +procedure tWerte.fft2dNachbearbeitung(threads: longint; nb: tFFTDatenordnung); +var i: longint; + FNTs: array of tFFT2dNBThread; + fertig: boolean; +begin // bearbeitet nur den Hauptteil (außer erster und mittlerer Zeile/Spalte) nach! + setlength(FNTs,threads); + for i:=0 to length(FNTs)-1 do + FNTs[i]:=TFFT2dNBThread.create( + round(i*(_xsteps div 2 -1)/length(FNTs))+1, + round((i+1)*(_xsteps div 2 -1)/length(FNTs)), + self, + nb); + repeat + sleep(100); + fertig:=true; + for i:=0 to length(FNTs)-1 do + fertig:=fertig and FNTs[i].fertig; + until fertig; + for i:=0 to length(FNTs)-1 do + FNTs[i].free; + gibAus('Alle FFT2dNBThreads fertig!',1); +end; + +function tWerte.callBackGetValue(s: string): extended; +var i: longint; +begin + result:=nan; + if (pos('Kontur[',s)=1) or (pos('Konturen[',s)=1) then begin + delete(s,1,pos('[',s)); + if pos('].',s)=0 then begin + gibAus('Syntaxfehler, '']'' fehlt!',3); + exit; + end; + i:=findeKontur(copy(s,1,pos('].',s)-1),Konturen,false); + if i<0 then begin + gibAus('Finde Kontur '''+copy(s,1,pos('].',s)-1)+''' nicht!',3); + exit; + end; + delete(s,1,pos('].',s)+1); + if s='xmin' then result:=Konturen^[i].xmin + else if s='xmax' then result:=Konturen^[i].xmax + else if s='tmin' then result:=Konturen^[i].tmin + else if s='tmax' then result:=Konturen^[i].tmax + else if s='Breite' then result:=Konturen^[i].xmax-Konturen^[i].xmin + else if s='Hoehe' then result:=Konturen^[i].tmax-Konturen^[i].tmin + else gibAus('Kenne Bezeichner '''+s+''' nicht als Eigenschaft einer Kontur!',3); + exit; + end; + gibAus('Ich kenne den Bezeichner '''+s+''' nicht!',3); +end; + +function tWerte.exprtofloat(st: boolean; s: string): extended; +begin + case genauigkeit of + gSingle: result:=sWerte.exprtofloat(st,s,@callBackGetValue); + gExtended: result:=eWerte.exprtofloat(st,s,@callBackGetValue); + end; +end; + +function tWerte.paramsdump: string; +begin + result:=bezeichner+' '+inttostr(integer(genauigkeit))+' '+inttostr(_xsteps)+' '+inttostr(_tsiz) + +' '+floattostr(sWerte.params^.xstart)+'-'+floattostr(sWerte.params^.xstop) + +'x'+floattostr(sWerte.params^.tstart)+'-'+floattostr(sWerte.params^.tstop); + if sWerte.params<>eWerte.params then result:='!! '+result; +end; + +procedure tWerte.beendeLeseThreadWennFertig; +begin + if assigned(leseThread) and leseThread.fertig then begin + leseThread.free; + leseThread:=nil; + end; +end; + +// tLogThread ****************************************************************** + +constructor tLogThread.create; +begin + inherited create(true); + freeonterminate:=false; + fertig:=false; +end; + +destructor tLogThread.destroy; +begin + if not behalteLogs then cleanupLog(ThreadID); + inherited destroy; +end; + +procedure tLogThread.execute; +begin + try + stExecute; + except + on E: Exception do begin + DumpExceptionCallStack(E); + halt(1); + end; + end; + fertig:=true; +end; + +// tLiKoThread ***************************************************************** + +constructor tLiKoThread.create(lk: pTLiKo; ws: pTWerteArray; pWerte: tWerte; xMin,xMax,tMin,tMax,xOff,tOff: longint); +begin + inherited create; + liKo:=lk; + wertes:=ws; + pW:=pWerte; + xMi:=xMin; + xMa:=xMax; + tMi:=tMin; + tMa:=tMax; + tOf:=tOff; + xOf:=xOff; + gibAus('Starte LiKo-Berechnungsthread!',1); + suspended:=false; +end; + +procedure tLiKoThread.stExecute; +var i,j,k: longint; + out0,in0: boolean; +begin + gibAus('LiKo-Berechnungsthread gestartet ('+inttostr(xmi)+'-'+inttostr(xma)+'x'+inttostr(tmi)+'-'+inttostr(tma)+') ...',1); + for i:=0 to length(liKo^)-1 do + gibAus(liko^[i].werte.bezeichner+' * '+floattostr(liko^[i].alpha),1); + out0:=true; + in0:=true; + case liKo^[0].werte.Genauigkeit of //<> + gSingle: + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('LiKo-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do begin + pW.eWerte.werte[i+j*pW._xsteps]:=0; + for k:=0 to length(liKo^)-1 do begin + pW.eWerte.werte[i+j*pW._xsteps]:= + pW.eWerte.werte[i+j*pW._xsteps] + + liKo^[k].alpha*liKo^[k].werte.sWerte.werte[(xOf+i) + (tOf+j)*liKo^[k].werte._xsteps]; + in0:=in0 and (liKo^[k].werte.sWerte.werte[(xOf+i) + (tOf+j)*liKo^[k].werte._xsteps]=0); + end; + out0:=out0 and (pW.eWerte.werte[i+j*pW._xsteps]=0); + end; + end; + gExtended: + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('LiKo-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do begin + pW.eWerte.werte[i+j*pW._xsteps]:=0; + for k:=0 to length(liKo^)-1 do begin + pW.eWerte.werte[i+j*pW._xsteps]:= + pW.eWerte.werte[i+j*pW._xsteps] + + liKo^[k].alpha*liKo^[k].werte.eWerte.werte[(xOf+i) + (tOf+j)*liKo^[k].werte._xsteps]; + in0:=in0 and (liKo^[k].werte.eWerte.werte[(xOf+i) + (tOf+j)*liKo^[k].werte._xsteps]=0); + end; + out0:=out0 and (pW.eWerte.werte[i+j*pW._xsteps]=0); + end; + end; + end{of Case}; + if in0 then gibAus('Nur Nullen im Input!',1); + if out0 then gibAus('Nur Nullen im Output!',1); + gibAus('... und fertig!',1); + fertig:=true; +end; + +// tQuotientThread ************************************************************* + +constructor tQuotientThread.create(dividend, divisor, quotient: tWerte; epsilon: extended; xMin,xMax,tMin,tMax,xOff,tOff: longint); +begin + inherited create; + dend:=dividend; + sor:=divisor; + quot:=quotient; + eps:=epsilon; + xMi:=xMin; + xMa:=xMax; + tMi:=tMin; + tMa:=tMax; + tOf:=tOff; + xOf:=xOff; + gibAus('Starte Quotient-Berechnungsthread!',1); + suspended:=false; +end; + +procedure tQuotientThread.stExecute; +var i,j: longint; + i0,o0: boolean; +begin + gibAus('Quotient-Berechnungsthread gestartet ...',1); + i0:=true; + o0:=true; + case 2*byte(sor.Genauigkeit)+byte(dend.Genauigkeit) of + 0: // single / single + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Quotient-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do + if abs(sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]) Bild ...',1); + for j:=-oof to whoehe-1+uof do begin gibAus(inttostr(j)+' / '+inttostr(-oof)+' - '+inttostr(whoehe-1+uof),1); + for i:=xpmi to xpma do + if (j>=0) and (j=0) and (i=-1) and (j<=whoehe))) and // links + (not ((i=gesBreite) and (j>=-1) and (j<=whoehe))) and // rechts + (not ((j=-1) and (i>=-1) and (i<=gesBreite))) and // oben + (not ((j=whoehe) and (i>=-1) and (i<=gesBreite))))); // unten + gibAus('b',1); + farben[i-xpmi+(j+oof)*breite].rgbGreen:=farben[i-xpmi+(j+oof)*breite].rgbRed; + gibAus('c',1); + farben[i-xpmi+(j+oof)*breite].rgbBlue:=farben[i-xpmi+(j+oof)*breite].rgbRed; + gibAus('d',1); + end; + end; + + gibAus('Thread '+inttostr(nummer)+': Beschriftung einfügen ...',1); + + for i:=0 to length(Beschr^)-1 do begin + for j:=max(Beschr^[i].links,xpmi) to min(Beschr^[i].rechts,xpma) do + for k:=Beschr^[i].oben to Beschr^[i].unten do + farben[j-xpmi+(k+oof)*breite]:= + andFarben( + farben[j-xpmi+(k+oof)*breite], + Beschr^[i].bild.farben[j-Beschr^[i].links + (k-Beschr^[i].oben)*Beschr^[i].bild.breite]); + case Beschr^[i].lage of + lRechts: + for j:=max(Beschr^[i].bBreite,xpmi) to min(Beschr^[i].bBreite+3+byte(Rahmen),xpma) do begin + farben[j-xpmi+(Beschr^[i].strich+oof)*breite].rgbRed:=$00; + farben[j-xpmi+(Beschr^[i].strich+oof)*breite].rgbGreen:=$00; + farben[j-xpmi+(Beschr^[i].strich+oof)*breite].rgbBlue:=$00; + end; + lLinks: + for j:=max(-4-byte(Rahmen),xpmi) to min(-1,xpma) do begin + farben[j-xpmi+(Beschr^[i].strich+oof)*breite].rgbRed:=$00; + farben[j-xpmi+(Beschr^[i].strich+oof)*breite].rgbGreen:=$00; + farben[j-xpmi+(Beschr^[i].strich+oof)*breite].rgbBlue:=$00; + end; + lOben: + if (Beschr^[i].strich>=xpmi) and (Beschr^[i].strich<=xpma) then + for j:=Beschr^[i].bHoehe to Beschr^[i].bHoehe+3+byte(Rahmen) do begin + farben[Beschr^[i].strich-xpmi+(j+oof)*breite].rgbRed:=$00; + farben[Beschr^[i].strich-xpmi+(j+oof)*breite].rgbGreen:=$00; + farben[Beschr^[i].strich-xpmi+(j+oof)*breite].rgbBlue:=$00; + end; + lUnten: + if (Beschr^[i].strich>=xpmi) and (Beschr^[i].strich<=xpma) then + for j:=-4-byte(Rahmen) to -1 do begin + farben[Beschr^[i].strich-xpmi+(j+oof)*breite].rgbRed:=$00; + farben[Beschr^[i].strich-xpmi+(j+oof)*breite].rgbGreen:=$00; + farben[Beschr^[i].strich-xpmi+(j+oof)*breite].rgbBlue:=$00; + end; + end{of case}; + end; + + if length(werte)>0 then begin + b:=false; + for i:=0 to length(werte)-1 do + b:=b or (werte[i]<>0); + wert:=werte[0]; + for i:=0 to length(werte)-1 do + wert:=max(wert,werte[i]); + gibAus('Thread '+inttostr(nummer)+' hat max. '+myfloattostr(wert),1); + for i:=0 to length(werte)-1 do + wert:=min(wert,werte[i]); + gibAus('Thread '+inttostr(nummer)+' hat min. '+myfloattostr(wert),1); + if not b then + gibAus('Thread '+inttostr(nummer)+' hat nur Nullen!',1); + end; + gibAus('Thread '+inttostr(nummer)+' fertig!',1); + fertig:=true; +end; + +destructor tBilderthread.destroy; +begin + setlength(farben,0); + setlength(werte,0); + setlength(anzahlen,0); + inherited destroy; +end; + +// tDichteThread *************************************************************** + +constructor tDichteThread.create(xmi,xma,tmi,tma: longint; const werte: tWerte); +begin + inherited create; + xmin:=xmi; + xmax:=xma; + tmin:=tmi; + tmax:=tma; + w:=werte; + maxdichte:=0; + gibAus('Dichtethread kreiert: '+inttostr(xmin)+'-'+inttostr(xmax)+' '+inttostr(tmin)+'-'+inttostr(tmax),1); + suspended:=false; +end; + +procedure tDichteThread.stExecute; +begin + gibAus('Dichtethread gestartet!',1); + case w.Genauigkeit of + gSingle: w.sWerte.gibMinMaxDichten(minDichte,maxDichte,xmin,xmax,tmin,tmax); + gExtended: w.eWerte.gibMinMaxDichten(minDichte,maxDichte,xmin,xmax,tmin,tmax); + end{of case}; + gibAus('Dichtethread fertig!',1); + fertig:=true; +end; + +// tFFTThread ****************************************************************** + +constructor tFFTThread.create(werte: tWerte; xMin,xMax,tMin,tMax: longint; senkrecht,invers: boolean; const vor,nach: tFFTDatenordnung; const fenster: tFenster); +begin + inherited create; + pW:=werte; + xMi:=xMin; + xMa:=xMax; + tMi:=tMin; + tMa:=tMax; + sen:=senkrecht; + inv:=invers; + vo:=vor; + na:=nach; + fen:=fenster; + erfolg:=false; + gibAus('FFTthread kreiert: '+inttostr(xmin)+'-'+inttostr(xmax)+' '+inttostr(tmin)+'-'+inttostr(tmax),1); + suspended:=false; +end; + +procedure tFFTThread.stExecute; +begin + gibAus('FFTthread gestartet: '+inttostr(xMi)+'-'+inttostr(xMa)+' '+inttostr(tMi)+'-'+inttostr(tMa)+' ...',1); + case pW.Genauigkeit of + gSingle: erfolg:=pW.sWerte.fft(xMi,xMa,tMi,tMa,sen,inv,vo,na,fen,pvFehler); + gExtended: erfolg:=pW.eWerte.fft(xMi,xMa,tMi,tMa,sen,inv,vo,na,fen,pvFehler); + end{of case}; + gibAus('... und fertig! ',1); + fertig:=true; +end; + +// tSpiegelThread ************************************************************** + +constructor tSpiegelThread.create(tmi,tma: longint; pWerte: tWerte); +begin + inherited create; + tmin:=tmi; + tmax:=tma; + pW:=pWerte;; + gibAus('Spiegelthread kreiert: '+inttostr(tmin)+'-'+inttostr(tmax),1); + suspended:=false; +end; + +procedure tSpiegelThread.stExecute; +begin + gibAus('Spiegelthread gestartet: '+inttostr(tMin)+'-'+inttostr(tMax)+' ...',1); + case pW.Genauigkeit of + gSingle: pW.sWerte.spiegle(tMin,tMax); + gExtended: pW.eWerte.spiegle(tMin,tMax); + end{of case}; + gibAus('... und fertig!',1); + fertig:=true; +end; + +// tFFT2dNBThread ************************************************************** + +constructor tFFT2dNBThread.create(xmi,xma: longint; pWerte: tWerte; endordnung: tFFTDatenordnung); +begin + inherited create; + xmin:=xmi; + xmax:=xma; + pW:=pWerte; + nb:=endordnung; + gibAus('FFT2d-Nachbearbeitungsthread kreiert: '+inttostr(xmin)+'-'+inttostr(xmax),1); + suspended:=false; +end; + +procedure tFFT2dNBThread.stExecute; +begin + gibAus('FFT2d-Nachbearbeitungsthread gestartet: '+inttostr(xMin)+'-'+inttostr(xMax)+' ...',1); + case pW.Genauigkeit of + gSingle: pW.sWerte.fft2dNachbearbeitungB(xMin,xMax,nb); + gExtended: pW.eWerte.fft2dNachbearbeitungB(xMin,xMax,nb); + end{of case}; + gibAus('... und fertig!',1); + fertig:=true; +end; + +// tKorrelThread *************************************************************** + +constructor tKorrelThread.create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax,xOff,tOff: longint; wavelet: tWavelet); +begin + inherited create; + qu:=quelle; + zi:=ziel; + xMi:=xMin; + xMa:=xMax; + tMi:=tMin; + tMa:=tMax; + tOf:=tOff; + xOf:=xOff; + wl:=wavelet; + gibAus('Korrelationsthread kreiert: '+inttostr(xmin)+'-'+inttostr(xmax)+' '+inttostr(tmin)+'-'+inttostr(tmax),1); + suspended:=false; +end; + +procedure tKorrelThread.stExecute; +var i,j,k,hl: longint; + sus,suc,tmp,pvF: extended; + in0,out0: boolean; + fenster: tFenster; + tmpW: tWerte; +begin + gibAus('Korrelationsberechnungsthread gestartet ...',1); + gibAus('('+inttostr(xmi)+'-'+inttostr(xma)+' x '+inttostr(tmi)+'-'+inttostr(tma)+'), '+inttostr(wl.werte.params^.tsiz),1); + in0:=true; + out0:=true; + pvFehler:=0; + if wl.mitFFT then begin + tma:=tma-tmi; // wenn FFT, dann wurde das schon außerhalb von "kopiereVon" geändert + tmi:=0; + for i:=xmi to xma do + for j:=tmi to tma do in0:=in0 and (zi.eWerte.werte[i+j*zi._xsteps]=0); + fenster.aktiv:=false; +// fenster.Breite:=0; +// fenster.berechneWerte(tma+1-tmi); + gibAus('FFT berechnen ...',1); + zi.eWerte.fft(xmi,xma,tmi,tma,true,false,doRes,doResIms,fenster,pvF); + pvFehler:=pvF+pvFehler; + if wl.typ=wtSin2 then // Das Sin²-Wavelet besteht eigntlich aus zwei! + tmpW:=tWerte.create(zi,xmi,xma); + gibAus('... fertig, punktweise Produkte berechnen ...',1); + hl:=(tma+1-tmi) div 2; // halbe Länge + for i:=xmi to xma do begin + zi.eWerte.werte[i]:=zi.eWerte.werte[i]*wl.werte.werte[0]; // f_0 + zi.eWerte.werte[i+hl*zi._xsteps]:=zi.eWerte.werte[i+hl*zi._xsteps]*wl.werte.werte[2*hl]; // f_n/2 + if wl.typ=wtSin2 then begin // Das Sin²-Wavelet besteht eigntlich aus zwei! + // und das gleiche für tmpW statt zi^: + tmpW.eWerte.werte[i-xmi]:=tmpW.eWerte.werte[i-xmi]*wl.werte.werte[1]; // f_0 + tmpW.eWerte.werte[i-xmi+hl*tmpW._xsteps]:=tmpW.eWerte.werte[i-xmi+hl*tmpW._xsteps]*wl.werte.werte[2*hl+1]; // f_n/2 + end; + for j:=1 to hl-1 do begin + tmp:=zi.eWerte.werte[i+j*zi._xsteps]; // Re_j + zi.eWerte.werte[i+j*zi._xsteps]:=tmp*wl.werte.werte[2*j]-zi.eWerte.werte[i+(j+hl)*zi._xsteps]*wl.werte.werte[2*(j+hl)]; + // Re_j * wRe_j - Im_j * wIm_j + zi.eWerte.werte[i+(j+hl)*zi._xsteps]:=tmp*wl.werte.werte[2*(j+hl)]+zi.eWerte.werte[i+(j+hl)*zi._xsteps]*wl.werte.werte[2*j]; + // Re_j * wIm_j + Im_j * wRe_j + if wl.typ=wtSin2 then begin // Das Sin²-Wavelet besteht eigntlich aus zwei! + // und das gleiche für tmpW statt zi^: + tmp:=tmpW.eWerte.werte[i-xmi+j*tmpW._xsteps]; // Re_j + tmpW.eWerte.werte[i-xmi+j*tmpW._xsteps]:=tmp*wl.werte.werte[2*j+1]-tmpW.eWerte.werte[i-xmi+(j+hl)*tmpW._xsteps]*wl.werte.werte[2*(j+hl)+1]; + // Re_j * wRe_j - Im_j * wIm_j + tmpW.eWerte.werte[i-xmi+(j+hl)*tmpW._xsteps]:=tmp*wl.werte.werte[2*(j+hl)+1]+tmpW.eWerte.werte[i-xmi+(j+hl)*tmpW._xsteps]*wl.werte.werte[2*j+1]; + // Re_j * wIm_j + Im_j * wRe_j + end; + end; + end; + gibAus('... fertig, iFFT berechnen ...',1); + zi.eWerte.fft(xmi,xma,0,tma-tmi,true,true,doResIms,doBetrQdr,fenster,pvF); + pvFehler:=pvF+pvFehler; + case wl.typ of + wtSin2: begin // Das Sin²-Wavelet besteht eigntlich aus zwei! + tmpW.eWerte.fft(0,xma-xmi,0,tma-tmi,true,true,doResIms,doBetrQdr,fenster,pvF); + pvFehler:=(pvF+pvFehler)/3; + for i:=xmi to xma do + for j:=0 to tma-tmi do begin + zi.eWerte.werte[i+j*zi._xsteps]:=zi.eWerte.werte[i+j*zi._xsteps]+tmpW.eWerte.werte[i-xmi+j*tmpW._xsteps]; + out0:=out0 and (zi.eWerte.werte[i+j*zi._xsteps]=0); + end; + tmpW.free; + end; + wtFrequenzfenster: begin // Das Frequenzfenster-Wavelet ist nur eines! + pvFehler:=pvFehler/2; + for i:=xmi to xma do + for j:=0 to tma-tmi do + out0:=out0 and (zi.eWerte.werte[i+j*zi._xsteps]=0); + end; + end{of case}; + gibAus(' (Parseval-Fehler = '+floattostr(pvFehler)+')',1); + gibAus('... fertig',1); + end + else begin + case qu.Genauigkeit of + gExtended: + for i:=xmi to xma do begin + if (xma-i) mod ((xma-xmi) div 10) = 0 then gibAus(inttostr(i)+'/'+inttostr(xmi)+'-'+inttostr(xma),1); + for j:=tmi to tma do begin + sus:=0; + suc:=0; + for k:=max(-wl.hlen,-tOf-j) to min(wl.hlen,qu._tsiz-j-tOf-1) do begin + suc:=suc + qu.eWerte.werte[i+xOf+(j+k+tOf)*qu._xsteps]*wl.werte.werte[(k+wl.hlen)*2]; + sus:=sus + qu.eWerte.werte[i+xOf+(j+k+tOf)*qu._xsteps]*wl.werte.werte[(k+wl.hlen)*2+1]; + end; + zi.eWerte.werte[i+j*zi._xsteps]:=(sqr(sus)+sqr(suc))/sqr(1+2*wl.hlen); + in0:=in0 and (qu.eWerte.werte[i+xOf+(j+tOf)*qu._xsteps]=0); + out0:=out0 and (zi.eWerte.werte[i+j*zi._xsteps]=0); + end; + end; + gSingle: + for i:=xmi to xma do begin + if (xma-i) mod ((xma-xmi) div 10) = 0 then gibAus(inttostr(i)+'/'+inttostr(xmi)+'-'+inttostr(xma),1); + for j:=tmi to tma do begin + sus:=0; + suc:=0; + for k:=max(-wl.hlen,-tOf-j) to min(wl.hlen,qu._tsiz-j-tOf-1) do begin + suc:=suc + qu.sWerte.werte[i+xOf+(j+k+tOf)*qu._xsteps]*wl.werte.werte[(k+wl.hlen)*2]; + sus:=sus + qu.sWerte.werte[i+xOf+(j+k+tOf)*qu._xsteps]*wl.werte.werte[(k+wl.hlen)*2+1]; + end; + zi.eWerte.werte[i+j*zi._xsteps]:=(sqr(sus)+sqr(suc))/sqr(1+2*wl.hlen); + in0:=in0 and (qu.sWerte.werte[i+xOf+(j+tOf)*qu._xsteps]=0); + out0:=out0 and (zi.eWerte.werte[i+j*zi._xsteps]=0); + end; + end; + end{of case}; + end; + if in0 then gibAus('Nur Nullen im Input der Korrelation!',1); + if out0 then gibAus('Nur Nullen im Output der Korrelation!',1); + gibAus('... und fertig!',1); + fertig:=true; +end; + +// tKontur ********************************************************************* + +constructor tKontur.create; +begin + inherited create; + farbe.rgbRed:=$00; + farbe.rgbGreen:=$00; + farbe.rgbBlue:=$00; + setlength(orte,0); + bezeichner:=''; +end; + +destructor tKontur.destroy; +begin + setlength(orte,0); + inherited destroy; +end; + +function tKontur.rxmin: extended; +var i: longint; +begin + if length(orte)=0 then begin + result:=nan; + exit; + end; + result:=orte[0].x; + for i:=1 to length(orte)-1 do + result:=min(result,orte[i].x); +end; + +function tKontur.rxmax: extended; +var i: longint; +begin + if length(orte)=0 then begin + result:=nan; + exit; + end; + result:=orte[0].x; + for i:=1 to length(orte)-1 do + result:=max(result,orte[i].x); +end; + +function tKontur.rtmin: extended; +var i: longint; +begin + if length(orte)=0 then begin + result:=nan; + exit; + end; + result:=orte[0].y; + for i:=1 to length(orte)-1 do + result:=min(result,orte[i].y); +end; + +function tKontur.rtmax: extended; +var i: longint; +begin + if length(orte)=0 then begin + result:=nan; + exit; + end; + result:=orte[0].y; + for i:=1 to length(orte)-1 do + result:=max(result,orte[i].y); +end; + +function tKontur.init(st: boolean; var f: tInputfile; w: pTWerteArray; mt: longint): boolean; +var s,xmi,xma,tmi,tma: string; + i,j,k,tmpi: longint; +begin + result:=false; + gibAus('Kontur erzeugen ...',1); + xmi:='-1e9'; + xma:='1e9'; + tmi:='-1e9'; + tma:='1e9'; + repeat + if not f.gibZeile(s) then begin + gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); + exit; + end; + if pos('Farbe:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + if length(s)=6 then begin + tmpi:=0; + for i:=1 to 6 do + tmpi:= + (tmpi shl 4) or + (ord(s[i])-ord('0') + - byte(s[i] in ['a'..'f'])*(ord('a')-ord('0')-10) + - byte(s[i] in ['A'..'F'])*(ord('A')-ord('0')-10)); + end + else + tmpi:=strtoint(copy(s,1,pos(' ',s)-1)); + farbe.rgbRed:= (tmpi and $ff0000) shr 16; + farbe.rgbGreen:=(tmpi and $ff00) shr 8; + farbe.rgbBlue:= tmpi and $ff; + continue; + end; + if pos('Datei:',s)=1 then begin + if length(orte)>0 then begin + gibAus('Diese Kontur hat schon Werte!',3); + exit; + end; + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + if not liesVonDatei(st,s,strtofloat(xmi),strtofloat(xma),strtofloat(tmi),strtofloat(tma)) then exit; + continue; + end; + if pos('Werte:',s)=1 then begin + if length(orte)>0 then begin + gibAus('Diese Kontur hat schon Werte!',3); + exit; + end; + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + if not erzeugeAusWerten(st,s,w,mt,xmi,xma,tmi,tma) then exit; + continue; + end; + if pos('Name:',s)=1 then begin + delete(s,1,pos(':',s)); + bezeichner:=trim(s); + continue; + end; + if pos('xmin:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + xmi:=s; + continue; + end; + if pos('xmax:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + xma:=s; + continue; + end; + if pos('tmin:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + tmi:=s; + continue; + end; + if pos('tmax:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + tma:=s; + continue; + end; + if pos('reduziere nach ',s)=1 then begin + delete(s,1,pos(' ',s)); + delete(s,1,pos(' ',s)); + if not st then + if not sortiere_nach_y(mt) then exit; + if s='rechts' then begin + i:=0; + j:=0; + while jOrte[k].x then + k:=j; + inc(j); + end; + Orte[i]:=Orte[k]; + inc(i); + end; + setlength(Orte,i); + continue; + end; + if s='links' then begin + i:=0; + j:=0; + while j0 then delete(s,pos('#',s),length(s)); + while (length(s)>0) and (s[1]=' ') do + delete(s,1,1); + if s='' then continue; + tmp.y:=strtofloat(copy(s,1,pos(' ',s)-1)); + delete(s,1,pos(' ',s)); + while (length(s)>0) and (s[1]=' ') do + delete(s,1,1); + tmp.x:=strtofloat(copy(s,1,pos(' ',s+' ')-1)); + if (tmp.xxma) or (tmp.ytma) then continue; + if i>=length(orte) then + setlength(orte,length(orte)+Speicherhappen); + orte[i]:=tmp; + inc(i); + end; + closefile(tf); + setlength(orte,i); + result:=true; +end; + +function tKontur.erzeugeAusWerten(st: boolean; s: string; w: pTWerteArray; mt: longint; _xmin,_xmax,_tmin,_tmax: string): boolean; +var i,j,k,l,xmi,xma,tmi,tma: longint; + Schwelle: extended; + fertig: boolean; + Konturthreads: array of tKonturAusWertenThread; +begin + result:=false; + i:=findeWerte(copy(s,1,pos(' ',s)-1),w,nil,false); + if i<0 then exit; + delete(s,1,pos(' ',s)); + while pos(' ',s)=1 do delete(s,1,1); + Schwelle:=w^[i].exprtofloat(false,s); + if _xmin='' then xmi:=1 + else xmi:=max(1,min(w^[i]._xsteps-1,round((w^[i].exprtofloat(st,_xmin)-w^[i]._xstart)*(w^[i]._xsteps-1)/(w^[i]._xstop-w^[i]._xstart)))); + if _xmax='' then xma:=w^[i]._xsteps-1 + else xma:=max(1,min(w^[i]._xsteps-1,round((w^[i].exprtofloat(st,_xmax)-w^[i]._xstart)*(w^[i]._xsteps-1)/(w^[i]._xstop-w^[i]._xstart)))); + if _tmin='' then tmi:=1 + else tmi:=max(1,min(w^[i]._tsiz-1,round((w^[i].exprtofloat(st,_tmin)-w^[i]._tstart)*(w^[i]._tsiz-1)/(w^[i]._tstop-w^[i]._tstart)))); + if _tmax='' then tma:=w^[i]._tsiz-1 + else tma:=max(1,min(w^[i]._tsiz-1,round((w^[i].exprtofloat(st,_tmax)-w^[i]._tstart)*(w^[i]._tsiz-1)/(w^[i]._tstop-w^[i]._tstart)))); + if st then begin + result:=true; + exit; + end; + setlength(Konturthreads,mt); + for j:=0 to length(Konturthreads)-1 do + Konturthreads[j]:= + tKonturAusWertenThread.create( + w^[i], + Schwelle, + round(j/length(Konturthreads)*(xma+1-xmi)+xmi), + round((j+1)/length(Konturthreads)*(xma+1-xmi)+xmi-1), + tmi, + tma); + repeat + fertig:=true; + for j:=0 to length(Konturthreads)-1 do + fertig:=fertig and Konturthreads[j].fertig; + if not fertig then sleep(100); + until fertig; + k:=0; + for j:=0 to length(Konturthreads)-1 do + k:=k+length(Konturthreads[j].punkte); + setlength(orte,k); + k:=0; + for j:=0 to length(Konturthreads)-1 do begin + for l:=0 to length(Konturthreads[j].punkte)-1 do + orte[k+l]:=Konturthreads[j].punkte[l]; + k:=k+length(Konturthreads[j].punkte); + Konturthreads[j].Free; + end; + result:=true; +end; + +function tKontur.sortiere_nach_y(mt: longint): boolean; +begin + result:=sortiere_nach_y(mt,0,length(Orte)-1); +end; + +function tKontur.sortiere_nach_y(mt,von,bis: longint): boolean; +var i,j: longint; + avg: extended; + tmp: tExtPoint; + st1,st2: tSortiereNachYThread; +begin + result:=false; + if von>=bis then begin + result:=true; + exit; + end; + avg:=0; + for i:=von to bis do + avg:=avg+Orte[i].y; + avg:=avg/(bis-von+1); + i:=von; + j:=bis; + + while i=avg) do + dec(j); + if ij+1 then begin + gibAus(' interner Quicksort-Fehler: "quicksort-sanity-check nicht bestanden! (i='+inttostr(i)+' & j='+inttostr(j)+')"',1); + exit; + end; + if (jbis) then begin + for i:=von+1 to bis do + if Orte[i].y <> Orte[von].y then begin + gibAus(' interner Quicksort-Fehler: "komisch, die Orte sind doch unterschiedlich ..."',1); + halt; + end; + result:=true; + exit; + end; + + if mt<=1 then + result:=sortiere_nach_y(mt,von,i-1) and sortiere_nach_y(mt,i,bis) + else begin + j:=min(max(1,round(mt/(bis+1-von)*(i-von))),mt-1); + st1:=tSortiereNachYThread.create(self,j,von,i-1); + st2:=tSortiereNachYThread.create(self,mt-j,i,bis); + repeat + sleep(100); + until st1.fertig and st2.fertig; + result:=st1.erfolg and st2.erfolg; + st1.free; + st2.free; + end; +end; + +// tKonturAusWertenThread ****************************************************** + +constructor tKonturAusWertenThread.create(werte: tWerte; schwelle: extended; xmin, xmax, tmin, tmax: longint); +begin + inherited create; + w:=werte; + s:=schwelle; + xmi:=xmin; + xma:=xmax; + tmi:=tmin; + tma:=tmax; + setlength(punkte,0); + suspended:=false; +end; + +destructor tKonturAusWertenThread.destroy; +begin + setlength(punkte,0); + inherited destroy; +end; + +procedure tKonturAusWertenThread.stExecute; +begin + case w.Genauigkeit of + gSingle: punkte:=w.sWerte.findeSchwellwerte(xmi,xma,tmi,tma,s); + gExtended: punkte:=w.eWerte.findeSchwellwerte(xmi,xma,tmi,tma,s); + end{of case}; + fertig:=true; +end; + +// tIntegralThread ************************************************************* + +constructor tIntegralThread.create(quelle, ziel: tWerte; xmin, xmax, tmin, tmax, xoff, toff: longint; richtung: tIntegrationsRichtung); +begin + inherited create; + qu:=quelle; + zi:=ziel; + xmi:=xmin; + xma:=xmax; + tmi:=tmin; + tma:=tmax; + xof:=xoff; + tof:=toff; + rtg:=richtung; + gibAus('Integralthread kreiert',1); + suspended:=false; +end; + +procedure tIntegralThread.stExecute; +begin + gibAus('Integralthread gestartet ('+inttostr(xmi)+'-'+inttostr(xma)+'x'+inttostr(tmi)+'-'+inttostr(tma)+') '+ + '('+inttostr(qu._xsteps)+'x'+inttostr(qu._tsiz)+') -> '+ + '('+inttostr(zi._xsteps)+'x'+inttostr(zi._tsiz)+') delta: '+ + inttostr(xof)+'x'+inttostr(tof)+' ...',1); + case rtg of + irHorizontal: gibAus(' (horizontal)',1); + irEinfall: gibAus(' (einfallend)',1); + irAusfall: gibAus(' (ausfallend)',1); + end{of case}; + case zi.Genauigkeit of + gSingle: + case qu.Genauigkeit of + gSingle: zi.sWerte.integriereSingle(@(qu.sWerte),xmi,xma,tmi,tma,xof,tof,rtg); + gExtended: zi.sWerte.integriereExtended(@(qu.eWerte),xmi,xma,tmi,tma,xof,tof,rtg); + end{of case}; + gExtended: + case qu.Genauigkeit of + gSingle: zi.eWerte.integriereSingle(@(qu.sWerte),xmi,xma,tmi,tma,xof,tof,rtg); + gExtended: zi.eWerte.integriereExtended(@(qu.eWerte),xmi,xma,tmi,tma,xof,tof,rtg); + end{of case}; + end{of case}; + gibAus('... und fertig',1); + fertig:=true; +end; + +// tSortiereNachYThread ******************************************************** + +constructor tSortiereNachYThread.create(K: tKontur; threads,von,bis: longint); +begin + inherited create; + Kont:=K; + vo:=von; + bi:=bis; + mt:=threads; + erfolg:=false; + gibAus('Sortierthread kreiert ('+inttostr(vo)+'-'+inttostr(bi)+') -> x'+inttostr(mt),1); + suspended:=false; +end; + +procedure tSortiereNachYThread.stExecute; +begin + gibAus('Sortierthread gestartet ('+inttostr(vo)+'-'+inttostr(bi)+') -> x'+inttostr(mt)+' ...',1); + erfolg:=Kont.sortiere_nach_y(mt,vo,bi); + gibAus(' ... und fertig',1); + fertig:=true; +end; + +// tBefehlThread *************************************************************** + +constructor tBefehlThread.create(cmd: string; out erfolg: boolean); +function shellParseNextArg(var s: string): string; +begin + if length(s)=0 then begin + erfolg:=false; + exit; + end; + if pos('"',s)=1 then begin + delete(s,1,1); + if pos('" ',s+' ')=0 then begin + erfolg:=false; + exit; + end; + result:=leftStr(s,pos('" ',s+' ')-1); + delete(s,1,pos('" ',s+' ')+1); + end + else begin + result:=leftStr(s,pos(' ',s+' ')-1); + delete(s,1,pos(' ',s+' ')); + end; + if pos('./',result)=1 then begin + delete(result,1,1); + result:=extractfilepath(paramstr(0))+result; + end; +end; +begin + inherited create; + erfolg:=true; + bg:=rightStr(cmd,1)='&'; + if bg then + delete(cmd,length(cmd),1); + p:=tProcess.create(nil); + p.Options:=p.Options + [poWaitOnExit]; + p.Executable:=shellParseNextArg(cmd); + if not erfolg then begin + p.free; + exit; + end; + while length(cmd)>0 do begin + p.Parameters.Add(shellParseNextArg(cmd)); + if not erfolg then begin + p.free; + exit; + end; + end; + cmd:=p.Parameters.Text; + while (length(cmd)>0) and (cmd[length(cmd)] in [#10,#13]) do + delete(cmd,length(cmd),1); + cmd:=''''+cmd+''''; + while pos(#10,cmd)>0 do + cmd:=leftStr(cmd,pos(#10,cmd)-1)+''' '''+copy(cmd,pos(#10,cmd)+1,length(cmd)); + while pos(#13,cmd)>0 do + cmd:=leftStr(cmd,pos(#13,cmd)-1)+''' '''+copy(cmd,pos(#13,cmd)+1,length(cmd)); + gibAus('Externer Befehl: '''+p.Executable+''' '+cmd+' erzeugt.',3); +end; + +destructor tBefehlThread.destroy; +begin + p.free; + inherited destroy; +end; + +procedure tBefehlThread.stExecute; +begin + gibAus('externen Befehl ausführen ...',1); + p.Execute; + gibAus('... fertig!',1); + fertig:=true; +end; + +// tLeseThread ***************************************************************** + +constructor tLeseThread.create(we: tWerte; inps: tGenerischeInputDateiInfoArray); +var i: longint; +begin + inherited create; + w:=we; + setlength(inputs,length(inps)); + for i:=0 to length(inputs)-1 do begin + if inps[i] is tSpaceTimeInputDateiInfo then begin + inputs[i]:=tSpaceTimeInputDateiInfo.create(inps[i]); + continue; + end; + if inps[i] is tTraceInputDateiInfo then begin + inputs[i]:=tTraceInputDateiInfo.create(inps[i]); + continue; + end; + if inps[i] is tPipeInputDateiInfo then begin + inputs[i]:=tPipeInputDateiInfo.create(inps[i]); + continue; + end; + gibAus('unbekannter InputDateiInfo-Typ ...',3); + halt(1); + end; + gibAus('LeseThread erzeugt',1); + suspended:=false; +end; + +destructor tLeseThread.destroy; +begin + w:=nil; + inherited destroy; +end; + +procedure tLeseThread.stExecute; +begin + gibAus('LeseThread gestartet',1); + case w.Genauigkeit of + gSingle: + if not w.sWerte.liesDateien(inputs) then + exit; + gExtended: + if not w.eWerte.liesDateien(inputs) then + exit; + end{of case}; + gibAus('LeseThread beendet',1); + fertig:=true; +end; + +// tVerzerrInitThread ********************************************************** + +constructor tVerzerrInitThread.create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax,x0Abs,t0Abs,threads: longint; epsilon: extended; verzerrung: tVerzerrung; zielpositionen: tPointArray; zielgewichte: tExtPointArray); +begin + inherited create; + qu:=quelle; + zi:=ziel; + ZPs:=zielpositionen; + ZGs:=zielgewichte; + setlength(ZAs,zi._xsteps*zi._tsiz); + xMi:=xMin; + xMa:=xMax; + tMi:=tMin; + tMa:=tMax; + x0:=x0Abs; + t0:=t0Abs; + eps:=epsilon; + verz:=verzerrung; + mt:=threads; + gibAus('VerzerrInitThread kreiert',1); + suspended:=false; +end; + +procedure tVerzerrInitThread.stExecute; +begin + gibAus('VerzerrInitThread gestartet ('+inttostr(xMi)+'-'+inttostr(xMa)+'/'+inttostr(tMi)+'-'+inttostr(tMa)+')',1); + zi.initVerzerrung(qu,xMi,xMa,tMi,tMa,x0,t0,mt,false,eps,verz,ZPs,ZGs,ZAs); + gibAus('VerzerrInitThread beendet',1); + fertig:=true; +end; + +destructor tVerzerrInitThread.destroy; +begin + setlength(ZAs,0); + inherited destroy; +end; + +// tVerzerrThread ************************************************************** + +constructor tVerzerrThread.create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax: longint; zielpositionen: tPointArray; zielgewichte: tExtPointArray; zielanzahlen: tExtendedArray; Vorbearbeitungen,Nachbearbeitungen: tBearbeitungen); +begin + inherited create; + qu:=quelle; + zi:=ziel; + ZPs:=zielpositionen; + ZGs:=zielgewichte; + ZAs:=zielanzahlen; + xMi:=xMin; + xMa:=xMax; + tMi:=tMin; + tMa:=tMax; + vb:=Vorbearbeitungen; + nb:=Nachbearbeitungen; + gibAus('Verzerrthread erzeugt',1); + suspended:=false; +end; + +procedure tVerzerrThread.stExecute; +var sw: pTLLWerteSingle; + ew: pTLLWerteDouble; +begin + gibAus('Verzerrthread gestartet '+floattostr(qu._minW)+' '+floattostr(qu._maxW),1); + case qu.genauigkeit of + gSingle: begin + sw:=@(qu.sWerte); + ew:=nil; + end; + gExtended: begin + sw:=nil; + ew:=@(qu.eWerte); + end; + end{of case}; + case zi.genauigkeit of + gSingle: + case qu.genauigkeit of + gSingle: + zi.sWerte.kopiereVerzerrt(sw,ZPs,ZGs,ZAs,xMi,xMa,tMi,tMa,vb,nb); + gExtended: + zi.sWerte.kopiereVerzerrt(ew,ZPs,ZGs,ZAs,xMi,xMa,tMi,tMa,vb,nb); + end{of case}; + gExtended: + case qu.genauigkeit of + gSingle: + zi.eWerte.kopiereVerzerrt(sw,ZPs,ZGs,ZAs,xMi,xMa,tMi,tMa,vb,nb); + gExtended: + zi.eWerte.kopiereVerzerrt(ew,ZPs,ZGs,ZAs,xMi,xMa,tMi,tMa,vb,nb); + end{of case}; + end{of case}; + gibAus('Verzerrthread beendet',1); + if not behalteLogs then cleanuplog(GetThreadID); + fertig:=true; +end; + +// sonstiges ******************************************************************* + +function findePalette(out Palette: pTPalette; name: string): boolean; +var i: longint; +begin + result:=true; + for i:=0 to length(paletten)-1 do + if paletten[i].name=name then + begin + Palette:=@(paletten[i]); + exit; + end; + Palette:=nil; + result:=false; +end; + +function erzeugeLegende(st: boolean; var f: tInputfile; datei: string; Qu: tWerte; minDichte,maxDichte: extended; nb: tBearbeitungen; pal: pTPalette): boolean; +var s: string; + breite,hoehe,i,j,k,lo,ro,oo,uo, + schriftgroesze: longint; + img: file; + lineareFarbe,waagerecht,rahmen: boolean; + farben: tRgbArray; + col: tRGB; + wert,tmp,schritt: extended; + fontRenderer: tFontRenderer; + beschriftungsschritte: array of tBeschriftungsschritt; + beschriftungen: array of tBeschriftung; +begin + result:=false; + breite:=100; + hoehe:=100; + waagerecht:=false; + lineareFarbe:=false; + schriftgroesze:=24; + setlength(beschriftungen,0); + setlength(beschriftungsschritte,2); + beschriftungsschritte[0].schritte:=0; + beschriftungsschritte[0].bis:=minDichte; + beschriftungsschritte[0].linear:=false; + beschriftungsschritte[0].faktor:=1; + beschriftungsschritte[1].bis:=maxDichte; + beschriftungsschritte[1].schritte:=10; + beschriftungsschritte[1].linear:=true; + beschriftungsschritte[1].faktor:=1; + rahmen:=false; + repeat + if not f.gibZeile(s) then + begin + gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); + exit; + end; + if pos('Ausrichtung:',s)=1 then + begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + waagerecht:=s='waagerecht'; + if (s='waagerecht') or (s='senkrecht') then continue; + gibAus(''''+s+''' ist keine gültige Ausrichtung!',3); + exit; + end; + if pos('Breite:',s)=1 then + begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + breite:=strtoint(s); + continue; + end; + if pos('Höhe:',s)=1 then + begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + hoehe:=strtoint(s); + continue; + end; + if pos('Schriftgröße:',s)=1 then + begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + schriftgroesze:=strtoint(s); + continue; + end; + if s='Farbe linear' then + begin + lineareFarbe:=true; + continue; + end; + if s='Werte linear' then + begin + lineareFarbe:=false; + continue; + end; + if s='Rahmen' then + begin + rahmen:=true; + continue; + end; + if s='Beschriftungen:' then + begin + setlength(beschriftungsschritte,1); + beschriftungsschritte[0].schritte:=0; + beschriftungsschritte[0].bis:=minDichte; + beschriftungsschritte[0].linear:=false; + beschriftungsschritte[0].faktor:=1; + repeat + if not f.gibZeile(s) then + begin + gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); + exit; + end; + if s='Beschriftungsende' then + break; + if not ((pos('linear',s)=1) or (pos('logarithmisch',s)=1) or (length(beschriftungsschritte)>1)) then + begin + gibAus('Ich weiß nicht, ob die Beschriftung linear oder logarithmisch sein soll!',3); + exit; + end; + setlength(beschriftungsschritte,length(beschriftungsschritte)+1); + if not ((pos('linear',s)=1) or (pos('logarithmisch',s)=1)) then + begin + beschriftungsschritte[length(beschriftungsschritte)-1].linear:= + beschriftungsschritte[length(beschriftungsschritte)-2].linear; + end; + if pos('linear',s)=1 then + begin + delete(s,1,length('linear')); + beschriftungsschritte[length(beschriftungsschritte)-1].linear:=true; + end; + if pos('logarithmisch',s)=1 then + begin + delete(s,1,length('logarithmisch')); + beschriftungsschritte[length(beschriftungsschritte)-1].linear:=false; + while pos(' ',s)=1 do + delete(s,1,1); + minDichte:=Qu.exprtofloat(st,copy(s,1,pos(' ',s)-1)); + beschriftungsschritte[0].bis:=maxDichte*minDichte; + delete(s,1,pos(' ',s)); + for i:=0 to nb.count-1 do + if nb[i].typ=btLog then + begin + if nb[i].parameter[0]<>minDichte then + begin + gibAus('Die minimale Dichte der logarithmischen Farbskala ('+myfloattostr(minDichte)+') und der logarithmischen Nachbearbeitung ('+myfloattostr(nb[i].parameter[0])+') stimmen nicht überein!',3); + exit; + end; + minDichte:=minDichte*maxDichte; + break; + end; + end; + while pos(' ',s)=1 do delete(s,1,1); + beschriftungsschritte[length(beschriftungsschritte)-1].bis:=Qu.exprtofloat(st,copy(s,1,pos(' ',s)-1)); + delete(s,1,pos(' ',s)); + while pos(' ',s)=1 do delete(s,1,1); + case s[length(s)] of + '+': beschriftungsschritte[length(beschriftungsschritte)-1].faktor:=0.5; + '-': beschriftungsschritte[length(beschriftungsschritte)-1].faktor:=2; + else beschriftungsschritte[length(beschriftungsschritte)-1].faktor:=1; + end{of case}; + if s[length(s)] in ['+','-'] then + delete(s,length(s),1); + beschriftungsschritte[length(beschriftungsschritte)-1].schritte:=strtoint(s); + until false; + continue; + end; + if s='Legendenende' then + break; + gibAus('Verstehe Option '''+s+''' nicht bei Erzeugund der Legende!',3); + exit; + until false; + if st then begin + result:=true; + exit; + end; + + fontRenderer:=tFontRenderer.create(schriftgroesze); + + gibAus(floattostr(minDichte)+' '+floattostr(maxDichte),1); + for i:=0 to length(beschriftungsschritte)-1 do + gibAus(inttostr(i)+' '+floattostr(beschriftungsschritte[i].bis)+' '+floattostr(beschriftungsschritte[i].faktor)+' '+inttostr(beschriftungsschritte[i].schritte)+' '+inttostr(byte(beschriftungsschritte[i].linear)),1); + + i:=0; + wert:=minDichte; + schritt:=-1; + while wert0 then gibAus(inttostr(i)+' '+floattostr(wert)+' '+floattostr(schritt)+' '+floattostr(beschriftungsschritte[i].bis),1); + if ((ibeschriftungsschritte[i].bis)) or (i=0) then + begin + repeat + inc(i); + until (i>=length(beschriftungsschritte)-1) or (beschriftungsschritte[i].bis>=wert); + if beschriftungsschritte[i].linear then + begin + schritt:=(beschriftungsschritte[i].bis-beschriftungsschritte[i-1].bis)/beschriftungsschritte[i].schritte; + schritt:=power(10,round(ln(schritt)/ln(10)))*beschriftungsschritte[i].faktor; + end + else + schritt:=power(10,floor(ln(wert)/ln(10)-beschriftungsschritte[i].schritte))*beschriftungsschritte[i].faktor; + tmp:=round(beschriftungsschritte[i-1].bis/schritt)*schritt; + while tmp+schritt/2<=wert do tmp:=(round(tmp/schritt)+1)*schritt; + wert:=tmp; + gibAus(inttostr(i)+' '+floattostr(wert)+' '+floattostr(schritt)+' '+floattostr(beschriftungsschritte[i].bis),1); + end; + setlength(beschriftungen,length(beschriftungen)+1); + beschriftungen[length(beschriftungen)-1]:=tBeschriftung.create; + beschriftungen[length(beschriftungen)-1].bBreite:=breite; + beschriftungen[length(beschriftungen)-1].bHoehe:=hoehe; + beschriftungen[length(beschriftungen)-1].Rahmen:=Rahmen; + beschriftungen[length(beschriftungen)-1].fontRend:=fontRenderer; + beschriftungen[length(beschriftungen)-1].position:=(wert-minDichte)/(maxDichte-minDichte); + beschriftungen[length(beschriftungen)-1].inhalt:=floattostr(wert); + if not beschriftungsschritte[i].linear then + schritt:=power(10,floor(ln(wert)/ln(10)-beschriftungsschritte[i].schritte))*beschriftungsschritte[i].faktor; + wert:=(round(wert/schritt)+1)*schritt; + end; + + if lineareFarbe then + for i:=0 to length(beschriftungen)-1 do begin + wert:=beschriftungen[i].position; + for j:=0 to nb.count-1 do + nb[j].anwenden(wert); + beschriftungen[i].position:=wert; + end; + for i:=0 to length(beschriftungen)-1 do + beschriftungen[i].position:=beschriftungen[i].position*(hoehe+byte(waagerecht)*(breite-hoehe)); + + lo:=Byte(Rahmen); + ro:=Byte(Rahmen); + oo:=Byte(Rahmen); + uo:=Byte(Rahmen); + for i:=0 to length(beschriftungen)-1 do begin + lo:=max(lo,-beschriftungen[i].links); + ro:=max(ro,1+beschriftungen[i].rechts-breite); + oo:=max(oo,-beschriftungen[i].oben); + uo:=max(uo,1+beschriftungen[i].unten-hoehe); + end; + if lo+oo+ro+uo>0 then + gibAus('Extra-Ränder: '+inttostr(lo)+' Pixel links, '+inttostr(oo)+' Pixel oben, '+inttostr(ro)+' Pixel rechts und '+inttostr(uo)+' Pixel unten.',3); + + setlength(farben,byte(waagerecht)*(breite-hoehe)+hoehe); + for i:=0 to length(farben)-1 do begin + wert:=i/length(farben); + if not lineareFarbe then + for j:=0 to nb.count-1 do + nb[j].anwenden(wert); + farben[i]:=wertZuFarbe(wert,pal^.farben); + end; + assign(img,datei); + rewrite(img,1); + schreibeBmpHeader(img,breite+lo+ro,hoehe+oo+uo); + for j:=-oo to hoehe+uo-1 do begin + i:=-lo; + while i=0) and (j=0) and (i=0) and (j=-1) and (j<=hoehe)) or + ((i=breite) and (j>=-1) and (j<=hoehe)) or + ((j=-1) and (i>=-1) and (i<=breite)) or + ((j=hoehe) and (i>=-1) and (i<=breite)) then begin + col.rgbRed:=$00; + col.rgbGreen:=$00; + col.rgbBlue:=$00; + end; + end; + for k:=0 to length(Beschriftungen)-1 do + with Beschriftungen[k] do begin + if (links<=i) and (rechts>=i) and (oben<=j) and (unten>=j) then + col:=andFarben(col,bild.farben[i-links + (j-oben)*bild.breite]); + if ((bBreite<=i) and (is) do + inc(result); + if result0; + for i:=1 to length(s) do + istZahl:=istZahl and (s[i] in ['0'..'9']); + + if istZahl then begin // bei s handelt es sich um den Index selbst + result:=strtoint(s); + if result>=length(pws^) then begin + gibAus('Index ('+s+') liegt außerhalb des gültigen Bereichs (0..'+inttostr(length(pws^)-1)+')!',3); + result:=-1; + end + else + pws^[result].warteaufBeendigungDesLeseThreads; + exit; + end; + + if s='' then begin + if not darfErstellen then begin + gibAus('Leerer Bezeichner bezeichnet keine Werte!',3); + result:=-1; + exit; + end; + end; + setlength(pws^,length(pws^)+1); + pws^[length(pws^)-1]:=tWerte.create(Kont); + pws^[length(pws^)-1].bezeichner:=s; + result:=length(pws^)-1; +end; + +function findeKontur(s: String; pks: pTKonturenArray; darfErstellen: boolean): integer; +var i: integer; + istZahl: boolean; +begin + s:=trim(s); + result:=length(pks^)*byte(s=''); // kleine Abkürzung + while (results) do + inc(result); + if result0; + for i:=1 to length(s) do + istZahl:=istZahl and (s[i] in ['0'..'9']); + + if istZahl then begin // bei s handelt es sich um den Index selbst + result:=strtoint(s); + if result>=length(pks^) then begin + gibAus('Index ('+s+') liegt außerhalb des gültigen Bereichs (0..'+inttostr(length(pks^)-1)+')!',3); + result:=-1; + end; + exit; + end; + + if s='' then begin + if not darfErstellen then begin + gibAus('Leerer Bezeichner bezeichnet keine Werte!',3); + result:=-1; + exit; + end; + end; + setlength(pks^,length(pks^)+1); + pks^[length(pks^)-1]:=tKontur.create; + pks^[length(pks^)-1].bezeichner:=s; + result:=length(pks^)-1; +end; + +function initBmpHeader(w,h: longint): tBmpHeader; +begin + With result do begin + bfType1 := $42; + bfType2 := $4D; + bfSize := $36 + ((3*w+3) div 4)*4*h; + bfReserved1 := $0000; + bfReserved2 := $0000; + bfOffBits := $36; + biSize := $28; + biWidth := w; + biHeight := h; + biPlanes := $0001; + biBitCount := $0018; + biCompression := $00000000; + biSizeImage := ((3*w+3) div 4)*4*h; + biXPelsPerMeter := $00000000; + biYPelsPerMeter := $00000000; + biClrUsed := $00000000; + biClrImportant := $00000000; + end; +end; + +procedure schreibeBmpHeader(var f: file; w,h: longint); +var bmpHeader: tBmpHeader; +begin + bmpHeader:=initBmpHeader(w,h); + blockwrite(f,bmpHeader,sizeof(bmpHeader)); +end; + +function neuePalette(var f: tInputfile): boolean; +var s,name: string; + Palette: tRGBArray; + i,tmpi: longint; + nPalette: pTPalette; +begin + result:=false; + setlength(Palette,0); + name:=''; + nPalette:=nil; + repeat + if not f.gibZeile(s) then begin + gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); + exit; + end; + if s='Ende' then break; + if pos('Name:',s)=1 then begin + delete(s,1,pos(':',s)); + while pos(' ',s)=1 do delete(s,1,1); + name:=s; + findePalette(nPalette,s); + continue; + end; + if (length(s)=6) and (s[1] in ['0'..'9','a'..'f']) and + (s[2] in ['0'..'9','a'..'f']) and + (s[3] in ['0'..'9','a'..'f']) and + (s[4] in ['0'..'9','a'..'f']) and + (s[5] in ['0'..'9','a'..'f']) and + (s[6] in ['0'..'9','a'..'f']) then begin + setlength(Palette,length(Palette)+1); + tmpi:=0; + for i:=1 to 6 do begin + tmpi:=tmpi shl 4; + if s[i] in ['0'..'9'] then + tmpi:=tmpi + ord(s[i])-ord('0') + else + tmpi:=tmpi + ord(s[i])-ord('a')+10; + end; + Palette[length(Palette)-1].rgbRed:= tmpi and $0000ff; + Palette[length(Palette)-1].rgbGreen:=(tmpi and $00ff00) shr 8; + Palette[length(Palette)-1].rgbBlue:= (tmpi and $ff0000) shr 16; + continue; + end; + gibAus(''''+s+''' ist keine Farbe für eine Palette!',3); + exit; + until false; + if name='' then begin + gibAus('Die Palette braucht einen Namen!',3); + exit; + end; + if length(Palette)<2 then begin + gibAus('Zu wenige Farben in der Palette '''+name+''', nämlich nur '+inttostr(length(Palette)),3); + exit; + end; + if nPalette=nil then begin + setlength(Paletten,length(Paletten)+1); + nPalette:=@(Paletten[length(Paletten)-1]); + end; + nPalette^.name:=name; + setlength(nPalette^.farben,length(Palette)); + for i:=0 to length(Palette)-1 do + nPalette^.farben[i]:=Palette[i]; + gibAus('Neue Palette '''+nPalette^.name+''' erstellt!',3); + result:=true; +end; + +function externerBefehl(st: boolean; s: string): boolean; +var bt: tBefehlThread; +begin + bt:=tBefehlThread.create(s,result); + if st or not result then begin + bt.free; + exit; + end; + bt.suspended:=false; + gibAus('Befehl gestartet.',3); + if bt.bg then begin + setlength(externeBefehle,length(externeBefehle)+1); + externeBefehle[length(externeBefehle)-1]:=bt; + exit; // Job läuft im Hintergrund weiter! + end; + while not bt.fertig do + sleep(100); + bt.free; +end; + +procedure warte_auf_externeBefehle; +var i: longint; + b,c: boolean; +begin + c:=true; + repeat + b:=false; + for i:=0 to length(externeBefehle)-1 do + b:=b or (assigned(externeBefehle[i]) and not externeBefehle[i].fertig); + if b then begin + if c then gibAus('Warte auf Beendigung externer Befehle ...',3); + c:=false; + sleep(100); + end; + until not b; + if not c then + gibAus('... alle externen Befehle fertig.',3); + for i:=0 to length(externeBefehle)-1 do + if assigned(externeBefehle[i]) then externeBefehle[i].free; + setlength(externeBefehle,0); +end; + +begin + setlength(externeBefehle,0); + + setlength(Paletten,5); + Paletten[0].name:='Graustufen'; + setlength(Paletten[0].farben,2); + Paletten[0].farben[0].rgbRed:= $ff; + Paletten[0].farben[0].rgbGreen:=$ff; + Paletten[0].farben[0].rgbBlue:= $ff; + Paletten[0].farben[1].rgbRed:= $00; + Paletten[0].farben[1].rgbGreen:=$00; + Paletten[0].farben[1].rgbBlue:= $00; + + Paletten[1].name:='invertierte Graustufen'; + setlength(Paletten[1].farben,2); + Paletten[1].farben[0].rgbRed:= $00; + Paletten[1].farben[0].rgbGreen:=$00; + Paletten[1].farben[0].rgbBlue:= $00; + Paletten[1].farben[1].rgbRed:= $ff; + Paletten[1].farben[1].rgbGreen:=$ff; + Paletten[1].farben[1].rgbBlue:= $ff; + + Paletten[2].name:='Regenbogen'; + setlength(Paletten[2].farben,6); + Paletten[2].farben[0].rgbRed:= $00; + Paletten[2].farben[0].rgbGreen:=$00; + Paletten[2].farben[0].rgbBlue:= $ff; + Paletten[2].farben[1].rgbRed:= $00; + Paletten[2].farben[1].rgbGreen:=$ff; + Paletten[2].farben[1].rgbBlue:= $ff; + Paletten[2].farben[2].rgbRed:= $00; + Paletten[2].farben[2].rgbGreen:=$ff; + Paletten[2].farben[2].rgbBlue:= $00; + Paletten[2].farben[3].rgbRed:= $ff; + Paletten[2].farben[3].rgbGreen:=$ff; + Paletten[2].farben[3].rgbBlue:= $00; + Paletten[2].farben[4].rgbRed:= $ff; + Paletten[2].farben[4].rgbGreen:=$00; + Paletten[2].farben[4].rgbBlue:= $00; + Paletten[2].farben[5].rgbRed:= $00; + Paletten[2].farben[5].rgbGreen:=$00; + Paletten[2].farben[5].rgbBlue:= $00; + + Paletten[3].name:='invertierter Regenbogen'; + setlength(Paletten[3].farben,6); + Paletten[3].farben[0].rgbRed:= $00; + Paletten[3].farben[0].rgbGreen:=$00; + Paletten[3].farben[0].rgbBlue:= $00; + Paletten[3].farben[1].rgbRed:= $ff; + Paletten[3].farben[1].rgbGreen:=$00; + Paletten[3].farben[1].rgbBlue:= $00; + Paletten[3].farben[2].rgbRed:= $ff; + Paletten[3].farben[2].rgbGreen:=$ff; + Paletten[3].farben[2].rgbBlue:= $00; + Paletten[3].farben[3].rgbRed:= $00; + Paletten[3].farben[3].rgbGreen:=$ff; + Paletten[3].farben[3].rgbBlue:= $00; + Paletten[3].farben[4].rgbRed:= $00; + Paletten[3].farben[4].rgbGreen:=$ff; + Paletten[3].farben[4].rgbBlue:= $ff; + Paletten[3].farben[5].rgbRed:= $00; + Paletten[3].farben[5].rgbGreen:=$00; + Paletten[3].farben[5].rgbBlue:= $ff; + + Paletten[4].name:='Jet-Regenbogen'; + setlength(Paletten[4].farben,5); + Paletten[4].farben[0].rgbRed:= $ff; + Paletten[4].farben[0].rgbGreen:=$00; + Paletten[4].farben[0].rgbBlue:= $00; + Paletten[4].farben[1].rgbRed:= $ff; + Paletten[4].farben[1].rgbGreen:=$ff; + Paletten[4].farben[1].rgbBlue:= $00; + Paletten[4].farben[2].rgbRed:= $00; + Paletten[4].farben[2].rgbGreen:=$ff; + Paletten[4].farben[2].rgbBlue:= $00; + Paletten[4].farben[3].rgbRed:= $00; + Paletten[4].farben[3].rgbGreen:=$ff; + Paletten[4].farben[3].rgbBlue:= $ff; + Paletten[4].farben[4].rgbRed:= $00; + Paletten[4].farben[4].rgbGreen:=$00; + Paletten[4].farben[4].rgbBlue:= $ff; + +end. + -- cgit v1.2.3-70-g09d2