unit_weather.pas

网上天气预报,可以实时查看不地的天气情况,界面美观大方,欢迎下载

unit Unit_Weather;
{*
================================================================================
* 软件名称：天气预报读取器
* 单元名称：读取天气信息主窗体
* 单元作者：袁刚
* 备    注：天气信息来自中央气象台网站
* 开发平台：PWin2000 SP2 + Delphi 7.0
* 兼容测试：PWin2000 + Delphi 7.0
* 单元标识：$Id: Unit_Weather.pas,v 1.0 2007/5/10 $
* 修改记录： V1.0
*               创建单元
================================================================================
}
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls,GiFImage, ImgList, StdCtrls, Buttons, OleCtrls, SHDocVw,
  Menus, IniFiles,ComCtrls,ShellApi,ActiveX,ComObj,Unit_thread,Unit_Const;

type
  TFrm_Weather=class(TForm)
    ParamSet_Btn: TSpeedButton;
    About_Btn: TSpeedButton;
    Min_Btn: TSpeedButton;
    WebBrowser1: TWebBrowser;
    Shape1: TShape;
    Shape2: TShape;
    Label1: TLabel;
    PopupMenu1: TPopupMenu;
    ImageList1: TImageList;
    Quit_Menu: TMenuItem;
    ProgressBar1: TProgressBar;
    Memo1: TMemo;
    Timer2: TTimer;
    Label2: TLabel;
    Shape3: TShape;
    Mobile_Btn: TSpeedButton;
    Rain_Btn: TSpeedButton;
    HintLab: TLabel;
    Move_Btn: TSpeedButton;
    Call_Btn: TSpeedButton;
    Label3: TLabel;
    Show_Menu: TMenuItem;
    procedure FormShow(Sender: TObject);
    procedure Min_BtnClick(Sender: TObject);
    procedure Quit_MenuClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ParamSet_BtnClick(Sender: TObject);
    procedure About_BtnClick(Sender: TObject);
    procedure Rain_BtnClick(Sender: TObject);
    procedure Mobile_BtnClick(Sender: TObject);
    procedure Move_BtnMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Call_BtnClick(Sender: TObject);
    procedure Show_MenuClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    CanQuit,IsShow: Boolean;
    HotkeyID:Integer;
    AWeatherThread:TWeatherThread;
    procedure WMHotkeyHandle(var msg:TMessage);Message WM_HOTKEY; //响应热键消息
    procedure WMWeatherMsg(var msg:TMessage);Message WM_WeatherMsg;
  public
    { Public declarations }
    procedure ReadSysParam;
  end;
Const
  CnWeekArray : Array[1..7] of String[8]=('星期日', '星期一', '星期二',
      '星期三', '星期四', '星期五', '星期六');
var
  Frm_Weather: TFrm_Weather;

implementation

uses Unit_About, Unit_System,WinInet,Winsock;

{$R *.dfm}
function CheckInternetOnline: boolean;  //检查互联网是否在线
var
     ConnectState:DWORD;
     StateSize:DWORD;
begin
     ConnectState:=0;
     StateSize:=SizeOf(ConnectState);
     Result:=False;
     try
     if InternetQueryOption(nil,INTERNET_OPTION_CONNECTED_STATE,@ConnectState,StateSize) then
        Result:=(ConnectState and INTERNET_STATE_DISCONNECTED)<>2;
     if Result then
        Result:=InternetCheckConnection('http://www.microsoft.com/isapi/redir.dll?prd=ie&pver=6&ar=msnhome', 1, 0);
     except
        Result:=False;
     end;
end;

procedure TFrm_Weather.FormShow(Sender: TObject);
begin
     if not IsShow then  //判断第一次有动画效果
        AnimateWindow(Handle,1000,AW_VER_NEGATIVE or AW_ACTIVATE); //窗体动画效果
     IsShow:=true;
end;

procedure TFrm_Weather.Min_BtnClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TFrm_Weather.Quit_MenuClick(Sender: TObject);
begin
     if Application.MessageBox('退出后天气信息提醒将停止，是否确定要退出?',
          '提示',MB_OKCancel+MB_ICONQuestion)=MrOK then
     begin
          CanQuit:=True;
          Close;
     end;
end;

procedure TFrm_Weather.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
     if CanQuit then
     begin
        UnRegisterHotkey(Handle,HotkeyID);
        DeleteAtom(HotkeyID);   //热键删除
        Action:=caFree;
     end else begin
        Action:=CaNone;
        Self.Hide;
     end;
end;

procedure TFrm_Weather.ParamSet_BtnClick(Sender: TObject); //参数设置窗体
begin
     Frm_System:=TFrm_System.Create(Self);
     Frm_System.Left:=Frm_Weather.Left+(Frm_Weather.Width-Frm_System.Width) div 2; //确定位置
     Frm_System.Top:=Frm_Weather.Top+(Frm_Weather.Height-Frm_System.Height) div 2;
     Frm_System.ShowModal;
     Frm_System.Free;
end;

procedure TFrm_Weather.About_BtnClick(Sender: TObject); //关于窗体
begin
     Frm_About:=TFrm_About.Create(Self);
     Frm_About.Left:=Frm_Weather.Left+(Frm_Weather.Width-Frm_About.Width) div 2;
     Frm_About.Top:=Frm_Weather.Top+(Frm_Weather.Height-Frm_About.Height) div 2;
     Frm_About.ShowModal;
     Frm_About.Free;
end;

procedure TFrm_Weather.Rain_BtnClick(Sender: TObject);
begin
     Shellexecute(handle,nil,pchar(RainUrl),nil,nil,sw_shownormal);//火车时刻表
