Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   Datos Meteorológicos (https://www.clubdelphi.com/foros/showthread.php?t=45073)

José Luis Garcí 21-06-2007 21:18:18
Datos Meteorológicos
 
En la secion de trucos hay uno con este mismo titulo, me gustaria saber si alguien ha comprobado si funciona, en el mismo truco solicito a GLuGlu si puede poner el código completo, o una palicación de emplo, ruego a los foristas si aluno puede ayudar.

Gracias de antemano y un saludo desde Canarias.:o

gluglu 22-06-2007 00:15:54
Mil disculpas por no haberme fijado que había comentarios en la sección de trucos.

El código está completo.

Lo que pasa es que en mi caso particular lo ejecuto en un TThread. Por eso no quise liar más la cosa. A mi me funciona sin ningún problema.

Vuelvo a poner el código completo aquí en mi versión con el TThread :

Código Delphi [-]
unit Main;
 
interface
 
uses
  ..., MainMetar, ...
 
type
  TMainform = class(TForm)
  ...
    LabelStMet1: TLabel;
    LabelStMet2: TLabel;
    LabelStMet3: TLabel;
    LabelStMet4: TLabel;
    LabelStMetAux: TLabel;
    procedure MetarUpdate(Modus: Integer; Metar_Str: String);
    procedure LabelStMetAuxMouseEnter(Sender: TObject);
    procedure LabelStMetAuxMouseLeave(Sender: TObject);
  private
    { Private declarations }
    MainMetar    : TMainFormMetar;
  end;

implementation

procedure TMainform.LabelStMetAuxMouseEnter(Sender: TObject);
begin
  MainMetar := TMainFormMetar.Create(Self);
  MainMetar.LabelPanelMet.Caption := ShaderStMet.Tag;
  MainMetar.PanelMet.Width := MainMetar.LabelPanelMet.Width + 13;
  MainMetar.Top       := MainForm.Height - 48;
  MainMetar.Left      := (MainForm.Width - 20) - MainMetar.LabelPanelMet.Width;
  MainMetar.PopupMode := pmAuto;
  MainMetar.Show;
end;

procedure TMainform.LabelStMetAuxMouseLeave(Sender: TObject);
begin
  MainMetar.Free;
end;

procedure TMainform.FormActivate(Sender: TObject);
begin

  ...
  Metar_Initialize;
  ...
end;

procedure TMainform.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if Assigned(Metar) then Metar.Terminate;
end;

procedure TMainForm.MetarUpdate(Modus: Integer; Metar_Str: String);
var
  Aux_Temp : String;
begin

  if Modus = 1 then begin
    LabelStMet1.Visible := False;
    LabelStMet2.Visible := False;
    LabelStMet3.Visible := False;
    LabelStMet4.Visible := False;
  end;

  if Modus = 2 then begin

    Aux_Temp := IntToStr(StrToInt(Copy(Metar_Str, PosEx('/', Metar_Str, 18)-2, 2)));
    if Copy(Metar_Str, PosEx('/', Metar_Str, 18)-3, 1) = 'M' then Aux_Temp := '-'+Aux_Temp;

    LabelStMet1.Caption    := Aux_Temp;

    LabelStMet1.Visible    := True;
    LabelStMet2.Visible    := True;

    LabelStMet3.Visible    := False;
    LabelStMet4.Visible    := False;
    LabelStMet3.Top        := -1;
    LabelStMet3.Left       := 36;
    LabelStMet3.Font.Size  := 19;
    LabelStMet3.Font.Color := $009B9B9B;
    LabelStMet4.Top        := 0;
    LabelStMet4.Left       := 36;
    LabelStMet4.Font.Size  := 15;

    if (PosEx('RA', Metar_Str, 18) <> 0) or
       (PosEx('SH', Metar_Str, 18) <> 0) or
       (PosEx('DZ', Metar_Str, 18) <> 0) then begin
      // Rain
      LabelStMet3.Visible    := True;
      LabelStMet4.Visible    := False;
      LabelStMet3.Caption    := 'Û';
    end else
    if PosEx('SN', Metar_Str, 18) <> 0 then begin
      // Snow
      LabelStMet3.Visible    := True;
      LabelStMet4.Visible    := False;
      LabelStMet3.Caption    := 'Ú';
    end else
    if PosEx('TS', Metar_Str, 18) <> 0 then begin
      // Snow
      LabelStMet3.Visible    := True;
      LabelStMet4.Visible    := False;
      LabelStMet3.Caption    := 'Ü';
    end else
    if PosEx('OVC', Metar_Str, 18) <> 0 then begin
      // OverCast
      LabelStMet3.Visible    := True;
      LabelStMet4.Visible    := False;
      LabelStMet3.Caption    := 'Ù';
    end else
    if PosEx('BKN', Metar_Str, 18) <> 0 then begin
      // Broken
      LabelStMet3.Visible    := True;
      LabelStMet4.Visible    := False;
      LabelStMet3.Caption    := 'Ø';
    end else
    if PosEx('SCT', Metar_Str, 18) <> 0 then begin
      // Scatered
      LabelStMet3.Visible    := True;
      LabelStMet4.Visible    := False;
      LabelStMet3.Caption    := '×';
    end else
    if PosEx('FEW', Metar_Str, 18) <> 0 then begin
      // Few
      LabelStMet3.Visible    := True;
      LabelStMet4.Visible    := True;
      LabelStMet3.Top        := 3;
      LabelStMet3.Left       := 42;
      LabelStMet3.Font.Size  := 16;
      LabelStMet3.Font.Color := $00B6B6B6;
      LabelStMet3.Caption    := 'Ù';
    end else begin
      LabelStMet3.Visible    := False;
      LabelStMet4.Visible    := True;
      LabelStMet4.Top        := -1;
      LabelStMet4.Left       := 38;
      LabelStMet4.Font.Size  := 17;
    end;

  end;

  if Modus = 3 then begin
    ShaderStMet.Tag       := Metar_Str;
    LabelStMetAux.Visible := True;
  end;

end;

... y aparte la unidad MainMetar completa. En diseño, el form contiene un TPanel y un TLabel que será el que muestre la cadena de caracteres interpretada con los valores de datos meteorológicos.

Código Delphi [-]
unit MainMetar;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Borland.Vcl.StdCtrls, System.ComponentModel, Borland.Vcl.ExtCtrls,
  Borland.Vcl.StrUtils, Borland.Vcl.Math, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase, IdFTP;

procedure Metar_Initialize;

type
  TMainFormMetar = class(TForm)
    PanelMet: TPanel;
    LabelPanelMet: TLabel;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TMetar = class(TThread)
    procedure UpdateMainForm;
    procedure Timer1Timer(Sender: TObject);
  private
    FName_Loc   : String;
    FGMT_Dif    : Integer;
    IdFTP1      : TidFTP;
    Timer1      : TTimer;
    Metar_Modus : Integer;
    Metar_Str   : String;
  public
    property Name_Loc : String  read FName_Loc write FName_Loc;
    property GMT_Dif  : Integer read FGMT_Dif  write FGMT_Dif;
    constructor Create;
  protected
    procedure Execute; override;
  end;

var
  MainFormMetar : TMainFormMetar;
  Metar : TMetar;

implementation

uses Main, DataModule;

{$R *.nfm}

constructor TMetar.Create;
begin

  inherited Create(True);

  IdFTP1 := TidFTP.Create(Application);
  IdFTP1.Host     := DM0.IBDataSetCheck.FieldByName('FTP').AsString;
  IdFTP1.Username := DM0.IBDataSetCheck.FieldByName('USERNAME').AsString;
  IdFTP1.Tag      := DM0.IBDataSetCheck.FieldByName('MAIN_OACI_LOC').AsString;

  Timer1 := TTimer.Create(Application);
  Timer1.Tag      := 1;
  Timer1.Interval := DM0.IBDataSetCheck.FieldByName('INTERVAL').AsInteger * 60000;
  Timer1.OnTimer  := Timer1Timer;

end;

procedure TMetar.UpdateMainForm;
begin
  MainForm.MetarUpdate(Metar_Modus, Metar_Str);
end;

procedure TMetar.Timer1Timer(Sender: TObject);
begin
  Timer1.Tag := 1;
end;

procedure TMetar.Execute;
var
  Temp      : TFileStream;
  Aux_METAR : TStringList;
  Aux_Temp  : String;
  Aux_Met   : String;
  Aux_Val   : Integer;
  Aux_Val2  : Real;
  Aux_Val3  : Integer;
  tzInfo    : TTimeZoneInformation;
begin

  if Timer1.Tag = 1 then begin

    Metar_Modus := 1;
    Metar_Str   := '';
    Synchronize(UpdateMainForm);

    Temp := TFileStream.Create('C:\METAR.Met', fmCreate);
    try
      IdFTP1.Connect;
      Aux_Temp := 'data/observations/metar/stations/' + IdFTP1.Tag + '.TXT';
      IdFTP1.Get(Aux_Temp, Temp, True);
      IdFTP1.Disconnect;
    except
      Temp.Free;
      Exit;
    end;
    Temp.Free;

    Aux_METAR := TStringList.Create;
    Aux_METAR.LoadFromFile('C:\METAR.Met');

    Aux_Temp := IntToStr(StrToInt(Copy(Aux_METAR[0], PosEx('/', Aux_METAR[0], 18)-2, 2)));
    if Copy(Aux_METAR[0], PosEx('/', Aux_METAR[0], 18)-3, 1) = 'M' then Aux_Temp := '-'+Aux_Temp;

    Metar_Modus := 2;
    Metar_Str   := Aux_METAR[0];
    Synchronize(UpdateMainForm);

    Aux_Met := Metar.Name_Loc + ' ';
    Aux_Val := StrToInt(Copy(Aux_METAR[0], PosEx('Z', Aux_METAR[0], 24)-4, 2));

    Aux_Val := Aux_Val + Metar.GMT_Dif;
    if GetTimeZoneInformation(tzInfo) = TIME_ZONE_ID_DAYLIGHT then
      Aux_Val := Aux_Val + 1;

    if Aux_Val < 10 then Aux_Temp := '0'+IntToStr(Aux_Val) else
    if Aux_Val = 24 then Aux_Temp := '00' else
    Aux_Temp := IntToStr(Aux_Val);

    Aux_Met := Aux_Met + Aux_Temp + ':' + Copy(Aux_METAR[0], PosEx('Z', Aux_METAR[0], 24)-2, 2) + ' :  ';

    Aux_Val3 := 0;
    if Pos('G', Copy(Aux_METAR[0], PosEx('KT', Aux_METAR[0], 24)-5, 5)) <> 0 then begin
      Aux_Val3 := StrToInt(Copy(Aux_METAR[0], PosEx('KT', Aux_METAR[0], 24)-2, 2));
      Aux_Val  := StrToInt(Copy(Aux_METAR[0], PosEx('G', Aux_METAR[0],24)-2, 2));
    end
    else begin
      Aux_Val  := StrToInt(Copy(Aux_METAR[0], Pos('KT', Aux_METAR[0])-2, 2));
    end;

    Aux_Val2 := 1.852 * Aux_Val;
    Aux_Temp := FormatFloat('0', Aux_Val2);

    Aux_Met := Aux_Met + Aux_Temp + ' Km/h ';

    if Copy(Aux_METAR[0], PosEx('KT', Aux_METAR[0], 24)-5, 3) = 'VRB' then
      Aux_Temp := 'VRB'
    else begin

      if Aux_Val3 = 0 then
        Aux_Val  := StrToInt(Copy(Aux_METAR[0], PosEx('KT', Aux_METAR[0], 24)-5, 3))
      else
        Aux_Val  := StrToInt(Copy(Aux_METAR[0], PosEx('G', Aux_METAR[0], 24)-5, 3));

      if Aux_Val <=  20 then Aux_Temp := 'N'  else
      if Aux_Val <=  70 then Aux_Temp := 'NE' else
      if Aux_Val <= 110 then Aux_Temp := 'E'  else
      if Aux_Val <= 160 then Aux_Temp := 'SE' else
      if Aux_Val <= 200 then Aux_Temp := 'S'  else
      if Aux_Val <= 250 then Aux_Temp := 'SW' else
      if Aux_Val <= 290 then Aux_Temp := 'W'  else
      if Aux_Val <= 340 then Aux_Temp := 'NW' else
      Aux_Temp := 'N';

    end;

    Aux_Met  := Aux_Met + Aux_Temp + ' ';

    if Aux_Val3 <> 0 then begin
      Aux_Val2 := 1.852 * Aux_Val3;
      Aux_Temp := FormatFloat('0', Aux_Val2);
      Aux_Met := Aux_Met + '(' + Aux_Temp + ' Km/h)  ';
    end
    else
      Aux_Met := Aux_Met + ' ';

    Aux_Temp := IntToStr(StrToInt(Copy(Aux_METAR[0], PosEx('/', Aux_METAR[0], 18)-2, 2)));
    if Copy(Aux_METAR[0], PosEx('/', Aux_METAR[0], 18)-3, 1) = 'M' then Aux_Temp := '-'+Aux_Temp;
    Aux_Met  := Aux_Met + Aux_Temp + ' ºC  ';

    Aux_Val  := StrToInt(Aux_Temp);

    if Copy(Aux_METAR[0], PosEx('/', Aux_METAR[0], 18)+1, 1) = 'M' then
      Aux_Temp := '-' + IntToStr(StrToInt(Copy(Aux_METAR[0], PosEx('/', Aux_METAR[0], 18)+2, 2)))
    else
      Aux_Temp := IntToStr(StrToInt(Copy(Aux_METAR[0], PosEx('/', Aux_METAR[0], 18)+1, 2)));
    Aux_Val3 := StrToInt(Aux_Temp);
    Aux_Val2 := 100 * Power((112 - (0.1 * Aux_Val) + Aux_Val3) / (112 + (0.9 * Aux_Val)),8);
    Aux_Temp := FormatFloat('0', Aux_Val2);

    Aux_Met  := Aux_Met + Aux_Temp + '%  ';

    Aux_Temp := Copy(Aux_METAR[0], Pos('Q', Aux_METAR[0])+1, 4);
    Aux_Met  := Aux_Met + Aux_Temp + ' mb';

    Metar_Modus := 3;
    Metar_Str   := Aux_Met;
    Synchronize(UpdateMainForm);

    DeleteFile('C:\METAR.Met');

    Timer1.Tag := 0;

  end;

end;

procedure Metar_Initialize;
begin

  with DM0.IBDataSetCheck do begin
    SelectSQL.Clear;
    SelectSQL.Add('Select * from METAR_GENERAL');
    Prepare;
    Open;
  end;

  if (not DM0.IBDataSetCheck.IsEmpty) and
     (DM0.IBDataSetCheck.FieldByName('FTP').AsString <> '') then begin
    Metar := TMetar.Create;
    Metar.FreeOnTerminate := True;
    Metar.Name_Loc  := DM0.IBDataSetCheck.FieldByName('NAME_MAIN_LOC').AsString;
    Metar.GMT_Dif   := DM0.IBDataSetCheck.FieldByName('GMT_DIF').AsInteger;
    Metar.Resume;
  end;

  MainForm.LabelStMetAux.Visible := False;

end;

end.

Si tienes cualquier duda, estaré encantando de poder aclararla.

Un saludo.

José Luis Garcí 28-06-2007 17:34:19
Glu Glu gracias por tu rapida contestación, y perdona por tardar en contestar, he intentado varias veces pero no logro que funcione, con que veción de delphi programas, La mia es Delphi 6, por si viene por ahi el fallo, espero tu respuesta.

Gracias y un saludo desde Canarias

gluglu 28-06-2007 17:51:19
Utilizo BDS 2006 Vcl.NET

Pero no creo que deba de haber ningún problema con Delphi 6.

Lo único que a lo mejor varía algo son los componentes de Indy que se utilizan en la versión BDS 2006. Tendrías que detallarme algo más, indicando donde te falla, para que te pueda ayudar.

En mi ejemplo de código, el fichero que se obtiene del FTP se graba en C:\METAR.Txt

Ese fichero lo obtienes y se graba correctamente ?

No mencioné en el anterior post que existe una tabla en mi base de datos que se abre en un DataModule adicional y que contiene los siguientes campos :

FTP : Nombre del FTP del que se obtiene la información meteorológica
USERNAME : Nombre de usuario para acceder a ese FTP
MAIN_OACI_LOC : Código OACI del aeropuerto del que se quiere consultar la información meteorológica
INTERVAL : Intervalo de tiempo en minutos para nueva consulta de datos meteorológicos del FTP

Los valores 'generales' de esa tabla son :
FTP = tgftp.nws.noaa.gov
USERNAME = anonymous
MAIN_OACI_LOC = LEMG (en mi caso, correspondiente al aeropuerto de Málaga)
INTERVAL = 20 (yo consulto cada 20 minutos, aunque la información se actualiza normalmente cada 30 minutos o cada hora)

Espero ayudarte en lo posible.

Un saludo ;)

José Luis Garcí 04-07-2007 18:47:18
Gluglu Como siempre voy atrasado en mis mensajes,laultima vez que lo intentem, no habia conseguido nada, que error me da no lo recuerdo, pero intalando unos componentes mi delphi ha dejado de funcionar y estoy esperando a mi nuevo PC para seguir trabajando, de todos modos si no te es mucho trabajo, podiras poner una pequeña demo muy basica, para hacerla correr en Delphi.

Gracias y un saludod desde Canarias.

gluglu 04-07-2007 20:08:00
1 Archivos Adjunto(s)
Aquí te subo un programa hecho con BDS 2006 para Win32.

Sí que es cierto que he tenido que cambiar una cosa con respecto al StringList. En VCL.Net me lo grababa en un sólo String del StringList, y en Win32 me lo graba en 2 String's diferentes del StringList, por lo que ha bastado unir esos dos strings por separado en uno solo.

Espero que te sirva.

Un saludo ;)

José Luis Garcí 16-07-2007 13:48:32
Gluglu siento decirte que no logro que funcione, lo he instalado en mi Delphi 6 y en Turbo delphi y nada no hay manera, no te comento el error al no estar en casa donde programo, de todas maneras darte las gracias por atenderme y disculpas por el atraso, pero apenas puedo dedicar unas horas a la semana a la programación, cosa que me pesa mucho.

Gracias y un saludo desde Canarias


La franja horaria es GMT +2. Ahora son las 04:50:01.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi