Delphi Fmx 获取天气预报

/***   www.delphifmx.com  
本程序是跨平台的,谨此感谢武稀松的 HtmlParser 单元。在移动端未能获得通过的问题,我在联系武稀松大哥,以求获得解决方案。届时重新编辑、发布.

同时感谢 广州-佬 的教导与指引
***/
unit Unit1;
interface
uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,  IdGlobalProtocols,
  System.Net.URLClient, System.Net.HttpClient, HtmlParser, System.Net.HttpClientComponent,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects;
type
  TForm1 = class(TForm)
    LwAddr: TLabel;
    RWeather: TRectangle;
    Label1: TLabel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.fmx}
//  www.delphifmx.com 
procedure TForm1.Button1Click(Sender: TObject);
  function FindNode(AHtml: IHtmlElement; WideStr: WideString): IHtmlElement;
  var
    Idx: Cardinal;
  begin
    Result:= nil;
    for Idx := 0 to AHtml.ChildrenCount-1 do
    if SameText(AHtml.Children[Idx].TagName, WideStr) then begin
      Exit(AHtml.Children[Idx]);
    end;
  end;
var
  AStr, Addr, AWea, ALunar, APic: String;
  ABool: Boolean;
  AStm: TStream;
  AResponse: IHTTPResponse;
  FNetCnt: TNetHTTPClient;
  Html: IHtmlElement;
  Idx: Cardinal;
  //获取时间
  ATime: TDateTime;
  STime: String;
  AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word;
  LYear, LMonth, LDay: Integer;
  LeapMonth: Boolean;
  PWChar: PWideChar;
begin
  AStm:= TMemoryStream.Create;
  FNetCnt:= TNetHTTPClient.Create(nil);
  FNetCnt.Asynchronous:= False;//设置为 同步
  FNetCnt.Accept:= '*/*';
  FNetCnt.AcceptEncoding:= 'gzip, deflate';
  FNetCnt.AcceptLanguage:= 'zh-CN,zh;q=0.9';
  FNetCnt.AcceptCharSet := 'utf-8';
  FNetCnt.ContentType:= 'application/x-www-form-urlencoded';
  FNetCnt.UserAgent:= 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/74.0.3729.169 Safari/537.36';
  FNetCnt.ConnectionTimeout:= 40000;
  try
    AResponse:= FNetCnt.Post('https://tianqiapi.com/api.php?style=tf&skin=pitaya', AStm);
    AStr:= AResponse.ContentAsString(TEncoding.GetEncoding(CP_UTF8));
    AStr:= Trim(AStr);
    if AStr <> '' then begin
      Addr:= '';
      AStm.Size:= 0;
      Html := ParserHTML(AStr);
      if Html<>nil then Html:= FindNode(Html, 'Html');
      if Html<>nil then Html:= FindNode(Html, 'Head');
      if Html<>nil then Html:= FindNode(Html, 'Body');
      if Html<>nil then begin
        //获取地区
        Addr:= FindNode(Html, 'Em').InnerHtml;
        //Addr:= StringReplace(Addr, '今天', '', [rfReplaceAll, rfIgnoreCase]);
        //获取图标
        FNetCnt.Get(FindNode(Html, 'Img').Attributes['Src'], AStm);
      end;
         Self.LwAddr.Text:= Addr;
                                if AStm.Size > 0 then begin
                                  AStm.Position:=0;
                                  Self.RWeather.Fill.Bitmap.Bitmap.LoadFromStream(AStm);
                                  Self.Updated;
                                end;
      AStm.Size:= 0;
    end;
  except
  end;
  FNetCnt.DisposeOf;
  FNetCnt:= nil;
end;
end.

添加新评论

纯文本

  • 不允许使用HTML标签。
  • 自动断行和分段。
  • 网页和电子邮件地址自动转换为链接。
请输入图片中的字符,不区分大小写