end;

procedure TFrm_Weather.Mobile_BtnClick(Sender: TObject);
begin
     Shellexecute(handle,nil,pchar(MobileUrl),nil,nil,sw_shownormal); //手机归属地
end;

procedure TFrm_Weather.Move_BtnMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
const
     SC_DRAGMOVE:Longint=$F012; //无标题栏拖动窗口
begin
     ReleaseCapture;
     SendMessage(Handle,WM_SYSCOMMAND,SC_DRAGMOVE,0);
end;

procedure TFrm_Weather.Call_BtnClick(Sender: TObject);
begin
     try
        AWeatherThread:=TWeatherThread.Create; //读取数据并显示信息
     except
        HintLab.Caption:='读取天气信息失败';
     end;
end;

procedure TFrm_Weather.Show_MenuClick(Sender: TObject);
begin
     Self.Show;
end;

procedure TFrm_Weather.FormCreate(Sender: TObject);
begin
     Frm_Weather.Left:=Screen.Width-Frm_Weather.Width-5;
     Frm_Weather.Top:=Screen.Height-Frm_Weather.Height-30;
     Label1.Caption:='今天： '+DateToStr(Now)+'   '+CnWeekArray[DayOfWeek(now)];
     
     CanQuit:=False;
     AppPath:=ExtractFilePath(ParamStr(0));
     SetWindowPos(Application.Handle,HWND_TOPMOST,0,0,0,0,0);

     ReadSysParam; //读取参数

     Memo1.Lines.LoadFromFile(AppPath+'temp\temp.txt');

     if not CheckInternetOnline then
        HintLab.Caption:='网络连接异常'
     else begin
        HintLab.Caption:='网络连接正常';
        try
          AWeatherThread:=TWeatherThread.Create; //启动时读取数据并显示
        except
          HintLab.Caption:='读取天气信息失败';
        end;
     end;

     Timer2.Enabled:=True;
end;

procedure TFrm_Weather.ReadSysParam;
var
     WeatherIni : TIniFile;
begin
     try
        WeatherIni:=TIniFile.Create(AppPath+'Weather.ini');
        CityName:=WeatherIni.ReadString('city','cityname','石家庄');
        WeatherURL:=WeatherIni.ReadString('URL','weatherURL','http://www.cma.gov.cn/cma_new/tqyb/search_city.php?city=');
        RainUrl:=WeatherIni.ReadString('URL','rainURL','');
        MobileUrl:=WeatherIni.ReadString('URL','MobileURL','');
        IPUrl:=WeatherIni.ReadString('URL','ipURL','');
        ImgUrl:=WeatherIni.ReadString('URL','ImageURL','');
        Hotkey:=WeatherIni.ReadString('Hotkey','key','G');
        IconVis:=WeatherIni.ReadBool('system','iconvisable',False);
        WeatherIni.Free;


        HotkeyID:=GlobalAddAtom(PChar('UserDefineHotKey'))-$C000; //保证取值范围
        RegisterHotkey(Handle,HotkeyID,MOD_ALT,Ord(Hotkey[1]));//热键alt+

        Min_Btn.Hint:='            最小化'+#13#10+'按Alt+'+UpCase(Hotkey[1])+'热键重新显示';
     except
        HintLab.Caption:='读取系统参数失败';
     end;

end;

procedure TFrm_Weather.Timer2Timer(Sender: TObject);
var
     TimeIni : TIniFile;
     I : Byte;
     RsumeTime : String;
     NowTime   : String;
begin
    Label1.Caption:='今天： '+DateToStr(Now)+'   '+CnWeekArray[DayOfWeek(Now)];//更新时间
    //这里判断时间提醒
    NowTime:=FormatDateTime('HH:mm:00',now);
    try
        TimeIni:=TIniFile.Create(AppPath+'Weather.ini');
        for I:=1 to 12 do
        begin
             if TimeIni.ReadBool('time','on'+IntToStr(I),False) then
             begin
                  RsumeTime:=TimeIni.ReadString('time','time'+IntToStr(I),'00:00');
                  if StrToTime(RsumeTime)=StrToTime(NowTime) then
                  begin
                    try
                      AWeatherThread:=TWeatherThread.Create;//时间到显示提醒
                      Self.Show;
                    except
                      HintLab.Caption:='读取天气信息失败';
                    end;
                  end;
             end;
        end;
        TimeIni.Free;
    except
    end;
end;

procedure TFrm_Weather.WMHotkeyHandle(var msg: TMessage);
begin
     if (msg.LParamHi=Ord(Hotkey[1])) and (msg.LParamLo=MOD_ALT) then
     begin
          Msg.Result:=1;  //该消息被处理
          Frm_Weather.Show;//显示
     end;
end;

procedure TFrm_Weather.WMWeatherMsg(var msg: TMessage);
begin
     if msg.LParam=0 then
       Label3.Caption:='本地外网IP：获取失败'
     else if msg.LParam=1 then
     begin
       Label3.Caption:='本地外网IP：'+IP;
     end else if msg.LParam=2 then
       ProgressBar1.Position:=100
     else if msg.LParam=3 then
       Application.MessageBox('城市名称未能得到,必须在参数设置里输入一个城市名称!',
                           '警告',MB_OK+MB_ICONWARNING)
     else if msg.LParam=4 then ;

end;

procedure TFrm_Weather.Shape1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
const
     SC_DRAGMOVE:Longint=$F012; //无标题栏拖动窗口
begin
     ReleaseCapture;
     SendMessage(Handle,WM_SYSCOMMAND,SC_DRAGMOVE,0);
end;

end.