unit epostunit; {$mode objfpc}{$H+} interface uses Classes, SysUtils, mystringlistunit, werteunit, typenunit, process, lowlevelunit, matheunit; 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: tMyStringlist; 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: tMyStringlist; 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: tTransformationen; ZPs: tIntPointArray; ZGs: tExtPointArray; ZAs: tExtendedArray; Warn: tWarnstufe); 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; function kont2disk(dir: char; x: extended): longint; function kont2diskFak(dir: char; x: extended): extended; function disk2kont(dir: char; x: longint): extended; function disk2kontFak(dir: char; x: longint): extended; procedure schreibeWertIntegriert(var f: textfile; i: longint; hor: boolean); public eWerte: tLLWerteExtended; dWerte: tLLWerteDouble; sWerte: tLLWerteSingle; Genauigkeit: tGenauigkeit; bezeichner: string; Konturen: pTKonturenArray; wertes: pTWerteArray; constructor create(Kont: pTKonturenArray; wert: pTWerteArray); 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: tMyStringlist; pl: boolean): boolean; function ladeAscii(st: boolean; datei: string): boolean; function berechneLiKo(st: boolean; var f: tMyStringlist; threads: longint): boolean; function berechneQuotient(st: boolean; var f: tMyStringlist; threads, dividend, divisor: longint): boolean; function berechneProdukt(st: boolean; var f: tMyStringlist; threads, faktor1, faktor2: longint): boolean; function berechneKorrelation(st: boolean; var f: tMyStringlist; 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: tMyStringlist; threads: longint; const quelle: tWerte; Warn: tWarnstufe): boolean; function berechneVerzerrung(st: boolean; var f: tMyStringlist; threads: longint; const quelle: tWerte; Warn: tWarnstufe): boolean; function berechneIntegral(st: boolean; var f: tMyStringlist; threads: longint; const quelle: tWerte): boolean; function berechneFFT(st: boolean; var f: tMyStringlist; threads: longint; Warn: tWarnstufe): boolean; function berechneFFT2d(st: boolean; var f: tMyStringlist; threads: longint; Warn: tWarnstufe): boolean; function erzeugeLinearesBild(st: boolean; var f: tMyStringlist; maxThreads: longint): boolean; function erzeugeAscii(st: boolean; var f: tMyStringlist): boolean; function erzeugeLineout(st: boolean; params: string): boolean; function erzeugeBinning(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; function Transformationen: tTransformationen; 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) private _fertig: boolean; raisedException: exception; function rFertig: boolean; public property fertig: boolean read rFertig write _fertig; constructor create; destructor destroy; override; procedure execute; override; procedure stExecute; virtual; abstract; end; tLiKoThread = class(tLogThread) liKo: pTLiKo; xMi,xMa,tMi,tMa,tOf,xOf: longint; pW: tWerte; constructor create(lk: pTLiKo; pWerte: tWerte; xMin,xMax,tMin,tMax,xOff,tOff: longint); destructor destroy; override; procedure stExecute; override; end; tQuotientThread = class(tLogThread) 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); destructor destroy; override; procedure stExecute; override; end; tProduktThread = class(tLogThread) xMi,xMa,tMi,tMa,tOf,xOf: longint; f1,f2,pro: tWerte; constructor create(faktor1, faktor2, produkt: tWerte; xMin,xMax,tMin,tMax,xOff,tOff: longint); destructor destroy; override; 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: tTransformationen; 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: tTransformationen; 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); destructor destroy; override; procedure stExecute; override; end; tSpiegelThread = class(tLogThread) tmin,tmax: longint; pW: tWerte; constructor create(tmi,tma: longint; pWerte: tWerte); destructor destroy; override; procedure stExecute; override; end; tFFT2dNBThread = class(tLogThread) xmin,xmax: longint; pW: tWerte; nb: tFFTDatenordnung; constructor create(xmi,xma: longint; pWerte: tWerte; endordnung: tFFTDatenordnung); destructor destroy; override; 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); destructor destroy; override; 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); destructor destroy; override; 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); destructor destroy; override; procedure stExecute; override; end; tSortiereNachYThread = class(tLogThread) Kont: tKontur; vo,bi,mt: longint; erfolg: boolean; constructor create(K: tKontur; threads,von,bis: longint); destructor destroy; override; procedure stExecute; override; end; tBefehlThread = class(tLogThread) bg: boolean; p: tProcess; constructor create(st: boolean; 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: tIntPointArray; ZGs: tExtPointArray; ZAs: tExtendedArray; xMi,xMa,tMi,tMa,x0,t0,mt: longint; // bzgl. Ziel eps: extended; verz: tTransformationen; Warnstufe: tWarnstufe; constructor create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax,x0Abs,t0Abs,threads: longint; epsilon: extended; verzerrung: tTransformationen; zielpositionen: tIntPointArray; zielgewichte: tExtPointArray; Warn: tWarnstufe); destructor destroy; override; procedure stExecute; override; end; tVerzerrThread = class(tLogThread) qu,zi: tWerte; ZPs: tIntPointArray; ZGs: tExtPointArray; ZAs: tExtendedArray; xMi,xMa,tMi,tMa: longint; // bzgl. Ziel vb,nb: tTransformationen; constructor create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax: longint; zielpositionen: tIntPointArray; zielgewichte: tExtPointArray; zielanzahlen: tExtendedArray; Vorbearbeitungen,Nachbearbeitungen: tTransformationen); destructor destroy; override; procedure stExecute; override; end; function neuePalette(var f: tMyStringlist): 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: tMyStringlist; datei: string; Qu: tWerte; minDichte,maxDichte: extended; nb: tTransformationen; 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; wert: pTWerteArray); var ps: tExtrainfos; begin inherited create; ps:=tExtrainfos.create; Genauigkeit:=gSingle; leseThread:=nil; sWerte:=tLLWerteSingle.create(ps); dWerte:=tLLWerteDouble.create(ps); eWerte:=tLLWerteExtended.create(ps); Konturen:=Kont; wertes:=wert; bezeichner:=''; end; constructor tWerte.create(original: tWerte; xmin,xmax: longint); var ps: tExtrainfos; pSi: pTLLWerteSingle; pDo: pTLLWerteDouble; pEx: pTLLWerteExtended; begin inherited create; original.warteAufBeendigungDesLeseThreads; 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); dWerte:=tLLWerteDouble.create(ps); eWerte:=tLLWerteExtended.create(ps); end; gDouble: begin pDo:=@(original.dWerte); sWerte:=tLLWerteSingle.create(ps); dWerte:=tLLWerteDouble.create(pDo,ps,xmin,xmax); eWerte:=tLLWerteExtended.create(ps); end; gExtended: begin sWerte:=tLLWerteSingle.create(ps); dWerte:=tLLWerteDouble.create(ps); pEx:=@(original.eWerte); eWerte:=tLLWerteExtended.create(pEx,ps,xmin,xmax); end; end{of case}; if original.bezeichner='' then bezeichner:='' else bezeichner:=original.bezeichner+''''; Transformationen.kopiereVon(original.Transformationen); wertes:=original.wertes; end; destructor tWerte.destroy; begin warteAufBeendigungDesLeseThreads; if eWerte.params<>sWerte.params then begin eWerte.params.free; gibAus('Die Werteparameter sind verschieden instaziiert!!!',3); end; sWerte.params.free; eWerte.free; dWerte.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; pDo: pTLLWerteDouble; pEx: pTLLWerteExtended; begin original.warteAufBeendigungDesLeseThreads; Transformationen.kopiereVon(original.Transformationen); Genauigkeit:=original.Genauigkeit; case Genauigkeit of gSingle: begin pSi:=@(original.sWerte); sWerte.kopiereVon(st,pSi,xmin,xmax); end; gDouble: begin pDo:=@(original.dWerte); dWerte.kopiereVon(st,pDo,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; gDouble: result:=dWerte.params.xsteps; gExtended: result:=eWerte.params.xsteps; end{of case}; end; procedure tWerte.wXsteps(xs: longint); begin sWerte.params.xsteps:=xs; sWerte.params.refreshKnownValues; dWerte.params.xsteps:=xs; dWerte.params.refreshKnownValues; eWerte.params.xsteps:=xs; eWerte.params.refreshKnownValues; end; function tWerte.rTsiz: longint; begin case genauigkeit of gSingle: result:=sWerte.params.tsiz; gDouble: result:=dWerte.params.tsiz; gExtended: result:=eWerte.params.tsiz; end{of case}; end; procedure tWerte.wTsiz(ts: longint); begin sWerte.params.tsiz:=ts; sWerte.params.refreshKnownValues; dWerte.params.tsiz:=ts; dWerte.params.refreshKnownValues; eWerte.params.tsiz:=ts; eWerte.params.refreshKnownValues; end; function tWerte.rXstart: extended; begin case genauigkeit of gSingle: result:=sWerte.params.xstart; gDouble: result:=dWerte.params.xstart; gExtended: result:=eWerte.params.xstart; end{of case}; end; procedure tWerte.wXstart(xs: extended); begin case genauigkeit of gSingle: begin sWerte.params.transformationen.xstart:=xs; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.transformationen.xstart:=xs; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.transformationen.xstart:=xs; eWerte.params.refreshKnownValues; end; end{of case}; end; function tWerte.rXstop: extended; begin case genauigkeit of gSingle: result:=sWerte.params.xstop; gDouble: result:=dWerte.params.xstop; gExtended: result:=eWerte.params.xstop; end{of case}; end; procedure tWerte.wXstop(xs: extended); begin case genauigkeit of gSingle: begin sWerte.params.transformationen.xstop:=xs; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.transformationen.xstop:=xs; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.transformationen.xstop:=xs; eWerte.params.refreshKnownValues; end; end{of case}; end; function tWerte.rTstart: extended; begin case genauigkeit of gSingle: result:=sWerte.params.tstart; gDouble: result:=dWerte.params.tstart; gExtended: result:=eWerte.params.tstart; end{of case}; end; procedure tWerte.wTstart(ts: extended); begin case genauigkeit of gSingle: begin sWerte.params.transformationen.tstart:=ts; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.transformationen.tstart:=ts; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.transformationen.tstart:=ts; eWerte.params.refreshKnownValues; end; end{of case}; end; function tWerte.rTstop: extended; begin case genauigkeit of gSingle: result:=sWerte.params.tstop; gDouble: result:=dWerte.params.tstop; gExtended: result:=eWerte.params.tstop; end{of case}; end; procedure tWerte.wTstop(ts: extended); begin case genauigkeit of gSingle: begin sWerte.params.transformationen.tstop:=ts; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.transformationen.tstop:=ts; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.transformationen.tstop:=ts; eWerte.params.refreshKnownValues; end; end{of case}; end; function tWerte.rNp: extended; begin case genauigkeit of gSingle: result:=sWerte.params.np; gDouble: result:=dWerte.params.np; gExtended: result:=eWerte.params.np; end{of case}; end; procedure tWerte.wNp(np: extended); begin case genauigkeit of gSingle: begin sWerte.params.np:=np; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.np:=np; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.np:=np; eWerte.params.refreshKnownValues; end; end{of case}; end; function tWerte.rBeta: extended; begin case genauigkeit of gSingle: result:=sWerte.params.beta; gDouble: result:=dWerte.params.beta; gExtended: result:=eWerte.params.beta; end{of case}; end; procedure tWerte.wBeta(beta: extended); begin case genauigkeit of gSingle: begin sWerte.params.beta:=beta; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.beta:=beta; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.beta:=beta; eWerte.params.refreshKnownValues; end; end{of case}; end; function tWerte.rMinw: extended; begin case genauigkeit of gSingle: result:=sWerte.params.minw; gDouble: result:=dWerte.params.minw; gExtended: result:=eWerte.params.minw; end{of case}; end; procedure tWerte.wMinw(miw: extended); begin Transformationen.wmin:=miw; case genauigkeit of gSingle: begin sWerte.params.minw:=miw; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.minw:=miw; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.minw:=miw; eWerte.params.refreshKnownValues; end; end{of case}; end; function tWerte.rMaxw: extended; begin case genauigkeit of gSingle: result:=sWerte.params.maxw; gDouble: result:=dWerte.params.maxw; gExtended: result:=eWerte.params.maxw; end{of case}; end; procedure tWerte.wMaxw(maw: extended); begin Transformationen.wmax:=maw; case genauigkeit of gSingle: begin sWerte.params.maxw:=maw; sWerte.params.refreshKnownValues; end; gDouble: begin dWerte.params.maxw:=maw; dWerte.params.refreshKnownValues; end; gExtended: begin eWerte.params.maxw:=maw; eWerte.params.refreshKnownValues; end; 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 tPhaseSpaceInputDateiInfo then dat[length(dat)-1]:=tPhaseSpaceInputDateiInfo.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: tMyStringlist; 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.transformationen.tstart:=0; sWerte.params.transformationen.tstop:=0; sWerte.params.transformationen.xstart:=0; sWerte.params.transformationen.xstop:=0; mitGewalt:=false; repeat if not f.readln(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 startetMit('Genauigkeit:',s) then begin if not Vorlagen.GenauigkeitFromStr(s) then begin aufraeumen; exit; end; if (Genauigkeit < Vorlagen.Genauigkeit) then Genauigkeit:=Vorlagen.Genauigkeit; continue; end; if startetMit('Gamma:',s) then begin Vorlagen.Gamma:=exprtofloat(false,s); continue; end; if startetMit('tmin:',s) then begin Vorlagen.tstart:=exprtofloat(false,s); continue; end; if startetMit('tmax:',s) then begin Vorlagen.tstop:=exprtofloat(false,s); continue; end; if startetMit('xmin:',s) then begin Vorlagen.xstart:=exprtofloat(false,s); continue; end; if startetMit('xmax:',s) then begin Vorlagen.xstop:=exprtofloat(false,s); continue; end; if startetMit('Name:',s) then begin bezeichner:=s; continue; end; if startetMit('Inputparameterdatei:',s) then begin 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); s:=erstesArgument(s,'#'); if startetMit('Gamma :',s) then begin Vorlagen.Gamma:=strtofloat(s); erfolg:=erfolg or 1; continue; end; if startetMit('Beta :',s) then begin be:=strtofloat(s); erfolg:=erfolg or 2; continue; end; if startetMit('n_el_over_nc :',s) then begin ne:=strtofloat(s); erfolg:=erfolg or 4; continue; end; if startetMit('.a0 :',s) then begin if strtofloat(s)>maxAmp then begin maxAmp:=strtofloat(s); erfolg:=erfolg or 8; end; continue; end; if startetMit('pulse component # ',s) then begin erfolg:=erfolg and (not 8); continue; end; if odd(erfolg shr 3) and startetMit('.frequency :',s) then begin 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 startetMit('Fehlerbehebungskommando:',s) then begin Vorlagen.Fehlerbehebungskommando:=s; continue; end; if startetMit('Spurnummer:',s) then begin Vorlagen.SpurNummer:=strtoint(s); continue; end; if startetMit('Feldnummer:',s) then begin Vorlagen.FeldNummer:=strtoint(s); continue; end; if startetMit('Feld:',s) then begin 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 startetMit('Analysator:',s) then begin Vorlagen.Analysator:=s; continue; end; if startetMit('PhaseSpace-Datei:',s) then begin if fileexists(s) then begin setlength(dateien,length(dateien)+1); dateien[length(dateien)-1]:=tPhaseSpaceInputDateiInfo.create(Vorlagen.PhaseSpaceVorlage); dateien[length(dateien)-1].Name:=s; continue; end; if not findeAlleDateien(s,dateien,Vorlagen.PhaseSpaceVorlage) then begin aufraeumen; exit; end; continue; end; if startetMit('SpaceTime-Datei:',s) then begin 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 startetMit('Trace-Datei:',s) then begin 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 startetMit('Pipe:',s) then begin 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; sWerte.params.refreshKnownValues; 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; tmpd: double; tmpe: extended; f: file; Positionen: tLongintArray; Sortiert: tGenerischeInputDateiInfoArray; ipp,ipap: tProcess; buf: array of byte; s,t: string; begin result:=false; if length(Dateien)=0 then begin gibAus('Keine Dateien zum Einlesen!',3); exit; end; genauigkeit:=gSingle; for i:=0 to length(dateien)-1 do genauigkeit:=tGenauigkeit(max(genauigkeit,dateien[i].genauigkeit)); tmpi:=0; num:=0; tmps:=0; tmpd:=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 startetMit('Channels',t) and startetMit(':',t) then begin dateien[i].xsteps:=strtoint(t); continue; end; if startetMit('Sample Rate',t) and startetMit(':',t) then begin dateien[i].groeszenFaktor:=dateien[i].groeszenFaktor/strtofloat(t); continue; end; if startetMit('Precision',t) and startetMit(':',t) then begin 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 startetMit('Duration',t) and startetMit(':',t) then begin erstesArgument(t,'='); t:=erstesArgument(t); dateien[i].tsiz:=strtoint(t); dateien[i].groeszenFaktor:=dateien[i].groeszenFaktor*dateien[i].tsiz; continue; end; if startetMit('Sample Encoding',t) and startetMit(':',t) then begin 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 assign(f,dateien[i].Name); reset(f,1); blockread(f,num,sizeof(longint)); dec(num); if dateien[i] is tTraceInputDateiInfo then begin dateien[i].xsteps:=1; dateien[i].xstop:=dateien[i].xstart; blockread(f,tmpi,sizeof(longint)); if spAnz<0 then spAnz:=tmpi; 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; gDouble: begin blockread(f,tmpd,sizeof(double)); tmpe:=tmpd; end; gExtended: blockread(f,tmpe,sizeof(extended)); end{of case}; tmpe:=tmpe*dateien[i].groeszenFaktor; if i=0 then Transformationen.xstart:=tmpe; if tmpe<>Transformationen.xstart then begin gibAus('Falscher linker Rand in '''+dateien[i].Name+''', nämlich '+myfloattostr(tmpe)+' statt '+myfloattostr(Transformationen.xstart)+'.',3); close(f); exit; end; case dateien[i].Genauigkeit of gSingle: begin blockread(f,tmps,sizeof(single)); tmpe:=tmps; end; gDouble: begin blockread(f,tmpd,sizeof(double)); tmpe:=tmpd; end; gExtended: blockread(f,tmpe,sizeof(extended)); end{of case}; tmpe:=tmpe*dateien[i].groeszenFaktor; if i=0 then Transformationen.xstop:=tmpe; if tmpe<>Transformationen.xstop then begin gibAus('Falscher rechter Rand in '''+dateien[i].Name+''', nämlich '+myfloattostr(tmpe)+' statt '+myfloattostr(Transformationen.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; if dateien[i] is tPhaseSpaceInputDateiInfo then begin if (i<>0) or (length(dateien)<>1) then begin gibAus('Ich kann Phasenraumdateien nicht kaskadieren!',3); close(f); exit; end; assign(f,dateien[i].Name); reset(f,1); case dateien[i].Genauigkeit of gSingle: begin blockread(f,tmps,sizeof(single)); tmpe:=tmps; end; gDouble: begin blockread(f,tmpd,sizeof(double)); tmpe:=tmpd; end; gExtended: blockread(f,tmpe,sizeof(extended)); end{of case}; tmpe:=tmpe*dateien[i].groeszenFaktor; Transformationen.tstart:=tmpe; case dateien[i].Genauigkeit of gSingle: begin blockread(f,tmps,sizeof(single)); tmpe:=tmps; end; gDouble: begin blockread(f,tmpd,sizeof(double)); tmpe:=tmpd; end; gExtended: blockread(f,tmpe,sizeof(extended)); end{of case}; tmpe:=tmpe*dateien[i].groeszenFaktor; Transformationen.tstop:=tmpe; blockread(f,tmpi,sizeof(longint)); dateien[i].tsiz:=tmpi; case dateien[i].Genauigkeit of gSingle: begin blockread(f,tmps,sizeof(single)); tmpe:=tmps; end; gDouble: begin blockread(f,tmpd,sizeof(double)); tmpe:=tmpd; end; gExtended: blockread(f,tmpe,sizeof(extended)); end{of case}; tmpe:=tmpe*dateien[i].groeszenFaktor; Transformationen.xstart:=tmpe; case dateien[i].Genauigkeit of gSingle: begin blockread(f,tmps,sizeof(single)); tmpe:=tmps; end; gDouble: begin blockread(f,tmpd,sizeof(double)); tmpe:=tmpd; end; gExtended: blockread(f,tmpe,sizeof(extended)); end{of case}; tmpe:=tmpe*dateien[i].groeszenFaktor; Transformationen.xstop:=tmpe; blockread(f,tmpi,sizeof(longint)); dateien[i].xsteps:=tmpi; close(f); Positionen[i]:=0; 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; if not (dateien[0] is tPhaseSpaceInputDateiInfo) then begin Transformationen.tstart:=Positionen[0]*dateien[0].groeszenFaktor; Transformationen.tstop:=(Positionen[0]+1)*dateien[0].groeszenFaktor; for i:=1 to length(Positionen)-1 do begin Transformationen.tstart:=min(Transformationen.tstart,Positionen[i]*dateien[i].groeszenFaktor); Transformationen.tstop:=max(Transformationen.tstop,(Positionen[i]+1)*dateien[i].groeszenFaktor); end; if 0<>round(Transformationen.tstart+length(dateien)*dateien[0].groeszenFaktor-Transformationen.tstop) then begin gibAus('Die Dateien decken nicht den kompletten Zeitbereich von '+inttostr(round(Transformationen.tstart))+'T bis '+inttostr(round(Transformationen.tstop))+'T ab!',3); exit; end; setlength(sortiert,length(dateien)); for i:=0 to length(Positionen)-1 do sortiert[Positionen[i]-round(Transformationen.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; end; sWerte.params.refreshKnownValues; result:=true; end; procedure tWerte.initVerzerrung(quelle: tWerte; xMin,xMax,tMin,tMax,x0Abs,t0Abs,mt: longint; oberst: boolean; epsilon: extended; verzerrung: tTransformationen; ZPs: tIntPointArray; ZGs: tExtPointArray; ZAs: tExtendedArray; Warn: tWarnstufe); 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 for j:=xMin to xMax do begin ZGs[j+i*quelle._xsteps]:=verzerrung.transformiereKoordinaten(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 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, Warn); 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 if ZAs[i]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; Transformationen.clear; Transformationen.xsteps:=_xsteps; Transformationen.tsiz:=_tsiz; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.berechneLiKo(st: boolean; var f: tMyStringlist; threads: longint): 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.readln(s) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; if s='Ende' then break; if startetMit('Name:',s) then begin bezeichner:=s; continue; end; if startetMit('xmin:',s) then begin xmin:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('xmax:',s) then begin xmax:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('tmin:',s) then begin tmin:=kont2disk('t',exprtofloat(st,s)); continue; end; if startetMit('tmax:',s) then begin tmax:=kont2disk('t',exprtofloat(st,s)); continue; end; setlength(liKo,length(liKo)+1); i:=findeWerte(erstesArgument(s),wertes,Konturen,false); if i<0 then exit; 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; Transformationen.kopiereVon(liKo[length(liKo)-1].werte.Transformationen); xmin:=0; xmax:=_xsteps-1; end; if _tsiz=0 then begin _tsiz:=liKo[length(liKo)-1].werte._tsiz; Transformationen.kopiereVon(liKo[length(liKo)-1].werte.Transformationen); 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.Transformationen.xstart<>liKo[0].werte.Transformationen.xstart then begin gibAus('Anfangspostionen passen nicht zusammen ('+floattostr(liKo[0].werte.Transformationen.xstart)+' bisher vs. '+floattostr(liKo[length(liKo)-1].werte.Transformationen.xstart)+' bei '+inttostr(i)+')!',3); exit; end; if liKo[length(liKo)-1].werte.Transformationen.xstop<>liKo[0].werte.Transformationen.xstop then begin gibAus('Endpostionen passen nicht zusammen ('+floattostr(liKo[0].werte.Transformationen.xstop)+' bisher vs. '+floattostr(liKo[length(liKo)-1].werte.Transformationen.xstop)+' bei '+inttostr(i)+')!',3); exit; end; if liKo[length(liKo)-1].werte.Transformationen.tstart<>liKo[0].werte.Transformationen.tstart then begin gibAus('Anfangszeiten passen nicht zusammen ('+floattostr(liKo[0].werte.Transformationen.tstart)+' bisher vs. '+floattostr(liKo[length(liKo)-1].werte.Transformationen.tstart)+' bei '+inttostr(i)+')!',3); exit; end; if liKo[length(liKo)-1].werte.Transformationen.tstop<>liKo[0].werte.Transformationen.tstop then begin gibAus('Endzeiten passen nicht zusammen ('+floattostr(liKo[0].werte.Transformationen.tstop)+' bisher vs. '+floattostr(liKo[length(liKo)-1].werte.Transformationen.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; Transformationen.addAusschnitt(xmin,xmax,tmin,tmax); _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,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 '+timetostr(now-Zeit),3); result:=true; end; function tWerte.berechneQuotient(st: boolean; var f: tMyStringlist; threads, dividend, divisor: longint): 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; Transformationen.kopiereVon(wertes^[dividend].Transformationen); _xsteps:=wertes^[dividend]._xsteps; xmin:=0; xmax:=_xsteps-1; _tsiz:=wertes^[dividend]._tsiz; tmin:=0; tmax:=_tsiz-1; _np:=wertes^[dividend]._np; _beta:=wertes^[dividend]._beta; epsilon:=1e-9; Zeit:=now; repeat if not f.readln(s) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; if s='Ende' then break; if startetMit('Name:',s) then begin bezeichner:=s; continue; end; if startetMit('xmin:',s) then begin xmin:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('xmax:',s) then begin xmax:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('tmin:',s) then begin tmin:=kont2disk('t',exprtofloat(st,s)); continue; end; if startetMit('tmax:',s) then begin tmax:=kont2disk('t',exprtofloat(st,s)); continue; end; if startetMit('epsilon:',s) then begin epsilon:=exprtofloat(st,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].Transformationen.xstart<>wertes^[divisor].Transformationen.xstart) or (wertes^[dividend].Transformationen.xstop<>wertes^[divisor].Transformationen.xstop) or (wertes^[dividend].Transformationen.tstart<>wertes^[divisor].Transformationen.tstart) or (wertes^[dividend].Transformationen.tstop<>wertes^[divisor].Transformationen.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; Transformationen.addAusschnitt(xmin,xmax,tmin,tmax); _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 '+timetostr(now-Zeit),3); result:=true; end; function tWerte.berechneProdukt(st: boolean; var f: tMyStringlist; threads, faktor1, faktor2: longint): boolean; var i,xmin,xmax,tmin,tmax: longint; s: string; fertig: boolean; produktThreads: array of tProduktThread; Zeit: extended; begin result:=false; warteaufBeendigungDesLeseThreads; Zeit:=now; Transformationen.kopiereVon(wertes^[faktor1].Transformationen); _xsteps:=wertes^[faktor1]._xsteps; xmin:=0; xmax:=_xsteps-1; _tsiz:=wertes^[faktor1]._tsiz; tmin:=0; tmax:=_tsiz-1; _np:=wertes^[faktor1]._np; _beta:=wertes^[faktor1]._beta; Zeit:=now; repeat if not f.readln(s) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; if s='Ende' then break; if startetMit('Name:',s) then begin bezeichner:=s; continue; end; if startetMit('xmin:',s) then begin xmin:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('xmax:',s) then begin xmax:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('tmin:',s) then begin tmin:=kont2disk('t',exprtofloat(st,s)); continue; end; if startetMit('tmax:',s) then begin tmax:=kont2disk('t',exprtofloat(st,s)); continue; end; gibAus('Verstehe Option '''+s+''' nicht bei Multipliziere!',3); exit; until false; _xsteps:=xmax-xmin+1; _tsiz:=tmax-tmin+1; if (wertes^[faktor1].Transformationen.xstart<>wertes^[faktor2].Transformationen.xstart) or (wertes^[faktor1].Transformationen.xstop<>wertes^[faktor2].Transformationen.xstop) or (wertes^[faktor1].Transformationen.tstart<>wertes^[faktor2].Transformationen.tstart) or (wertes^[faktor1].Transformationen.tstop<>wertes^[faktor2].Transformationen.tstop) or (wertes^[faktor1]._xsteps<>wertes^[faktor2]._xsteps) or (wertes^[faktor1]._tsiz<>wertes^[faktor2]._tsiz) then begin gibAus('Faktor1 und Faktor2 haben verschiedene Abmessungen, sowas verstehe ich nicht!',3); exit; end; Transformationen.addAusschnitt(xmin,xmax,tmin,tmax); _np:=wertes^[faktor1]._np; _beta:=wertes^[faktor1]._beta; Genauigkeit:=gExtended; if st then begin result:=true; exit; end; eWerte.holeRam(3); gibAus('Berechne ...',3); Zeit:=now; setlength(produktThreads,threads); for i:=0 to length(produktThreads)-1 do produktThreads[i]:=tProduktThread.create(wertes^[faktor1],wertes^[faktor2],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(produktThreads)-1 do fertig:=fertig and produktThreads[i].fertig; until fertig; for i:=0 to length(produktThreads)-1 do produktThreads[i].free; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.berechneKorrelation(st: boolean; var f: tMyStringlist; 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; pDo: pTLLWerteDouble; pEx: pTLLWerteExtended; begin result:=false; warteaufBeendigungDesLeseThreads; genauigkeit:=gExtended; wavelet:=tWavelet.create; wavelet.mitFFT:=false; Zeit:=now; Transformationen.kopiereVon(quelle.Transformationen); wavelet.freq:=0; wavelet.tfwhm:=1; wavelet.typ:=wtSin2; _xsteps:=quelle._xsteps; xmin:=0; xmax:=_xsteps-1; _tsiz:=quelle._tsiz; tmin:=0; tmax:=_tsiz-1; _np:=quelle._np; _beta:=quelle._beta; ausrichtung:=0; repeat if not f.readln(s) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; if s='Ende' then break; if startetMit('Name:',s) then begin bezeichner:=s; continue; end; if startetMit('xmin:',s) then begin xmin:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('xmax:',s) then begin xmax:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('tmin:',s) then begin tmin:=kont2disk('t',exprtofloat(st,s)); continue; end; if startetMit('tmax:',s) then begin tmax:=kont2disk('t',exprtofloat(st,s)); continue; end; if startetMit('freq:',s) then begin wavelet.freq:=1/kont2diskFak('t',1/exprtofloat(st,s)); continue; end; if startetMit('tfwhm:',s) then begin wavelet.tfwhm:=round(kont2diskFak('t',exprtofloat(st,s))); continue; end; if startetMit('Wavelettyp:',s) then begin if not wavelet.setzeTyp(s) then exit; continue; end; if startetMit('mit FFT',s) then begin wavelet.mitFFT:=true; 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; Transformationen.addAusschnitt(xmin,xmax,tmin,tmax); _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; gDouble: begin pDo:=@(quelle.dWerte); dWerte.kopiereVon(st,pDo,xmin,xmax,tmin,tmax); end; gExtended: begin pEx:=@(quelle.eWerte); eWerte.kopiereVon(st,pEx,xmin,xmax,tmin,tmax); end; end{of case}; gibAus('... fertig '+timetostr(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; wavelet.werte.params.refreshKnownValues; 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 '+timetostr(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,min(threads,xmax+1-xmin)); 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); if threads>_xsteps then threads:=_xsteps; end else begin if length(fen.Werte)<>xmax+1-xmin then fen.berechneWerte(xmax+1-xmin); if threads>_tsiz then threads:=_tsiz; 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: tMyStringlist; 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; transformationen.clear; Fenster.Breite:=0; Fenster.aktiv:=false; Fenster.Rand:=0; Schritt:=round(sqrt(quelle._tsiz)); tmin:=0; tmax:=quelle._tsiz-1; freqMax:=quelle._tsiz/(quelle.Transformationen.tstop-quelle.Transformationen.tstart); Genauigkeit:=gExtended; repeat if not f.readln(s) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; if s='Ende' then break; if startetMit('Name:',s) then begin bezeichner:=s; continue; end; if startetMit('Threadanzahl:',s) then begin threads:=strtoint(s); continue; end; if startetMit('Fenster:',s) then begin Fenster.Breite:=round(quelle.kont2diskFak('t',quelle.exprtofloat(st,erstesArgument(s,';')))); Fenster.Rand:=round(quelle.kont2diskFak('t',quelle.exprtofloat(st,s))); Fenster.aktiv:=true; continue; end; if startetMit('Schritt:',s) then begin Schritt:=round(quelle.kont2diskFak('t',quelle.exprtofloat(st,s))); continue; end; if (quelle._xsteps=1) then begin if startetMit('xmin:',s) then begin tmin:=quelle.kont2disk('x',quelle.exprtofloat(st,s)); continue; end; if startetMit('xmax:',s) then begin tmax:=quelle.kont2disk('x',quelle.exprtofloat(st,s)); continue; end; if startetMit('wmax:',s) or startetMit('omegamax:',s) or startetMit('ωmax:',s) then begin freqmax:=quelle.exprtofloat(st,s); continue; end; end; if (quelle._tsiz=1) then begin if startetMit('tmin:',s) then begin tmin:=quelle.kont2disk('t',quelle.exprtofloat(st,s)); continue; end; if startetMit('tmax:',s) then begin tmax:=quelle.kont2disk('t',quelle.exprtofloat(st,s)); continue; end; if startetMit('kmax:',s) then begin 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); _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(disk2kontFak('t',Fenster.Breite),2,true)+'>='+ floattostrtrunc(disk2kontFak('t',tmax-tmin+1),2,true)+')',3); exit; end; Transformationen.xsteps:=_xsteps; Transformationen.tsiz:=_tsiz; if quelle._tsiz<>1 then begin Transformationen.xstart:=quelle.disk2kont('t',tmin); // quelle._tstart + tmin/(quelle._tsiz-1)*(quelle._tstop-quelle._tstart); Transformationen.xstop:= quelle.disk2kont('t',tmax); // quelle._tstart + tmax/(quelle._tsiz-1)*(quelle._tstop-quelle._tstart); Transformationen.tstart:=0; Transformationen.tstop:=quelle.disk2kontFak('t',_tsiz-1); // _tsiz/(quelle._tsiz-1)*(quelle._tstop-quelle._tstart); end else begin Transformationen.xstart:=quelle.disk2kont('x',tmin); // _xstart:=quelle._xstart + tmin/(quelle._xsteps-1)*(quelle._xstop-quelle._xstart); Transformationen.xstop:= quelle.disk2kont('x',tmax); // _xstop:= quelle._xstart + tmax/(quelle._xsteps-1)*(quelle._xstop-quelle._xstart); Transformationen.tstart:=0; Transformationen.tstop:=quelle.disk2kontFak('x',_tsiz-1); // _tstop:=_tsiz/(quelle._xsteps-1)*(quelle._xstop-quelle._xstart); end; if not st then begin 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; gDouble: for i:=0 to _xsteps-1 do for j:=0 to Fenster.Breite-1 do begin eWerte.werte[i + (j+tOf)*_xsteps]:= quelle.dWerte.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; gibAus(' (Parseval-Fehler = '+floattostr(pvFehler)+')',3); end; Transformationen.addFFT(false,true); if (Transformationen.tstop<=freqmax) or (freqmax<=0) then _tsiz:=_tsiz div 2 else begin freqmax:=Transformationen.tstop * round((_tsiz div 2)/Transformationen.tstop*freqmax) / (_tsiz div 2); _tsiz:=round((_tsiz div 2)/Transformationen.tstop*freqmax); end; Transformationen.addAusschnitt(0,_xsteps-1,0,_tsiz-1); if not st then eWerte.holeRAM(0); gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.berechneVerzerrung(st: boolean; var f: tMyStringlist; threads: longint; const quelle: tWerte; Warn: tWarnstufe): boolean; var i,j: longint; grenzen: t2x2Longint; ZPs: tIntPointArray; // Zielpositionen ZGs: tExtPointArray; // Zielgewichte ZAs: tExtendedArray; // Anzahl Quellen, die auf entsprechende Zielposition abgebildet werden Zeit,epsilon: extended; Vorbearbeitung, Nachbearbeitung, verzerrung: tTransformationen; 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); Vorbearbeitung.free; Nachbearbeitung.free; verzerrung.free; setlength(ZPs,0); setlength(ZGs,0); setlength(ZAs,0); end; begin result:=false; warteaufBeendigungDesLeseThreads; gibAus('Verzerrung berechnen ... ',3); Zeit:=now; verzerrung:=tTransformationen.create; verzerrung.xsteps:=quelle._xsteps; verzerrung.tsiz:=quelle._tsiz; epsilon:=1e-9; Genauigkeit:=gExtended; Vorbearbeitung:=tTransformationen.create; Nachbearbeitung:=tTransformationen.create; repeat if not f.readln(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 startetMit('Name:',s) then begin bezeichner:=s; continue; end; if startetMit('Threadanzahl:',s) then begin threads:=strtoint(s); continue; end; if startetMit('Epsilon:',s) then begin epsilon:=exprtofloat(st,s); continue; end; if startetMit('Abbildung:',s) then begin if not verzerrung.add(st,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))+' -> '+ tExtPointToStr(verzerrung.transformiereKoordinaten(i*(quelle._xsteps-1),j*(quelle._tsiz-1))),3); end; continue; end; if startetMit('Nachbearbeitung:',s) then begin if not Nachbearbeitung.add(st,s,f,@exprtofloat) then begin aufraeumen; exit; end; continue; end; if startetMit('Vorbearbeitung:',s) then begin if not Vorbearbeitung.add(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; Transformationen.kopiereVon(quelle.Transformationen); Transformationen.append(Vorbearbeitung); Transformationen.append(Verzerrung); Transformationen.append(Nachbearbeitung); if not st then begin gibAus('... Zielausdehnung berechnen ... ',3); verzerrung.berechneZielausdehnung(grenzen); _xsteps:=grenzen['x','y']-grenzen['x','x']+2; _tsiz:=grenzen['y','y']-grenzen['y','x']+2; if (_xsteps<=1) or (_tsiz<=1) then begin gibAus('Es passt kein Rechteck des Ziels vollständig in die Quelldaten!',3); aufraeumen; exit; end; 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,Warn); 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 '+timetostr(now-Zeit),3); result:=true; end; function tWerte.berechneIntegral(st: boolean; var f: tMyStringlist; 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.readln(s) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; if s='Ende' then break; if startetMit('Name:',s) then begin bezeichner:=s; continue; end; if startetMit('Threadanzahl:',s) then begin threads:=strtoint(s); continue; end; if startetMit('xmin:',s) then begin xmin:=quelle.kont2disk('x',quelle.exprtofloat(st,s)); continue; end; if startetMit('xmax:',s) then begin xmax:=quelle.kont2disk('x',quelle.exprtofloat(st,s)); continue; end; if startetMit('tmin:',s) then begin tmin:=quelle.kont2disk('t',quelle.exprtofloat(st,s)); continue; end; if startetMit('tmax:',s) then begin tmax:=quelle.kont2disk('t',quelle.exprtofloat(st,s)); continue; end; if startetMit('Richtung:',s) then begin 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; gibAus('Verstehe Richtung '''+s+''' nicht bei Berechnung eines Integrals!',3); exit; 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); Transformationen.kopiereVon(quelle.Transformationen); Transformationen.addAusschnitt(xmin,xmax,tmin,tmax); if not st then begin _tsiz:=tmax-tmin+1; _xsteps:=xmax-xmin+1; 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 '+timetostr(now-Zeit),3); end; result:=true; end; function tWerte.berechneFFT(st: boolean; var f: tMyStringlist; 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.readln(s) then begin gibAus('Unerwartetes Dateiende!',3); end; if s='Ende' then break; if startetMit('Name:',s) then begin bezeichner:=s; continue; end; if startetMit('Nachbereitung:',s) then begin if not strToFftDo(NB,s) then exit; continue; end; if startetMit('Fenster:',s) then begin if senkrecht then Fenster.Rand:=round(kont2diskFak('t',exprtofloat(st,s))) else Fenster.Rand:=round(kont2diskFak('x',exprtofloat(st,s))); 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; if senkrecht then begin i:=1; while 2*i<=_tsiz do i:=i*2; Transformationen.addAusschnitt(0,_xsteps-1,(_tsiz-i) div 2,((_tsiz+i) div 2) - 1); if not st then begin gibAus('Die Länge wird von '+inttostr(_tsiz)+' auf '+inttostr(i)+' Zeitschritte gekürzt!',3); _tsiz:=i; end; end else begin i:=1; while 2*i<=_xsteps do i:=i*2; Transformationen.addAusschnitt((_xsteps-i) div 2,((_xsteps+i) div 2) - 1,0,_tsiz-1); if not st then begin gibAus('Die Länge wird von '+inttostr(_xsteps)+' auf '+inttostr(i)+' Ortsschritte gekürzt!',3); _xsteps:=i; end; end; Transformationen.addFFT(not senkrecht,senkrecht); if not st then begin eWerte.holeRam(0); gibAus('... fertig! '+timetostr(now-Zeit),3); end; result:=true; end; function tWerte.berechneFFT2d(st: boolean; var f: tMyStringlist; 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.readln(s) then begin gibAus('Unerwartetes Dateiende!',3); end; if s='FFTEnde' then break; if startetMit('Name:',s) then begin bezeichner:=s; continue; end; if startetMit('Nachbereitung:',s) then begin 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)); s:=trim(s); if b then Fensters[b].Rand:=round(kont2diskFak('t',exprtofloat(st,s))) else Fensters[b].Rand:=round(kont2diskFak('x',exprtofloat(st,s))); 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); Transformationen.addAusschnitt(0,_xsteps-1,(_tsiz-i) div 2,((_tsiz+i) div 2) - 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); Transformationen.addAusschnitt((_xsteps-i) div 2,((_xsteps+i) div 2) - 1,0,_tsiz-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; Transformationen.addFFT(true,true); gibAus('... fertig! '+timetostr(now-Zeit),3); if spiegeln then begin gibAus('Werte spiegeln ...',3); spiegle(threads); gibAus('... fertig! '+timetostr(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); gibAus('... fertig! '+timetostr(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); gibAus('... fertig! '+timetostr(now-Zeit),3); gibAus('Wertenachbearbeiten ...',3); case genauigkeit of gSingle: sWerte.fft2dNachbearbeitungA(NB); gDouble: dWerte.fft2dNachbearbeitungA(NB); gExtended: eWerte.fft2dNachbearbeitungA(NB); end{of case}; case NB of doBetr,doBetrQdr: fft2dNachbearbeitung(threads,nb); // die Hauptarbeit end{of case}; gibAus('... fertig! '+timetostr(now-Zeit),3); result:=true; end; function tWerte.erzeugeLinearesBild(st: boolean; var f: tMyStringlist; 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: tTransformationen; 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 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 aus '+bezeichner+' ...',3); datei:=''; xzoom:=1; yzoom:=1; xmin:=0; xmax:=_xsteps-1; tmin:=0; tmax:=_tsiz-1; schriftgroesze:=24; Nachbearbeitung:=tTransformationen.create; findePalette(Palette,'Graustufen'); setlength(Achsen,0); setlength(verwKonturen,0); setlength(beschriftungen,0); setlength(BilderThreads,0); Rahmen:=false; fontRenderer:=nil; repeat if not f.readln(s) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); aufraeumen; exit; end; if startetMit('Datei:',s) then begin datei:=s; continue; end; if startetMit('Vergrößerung:',s) then begin xzoom:=exprtofloat(st,s); yzoom:=exprtofloat(st,s); continue; end; if startetMit('x-Vergrößerung:',s) then begin xzoom:=exprtofloat(st,s); continue; end; if startetMit('t-Vergrößerung:',s) then begin yzoom:=exprtofloat(st,s); continue; end; if self.dichtenParameterErkannt(st,s,maxThreads,xmin,xmax,tmin,tmax) then continue; if startetMit('xmin:',s) then begin xmin:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('xmax:',s) then begin xmax:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('tmin:',s) then begin tmin:=kont2disk('t',exprtofloat(st,s)); continue; end; if startetMit('tmax:',s) then begin tmax:=kont2disk('t',exprtofloat(st,s)); continue; end; if startetMit('Palette:',s) then begin if not findePalette(Palette,s) then begin gibAus('Kenne Palette '''+s+''' nicht!',3); aufraeumen; exit; end; continue; end; if startetMit('Schriftgröße:',s) then begin schriftgroesze:=strtoint(s); continue; end; if s='Rahmen' then begin Rahmen:=true; continue; end; if startetMit('Nachbearbeitung:',s) then begin if not Nachbearbeitung.add(st,s,f,@exprtofloat) then begin aufraeumen; exit; end; continue; end; if startetMit('Legende:',s) then begin if not erzeugeLegende(st,f,s,self,_minW,_maxW,Nachbearbeitung,Palette) then begin aufraeumen; exit; end; continue; end; if startetMit('Achse:',s) then begin setlength(Achsen,length(Achsen)+1); if startetMit('oben',s) then Achsen[length(Achsen)-1].Lage:=lOben else if startetMit('unten',s) then Achsen[length(Achsen)-1].Lage:=lUnten else if startetMit('links',s) then Achsen[length(Achsen)-1].Lage:=lLinks else if startetMit('rechts',s) then Achsen[length(Achsen)-1].Lage:=lRechts else begin gibAus('Ungültiger Parameter '''+s+''' für eine Achse!',3); aufraeumen; exit; end; if endetMit('+',s) then Achsen[length(Achsen)-1].faktor:=1/2 else if endetMit('-',s) then Achsen[length(Achsen)-1].faktor:=2 else Achsen[length(Achsen)-1].faktor:=1; Achsen[length(Achsen)-1].Striche:=strtoint(s); continue; end; if startetMit('Kontur:',s) then begin while length(s)>0 do begin setlength(verwKonturen,length(verwKonturen)+1); verwKonturen[length(verwKonturen)-1]:=findeKontur(erstesArgument(s),Konturen,false); if (verwKonturen[length(verwKonturen)-1]<0) or (verwKonturen[length(verwKonturen)-1]>=length(Konturen^)) then begin gibAus('Die Kontur gibt es nicht!',3); aufraeumen; exit; end; 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(Transformationen.xstart)+'-'+floattostr(Transformationen.xstop)+' x '+floattostr(Transformationen.tstart)+'-'+floattostr(Transformationen.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 *) if Achsen[i].Lage in [lOben,lUnten] then begin maw:=disk2kont('x',xMax); miw:=disk2Kont('x',xMin); end else begin maw:=disk2kont('t',tMax); miw:=disk2kont('t',tMin); 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); position:=Transformationen.transformiereKoordinaten(Achsen[i].Lage,wert); if (position<0) or (position>1) then begin gibAus('Der Wert '+floattostr(wert)+' liegt außerhalb des Bildes ('+floattostr(position)+') - das sollte eigentlich nicht passieren!',3); beschriftungen[length(beschriftungen)-1].free; setlength(beschriftungen,length(beschriftungen)-1); end else begin if lage in [lOben,lUnten] then position:=position*bBreite else position:=position*bHoehe; inhalt:=floattostr(wert); end; 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:=kont2disk('x',konturen^[verwKonturen[i]].orte[j]['x']); tp:=kont2disk('t',konturen^[verwKonturen[i]].orte[j]['y']); 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 '+timetostr(now-Zeit),3); end; function tWerte.erzeugeAscii(st: boolean; var f: tMyStringlist): 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.readln(s) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); exit; end; if startetMit('Datei:',s) then begin datei:=s; continue; end; if startetMit('xmin:',s) then begin xmin:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('xmax:',s) then begin xmax:=kont2disk('x',exprtofloat(st,s)); continue; end; if startetMit('tmin:',s) then begin tmin:=kont2disk('t',exprtofloat(st,s)); continue; end; if startetMit('tmax:',s) then begin tmax:=kont2disk('t',exprtofloat(st,s)); 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 startetMit('Separator:',s) then begin 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; gDouble: 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(dWerte.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(disk2kont('x',i))+separator+floattostr(sWerte.werte[i])); gDouble: for i:=max(0,xmin) to min(_xsteps-1,xmax) do writeln(outf,floattostr(disk2kont('x',i))+separator+floattostr(dWerte.werte[i])); gExtended: for i:=max(0,xmin) to min(_xsteps-1,xmax) do writeln(outf,floattostr(disk2kont('x',i))+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(disk2kont('t',i))+separator+floattostr(sWerte.werte[i])); gDouble: for i:=max(0,tmin) to min(_tsiz-1,tmax) do writeln(outf,floattostr(disk2kont('t',i))+separator+floattostr(dWerte.werte[i])); gExtended: for i:=max(0,tmin) to min(_tsiz-1,tmax) do writeln(outf,floattostr(disk2kont('t',i))+separator+floattostr(eWerte.werte[i])); end{of Case}; 3: case Genauigkeit of gSingle: writeln(outf,floattostr(disk2kont('x',0))+separator+floattostr(disk2kont('t',0))+separator+floattostr(sWerte.werte[0])); gDouble: writeln(outf,floattostr(disk2kont('x',0))+separator+floattostr(disk2kont('t',0))+separator+floattostr(dWerte.werte[0])); gExtended: writeln(outf,floattostr(disk2kont('x',0))+separator+floattostr(disk2kont('t',0))+separator+floattostr(eWerte.werte[0])); end{of Case}; end{of Case}; close(outf); gibAus('... fertig '+timetostr(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; b1,b2: boolean; begin result:=false; warteaufBeendigungDesLeseThreads; Zeit:=now; if not st then begin gibAus('erzeuge Lineout ...',3); gibAus('insgesamt: '+floattostr(Transformationen.xstart)+'..'+floattostr(Transformationen.xstop)+' x '+floattostr(Transformationen.tstart)+'..'+floattostr(Transformationen.tstop),3); end; for b1:=false to true do for b2:=false to true do ab[b1,b2]:=0; params:=trim(params); if startetMit('integriere ',params) then begin if startetMit('horizontal',params) then b1:=true else if startetMit('vertikal',params) then b1:=false else exit; if st then begin result:=true; exit; end; if b1 then s:='horizontal' else s:='vertikal'; gibAus('... schreibe in '''+params+''', integriere '+s,3); if pos(' ',params)>0 then begin gibAus('Leerzeichen im Dateinamen sind nicht erlaubt!',3); exit; end; assignFile(f,params); rewrite(f); for i:=0 to _xsteps*byte(not b1)+_tsiz*byte(b1)-1 do schreibeWertIntegriert(f,i,b1); closefile(f); end else begin for b1:=false to true do if startetMit('(',params) then begin s:=erstesArgument(params,','); ab[b1,false]:=kont2disk('x',exprtofloat(st,s)); s:=erstesArgument(params,')'); ab[b1,true]:=kont2disk('t',exprtofloat(st,s)); end else begin ab[true,false]:=ab[false,false]; ab[true,true]:=ab[false,true]; ab[false,false]:=(_xsteps-1)*byte(not b1); ab[false,true]:=(_tsiz-1)*byte(not b1); end; if st then begin result:=true; exit; end; if pos(' ',params)>0 then begin gibAus('Leerzeichen im Dateinamen sind nicht erlaubt!',3); 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); end; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.erzeugeBinning(st: boolean; params: string): boolean; var senkrecht,linien: boolean; Zeit,x0,dx: extended; begin result:=false; warteaufBeendigungDesLeseThreads; Zeit:=now; if not st then begin gibAus('erzeuge Binning ...',3); gibAus('insgesamt: '+floattostr(Transformationen.xstart)+'..'+floattostr(Transformationen.xstop)+' x '+floattostr(Transformationen.tstart)+'..'+floattostr(Transformationen.tstop),3); end; senkrecht:=Transformationen.xstart=Transformationen.xstop; if (not senkrecht) and (Transformationen.tstart<>Transformationen.tstop) then begin gibAus('Binning geht nur auf eindimensionalen Daten!',3); exit; end; params:=trim(params); linien:=startetMit('(Gnuplotlinien)',params); x0:=kont2disk(char(ord('x')+byte(senkrecht)),exprtofloat(st,erstesArgument(params))); dx:=kont2diskFak(char(ord('x')+byte(senkrecht)),exprtofloat(st,erstesArgument(params))); if pos(' ',params)>0 then begin gibAus('Leerzeichen im Dateinamen sind nicht erlaubt!',3); exit; end; if not st then case Genauigkeit of gSingle: sWerte.erzeugeBinning(senkrecht,linien,x0,dx,params); gDouble: dWerte.erzeugeBinning(senkrecht,linien,x0,dx,params); gExtended: eWerte.erzeugeBinning(senkrecht,linien,x0,dx,params); end{of case}; gibAus('... fertig '+timetostr(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); gDouble: dWerte.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; Transformationen.AddSpiegelung; 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 startetMit('Kontur[',s) or startetMit('Konturen[',s) then begin if pos('].',s)=0 then begin gibAus('Syntaxfehler, '']'' fehlt!',3); exit; end; i:=findeKontur(erstesArgument(s,'].'),Konturen,false); if i<0 then begin gibAus('Finde Kontur nicht!',3); exit; end; 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; if startetMit('Wert[',s) or startetMit('Werte[',s) or startetMit('Wertes[',s) then begin if pos('].',s)=0 then begin gibAus('Syntaxfehler, '']'' fehlt!',3); exit; end; i:=findeWerte(erstesArgument(s,'].'),wertes,Konturen,false); if i<0 then begin gibAus('Finde Werte nicht!',3); exit; end; if s='xmin' then result:=wertes^[i].Transformationen.xstart else if s='xmax' then result:=wertes^[i].Transformationen.xstop else if s='tmin' then result:=wertes^[i].Transformationen.tstart else if s='tmax' then result:=wertes^[i].Transformationen.xstop else if (s='wmin') or (s='minw') then result:=wertes^[i]._minw else if (s='wmax') or (s='maxw') then result:=wertes^[i]._maxw else if s='Breite' then result:=wertes^[i].Transformationen.xstart-wertes^[i].Transformationen.xstop else if s='Hoehe' then result:=wertes^[i].Transformationen.tstart-wertes^[i].Transformationen.tstop else gibAus('Kenne Bezeichner '''+s+''' nicht als Eigenschaft von Werten!',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:=matheunit.exprtofloat(st,s,swerte.params.knownValues,@callBackGetValue); gDouble: result:=matheunit.exprtofloat(st,s,dwerte.params.knownValues,@callBackGetValue); gExtended: result:=matheunit.exprtofloat(st,s,ewerte.params.knownValues,@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; function tWerte.Transformationen: tTransformationen; begin case genauigkeit of gSingle: result:=sWerte.params.transformationen; gDouble: result:=dWerte.params.transformationen; gExtended: result:=eWerte.params.transformationen; end{of case}; end; // tLogThread ****************************************************************** constructor tLogThread.create; begin inherited create(true); raisedException:=nil; freeonterminate:=false; fertig:=false; end; destructor tLogThread.destroy; begin raisedException.free; if (not behalteLogs) and not odd(__ausgabenMaske) then cleanupLog(ThreadID); inherited destroy; end; function tLogThread.rFertig: boolean; begin if assigned(raisedException) then raise exception.Create('Fehler innerhalb eines Threads!'); result:=_fertig; end; procedure tLogThread.execute; begin try stExecute; except on E: exception do begin dumpExceptionCallStack(E); raisedException:=E; end; end; fertig:=true; end; // tLiKoThread ***************************************************************** constructor tLiKoThread.create(lk: pTLiKo; pWerte: tWerte; xMin,xMax,tMin,tMax,xOff,tOff: longint); begin inherited create; liKo:=lk; pW:=pWerte; xMi:=xMin; xMa:=xMax; tMi:=tMin; tMa:=tMax; tOf:=tOff; xOf:=xOff; gibAus('Starte LiKo-Berechnungsthread!',1); suspended:=false; end; destructor tLiKoThread.destroy; begin inherited destroy; 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; gDouble: 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.dWerte.werte[(xOf+i) + (tOf+j)*liKo^[k].werte._xsteps]; in0:=in0 and (liKo^[k].werte.dWerte.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; destructor tQuotientThread.destroy; begin inherited destroy; end; procedure tQuotientThread.stExecute; var i,j: longint; i01,i02,o0: boolean; begin gibAus('Quotient-Berechnungsthread gestartet ...',1); i01:=true; i02:=true; o0:=true; case dend.Genauigkeit of gSingle: case sor.Genauigkeit of gSingle: // 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 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 farben[i-xpmi+(j+oof)*breite].rgbGreen:=farben[i-xpmi+(j+oof)*breite].rgbRed; farben[i-xpmi+(j+oof)*breite].rgbBlue:=farben[i-xpmi+(j+oof)*breite].rgbRed; 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; // 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; destructor tDichteThread.destroy; begin inherited destroy; end; procedure tDichteThread.stExecute; begin gibAus('Dichtethread gestartet!',1); case w.Genauigkeit of gSingle: w.sWerte.gibMinMaxDichten(minDichte,maxDichte,xmin,xmax,tmin,tmax); gDouble: w.dWerte.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; destructor tFFTThread.destroy; begin inherited destroy; 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); gDouble: erfolg:=pW.dWerte.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; destructor tSpiegelThread.destroy; begin inherited destroy; end; procedure tSpiegelThread.stExecute; begin gibAus('Spiegelthread gestartet: '+inttostr(tMin)+'-'+inttostr(tMax)+' ...',1); case pW.Genauigkeit of gSingle: pW.sWerte.spiegle(tMin,tMax); gDouble: pW.dWerte.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; destructor tFFT2dNBThread.destroy; begin inherited destroy; 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); gDouble: pW.dWerte.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; destructor tKorrelThread.destroy; begin inherited destroy; 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 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; gDouble: 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.dWerte.werte[i+xOf+(j+k+tOf)*qu._xsteps]*wl.werte.werte[(k+wl.hlen)*2]; sus:=sus + qu.dWerte.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.dWerte.werte[i+xOf+(j+tOf)*qu._xsteps]=0); out0:=out0 and (zi.eWerte.werte[i+j*zi._xsteps]=0); end; end; 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; 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: tMyStringlist; 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.readln(s) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); exit; end; if startetMit('Farbe:',s) then begin 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 startetMit('Datei:',s) then begin if length(orte)>0 then begin gibAus('Diese Kontur hat schon Werte!',3); exit; end; if not liesVonDatei(st,s,strtofloat(xmi),strtofloat(xma),strtofloat(tmi),strtofloat(tma)) then exit; continue; end; if startetMit('Werte:',s) then begin if length(orte)>0 then begin gibAus('Diese Kontur hat schon Werte!',3); exit; end; if not erzeugeAusWerten(st,s,w,mt,xmi,xma,tmi,tma) then exit; continue; end; if startetMit('Name:',s) then begin bezeichner:=s; continue; end; if startetMit('xmin:',s) then begin xmi:=s; continue; end; if startetMit('xmax:',s) then begin xma:=s; continue; end; if startetMit('tmin:',s) then begin tmi:=s; continue; end; if startetMit('tmax:',s) then begin tma:=s; continue; end; if startetMit('reduziere nach ',s) then begin 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 jxma) or (tmp['y']tma) 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(erstesArgument(s),w,nil,false); if i<0 then exit; Schwelle:=w^[i].exprtofloat(false,s); if _xmin='' then xmi:=1 else xmi:=max(1,w^[i].kont2disk('x',w^[i].exprtofloat(st,_xmin))); if _xmax='' then xma:=w^[i]._xsteps-1 else xma:=max(1,w^[i].kont2disk('x',w^[i].exprtofloat(st,_xmax))); if _tmin='' then tmi:=1 else tmi:=max(1,w^[i].kont2disk('t',w^[i].exprtofloat(st,_tmin))); if _tmax='' then tma:=w^[i]._tsiz-1 else tma:=max(1,w^[i].kont2disk('x',w^[i].exprtofloat(st,_tmax))); 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); gDouble: punkte:=w.dWerte.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; destructor tIntegralThread.destroy; begin inherited destroy; 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); gDouble: zi.sWerte.integriereDouble(@(qu.dWerte),xmi,xma,tmi,tma,xof,tof,rtg); gExtended: zi.sWerte.integriereExtended(@(qu.eWerte),xmi,xma,tmi,tma,xof,tof,rtg); end{of case}; gDouble: case qu.Genauigkeit of gSingle: zi.dWerte.integriereSingle(@(qu.sWerte),xmi,xma,tmi,tma,xof,tof,rtg); gDouble: zi.dWerte.integriereDouble(@(qu.dWerte),xmi,xma,tmi,tma,xof,tof,rtg); gExtended: zi.dWerte.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); gDouble: zi.eWerte.integriereDouble(@(qu.dWerte),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; destructor tSortiereNachYThread.destroy; begin inherited destroy; 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(st: boolean; cmd: string; out erfolg: boolean); function shellParseNextArg(var s: string): string; var err: longint; sr: tSearchRec; begin if length(s)=0 then begin erfolg:=false; exit; end; if startetMit('"',s) then begin if pos('"',s)=0 then begin erfolg:=false; exit; end; result:=erstesArgument(s,'"'); end else begin result:=stringReplace(erstesArgument(s),'$$DATETIME',mydatetimetostr(now),[rfReplaceAll]); if pos('*',result)>0 then begin err:=findFirst(result,$3F,sr); if err=0 then begin result:=extractfilepath(result)+sr.Name; err:=findNext(sr); while err=0 do begin s:=trim('"'+extractfilepath(result)+sr.Name+'" '+s); err:=findNext(sr); end; end; findClose(sr); end; end; if startetMit('./',result) then result:=extractfilepath(paramstr(0))+result; end; begin inherited create; erfolg:=true; bg:=endetMit('&',cmd); if not st then begin p:=tProcess.create(nil); p.Options:=p.Options + [poWaitOnExit]; p.Executable:=shellParseNextArg(cmd); end else shellParseNextArg(cmd); if not erfolg then begin if not st then p.free; exit; end; while length(cmd)>0 do begin if st then shellParseNextArg(cmd) else p.Parameters.Add(shellParseNextArg(cmd)); if not erfolg then begin if not st then p.free; exit; end; end; if st then exit; 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 tPhaseSpaceInputDateiInfo then begin inputs[i]:=tPhaseSpaceInputDateiInfo.create(inps[i]); continue; end; 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; gDouble: if not w.dWerte.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: tTransformationen; zielpositionen: tIntPointArray; zielgewichte: tExtPointArray; Warn: tWarnstufe); 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; Warnstufe:=Warn; gibAus('VerzerrInitThread kreiert',1); suspended:=false; end; destructor tVerzerrInitThread.destroy; begin setlength(ZAs,0); inherited destroy; 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,Warnstufe); gibAus('VerzerrInitThread beendet',1); end; // tVerzerrThread ************************************************************** constructor tVerzerrThread.create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax: longint; zielpositionen: tIntPointArray; zielgewichte: tExtPointArray; zielanzahlen: tExtendedArray; Vorbearbeitungen,Nachbearbeitungen: tTransformationen); 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; destructor tVerzerrThread.destroy; begin inherited destroy; end; procedure tVerzerrThread.stExecute; var sw: pTLLWerteSingle; dw: pTLLWerteDouble; ew: pTLLWerteExtended; begin gibAus('Verzerrthread gestartet '+floattostr(qu._minW)+' '+floattostr(qu._maxW),1); case qu.genauigkeit of gSingle: begin sw:=@(qu.sWerte); dw:=nil; ew:=nil; end; gDouble: begin sw:=nil; dw:=@(qu.dWerte); ew:=nil; end; gExtended: begin sw:=nil; dw:=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); gDouble: zi.sWerte.kopiereVerzerrt(dw,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}; gDouble: case qu.genauigkeit of gSingle: zi.dWerte.kopiereVerzerrt(sw,ZPs,ZGs,ZAs,xMi,xMa,tMi,tMa,vb,nb); gDouble: zi.dWerte.kopiereVerzerrt(dw,ZPs,ZGs,ZAs,xMi,xMa,tMi,tMa,vb,nb); gExtended: zi.dWerte.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); gDouble: zi.eWerte.kopiereVerzerrt(dw,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); 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: tMyStringlist; datei: string; Qu: tWerte; minDichte,maxDichte: extended; nb: tTransformationen; 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.readln(s) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); exit; end; if startetMit('Ausrichtung:',s) then begin waagerecht:=s='waagerecht'; if (s='waagerecht') or (s='senkrecht') then continue; gibAus(''''+s+''' ist keine gültige Ausrichtung!',3); exit; end; if startetMit('Breite:',s) then begin breite:=strtoint(s); continue; end; if startetMit('Höhe:',s) then begin hoehe:=strtoint(s); continue; end; if startetMit('Schriftgröße:',s) then begin 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.readln(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 startetMit('linear',s) then beschriftungsschritte[length(beschriftungsschritte)-1].linear:=true; if startetMit('logarithmisch',s) then begin 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] is tWerteLogTransformation then begin if (nb[i] as tWerteLogTransformation).logMin<>minDichte then begin gibAus('Die minimale Dichte der logarithmischen Farbskala ('+myfloattostr(minDichte)+') und der logarithmischen Nachbearbeitung ('+myfloattostr((nb[i] as tWerteLogTransformation).logMin)+') stimmen nicht überein!',3); exit; end; minDichte:=minDichte*maxDichte; break; end; end; s:=trim(s); beschriftungsschritte[length(beschriftungsschritte)-1].bis:=Qu.exprtofloat(st,erstesArgument(s)); if endetMit('+',s) then beschriftungsschritte[length(beschriftungsschritte)-1].faktor:=0.5 else if endetMit('-',s) then beschriftungsschritte[length(beschriftungsschritte)-1].faktor:=2 else beschriftungsschritte[length(beschriftungsschritte)-1].faktor:=1; beschriftungsschritte[length(beschriftungsschritte)-1].schritte:=strtoint(s); until false; continue; end; if s='Ende' 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 tmp0 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 wert:=nb.transformiereWert(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<0) or (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 not darfErstellen then begin gibAus('Ich habe Werte '''+s+''' nicht gefunden und darf sie auch nicht erstellen!',3); result:=-1; exit; end; setlength(pws^,length(pws^)+1); pws^[length(pws^)-1]:=tWerte.create(Kont,pws); 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:=trimAll(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<0) or (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 not darfErstellen then begin gibAus('Ich habe Konturen '''+s+''' nicht gefunden und darf sie auch nicht erstellen!',3); result:=-1; exit; 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: tMyStringlist): 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.readln(s) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); exit; end; if s='Ende' then break; if startetMit('Name:',s) then begin 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(st,s,result); if st then exit; if not result then begin try bt.free; except end; 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.