OpenWeather API

init
This commit is contained in:
Paweł Dmitruk 2024-02-18 15:21:53 +01:00
parent 92ba673995
commit 6f1c29057c
12 changed files with 1428 additions and 0 deletions

7
.gitignore vendored
View File

@ -45,6 +45,13 @@
*.o
*.ocx
#Lazarus
*.ppu
*.compiled
*.lps
backup/
lib/
# Delphi autogenerated files (duplicated info)
*.cfg
*.hpp

View File

@ -0,0 +1,631 @@
{==============================================================================
MIT License
Copyright (c) 2024 Paweł Dmitruk (paweld), https://github.com/paweld
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
==============================================================================}
{
Get current weather and forecast from OpenWeather API
}
unit LPDWeatherU;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Graphics, DateUtils, fphttpclient, opensslsockets, httpprotocol, fpjson, jsonparser, fgl;
type
TWeatherUnits = (wuMetric, wuStandard, wuImperial);
{ metric [temp: Celsius, wind: m/s], standard [temp: Kelvin, wind: m/s], imperial [temp: Fahrenheit, wind: mile/h] }
TWeatherLang = (wlAf {Afrikaans}, wlAl {Albanian}, wlAr {Arabic}, wlAz {Azerbaijani}, wlBg {Bulgarian}, wlCa {Catalan}, wlCz {Czech}, wlDa {Danish},
wlDe {German}, wlEl {Greek}, wlEn {English}, wlEs {Spanish}, wlEu {Basque}, wlFa {Persian (Farsi)}, wlFi {Finnish}, wlFr {French}, wlGl {Galician},
wlHe {Hebrew}, wlHi {Hindi}, wlHr {Croatian}, wlHu {Hungarian}, wlId {Indonesian}, wlIt {Italian}, wlJa {Japanese}, wlKr {Korean}, wlLa {Latvian},
wlLt {Lithuanian}, wlMk {Macedonian}, wlNo {Norwegian}, wlNl {Dutch}, wlPl {Polish}, wlPt {Portuguese}, wlPt_br {Português Brasil}, wlRo {Romanian},
wlRu {Russian}, wlSv {Swedish}, wlSk {Slovak}, wlSl {Slovenian}, wlSr {Serbian}, wlTh {Thai}, wlTr {Turkish}, wlUk {Ukrainian}, wlVi {Vietnamese},
wlZh_cn {Chinese Simplified}, wlZh_tw {Chinese Traditional}, wlZu {Zulu});
{ TWeatherItem }
TWeatherItem = class
private
FPressure: Currency;
FDate: TDateTime;
FWeatherIcon: TMemoryStream;
FDescription: String;
FTemp: Currency;
FTempMax: Currency;
FTempMin: Currency;
FTempFeelsLike: Currency;
FWindDirection: String;
FWindSpeed: Currency;
FWindDegrees: Currency;
FWindGust: Currency;
FVisibility: Currency;
FHumidity: Currency;
FSunrise: TTime;
FSunset: TTime;
procedure SetWindDegrees(aValue: Currency);
public
constructor Create;
destructor Destroy; override;
property Date: TDateTime read FDate write FDate;
property Description: String read FDescription write FDescription;
property Temp: Currency read FTemp write FTemp;
property TempFeelsLike: Currency read FTempFeelsLike write FTempFeelsLike;
property TempMin: Currency read FTempMin write FTempMin;
property TempMax: Currency read FTempMax write FTempMax;
property Humidity: Currency read FHumidity write FHumidity;
property Pressure: Currency read FPressure write FPressure;
property Visibility: Currency read FVisibility write FVisibility;
property WindSpeed: Currency read FWindSpeed write FWindSpeed;
property WindDegrees: Currency read FWindDegrees write SetWindDegrees;
property WindDirection: String read FWindDirection write FWindDirection;
property WindGust: Currency read FWindGust write FWindGust;
property Sunrise: TTime read FSunrise write FSunrise;
property Sunset: TTime read FSunset write FSunset;
property WeatherIcon: TMemoryStream read FWeatherIcon write FWeatherIcon;
end;
{ TWeatherList }
TWeatherList = class(specialize TFPGMapObject<TDateTime, TWeatherItem>)
public
constructor Create;
function IndexOfDate(aDate: TDatetime): Integer;
end;
{ TWeather }
TWeather = class
private
FCurrentWeather: TWeatherItem;
FAPIKey: String;
FCity: String;
FLang: TWeatherLang;
FLastError: String;
FLatitude: Double;
FLongitude: Extended;
FUnits: TWeatherUnits;
FWeatherForecast: TWeatherList;
function GetLangCode: String;
function GetUnitsCode: String;
procedure Parse(ajo: TJsonObject; var aPogodaItem: TWeatherItem);
procedure SetLang(AValue: TWeatherLang);
procedure SetLangCode(AValue: String);
procedure SetUnits(AValue: TWeatherUnits);
procedure SetCity(AValue: String);
public
constructor Create;
destructor Destroy; override;
procedure ClearWeatherInfo;
function Get(aCity: String; aCountryCode: String = ''; aStateCode: String = ''): Boolean;
function Get(aLat, aLon: Double): Boolean;
property APIKey: String read FAPIKey write FAPIKey;
property CurrentWeather: TWeatherItem read FCurrentWeather;
property City: String read FCity;
property Lang: TWeatherLang read FLang write SetLang;
property LangCode: String read GetLangCode write SetLangCode;
property Units: TWeatherUnits read FUnits write SetUnits;
property WeatherForecast: TWeatherList read FWeatherForecast;
property LastError: String read FLastError;
property Latitude: Double read FLatitude;
property Longitude: Extended read FLongitude;
end;
implementation
{ TWeatherItem }
procedure TWeatherItem.SetWindDegrees(aValue: Currency);
const
wdarr: array [0..7] of String = ('N', 'NE', 'E', 'SE', 'S', 'SW', 'W', 'NW');
var
i, idx, range: Integer;
deg: Currency;
begin
FWindDegrees := aValue;
if (FWindDegrees < 0) or (FWindDegrees > 360) then
raise Exception.Create('Incorrect WindDegrees!');
deg := FWindDegrees;
if deg = 0 then
deg := 1;
range := 360 div Length(wdarr);
idx := 0;
for i := Low(wdarr) to High(wdarr) do
begin
if (deg >= ((range * i) - (range div 2))) and (deg <= ((range * (i + 1)) - (range div 2))) then
begin
idx := i;
break;
end;
end;
FWindDirection := wdarr[idx];
end;
constructor TWeatherItem.Create;
begin
FPressure := 0;
FDate := 0;
FDescription := '';
FTemp := 0;
FTempMax := 0;
FTempMin := 0;
FTempFeelsLike := 0;
FWindDirection := '';
FWindSpeed := 0;
FWindDegrees := 0;
FWindGust := 0;
FVisibility := 0;
FHumidity := 0;
FSunrise := 0;
FSunset := 0;
FWeatherIcon := TMemoryStream.Create;
end;
destructor TWeatherItem.Destroy;
begin
FWeatherIcon.Free;
inherited Destroy;
end;
{ TWeatherList }
constructor TWeatherList.Create;
begin
inherited Create;
Duplicates := dupIgnore;
Sorted := True;
end;
function TWeatherList.IndexOfDate(aDate: TDatetime): Integer;
var
i: Integer;
begin
Result := -1;
if Count = 0 then //if no forecast
exit;
if (Trunc(aDate) < Trunc(Keys[0])) or (Trunc(aDate) > Trunc(Keys[Count - 1])) then //if the date is out of the forecast
exit;
if aDate < Keys[0] then
begin
Result := 0;
exit;
end;
for i := 0 to Count - 2 do
begin
if aDate < IncSecond(Keys[i], SecondsBetween(Keys[i], Keys[i + 1]) div 2) then
begin
Result := i;
break;
end;
end;
if Result < 0 then
Result := Count - 1;
end;
{ TWeather }
constructor TWeather.Create;
begin
FAPIKey := '';
FLastError := '';
FLang := wlEn;
FCity := '';
FLatitude := 0;
FLongitude := 0;
FUnits := wuMetric;
FCurrentWeather := TWeatherItem.Create;
FWeatherForecast := TWeatherList.Create;
if not DirectoryExists(GetAppConfigDir(False)) then
ForceDirectories(GetAppConfigDir(False));
end;
destructor TWeather.Destroy;
begin
FCurrentWeather.Free;
FWeatherForecast.Free;
inherited Destroy;
end;
procedure TWeather.ClearWeatherInfo;
begin
FCurrentWeather.Pressure := 0;
FCurrentWeather.Date := 0;
FCurrentWeather.Description := '';
FCurrentWeather.Temp := 0;
FCurrentWeather.TempMax := 0;
FCurrentWeather.TempMin := 0;
FCurrentWeather.TempFeelsLike := 0;
FCurrentWeather.WindDirection := '';
FCurrentWeather.WindSpeed := 0;
FCurrentWeather.WindDegrees := 0;
FCurrentWeather.WindGust := 0;
FCurrentWeather.Visibility := 0;
FCurrentWeather.Humidity := 0;
FCurrentWeather.Sunrise := 0;
FCurrentWeather.Sunset := 0;
FCurrentWeather.WeatherIcon.Clear;
FWeatherForecast.Clear;
end;
function TWeather.GetLangCode: String;
begin
case FLang of
wlAf: Result := 'af';
wlAl: Result := 'al';
wlAr: Result := 'ar';
wlAz: Result := 'az';
wlBg: Result := 'bg';
wlCa: Result := 'ca';
wlCz: Result := 'cz';
wlDa: Result := 'da';
wlDe: Result := 'de';
wlEl: Result := 'el';
wlEn: Result := 'en';
wlEs: Result := 'es';
wlEu: Result := 'eu';
wlFa: Result := 'fa';
wlFi: Result := 'fi';
wlFr: Result := 'fr';
wlGl: Result := 'gl';
wlHe: Result := 'he';
wlHi: Result := 'hi';
wlHr: Result := 'hr';
wlHu: Result := 'hu';
wlId: Result := 'id';
wlIt: Result := 'it';
wlJa: Result := 'ja';
wlKr: Result := 'kr';
wlLa: Result := 'la';
wlLt: Result := 'lt';
wlMk: Result := 'mk';
wlNo: Result := 'no';
wlNl: Result := 'nl';
wlPl: Result := 'pl';
wlPt: Result := 'pt';
wlPt_br: Result := 'pt_br';
wlRo: Result := 'ro';
wlRu: Result := 'ru';
wlSv: Result := 'sv';
wlSk: Result := 'sk';
wlSl: Result := 'sl';
wlSr: Result := 'sr';
wlTh: Result := 'th';
wlTr: Result := 'tr';
wlUk: Result := 'uk';
wlVi: Result := 'vi';
wlZh_cn: Result := 'zh_cn';
wlZh_tw: Result := 'zh_tw';
wlZu: Result := 'zu';
else
Result := 'en';
end;
end;
function TWeather.GetUnitsCode: String;
begin
case FUnits of
wuMetric: Result := 'metric';
wuStandard: Result := 'standard';
wuImperial: Result := 'imperial';
else
Result := 'metric';
end;
end;
procedure TWeather.Parse(ajo: TJsonObject; var aPogodaItem: TWeatherItem);
var
i: Integer;
ja: TJsonArray;
s: String;
ss: TStringStream;
begin
if ajo.FindPath('dt') <> nil then
aPogodaItem.Date := UnixToDateTime(ajo.GetPath('dt').AsInt64, False);
if (ajo.FindPath('weather') <> nil) and (ajo.GetPath('weather').Count > 0) then
begin
ja := TJsonArray(ajo.GetPath('weather'));
for i := 0 to ja.Count - 1 do
begin
if ja.Items[i].FindPath('description') <> nil then
aPogodaItem.Description := ja.Items[i].GetPath('description').AsString;
if ja.Items[i].FindPath('icon') <> nil then
begin
//if icon not exists
if not FileExists(GetAppConfigDir(False) + ja.Items[i].FindPath('icon').AsString + '.png') then
begin
//get icon
s := TFPHttpClient.SimpleGet('http://openweathermap.org/img/wn/' + ja.Items[i].FindPath('icon').AsString + '@2x.png');
ss := TStringStream.Create(s);
//an save to disk
ss.SaveToFile(GetAppConfigDir(False) + ja.Items[i].FindPath('icon').AsString + '.png');
ss.Free;
end;
//load icon
aPogodaItem.WeatherIcon.Clear;
aPogodaItem.WeatherIcon.LoadFromFile(GetAppConfigDir(False) + ja.Items[i].FindPath('icon').AsString + '.png');
aPogodaItem.WeatherIcon.Position := 0;
end;
end;
end;
if ajo.FindPath('main.temp') <> nil then
aPogodaItem.Temp := ajo.GetPath('main.temp').AsFloat;
if ajo.FindPath('main.feels_like') <> nil then
aPogodaItem.TempFeelsLike := ajo.GetPath('main.feels_like').AsFloat;
if ajo.FindPath('main.temp_min') <> nil then
aPogodaItem.TempMin := ajo.GetPath('main.temp_min').AsFloat;
if ajo.FindPath('main.temp_max') <> nil then
aPogodaItem.TempMax := ajo.GetPath('main.temp_max').AsFloat;
if ajo.FindPath('main.humidity') <> nil then
aPogodaItem.Humidity := ajo.GetPath('main.humidity').AsFloat;
if ajo.FindPath('main.pressure') <> nil then
aPogodaItem.Pressure := ajo.GetPath('main.pressure').AsFloat;
if ajo.FindPath('visibility') <> nil then
aPogodaItem.Visibility := ajo.GetPath('visibility').AsFloat;
if ajo.FindPath('wind.speed') <> nil then
aPogodaItem.WindSpeed := ajo.GetPath('wind.speed').AsFloat;
if ajo.FindPath('wind.deg') <> nil then
aPogodaItem.WindDegrees := ajo.GetPath('wind.deg').AsFloat;
if ajo.FindPath('wind.gust') <> nil then
aPogodaItem.WindGust := ajo.GetPath('wind.gust').AsFloat;
if ajo.FindPath('sys.sunrise') <> nil then
aPogodaItem.Sunrise := UnixToDateTime(ajo.GetPath('sys.sunrise').AsInt64, False);
if ajo.FindPath('sys.sunset') <> nil then
aPogodaItem.Sunset := UnixToDateTime(ajo.GetPath('sys.sunset').AsInt64, False);
end;
procedure TWeather.SetLang(AValue: TWeatherLang);
begin
if FLang <> AValue then
begin
ClearWeatherInfo;
FLang := AValue;
end;
end;
procedure TWeather.SetLangCode(AValue: String);
begin
if GetLangCode = AValue then
exit;
case AValue of
'af': FLang := wlAf;
'al': FLang := wlAl;
'ar': FLang := wlAr;
'az': FLang := wlAz;
'bg': FLang := wlBg;
'ca': FLang := wlCa;
'cz': FLang := wlCz;
'da': FLang := wlDa;
'de': FLang := wlDe;
'el': FLang := wlEl;
'en': FLang := wlEn;
'es': FLang := wlEs;
'eu': FLang := wlEu;
'fa': FLang := wlFa;
'fi': FLang := wlFi;
'fr': FLang := wlFr;
'gl': FLang := wlGl;
'he': FLang := wlHe;
'hi': FLang := wlHi;
'hr': FLang := wlHr;
'hu': FLang := wlHu;
'id': FLang := wlId;
'it': FLang := wlIt;
'ja': FLang := wlJa;
'kr': FLang := wlKr;
'la': FLang := wlLa;
'lt': FLang := wlLt;
'mk': FLang := wlMk;
'no': FLang := wlNo;
'nl': FLang := wlNl;
'pl': FLang := wlPl;
'pt': FLang := wlPt;
'pt_br': FLang := wlPt_br;
'ro': FLang := wlRo;
'ru': FLang := wlRu;
'sv': FLang := wlSv;
'sk': FLang := wlSk;
'sl': FLang := wlSl;
'sr': FLang := wlSr;
'th': FLang := wlTh;
'tr': FLang := wlTr;
'uk': FLang := wlUk;
'vi': FLang := wlVi;
'zh_cn': FLang := wlZh_cn;
'zh_tw': FLang := wlZh_tw;
'zu': FLang := wlZu;
else
FLang := wlEn;
end;
end;
procedure TWeather.SetUnits(AValue: TWeatherUnits);
begin
if FUnits <> AValue then
begin
ClearWeatherInfo;
FUnits := AValue;
end;
end;
procedure TWeather.SetCity(AValue: String);
begin
if FCity <> AValue then
begin
ClearWeatherInfo;
FCity := AValue;
end;
end;
function TWeather.Get(aCity: String; aCountryCode: String; aStateCode: String): Boolean;
var
json, cc, sc: String;
ja: TJsonArray;
lat, lon: Double;
hc: TFpHttpClient;
begin
Result := False;
FLastError := '';
if FAPIKey = '' then
begin
FLastError := 'Enter APIKey';
exit;
end;
if aCity = '' then
begin
FLastError := 'Enter city name';
exit;
end;
//country code
cc := '';
if aCountryCode <> '' then
cc := ',' + aCountryCode;
//state code
sc := '';
if (aStateCode <> '') or (SameText(aCountryCode, 'US') or SameText(aCountryCode, 'USA')) then
sc := aStateCode;
hc := TFPHttpClient.Create(nil);
try
json := hc.Get(Format('http://api.openweathermap.org/geo/1.0/direct?q=%s%s%s&limit=1&appid=%s', [HTTPEncode(aCity), cc, sc, HTTPEncode(FAPIKey)]));
except
on E: Exception do
begin
if hc.ResponseStatusCode = 401 then
FLastError := 'Invalid APIKey'
else
FLastError := hc.ResponseStatusText;
hc.Free;
exit;
end;
end;
hc.Free;
ja := TJsonArray(GetJSON(json));
Result := ja.Count > 0;
if Result and (ja.Items[0].FindPath('lat') <> nil) and (ja.Items[0].FindPath('lon') <> nil) then
begin
lat := ja.Items[0].FindPath('lat').AsFloat;
lon := ja.Items[0].FindPath('lon').AsFloat;
end
else
FLastError := 'Invalid city name';
ja.Free;
if Result then
Result := Get(lat, lon);
end;
function TWeather.Get(aLat, aLon: Double): Boolean;
var
json: String;
jo, jod: TJsonObject;
ja: TJsonArray;
wi: TWeatherItem;
i: Integer;
hc: TFpHttpClient;
fs: TFormatSettings;
begin
Result := False;
FLastError := '';
if FAPIKey = '' then
begin
FLastError := 'Enter APIKey';
exit;
end;
if (aLat = 0) and (aLon = 0) then
begin
FLastError := 'Invalid coordinates';
exit;
end;
fs.DecimalSeparator := '.';
hc := TFPHttpClient.Create(nil);
try
json := hc.Get(Format('https://api.openweathermap.org/data/2.5/weather?lat=%.7f&lon=%.7f&appid=%s&units=%s&lang=%s',
[aLat, aLon, HTTPEncode(FAPIKey), GetUnitsCode, GetLangCode], fs));
except
on E: Exception do
begin
if hc.ResponseStatusCode = 401 then
FLastError := 'Invalid APIKey'
else
FLastError := hc.ResponseStatusText;
hc.Free;
exit;
end;
end;
hc.Free;
jo := TJsonObject(GetJSON(json));
Result := jo.FindPath('name') <> nil;
if Result then
begin
SetCity(jo.GetPath('name').AsString);
if jo.FindPath('coord.lat') <> nil then
FLatitude := jo.FindPath('coord.lat').AsFloat;
if jo.FindPath('coord.lon') <> nil then
FLongitude := jo.FindPath('coord.lon').AsFloat;
FCurrentWeather.Date := Now;
end;
Parse(jo, FCurrentWeather);
jo.Free;
if not Result then
exit;
if (FWeatherForecast.Count = 0) or (Trunc(FWeatherForecast.Keys[0]) < Date) then //if no weather forecast or the weather forecast starts from yesterday or earlier
begin
FWeatherForecast.Clear;
hc := TFPHttpClient.Create(nil);
try
json := hc.SimpleGet(Format('https://api.openweathermap.org/data/2.5/forecast?lat=%.7f&lon=%.7f&appid=%s&units=%s&lang=%s',
[aLat, aLon, HTTPEncode(FAPIKey), GetUnitsCode, GetLangCode], fs));
except
on E: Exception do
begin
if hc.ResponseStatusCode = 401 then
FLastError := 'Invalid APIKey'
else
FLastError := hc.ResponseStatusText;
hc.Free;
exit;
end;
end;
hc.Free;
jo := TJsonObject(GetJSON(json));
if jo.FindPath('list') <> nil then
begin
ja := TJsonArray(jo.GetPath('list'));
for i := 0 to ja.Count - 1 do
begin
wi := TWeatherItem.Create;
jod := TJsonObject(ja.Items[i]);
Parse(jod, wi);
FWeatherForecast.Add(wi.Date, wi);
end;
end;
jo.Free;
end;
end;
end.

