diff options
Diffstat (limited to 'fhunit.pas')
| -rw-r--r-- | fhunit.pas | 583 |
1 files changed, 574 insertions, 9 deletions
@@ -5,19 +5,91 @@ unit fhunit; interface uses - Classes, SysUtils, Graphics; + CThreads, Classes, SysUtils, Graphics, ExtCtrls, Process, lowLevelUnit; type - tMessgroesze = (mgTemperatur,mgLuftfeuchte,mgWindgeschwindigkeit,mgWindrichtung, + tMessGroesze = (mgTemperatur,mgLuftfeuchte,mgWindgeschwindigkeit,mgWindrichtung, mgNiederschlag,mgGlobalstrahlung,mgLuftdruck); - tZeitgroesze = (zgJahr,zgMonat,zgTag,zgStunde,zgMin10); - tMesswerte = array[tMessgroesze] of extended; - tZeit = array[tZeitgroesze] of integer; - tMesspunkt = record - zeit: tZeit; - mW: tMesswerte; + tMessGroeszenSet = set of tMessGroesze; + tZeitGroesze = (zgJahr,zgMonat,zgTag,zgStunde,zgMin10); + tMessWerte = array[tMessGroesze] of extended; + tMessWerteExtPoints = array[tMessGroesze] of tExtPoint; + tZeit = array[tZeitGroesze] of word; + + tMessPunkte = class; + + tMessPunkt = class + private + _mZeit: tZeit; + _uZeit: extended; + _mW: tMessWerte; + procedure setzeUZeit; inline; + procedure setzeZeit; inline; + function rMW(mG: tMessGroesze): extended; inline; + public + constructor create; + destructor destroy; override; + function lade(s: string): boolean; + function schreibe: string; + property zeit: extended + read _uZeit; + property mW[mG: tMessGroesze]: extended + read rMW; + end; + + tMessPunkteListe = class + private + inhalt: tFPList; + function rItem(i: longint): tMessPunkt; + function bisekt(zeit: extended): longint; + public + constructor create; + destructor destroy; override; + function add(s: string): boolean; + function last: tMessPunkt; + function count: longint; + property items[i: longint]: tMessPunkt + read rItem; default; + function minMaxY(startZeit,stopZeit: extended): tMessWerteExtPoints; + end; + + tMessPunkteUpdateThread = class(tThread) + private + _besitzer: tMessPunkte; + antwort: string; + ladeProzess: tProcess; + beendet, + warGueltig: boolean; + nZeit: extended; + _tNum,_tAnz: longint; + procedure uebernehmen; + procedure nZeitNullen; inline; + public + beenden: boolean; + constructor create(besitzer: tMessPunkte; tNum,tAnz: longint); + destructor destroy; override; + procedure execute; override; + end; + + tMessPunkte = class + private + bild: tImage; + werte: tMessPunkteListe; + muts: array of tMessPunkteUpdateThread; + public + constructor create(zeichenFlaeche: tImage); + destructor destroy; override; + function einlesen(was: string): boolean; + procedure laden(von: string); + procedure speichern(nach: string); + procedure achsenZeichnen(zuZeichnen: tMessGroeszenSet; startZeit,stopZeit: extended); + procedure graphenZeichnen(zuZeichnen: tMessGroeszenSet; startZeit,stopZeit: extended); + procedure mutBeenden; end; +procedure uZeit2mZeit(uZ: extended; out mZ: tZeit); inline; +function strZuMZeit(s: string; out mZ: tZeit): boolean; + const messNamen: array[tMessgroesze] of string = ('Temperatur','Luftfeuchte','Windgeschwindigkeit','Windrichtung', @@ -25,12 +97,505 @@ const maszEinheit: array[tMessgroesze] of string = ('°C','%','m/s','°','mm','W/m²','mbar'); monatsNamen: array[1..12] of string = - ('Januar','Februar','März','April','Mai','Juni','Juli', + ('Januar','Februar','M'#$e4'rz','April','Mai','Juni','Juli', 'August','September','Oktober','November','Dezember'); farben: array[tMessgroesze] of tColor = ($0000DF,$CFAF7F,$007FFF,$FF00FF,$FFAF3F,$3FAFAF,$AFAFAF); implementation +uses unit1, math, systemUnit; + +// tMessPunkt ****************************************************************** + +constructor tMessPunkt.create; +var + zg: tZeitGroesze; + mg: tMessGroesze; +begin + inherited create; + for zg:=low(zg) to high(zg) do + _mZeit[zg]:=0; + _uZeit:=0; + for mg:=low(mg) to high(mg) do + _mW[mg]:=0; +end; + +destructor tMessPunkt.destroy; +begin + inherited destroy; +end; + +procedure tMessPunkt.setzeUZeit; +begin + _uZeit:= + encodeDate(_mZeit[zgJahr],_mZeit[zgMonat],_mZeit[zgTag])+ + encodeTime(_mZeit[zgStunde],_mZeit[zgMin10]*10,0,0) +end; + +procedure tMessPunkt.setzeZeit; +begin + uZeit2mZeit(_uZeit,_mZeit); +end; + +function tMessPunkt.rMW(mG: tMessGroesze): extended; +begin + result:=_mW[mG]; +end; + +function tMessPunkt.lade(s: string): boolean; +var + zG: tZeitGroesze; + mG: tMessGroesze; + t: string; + istZahl: boolean; + i: longint; +begin + result:=false; + if pos('<html>',s)=0 then begin // Format wie in letztes_Wetter.txt + {$WARNINGS-} + if decimalSeparator<>',' then + while pos(',',s)>0 do + s[pos(',',s)]:=decimalSeparator; + {$WARNINGS+} + for zG:=low(zG) to high(zG) do + _mZeit[zG]:=strtoint(erstesArgument(s,#9)); + for mG:=high(mG) downto low(mG) do + _mW[mG]:=strtofloat(erstesArgument(s,#9)); + while _mZeit[zgStunde]>=24 do begin + _mZeit[zgStunde]:=_mZeit[zgStunde]-24; + inc(_mZeit[zgTag]); + if _mZeit[zgTag]>30+byte(_mZeit[zgMonat] in [1,3,5,7,8,10,12])-(2-byte(_mZeit[zgJahr] mod 4 = 0))*byte(_mZeit[zgMonat]=2) then begin + _mZeit[zgTag]:=1; + inc(_mZeit[zgMonat]); + if _mZeit[zgMonat]>12 then begin + _mZeit[zgMonat]:=1; + inc(_mZeit[zgJahr]); + end; + end; + end; + setzeUZeit; + end + else begin // Format wie im Netz + + delete(s,1,pos('<BODY',uppercase(s))-1); + s:=copy(s,1,pos('</BODY>',uppercase(s))); + delete(s,1,pos('<CENTER>',uppercase(s))); + delete(s,1,pos('>',s)); + s:=trim(s); + t:=trim(leftStr(s,pos('<',s)-1)); + if not strZuMZeit(t,_mZeit) then + exit; + {$WARNINGS-} + if decimalSeparator<>'.' then + while pos('.',s)>0 do + s[pos('.',s)]:=decimalSeparator; + {$WARNINGS+} + for mG:=low(mG) to high(mG) do begin + delete(s,1,pos(uppercase(messNamen[mG]),uppercase(s))); + delete(s,1,pos('>',s)); + t:=trim(leftStr(s,pos('<',S)-1)); + istZahl:=t<>''; + for i:=1 to length(t) do + istZahl:=istZahl and (t[i] in ['0'..'9','.',',','-']); + if not istZahl then + exit; + _mW[mG]:=strtofloat(t); + end; + setzeUZeit; + end; + result:=true; +end; + +function tMessPunkt.schreibe: string; +var + zG: tZeitGroesze; + mG: tMessGroesze; +begin + result:=''; + for zG:=low(zG) to high(zG) do + result:=result+#9+inttostr(_mZeit[zG]); + for mG:=high(mG) downto low(mG) do + result:=result+#9+floattostr(mW[mG]); + result:=trim(result); +end; + +// tMessPunkteListe ************************************************************ + +constructor tMessPunkteListe.create; +begin + inherited create; + inhalt:=tFPList.create; +end; + +destructor tMessPunkteListe.destroy; +begin + inhalt.free; + inherited destroy; +end; + +function tMessPunkteListe.rItem(i: longint): tMessPunkt; +begin + result:=tMessPunkt(inhalt[i]); +end; + +function tMessPunkteListe.bisekt(zeit: extended): longint; +var + mi,ma,neu: longint; +begin + mi:=0; + neu:=mi; + ma:=count; + while mi<ma do begin + neu:=(mi+ma) div 2; + if (neu>=count) or (items[neu].zeit<zeit) then begin + inc(neu); + mi:=neu; + continue; + end; + if items[neu].zeit>zeit then begin + ma:=neu; + continue; + end; + result:=neu; + exit; + end; + result:=neu; +end; + +function tMessPunkteListe.add(s: string): boolean; +var + nm: tMessPunkt; + i: longint; +begin + result:=false; + nm:=tMessPunkt.create; + if not nm.lade(s) then begin + nm.free; + exit; + end; + i:=bisekt(nm.zeit); + result:=true; + if (i>=count) or (items[i].zeit<>nm.zeit) then + inhalt.Insert(i,nm) + else + nm.free; +end; + +function tMessPunkteListe.last: tMessPunkt; +begin + result:=items[count-1]; +end; + +function tMessPunkteListe.count: longint; +begin + result:=inhalt.count; +end; + +function tMessPunkteListe.minMaxY(startZeit,stopZeit: extended): tMessWerteExtPoints; +var + i: longint; + mG: tMessGroesze; +begin + i:=bisekt(startZeit); + for mG:=low(mG) to high(mG) do begin + result[mG,'x']:=items[i].mW[mG]; + result[mG,'y']:=result[mG,'x']; + end; + while (i<count) and (items[i].zeit<=stopZeit) do begin + for mG:=low(mG) to high(mG) do begin + result[mG,'x']:=min(result[mG,'x'],items[i].mW[mG]); + result[mG,'y']:=max(result[mG,'y'],items[i].mW[mG]); + end; + inc(i); + end; +end; + +// tMessPunkteUpdateThread ***************************************************** + +constructor tMessPunkteUpdateThread.create(besitzer: tMessPunkte; tNum,tAnz: longint); +begin + inherited create(true); + _besitzer:=besitzer; + fillchar(antwort,sizeof(antwort),#0); + setlength(antwort,0); + ladeProzess:=nil; + beendet:=false; + _tNum:=tNum; + _tAnz:=tAnz; + beenden:=false; + warGueltig:=false; + nZeitNullen; + suspended:=false; +end; + +destructor tMessPunkteUpdateThread.destroy; +begin + while not beendet do + sleep(100); + setlength(antwort,0); + inherited destroy; +end; + +procedure tMessPunkteUpdateThread.uebernehmen; +begin + if beenden then exit; + warGueltig:=_besitzer.einlesen(antwort); + setlength(antwort,0); + if (not warGueltig) or (20*random<1) then + form1.zeichnen; +end; + +procedure tMessPunkteUpdateThread.nZeitNullen; +var + lIch: longint; +begin + if beenden then exit; + lIch:=_besitzer.werte.count-1; + while round(_besitzer.werte[lIch].zeit*24*6) mod _tAnz <> _tNum do + dec(lIch); + nZeit:=_besitzer.werte[lIch].zeit + _tAnz*1/24/6; +end; + +procedure tMessPunkteUpdateThread.execute; +var + bytesToRead,bytesRead,cnt: longint; + mZeit: tZeit; +begin + while not beenden do begin + ladeProzess:=tProcess.create(nil); + ladeProzess.options:=[poUsePipes]; + ladeProzess.executable:='/usr/bin/curl'; + ladeProzess.parameters.add('-o'); + ladeProzess.parameters.add('-'); + ladeProzess.parameters.add('--data'); + uZeit2mZeit(nZeit,mZeit); + ladeProzess.parameters.add( + 'tag='+inttostr(mZeit[zgTag])+'&'+ + 'monat='+Monatsnamen[mZeit[zgMonat]]+'&'+ + 'jahr='+inttostr(mZeit[zgJahr])+'&'+ + 'stunde='+inttostr(mZeit[zgStunde])+'&'+ + 'minute='+inttostr(10*mZeit[zgMin10])+'&'+ + 'submit=Abfrage starten'); + ladeProzess.parameters.add('http://wetter.mb.fh-jena.de/station/datenbank/php_alt/abfrage1.php'); + bytesRead:=0; + ladeProzess.execute; + ladeProzess.closeInput; + ladeProzess.closeStderr; + while (ladeProzess.running) or (ladeProzess.output.numBytesAvailable>0) do begin + if beenden then + ladeProzess.terminate(0); + bytesToRead:=ladeProzess.output.numBytesAvailable; + if bytesToRead>0 then begin + setlength(antwort,bytesRead + bufLengMin); + bytesRead:=bytesRead+ladeProzess.output.read(antwort[bytesRead+1],min(bytesToRead,length(antwort)-bytesRead)); + end + else + sleep(10); + end; + ladeProzess.closeOutput; + ladeProzess.free; + + if not beenden then begin + setlength(antwort,bytesRead); + + synchronize(@uebernehmen); + + if (nZeit<=now) or warGueltig then + nZeit:=nZeit + _tAnz*1/24/6 + else begin + synchronize(@nZeitNullen); + for cnt:=0 to 599 do begin + if beenden then + break; + sleep(100); + end; + end; + end; + end; + ladeProzess:=nil; + beendet:=true; +end; + +// tMessPunkte ***************************************************************** + +constructor tMessPunkte.create(zeichenFlaeche: tImage); +begin + inherited create; + bild:=zeichenFlaeche; + werte:=tMessPunkteListe.create; + fillchar(muts,sizeof(muts),#0); + setlength(muts,0); +end; + +destructor tMessPunkte.destroy; +var + i: longint; +begin + werte.free; + for i:=0 to length(muts)-1 do + muts[i].free; + setlength(muts,0); + inherited destroy; +end; + +function tMessPunkte.einlesen(was: string): boolean; +begin + result:=werte.add(was); +end; + +procedure tMessPunkte.laden(von: string); +var + f: textfile; + s: string; + i: longint; +begin + if not fileexists(von) then begin + writeln('Messwertedatei '''+von+''' existiert nicht!'); + raise exception.create('Messwertedatei '''+von+''' existiert nicht!'); + exit; + end; + assignfile(f,von); + reset(f); + while not eof(f) do begin + readln(f,s); + werte.add(s); + end; + closefile(f); + if length(muts)=0 then begin + setlength(muts,20); + for i:=0 to length(muts)-1 do + muts[i]:=tMessPunkteUpdateThread.create(self,i,length(muts)); + end; +end; + +procedure tMessPunkte.speichern(nach: string); +var + dateischonda: boolean; + f: textfile; + i: longint; +begin + dateischonda:=fileexists(nach); + if dateischonda then + assignfile(f,mkTemp(nach+'.XXXXXX')) + else + assignfile(f,nach); + rewrite(f); + for i:=0 to werte.count-1 do + writeln(f,werte[i].schreibe); + closefile(f); + if dateischonda then begin + deletefile(nach); + rename(f,nach); + end; +end; + +procedure tMessPunkte.achsenZeichnen(zuZeichnen: tMessGroeszenSet; startZeit,stopZeit: extended); +var + mG: tMessGroesze; + miMa: tMessWerteExtPoints; + dY,cY: extended; +begin + miMa:=werte.minMaxY(startZeit,stopZeit); + for mG:=high(mG) downto low(mG) do + if mG in zuZeichnen then begin + bild.canvas.pen.color:=farben[mG]; + dY:=power(10,ceil(ln(max(1e-9,miMa[mG,'y']-miMa[mG,'x']))/ln(10))); + repeat + if max(1e-9,miMa[mG,'y']-miMa[mG,'x'])/dY>=3 then continue; + dY:=dY/10*3; + if max(1e-9,miMa[mG,'y']-miMa[mG,'x'])/dY>=3 then continue; + dY:=dY/3; + until max(1e-9,miMa[mG,'y']-miMa[mG,'x'])/dY>=3; + cY:=ceil(miMa[mG,'x']/dY)*dY; + while cY<=miMa[mG,'y'] do begin + bild.canvas.moveTo(-10,wertZuY(cY,miMa[mG],bild.height)); + bild.canvas.lineTo(bild.width+10,wertZuY(cY,miMa[mG],bild.height)); + cY:=cY+dY; + end; + end; +end; + +procedure tMessPunkte.graphenZeichnen(zuZeichnen: tMessGroeszenSet; startZeit,stopZeit: extended); +var + mG: tMessGroesze; + miMa: tMessWerteExtPoints; + i: longint; +begin + miMa:=werte.minMaxY(startZeit,stopZeit); + for mG:=high(mG) downto low(mG) do + if mG in zuZeichnen then begin + bild.canvas.pen.color:=farben[mG]; + i:=werte.bisekt(startZeit); + bild.canvas.moveTo( + -10, + wertZuY(werte[i].mW[mG],miMa[mG],bild.height) + ); + while (i<werte.count) and (werte[i].zeit<=stopZeit) do begin + bild.canvas.lineTo( + wertZuX(werte[i].zeit,startZeit,stopZeit,bild.width), + wertZuY(werte[i].mW[mG],miMa[mG],bild.height) + ); + inc(i); + end; + end; +end; + +procedure tMessPunkte.mutBeenden; +var + i: longint; +begin + for i:=0 to length(muts)-1 do + muts[i].beenden:=true; +end; + +// allgemeine Funktionen ******************************************************* + +procedure uZeit2mZeit(uZ: extended; out mZ: tZeit); inline; +var + mi,se,hu: word; +begin + decodeDate(uZ,mZ[zgJahr],mZ[zgMonat],mZ[zgTag]); + decodeTime(uZ,mZ[zgStunde],mi,se,hu); + mZ[zgMin10]:=round(mi/10); +end; + +function strZuMZeit(s: string; out mZ: tZeit): boolean; +var + t: string; + i: longint; +begin + result:=false; + s:=trim(s); + if pos('.',s)=0 then exit; + t:=erstesArgument(s,'.'); + if t='' then exit; + for i:=1 to length(t) do + if not (t[i] in ['0'..'9']) then exit; + mZ[zgTag]:=strtoint(t); + t:=erstesArgument(s); + mZ[zgMonat]:=1; + while (mZ[zgMonat]<=12) and (monatsNamen[mZ[zgMonat]]<>t) do + inc(mZ[zgMonat]); + if mZ[zgMonat]>12 then + exit; + t:=erstesArgument(s); + if t='' then exit; + for i:=1 to length(t) do + if not (t[i] in ['0'..'9']) then exit; + mZ[zgJahr]:=strtoint(t); + t:=erstesArgument(s,':'); + if t='' then exit; + for i:=1 to length(t) do + if not (t[i] in ['0'..'9']) then exit; + mZ[zgStunde]:=strtoint(t); + t:=erstesArgument(s); + if t='' then exit; + for i:=1 to length(t) do + if not (t[i] in ['0'..'9']) then exit; + mZ[zgMin10]:=strtoint(t) div 10; + result:=(strtoint(t) mod 10) = 0; +end; + end. |