unit epostunit; {$mode objfpc}{$H+} interface uses classes, sysutils, mystringlistunit, werteunit, typenunit, process, lowlevelunit, matheunit, fftunit, randomunit; 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 = class private farben: array[boolean] of tRGBArray; public name: string; constructor create; constructor create(original: tPalette); destructor destroy; override; procedure kopiereVon(original: tPalette); function neuerWert(s: string; imPart: boolean): boolean; overload; function neuerWert(farbe: tRGB; imPart: boolean): boolean; overload; function wertZuFarbe(x: extended; imPart: boolean = false): tRGB; inline; end; tPalettenArray = array of tPalette; tWerte = class; tLiKo = array of record alpha: extended; werte: tWerte; end; pTLiKo = ^tLiKo; pTWerteArray = ^tWerteArray; tWerteArray = array of tWerte; tKontur = class; tKonturenArray = array of tKontur; pTKonturenArray = ^tKonturenArray; tDatenVorfahr = class(tObject) bezeichner: string; konturen: pTKonturenArray; wertes: pTWerteArray; constructor create(kont: pTKonturenArray; wert: pTWerteArray); function callBackGetValue(s: string): extended; end; tKontur = class(tDatenVorfahr) private function rxmin: extended; function rxmax: extended; function rtmin: extended; function rtmax: extended; function sortiereNachY(mT: longint): boolean; overload; function sortiereNachY(mT,von,bis: longint): boolean; overload; function exprToFloat(sT: boolean; s: string; kvs: tKnownValues): extended; public orte: tExtPointArray; function init(sT: boolean; 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; function erzeugeAusFunktion(sT: boolean; s: string; xMi,xMa,tMi,tMa,dx,dt: extended; mT: longint): boolean; property xMin: extended read rxmin; property xMax: extended read rxmax; property tMin: extended read rtmin; property tMax: extended read rtmax; constructor create(kont: pTKonturenArray; wert: pTWerteArray); destructor destroy; override; end; tLeseThread = class; tWerte = class(tDatenVorfahr) { 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(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: tTransformation; verzerrAnzahl: longint; zPs: tIntPointArray; zGs: tExtPointArray; zAs: tExtendedArray; Warn: tWarnstufe); function rTransformationen: tTransformation; procedure wTransformationen(tr: tTransformation); 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 istKomplex: boolean; function xScale: extended; function tScale: extended; function dichtenParameterErkannt(sT: boolean; s: string; var bekannteBefehle: tMyStringList; threads,xMin,xMax,tMin,tMax: longint): boolean; function kont2disk(senkrecht: boolean; x: extended): longint; overload; inline; function kont2disk(dir: char; x: extended): longint; overload; function kont2diskFak(senkrecht: boolean; x: extended): extended; overload; inline; function kont2diskFak(dir: char; x: extended): extended; overload; function disk2kont(dir: char; x: longint): extended; function disk2kontFak(senkrecht: boolean; x: longint): extended; overload; inline; function disk2kontFak(dir: char; x: longint): extended; overload; procedure schreibeWertIntegriert(var f: textfile; i: longint; hor: boolean); procedure holeRAM(ausgaben: byte); inline; public eWerte: tLLWerteExtended; dWerte: tLLWerteDouble; sWerte: tLLWerteSingle; genauigkeit: tGenauigkeit; 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; f: tMyStringList; pl,sA: boolean): boolean; function ladeAscii(sT: boolean; datei: string): boolean; function berechneLiKo(sT: boolean; f: tMyStringList; threads: longint): boolean; function berechneAgglomeration(sT: boolean; var f: tMyStringList): boolean; function berechneQuotient(sT: boolean; f: tMyStringList; threads, dividend, divisor: longint): boolean; function berechneProdukt(sT: boolean; f: tMyStringList; threads, faktor1, faktor2: longint): boolean; function berechneKorrelation(sT: boolean; f: tMyStringList; threads: longint; 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; procedure gleicheMinMaxDichtenAn(sT: boolean; f: tMyStringList; symmetrisch: boolean); function fft(threads: longint; senkrecht,invers: boolean; const vor,nach: tFFTDatenordnung; fen: tFenster; hg: extended; out pvFehler: extended; Warn: tWarnstufe): boolean; overload; procedure initFuerGauszFit(sT: boolean; daten: tWerte; senkrecht: boolean; adLaenge: longint; adStart,adStop: extended); function fitteGausze(sT: boolean; f: tMyStringList; threads: longint): boolean; function berechneZeitfrequenzanalyse(sT: boolean; f: tMyStringList; threads: longint; quelle: tWerte; Warn: tWarnstufe): boolean; function berechneVerzerrung(sT: boolean; f: tMyStringList; threads: longint; quelle: tWerte; Warn: tWarnstufe): boolean; function berechneLambdaZuOmegaVerzerrung(sT: boolean; f: tMyStringList; threads: longint; quelle: tWerte): boolean; function entferneArtefakte(sT: boolean; f: tMyStringList; threads: longint): boolean; function extrahiereEinhuellende(sT: boolean; f: tMyStringList; threads: longint; Warn: tWarnstufe): boolean; function extrahierePhase(sT: boolean; f: tMyStringList; threads: longint; Warn: tWarnstufe): boolean; function macheKomplex(sT: boolean; f: tMyStringList; threads: longint): boolean; function berechneIntegral(sT: boolean; f: tMyStringList; threads: longint; quelle: tWerte): boolean; function berechneFFT(sT: boolean; f: tMyStringList; threads: longint; Warn: tWarnstufe): boolean; function berechneFFT2d(sT: boolean; f: tMyStringList; threads: longint; Warn: tWarnstufe): boolean; function erzeugeLinearesBild(sT: boolean; var f: tMyStringList; maxThreads: longint): boolean; function erzeugeAscii(sT: boolean; 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 fuelleMitDummys(sT: boolean); procedure verschiebe(threads: longint; richtung: tIntPoint); procedure ermittlePhasenWinkel(threads: longint); procedure fft2dNachbearbeitung(threads: longint; nB: tFFTDatenordnung); procedure schreibeWert(var f: textfile; x,y: longint); function exprToFloat(sT: boolean; s: string): extended; function paramsDump: string; procedure beendeLeseThreadWennFertig; property transformationen: tTransformation read rTransformationen write wTransformationen; 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; tZuZeichnendeKontur = class farbe: tRGB; deckKraft,dicke: extended; kontur: tKontur; constructor create; overload; constructor create(original: tZuZeichnendeKontur; kont: tKontur); overload; destructor destroy; override; end; tLogThread = class(tThread) private _fertig: boolean; raisedException: exception; function rFertig: boolean; public erfolg: boolean; 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); 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); 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); procedure stExecute; override; end; tBilderThread = class(tLogThread) nummer,mT,breite,wBreite,hoehe, wHoehe,gesBreite,lOf,oOf,rOf,uOf: longint; ws: tWerteArray; xMi,xMa,tMi,tMa,xPMi,xPMa: longint; xZ,yZ: extended; nbs: tTransformationArray; farben: tRGBArray; istKomplex: array of boolean; wertes: array of tExtendedArray; anzahlens: array of tLongintArray; pals: array of tPalette; rahmen: boolean; beschr: pTBeschriftungen; constructor create(i,maxThreads,iBreite,iHoehe,lO,oO,rO,uO: longint; const wes: tWerteArray; xMin,xMax,tMin,tMax: longint; xZoom,yZoom: extended; nachbearbeitungen: tTransformationArray; paletten: tPalettenArray; beschri: pTBeschriftungen; rm: boolean); destructor destroy; override; procedure stExecute; override; procedure initAnzahlensFuerKontur; end; tDichteThread = class(tLogThread) maxDichte,minDichte: extended; xMin,xMax,tMin,tMax: longint; w: tWerte; constructor create(xMi,xMa,tMi,tMa: longint; const werte: tWerte); procedure stExecute; override; end; tSpiegelThread = class(tLogThread) tMin,tMax: longint; pW: tWerte; constructor create(tMi,tMa: longint; pWerte: tWerte); procedure stExecute; override; end; tFFT2dNBThread = class(tLogThread) xMin,xMax: longint; pW: tWerte; nB: tFFTDatenordnung; constructor create(xMi,xMa: longint; pWerte: tWerte; endordnung: tFFTDatenordnung); procedure stExecute; override; end; tFFTThread = class(tLogThread) sMi,sMa: longint; fen: tFenster; sen,inv: boolean; algo: tFFTAlgorithmus; pW: tWerte; pvFehler,hg: extended; constructor create(werte: tWerte; sMin,sMax: longint; senkrecht,invers: boolean; const vor,nach: tFFTDatenordnung; fenster: tFenster; hintergrund: extended); overload; constructor create(werte: tWerte; sMin,sMax: longint; senkrecht,invers: boolean; algorithmus: tFFTAlgorithmus; fenster: tFenster; hintergrund: extended); overload; procedure stExecute; override; end; tGauszFitThread = class(tLogThread) qu: tWerte; ampl,br,posi,ueberl,hint: pTLLWerteExtended; vo,bi: longint; senkr: boolean; fenBr,maxBr,maxVersch: extended; posiMitten: tExtendedArray; constructor create(daten,amplituden,breiten,positionen,ueberlappe,hintergruende: tWerte; von,bis: longint; senkrecht: boolean; fensterBreite,maxBreite,maxVerschiebung: extended; positionsMitten: tExtendedArray); procedure stExecute; override; end; tKorrelThread = class(tLogThread) wl: tWavelet; xMi,xMa: longint; qu,zi: tWerte; pvFehler: extended; algo: tFFTAlgorithmus; constructor create(quelle,ziel: tWerte; xMin,xMax: longint; wavelet: tWavelet); procedure stExecute; override; end; tKonturAusWertenThread = class(tLogThread) w: tWerte; s: extended; xMi,xMa,tMi,tMa: longint; punkte: tExtPointArray; constructor create(werte: tWerte; schwelle: extended; xMin, xMax, tMin, tMax: longint); destructor destroy; override; procedure stExecute; override; end; tIntegralThread = class(tLogThread) qu,zi: tWerte; xMi,xMa,tMi,tMa,xOf,tOf: longint; rtg: tIntegrationsRichtung; constructor create(quelle, ziel: tWerte; xMin, xMax, tMin, tMax, xOff, tOff: longint; richtung: tIntegrationsRichtung); procedure stExecute; override; end; tSortiereNachYThread = class(tLogThread) kont: tKontur; vo,bi,mT: longint; constructor create(k: tKontur; threads,von,bis: longint); procedure stExecute; override; end; tBefehlThread = class(tLogThread) bg: boolean; p: tProcess; constructor create(sT: boolean; cmd: string; out erzeugungsErfolg: 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,vA: longint; // bzgl. Ziel eps: extended; verz: tTransformation; Warnstufe: tWarnstufe; constructor create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax,x0Abs,t0Abs,threads: longint; epsilon: extended; verzerrung: tTransformation; verzerrAnz: longint; 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: tTransformation; vA,nA: longint; constructor create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax: longint; zielPositionen: tIntPointArray; zielGewichte: tExtPointArray; zielAnzahlen: tExtendedArray; vorbearbeitungen,nachbearbeitungen: tTransformation; vorAnz,nachAnz: longint); procedure stExecute; override; end; tVerzerrLOThread = class(tLogThread) qu,zi: tWerte; ho,ve: boolean; verhHo,verhVe: extended; // lambda_min / (lambda_max - lambda_min) xMi,xMa,tMi,tMa: longint; // bzgl. Ziel constructor create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax: longint; verhaeltnisHorizontal, verhaeltnisVertikal: extended); procedure stExecute; override; end; tFensterThread = class(tLogThread) we: tWerte; xFen,tFen: tFenster; hg: extended; xMi,xMa,tMi,tMa: longint; constructor create(werte: tWerte; xMin,xMax,tMin,tMax: longint; fensterX,fensterT: tFenster; hintergrund: extended); procedure stExecute; override; end; tVerschiebeThread = class(tLogThread) we: tWerte; xMi,xMa,tMi,tMa: longint; rtg: tIntPoint; constructor create(werte: tWerte; xMin,xMax,tMin,tMax: longint; richtung: tIntPoint); procedure stExecute; override; end; tPhasenWinkelThread = class(tLogThread) we: tWerte; xMi,xMa: longint; constructor create(werte: tWerte; xMin,xMax: longint); procedure stExecute; override; end; tKomplexMachThread = class(tLogThread) we: tWerte; xMi,xMa: longint; kmm: tKomplexMachModus; mT: tMersenneTwister; constructor create(werte: tWerte; xMin,xMax: longint; komplexMachModus: tKomplexMachModus; randomSeed: longword); procedure stExecute; override; end; function neuePalette(f: tMyStringList): boolean; function initBmpHeader(w,h: longint): tBmpHeader; procedure schreibeBmpHeader(var f: file; w,h: longint); function findePalette(out palette: tPalette; name: string): boolean; function dumpPalettenNamen: string; function erzeugeLegende(sT: boolean; f: tMyStringList; datei: string; qu: tWerte; minDichte,maxDichte: extended; nB: tTransformation; pal: tPalette): boolean; function findeWerte(s: string; f: tMyStringList; pws: pTWerteArray; kont: pTKonturenArray; darfErstellen: boolean): integer; function findeKontur(s: string; f: tMyStringList; pws: pTWerteArray; pks: pTKonturenArray; darfErstellen: boolean): integer; function externerBefehl(sT: boolean; s: string): boolean; procedure warteAufExterneBefehle; procedure beendeExterneBefehleWennFertig; var allePaletten: tPalettenArray; behalteLogs: boolean; externeBefehle: array of tBefehlThread; implementation uses math, systemunit; // tPalette ******************************************************************** constructor tPalette.create; var b: boolean; begin inherited create; for b:=false to true do begin fillChar(farben,sizeOf(farben),0); setLength(farben[b],0); end; fillChar(name,sizeOf(name),0); end; constructor tPalette.create(original: tPalette); begin create; kopiereVon(original); end; destructor tPalette.destroy; var b: boolean; begin for b:=false to true do setLength(farben[b],0); inherited destroy; end; procedure tPalette.kopiereVon(original: tPalette); var b: boolean; i: longint; begin name:=original.name; for b:=false to true do begin setLength(farben[b],length(original.farben[b])); for i:=0 to length(farben[b])-1 do move(original.farben[b][i],farben[b][i],sizeOf(farben[b][i])); end; end; function tPalette.neuerWert(s: string; imPart: boolean): boolean; var farbe: tRGB; begin result:=strToTRGB(s,farbe); if result then neuerWert(farbe,imPart); end; function tPalette.neuerWert(farbe: tRGB; imPart: boolean): boolean; begin setLength(farben[imPart],length(farben[imPart])+1); farben[imPart][length(farben[imPart])-1]:=farbe; result:=true; end; function tPalette.wertZuFarbe(x: extended; imPart: boolean = false): tRGB; begin if length(farben[imPart])<2 then raise exception.create('Die Palette '''+name+''' besitzt keine Farben für Imaginärteile!'); result:=lowlevelunit.wertZuFarbe(x,farben[imPart]); end; // tDatenVorfahr *************************************************************** constructor tDatenVorfahr.create(kont: pTKonturenArray; wert: pTWerteArray); begin inherited create; konturen:=kont; wertes:=wert; bezeichner:=''; end; function tDatenVorfahr.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 fehler('Syntaxfehler, '']'' fehlt!'); i:=findeKontur(erstesArgument(s,'].'),nil,wertes,konturen,false); if i<0 then fehler('Finde Kontur nicht!'); 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 fehler('Kenne Bezeichner '''+s+''' nicht als Eigenschaft einer Kontur!'#10 + 'Ich kenne:'#10 + '''xMin'''#10 + '''xMax'''#10 + '''tMin'''#10 + '''tMax'''#10 + '''Breite'''#10 + '''Hoehe''' ); exit; end; if startetMit('Wert[',s) or startetMit('Werte[',s) or startetMit('wertes[',s) then begin if pos('].',s)=0 then fehler('Syntaxfehler, '']'' fehlt!'); i:=findeWerte(erstesArgument(s,'].'),nil,wertes,konturen,false); if i<0 then fehler('Finde Werte nicht!'); if (s='xMin') or (s='xStart') then result:=wertes^[i].transformationen.xStart else if (s='xMax') or (s='xStop') then result:=wertes^[i].transformationen.xStop else if (s='tMin') or (s='tStart') then result:=wertes^[i].transformationen.tStart else if (s='tMax') or (s='tStop') then result:=wertes^[i].transformationen.tStop 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='np' then result:=wertes^[i]._np else if (s='beta') or (s='β') then result:=wertes^[i]._beta 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 fehler('Kenne Bezeichner '''+s+''' nicht als Eigenschaft von Werten!'#10 + 'Ich kenne:'#10 + '''xMin'''#10 + '''xStart'''#10 + '''xMax'''#10 + '''xStop'''#10 + '''tMin'''#10 + '''tStart'''#10 + '''tMax'''#10 + '''tStop'''#10 + '''wMin'''#10 + '''minW'''#10 + '''wMax'''#10 + '''maxW'''#10 + '''np'''#10 + '''beta'''#10 + '''β'''#10 + '''Breite'''#10 + '''Hoehe''' ); exit; end; fehler('Ich kenne den Bezeichner '''+s+''' nicht!'); end; // tWerte ********************************************************************** constructor tWerte.create(kont: pTKonturenArray; wert: pTWerteArray); var ps: tExtraInfos; begin inherited create(kont,wert); ps:=tExtraInfos.create; genauigkeit:=gSingle; leseThread:=nil; sWerte:=tLLWerteSingle.create(ps); dWerte:=tLLWerteDouble.create(ps); eWerte:=tLLWerteExtended.create(ps); end; constructor tWerte.create(original: tWerte; xMin,xMax: longint); var ps: tExtraInfos; begin inherited create(original.konturen,original.wertes); original.warteAufBeendigungDesLeseThreads; ps:=tExtraInfos.create; leseThread:=nil; genauigkeit:=original.genauigkeit; case genauigkeit of gSingle: begin sWerte:=tLLWerteSingle.create(pTLLWerteSingle(@original.sWerte),ps,xMin,xMax); dWerte:=tLLWerteDouble.create(ps); eWerte:=tLLWerteExtended.create(ps); end; gDouble: begin sWerte:=tLLWerteSingle.create(ps); dWerte:=tLLWerteDouble.create(pTLLWerteDouble(@original.dWerte),ps,xMin,xMax); eWerte:=tLLWerteExtended.create(ps); end; gExtended: begin sWerte:=tLLWerteSingle.create(ps); dWerte:=tLLWerteDouble.create(ps); eWerte:=tLLWerteExtended.create(pTLLWerteExtended(@original.eWerte),ps,xMin,xMax); end; end{of case}; if original.bezeichner='' then bezeichner:='' else bezeichner:=original.bezeichner+''''; transformationen:=original.transformationen; end; destructor tWerte.destroy; begin warteAufBeendigungDesLeseThreads; if eWerte.params<>sWerte.params then begin eWerte.params.free; gibAus('Die Werteparameter sind verschieden instaziiert!!!',3); end; if dWerte.params<>sWerte.params then begin dWerte.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(10); 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; begin original.warteAufBeendigungDesLeseThreads; transformationen:=tIdentitaet.create(original.transformationen); genauigkeit:=original.genauigkeit; case genauigkeit of gSingle: sWerte.kopiereVon(sT,pTLLWerteSingle(@original.sWerte),xMin,xMax); gDouble: dWerte.kopiereVon(sT,pTLLWerteDouble(@original.dWerte),xMin,xMax); gExtended: eWerte.kopiereVon(sT,pTLLWerteExtended(@original.eWerte),xMin,xMax); end{of case}; end; function tWerte.rTransformationen: tTransformation; begin case genauigkeit of gSingle: result:=sWerte.params.transformationen; gDouble: result:=dWerte.params.transformationen; gExtended: result:=eWerte.params.transformationen; end{of case}; end; procedure tWerte.wTransformationen(tr: tTransformation); begin case genauigkeit of gSingle: sWerte.params.transformationen:=tr; gDouble: dWerte.params.transformationen:=tr; gExtended: eWerte.params.transformationen:=tr; end{of case}; 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.istKomplex: boolean; begin case genauigkeit of gSingle: result:=sWerte.params.istKomplex; gDouble: result:=dWerte.params.istKomplex; gExtended: result:=eWerte.params.istKomplex; end{of case}; end; function tWerte.findeAlleDateien(nam: string; var dat: tGenerischeInputDateiInfoArray; vorlage: tGenerischeInputDateiInfo): boolean; var err: longint; i: longint; sR: tSearchRec; sA: tMyStringList; begin result:=false; shellExpand(nam,sA); for i:=0 to sA.count-1 do begin err:=findFirst(sA[i],$3f,sR); if err<>0 then begin findClose(sR); sA.free; gibAus('Keine Datei passt zum Muster '''+sA[i]+'''!',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); end; sA.free; result:=true; end; function tWerte.ermittleExterneInputParameter(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; bekannteBefehle: tMyStringList; 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); bekannteBefehle.free; 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; bekannteBefehle:=tMyStringList.create; mitGewalt:=false; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); aufraeumen; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('mit Gewalt',s,bekannteBefehle,false) then begin mitGewalt:=true; continue; end; if istDasBefehl('Genauigkeit:',s,bekannteBefehle,true) then begin if not vorlagen.genauigkeitFromStr(s) then begin aufraeumen; exit; end; if (genauigkeit < vorlagen.genauigkeit) then genauigkeit:=vorlagen.genauigkeit; continue; end; if istDasBefehl('Gamma:',s,bekannteBefehle,true) then begin vorlagen.gamma:=exprToFloat(false,s); continue; end; if istDasBefehl('tMin:',s,bekannteBefehle,true) then begin vorlagen.tStart:=exprToFloat(false,s); continue; end; if istDasBefehl('tMax:',s,bekannteBefehle,true) then begin vorlagen.tStop:=exprToFloat(false,s); continue; end; if istDasBefehl('xMin:',s,bekannteBefehle,true) then begin vorlagen.xStart:=exprToFloat(false,s); continue; end; if istDasBefehl('xMax:',s,bekannteBefehle,true) then begin vorlagen.xStop:=exprToFloat(false,s); continue; end; if istDasBefehl('Inputparameterdatei:',s,bekannteBefehle,true) 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 istDasBefehl('Fehlerbehebungskommando:',s,bekannteBefehle,true) then begin vorlagen.fehlerBehebungsKommando:=s; continue; end; if istDasBefehl('Spurnummer:',s,bekannteBefehle,true) then begin vorlagen.spurNummer:=strtoint(s); continue; end; if istDasBefehl('Feldnummer:',s,bekannteBefehle,true) then begin vorlagen.feldNummer:=strtoint(s); continue; end; if istDasBefehl('Feld:',s,bekannteBefehle,true) 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 istDasBefehl('Analysator:',s,bekannteBefehle,true) then begin vorlagen.analysator:=s; continue; end; if istDasBefehl('PhaseSpace-Datei:',s,bekannteBefehle,true) 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 istDasBefehl('SpaceTime-Datei:',s,bekannteBefehle,true) 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 istDasBefehl('Trace-Datei:',s,bekannteBefehle,true) 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 istDasBefehl('Sergey-Trace:',s,bekannteBefehle,true) then begin if not directoryexists(s) then begin gibAus(''''+s+''' ist kein Verzeichnis!',3); aufraeumen; exit; end; setLength(dateien,length(dateien)+1); dateien[length(dateien)-1]:=tSergeyInputDateiInfo.create(vorlagen.sergeyVorlage); dateien[length(dateien)-1].name:=s; continue; end; if istDasBefehl('Pipe:',s,bekannteBefehle,true) then begin setLength(dateien,length(dateien)+1); dateien[length(dateien)-1]:=tPipeInputDateiInfo.create(vorlagen.pipeVorlage); dateien[length(dateien)-1].name:=s; continue; end; if istDasBefehl('Andor-Datei:',s,bekannteBefehle,true) then begin if fileexists(s) then begin setLength(dateien,length(dateien)+1); dateien[length(dateien)-1]:=tAndorInputDateiInfo.create(vorlagen.andorVorlage); dateien[length(dateien)-1].name:=s; continue; end; if not findeAlleDateien(s,dateien,vorlagen.andorVorlage) then begin aufraeumen; exit; end; continue; end; bekannteBefehle.sort; gibAus('Verstehe Parameter '''+s+''' nicht beim Einlesen!'#10'Ich kenne:'#10+bekannteBefehle.text,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; tf: textfile; positionen,iArr: tLongintArray; sortiert: tGenerischeInputDateiInfoArray; iPP,iPAP: tProcess; buf: array of byte; s,t: string; sl: tMyStringList; begin result:=false; if length(dateien)=0 then begin gibAus('Keine Dateien zum Einlesen!',3); exit; end; 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(10); 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(10); end; if not iPP.waitOnExit then begin gibAus('ErmittleInterneInputParameter hat ohne Erfolg auf Ende von iPP gewartet!',3); exit; end; if not iPAP.waitOnExit then begin gibAus('ErmittleInterneInputParameter hat ohne Erfolg auf Ende von iPAP gewartet!',3); exit; 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 (erwartet: ''#-bit'')!',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!'#10'Ich kenne:'#10'''32-bit Signed Integer PCM''',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); 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; if dateien[i] is tSergeyInputDateiInfo then begin if (i<>0) or (length(dateien)<>1) then begin gibAus('Ich kann Sergey Trace-Dateien nicht kaskadieren!',3); exit; end; if rightStr(dateien[i].name,1)<>'/' then dateien[i].name:=dateien[i].name+'/'; if not fileexists(dateien[i].name+'numberoftimesteps') then begin gibAus('Datei '''+dateien[i].name+'numberoftimesteps'' existiert nicht!',3); exit; end; if not fileexists(dateien[i].name+'dt') then begin gibAus('Datei '''+dateien[i].name+'dt'' existiert nicht!',3); exit; end; if not fileexists(dateien[i].name+'traces/traces.dat') then begin gibAus('Datei '''+dateien[i].name+'traces/traces.dat'' existiert nicht!',3); exit; end; if not fileexists(dateien[i].name+'../xrom.ini') then begin gibAus('Datei '''+dateien[i].name+'../xrom.ini'' existiert nicht!',3); exit; end; if ((dateien[i] as tSergeyInputDateiInfo).feldNummer<0) or ((dateien[i] as tSergeyInputDateiInfo).feldNummer>=anzSergeyFelder) then begin gibAus('Ausgewählte Feldnummer ('+intToStr((dateien[i] as tSergeyInputDateiInfo).feldNummer)+') liegt außerhalb des verfügbaren Bereiches (0..'+intToStr(anzSergeyFelder-1)+')!',3); exit; end; assign(tf,dateien[i].name+'numberoftimesteps'); reset(tf); readln(tf,tmpI); close(tf); dateien[i].tSiz:=tmpI+1; sl:=tMyStringList.create; sl.loadFromFile(dateien[i].name+'../xrom.ini'); t:=sl.grepFirst('^\s*Pulse[12]\.a0\s*=.*[^0 ].*$'); if t='' then begin gibAus(''''+s+''' enthält keinen Puls, den ich erkenne!',3); exit; end; erstesArgument(t,'Pulse'); dateien[i].groeszenFaktor:=strtoint(erstesArgument(t,'.')); t:=sl.grepFirst('^\s*Plasma\.Density\s*='); if t='' then begin gibAus(''''+s+''' enthält keine Plasmadichte, die ich erkenne!',3); exit; end; erstesArgument(t,'='); dateien[i].params.np:=sqrt(strToFloat(t))/dateien[i].groeszenFaktor; sl.free; assign(tf,dateien[i].name+'dt'); reset(tf); readln(tf,tmpE); close(tf); tmpE:=tmpE*dateien[i].groeszenFaktor; dateien[i].tStart:=0; dateien[i].tStop:=tmpE/2/pi*(dateien[i].tSiz-1); dateien[i].xStart:=0; dateien[i].xStop:=0; dateien[i].xSteps:=1; assignFile(f,dateien[i].name+'traces/traces.dat'); reset(f,1); if filesize(f)<>wertGroesze(dateien[i].genauigkeit)*dateien[i].tSiz*anzSergeyFelder then begin gibAus(''''+dateien[i].name+'traces/traces.dat'' hat die falsche Größe ('+intToStr(filesize(f))+' statt '+intToStr(wertGroesze(dateien[i].genauigkeit)*dateien[i].tSiz*anzSergeyFelder)+' Byte)!',3); close(f); exit; end; close(f); positionen[i]:=0; end; if dateien[i] is tAndorInputDateiInfo then begin if (i<>0) or (length(dateien)<>1) then begin gibAus('Ich kann Andor-Dateien nicht kaskadieren!',3); exit; end; assignFile(f,dateien[i].name); reset(f,1); readALine(f,s); if s<>'Andor Technology Multi-Channel File' then begin gibAus('Syntax-Fehler in '''+dateien[i].name+''': erkenne Andor Datei nicht!',3); closeFile(f); exit; end; readALine(f,s); if s<>'65538 1' then begin gibAus('Syntax-Fehler in '''+dateien[i].name+''': diese Andor Datei hält der strengen Prüfung nicht stand!',3); closeFile(f); exit; end; readALine(f,s); for j:=0 to 4 do erstesArgument(s,' ',false); (dateien[i] as tAndorInputDateiInfo).temperatur:=strToFloat(erstesArgument(s,' ',false)); for j:=6 to 11 do erstesArgument(s,' ',false); (dateien[i] as tAndorInputDateiInfo).belichtungsZeit:=strToFloat(erstesArgument(s,' ',false)); (dateien[i] as tAndorInputDateiInfo).zyklusZeit:=strToFloat(erstesArgument(s,' ',false)); (dateien[i] as tAndorInputDateiInfo).akkumulierteZyklusZeit:=strToFloat(erstesArgument(s,' ',false)); (dateien[i] as tAndorInputDateiInfo).akkumulierteZyklen:=strToInt64(erstesArgument(s,' ',false)); erstesArgument(s,' ',false); // 16 (dateien[i] as tAndorInputDateiInfo).zyklusStapelZeit:=strToFloat(erstesArgument(s,' ',false)); (dateien[i] as tAndorInputDateiInfo).pixelAusleseZeit:=strToFloat(erstesArgument(s,' ',false)); for j:=19 to 20 do erstesArgument(s,' ',false); (dateien[i] as tAndorInputDateiInfo).verstaerkungADW:=strToFloat(erstesArgument(s,' ',false)); for j:=22 to 75 do erstesArgument(s,' ',false); try readAnAndorString(f,(dateien[i] as tAndorInputDateiInfo).detektorTyp,strToInt64(s),true); except gibAus('Syntax-Fehler in '''+dateien[i].name+''': Detektor-String nicht lesbar!',3); closeFile(f); exit; end; readALine(f,s); s:=trim(s); (dateien[i] as tAndorInputDateiInfo).detektorGroesze['x']:=strToInt64(erstesArgument(s,' ',false)); (dateien[i] as tAndorInputDateiInfo).detektorGroesze['y']:=strToInt64(erstesArgument(s,' ',false)); try readAnAndorString(f,(dateien[i] as tAndorInputDateiInfo).dateiName,strToInt64(s),true); except gibAus('Syntax-Fehler in '''+dateien[i].name+''': originaler Dateiname nicht lesbar!',3); closeFile(f); exit; end; readALine(f,s); erstesArgument(s); seek(f,filePos(f)+strToInt64(s)); for j:=0 to 2 do readALine(f,s); for j:=0 to 2 do erstesArgument(s,' ',false); dateien[i].xStart:=strToFloat(erstesArgument(s,' ',false)); (dateien[i] as tAndorInputDateiInfo).shutterZeit['x']:=strToFloat(erstesArgument(s,' ',false)); (dateien[i] as tAndorInputDateiInfo).shutterZeit['y']:=strToFloat(erstesArgument(s,' ',false)); erstesArgument(s,' ',false); // Gitter-abstand? dateien[i].xStop:=strToFloat(erstesArgument(s,'nm',false)); for j:=0 to (dateien[i] as tAndorInputDateiInfo).detectorSkipLines-1 do readALine(f,s); try readAnAndorString(f,(dateien[i] as tAndorInputDateiInfo).xAchsenTitel,false); readAnAndorString(f,(dateien[i] as tAndorInputDateiInfo).datenTypTitel,false); readAnAndorString(f,(dateien[i] as tAndorInputDateiInfo).yAchsenTitel,false); except gibAus('Syntax-Fehler in '''+dateien[i].name+''': Achsenbeschriftung nicht lesbar!',3); closeFile(f); exit; end; readALine(f,s); readALine(f,t); splitStrToInt(s+' '+t,iArr); if (iArr[0]<>65541) or (iArr[9]<>65538) or (iArr[13]<>1) or (iArr[16]<>0) then begin gibAus('Syntax-Fehler in '''+dateien[i].name+''': inkonsistenter Kopf.',3); closeFile(f); exit; end; (dateien[i] as tAndorInputDateiInfo).bildBereich['x','x']:=iArr[1]; (dateien[i] as tAndorInputDateiInfo).bildBereich['x','y']:=iArr[3]; (dateien[i] as tAndorInputDateiInfo).bildBereich['y','x']:=iArr[4]; (dateien[i] as tAndorInputDateiInfo).bildBereich['y','y']:=iArr[2]; (dateien[i] as tAndorInputDateiInfo).bildBereichStapel['x']:=iArr[6]; (dateien[i] as tAndorInputDateiInfo).bildBereichStapel['y']:=iArr[5]; (dateien[i] as tAndorInputDateiInfo).rahmenBereich['x','x']:=iArr[10]; (dateien[i] as tAndorInputDateiInfo).rahmenBereich['x','y']:=iArr[12]; (dateien[i] as tAndorInputDateiInfo).rahmenBereich['x','x']:=iArr[13]; (dateien[i] as tAndorInputDateiInfo).rahmenBereich['x','y']:=iArr[11]; (dateien[i] as tAndorInputDateiInfo).rahmenToepfe['x']:=iArr[15]; (dateien[i] as tAndorInputDateiInfo).rahmenToepfe['y']:=iArr[14]; j:=(dateien[i] as tAndorInputDateiInfo).bildBereichStapel['y'] - (dateien[i] as tAndorInputDateiInfo).bildBereichStapel['x'] + 1; if j<>1 then begin gibAus('So ein Mist - Ich kenn hier nur den Wert "1" in '''+dateien[i].name+'''.',3); closeFile(f); exit; end; dateien[i].xSteps:= ((dateien[i] as tAndorInputDateiInfo).bildBereich['x','y']- (dateien[i] as tAndorInputDateiInfo).bildBereich['x','x']+1) div (dateien[i] as tAndorInputDateiInfo).rahmenToepfe['x']; dateien[i].tSiz:= ((dateien[i] as tAndorInputDateiInfo).bildBereich['y','y']- (dateien[i] as tAndorInputDateiInfo).bildBereich['y','x']+1) div (dateien[i] as tAndorInputDateiInfo).rahmenToepfe['y']; if (dateien[i].xSteps*dateien[i].tSiz <> iArr[8]) or (iArr[8]*j <> iArr[7]) then begin gibAus('Syntax-Fehler in '''+dateien[i].name+''': inkonsistenter Kopf.',3); closeFile(f); exit; end; while j>=0 do begin readAnAndorString(f,s,false); // labels dec(j); end; (dateien[i] as tAndorInputDateiInfo).datenStart:=filePos(f); seek(f,(dateien[i] as tAndorInputDateiInfo).datenStart+dateien[i].xSteps*dateien[i].tSiz*sizeOf(single)); try readAnAndorString(f,s,false); except s:='falsch'; end; if s<>'' then begin gibAus('Syntax-Fehler in '''+dateien[i].name+''': vmtl. zu viele/wenige Daten.',3); closeFile(f); exit; end; closeFile(f); 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 (dateien[0] is tSergeyInputDateiInfo) or (dateien[0] is tAndorInputDateiInfo) then begin transformationen.xStart:=dateien[0].xStart; transformationen.xStop:=dateien[0].xStop; transformationen.tStart:=dateien[0].tStart; transformationen.tStop:=dateien[0].tStop; end; if not ((dateien[0] is tPhaseSpaceInputDateiInfo) or (dateien[0] is tSergeyInputDateiInfo)) 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: tTransformation; verzerrAnzahl: longint; 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,verzerrAnzahl-1); 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, verzerrAnzahl, zPs, zGs, Warn); while not (vits[false].fertig and vits[true].fertig) do sleep(10); 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.xSteps:=_xSteps; transformationen.tSiz:=_tSiz; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.berechneLiKo(sT: boolean; 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.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; if s='Ende' then break; if startetMit('xMin:',s) then begin if length(liKo)=0 then begin gibAus('xMin kann erst gesetzt werden, wenn wenigstens eine Komponente bekannt ist',3); exit; end; xMin:=liKo[0].werte.kont2disk('x',exprToFloat(sT,s)); continue; end; if startetMit('xMax:',s) then begin if length(liKo)=0 then begin gibAus('xMax kann erst gesetzt werden, wenn wenigstens eine Komponente bekannt ist',3); exit; end; xMax:=liKo[0].werte.kont2disk('x',exprToFloat(sT,s)); continue; end; if startetMit('tMin:',s) then begin if length(liKo)=0 then begin gibAus('tMin kann erst gesetzt werden, wenn wenigstens eine Komponente bekannt ist',3); exit; end; tMin:=liKo[0].werte.kont2disk('t',exprToFloat(sT,s)); continue; end; if startetMit('tMax:',s) then begin if length(liKo)=0 then begin gibAus('tMax kann erst gesetzt werden, wenn wenigstens eine Komponente bekannt ist',3); exit; end; tMax:=liKo[0].werte.kont2disk('t',exprToFloat(sT,s)); continue; end; if (s='in t auf Zweierpotenz kürzen') or (s='in y auf Zweierpotenz kürzen') then begin i:=round(power(2,floor(ln(tMax-tMin+1)/ln(2)))); tMax:=(tMax+tMin+i) div 2; tMin:=tMax-i+1; continue; end; if s='in x auf Zweierpotenz kürzen' then begin i:=round(power(2,floor(ln(xMax-xMin+1)/ln(2)))); xMax:=(xMax+xMin+i) div 2; xMin:=xMax-i+1; continue; end; setLength(liKo,length(liKo)+1); i:=findeWerte(erstesArgument(s),nil,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; xMin:=0; xMax:=_xSteps-1; end; if _tSiz=0 then begin _tSiz:=liKo[length(liKo)-1].werte._tSiz; 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:=tUeberlagerung.create; for i:=0 to length(liKo)-1 do (transformationen as tUeberlagerung).addKomponente(liKo[i].werte.transformationen); transformationen:=tKoordinatenAusschnitt.create(transformationen,xMin,xMax,tMin,tMax); _np:=liKo[0].werte._np; _beta:=liKo[0].werte._beta; if sT then begin result:=true; exit; end; 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(10); 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.berechneAgglomeration(sT: boolean; var f: tMyStringList): boolean; var i,xMin,xMax,tMin,tMax: longint; quellen: tWerteArray; s: string; Zeit: extended; begin result:=false; warteAufBeendigungDesLeseThreads; setLength(quellen,0); genauigkeit:=gExtended; _xSteps:=0; _tSiz:=0; xMin:=-1; xMax:=-1; tMin:=-1; tMax:=-1; Zeit:=now; transformationen:=tAgglomeration.create; (transformationen as tAgglomeration).schritt:=-1; (transformationen as tAgglomeration).horizontal:=false; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; if s='Ende' then break; if startetMit('xMin:',s) then begin xMin:=quellen[0].kont2disk('x',exprToFloat(sT,s)); continue; end; if startetMit('xMax:',s) then begin xMax:=quellen[0].kont2disk('x',exprToFloat(sT,s)); continue; end; if startetMit('tMin:',s) then begin tMin:=quellen[0].kont2disk('t',exprToFloat(sT,s)); continue; end; if startetMit('tMax:',s) then begin tMax:=quellen[0].kont2disk('t',exprToFloat(sT,s)); continue; end; if startetMit('Schritt:',s) then begin (transformationen as tAgglomeration).schritt:=exprToFloat(sT,s); continue; end; if startetMit('Nullposition:',s) then begin (transformationen as tAgglomeration).nullposition:=exprToFloat(sT,s); continue; end; if s='waagerecht' then begin (transformationen as tAgglomeration).horizontal:=true; continue; end; if s='senkrecht' then begin (transformationen as tAgglomeration).horizontal:=true; continue; end; setLength(quellen,length(quellen)+1); i:=findeWerte(erstesArgument(s),nil,wertes,konturen,false); if (i<0) or (wertes^[i]=self) then exit; quellen[length(quellen)-1]:=wertes^[i]; if length(quellen)=1 then begin _xSteps:=quellen[0]._xSteps; _tSiz:=quellen[0]._tSiz; end; if _xSteps<>quellen[length(quellen)-1]._xSteps then begin gibAus('Unterschiedliche Anzahl an x-Schritten: '+intToStr(_xSteps)+' bisher vs. '+intToStr(quellen[length(quellen)-1]._xSteps)+' bei '+intToStr(i)+'!',3); exit; end; if _tSiz<>quellen[length(quellen)-1]._tSiz then begin gibAus('Unterschiedliche Anzahl an t-Schritten: '+intToStr(_tSiz)+' bisher vs. '+intToStr(quellen[length(quellen)-1]._tSiz)+' bei '+intToStr(i)+'!',3); exit; end; if quellen[length(quellen)-1].transformationen.xStart<>quellen[0].transformationen.xStart then begin gibAus('Anfangspostionen passen nicht zusammen ('+floatToStr(quellen[0].transformationen.xStart)+' bisher vs. '+floatToStr(quellen[length(quellen)-1].transformationen.xStart)+' bei '+intToStr(i)+')!',3); exit; end; if quellen[length(quellen)-1].transformationen.xStop<>quellen[0].transformationen.xStop then begin gibAus('Endpostionen passen nicht zusammen ('+floatToStr(quellen[0].transformationen.xStop)+' bisher vs. '+floatToStr(quellen[length(quellen)-1].transformationen.xStop)+' bei '+intToStr(i)+')!',3); exit; end; if quellen[length(quellen)-1].transformationen.tStart<>quellen[0].transformationen.tStart then begin gibAus('Anfangszeiten passen nicht zusammen ('+floatToStr(quellen[0].transformationen.tStart)+' bisher vs. '+floatToStr(quellen[length(quellen)-1].transformationen.tStart)+' bei '+intToStr(i)+')!',3); exit; end; if quellen[length(quellen)-1].transformationen.tStop<>quellen[0].transformationen.tStop then begin gibAus('Endzeiten passen nicht zusammen ('+floatToStr(quellen[0].transformationen.tStop)+' bisher vs. '+floatToStr(quellen[length(quellen)-1].transformationen.tStop)+' bei '+intToStr(i)+')!',3); exit; end; until false; if length(quellen)=0 then begin gibAus('Leere Agglomeration!',3); exit; end; if xMin<0 then xMin:=0; if xMax<0 then xMax:=quellen[0].transformationen.xSteps-1; if tMin<0 then tMin:=0; if tMax<0 then tMax:=quellen[0].transformationen.tSiz-1; for i:=0 to length(quellen)-1 do (transformationen as tAgglomeration).addKomponente( tKoordinatenAusschnitt.create( quellen[i].transformationen, xMin,xMax,tMin,tMax) ); _xSteps:=transformationen.xSteps; _tSiz:=transformationen.tSiz; _minW:=transformationen.wMin; _maxW:=transformationen.wMax; _np:=quellen[0]._np; _beta:=quellen[0]._beta; if sT then begin result:=true; exit; end; holeRAM(3); gibAus('Berechne ...',3); Zeit:=now; for i:=0 to length(quellen)-1 do case quellen[i].genauigkeit of gSingle: eWerte.kopiereVonNach( pTLLWerteSingle(@quellen[i].sWerte), xMin,xMax, tMin,tMax, (1+xMax-xMin)*i*byte((transformationen as tAgglomeration).horizontal), (1+tMax-tMin)*i*byte(not (transformationen as tAgglomeration).horizontal) ); gDouble: eWerte.kopiereVonNach( pTLLWerteDouble(@quellen[i].dWerte), xMin,xMax, tMin,tMax, (1+xMax-xMin)*i*byte((transformationen as tAgglomeration).horizontal), (1+tMax-tMin)*i*byte(not (transformationen as tAgglomeration).horizontal) ); gExtended: eWerte.kopiereVonNach( pTLLWerteExtended(@quellen[i].eWerte), xMin,xMax, tMin,tMax, (1+xMax-xMin)*i*byte((transformationen as tAgglomeration).horizontal), (1+tMax-tMin)*i*byte(not (transformationen as tAgglomeration).horizontal) ); end; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.berechneQuotient(sT: boolean; 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; bekannteBefehle: tMyStringList; begin result:=false; warteAufBeendigungDesLeseThreads; Zeit:=now; transformationen:=tUeberlagerung.create; (transformationen as tUeberlagerung).addKomponente(wertes^[dividend].transformationen); (transformationen as tUeberlagerung).addKomponente(wertes^[divisor].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; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('xMin:',s,bekannteBefehle,true) then begin xMin:=kont2disk('x',exprToFloat(sT,s)); continue; end; if istDasBefehl('xMax:',s,bekannteBefehle,true) then begin xMax:=kont2disk('x',exprToFloat(sT,s)); continue; end; if istDasBefehl('tMin:',s,bekannteBefehle,true) then begin tMin:=kont2disk('t',exprToFloat(sT,s)); continue; end; if istDasBefehl('tMax:',s,bekannteBefehle,true) then begin tMax:=kont2disk('t',exprToFloat(sT,s)); continue; end; if istDasBefehl('epsilon:',s,bekannteBefehle,true) then begin epsilon:=exprToFloat(sT,s); continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Teile!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; _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:=tKoordinatenAusschnitt.create(transformationen,xMin,xMax,tMin,tMax); _np:=wertes^[dividend]._np; _beta:=wertes^[dividend]._beta; genauigkeit:=gExtended; if sT then begin result:=true; exit; end; 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(10); 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; f: tMyStringList; threads, faktor1, faktor2: longint): boolean; var i,xMin,xMax,tMin,tMax: longint; s: string; fertig: boolean; produktThreads: array of tProduktThread; Zeit: extended; bekannteBefehle: tMyStringList; begin result:=false; warteAufBeendigungDesLeseThreads; Zeit:=now; transformationen:=tUeberlagerung.create; (transformationen as tUeberlagerung).addKomponente(wertes^[faktor1].transformationen); (transformationen as tUeberlagerung).addKomponente(wertes^[faktor2].transformationen); _xSteps:=transformationen.xSteps; xMin:=0; xMax:=_xSteps-1; _tSiz:=transformationen.tSiz; tMin:=0; tMax:=_tSiz-1; _np:=wertes^[faktor1]._np; _beta:=wertes^[faktor1]._beta; Zeit:=now; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('xMin:',s,bekannteBefehle,true) then begin xMin:=kont2disk('x',exprToFloat(sT,s)); continue; end; if istDasBefehl('xMax:',s,bekannteBefehle,true) then begin xMax:=kont2disk('x',exprToFloat(sT,s)); continue; end; if istDasBefehl('tMin:',s,bekannteBefehle,true) then begin tMin:=kont2disk('t',exprToFloat(sT,s)); continue; end; if istDasBefehl('tMax:',s,bekannteBefehle,true) then begin tMax:=kont2disk('t',exprToFloat(sT,s)); continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Multipliziere!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; _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:=tKoordinatenAusschnitt.create(transformationen,xMin,xMax,tMin,tMax); _np:=wertes^[faktor1]._np; _beta:=wertes^[faktor1]._beta; genauigkeit:=gExtended; if sT then begin result:=true; exit; end; 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(10); 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; f: tMyStringList; threads: longint; quelle: tWerte): boolean; var i: longint; s: string; wavelet: tWavelet; fertig: boolean; korrelThreads: array of tKorrelThread; Zeit,pvFehler: extended; bekannteBefehle: tMyStringList; begin result:=false; warteAufBeendigungDesLeseThreads; genauigkeit:=gExtended; wavelet:=tWavelet.create; wavelet.mitFFT:=false; Zeit:=now; transformationen:=quelle.transformationen; wavelet.freq:=0; wavelet.tfwhm:=1; wavelet.typ:=wtSin2; _xSteps:=quelle._xSteps; _tSiz:=quelle._tSiz; _np:=quelle._np; _beta:=quelle._beta; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('freq:',s,bekannteBefehle,true) then begin wavelet.freq:=1/kont2diskFak('t',1/exprToFloat(sT,s)); continue; end; if istDasBefehl('tfwhm:',s,bekannteBefehle,true) then begin wavelet.tfwhm:=round(kont2diskFak('t',exprToFloat(sT,s))); continue; end; if istDasBefehl('Wavelettyp:',s,bekannteBefehle,true) then begin if not wavelet.setzeTyp(s) then exit; continue; end; if istDasBefehl('mit FFT',s,bekannteBefehle,false) then begin wavelet.mitFFT:=true; continue; end; if istDasBefehl('ohne FFT',s,bekannteBefehle,false) then begin wavelet.mitFFT:=false; continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Berechnung einer Korrelation!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; 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: eWerte.kopiereVon(sT,pTLLWerteSingle(@quelle.sWerte)); gDouble: dWerte.kopiereVon(sT,pTLLWerteDouble(@quelle.dWerte)); gExtended: eWerte.kopiereVon(sT,pTLLWerteExtended(@quelle.eWerte)); end{of case}; gibAus('... fertig '+timetostr(now-Zeit)+', berechne ...',3); end else begin genauigkeit:=gExtended; 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),wavelet); repeat sleep(10); 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(i=_maxW then _maxW:=_minW+1; exit; end; warteAufBeendigungDesLeseThreads; for i:=0 to length(vgWs)-1 do vgWs[i].warteAufBeendigungDesLeseThreads; Zeit:=now; gibAus('Gleiche maximale und minimale Dichten an ...',3); for i:=0 to length(vgWs)-1 do begin _minW:=min(_minW,vgWs[i]._minW); _maxW:=max(_maxW,vgWs[i]._maxW); end; if symmetrisch then begin _minW:=min(_minW,-_maxW); _maxW:=max(_maxW,-_minW); end; for i:=0 to length(vgWs)-1 do begin vgWs[i]._minW:=_minW; vgWs[i]._maxW:=_maxW; end; gibAus('... sie sind '+myFloatToStr(_minW)+' und '+myFloatToStr(_maxW)+'. '+timetostr(now-Zeit),3); if symmetrisch then begin _minW:=min(_minW,-_maxW); _maxW:=max(_maxW,-_minW); gibAus('Jetzt sind sie '+myFloatToStr(_minW)+' und '+myFloatToStr(_maxW)+'. '+timetostr(now-Zeit),3); end; end; function tWerte.fft(threads: longint; senkrecht,invers: boolean; const vor,nach: tFFTDatenordnung; fen: tFenster; hg: extended; out pvFehler: extended; Warn: tWarnstufe): boolean; var fftThreads: array of tFFTThread; i,fftTSiz: int64; fertig: boolean; begin result:=false; if (vor in [doAlleResIms,doAlleResSmi]) xor (nach in [doAlleResIms,doAlleResSmi]) then begin gibAus('Eine FFT kann nicht von voll-komplex zu halb-komplex oder umgekehrt transformieren - das muss außerhalb erledigt werden ('+fftDoToStr(vor)+' -> '+fftDoToStr(nach)+')!',3); exit; end; if (vor in [doGetrennt]) or (nach in [doGetrennt]) then begin gibAus('tWerte.fft kann nicht mit getrenntem Input oder Output umgehen!',3); exit; end; fftTSiz:=_tSiz div (1+byte(vor in [doAlleResIms,doAlleResSmi])); if senkrecht then begin if assigned(fen) and (length(fen.werte)<>fftTSiz) then fen.berechneWerte(fftTSiz); if threads>_xSteps then threads:=_xSteps; end else begin if assigned(fen) and (length(fen.werte)<>_xSteps) then fen.berechneWerte(_xSteps); if threads>fftTSiz then threads:=fftTSiz; end; setLength(fftThreads,threads); if senkrecht then begin fftThreads[0]:= tFFTThread.create( self, 0, round(_xSteps/threads-1), senkrecht, invers, vor, nach, fen, hg); for i:=1 to threads-1 do fftThreads[i]:= tFFTThread.create( self, round(_xSteps/threads*i), round(_xSteps/threads*(i+1)-1), senkrecht, invers, fftThreads[0].algo, fen, hg); end else begin fftThreads[0]:= tFFTThread.create( self, 0, round(fftTSiz/threads-1), senkrecht, invers, vor, nach, fen, hg); for i:=1 to threads-1 do fftThreads[i]:= tFFTThread.create( self, round(fftTSiz/threads*i), round(fftTSiz/threads*(i+1)-1), senkrecht, invers, fftThreads[0].algo, fen, hg); end; repeat sleep(10); 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; procedure tWerte.initFuerGauszFit(sT: boolean; daten: tWerte; senkrecht: boolean; adLaenge: longint; adStart,adStop: extended); begin transformationen:=tFitTransformation.create(daten.transformationen,senkrecht,adLaenge,adStart,adStop); _xSteps:=transformationen.xSteps; _tSiz:=transformationen.tSiz; genauigkeit:=gExtended; if not sT then holeRAM(3); end; function tWerte.fitteGausze(sT: boolean; f: tMyStringList; threads: longint): boolean; var Zeit: extended; senkrecht,fertig: boolean; s: string; i,iterDim: longint; ampl,br,posi,ueberl,hint: tWerte; maxBreite,maxVerschiebung,fensterBreite: extended; posiMitten: tExtendedArray; gauszFitThreads: array of tGauszFitThread; bekannteBefehle: tMyStringList; begin result:=false; Zeit:=now; if not sT then gibAus('Gauße fitten ...',3); ampl:=nil; br:=nil; posi:=nil; ueberl:=nil; hint:=nil; senkrecht:=true; maxBreite:=-1; maxVerschiebung:=-1; fensterBreite:=-1; setLength(posiMitten,0); bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('senkrecht',s,bekannteBefehle,false) then begin senkrecht:=true; continue; end; if istDasBefehl('waagerecht',s,bekannteBefehle,false) then begin senkrecht:=false; continue; end; if istDasBefehl('Amplituden:',s,bekannteBefehle,true) then begin i:=findeWerte(s,f,wertes,konturen,true); if i<0 then exit; if assigned(ampl) then begin gibAus('Habe bereits ein Ziel für die Amplituden beim Fitten eines Gaußes!',3); exit; end; ampl:=wertes^[i]; continue; end; if istDasBefehl('Breiten:',s,bekannteBefehle,true) then begin i:=findeWerte(s,f,wertes,konturen,true); if i<0 then exit; if assigned(br) then begin gibAus('Habe bereits ein Ziel für die Breiten beim Fitten eines Gaußes!',3); exit; end; br:=wertes^[i]; continue; end; if istDasBefehl('Positionen:',s,bekannteBefehle,true) then begin i:=findeWerte(s,f,wertes,konturen,true); if i<0 then exit; if assigned(posi) then begin gibAus('Habe bereits ein Ziel für die Positionen beim Fitten eines Gaußes!',3); exit; end; posi:=wertes^[i]; continue; end; if istDasBefehl('Überlapp:',s,bekannteBefehle,true) then begin i:=findeWerte(s,f,wertes,konturen,true); if i<0 then exit; if assigned(ueberl) then begin gibAus('Habe bereits ein Ziel für den Überlapp beim Fitten eines Gaußes!',3); exit; end; ueberl:=wertes^[i]; continue; end; if istDasBefehl('Hintergrund:',s,bekannteBefehle,true) then begin i:=findeWerte(s,f,wertes,konturen,true); if i<0 then exit; if assigned(hint) then begin gibAus('Habe bereits ein Ziel für den Hintergrund beim Fitten eines Gaußes!',3); exit; end; hint:=wertes^[i]; continue; end; if istDasBefehl('Maximalverschiebung:',s,bekannteBefehle,true) then begin maxVerschiebung:=kont2diskFak(senkrecht,exprToFloat(sT,s)); continue; end; if istDasBefehl('Maximalbreite:',s,bekannteBefehle,true) then begin maxBreite:=kont2diskFak(senkrecht,exprToFloat(sT,s)); continue; end; if istDasBefehl('Fensterbreite:',s,bekannteBefehle,true) then begin fensterBreite:=kont2diskFak(senkrecht,exprToFloat(sT,s)); continue; end; if istDasBefehl('Positionsbereichsmitten:',s,bekannteBefehle,true) then begin while s<>'' do fuegeSortiertHinzu(kont2disk(senkrecht,exprToFloat(sT,erstesArgument(s))),posiMitten); continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht beim Fitten eines Gaußes!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; if (2*maxVerschiebung>fensterBreite) or ((maxVerschiebung<0) and (fensterBreite>0)) then maxVerschiebung:=fensterBreite/2; if length(posiMitten)=0 then begin gibAus('Es sind keine Gauße zu fitten! Was soll das?',3); exit; end; if not (assigned(ampl) or assigned(br) or assigned(posi) or assigned(ueberl) or assigned(hint)) then begin gibAus('Es sind keine Parameter des Gaußes zu speichern! Was soll das?',3); exit; end; if assigned(ampl) then ampl.initFuerGauszFit(sT,self,senkrecht,length(posiMitten),posiMitten[0],posiMitten[length(posiMitten)-1]); if assigned(br) then br.initFuerGauszFit(sT,self,senkrecht,length(posiMitten),posiMitten[0],posiMitten[length(posiMitten)-1]); if assigned(posi) then posi.initFuerGauszFit(sT,self,senkrecht,length(posiMitten),posiMitten[0],posiMitten[length(posiMitten)-1]); if assigned(ueberl) then ueberl.initFuerGauszFit(sT,self,senkrecht,length(posiMitten),posiMitten[0],posiMitten[length(posiMitten)-1]); if assigned(hint) then hint.initFuerGauszFit(sT,self,senkrecht,length(posiMitten),posiMitten[0],posiMitten[length(posiMitten)-1]); if senkrecht then iterDim:=_xSteps else iterDim:=_tSiz; if threads > iterDim then threads:=iterDim; if sT then begin result:=true; exit; end; setLength(gauszFitThreads,threads); for i:=0 to threads-1 do gauszFitThreads[i]:= tGauszFitThread.create( self, ampl, br, posi, ueberl, hint, round(i*iterDim/threads), round((i+1)*iterDim/threads)-1, senkrecht, fensterBreite, maxBreite, maxVerschiebung, posiMitten ); repeat sleep(10); fertig:=true; for i:=0 to threads-1 do fertig:=fertig and gauszFitThreads[i].fertig; until fertig; for i:=0 to threads-1 do gauszFitThreads[i].free; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.berechneZeitfrequenzanalyse(sT: boolean; f: tMyStringList; threads: longint; quelle: tWerte; Warn: tWarnstufe): boolean; var i,tMin,tMax,qlen: longint; Zeit,pvFehler,total: extended; wavelet: tGauszFenster; fenster: tSin2Fenster; s: string; senkrecht,rundeAuf2: boolean; tmpW: tExtendedArray; bekannteBefehle: tMyStringList; begin result:=false; if not ((quelle._xSteps<>1) xor (quelle._tSiz<>1)) then begin gibAus('Eine Zeitfrequenzanalyse geht nur auf eindimensionalen Daten! ('+intToStr(quelle._xSteps)+'x'+intToStr(quelle._tSiz)+')',3); exit; end; warteAufBeendigungDesLeseThreads; senkrecht:=quelle._tSiz<>1; tMin:=0; rundeAuf2:=false; if senkrecht then tMax:=quelle._tSiz-1 else tMax:=quelle._xSteps-1; Zeit:=now; wavelet:=tGauszFenster.create; fenster:=tSin2Fenster.create; genauigkeit:=gExtended; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); wavelet.free; fenster.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('Breite:',s,bekannteBefehle,true) then begin wavelet.breite:=quelle.kont2diskFak(senkrecht,quelle.exprToFloat(sT,s)); wavelet.aktiv:=true; continue; end; if istDasBefehl('Rand:',s,bekannteBefehle,true) then begin fenster.rand:=round(quelle.kont2diskFak(senkrecht,quelle.exprToFloat(sT,s))); fenster.aktiv:=true; continue; end; if istDasBefehl('nicht auf Zweierpotenz runden',s,bekannteBefehle,false) then begin rundeAuf2:=false; continue; end; if istDasBefehl('auf Zweierpotenz runden',s,bekannteBefehle,false) then begin rundeAuf2:=true; continue; end; if senkrecht then begin if istDasBefehl('tMin:',s,bekannteBefehle,true) or istDasBefehl('yMin:',s,bekannteBefehle,true) then begin tMin:=round(quelle.kont2disk('t',quelle.exprToFloat(sT,s))); continue; end; if istDasBefehl('tMax:',s,bekannteBefehle,true) or istDasBefehl('yMax:',s,bekannteBefehle,true) then begin tMax:=round(quelle.kont2disk('t',quelle.exprToFloat(sT,s))); continue; end; end; if senkrecht then begin if istDasBefehl('xMin:',s,bekannteBefehle,true) then begin tMin:=round(quelle.kont2disk('x',quelle.exprToFloat(sT,s))); continue; end; if istDasBefehl('xMax:',s,bekannteBefehle,true) then begin tMax:=round(quelle.kont2disk('x',quelle.exprToFloat(sT,s))); continue; end; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer Zeitfrequenzanalyse!'#10'Ich kenne:'#10+bekannteBefehle.text,3); wavelet.free; fenster.free; bekannteBefehle.free; exit; until false; bekannteBefehle.free; if senkrecht then qlen:=quelle._tSiz else qlen:=quelle._xSteps; tMin:=max(tMin,0); tMax:=min(tMax,qlen-1); _xSteps:=tMax+1-tMin; if rundeAuf2 then begin _xSteps:=round(power(2,round(ln(_xSteps)/ln(2)))); if _xSteps>qlen then _xSteps:=_xSteps div 2; tMax:=(tMin+tMax+_xSteps) div 2; tMin:=tMax+1-_xSteps; if tMin<0 then begin tMin:=0; tMax:=_xSteps-1; end; if tMax>=qlen then begin tMax:=qlen-1; tMin:=tMax+1-_xSteps; end; if tMin<0 then begin gibAus('Das Fenster passt nicht in die Werte - das sollte nicht passieren können! ('+ intToStr(tMin)+'..'+ intToStr(tMax)+': '+ intToStr(qlen)+' ('+ intToStr(quelle._xSteps)+'x'+ intToStr(quelle._tSiz)+'))',3); wavelet.free; fenster.free; exit; end; end; _tSiz:=_xSteps; if wavelet.breite>_xSteps then begin gibAus('Die angegebene Breite ist größer als die Anzahl der Werte! ('+ floattostrtrunc(wavelet.breite,2,true)+'>='+ intToStr(_xSteps)+')',3); wavelet.free; fenster.free; exit; end; if fenster.aktiv then fenster.breite:=qlen-fenster.rand else begin fenster.breite:=qlen+1; fenster.rand:=0; end; fenster.berechneWerte(qlen,true); if senkrecht then transformationen:=tKoordinatenAusschnitt.create(quelle.transformationen,0,0,tMin,tMax) else transformationen:=tKoordinatenAusschnitt.create(quelle.transformationen,tMin,tMax,0,0); transformationen:=tDiagonaleAgglomeration.create(transformationen); if not sT then begin total:=0; tMin:=tMin - _xSteps div 2; while tMin<0 do tMin:=tMin+qlen; holeRAM(3); setLength(tmpW,2*_xSteps-1); gibAus('kopiere Inhalt ...',3); case quelle.genauigkeit of gSingle: for i:=0 to 2*_xSteps-2 do tmpW[i]:=quelle.sWerte.werte[(i+tMin) mod qlen] * fenster.werte[(i+tMin) mod qlen]; gDouble: for i:=0 to 2*_xSteps-2 do tmpW[i]:=quelle.dWerte.werte[(i+tMin) mod qlen] * fenster.werte[(i+tMin) mod qlen]; gExtended: for i:=0 to 2*_xSteps-2 do tmpW[i]:=quelle.eWerte.werte[(i+tMin) mod qlen] * fenster.werte[(i+tMin) mod qlen]; end{of case}; for i:=0 to _xSteps-1 do move(tmpW[i],eWerte.werte[i*_xSteps],_xSteps*sizeOf(extended)); for i:=0 to length(eWerte.werte)-1 do total:=total+sqr(eWerte.werte[i]); gibAus('... fertig ('+floatToStr(total)+'), berechne Fouriertransformation ...',3); if not fft(threads,senkrecht,false,doRes,doBetrQdr,wavelet,0,pvFehler,Warn) then begin gibAus('Es traten Fehler auf!',3); wavelet.free; fenster.free; exit; end; total:=0; for i:=0 to length(eWerte.werte)-1 do total:=total+sqr(eWerte.werte[i]); gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+') -> '+floatToStr(total),3); end; transformationen:=tFFTTransformation.create(transformationen,not senkrecht,senkrecht); if senkrecht then // die zweite Hälfte der Werte ist redundant _tSiz:=_tSiz div 2 + 1 else _xSteps:=_xSteps div 2 + 1; transformationen:=tKoordinatenAusschnitt.create(transformationen,0,_xSteps-1,0,_tSiz-1); if not sT then eWerte.holeRAM(0); gibAus('... fertig '+timetostr(now-Zeit),3); wavelet.free; fenster.free; result:=true; end; function tWerte.berechneVerzerrung(sT: boolean; f: tMyStringList; threads: longint; 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,tmp: tTransformation; vorAnz,nachAnz,verAnz: longint; s: string; verzerrThreads: array of tVerzerrThread; fertig, bearbeitungenLoeschen: boolean; bekannteBefehle: tMyStringList; 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); if bearbeitungenLoeschen then begin zerstoereTransformationWennObsolet(Vorbearbeitung); zerstoereTransformationWennObsolet(Nachbearbeitung); zerstoereTransformationWennObsolet(verzerrung); end; setLength(zPs,0); setLength(zGs,0); setLength(zAs,0); bekannteBefehle.free; end; begin result:=false; warteAufBeendigungDesLeseThreads; gibAus('Verzerrung berechnen ... ',3); Zeit:=now; bearbeitungenLoeschen:=true; verzerrung:=tKeineTransformation.create; verAnz:=0; epsilon:=1e-9; genauigkeit:=gExtended; Vorbearbeitung:=tKeineTransformation.create; vorAnz:=0; Nachbearbeitung:=tKeineTransformation.create; nachAnz:=0; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); aufraeumen; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if quelle.dichtenParameterErkannt(sT,s,bekannteBefehle,threads,0,_xSteps-1,0,_tSiz-1) then continue; if istDasBefehl('Threadanzahl:',s,bekannteBefehle,true) then begin threads:=strtoint(s); continue; end; if istDasBefehl('Epsilon:',s,bekannteBefehle,true) then begin epsilon:=exprToFloat(sT,s); continue; end; if istDasBefehl('Abbildung:',s,bekannteBefehle,true) then begin tmp:=tKonkreteKoordinatenTransformation.create; if assigned(verzerrung) then tmp.fuegeVorgaengerHinzu(verzerrung); verzerrung:=tmp; if not (verzerrung as tKonkreteKoordinatenTransformation).initAbbildung(sT,s,quelle.xScale,quelle.tScale,@exprToFloat) then begin gibAus('Syntaxfehler in der Funktion '''+s+'''!',3); aufraeumen; exit; end; inc(verAnz); if not sT then begin gibAus(verzerrung.dumpParams(verAnz),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),verAnz-1)),3); end; continue; end; if istDasBefehl('Nachbearbeitung:',s,bekannteBefehle,true) then begin if not liesTWerteTransformationen(sT,s,f,@exprToFloat,Nachbearbeitung) then begin aufraeumen; exit; end; inc(nachAnz); continue; end; if istDasBefehl('Vorbearbeitung:',s,bekannteBefehle,true) then begin if not liesTWerteTransformationen(sT,s,f,@exprToFloat,Vorbearbeitung) then begin aufraeumen; exit; end; inc(vorAnz); continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer Verzerrung!'#10'Ich kenne:'#10+bekannteBefehle.text,3); aufraeumen; exit; until false; transformationen:=quelle.transformationen; Vorbearbeitung.ersetzeAnfangDurch(transformationen); verzerrung.ersetzeAnfangDurch(Vorbearbeitung); Nachbearbeitung.ersetzeAnfangDurch(verzerrung); if not sT then begin gibAus('... Zielausdehnung berechnen ... ',3); grenzen:=(verzerrung as tKonkreteKoordinatenTransformation).zielausdehnung; _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; 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,verAnz,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,vorAnz,nachAnz); repeat fertig:=true; for i:=0 to length(verzerrThreads)-1 do fertig:=fertig and verzerrThreads[i].fertig; if not fertig then sleep(10); until fertig; end; transformationen:=Nachbearbeitung; aufraeumen; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.berechneLambdaZuOmegaVerzerrung(sT: boolean; f: tMyStringList; threads: longint; quelle: tWerte): boolean; var i: longint; Zeit: extended; verzerrLOThreads: array of tVerzerrLOThread; fertig: boolean; s: string; bekannteBefehle: tMyStringList; procedure aufraeumen; var ii: longint; begin for ii:=0 to length(verzerrLOThreads)-1 do if assigned(verzerrLOThreads[ii]) then verzerrLOThreads[ii].free; setLength(verzerrLOThreads,0); bekannteBefehle.free; end; begin result:=false; warteAufBeendigungDesLeseThreads; gibAus('lambda-zu-omega-Verzerrung berechnen ... ',3); Zeit:=now; genauigkeit:=gExtended; transformationen:=tLambdaZuOmegaTransformation.create; transformationen.fuegeVorgaengerHinzu(quelle.transformationen); bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); aufraeumen; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if quelle.dichtenParameterErkannt(sT,s,bekannteBefehle,threads,0,_xSteps-1,0,_tSiz-1) then continue; if istDasBefehl('Threadanzahl:',s,bekannteBefehle,true) then begin threads:=strtoint(s); continue; end; if istDasBefehl('horizontal',s,bekannteBefehle,false) then begin (transformationen as tLambdaZuOmegaTransformation).horizontal:=true; continue; end; if istDasBefehl('vertikal',s,bekannteBefehle,false) then begin (transformationen as tLambdaZuOmegaTransformation).vertikal:=true; continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer lambda-zu-omega-Verzerrung!'#10'Ich kenne:'#10+bekannteBefehle.text,3); aufraeumen; exit; until false; _xSteps:=quelle._xSteps; _tSiz:=quelle._tSiz; if not sT then begin holeRAM(3); gibAus('Threads starten',3); setLength(verzerrLOThreads,threads); for i:=0 to length(verzerrLOThreads)-1 do verzerrLOThreads[i]:= tVerzerrLOThread.create( quelle, self, round(i/length(verzerrLOThreads)*_xSteps), round((i+1)/length(verzerrLOThreads)*_xSteps-1), 0, _tSiz-1, (transformationen as tLambdaZuOmegaTransformation).verhaeltnisHorizontal, (transformationen as tLambdaZuOmegaTransformation).verhaeltnisVertikal); repeat fertig:=true; for i:=0 to length(verzerrLOThreads)-1 do fertig:=fertig and verzerrLOThreads[i].fertig; if not fertig then sleep(10); until fertig; end; aufraeumen; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.entferneArtefakte(sT: boolean; f: tMyStringList; threads: longint): boolean; var Zeit,hintergrund: extended; fensters: array[boolean] of tSin2Fenster; s: string; b,hintergrundAbziehen,fertig: boolean; fensterThreads: array of tFensterThread; i: int64; bekannteBefehle: tMyStringList; begin result:=false; Zeit:=now; if not sT then gibAus('Artefakte entfernen ...',3); for b:=false to true do fensters[b]:=tSin2Fenster.create; hintergrundAbziehen:=false; hintergrund:=0; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); for b:=false to true do fensters[b].free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; bekannteBefehle.add('''x-Fenster: ...'''); bekannteBefehle.add('''t-Fenster: ...'''); 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 istDasBefehl('Hintergrund abziehen',s,bekannteBefehle,false) then begin hintergrundAbziehen:=true; continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht beim Entfernen von Artefakten!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; fensters[true].breite:=_tSiz-fensters[true].breite; fensters[false].breite:=_xSteps-fensters[false].breite; if sT then begin for b:=false to true do fensters[b].free; result:=true; exit; end; if hintergrundAbziehen then case genauigkeit of gSingle: hintergrund:=sWerte.ermittleHintergrund; gDouble: hintergrund:=dWerte.ermittleHintergrund; gExtended: hintergrund:=eWerte.ermittleHintergrund; end{of case}; gibAus('Threads starten',3); setLength(fensterThreads,threads); for i:=0 to length(fensterThreads)-1 do fensterThreads[i]:= tFensterThread.create( self, round(i/length(fensterThreads)*_xSteps), round((i+1)/length(fensterThreads)*_xSteps-1), 0, _tSiz-1, fensters[false], fensters[true], hintergrund); repeat fertig:=true; for i:=0 to length(fensterThreads)-1 do fertig:=fertig and fensterThreads[i].fertig; if not fertig then sleep(10); until fertig; gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.extrahiereEinhuellende(sT: boolean; f: tMyStringList; threads: longint; Warn: tWarnstufe): boolean; var Zeit,pvFehler,hintergrund,xFak,yFak: extended; fensters: array[boolean] of tSin2Fenster; s: string; b,hintergrundAbziehen: boolean; betraege: tWerte; bekannteBefehle: tMyStringList; begin result:=false; Zeit:=now; if not sT then gibAus('Einhüllende extrahieren ...',3); for b:=false to true do fensters[b]:=tSin2Fenster.create; hintergrundAbziehen:=false; hintergrund:=0; xFak:=1; yFak:=1; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); for b:=false to true do fensters[b].free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; bekannteBefehle.add('''x-Fenster: ...'''); bekannteBefehle.add('''t-Fenster: ...'''); 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 istDasBefehl('Hintergrund abziehen',s,bekannteBefehle,false) then begin hintergrundAbziehen:=true; continue; end; if istDasBefehl('Abstandsmetrik',s,bekannteBefehle,true) then begin xFak:=round(kont2diskFak('x',exprToFloat(sT,erstesArgument(s)))); yFak:=round(kont2diskFak('t',exprToFloat(sT,s))); end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht beim Extrahieren der Einhüllenden!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; fensters[true].breite:=_tSiz-fensters[true].breite; fensters[false].breite:=_xSteps-fensters[false].breite; if sT then begin for b:=false to true do fensters[b].free; result:=true; exit; end; if hintergrundAbziehen then case genauigkeit of gSingle: hintergrund:=sWerte.ermittleHintergrund; gDouble: hintergrund:=dWerte.ermittleHintergrund; gExtended: hintergrund:=eWerte.ermittleHintergrund; end{of case}; gibAus('berechne t-FFT ...',3); if not fft(threads,true,false,doRes,doResSmi,fensters[true],hintergrund,pvFehler,Warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); gibAus('berechne x-FFT ...',3); if not fft(threads,false,false,doRes,doResSmi,fensters[false],0,pvFehler,Warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); for b:=false to true do fensters[b].free; gibAus('spektrale Beträge ermitteln',3); betraege:=tWerte.create(self,0,_xSteps-1); betraege.fft2dNachbearbeitung(threads,doBetrQdr); gibAus('hohe Frequenzen filtern',3); case genauigkeit of gSingle: sWerte.kantenFilter(betraege.sWerte,xFak,yFak,kfTiefpass); gDouble: dWerte.kantenFilter(betraege.dWerte,xFak,yFak,kfTiefpass); gExtended: eWerte.kantenFilter(betraege.eWerte,xFak,yFak,kfTiefpass); end{of case}; betraege.free; gibAus('berechne inverse x-FFT ...',3); if not fft(threads,false,true,doResSmi,doRes,nil,0,pvFehler,wsLasch) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); gibAus('berechne inverse t-FFT ...',3); if not fft(threads,true,true,doResSmi,doBetr,nil,hintergrund,pvFehler,Warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.extrahierePhase(sT: boolean; f: tMyStringList; threads: longint; Warn: tWarnstufe): boolean; var Zeit,pvFehler,hintergrund,xFak,yFak: extended; fensters: array[boolean] of tSin2Fenster; s: string; b,hintergrundAbziehen: boolean; bekannteBefehle: tMyStringList; maxPos: tIntPoint; betraege: tWerte; begin result:=false; Zeit:=now; if not sT then gibAus('Phase extrahieren ...',3); for b:=false to true do fensters[b]:=tSin2Fenster.create; hintergrundAbziehen:=false; hintergrund:=0; xFak:=1; yFak:=1; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); for b:=false to true do fensters[b].free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; bekannteBefehle.add('''x-Fenster: ...'''); bekannteBefehle.add('''t-Fenster: ...'''); 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 istDasBefehl('Hintergrund abziehen',s,bekannteBefehle,false) then begin hintergrundAbziehen:=true; continue; end; if istDasBefehl('Abstandsmetrik',s,bekannteBefehle,true) then begin xFak:=round(kont2diskFak('x',exprToFloat(sT,erstesArgument(s)))); yFak:=round(kont2diskFak('t',exprToFloat(sT,s))); end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht beim Extrahieren der Phase!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; fensters[true].breite:=_tSiz-fensters[true].breite; fensters[false].breite:=_xSteps-fensters[false].breite; if sT then begin for b:=false to true do fensters[b].free; result:=true; exit; end; if hintergrundAbziehen then case genauigkeit of gSingle: hintergrund:=sWerte.ermittleHintergrund; gDouble: hintergrund:=dWerte.ermittleHintergrund; gExtended: hintergrund:=eWerte.ermittleHintergrund; end{of case}; gibAus('berechne t-FFT ...',3); if not fft(threads,true,false,doRes,doResSmi,fensters[true],hintergrund,pvFehler,Warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); gibAus('berechne x-FFT ...',3); if not fft(threads,false,false,doRes,doResSmi,fensters[false],0,pvFehler,Warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); for b:=false to true do fensters[b].free; gibAus('spektrale Beträge ermitteln',3); betraege:=tWerte.create(self,0,_xSteps-1); betraege.fft2dNachbearbeitung(threads,doBetrQdr); fft2dNachbearbeitung(threads,doAlleResIms); gibAus('tiefe Frequenzen filtern',3); case genauigkeit of gSingle: sWerte.kantenFilter(betraege.sWerte,xFak,yFak,kfHochpass,true,maxPos); gDouble: dWerte.kantenFilter(betraege.dWerte,xFak,yFak,kfHochpass,true,maxPos); gExtended: eWerte.kantenFilter(betraege.eWerte,xFak,yFak,kfHochpass,true,maxPos); end{of case}; betraege.free; gibAus('zentrieren '+tIntPointToStr(maxPos),3); verschiebe(threads,maxPos); gibAus('berechne inverse x-FFT ...',3); if not fft(threads,false,true,doAlleResIms,doAlleResIms,nil,0,pvFehler,wsLasch) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); gibAus('berechne inverse t-FFT ...',3); if not fft(threads,true,true,doAlleResIms,doAlleResIms,nil,hintergrund,pvFehler,Warn) then begin gibAus('Es traten Fehler auf!',3); exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); gibAus('Phasenwinkel ermitteln ...',3); ermittlePhasenWinkel(threads); gibAus('... fertig '+timetostr(now-Zeit),3); result:=true; end; function tWerte.macheKomplex(sT: boolean; f: tMyStringList; threads: longint): boolean; var bekannteBefehle: tMyStringList; komplexMachModus: tKomplexMachModus; kmThreads: array of tKomplexMachThread; s: string; i: longint; fertig: boolean; begin result:=false; if istKomplex then begin gibAus('Werte '''+bezeichner+''' sind bereits komplex!',3); exit; end; komplexMachModus:=kmmImNull; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('rein reell',s,bekannteBefehle,false) then begin komplexMachModus:=kmmImNull; continue; end; if istDasBefehl('rein imaginär',s,bekannteBefehle,false) then begin komplexMachModus:=kmmReNull; continue; end; if istDasBefehl('zufällige Phase',s,bekannteBefehle,false) then begin komplexMachModus:=kmmPhZuf; continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht beim Komplexmachen!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; _tSiz:=_tSiz*2; case genauigkeit of gSingle: sWerte.params.istKomplex:=true; gDouble: dWerte.params.istKomplex:=true; gExtended: eWerte.params.istKomplex:=true; end{of case}; if sT then begin result:=true; exit; end; holeRAM(3); setLength(kmThreads,threads); for i:=0 to length(kmThreads)-1 do kmThreads[i]:=tKomplexMachThread.create( self, round(i/threads*(_tSiz div 2)), round((i+1)/threads*(_tSiz div 2))-1, komplexMachModus, random(high(longword)) ); repeat fertig:=true; for i:=0 to length(kmThreads)-1 do fertig:=fertig and kmThreads[i].fertig; if not fertig then sleep(10); until fertig; for i:=0 to length(kmThreads)-1 do kmThreads[i].free; result:=true; end; function tWerte.berechneIntegral(sT: boolean; f: tMyStringList; threads: longint; quelle: tWerte): boolean; var i,tMin,tMax,xMin,xMax: longint; Zeit: extended; s: string; rtg: tIntegrationsRichtung; intThreads: array of tIntegralThread; fertig: boolean; bekannteBefehle: tMyStringList; begin result:=false; warteAufBeendigungDesLeseThreads; Zeit:=now; tMin:=0; tMax:=quelle._tSiz-1; xMin:=0; xMax:=quelle._xSteps-1; genauigkeit:=gExtended; rtg:=irHorizontal; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('Threadanzahl:',s,bekannteBefehle,true) then begin threads:=strtoint(s); continue; end; if istDasBefehl('xMin:',s,bekannteBefehle,true) then begin xMin:=quelle.kont2disk('x',quelle.exprToFloat(sT,s)); continue; end; if istDasBefehl('xMax:',s,bekannteBefehle,true) then begin xMax:=quelle.kont2disk('x',quelle.exprToFloat(sT,s)); continue; end; if istDasBefehl('tMin:',s,bekannteBefehle,true) then begin tMin:=quelle.kont2disk('t',quelle.exprToFloat(sT,s)); continue; end; if istDasBefehl('tMax:',s,bekannteBefehle,true) then begin tMax:=quelle.kont2disk('t',quelle.exprToFloat(sT,s)); continue; end; if istDasBefehl('Richtung:',s,bekannteBefehle,true) then begin bekannteBefehle.clear; if istDasBefehl('waagerecht',s,bekannteBefehle,false) then begin rtg:=irHorizontal; continue; end; if istDasBefehl('einfall',s,bekannteBefehle,false) then begin rtg:=irEinfall; continue; end; if istDasBefehl('ausfall',s,bekannteBefehle,false) then begin rtg:=irAusfall; continue; end; bekannteBefehle.sort; gibAus('Verstehe Richtung '''+s+''' nicht bei Berechnung eines Integrals!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Berechnung eines Integrals!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; tMin:=max(0,tMin); tMax:=min(quelle._tSiz-1,tMax); xMin:=max(0,xMin); xMax:=min(quelle._xSteps-1,xMax); transformationen:=tKoordinatenAusschnitt.create(quelle.transformationen,xMin,xMax,tMin,tMax); if not sT then begin _tSiz:=tMax-tMin+1; _xSteps:=xMax-xMin+1; 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(10); 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; f: tMyStringList; threads: longint; Warn: tWarnstufe): boolean; var Zeit,pvFehler: extended; nB: tFFTDatenordnung; fenster: tSin2Fenster; senkrecht: boolean; s: string; bekannteBefehle: tMyStringList; begin result:=false; warteAufBeendigungDesLeseThreads; Zeit:=now; nB:=doBetrQdr; fenster:=tSin2Fenster.create; senkrecht:=true; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); fenster.free; bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('Nachbereitung:',s,bekannteBefehle,true) then begin if not strToFftDo(nB,s) then exit; continue; end; if istDasBefehl('Fenster:',s,bekannteBefehle,true) 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 istDasBefehl('senkrecht',s,bekannteBefehle,false) then begin senkrecht:=true; continue; end; if istDasBefehl('waagerecht',s,bekannteBefehle,false) then begin senkrecht:=false; continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer FFT!'#10'Ich kenne:'#10+bekannteBefehle.text,3); fenster.free; bekannteBefehle.free; exit; until false; bekannteBefehle.free; 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,0,pvFehler,Warn) then begin gibAus('Es traten Fehler auf!',3); fenster.free; exit; end; gibAus(' (Parseval-Fehler = '+floatToStr(pvFehler)+')',3); end; transformationen:=tFFTTransformation.create(transformationen,not senkrecht,senkrecht); if not sT then begin holeRAM(0); gibAus('... fertig! '+timetostr(now-Zeit),3); end; fenster.free; result:=true; end; function tWerte.berechneFFT2d(sT: boolean; f: tMyStringList; threads: longint; Warn: tWarnstufe): boolean; var Zeit,pvFehler: extended; dos: array[0..4] of tFFTDatenordnung; // FFT1 in -> out, // FFT2 in -> out, // Ende (= Benutzervorgabe) fensters: array[boolean] of tSin2Fenster; s: string; b,spiegeln: boolean; bekannteBefehle: tMyStringList; begin result:=false; warteAufBeendigungDesLeseThreads; Zeit:=now; if istKomplex then dos[4]:=doAlleResIms else dos[4]:=doBetrQdr; for b:=false to true do fensters[b]:=tSin2Fenster.create; spiegeln:=false; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende!',3); for b:=false to true do fensters[b].free; bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; if istDasBefehl('Nachbereitung:',s,bekannteBefehle,true) then begin if not strToFftDo(dos[4],s) then exit; continue; end; bekannteBefehle.add('''x-Fenster: ...'''); bekannteBefehle.add('''t-Fenster: ...'''); if (pos('-Fenster:',s)=2) and (s[1] in ['x','t']) then begin b:=s[1]='t'; erstesArgument(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 istDasBefehl('x-Spiegelung',s,bekannteBefehle,false) then begin spiegeln:=true; continue; end; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Erstellung einer zweidimensionalen FFT!'#10'Ich kenne:'#10+bekannteBefehle.text,3); for b:=false to true do fensters[b].free; bekannteBefehle.free; exit; until false; bekannteBefehle.free; fensters[true].breite:=_tSiz-fensters[true].breite; fensters[false].breite:=_xSteps-fensters[false].breite; if istKomplex xor (dos[4] in [doAlleResIms, doAlleResSmi]) then begin gibAus('Eine 2d-FFT gibt genau dann alle Real- und Imaginärteile aus, wenn die Eingabe komplex ist!',3); exit; end; if istKomplex then begin dos[0]:=doAlleResIms; dos[1]:=doAlleResIms; dos[2]:=doAlleResIms; dos[3]:=dos[4]; end else begin dos[0]:=doRes; dos[2]:=doRes; if dos[4]=doResIms then begin dos[1]:=doResIms; dos[3]:=doResIms; end else begin dos[1]:=doResSmi; dos[3]:=doResSmi; end; end; if sT then begin result:=true; for b:=false to true do fensters[b].free; exit; end; transformationen:=tFFTTransformation.create(transformationen,true,true); 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,true,false,dos[0],dos[1],fensters[true],0,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,false,false,dos[2],dos[3],fensters[false],0,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); if dos[3]<>dos[4] then fft2dNachbearbeitung(threads,dos[4]); gibAus('... fertig! '+timetostr(now-Zeit),3); for b:=false to true do fensters[b].free; 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, xp0,tp0: extended; xMin,xMax,tMin,tMax,xp,tp, breite,hoehe,lOf,rOf,oOf,uOf: longint; paletten: tPalettenArray; nachbearbeitungen: tTransformationArray; Ausschnitt: tTransformation; bilderThreads: array of tBilderThread; fertig,rahmen: boolean; img: file; achsen: array of tAchse; fontRenderer: tFontRenderer; beschriftungen: array of tBeschriftung; verwKonturen: array of tZuZeichnendeKontur; musterKontur: tZuZeichnendeKontur; quellen: tWerteArray; bekannteBefehle: tMyStringList; procedure aufraeumen; var ii: longint; begin for ii:=0 to length(nachbearbeitungen)-1 do zerstoereTransformationWennObsolet(nachbearbeitungen[ii]); setLength(nachbearbeitungen,0); Ausschnitt.free; Ausschnitt:=nil; 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; for ii:=0 to length(verwKonturen)-1 do verwKonturen[ii].free; setLength(verwKonturen,0); musterKontur.free; bekannteBefehle.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; setLength(quellen,1); quellen[0]:=self; setLength(nachbearbeitungen,1); nachbearbeitungen[0]:=tKeineTransformation.create; setLength(paletten,1); findePalette(paletten[0],'Graustufen'); setLength(achsen,0); setLength(verwKonturen,0); musterKontur:=tZuZeichnendeKontur.create; setLength(beschriftungen,0); setLength(bilderThreads,0); Ausschnitt:=nil; rahmen:=false; fontRenderer:=nil; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); aufraeumen; exit; end; bekannteBefehle.clear; if istDasBefehl('Datei:',s,bekannteBefehle,true) then begin datei:=s; continue; end; if istDasBefehl('Vergrößerung:',s,bekannteBefehle,true) then begin xZoom:=exprToFloat(sT,s); yZoom:=exprToFloat(sT,s); continue; end; if istDasBefehl('x-Vergrößerung:',s,bekannteBefehle,true) then begin xZoom:=exprToFloat(sT,s); continue; end; if istDasBefehl('t-Vergrößerung:',s,bekannteBefehle,true) then begin yZoom:=exprToFloat(sT,s); continue; end; if self.dichtenParameterErkannt(sT,s,bekannteBefehle,maxThreads,xMin,xMax,tMin,tMax) then continue; if istDasBefehl('xMin:',s,bekannteBefehle,true) then begin xMin:=kont2disk('x',exprToFloat(sT,s)); continue; end; if istDasBefehl('xMax:',s,bekannteBefehle,true) then begin xMax:=kont2disk('x',exprToFloat(sT,s)); continue; end; if istDasBefehl('tMin:',s,bekannteBefehle,true) then begin tMin:=kont2disk('t',exprToFloat(sT,s)); continue; end; if istDasBefehl('tMax:',s,bekannteBefehle,true) then begin tMax:=kont2disk('t',exprToFloat(sT,s)); continue; end; if istDasBefehl('Palette:',s,bekannteBefehle,true) then begin if s[1] in ['0'..'9'] then i:=strtoint(erstesArgument(s)) else i:=0; while i>=length(paletten) do begin setLength(paletten,length(paletten)+1); paletten[length(paletten)-1]:=nil; end; if not findePalette(paletten[i],s) then begin gibAus('Kenne Palette '''+s+''' nicht!'#10'Ich kenne nur:'#10+dumpPalettenNamen,3); aufraeumen; exit; end; continue; end; if istDasBefehl('Schriftgröße:',s,bekannteBefehle,true) then begin schriftgroesze:=strtoint(s); continue; end; if istDasBefehl('Rahmen',s,bekannteBefehle,false) then begin rahmen:=true; continue; end; if istDasBefehl('Nachbearbeitung:',s,bekannteBefehle,true) then begin if s[1] in ['0'..'9'] then i:=strtoint(erstesArgument(s)) else i:=0; if i>=length(nachbearbeitungen) then begin j:=length(nachbearbeitungen); setLength(nachbearbeitungen,i+1); while j'' do begin setLength(verwKonturen,length(verwKonturen)+1); i:=findeKontur(erstesArgument(s),nil,wertes,konturen,false); if (i<0) or (i>=length(konturen^)) then begin gibAus('Die Kontur '''+s+''' gibt es nicht!',3); aufraeumen; exit; end; verwKonturen[length(verwKonturen)-1]:=tZuZeichnendeKontur.create(musterKontur,konturen^[i]); end; until false; continue; end; if istDasBefehl('Daten:',s,bekannteBefehle,true) then begin i:=strtoint(erstesArgument(s)); if i>=length(quellen) then begin j:=length(quellen); setLength(quellen,i+1); while jlength(quellen)) or (length(nachbearbeitungen)<>length(quellen)) then begin gibAus( 'Die Anzahl der Paletten ('+intToStr(length(paletten))+'), '+ 'der Daten ('+intToStr(length(quellen))+') und '+ 'der Nachbearbeitungen ('+intToStr(length(nachbearbeitungen))+') stimmen nicht überein!',3); aufraeumen; exit; end; 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 div (1+byte(istKomplex))-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+1)*xZoom); hoehe:=round((tMax-tMin+1)*yZoom); Ausschnitt:=tKoordinatenAusschnitt.create(transformationen,xMin,xMax,tMin,tMax); 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 miW:=Ausschnitt.achsen['x','x']; maW:=Ausschnitt.achsen['x','y']; end else begin miW:=Ausschnitt.achsen['y','x']; maW:=Ausschnitt.achsen['y','y']; 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:=Ausschnitt.wertZuPositionAufAchse(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); aufraeumen; exit; 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,quellen,xMin,xMax,tMin,tMax,xZoom,yZoom,nachbearbeitungen,paletten,@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(10); 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 begin for j:=0 to length(bilderThreads)-1 do bilderThreads[j].initAnzahlensFuerKontur; for j:=0 to length(verwKonturen[i].kontur.orte)-1 do begin xp0:=(kont2diskFak('x',verwKonturen[i].kontur.orte[j]['x'])-xMin)*xZoom; tp0:=(kont2diskFak('t',verwKonturen[i].kontur.orte[j]['y'])-tMin)*yZoom; for xp:=ceil(xp0-verwKonturen[i].dicke/2) to floor(xp0+verwKonturen[i].dicke/2) do for tp:=ceil(tp0-verwKonturen[i].dicke/2) to floor(tp0+verwKonturen[i].dicke/2) do if (0<=xp) and (xp=bilderThreads[k+1].xPMi) do inc(k); if bilderThreads[k].anzahlens[0,(tp+oOf)*bilderThreads[k].breite + xp - bilderThreads[k].xPMi] = 0 then begin bilderThreads[k].anzahlens[0,(tp+oOf)*bilderThreads[k].breite + xp - bilderThreads[k].xPMi]:=1; bilderThreads[k].farben[(tp+oOf)*bilderThreads[k].breite + xp - bilderThreads[k].xPMi]:= mischeFarben( bilderThreads[k].farben[(tp+oOf)*bilderThreads[k].breite + xp - bilderThreads[k].xPMi], verwKonturen[i].farbe, verwKonturen[i].deckKraft ); end; end; 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; f: tMyStringList): boolean; var datei,s,separator: string; outF: textfile; i,j: longint; xMin,xMax,tMin,tMax: longint; Zeit: extended; mitKoordinaten: byte; bekannteBefehle: tMyStringList; 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:=','; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Datei:',s,bekannteBefehle,true) then begin datei:=s; continue; end; if istDasBefehl('xMin:',s,bekannteBefehle,true) then begin xMin:=kont2disk('x',exprToFloat(sT,s)); continue; end; if istDasBefehl('xMax:',s,bekannteBefehle,true) then begin xMax:=kont2disk('x',exprToFloat(sT,s)); continue; end; if istDasBefehl('tMin:',s,bekannteBefehle,true) then begin tMin:=kont2disk('t',exprToFloat(sT,s)); continue; end; if istDasBefehl('tMax:',s,bekannteBefehle,true) then begin tMax:=kont2disk('t',exprToFloat(sT,s)); continue; end; if istDasBefehl('Koordinaten einfügen',s,bekannteBefehle,false) then begin if (_xSteps=1) or (_tSiz=1) then begin mitKoordinaten:=byte(_xSteps=1)*2 + byte(_tSiz=1); continue; end; gibAus('Kann Koordinaten nicht in mehrdimensionale Daten einfügen!',3); bekannteBefehle.free; exit; end; if istDasBefehl('Separator:',s,bekannteBefehle,true) then begin if s='Leerzeichen' then begin separator:=' '; continue; end; if s='Tab' then begin separator:=#9; continue; end; separator:=s; continue; end; if istDasBefehl('Ende',s,bekannteBefehle,false) then break; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Erzeugung einer Ascii-Datei!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; 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('waagerecht',params) then b1:=true else if startetMit('senkrecht',params) then b1:=false else exit; if sT then begin result:=true; exit; end; if b1 then s:='waagerecht' else s:='senkrecht'; 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(10); 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:=tSpiegelungsTransformation.create(transformationen); gibAus('Alle Spiegelthreads fertig!',1); end; procedure tWerte.fuelleMitDummys(sT: boolean); var i,j,ts2: int64; begin genauigkeit:=gExtended; transformationen:=tKeineTransformation.create; transformationen.xStart:=-1; transformationen.xStop:=1; transformationen.tStart:=-1; transformationen.tStop:=1; _xSteps:=1024; ts2:=512; _tSiz:=2*ts2; transformationen.xSteps:=_xSteps; transformationen.tSiz:=_tSiz div 2; if sT then exit; holeRAM(3); for j:=0 to ts2-1 do for i:=0 to _xSteps-1 do begin eWerte.werte[i+j*_xSteps]:= 2*i/(_xSteps-1)-1; eWerte.werte[i+(j+ts2)*_xSteps]:= 2*j/(_tSiz-1)-1; end; end; procedure tWerte.verschiebe(threads: longint; richtung: tIntPoint); var einheitsZelle: tIntPoint; teilRichtung: char; verschiebeThreads: array of tVerschiebeThread; i: longint; fertig: boolean; begin einheitsZelle:=berechneEinheitsZelle(richtung,intPoint(_xSteps,_tSiz div (1+byte(istKomplex)))); teilRichtung:=char(ord('x')+byte(einheitsZelle['y']>einheitsZelle['x'])); if einheitsZelle[teilRichtung]eWerte.params then result:='!! '+result; end; procedure tWerte.beendeLeseThreadWennFertig; begin if assigned(leseThread) and leseThread.fertig then begin leseThread.free; leseThread:=nil; end; end; // tZuZeichnendeKontur ********************************************************* constructor tZuZeichnendeKontur.create; begin inherited create; farbe:=rgb($00,$00,$00); deckKraft:=1; dicke:=1; kontur:=nil; end; constructor tZuZeichnendeKontur.create(original: tZuZeichnendeKontur; kont: tKontur); begin inherited create; farbe:=original.farbe; deckKraft:=original.deckKraft; dicke:=original.dicke; kontur:=kont; end; destructor tZuZeichnendeKontur.destroy; begin kontur:=nil; inherited destroy; end; // tLogThread ****************************************************************** constructor tLogThread.create; begin inherited create(true); raisedException:=nil; freeonterminate:=false; fertig:=false; erfolg:=true; end; destructor tLogThread.destroy; begin raisedException.free; if (not behalteLogs) and erfolg and not odd(__ausgabenMaske) then cleanupLog(threadID); inherited destroy; end; function tLogThread.rFertig: boolean; var ei: string; i: longint; begin if assigned(raisedException) then begin if self is tBefehlThread then begin if assigned((self as tBefehlThread).p) then begin ei:=' '''+(self as tBefehlThread).p.executable+''''; for i:=0 to (self as tBefehlThread).p.parameters.count-1 do ei:=ei+' '''+(self as tBefehlThread).p.parameters[i]+''''; ei:=ei; end else ei:=': p=NIL'; end else ei:=''; raise exception.create('Fehler innerhalb eines Threads ('+className+')'+ei+'!'); end; 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; 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); end; // tQuotientThread ************************************************************* constructor tQuotientThread.create(dividend, divisor, quotient: tWerte; epsilon: extended; xMin,xMax,tMin,tMax,xOff,tOff: longint); begin inherited create; dend:=dividend; sor:=divisor; quot:=quotient; eps:=epsilon; xMi:=xMin; xMa:=xMax; tMi:=tMin; tMa:=tMax; tOf:=tOff; xOf:=xOff; gibAus('Starte Quotient-Berechnungsthread!',1); suspended:=false; end; procedure tQuotientThread.stExecute; var i,j: longint; 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; for k:=0 to length(wertes)-1 do if length(wertes[k])>0 then begin b:=false; for i:=0 to length(wertes[k])-1 do b:=b or (wertes[k,i]<>0); wert:=wertes[k,0]; for i:=0 to length(wertes[k])-1 do wert:=max(wert,wertes[k,i]); gibAus('Thread '+intToStr(nummer)+' hat max. ['+intToStr(k)+'] '+myFloatToStr(wert),1); for i:=0 to length(wertes[k])-1 do wert:=min(wert,wertes[k,i]); gibAus('Thread '+intToStr(nummer)+' hat min. ['+intToStr(k)+'] '+myFloatToStr(wert),1); if not b then gibAus('Thread '+intToStr(nummer)+' hat nur Nullen!',1); end; gibAus('Thread '+intToStr(nummer)+' fertig!',1); end; procedure tBilderThread.initAnzahlensFuerKontur; var ii: longint; begin for ii:=1 to length(anzahlens)-1 do setLength(anzahlens[ii],0); setLength(anzahlens,1); setLength(anzahlens[0],length(farben)); for ii:=0 to length(anzahlens[0])-1 do anzahlens[0,ii]:=0; end; // tDichteThread *************************************************************** constructor tDichteThread.create(xMi,xMa,tMi,tMa: longint; const werte: tWerte); begin inherited create; xMin:=xMi; xMax:=xMa; tMin:=tMi; tMax:=tMa; w:=werte; maxDichte:=0; gibAus('Dichtethread kreiert: '+intToStr(xMin)+'-'+intToStr(xMax)+' '+intToStr(tMin)+'-'+intToStr(tMax),1); suspended:=false; end; procedure tDichteThread.stExecute; begin gibAus('Dichtethread gestartet!',1); case w.genauigkeit of gSingle: w.sWerte.gibMinMaxDichten(minDichte,maxDichte,xMin,xMax,tMin,tMax); 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); end; // tFFTThread ****************************************************************** constructor tFFTThread.create(werte: tWerte; sMin,sMax: longint; senkrecht,invers: boolean; const vor,nach: tFFTDatenordnung; fenster: tFenster; hintergrund: extended); var tmpFFTAlgo: tFFTAlgorithmus; halberInput: boolean; begin halberInput:=vor in [doAlleResIms,doAlleResSmi]; if halberInput and assigned(fenster) then gibAus('Warnung: Diese Form der FFT ('+fftDoToStr(vor)+' -> '+fftDoToStr(nach)+') verhält sich beim Fenstern nicht so, wie man meinen möchte!',3); if senkrecht then tmpFFTAlgo:=createFFTAlgorithmus(werte._tSiz div (1+byte(halberInput)),vor,nach) else tmpFFTAlgo:=createFFTAlgorithmus(werte._xSteps,vor,nach); create(werte,sMin,sMax,senkrecht,invers,tmpFFTAlgo,fenster,hintergrund); tmpFFTAlgo.free; end; constructor tFFTThread.create(werte: tWerte; sMin,sMax: longint; senkrecht,invers: boolean; algorithmus: tFFTAlgorithmus; fenster: tFenster; hintergrund: extended); begin inherited create; pW:=werte; sMi:=sMin; sMa:=sMax; sen:=senkrecht; inv:=invers; algo:=createFFTAlgorithmus(algorithmus); fen:=fenster; hg:=hintergrund; erfolg:=false; gibAus('FFTthread kreiert ('+intToStr(pW._xSteps)+' x '+intToStr(pW._tSiz)+': '+intToStr(sMi)+' .. '+intToStr(sMa)+'): '+algo.className,3); suspended:=false; end; procedure tFFTThread.stExecute; begin gibAus('FFTthread gestartet ('+intToStr(pW._xSteps)+' x '+intToStr(pW._tSiz)+': '+intToStr(sMi)+' .. '+intToStr(sMa)+'): '+algo.className+' ...',1); case pW.genauigkeit of gSingle: erfolg:=pW.sWerte.fft(sMi,sMa,sen,inv,algo,fen,hg,pvFehler); gDouble: erfolg:=pW.dWerte.fft(sMi,sMa,sen,inv,algo,fen,hg,pvFehler); gExtended: erfolg:=pW.eWerte.fft(sMi,sMa,sen,inv,algo,fen,hg,pvFehler); end{of case}; gibAus('... und fertig! ',1); end; // tSpiegelThread ************************************************************** constructor tSpiegelThread.create(tMi,tMa: longint; pWerte: tWerte); begin inherited create; tMin:=tMi; tMax:=tMa; pW:=pWerte;; gibAus('Spiegelthread kreiert: '+intToStr(tMin)+'-'+intToStr(tMax),1); suspended:=false; end; procedure tSpiegelThread.stExecute; begin gibAus('Spiegelthread gestartet: '+intToStr(tMin)+'-'+intToStr(tMax)+' ...',1); case pW.genauigkeit of gSingle: pW.sWerte.spiegle(tMin,tMax); gDouble: pW.dWerte.spiegle(tMin,tMax); gExtended: pW.eWerte.spiegle(tMin,tMax); end{of case}; gibAus('... und fertig!',1); end; // tFFT2dNBThread ************************************************************** constructor tFFT2dNBThread.create(xMi,xMa: longint; pWerte: tWerte; endordnung: tFFTDatenordnung); begin inherited create; xMin:=xMi; xMax:=xMa; pW:=pWerte; nB:=endordnung; gibAus('FFT2d-Nachbearbeitungsthread kreiert: '+intToStr(xMin)+'-'+intToStr(xMax),1); suspended:=false; end; procedure tFFT2dNBThread.stExecute; begin gibAus('FFT2d-Nachbearbeitungsthread gestartet: '+intToStr(xMin)+'-'+intToStr(xMax)+' ...',1); case pW.genauigkeit of gSingle: pW.sWerte.fft2dNachbearbeitungB(xMin,xMax,nB); gDouble: pW.dWerte.fft2dNachbearbeitungB(xMin,xMax,nB); gExtended: pW.eWerte.fft2dNachbearbeitungB(xMin,xMax,nB); end{of case}; gibAus('... und fertig!',1); end; // tGauszFitThread ************************************************************* constructor tGauszFitThread.create(daten,amplituden,breiten,positionen,ueberlappe,hintergruende: tWerte; von,bis: longint; senkrecht: boolean; fensterBreite,maxBreite,maxVerschiebung: extended; positionsMitten: tExtendedArray); begin inherited create; qu:=daten; if assigned(amplituden) then ampl:=@amplituden.eWerte else ampl:=nil; if assigned(breiten) then br:=@breiten.eWerte else br:=nil; if assigned(positionen) then posi:=@positionen.eWerte else posi:=nil; if assigned(ueberlappe) then ueberl:=@ueberlappe.eWerte else ueberl:=nil; if assigned(hintergruende) then hint:=@hintergruende.eWerte else hint:=nil; vo:=von; bi:=bis; senkr:=senkrecht; fenBr:=fensterBreite; maxBr:=maxBreite; maxVersch:=maxVerschiebung; posiMitten:=positionsMitten; gibAus('GaußFitThread kreiert: '+intToStr(von)+'-'+intToStr(bis),1); suspended:=false; end; procedure tGauszFitThread.stExecute; begin gibAus('GaußFitThread gestartet ...',1); case qu.genauigkeit of gSingle: qu.sWerte.gauszFit(ampl,br,posi,ueberl,hint,vo,bi,senkr,fenBr,maxBr,maxVersch,posiMitten); gDouble: qu.dWerte.gauszFit(ampl,br,posi,ueberl,hint,vo,bi,senkr,fenBr,maxBr,maxVersch,posiMitten); gExtended: qu.eWerte.gauszFit(ampl,br,posi,ueberl,hint,vo,bi,senkr,fenBr,maxBr,maxVersch,posiMitten); end{of case}; gibAus('... und fertig',1); end; // tKorrelThread *************************************************************** constructor tKorrelThread.create(quelle,ziel: tWerte; xMin,xMax: longint; wavelet: tWavelet); begin inherited create; qu:=quelle; zi:=ziel; xMi:=xMin; xMa:=xMax; wl:=wavelet; gibAus('Korrelationsthread kreiert: '+intToStr(xMin)+'-'+intToStr(xMax),1); suspended:=false; end; procedure tKorrelThread.stExecute; var i,j,k,hl: longint; sus,suc,tmp,pvF: extended; in0,out0: boolean; tmpW: tWerte; tmpFFTAlgo: tFFTAlgorithmus; begin gibAus('Korrelationsberechnungsthread gestartet ...',1); gibAus('('+intToStr(xMi)+'-'+intToStr(xMa)+' x '+intToStr(qu._tSiz)+'), '+intToStr(wl.werte.params.tSiz),1); in0:=true; out0:=true; pvFehler:=0; if wl.mitFFT then begin for i:=xMi to xMa do for j:=0 to qu._tSiz-1 do in0:=in0 and (zi.eWerte.werte[i+j*zi._xSteps]=0); gibAus('FFT berechnen ...',1); tmpFFTAlgo:=createFFTAlgorithmus(zi._tSiz,doRes,doResIms); zi.eWerte.fft(true,false,tmpFFTAlgo,nil,0,pvF); tmpFFTAlgo.free; 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:=qu._tSiz 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); tmpFFTAlgo:=createFFTAlgorithmus(zi._tSiz,doResIms,doBetrQdr); zi.eWerte.fft(xMi,xMa,true,true,tmpFFTAlgo,nil,0,pvF); pvFehler:=pvF+pvFehler; case wl.typ of wtSin2: begin // Das Sin²-Wavelet besteht eigntlich aus zwei! tmpW.eWerte.fft(true,true,tmpFFTAlgo,nil,0,pvF); pvFehler:=(pvF+pvFehler)/3; for i:=xMi to xMa do for j:=0 to zi._tSiz-1 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 zi._tSiz-1 do out0:=out0 and (zi.eWerte.werte[i+j*zi._xSteps]=0); end; end{of case}; tmpFFTAlgo.free; 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:=0 to zi._tSiz-1 do begin sus:=0; suc:=0; for k:=max(-wl.hLen,-j) to min(wl.hLen,qu._tSiz-j-1) do begin suc:=suc + qu.sWerte.werte[i+(j+k)*qu._xSteps]*wl.werte.werte[(k+wl.hLen)*2]; sus:=sus + qu.sWerte.werte[i+(j+k)*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+j*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:=0 to zi._tSiz-1 do begin sus:=0; suc:=0; for k:=max(-wl.hLen,-j) to min(wl.hLen,qu._tSiz-j-1) do begin suc:=suc + qu.dWerte.werte[i+(j+k)*qu._xSteps]*wl.werte.werte[(k+wl.hLen)*2]; sus:=sus + qu.dWerte.werte[i+(j+k)*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+j*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:=0 to zi._tSiz-1 do begin sus:=0; suc:=0; for k:=max(-wl.hLen,-j) to min(wl.hLen,qu._tSiz-j-1) do begin suc:=suc + qu.eWerte.werte[i+(j+k)*qu._xSteps]*wl.werte.werte[(k+wl.hLen)*2]; sus:=sus + qu.eWerte.werte[i+(j+k)*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+j*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); end; // tKontur ********************************************************************* constructor tKontur.create(kont: pTKonturenArray; wert: pTWerteArray); begin inherited create(kont,wert); 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.exprToFloat(sT: boolean; s: string; kvs: tKnownValues): extended; begin result:=matheunit.exprToFloat(sT,s,kvs,@callBackGetValue); end; function tKontur.init(sT: boolean; f: tMyStringList; w: pTWerteArray; mT: longint): boolean; var s,xMi,xMa,tMi,tMa,dx,dt: string; i,j,k: longint; bekannteBefehle: tMyStringList; begin result:=false; gibAus('Kontur erzeugen ...',1); xMi:='-1e9'; xMa:='1e9'; tMi:='-1e9'; tMa:='1e9'; dx:='1'; dt:='1'; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); bekannteBefehle.free; exit; end; if istDasBefehl('Datei:',s,bekannteBefehle,true) then begin if length(orte)>0 then begin gibAus('Diese Kontur hat schon Werte!',3); bekannteBefehle.free; exit; end; if not liesVonDatei(sT,s,exprToFloat(sT,xMi,nil),exprToFloat(sT,xMa,nil),exprToFloat(sT,tMi,nil),exprToFloat(sT,tMa,nil)) then begin bekannteBefehle.free; exit; end; continue; end; if istDasBefehl('Werte:',s,bekannteBefehle,true) then begin if length(orte)>0 then begin gibAus('Diese Kontur hat schon Werte!',3); bekannteBefehle.free; exit; end; if not erzeugeAusWerten(sT,s,w,mT,xMi,xMa,tMi,tMa) then begin bekannteBefehle.free; exit; end; continue; end; if istDasBefehl('xMin:',s,bekannteBefehle,true) then begin xMi:=s; continue; end; if istDasBefehl('xMax:',s,bekannteBefehle,true) then begin xMa:=s; continue; end; if istDasBefehl('tMin:',s,bekannteBefehle,true) then begin tMi:=s; continue; end; if istDasBefehl('tMax:',s,bekannteBefehle,true) then begin tMa:=s; continue; end; if istDasBefehl('dx:',s,bekannteBefehle,true) then begin dx:=s; continue; end; if istDasBefehl('dy:',s,bekannteBefehle,true) or istDasBefehl('dt:',s,bekannteBefehle,true) then begin dt:=s; continue; end; if istDasBefehl('reduziere nach',s,bekannteBefehle,true) then begin if not sT then if not sortiereNachY(mT) then begin bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('rechts',s,bekannteBefehle,false) 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 istDasBefehl('links',s,bekannteBefehle,false) 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),nil,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(10); 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.erzeugeAusFunktion(sT: boolean; s: string; xMi,xMa,tMi,tMa,dx,dt: extended; mT: longint): boolean; var xf,yf: string; kvs: tKnownValues; pOrte: array of array[0..2] of extended; baustellen: array of tIntPoint; lenPO,lenB,i: longint; procedure berechnePOrt(i: longint); inline; begin kvs.add(s,pOrte[i,0]); pOrte[i,1]:=exprToFloat(sT,xf,kvs); pOrte[i,2]:=exprToFloat(sT,yf,kvs); end; function pOIndexInnerhalb(i: longint): boolean; inline; begin result:=(i>=0) and (i=xMi) and (pOrte[i,1]<=xMa) and (pOrte[i,2]>=tMi) and (pOrte[i,2]<=tMa); end; function punkteFastGleich(i1,i2: longint): boolean; inline; begin result:= pOIndexInnerhalb(i1) and pOIndexInnerhalb(i2) and (abs(round(pOrte[i1,1]/dx)-round(pOrte[i2,1]/dx))<=1) and (abs(round(pOrte[i1,2]/dt)-round(pOrte[i2,2]/dt))<=1); end; function baustelleUeberfluessig(i: longint): boolean; inline; begin result:= punkteFastGleich(baustellen[i,'x'],baustellen[i,'y']); end; begin result:=false; xf:=erstesArgument(s,';'); yf:=erstesArgument(s,';'); kvs:=tKnownValues.create; lenPO:=1; setLength(pOrte,speicherHappen); pOrte[0,0]:=0; berechnePOrt(0); if sT then begin result:=true; kvs.free; setLength(pOrte,0); exit; end; if not liegtInnerhalb(0) then begin gibAus('Die Funktionen '''+xf+''' bzw. '''+yf+''' erzeugen für '''+s+'''=0 keinen Punkt innerhalb der Grenzen ('+floatToStr(xMi)+'..'+floatToStr(xMa)+' x '+floatToStr(tMi)+'..'+floatToStr(tMa)+')!',3); kvs.free; setLength(pOrte,0); exit; end; lenB:=2; setLength(baustellen,speicherHappen); baustellen[0,'x']:=low(longint); baustellen[0,'y']:=0; baustellen[1,'x']:=0; baustellen[1,'y']:=high(longint); while lenB>0 do begin if baustelleUeberfluessig(lenB-1) then begin dec(lenB); continue; end; if length(baustellen)<=lenB+1 then setLength(baustellen,lenB+speicherHappen); if length(pOrte)<=lenPO+2 then setLength(pOrte,lenPO+speicherHappen); inc(lenPO); if baustellen[lenB-1,'x']=low(longint) then pOrte[lenPO-1,0]:=pOrte[baustellen[lenB-1,'y'],0]-max(round(max(dx,dt)),1) else if baustellen[lenB-1,'y']=high(longint) then pOrte[lenPO-1,0]:=pOrte[baustellen[lenB-1,'x'],0]+max(round(max(dx,dt)),1) else pOrte[lenPO-1,0]:=(pOrte[baustellen[lenB-1,'x'],0] + pOrte[baustellen[lenB-1,'y'],0])/2; berechnePOrt(lenPO-1); case 4*byte(liegtInnerhalb(lenPO-1)) + 2*byte(liegtInnerhalb(baustellen[lenB-1,'x'])) + byte(liegtInnerhalb(baustellen[lenB-1,'y'])) of 3..7: begin // Punkt oder wenigstens beide Grenzen innerhalb => Baustelle wird vmtl. geteilt baustellen[lenB,'x']:=lenPO-1; baustellen[lenB,'y']:=baustellen[lenB-1,'y']; baustellen[lenB-1,'y']:=lenPO-1; inc(lenB); if baustelleUeberfluessig(lenB-2) then begin baustellen[lenB-2]:=baustellen[lenB-1]; dec(lenB); end; if baustelleUeberfluessig(lenB-1) then dec(lenB); end; 2: // Punkt und rechte Grenze außerhalb => rechte Grenze auf neuen Punkt verschieben if pOIndexInnerhalb(baustellen[lenB-1,'y']) then begin // rechte Grenze ist real pOrte[baustellen[lenB-1,'y']]:=pOrte[lenPO-1]; // dann wird der Ort verschoben dec(lenPO); // und der alte gelöscht end else // sonst baustellen[lenB-1,'y']:=lenPO-1; // wird nur der Ortsindex verschoben 1: // Punkt und linke Grenze außerhalb => linke Grenze auf neuen Punkt verschieben if pOIndexInnerhalb(baustellen[lenB-1,'x']) then begin // linke Grenze ist real pOrte[baustellen[lenB-1,'x']]:=pOrte[lenPO-1]; // dann wird der Ort verschoben dec(lenPO); // und der alte gelöscht end else // sonst baustellen[lenB-1,'x']:=lenPO-1; // wird nur der Ortsindex verschoben 0: begin // alles außer Rand und Band => Baustelle und Punkt entfernen dec(lenB); dec(lenPO); end; end{of case}; end; setLength(orte,lenPO); for i:=0 to lenPO-1 do begin orte[i,'x']:=i; orte[i,'y']:=pOrte[i,0]; end; if not sortiereNachY(mT) then begin setLength(baustellen,0); setLength(pOrte,0); kvs.free; exit; end; for i:=0 to lenPO-1 do begin orte[i,'y']:=pOrte[round(orte[i,'x']),2]; orte[i,'x']:=pOrte[round(orte[i,'x']),1]; end; setLength(baustellen,0); setLength(pOrte,0); kvs.free; result:=true; end; function tKontur.sortiereNachY(mT: longint): boolean; begin result:=sortiereNachY(mT,0,length(orte)-1); end; function tKontur.sortiereNachY(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); exit; end; result:=true; exit; end; if mT<=1 then result:=sortiereNachY(mT,von,i-1) and sortiereNachY(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(10); 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}; end; // tIntegralThread ************************************************************* constructor tIntegralThread.create(quelle, ziel: tWerte; xMin, xMax, tMin, tMax, xOff, tOff: longint; richtung: tIntegrationsRichtung); begin inherited create; qu:=quelle; zi:=ziel; xMi:=xMin; xMa:=xMax; tMi:=tMin; tMa:=tMax; xOf:=xOff; tOf:=tOff; rtg:=richtung; gibAus('Integralthread kreiert',1); suspended:=false; end; procedure tIntegralThread.stExecute; begin gibAus('Integralthread gestartet ('+intToStr(xMi)+'-'+intToStr(xMa)+'x'+intToStr(tMi)+'-'+intToStr(tMa)+') '+ '('+intToStr(qu._xSteps)+'x'+intToStr(qu._tSiz)+') -> '+ '('+intToStr(zi._xSteps)+'x'+intToStr(zi._tSiz)+') delta: '+ intToStr(xOf)+'x'+intToStr(tOf)+' ...',1); case rtg of irHorizontal: gibAus(' (horizontal)',1); irEinfall: gibAus(' (einfallend)',1); irAusfall: gibAus(' (ausfallend)',1); end{of case}; case zi.genauigkeit of gSingle: case qu.genauigkeit of gSingle: zi.sWerte.integriereSingle(@(qu.sWerte),xMi,xMa,tMi,tMa,xOf,tOf,rtg); 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); end; // tSortiereNachYThread ******************************************************** constructor tSortiereNachYThread.create(k: tKontur; threads,von,bis: longint); begin inherited create; kont:=k; vo:=von; bi:=bis; mT:=threads; erfolg:=false; gibAus('Sortierthread kreiert ('+intToStr(vo)+'-'+intToStr(bi)+') -> x'+intToStr(mT),1); suspended:=false; end; procedure tSortiereNachYThread.stExecute; begin gibAus('Sortierthread gestartet ('+intToStr(vo)+'-'+intToStr(bi)+') -> x'+intToStr(mT)+' ...',1); erfolg:=kont.sortiereNachY(mT,vo,bi); gibAus(' ... und fertig',1); end; // tBefehlThread *************************************************************** constructor tBefehlThread.create(sT: boolean; cmd: string; out erzeugungsErfolg: boolean); var nichtLeeresArgument: boolean; function shellParseNextArg(var s: string): string; var err: longint; sR: tSearchRec; begin if length(s)=0 then exit; if startetMit('"',s) then begin if pos('"',s)=0 then begin gibAus('Kein passendes zweites Anführungszeichen im Argument für den Befehl gefunden!',3); erzeugungsErfolg:=false; exit; end; result:=erstesArgument(s,'"'); end else begin result:=shellExpand(stringReplace(erstesArgument(s),'$$DATETIME',mydatetimetostr(now),[rfReplaceAll])); if pos('*',result)>0 then begin err:=findFirst(result,$3F,sR); while err=0 do begin if (sR.name<>'.') and (sR.name<>'..') then s:=trim('"'+extractfilepath(result)+sR.name+'" '+s); err:=findNext(sR); end; findClose(sR); result:=shellParseNextArg(s); end; end; if startetMit('./',result) then result:=extractfilepath(paramstr(0))+result; if result<>'' then nichtLeeresArgument:=true; end; begin if not sT then inherited create; erzeugungsErfolg:=cmd<>''; if sT then begin endetMit('&',cmd); shellParseNextArg(cmd); end else begin bg:=endetMit('&',cmd); p:=tProcess.create(nil); p.options:=p.options + [poWaitOnExit]; p.executable:=shellParseNextArg(cmd); end; nichtLeeresArgument:=cmd=''; if not erzeugungsErfolg then begin if not sT then begin p.free; p:=nil; end; exit; end; while length(cmd)>0 do begin if sT then shellParseNextArg(cmd) else p.parameters.add(shellParseNextArg(cmd)); if not erzeugungsErfolg then begin if not sT then begin p.free; p:=nil; end; exit; end; end; if sT then exit; if not nichtLeeresArgument then begin p.free; p:=nil; end; if assigned(p) then begin 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 else gibAus('Des Befehls zu expandierende Argumente hatten keine Treffer, er wird ignoriert.',3); end; destructor tBefehlThread.destroy; begin gibAus('Befehl zerstört.',3); p.free; inherited destroy; end; procedure tBefehlThread.stExecute; begin if assigned(p) then begin gibAus( 'externen Befehl ausführen ... '+intToStr(belegterSpeicher)+#10+ p.executable+#10+ p.parameters.text, 3); p.execute; gibAus('... fertig!',1); end else gibAus('Externer Befehl hätte nichts zu tun und wird daher gar nicht erst gestartet.',1); 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; fehler('unbekannter InputDateiInfo-Typ ...'); 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); end; // tVerzerrInitThread ********************************************************** constructor tVerzerrInitThread.create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax,x0Abs,t0Abs,threads: longint; epsilon: extended; verzerrung: tTransformation; verzerrAnz: longint; 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; vA:=verzerrAnz; 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,vA,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: tTransformation; vorAnz,nachAnz: longint); begin inherited create; qu:=quelle; zi:=ziel; zPs:=zielPositionen; zGs:=zielGewichte; zAs:=zielAnzahlen; xMi:=xMin; xMa:=xMax; tMi:=tMin; tMa:=tMax; vB:=vorbearbeitungen; vA:=vorAnz; nB:=nachbearbeitungen; nA:=nachAnz; gibAus('Verzerrthread erzeugt',1); suspended:=false; end; procedure tVerzerrThread.stExecute; begin gibAus('Verzerrthread gestartet '+floatToStr(qu._minW)+' '+floatToStr(qu._maxW),1); case zi.genauigkeit of gSingle: case qu.genauigkeit of gSingle: zi.sWerte.kopiereVerzerrt(pTLLWerteSingle(@qu.sWerte),zPs,zGs,zAs,xMi,xMa,tMi,tMa,vB,nB,vA,nA); gDouble: zi.sWerte.kopiereVerzerrt(pTLLWerteDouble(@qu.dWerte),zPs,zGs,zAs,xMi,xMa,tMi,tMa,vB,nB,vA,nA); gExtended: zi.sWerte.kopiereVerzerrt(pTLLWerteExtended(@qu.eWerte),zPs,zGs,zAs,xMi,xMa,tMi,tMa,vB,nB,vA,nA); end{of case}; gDouble: case qu.genauigkeit of gSingle: zi.dWerte.kopiereVerzerrt(pTLLWerteSingle(@qu.sWerte),zPs,zGs,zAs,xMi,xMa,tMi,tMa,vB,nB,vA,nA); gDouble: zi.dWerte.kopiereVerzerrt(pTLLWerteDouble(@qu.dWerte),zPs,zGs,zAs,xMi,xMa,tMi,tMa,vB,nB,vA,nA); gExtended: zi.dWerte.kopiereVerzerrt(pTLLWerteExtended(@qu.eWerte),zPs,zGs,zAs,xMi,xMa,tMi,tMa,vB,nB,vA,nA); end{of case}; gExtended: case qu.genauigkeit of gSingle: zi.eWerte.kopiereVerzerrt(pTLLWerteSingle(@qu.sWerte),zPs,zGs,zAs,xMi,xMa,tMi,tMa,vB,nB,vA,nA); gDouble: zi.eWerte.kopiereVerzerrt(pTLLWerteDouble(@qu.dWerte),zPs,zGs,zAs,xMi,xMa,tMi,tMa,vB,nB,vA,nA); gExtended: zi.eWerte.kopiereVerzerrt(pTLLWerteExtended(@qu.eWerte),zPs,zGs,zAs,xMi,xMa,tMi,tMa,vB,nB,vA,nA); end{of case}; end{of case}; gibAus('Verzerrthread beendet',1); end; // tVerzerrLOThread ************************************************************ constructor tVerzerrLOThread.create(quelle,ziel: tWerte; xMin,xMax,tMin,tMax: longint; verhaeltnisHorizontal, verhaeltnisVertikal: extended); begin inherited create; qu:=quelle; zi:=ziel; xMi:=xMin; xMa:=xMax; tMi:=tMin; tMa:=tMax; verhHo:=verhaeltnisHorizontal; verhVe:=verhaeltnisVertikal; gibAus('VerzerrLOthread erzeugt: '+intToStr(xMin)+'-'+intToStr(xMax)+' '+intToStr(tMin)+'-'+intToStr(tMax),1); suspended:=false; end; procedure tVerzerrLOThread.stExecute; begin gibAus('VerzerrLOthread gestartet '+floatToStr(qu._minW)+' '+floatToStr(qu._maxW),1); case zi.genauigkeit of gSingle: case qu.genauigkeit of gSingle: zi.sWerte.kopiereLOVerzerrt(pTLLWerteSingle(@qu.sWerte),xMi,xMa,tMi,tMa,verhHo,verhVe); gDouble: zi.sWerte.kopiereLOVerzerrt(pTLLWerteDouble(@qu.dWerte),xMi,xMa,tMi,tMa,verhHo,verhVe); gExtended: zi.sWerte.kopiereLOVerzerrt(pTLLWerteExtended(@qu.eWerte),xMi,xMa,tMi,tMa,verhHo,verhVe); end{of case}; gDouble: case qu.genauigkeit of gSingle: zi.dWerte.kopiereLOVerzerrt(pTLLWerteSingle(@qu.sWerte),xMi,xMa,tMi,tMa,verhHo,verhVe); gDouble: zi.dWerte.kopiereLOVerzerrt(pTLLWerteDouble(@qu.dWerte),xMi,xMa,tMi,tMa,verhHo,verhVe); gExtended: zi.dWerte.kopiereLOVerzerrt(pTLLWerteExtended(@qu.eWerte),xMi,xMa,tMi,tMa,verhHo,verhVe); end{of case}; gExtended: case qu.genauigkeit of gSingle: zi.eWerte.kopiereLOVerzerrt(pTLLWerteSingle(@qu.sWerte),xMi,xMa,tMi,tMa,verhHo,verhVe); gDouble: zi.eWerte.kopiereLOVerzerrt(pTLLWerteDouble(@qu.dWerte),xMi,xMa,tMi,tMa,verhHo,verhVe); gExtended: zi.eWerte.kopiereLOVerzerrt(pTLLWerteExtended(@qu.eWerte),xMi,xMa,tMi,tMa,verhHo,verhVe); end{of case}; end{of case}; gibAus('VerzerrLOthread beendet',1); end; // tFensterThread ************************************************************** constructor tFensterThread.create(werte: tWerte; xMin,xMax,tMin,tMax: longint; fensterX,fensterT: tFenster; hintergrund: extended); begin inherited create; we:=werte; xMi:=xMin; xMa:=xMax; tMi:=tMin; tMa:=tMax; xFen:=fensterX; tFen:=fensterT; hg:=hintergrund; if length(xFen.werte)<>werte._xSteps then xFen.berechneWerte(werte._xSteps); if length(tFen.werte)<>werte._tSiz then tFen.berechneWerte(werte._tSiz); gibAus('FensterThread erzeugt: '+intToStr(xMin)+'-'+intToStr(xMax)+' '+intToStr(tMin)+'-'+intToStr(tMax),1); suspended:=false; end; procedure tFensterThread.stExecute; begin gibAus('FensterThread gestartet',1); case we.genauigkeit of gSingle: we.sWerte.fenstereWerte(xMi,xMa,tMi,tMa,xFen,tFen,hg); gDouble: we.dWerte.fenstereWerte(xMi,xMa,tMi,tMa,xFen,tFen,hg); gExtended: we.eWerte.fenstereWerte(xMi,xMa,tMi,tMa,xFen,tFen,hg); end{of case}; gibAus('FensterThread beendet',1); end; // tVerschiebeThread *********************************************************** constructor tVerschiebeThread.create(werte: tWerte; xMin,xMax,tMin,tMax: longint; richtung: tIntPoint); begin inherited create; we:=werte; xMi:=xMin; xMa:=xMax; tMi:=tMin; tMa:=tMax; rtg:=richtung; gibAus('VerschiebeThread erzeugt: '+intToStr(xMin)+'-'+intToStr(xMax)+' '+intToStr(tMin)+'-'+intToStr(tMax)+' '+tIntPointToStr(richtung)+' '+intToStr(byte(we.istKomplex)),1); suspended:=false; end; procedure tVerschiebeThread.stExecute; begin gibAus('VerschiebeThread gestartet',1); case we.genauigkeit of gSingle: we.sWerte.verschiebe(rtg,xMi,xMa,tMi,tMa); gDouble: we.dWerte.verschiebe(rtg,xMi,xMa,tMi,tMa); gExtended: we.eWerte.verschiebe(rtg,xMi,xMa,tMi,tMa); end{of case}; gibAus('VerschiebeThread beendet',1); end; // tPhasenWinkelThread ********************************************************* constructor tPhasenWinkelThread.create(werte: tWerte; xMin,xMax: longint); begin inherited create; we:=werte; xMi:=xMin; xMa:=xMax; gibAus('PhasenWinkelThread erzeugt: '+intToStr(xMin)+'-'+intToStr(xMax),1); suspended:=false; end; procedure tPhasenWinkelThread.stExecute; begin gibAus('PhasenWinkelThread gestartet',1); case we.genauigkeit of gSingle: we.sWerte.ermittlePhasenWinkel(xMi,xMa); gDouble: we.dWerte.ermittlePhasenWinkel(xMi,xMa); gExtended: we.eWerte.ermittlePhasenWinkel(xMi,xMa); end{of case}; gibAus('PhasenWinkelThread beendet',1); end; // tKomplexMachThread ********************************************************** constructor tKomplexMachThread.create(werte: tWerte; xMin,xMax: longint; komplexMachModus: tKomplexMachModus; randomSeed: longword); begin inherited create; we:=werte; xMi:=xMin; xMa:=xMax; kmm:=komplexMachModus; mT:=tMersenneTwister.create; mT.init(randomSeed); gibAus('KomplexMachThread erzeugt: '+intToStr(xMin)+'-'+intToStr(xMax),1); suspended:=false; end; procedure tKomplexMachThread.stExecute; begin gibAus('KomplexMachThread gestartet',1); case we.genauigkeit of gSingle: we.sWerte.macheKomplex(xMi,xMa,kmm,mT); gDouble: we.dWerte.macheKomplex(xMi,xMa,kmm,mT); gExtended: we.eWerte.macheKomplex(xMi,xMa,kmm,mT); end{of case}; gibAus('KomplexMachThread beendet',1); end; // sonstiges ******************************************************************* function findePalette(out palette: tPalette; name: string): boolean; var i: longint; begin result:=true; for i:=0 to length(allePaletten)-1 do if allePaletten[i].name=name then begin palette:=allePaletten[i]; exit; end; palette:=nil; result:=false; end; function dumpPalettenNamen: string; var i: longint; begin result:=''; for i:=0 to length(allePaletten)-1 do result:=result+#10''''+allePaletten[i].name+''''; delete(result,1,1); end; function erzeugeLegende(sT: boolean; f: tMyStringList; datei: string; qu: tWerte; minDichte,maxDichte: extended; nB: tTransformation; pal: tPalette): 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; tmpTr: tTransformation; bekannteBefehle: tMyStringList; 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; bekannteBefehle:=tMyStringList.create; repeat if not f.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); bekannteBefehle.free; exit; end; bekannteBefehle.clear; if istDasBefehl('Ausrichtung:',s,bekannteBefehle,true) then begin waagerecht:=s='waagerecht'; if (s='waagerecht') or (s='senkrecht') then continue; gibAus(''''+s+''' ist keine gültige Ausrichtung!'#10'Ich kenne:'#10'''senkrecht'''#10'''waagerecht''',3); exit; end; if istDasBefehl('Breite:',s,bekannteBefehle,true) then begin breite:=strtoint(s); continue; end; if istDasBefehl('Höhe:',s,bekannteBefehle,true) then begin hoehe:=strtoint(s); continue; end; if istDasBefehl('Schriftgröße:',s,bekannteBefehle,true) then begin schriftgroesze:=strtoint(s); continue; end; if istDasBefehl('Farbe linear',s,bekannteBefehle,false) then begin lineareFarbe:=true; continue; end; if istDasBefehl('Werte linear',s,bekannteBefehle,false) then begin lineareFarbe:=false; continue; end; if istDasBefehl('Rahmen',s,bekannteBefehle,false) then begin rahmen:=true; continue; end; if istDasBefehl('Beschriftungen:',s,bekannteBefehle,false) 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.metaReadln(s,true) then begin gibAus('Unerwartetes Dateiende in '''+paramstr(1)+'''!',3); bekannteBefehle.free; exit; end; if s='Ende' then break; setLength(beschriftungsschritte,length(beschriftungsschritte)+1); if startetMit('linear',s) then beschriftungsschritte[length(beschriftungsschritte)-1].linear:=true else if startetMit('logarithmisch',s) then begin beschriftungsschritte[length(beschriftungsschritte)-1].linear:=false; minDichte:=qu.exprToFloat(sT,erstesArgument(s)); beschriftungsschritte[0].bis:=maxDichte*minDichte; tmpTr:=nB; while assigned(tmpTr) do begin if tmpTr is tWerteLogTransformation then begin if (tmpTr as tWerteLogTransformation).logMin<>minDichte then begin gibAus('Die minimale Dichte der logarithmischen Farbskala ('+myFloatToStr(minDichte)+') und der logarithmischen Nachbearbeitung ('+myFloatToStr((tmpTr as tWerteLogTransformation).logMin)+') stimmen nicht überein!',3); exit; end; minDichte:=minDichte*maxDichte; break; end; tmpTr:=tmpTr.beliebigerVorgaenger; end; end else if length(beschriftungsschritte)>2 then beschriftungsschritte[length(beschriftungsschritte)-1].linear:= beschriftungsschritte[length(beschriftungsschritte)-2].linear else begin gibAus('Ich weiß nicht, ob die Beschriftung linear oder logarithmisch sein soll!',3); bekannteBefehle.free; exit; end; 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 istDasBefehl('Ende',s,bekannteBefehle,false) then break; bekannteBefehle.sort; gibAus('Verstehe Option '''+s+''' nicht bei Erzeugund der Legende!'#10'Ich kenne:'#10+bekannteBefehle.text,3); bekannteBefehle.free; exit; until false; bekannteBefehle.free; 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]:=pal.wertZuFarbe(wert); 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; i:=f.count-1; while (i>=0) and not f.needInLine(s,i) do dec(i); // i ist das letzte Vorkommen von s in f if pos('lösche Werte ',f[i])=0 then // wenn es sich um einen Löschbefehl handelt, machen wir nichts f.insert(i+1,'lösche Werte '+s); // ansonsten veranlassen wir die Löschung result:=length(pws^)-1; end; function findeKontur(s: string; f: tMyStringList; pws: pTWerteArray; 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 Kontur '''+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,pws); pks^[length(pks^)-1].bezeichner:=s; i:=f.count-1; while (i>=0) and not f.needInLine(s,i) do dec(i); // i ist das letzte Vorkommen von s in f if pos('lösche Kontur ',f[i])=0 then // wenn es sich um einen Löschbefehl handelt, machen wir nichts f.insert(i+1,'lösche Kontur '+s); // ansonsten veranlassen wir die Löschung 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(f: tMyStringList): boolean; var s,name: string; palette,nPalette: tPalette; imPart: boolean; begin result:=false; palette:=tPalette.create; nPalette:=nil; name:=''; imPart:=false; repeat if not f.metaReadln(s,true) 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 startetMit('Imaginärteile:',s) then begin if imPart then begin gibAus('Ich hatte schon Imaginärteile für diese Palette gelesen!',3); exit; end; imPart:=true; continue; end; if palette.neuerWert(s,imPart) then continue; 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.farben[false])<2 then begin gibAus('Zu wenige Farben in der Palette '''+name+''', nämlich nur '+intToStr(length(palette.farben[false])),3); exit; end; if nPalette=nil then begin setLength(allePaletten,length(allePaletten)+1); allePaletten[length(allePaletten)-1]:=tPalette.create; nPalette:=allePaletten[length(allePaletten)-1]; end else gibAus('Überschreibe bereits vorhandene Palette '''+nPalette.name+'''.',3); nPalette.kopiereVon(palette); nPalette.name:=name; palette.free; 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 begin // bt.free; exit; end; 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(10); bt.free; end; procedure warteAufExterneBefehle; 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(10); 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; procedure beendeExterneBefehleWennFertig; var i,j: longint; begin for i:=length(externeBefehle)-1 downto 0 do if assigned(externeBefehle) then if externeBefehle[i].fertig then begin externeBefehle[i].free; for j:=i+1 to length(externeBefehle)-1 do externeBefehle[j-1]:=externeBefehle[j]; setLength(externeBefehle,length(externeBefehle)-1); end; end; var i: longint; begin fileMode := fmOpenRead; setLength(externeBefehle,0); setLength(allePaletten,8); for i:=0 to length(allePaletten)-1 do allePaletten[i]:=tPalette.create; allePaletten[0].name:='Graustufen'; allePaletten[0].neuerWert(rgb($ff,$ff,$ff),false); allePaletten[0].neuerWert(rgb($00,$00,$00),false); allePaletten[1].name:='invertierte Graustufen'; allePaletten[1].neuerWert(rgb($00,$00,$00),false); allePaletten[1].neuerWert(rgb($ff,$ff,$ff),false); allePaletten[2].name:='Regenbogen'; allePaletten[2].neuerWert(rgb($00,$00,$ff),false); allePaletten[2].neuerWert(rgb($00,$ff,$ff),false); allePaletten[2].neuerWert(rgb($00,$ff,$00),false); allePaletten[2].neuerWert(rgb($ff,$ff,$00),false); allePaletten[2].neuerWert(rgb($ff,$00,$00),false); allePaletten[2].neuerWert(rgb($00,$00,$00),false); allePaletten[3].name:='invertierter Regenbogen'; allePaletten[3].neuerWert(rgb($00,$00,$00),false); allePaletten[3].neuerWert(rgb($ff,$00,$00),false); allePaletten[3].neuerWert(rgb($ff,$ff,$00),false); allePaletten[3].neuerWert(rgb($00,$ff,$00),false); allePaletten[3].neuerWert(rgb($00,$ff,$ff),false); allePaletten[3].neuerWert(rgb($00,$00,$ff),false); allePaletten[4].name:='Jet-Regenbogen'; allePaletten[4].neuerWert(rgb($ff,$00,$00),false); allePaletten[4].neuerWert(rgb($ff,$ff,$00),false); allePaletten[4].neuerWert(rgb($00,$ff,$00),false); allePaletten[4].neuerWert(rgb($00,$ff,$ff),false); allePaletten[4].neuerWert(rgb($00,$00,$ff),false); allePaletten[5].name:='erweiterter Regenbogen'; allePaletten[5].neuerWert(rgb($ff,$ff,$ff),false); allePaletten[5].neuerWert(rgb($00,$00,$ff),false); allePaletten[5].neuerWert(rgb($00,$ff,$ff),false); allePaletten[5].neuerWert(rgb($00,$ff,$00),false); allePaletten[5].neuerWert(rgb($ff,$ff,$00),false); allePaletten[5].neuerWert(rgb($ff,$00,$00),false); allePaletten[5].neuerWert(rgb($ff,$00,$ff),false); allePaletten[5].neuerWert(rgb($00,$00,$00),false); allePaletten[6].name:='komplexer Martin'; allePaletten[6].neuerWert(rgb($00,$00,$ff),false); allePaletten[6].neuerWert(rgb($ff,$00,$00),false); allePaletten[6].neuerWert(rgb($00,$ff,$00),true); allePaletten[6].neuerWert(rgb($00,$00,$00),true); allePaletten[7].name:='invertierter komplexer Martin'; allePaletten[7].neuerWert(rgb($ff,$00,$00),false); allePaletten[7].neuerWert(rgb($00,$00,$ff),false); allePaletten[7].neuerWert(rgb($00,$00,$00),true); allePaletten[7].neuerWert(rgb($00,$ff,$00),true); end.