soweit lauffähig

ToDo: Taskbaricon

1 files changed, 574 insertions, 9 deletions

diff --git a/fhunit.pas b/fhunit.pas
index 02c9d6d..fcfa1b6 100644
--- a/fhunit.pas
+++ b/fhunit.pas
@@ -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.