View File

@ -0,0 +1,8 @@
# OpenWeather API
Get the current weather and the forecast from `OpenWeather` API.
You can get a free api key at: https://home.openweathermap.org/users/sign_up
To compile the example, you need the CalLite component - you can install using `OnlinePackageManager` or download from https://sourceforge.net/p/lazarus-ccr/svn/HEAD/tree/components/callite/ and install manually.
![sample screenshot](owa_sample.png)

View File

@ -0,0 +1,198 @@
object Form1: TForm1
Left = 331
Height = 313
Top = 121
Width = 853
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'Form1'
ClientHeight = 313
ClientWidth = 853
Color = clSilver
LCLVersion = '3.99.0.0'
OnCreate = FormCreate
OnDestroy = FormDestroy
object CalendarLite1: TCalendarLite
Left = 8
Height = 296
Top = 8
Width = 440
Constraints.MinHeight = 120
Constraints.MinWidth = 120
ParentShowHint = False
ShowHint = True
TabOrder = 0
TabStop = True
Colors.TodayFrameColor = clGray
Date = 45334
DisplayTexts = '"Today is %s","mmm dd"", ""yyyy","Holidays in %d","There are no holidays set for %d","dddd"", "" mmm dd"", ""yyyy","mmmm yyyy"'
StartingDayOfWeek = dowMonday
WeekendDays = [dowSunday, dowSaturday]
OnDateChange = CalendarLite1DateChange
OnDrawCell = CalendarLite1DrawCell
OnHint = CalendarLite1Hint
end
object ecity: TEdit
Left = 576
Height = 23
Top = 48
Width = 264
TabOrder = 3
end
object Label2: TLabel
Left = 453
Height = 15
Top = 24
Width = 116
Caption = 'OpenWeather APIKey:'
end
object eapikey: TEdit
Left = 576
Height = 23
Top = 17
Width = 264
EchoMode = emPassword
PasswordChar = '#'
TabOrder = 1
end
object Label3: TLabel
Left = 576
Height = 15
Top = 88
Width = 19
Caption = 'Lat:'
end
object Label4: TLabel
Left = 712
Height = 15
Top = 88
Width = 23
Caption = 'Lon:'
end
object fselat: TFloatSpinEdit
Left = 600
Height = 23
Top = 80
Width = 96
DecimalPlaces = 7
TabOrder = 5
end
object fselon: TFloatSpinEdit
Left = 744
Height = 23
Top = 80
Width = 96
DecimalPlaces = 7
TabOrder = 6
end
object rbcity: TRadioButton
Left = 453
Height = 19
Top = 52
Width = 39
Caption = 'City'
Checked = True
TabOrder = 2
TabStop = True
end
object rbcoord: TRadioButton
Left = 453
Height = 19
Top = 84
Width = 82
Caption = 'Coordinates'
TabOrder = 4
end
object bGet: TButton
Left = 576
Height = 25
Top = 112
Width = 264
Caption = 'Get weather'
TabOrder = 7
OnClick = bGetClick
end
object Label1: TLabel
Left = 453
Height = 15
Top = 122
Width = 29
Caption = 'Lang:'
end
object cblang: TComboBox
Left = 488
Height = 23
Top = 114
Width = 81
ItemHeight = 15
ItemIndex = 0
Items.Strings = (
'English'
'Español'
'Polski'
'Українська'
'简体中文'
)
Style = csDropDownList
TabOrder = 8
Text = 'English'
end
object Image1: TImage
Left = 456
Height = 100
Top = 160
Width = 100
Stretch = True
end
object Label5: TLabel
Left = 560
Height = 15
Top = 152
Width = 34
Caption = 'Label5'
end
object Label6: TLabel
Left = 560
Height = 15
Top = 176
Width = 34
Caption = 'Label6'
end
object Label7: TLabel
Left = 560
Height = 15
Top = 200
Width = 34
Caption = 'Label7'
end
object Label8: TLabel
Left = 560
Height = 15
Top = 224
Width = 34
Caption = 'Label8'
end
object Label9: TLabel
Left = 561
Height = 15
Top = 248
Width = 34
Caption = 'Label9'
end
object Label10: TLabel
Left = 456
Height = 15
Top = 272
Width = 40
Caption = 'Label10'
end
object Button1: TButton
Left = 712
Height = 25
Top = 280
Width = 128
Caption = 'Show forecast'
TabOrder = 9
OnClick = Button1Click
end
end

