MsgBox "There has been an unrecoverable error....Closing"
Exit Sub
End Sub
Private Sub IconEvent_MouseUp(Button As Integer, Id As Long)
If Button = 1 Then Me.Show 'left click on systray icon gives you the weather screen
End Sub
Private Sub mnuabout_Click()
MsgBox "Weather Program made by Larry Myers 443-543-3107"
End Sub
Private Sub mnuAlerts_Click()
End Sub
Private Sub mnuback_Click()
If SSTab1 = 0 Then WebBrowser1.Navigate (pth & "currentweather.htm")
If SSTab1 = 1 Then WebBrowser2.Navigate (pth & "fivedayforecast.htm")
If SSTab1 = 2 Then WebBrowser3.Navigate (pth & "localrdr.htm")
If SSTab1 = 3 Then WebBrowser4.Navigate ("http://pollen.com/forecast_fourday.asp?AffiliateID=2508&zip=" & zpcd & "&ft=1&pop=1")
If SSTab1 = 4 Then WebBrowser5.Navigate (pth & "almanac.htm")
End Sub
Private Sub mnuenglish_Click()
'this is where english settings are selected
mnuenglish.Checked = True
mnumetric.Checked = False
'create settings.ini
zp = "zip=" & zpcd
mt = "metric=0"
prxytmp = "proxy=" & prxy
Open pth & "settings.ini" For Output As #1
Print #1, zp
Print #1, mt
Print #1, prxytmp
Close #1
metric = 0 'set metric variable to match english
tb = SSTab1.Tab 'make decision as to what function to call based on the tab selected
If tb = 0 Then forecast
End Sub
Private Sub mnuhelp_Click()
'quick and dirty help
MsgBox "When main weather form is on screen the 4 tabs give different information, current conditions is updated every minute. When minimized a mini form will appear: Left click on it=show main form, Left and Shift will minimize to task bar, Ricght click kills it. The Systray icon also has some abilities."
End Sub
Private Sub mnumetric_Click()
'this is where english settings are selected
mnuenglish.Checked = False
mnumetric.Checked = True
'create settings.ini
zp = "zip=" & zpcd
mt = "metric=1"
prxytmp = "proxy=" & prxy
Open pth & "settings.ini" For Output As #1
Print #1, zp
Print #1, mt
Print #1, prxytmp
Close #1
metric = 1 'set metric variable to metric
tb = SSTab1.Tab 'make decision as to what function to call based on the tab selected
If tb = 0 Then forecast
End Sub
Private Sub mnuproxy_Click()
'this is where proxy settings are made from the menu
prxytmp = InputBox("Enter Proxy Settings - None for No Proxy, ? for Auto Setup, Type in the IP for Manual Proxy", "Proxy Settings", prxy, Me.Left, Me.Top)
If Len(prxytmp) < 1 Then prxy = "" Else prxy = prxytmp 'if proxy is set to ? set to auto, if blank set to direct connect, if it is something else set the proxy to manual with proxy as that setting
'write settings.ini file again
zp = "zip=" & zpcd
mt = "metric=" & metric
prxytmp = "proxy=" & prxy
Open pth & "settings.ini" For Output As #1
Print #1, zp
Print #1, mt
Print #1, prxytmp
Close #1
10 tb = SSTab1.Tab 'make decision as to what function to call based on the tab selected
IconEvent.TrayTip = frmcp & vbNullChar 'tooltip for tray icon
'these few lines set up the minimum weather page just temperature and current weather image
Form2.Label1 = temp 'when minimized this will become visible is just for temperature
wbtx = "<html><body background=" & Chr$(34) & mg & Chr$(34) & " scroll=no></body></html>" 'need another webpage for image
Open pth & "test2.htm" For Output As #1 'put it locally
Print #1, wbtx
Close #1
tp = Form2.Shape1.Height / 2
Form2.WebBrowser1.Top = tp - Form2.WebBrowser1.Height / 2 'needed to center webbrowser on form programatically
Form2.WebBrowser1.Navigate pth & "test2.htm" 'go to local site
Form2.Label1.ToolTipText = frmcp 'put current weather in tooltips for this form
Form2.WebBrowser1.ToolTipText = frmcp
' need webpage creation here!!
Open pth & "currentweather.htm" For Output As #1 'store webpage locally
Print #1, weather
Close #1
Open pth & "fivedayforecast.htm" For Output As #1 'store webpage locally
Print #1, detailfivedayweb
Close #1
SSTab1.Enabled = True 'ok, you can press another tab
mnuback_Click
website = "0"
cnt = 0 'good connect
Timer1.Enabled = True
Timer2.Enabled = True
Exit Sub
errhandler:
cnt = cnt + 1
Debug.Print cnt
If progress = 1 Then Exit Sub
If cnt > 2 Then MsgBox "Not Connecting: Try Setting Your Proxy Or may be a change on the website": Exit Sub 'try connecting twice if no then tell them what may help
'2 was picked for dialup, takes quite a few seconds at dialup, LAN speeds are way different
SSTab1.Enabled = True
forecast 'try again
End Sub
Private Sub Timer2_Timer()
timercount2 = timercount2 + 1
If timercount2 > 4 Then
'use this as an alerts checker
timercount2 = 0
check_alerts
End If
End Sub
Private Sub Timer3_Timer()
timercount3 = timercount3 + 1
If timercount3 > 1 Then
timercount3 = 0
alerterror = "yes"
End If
End Sub
Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, FLAGS As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
If website = "0" And URL <> pth & "currentweather.htm" Then Cancel = True 'this stops all links that stay in this window from working
'easier than trying to remove the links themselves all external window hops work
End Sub
Private Sub Form_Resize()
bHide = True
If bHide = True Then
If WindowState = 1 And bShown = True Then
Form2.Show 'bring out the mini screen
success = SetWindowPos(Form2.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS) 'set it to topmost
Me.Hide 'hide big form
bShown = False
Else
Form2.Hide 'hide mini screen
Me.WindowState = 0 'show main screen
bShown = True
End If
End If
End Sub
Private Sub IconEvent_MenuClick(index As Integer)
'menu clicks for the popup meny on systray is handled here
Select Case index
Case 0
Me.Show 'show main form
Me.WindowState = 0 ' needed for when the form is in the taskbar.
Case 1
Form2.Hide 'minimize mini form to tray
Case 2
Form2.Show 'restore mini form from tray
Case 3
Unload Me 'exit
End Select
End Sub
Private Sub IconEvent_MouseDblClick(Button As Integer, Id As Long)
'double click and I will show main form
If Button = 1 Then Me.Show
End Sub
Public Sub IconEvent_MouseDown(Button As Integer, Id As Long)
If Button = 2 Then
Dim pt As POINTAPI, X&
GetCursorPos pt
' the next three lines are the trick to getting the Popup to disappear properly
SetForegroundWindow (Me.hWnd)
TrackPopupMenu hPopup, TPM_CENTERALIGN Or TPM_RIGHTBUTTON, pt.X, pt.Y, 0&, Me.hWnd, 0&
PostMessage Me.hWnd, 0&, 0&, 0&
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
'kill everything that is necessary
Set IconEvent = Nothing
DestroyMenu hPopup
Unload Form2
Unload Me
End Sub
Private Function OpenURL(ByVal sUrl As String) As String
Open pth & "alerts.htm" For Output As #1 'put it locally
Print #1, "<html><body><h1>Alerts are erroring out!</h1><br>Maybe website has changed!<br><a target='_blank' href=" & alertsurl & ">" & alertsurl & "</a></body></html>"
Close #1
End If
If alertflag = "some" Then Form2.BackColor = vbRed Else Form2.BackColor = 32768
If alertflag = "some" Then Form2.Label1.BackColor = vbRed Else Form2.Label1.BackColor = 32768
Timer1.Enabled = True 'do not allow overlap of timers
Timer2.Enabled = True
SSTab1.Enabled = True 'do not allow another click on tab
End Sub
Private Sub WebBrowser7_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, FLAGS As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
If URL = "" Then Exit Sub
If URL = "http:///" Then Exit Sub
If InStr(1, URL, "error") > 0 Then Exit Sub
If InStr(1, URL, pth) < 1 And InStr(1, URL, "about:blank") < 1 Then
founddetails = ""
WebBrowser9.Navigate (URL)
URL = ""
WebBrowser7.Navigate (pth & "alerts.htm")
End If
End Sub
Private Sub WebBrowser8_DocumentComplete(ByVal pDisp As Object, URL As Variant)
If InStr(1, URL, pth) > 0 Then Exit Sub
If (pDisp Is WebBrowser8.object) Then
If Mid$(URL, 8, 18) = "www.myforecast.com" Then alertdone = "done"
