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
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
LabelStMet3.Visible := True;
LabelStMet4.Visible := False;
LabelStMet3.Caption := 'Û';
end else
if PosEx('SN', Metar_Str, 18) <> 0 then begin
LabelStMet3.Visible := True;
LabelStMet4.Visible := False;
LabelStMet3.Caption := 'Ú';
end else
if PosEx('TS', Metar_Str, 18) <> 0 then begin
LabelStMet3.Visible := True;
LabelStMet4.Visible := False;
LabelStMet3.Caption := 'Ü';
end else
if PosEx('OVC', Metar_Str, 18) <> 0 then begin
LabelStMet3.Visible := True;
LabelStMet4.Visible := False;
LabelStMet3.Caption := 'Ù';
end else
if PosEx('BKN', Metar_Str, 18) <> 0 then begin
LabelStMet3.Visible := True;
LabelStMet4.Visible := False;
LabelStMet3.Caption := 'Ø';
end else
if PosEx('SCT', Metar_Str, 18) <> 0 then begin
LabelStMet3.Visible := True;
LabelStMet4.Visible := False;
LabelStMet3.Caption := '×';
end else
if PosEx('FEW', Metar_Str, 18) <> 0 then begin
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
public
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.