View File

@ -0,0 +1,228 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Spin, ExtCtrls, CalendarLite, Types, DateUtils, LPDWeatherU;
type
{ TForm1 }
TForm1 = class(TForm)
bGet: TButton;
Button1: TButton;
CalendarLite1: TCalendarLite;
cblang: TComboBox;
ecity: TEdit;
eapikey: TEdit;
fselat: TFloatSpinEdit;
fselon: TFloatSpinEdit;
Image1: TImage;
Label1: TLabel;
Label10: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
rbcoord: TRadioButton;
rbcity: TRadioButton;
procedure bGetClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure CalendarLite1DateChange(Sender: TObject);
procedure CalendarLite1DrawCell(Sender: TObject; ACanvas: TCanvas; AYear, AMonth, ADay: Word; AState: TCalCellStates; var ARect: TRect;
var AContinueDrawing: Boolean);
procedure CalendarLite1Hint(Sender: TObject; AYear, AMonth, ADay: Word; var AText: String);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure ClearInfo;
public
weather: TWeather;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
uses
Unit2;
procedure TForm1.bGetClick(Sender: TObject);
var
b: Boolean;
begin
weather.APIKey := eapikey.Text;
case cblang.ItemIndex of
0: weather.Lang := wlEn;
1: weather.Lang := wlEs;
2: weather.Lang := wlPl;
3: weather.Lang := wlUk;
4: weather.Lang := wlZh_cn;
end;
if rbcity.Checked then
b := weather.Get(eCity.Text)
else
b := weather.Get(fselat.Value, fselon.Value);
if not b then
ShowMessage(weather.LastError)
else
begin
eCity.Text := weather.City;
fselat.Value := weather.Latitude;
fselon.Value := weather.Longitude;
CalendarLite1DateChange(Sender);
CalendarLite1.Invalidate;
CalendarLite1.Date := Date;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Application.CreateForm(TForm2, Form2);
Form2.Width := 750;
Form2.Height := 400;
Form2.Caption := 'Forecast';
Form2.Position := poOwnerFormCenter;
Form2.ShowModal;
FreeAndNil(Form2);
end;
procedure TForm1.CalendarLite1DateChange(Sender: TObject);
var
idx: Integer;
begin
ClearInfo;
Label5.Caption := 'Date: ' + FormatDateTime('yyyy-mm-dd', CalendarLite1.Date);
idx := weather.WeatherForecast.IndexOfDate(IncHour(CalendarLite1.Date, HourOf(Now)));
if CalendarLite1.Date = Date then //if today then current weather
begin
if weather.CurrentWeather.WeatherIcon.Size > 0 then
begin
weather.CurrentWeather.WeatherIcon.Position := 0;
Image1.Picture.LoadFromStream(weather.CurrentWeather.WeatherIcon);
Label6.Caption := 'Temp: ' + FormatFloat('0.00', weather.CurrentWeather.Temp) + ' °C -> Feels like: ' +
FormatFloat('0.00', weather.CurrentWeather.TempFeelsLike) + ' °C';
Label7.Caption := 'Pressure: ' + FormatFloat('0', weather.CurrentWeather.Pressure) + ' hPa';
Label8.Caption := 'Humidity: ' + FormatFloat('0.0', weather.CurrentWeather.Humidity) + ' %';
Label9.Caption := 'Wind: ' + weather.CurrentWeather.WindDirection + ' speed: ' +
FormatFloat('0.00', weather.CurrentWeather.WindSpeed) + ' m/s';
Label10.Caption := weather.CurrentWeather.Description;
end;
end
else if idx >= 0 then //else if it is not today and there is a forecast for that day
begin
if weather.WeatherForecast.Data[idx].WeatherIcon.Size > 0 then
begin
weather.WeatherForecast.Data[idx].WeatherIcon.Position := 0;
Image1.Picture.LoadFromStream(weather.WeatherForecast.Data[idx].WeatherIcon);
Label6.Caption := 'Temp: ' + FormatFloat('0.00', weather.WeatherForecast.Data[idx].Temp) + ' °C -> Feels like: ' +
FormatFloat('0.00', weather.WeatherForecast.Data[idx].TempFeelsLike) + ' °C';
Label7.Caption := 'Pressure: ' + FormatFloat('0', weather.WeatherForecast.Data[idx].Pressure) + ' hPa';
Label8.Caption := 'Humidity: ' + FormatFloat('0.0', weather.WeatherForecast.Data[idx].Humidity) + ' %';
Label9.Caption := 'Wind: ' + weather.WeatherForecast.Data[idx].WindDirection + ' speed: ' +
FormatFloat('0.00', weather.WeatherForecast.Data[idx].WindSpeed) + ' m/s';
Label10.Caption := weather.WeatherForecast.Data[idx].Description;
end;
end;
end;
procedure TForm1.CalendarLite1DrawCell(Sender: TObject; ACanvas: TCanvas; AYear, AMonth, ADay: Word; AState: TCalCellStates; var ARect: TRect;
var AContinueDrawing: Boolean);
var
idx: Integer;
png: Graphics.TPortableNetworkGraphic;
r: TRect;
begin
if csSelectedDay in AState then
ACanvas.Brush.Color := CalendarLite1.Colors.SelectedDateColor
else
ACanvas.Brush.Color := CalendarLite1.Colors.BackgroundColor;
ACanvas.FillRect(ARect);
ACanvas.Brush.Style := bsClear;
idx := weather.WeatherForecast.IndexOfDate(EncodeDateTime(AYear, AMonth, ADay, HourOf(Now), 0, 0, 0));
if EncodeDate(AYear, AMonth, ADay) = Date then //if today then current weather
begin
if weather.CurrentWeather.WeatherIcon.Size > 0 then
begin
png := Graphics.TPortableNetworkGraphic.Create;
weather.CurrentWeather.WeatherIcon.Position := 0;
png.LoadFromStream(weather.CurrentWeather.WeatherIcon);
r.Left := ARect.Left + 2;
r.Top := ARect.Top;
r.Width := 25;
r.Height := 25;
ACanvas.StretchDraw(r, png);
png.Free;
end;
end
else if idx >= 0 then //else if it is not today and there is a forecast for that day
begin
if weather.WeatherForecast.Data[idx].WeatherIcon.Size > 0 then
begin
png := Graphics.TPortableNetworkGraphic.Create;
weather.WeatherForecast.Data[idx].WeatherIcon.Position := 0;
png.LoadFromStream(weather.WeatherForecast.Data[idx].WeatherIcon);
r.Left := ARect.Left + 2;
r.Top := ARect.Top;
r.Width := 24;
r.Height := 24;
ACanvas.StretchDraw(r, png);
png.Free;
end;
end;
end;
procedure TForm1.CalendarLite1Hint(Sender: TObject; AYear, AMonth, ADay: Word; var AText: String);
var
idx: Integer;
begin
idx := weather.WeatherForecast.IndexOfDate(EncodeDateTime(AYear, AMonth, ADay, HourOf(Now), 0, 0, 0));
if idx >= 0 then
begin
AText := Format('Weather description: %s' + #13#10 +
'Pressure: %3.0f hPa' + #13#10 +
'Humidity: %3.1f%%' + #13#10 +
'Temp: %3.2f °C',
[weather.WeatherForecast.Data[idx].Description, weather.WeatherForecast.Data[idx].Pressure,
weather.WeatherForecast.Data[idx].Humidity, weather.WeatherForecast.Data[idx].Temp]);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Caption := 'OpenWeather API sample';
Application.HintPause := 100;
ClearInfo;
weather := TWeather.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
weather.Free;
end;
procedure TForm1.ClearInfo;
begin
Image1.Picture.Clear;
Label5.Caption := '';
Label6.Caption := '';
Label7.Caption := '';
Label8.Caption := '';
Label9.Caption := '';
Label10.Caption := '';
end;
end.

