?? 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, RzTray,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;
RzTrayIcon1: TRzTrayIcon;
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);
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
CanQuit:=False;
Close;
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
RzTrayIcon1.IconIndex:=-1;//任務欄圖標釋放
RzTrayICon1.FreeOnRelease;
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;
if IconVis then RZTrayIcon1.Enabled:=True
else RZTrayIcon1.Enabled:=False;
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;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -