Ver Mensaje Individual
  #2  
Antiguo 22-06-2007
Avatar de gluglu
[gluglu] gluglu is offline
Miembro Premium
 
Registrado: sep 2004
Ubicación: Málaga - España
Posts: 1.455
Reputación: 21
gluglu Va por buen camino
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.
__________________
Piensa siempre en positivo !

Última edición por gluglu fecha: 22-06-2007 a las 00:23:48.
Responder Con Cita