View File

@ -0,0 +1,56 @@
object Form2: TForm2
Left = 331
Height = 240
Top = 121
Width = 320
Caption = 'Form2'
ClientHeight = 240
ClientWidth = 320
LCLVersion = '3.99.0.0'
OnCreate = FormCreate
object Panel1: TPanel
Left = 0
Height = 40
Top = 200
Width = 320
Align = alBottom
BevelOuter = bvNone
ClientHeight = 40
ClientWidth = 320
TabOrder = 0
object bClose: TButton
Left = 240
Height = 25
Top = 8
Width = 75
Anchors = [akTop, akRight]
Caption = 'Close'
ModalResult = 11
TabOrder = 0
end
end
object ScrollBox1: TScrollBox
Left = 0
Height = 200
Top = 0
Width = 320
HorzScrollBar.Page = 1
VertScrollBar.Page = 1
Align = alClient
ClientHeight = 196
ClientWidth = 316
TabOrder = 1
object FlowPanel1: TFlowPanel
Left = 0
Height = 196
Top = 0
Width = 316
Align = alClient
BevelOuter = bvNone
ControlList = <>
FlowLayout = tlTop
FlowStyle = fsLeftRightTopBottom
TabOrder = 0
end
end
end

View File

@ -0,0 +1,122 @@
unit Unit2;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, LPDWeatherU;
type
{ TForm2 }
TForm2 = class(TForm)
bClose: TButton;
FlowPanel1: TFlowPanel;
Panel1: TPanel;
ScrollBox1: TScrollBox;
procedure FormCreate(Sender: TObject);
private
public
procedure GenForecastInfo;
end;
var
Form2: TForm2;
implementation
{$R *.lfm}
{ TForm2 }
uses
Unit1;
var
wparr: Array of TPanel;
procedure TForm2.FormCreate(Sender: TObject);
begin
GenForecastInfo;
end;
procedure TForm2.GenForecastInfo;
var
i: Integer;
function AddInfoPanel(weatheritem: TWeatherItem): TPanel;
var
img: TImage;
l1, l2, l3, l4, l5, l6, l7: TLabel;
begin
Result := TPanel.Create(FlowPanel1);
Result.Parent := FlowPanel1;
Result.Width := 350;
Result.Height := 150;
Result.Color := clWhite;
Result.BevelInner := bvNone;
Result.BevelOuter := bvNone;
Result.BorderStyle := bsSingle;
Result.BorderSpacing.Around := 4;
img := TImage.Create(Result);
img.Parent := Result;
img.Width := 100;
img.Height := 100;
img.Top := 25;
img.Left := 10;
try
weatheritem.WeatherIcon.Position := 0;
img.Picture.LoadFromStream(weatheritem.WeatherIcon);
except
img.Picture.Clear;
end;
l1 := TLabel.Create(Result);
l1.Parent := Result;
l1.Top := 20;
l1.Left := 120;
l1.Caption := 'City: ' + Form1.weather.City;
l2 := TLabel.Create(Result);
l2.Parent := Result;
l2.Top := 35;
l2.Left := 120;
l2.Caption := 'Forecast time: ' + FormatDateTime('yyyy-mm-dd hh:nn', weatheritem.Date);
l3 := TLabel.Create(Result);
l3.Parent := Result;
l3.Top := 50;
l3.Left := 120;
l3.Caption := 'Temp: ' + FormatFloat('0.00', weatheritem.Temp) + ' °C';
l4 := TLabel.Create(Result);
l4.Parent := Result;
l4.Top := 65;
l4.Left := 120;
l4.Caption := 'Pressure: ' + FormatFloat('0', weatheritem.Pressure) + ' hPa';
l5 := TLabel.Create(Result);
l5.Parent := Result;
l5.Top := 80;
l5.Left := 120;
l5.Caption := 'Humidity: ' + FormatFloat('0.00', weatheritem.Humidity) + ' %';
l6 := TLabel.Create(Result);
l6.Parent := Result;
l6.Top := 95;
l6.Left := 120;
l6.Caption := 'Wind: ' + weatheritem.WindDirection + '; ' + FormatFloat('0.00', weatheritem.WindSpeed * 3.6) + ' km/h';
l7 := TLabel.Create(Result);
l7.Parent := Result;
l7.Top := 110;
l7.Left := 120;
l7.Font.Style := [fsBold];
l7.Font.Color := clNavy;
l7.Caption := weatheritem.Description;
end;
begin
SetLength(wparr, Form1.weather.WeatherForecast.Count);
for i := 0 to Form1.weather.WeatherForecast.Count - 1 do
wparr[i] := AddInfoPanel(Form1.weather.WeatherForecast.Data[i]);
end;
end.

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

