// Beim Start des Programms werden Wetter-Informationen für den aktuellen
// Tag abgefragt
(allerdings funktioniert das nur solange, wie sich der
// Quelltext der Wetter-Seite nicht ändert)
.
// Man muss Land und Stadt angeben, wobei zu beachten ist, dass bei Weitem
// nicht alle Städte unterstützt werden, dann wird nämlich nichts angezeigt.
// Da das Programm Daten aus dem Netz zieht, kann es sein das Ihr
// Antivirenprogramm meckert. Das muss dann angepasst werden.


// Getestet mit D4 unter XP

type 
  TWetter = class(TForm) 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    procedure holwetter(x, y: integer); 
  end; 
 
var 
  Wetter: TWetter; 
  Land: string = 'Thueringen'; 
  Stadt: string = 'Gera'; 
 
implementation 
 
{$R *.DFM} 
 
uses axctrls, urlmon; 
 
const 
  quelle = 'http://www.wetteronline.de/'; 
 
type 
  im = array[0..2] of TImage; 
 
var 
  mit, mat: string; 
  arr: array[0..2] of string = ('Vormittag', 'Nachmittag', 'Abend'); 
  lb: array[0..8] of TLabel; 
  ai: im; 
  shape: TShape; 
 
procedure TWetter.FormCreate(Sender: TObject); 
var 
  i: integer; 
begin 
  shape := TShape.create(self); 
  shape.visible := false; 
  shape.parent := self; 
  shape.width := 226; 
  shape.height := 244; 
  for i := 0 to high(ai) do begin 
    ai[i] := TImage.create(self); 
    ai[i].parent := self; 
    ai[i].autosize := true; 
    ai[i].picture.bitmap.width := 50; 
    ai[i].picture.bitmap.height := 35; 
  end; 
  for i := 0 to high(lb) do begin 
    lb[i] := TLabel.create(self); 
    lb[i].parent := self; 
    lb[i].Font.Name := 'Courier New'; 
    lb[i].Font.Size := 10; 
    if i = 5 then lb[i].Font.style := [fsBold]; 
    lb[i].Font.color := clBlack; 
    lb[i].color := clwhite; 
    lb[i].visible := false; 
  end; 
  holwetter(35, 35); 
end; 
 
procedure TWetter.FormDestroy(Sender: TObject); 
var 
  i: integer; 
begin 
  for i := 0 to high(lb) do lb[i].free; 
  for i := 0 to high(ai) do ai[i].free; 
  shape.free; 
end; 
 
procedure LoadBild(const Datei: string; Picture: TPicture); 
var 
  FStream: TFileStream; 
  OLEBild: TOleGraphic; 
begin 
  OLEBild := TOleGraphic.Create; 
  FStream := TFileStream.Create(Datei, fmOpenRead or fmShareDenyNone); 
  try 
    OLEBild.LoadFromStream(FStream); 
    Picture.Bitmap.canvas.stretchdraw(Picture.Bitmap.canvas.cliprect, OLEBild); 
  finally 
    FStream.Free; 
    OLEBild.free; 
  end; 
end; 
 
function holbild(img: im): boolean; 
var 
  sl: TStringlist; 
  p, pv, pb: PChar; 
  lg, x: integer; 
  s, t: string; 
  function m1(s: string): boolean; 
  begin 
    lg := length(s); 
    pv := @s[1]; 
    while p^ <> #0 do begin 
      inc(p); 
      if CompareMem(p, pv, lg) then begin 
        break; 
      end; 
    end; 
    result := p^ <> #0; 
  end; 
begin 
  result := false; 
  for x := 0 to 2 do img[x].visible := false; 
  URLDownloadToFile(nil, 
    pchar(quelle + Land + '/' + Stadt + '.htm'), 
    pchar(stadt + '.txt'), 0, nil); 
  sl := TStringlist.create; 
  sl.loadfromfile(stadt + '.txt'); 
  t := stringreplace(sl.text, #13#10, '', [rfReplaceAll]); 
  sl.free; 
  p := @t[1]; 
  if m1('Tiefst&#8208;Temperatur') then begin 
    if m1('&deg') then begin 
      pb := p; 
      mit := ''; 
      while p^ <> '>' do begin 
        dec(p); 
        mit := p^ + mit; 
      end; 
      mit := copy(mit, 2, maxint); 
      p := pb; 
      if m1('H&ouml;chst&#8208;Temperatur') then begin 
        if m1('&deg') then begin 
          pb := p; 
          mat := ''; 
          while p^ <> '>' do begin 
            dec(p); 
            mat := p^ + mat; 
          end; 
          mat := copy(mat, 2, maxint); 
          p := pb; 
          for x := 0 to 2 do begin 
            if m1(arr[x]) then begin 
              if m1('<img src="http://') then begin 
                pb := p; 
                inc(p, lg); 
                if not m1('"') then exit; 
                lg := p - pb; 
                setlength(s, lg); 
                copymemory(@s[1], pb, lg); 
                s := copy(s, pos('"', s) + 1, maxint); 
                URLDownloadToFile(nil, pchar(s), 
                  pchar('Gif' + inttostr(x) + '.gif'), 0, nil); 
                LoadBild('Gif' + inttostr(x) + '.gif', img[x].picture); 
                img[x].visible := true; 
              end; 
              result := true; 
            end; 
          end; 
        end; 
      end; 
    end; 
  end; 
  deletefile(stadt + '.txt'); 
  for x := 0 to 2 do 
    deletefile('Gif' + inttostr(x) + '.gif'); 
end; 
 
procedure TWetter.holwetter(x, y: integer); 
var 
  i: integer; 
begin 
  shape.visible := false; 
  if holbild(ai) then begin 
    shape.left := x; 
    shape.top := y; 
    shape.visible := true; 
    for i := 0 to high(ai) do begin 
      ai[i].left := x + 105; 
      ai[i].top := y + 85 + i * 40; 
    end; 
    for i := 0 to high(lb) do begin 
      lb[i].left := x + 5; 
    end; 
    for i := 0 to 1 do begin 
      lb[i].top := y + 40 + i * 20; 
    end; 
    for i := 2 to 4 do begin 
      lb[i].top := y + i * 40 + 15; 
    end; 
    for i := 0 to high(lb) do begin 
      lb[i].visible := true; 
    end; 
    lb[5].top := y + 3; 
    lb[6].top := y + 17; 
    lb[7].top := y + 210; 
    lb[8].top := y + 225; 
    lb[5].caption := formatdatetime('dddd, dd.mm.yyyy', date); 
    lb[6].caption := '(' + stadt + '/' + Land + ')'; 
    lb[7].caption := 'Quelle:'; 
    lb[8].caption := quelle; 
    lb[0].caption := 'Tiefst-Temperatur: ' + mit + '°C'; 
    lb[1].caption := 'Höchst-Temperatur: ' + mat + '°C'; 
    for i := 2 to 4 do begin 
      lb[i].caption := arr[i - 2]; 
    end; 
  end; 
end; 



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke