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.