View File

@ -0,0 +1,153 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="owapi_sample"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
<Item Name="Test">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="owapi_sample"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
<UseLineInfoUnit Value="False"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<Verbosity>
<ShowDebugInfo Value="True"/>
<ShowHintsForSenderNotUsed Value="True"/>
</Verbosity>
<WriteFPCLogo Value="False"/>
<CompilerMessages>
<IgnoredMessages idx6058="True" idx3124="True" idx3123="True"/>
</CompilerMessages>
<CustomOptions Value="-dTEST_MODE"/>
<OtherDefines Count="1">
<Define0 Value="TEST_MODE"/>
</OtherDefines>
</Other>
</CompilerOptions>
</Item>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="callight_pkg"/>
</Item>
<Item>
<PackageName Value="LCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="owapi_sample.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="Unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit>
<Unit>
<Filename Value="Unit2.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form2"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="owapi_sample"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value=".."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
<RunWithoutDebug Value="True"/>
<UseLineInfoUnit Value="False"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<Verbosity>
<ShowHintsForSenderNotUsed Value="True"/>
</Verbosity>
<WriteFPCLogo Value="False"/>
<CompilerMessages>
<IgnoredMessages idx6058="True" idx3124="True" idx3123="True"/>
</CompilerMessages>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,25 @@
program Project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
{$IFDEF HASAMIGA}
athreads,
{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, unit1, unit2
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Scaled := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

Binary file not shown.

Binary file not shown.

After

Width:  |  Height:  |  Size: 40 KiB