{***************************************************************************}
{ TMS TAdvWeather                                                           }
{ for Delphi & C++Builder                                                   }
{                                                                           }
{ written by TMS Software                                                   }
{            copyright © 2012                                               }
{            Email : info@tmssoftware.com                                   }
{            Web : http://www.tmssoftware.com                               }
{                                                                           }
{ The source code is given as is. The author is not responsible             }
{ for any possible damage done due to the use of this code.                 }
{ The component can be freely used in any application. The complete         }
{ source code remains property of the author and may not be distributed,    }
{ published, given or sold in any form as such. No parts of the source      }
{ code can be included in any other component or application without        }
{ written authorization of the author.                                      }
{***************************************************************************}
unit CloudWeather;

interface

uses
  Classes, CloudBase;

type

  TWeatherLocation = class(TPersistent)
  private
    FLatitude: string;
    FZip: string;
    FState: string;
    FLongitude: string;
    FCountry: string;
    FFullName: string;
    FCity: string;
    FElevation: string;
  public
    property FullName: string read FFullName write FFullName;
    property City: string read FCity write FCity;
    property State: string read FState write FState;
    property Country: string read FCountry write FCountry;
    property ZIP: string read FZip write FZip;
    property Longitude: string read FLongitude write FLongitude;
    property Latitude: string read FLatitude write FLatitude;
    property Elevation: string read FElevation write FElevation;
  end;

  TWeatherLanguage = (wlDutch, wlGerman, wlEnglish, wlFrench, wlPortuguese,
    wlSpanish, wlPolish, wlRussian, wlCzech, wlDanish, wlGreek, wlItalian, wlSwiss,
    wlSlovenian, wlSwedish, wlRomanian, wlTurkish, wlNorwegian, wlJapanese, wlFinnish);

  TWeatherCondition = class(TPersistent)
  private
    FLocation: TWeatherLocation;
    FTempC: double;
    FTempF: double;
    FWindDegrees: integer;
    FDewPointF: double;
    FPrecip1hrMetric: string;
    FWindKph: double;
    FIconURL: string;
    FWindMph: double;
    FWindDir: string;
    FPressureIn: double;
    FWeather: string;
    FUV: string;
    FVisibilityKm: double;
    FVisibilityMi: double;
    FDewPointC: double;
    FPressureMb: double;
    FFeelsLikeC: double;
    FFeelsLikeF: double;
  public
    constructor Create;
    destructor Destroy; override;
    property Location: TWeatherLocation read FLocation;
    property TempC: double read FTempC write FTempC;
    property TempF: double read FTempF write FTempF;
    property Weather: string read FWeather write FWeather;
    property WindDir: string read FWindDir write FWindDir;
    property WindDegrees: integer read FWindDegrees write FWindDegrees;
    property WindMph: double read FWindMph write FWindMph;
    property WindKph: double read FWindKph write FWindKph;
    property FeelsLikeC: double read FFeelsLikeC write FFeelsLikeC;
    property FeelsLikeF: double read FFeelsLikeF write FFeelsLikeF;
    property PressureMb: double read FPressureMb write FPressureMb;
    property PressureIn: double read FPressureIn write FPressureIn;
    property DewPointF: double read FDewPointF write FDewPointF;
    property DewPointC: double read FDewPointC write FDewPointC;
    property VisibilityMi: double read FVisibilityMi write FVisibilityMi;
    property VisibilityKm: double read FVisibilityKm write FVisibilityKm;
    property UV: string read FUV write FUV;
    property IconURL: string read FIconURL write FIconURL;
    property Precip1hrMetric: string read FPrecip1hrMetric write FPrecip1hrMetric;
  end;

  TTextWeatherForeCastItem = class(TCollectionItem)
  private
    FTextMetric: string;
    FIconURL: string;
    FTitle: string;
    FText: string;
  public
    property IconURL: string read FIconURL write FIconURL;
    property Title: string read FTitle write FTitle;
    property Text: string read FText write FText;
    property TextMetric: string read FTextMetric write FTextMetric;
  end;

  TTextWeatherForeCast = class(TCollection)
  private
    function GetItem(Index: integer): TTextWeatherForeCastItem;
    procedure SetItem(Index: integer; const Value: TTextWeatherForeCastItem);
  published
  public
    constructor Create;
    function Add: TTextWeatherForeCastItem;
    property Items[Index: integer]: TTextWeatherForeCastItem read GetItem write SetItem;
  end;

  TWeatherForeCastItem = class(TCollectionItem)
  private
    FDate: TDateTime;
    FTempHighC: double;
    FTempHighF: double;
    FTempLowC: double;
    FTempLowF: double;
    FAveWindMph: double;
    FMaxWindDegrees: integer;
    FAveWindDir: string;
    FIconURL: string;
    FMaxWindMph: double;
    FAveWindDegrees: integer;
    FMaxWindDir: string;
    FConditions: string;
    FAveWindKmh: double;
    FMaxWindKmh: double;
    FMaxHumidity: integer;
    FMinHumidity: integer;
    FAveHumidity: integer;
  public
    property Date: TDateTime read FDate write FDate;
    property TempHighF: double read FTempHighF write FTempHighF;
    property TempHighC: double read FTempHighC write FTempHighC;
    property TempLowF: double read FTempLowF write FTempLowF;
    property TempLowC: double read FTempLowC write FTempLowC;
    property Conditions: string read FConditions write FConditions;
    property IconURL: string read FIconURL write FIconURL;
    property MaxWindMph: double read FMaxWindMph write FMaxWindMph;
    property MaxWindKmh: double read FMaxWindKmh write FMaxWindKmh;
    property MaxWindDir: string read FMaxWindDir write FMaxWindDir;
    property MaxWindDegrees: integer read FMaxWindDegrees write FMaxWindDegrees;

    property AveWindMph: double read FAveWindMph write FAveWindMph;
    property AveWindKmh: double read FAveWindKmh write FAveWindKmh;
    property AveWindDir: string read FAveWindDir write FAveWindDir;
    property AveWindDegrees: integer read FAveWindDegrees write FAveWindDegrees;

    property AveHumidity: integer read FAveHumidity write FAveHumidity;
    property MaxHumidity: integer read FMaxHumidity write FMaxHumidity;
    property MinHumidity: integer read FMinHumidity write FMinHumidity;
  end;

  TWeatherForeCast = class(TCollection)
  private
    function GetItem(Index: integer): TWeatherForeCastItem;
    procedure SetItem(Index: integer; const Value: TWeatherForeCastItem);
  published
  public
    constructor Create;
    function Add: TWeatherForeCastItem;
    property Items[Index: integer]: TWeatherForeCastItem read GetItem write SetItem;
  end;


  TAdvWeather = class(TCloudBase)
  private
    FCondition: TWeatherCondition;
    FTextForeCast: TTextWeatherForeCast;
    FForeCast: TWeatherForeCast;
    FLanguage: TWeatherLanguage;
  protected
    procedure GetForecastInt(Cmd,ACountry, ACity: string);
    function LangParam: string;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure GetConditions(ACountry, ACity: string);
    procedure GetForecast(ACountry, ACity: string);
    procedure GetForecast10Day(ACountry, ACity: string);
    property Condition: TWeatherCondition read FCondition;
    property TextForeCast: TTextWeatherForeCast read FTextForeCast;
    property ForeCast: TWeatherForeCast read FForeCast;
    property Language: TWeatherLanguage read FLanguage write FLanguage default wlEnglish;
  end;

  TAdvWeatherLocationLookupProvider = class(TCloudLookupProvider)
  public
    procedure Lookup(AText: string; Values: TStrings); override;
  end;

implementation

uses
  Dialogs, DBXJSON, StrUtils, SysUtils;


{ TAdvWeather }

constructor TAdvWeather.Create(AOwner: TComponent);
begin
  inherited;
  FCondition := TWeatherCondition.Create;
  FTextForeCast := TTextWeatherForeCast.Create;
  FForeCast := TWeatherForeCast.Create;
  FLanguage := wlEnglish;
end;

destructor TAdvWeather.Destroy;
begin
  FCondition.Free;
  FTextForeCast.Free;
  FForeCast.Free;
  inherited;
end;

procedure TAdvWeather.GetConditions(ACountry, ACity: string);
var
  resdat: ansistring;
  url: string;
  jv: TJSONValue;
  jvs,jvl: TJSONValue;
  jo,jos: TJSONObject;
begin
  url := 'http://api.wunderground.com/api/'+ App.Key +'/conditions/q/' + URLEncode(ACountry)+'/'+ URLEncode(ACity)+'.json';
  resdat := CleanupJSON(httpsget(url));

  jv := TJSONObject.ParseJSONValue(string(resdat));

  if Assigned(jv) then
  begin
    jvs := GetJSONValue(jv as TJSONObject,'current_observation');

    if Assigned(jvs) and (jvs is TJSONObject) then
    begin
      jos := jvs as TJSONObject;
      jvl := GetJSONValue(jos,'display_location');
      jo := jvl as TJSONObject;

      Condition.Location.FullName := GetJSONProp(jo,'full');
      Condition.Location.City := GetJSONProp(jo,'city');
      Condition.Location.State := GetJSONProp(jo,'state');
      Condition.Location.Country := GetJSONProp(jo,'country');
      Condition.Location.ZIP := GetJSONProp(jo,'zip');
      Condition.Location.Longitude := GetJSONProp(jo,'longitude');
      Condition.Location.Latitude := GetJSONProp(jo,'latitude');
      Condition.Location.Elevation := GetJSONProp(jo,'elevation');

      jvl := GetJSONValue(jos,'temp_f');
      Condition.TempF := (jvl as TJSONNumber).AsDouble;

      jvl := GetJSONValue(jos,'temp_c');
      Condition.TempC := (jvl as TJSONNumber).AsDouble;

      jvl := GetJSONValue(jos,'dewpoint_f');
      Condition.DewPointF := (jvl as TJSONNumber).AsDouble;

      jvl := GetJSONValue(jos,'dewpoint_c');
      Condition.DewPointC := (jvl as TJSONNumber).AsDouble;

      Condition.FeelsLikeC := StrToFloat(GetJSONProp(jos,'feelslike_c'));
      Condition.FeelsLikeF := StrToFloat(GetJSONProp(jos,'feelslike_f'));

      Condition.VisibilityMi := StrToFloat(GetJSONProp(jos,'visibility_mi'));
      Condition.VisibilityKm := StrToFloat(GetJSONProp(jos,'visibility_km'));

      Condition.PressureMb := StrToFloat(GetJSONProp(jos,'pressure_mb'));
      Condition.PressureIn := StrToFloat(GetJSONProp(jos,'pressure_in'));

      jvl := GetJSONValue(jos,'wind_kph');
      Condition.WindKph := (jvl as TJSONNumber).AsDouble;

      Condition.WindMph := StrToFloat(GetJSONProp(jos,'wind_mph'));

      jvl := GetJSONValue(jos,'wind_degrees');
      Condition.WindDegrees := (jvl as TJSONNumber).AsInt;
      Condition.WindDir := GetJSONProp(jos,'wind_dir');

      Condition.UV := GetJSONProp(jos,'UV');

      Condition.IconURL := GetJSONProp(jos,'icon_url');

      Condition.Weather := GetJSONProp(jos,'weather');

      showmessage(condition.Location.FullName+' : '+ FloatToStr(condition.TempC)+'°C : ' + condition.Weather);
    end;

    jv.Free;
  end;

end;

procedure TAdvWeather.GetForecast(ACountry, ACity: string);
begin
  GetForeCastInt('forecast',ACountry, ACity);
end;

procedure TAdvWeather.GetForecast10day(ACountry, ACity: string);
begin
  GetForeCastInt('forecast10day',ACountry, ACity);
end;


procedure TAdvWeather.GetForecastInt(Cmd,ACountry, ACity: string);
var
  resdat: ansistring;
  url: string;
  jv: TJSONValue;
  jvs: TJSONValue;
  jo, jao: TJSONObject;
  ja: TJSONArray;
  i: integer;
  twfi: TTextWeatherForeCastItem;
  wfi: TWeatherForeCastItem;
  da,mo,ye:word;
begin
  url := 'http://api.wunderground.com/api/'+ App.Key +'/' + Cmd + '/' + Langparam + '/q/' + URLEncode(ACountry)+'/'+ URLEncode(ACity)+'.json';
  resdat := CleanupJSON(httpsget(url));

  //showmessage(resdat);

  jv := TJSONObject.ParseJSONValue(string(UTF8ToString(resdat)));

  if Assigned(jv) then
  begin
    TextForeCast.Clear;

    jvs := GetJSONValue(jv as TJSONObject,'forecast');

    if Assigned(jvs) then
    begin
      jvs := GetJSONValue(jvs as TJSONObject,'txt_forecast');

      if Assigned(jvs) then
        jvs := GetJSONValue(jvs as TJSONObject,'forecastday');
    end;

    if Assigned(jvs) and (jvs is TJSONArray) then
    begin
      ja  := (jvs as TJSONArray);

      for i := 0 to ja.Size - 1 do
      begin
        twfi := TextForeCast.Add;
        jo := ja.Get(i) as TJSONObject;
        twfi.IconURL := GetJSONProp(jo,'icon_url');
        twfi.Title := GetJSONProp(jo,'title');
        twfi.Text := GetJSONProp(jo,'fcttext');
        twfi.TextMetric := GetJSONProp(jo,'fcttext_metric');
      end;
    end;

    jvs := GetJSONValue(jv as TJSONObject,'forecast');

    if Assigned(jvs) then
    begin
      jvs := GetJSONValue(jvs as TJSONObject,'simpleforecast');

      if Assigned(jvs) then
        jvs := GetJSONValue(jvs as TJSONObject,'forecastday');
    end;

    if Assigned(jvs) and (jvs is TJSONArray) then
    begin
      ja  := (jvs as TJSONArray);

      ForeCast.Clear;

      for i := 0 to ja.Size - 1 do
      begin
        wfi := ForeCast.Add;

        jo := ja.Get(i) as TJSONObject;
        jao := GetJSONValue(jo,'date') as TJSONObject;

        da := (GetJSONValue(jao,'day') as TJSONNumber).AsInt;
        mo := (GetJSONValue(jao,'month') as TJSONNumber).AsInt;
        ye := (GetJSONValue(jao,'year') as TJSONNumber).AsInt;
        wfi.Date := EncodeDate(ye,mo,da);


        jao := GetJSONValue(jo,'high') as TJSONObject;

        wfi.TempHighF := StrToFloat(GetJSONProp(jao,'fahrenheit'));
        wfi.TempHighC := StrToFloat(GetJSONProp(jao,'celsius'));

        jao := GetJSONValue(jo,'low') as TJSONObject;

        wfi.TempLowF := StrToFloat(GetJSONProp(jao,'fahrenheit'));
        wfi.TempLowC := StrToFloat(GetJSONProp(jao,'celsius'));

        wfi.IconURL := GetJSONProp(jo,'icon_url');
        wfi.Conditions := GetJSONProp(jo,'conditions');

        jao := GetJSONValue(jo,'maxwind') as TJSONObject;
        wfi.MaxWindMph := (GetJSONValue(jao,'mph') as TJSONNumber).AsDouble;
        wfi.MaxWindKmh := (GetJSONValue(jao,'kph') as TJSONNumber).AsDouble;
        wfi.MaxWindDir := GetJSONProp(jao,'dir');
        wfi.MaxWindDegrees := (GetJSONValue(jao,'degrees') as TJSONNumber).AsInt;

        jao := GetJSONValue(jo,'avewind') as TJSONObject;
        wfi.AveWindMph := (GetJSONValue(jao,'mph') as TJSONNumber).AsDouble;
        wfi.AveWindKmh := (GetJSONValue(jao,'kph') as TJSONNumber).AsDouble;
        wfi.AveWindDir := GetJSONProp(jao,'dir');
        wfi.AveWindDegrees := (GetJSONValue(jao,'degrees') as TJSONNumber).AsInt;

        wfi.AveHumidity := (GetJSONValue(jo,'avehumidity') as TJSONNumber).AsInt;
        wfi.MaxHumidity := (GetJSONValue(jo,'maxhumidity') as TJSONNumber).AsInt;
        wfi.MinHumidity := (GetJSONValue(jo,'minhumidity') as TJSONNumber).AsInt;
      end;
    end;
    jv.Free;
  end;
end;

function TAdvWeather.LangParam: string;
begin
  case Language of
    wlDutch: Result := 'lang:NL';
    wlGerman: Result := 'lang:DL';
    wlEnglish: Result := 'lang:EN';
    wlFrench: Result := 'lang:FR';
    wlPortuguese: Result := 'lang:BR';
    wlSpanish: Result := 'lang:SP';
    wlPolish: Result := 'lang:PL';
    wlRussian: Result := 'lang:RU';
    wlCzech: Result := 'lang:CZ';
    wlDanish: Result := 'lang:DK';
    wlGreek: Result := 'lang:GR';
    wlItalian: Result := 'lang:IT';
    wlSwiss: Result := 'lang:CH';
    wlSlovenian: Result := 'lang:SL';
    wlSwedish: Result := 'lang:SW';
    wlRomanian: Result := 'lang:RO';
    wlTurkish: Result := 'lang:TR';
    wlNorwegian: Result := 'lang:NO';
    wlJapanese: Result := 'lang:JP';
    wlFinnish: Result := 'lang:FI';
  end;
end;

{ TWeatherCondition }

constructor TWeatherCondition.Create;
begin
  inherited;
  FLocation := TWeatherLocation.Create;
end;

destructor TWeatherCondition.Destroy;
begin
  FLocation.Free;
  inherited;
end;

{ TWeatherForeCast }

function TTextWeatherForeCast.Add: TTextWeatherForeCastItem;
begin
  Result := TTextWeatherForeCastItem(inherited Add);
end;

constructor TTextWeatherForeCast.Create;
begin
  inherited Create(TTextWeatherForeCastItem);
end;

function TTextWeatherForeCast.GetItem(Index: integer): TTextWeatherForeCastItem;
begin
  Result := TTextWeatherForeCastItem(inherited Items[Index]);
end;

procedure TTextWeatherForeCast.SetItem(Index: integer;
  const Value: TTextWeatherForeCastItem);
begin
  inherited Items[Index] := Value;
end;

{ TWeatherForeCast }

function TWeatherForeCast.Add: TWeatherForeCastItem;
begin
  Result := TWeatherForeCastItem(inherited Add);
end;

constructor TWeatherForeCast.Create;
begin
  inherited Create(TWeatherForeCastItem);
end;

function TWeatherForeCast.GetItem(Index: integer): TWeatherForeCastItem;
begin
  Result := TWeatherForeCastItem(inherited Items[Index]);
end;

procedure TWeatherForeCast.SetItem(Index: integer;
  const Value: TWeatherForeCastItem);
begin
  inherited Items[Index] := Value;
end;


{ TAdvWeatherLocationLookupProvider }

procedure TAdvWeatherLocationLookupProvider.Lookup(AText: string;
  Values: TStrings);
var
  resdat: ansistring;
  url: string;
  jv: TJSONValue;
  jvs: TJSONValue;
  ja: TJSONArray;
  jo: TJSONObject;
    i: Integer;
begin
  url := 'http://autocomplete.wunderground.com/aq?query=' + URLEncode(string(UTF8Encode(AText)));

  resdat := CleanupJSON(HttpsGet(url));

  jv := TJSONObject.ParseJSONValue(string(resdat));

  if Assigned(jv) then
  begin
    jvs := GetJSONValue(jv as TJSONObject,'RESULTS');

    if Assigned(jvs) and (jvs is TJSONArray) then
    begin
      ja := jvs as TJSONArray;

      for i := 0 to ja.Size - 1 do
      begin
        jo := ja.Get(i) as TJSONObject;

        Values.Add(GetJSONProp(jo,'name'));
      end;
    end;
    jv.Free;
  end;
end;

end.
