Weather, systray, popupmenu and preferences combined

Share your advanced PureBasic knowledge/code with the community.
Post Reply
infratec
Always Here
Always Here
Posts: 7582
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Weather, systray, popupmenu and preferences combined

Post by infratec »

Hi,

I answered a question about 'how to get weather data in PB' in the coding section.
When I already done the half work, why not write a complete program?
So here its is:

Code: Select all

;
; Yahoo weather;
;
; http://developer.yahoo.com/weather/
;
; You can find the WOEIDs at
; http://weather.yahoo.com/
;


Procedure.s GetWeatherData(WOEID$)

  Host$ = "weather.yahooapis.com"
  ;WOEID$ = "707991"
  Unit$ = "c"
  
  
  City$ = ""
  TemperatureUnit$ = ""
  PressureUnit$ = ""
  SpeedUnit$ = ""
  WindChill$ = ""
  WindDirection$ = ""
  WindSpeed$ = ""
  Humidity$ = ""
  Pressure$ = ""
  Temperature$ = ""
  Date$ = ""
  Lat$ = ""
  Long$ = ""
  
  ConnectionID = OpenNetworkConnection(Host$, 80)
  If ConnectionID
    
    Send$ = "GET /forecastrss?w=" + WOEID$
    Send$ + "&u=" + Unit$
    Send$ + " HTTP/1.0" + Chr(13) + Chr(10)
    Send$ + "User-Agent: Mozilla/2.0 (Win95; I)" + Chr(13) + Chr(10)
    Send$ + "Pragma: no-cache" + Chr(13) + Chr(10)
    Send$ + "Host: " + Host$ + Chr(13) + Chr(10)
    Send$ + "Accept: */*" + Chr(13) + Chr(10)
    Send$ + Chr(13) + Chr(10)
    
    SendNetworkString(ConnectionID, Send$)
      
    Answer = #False
    Timeout = 100
     
    While Not Answer And Timeout > 0
      Delay(10)
      If NetworkClientEvent(ConnectionID) = #PB_NetworkEvent_Data
           
        *Buffer = AllocateMemory(3000)
        If *Buffer 
          Length = ReceiveNetworkData(ConnectionID, *Buffer, 3000)
          If Length > 0
            Answer$ = PeekS(*Buffer, 3000, #PB_Ascii)
;Debug Answer$
            EndPos = 1
            Repeat
              StartPos = FindString(Answer$, "<yweather:", Endpos)
              If StartPos
                Startpos + 10
                EndPos = FindString(Answer$, "/>", Startpos)
                Line$ = Mid(Answer$, StartPos, EndPos - StartPos)
;Debug Line$
                If FindString(Line$, "location", 1)
                  City$ = Mid(Line$, 16, FindString(Line$, Chr(34), 16) - 16)
                ElseIf FindString(Line$, "units", 1)
                  LineEndPos = 5
                  LineStartPos = FindString(Line$, "temperature=", 5)
                  If LineStartPos
                    LineStartPos + 13
                    LineEndPos = FindString(Line$, Chr(34), LineStartPos)
                    TemperatureUnit$ = Mid(Line$, LineStartPos, LineEndPos - LineStartPos)
                  EndIf
                  LineStartPos = FindString(Line$, "pressure=", LineEndPos)
                  If LineStartPos
                    LineStartPos + 10
                    LineEndPos = FindString(Line$, Chr(34), LineStartPos)
                    PressureUnit$ = Mid(Line$, LineStartPos, LineEndPos - LineStartPos)
                  EndIf
                  LineStartPos = FindString(Line$, "speed=", LineEndPos)
                  If LineStartPos
                    LineStartPos + 7
                    LineEndPos = FindString(Line$, Chr(34), LineStartPos)
                    SpeedUnit$ = Mid(Line$, LineStartPos, LineEndPos - LineStartPos)
                  EndIf
                ElseIf FindString(Line$, "wind", 1)
                  LineEndPos = 4
                  LineStartPos = FindString(Line$, "chill=", 4)
                  If LineStartPos
                    LineStartPos + 7
                    LineEndPos = FindString(Line$, Chr(34), LineStartPos)
                    WindChill$ = Mid(Line$, LineStartPos, LineEndPos - LineStartPos)
                  EndIf
                  LineStartPos = FindString(Line$, "direction=", LineEndPos)
                  If LineStartPos
                    LineStartPos + 11
                    LineEndPos = FindString(Line$, Chr(34), LineStartPos)
                    WindDirection$ = Mid(Line$, LineStartPos, LineEndPos - LineStartPos)
                  EndIf
                  LineStartPos = FindString(Line$, "speed=", LineEndPos)
                  If LineStartPos
                    LineStartPos + 7
                    LineEndPos = FindString(Line$, Chr(34), LineStartPos)
                    WindSpeed$ = Mid(Line$, LineStartPos, LineEndPos - LineStartPos)
                  EndIf
                ElseIf FindString(Line$, "atmosphere", 1)
                  LineEndPos = 10
                  LineStartPos = FindString(Line$, "humidity=", 10)
                  If LineStartPos
                    LineStartPos + 10
                    LineEndPos = FindString(Line$, Chr(34), LineStartPos)
                    Humidity$ = Mid(Line$, LineStartPos, LineEndPos - LineStartPos)
                  EndIf
                  LineStartPos = FindString(Line$, "pressure=", LineEndPos)
                  If LineStartPos
                    LineStartPos + 10
                    LineEndPos = FindString(Line$, Chr(34), LineStartPos)
                    Pressure$ = Mid(Line$, LineStartPos, LineEndPos - LineStartPos)
                  EndIf
                ElseIf FindString(Line$, "condition", 1)
                  LineEndPos = 10
                  LineStartPos = FindString(Line$, "temp=", 10)
                  If LineStartPos
                    LineStartPos + 6
                    LineEndPos = FindString(Line$, Chr(34), LineStartPos)
                    Temperature$ = Mid(Line$, LineStartPos, LineEndPos - LineStartPos)
                  EndIf
                  LineStartPos = FindString(Line$, "date=", LineEndPos)
                  If LineStartPos
                    LineStartPos + 6
                    LineEndPos = FindString(Line$, Chr(34), LineStartPos)
                    Date$ = Mid(Line$, LineStartPos, LineEndPos - LineStartPos)
                  EndIf
                EndIf
              EndIf
            Until StartPos = 0
            
            EndPos = 1
            Repeat
              StartPos = FindString(Answer$, "<geo:", Endpos)
              If StartPos
                StartPos + 5
                EndPos = FindString(Answer$, "</", Startpos)
                Line$ = Mid(Answer$, StartPos, EndPos - StartPos)
                PointPos = FindString(Line$, ".", 1)
                If FindString(Line$, "lat", 1)
                  ;Lat$ = Mid(Line$, 5) + "°"
                  Lat$ = Mid(Line$, 5, PointPos - 5) + "°" + Str(Val(Mid(Line$, PointPos + 1)) * 0.6) + "'"
                ElseIf FindString(Line$, "long", 1)
                  ;Long$ = Mid(Line$, 6) + "°"
                  Long$ = Mid(Line$, 6, PointPos - 6) + "°" + Str(Val(Mid(Line$, PointPos + 1)) * 0.6) + "'"
                EndIf
                  
              EndIf
            Until StartPos = 0
            
          EndIf
          FreeMemory(*Buffer)
        EndIf 
        Answer = #True
      EndIf 
      Timeout - 1
    Wend  
  
    CloseNetworkConnection(ConnectionID)
  EndIf

  Text$ = City$ + #LF$;" at " + Date$ + #LF$
  Text$ + Temperature$ + "°" + TemperatureUnit$ + #LF$
  Text$ + Humidity$ + "%" + #LF$
  Text$ + Pressure$ + PressureUnit$ + #LF$
  Text$ + WindSpeed$ + SpeedUnit$
  
  SysTrayIconToolTip(0, Text$)
  
  Text$ = "Location" + Chr(9) + Chr(9) + ": " + City$  + " (" + Lat$ + " " + Long$ + ")" + #LF$
  Text$ + "Meassured at" + Chr(9) + ": " + Date$ + #LF$
  Text$ + "Temperature" + Chr(9) + ": " + Temperature$ + "°" + TemperatureUnit$ + #LF$
  Text$ + "Humidity" + Chr(9) + Chr(9) + ": " + Humidity$ + "%" + #LF$
  Text$ + "Pressure" + Chr(9) + Chr(9) + ": " + Pressure$ + PressureUnit$ + #LF$
  Text$ + "Windspeed" + Chr(9) + ": " + WindSpeed$ + SpeedUnit$ + #LF$
  Text$ + "Winddirection" + Chr(9) + ": " + WindDirection$ + "°"
  
  ProcedureReturn Text$
  
EndProcedure




InitNetwork()


OpenWindow(0, 0, 0, 1, 1, "", #PB_Window_Invisible)


NewMap WOEIDMap.s()

IniFile$ = Left(ProgramFilename(), Len(ProgramFilename()) - 3) + "ini"

If Not OpenPreferences(IniFile$)
  CreatePreferences(IniFile$)
  WritePreferenceString("Actual", "Worms")
  WritePreferenceString("Worms", "707991")
EndIf

If ExaminePreferenceKeys()
  While NextPreferenceKey()
    If PreferenceKeyName() <> "Actual"
      AddMapElement(WOEIDMap(), PreferenceKeyName())
      WOEIDMap() = PreferenceKeyValue()
    Else
      Location$ = PreferenceKeyValue()
    EndIf
  Wend
EndIf

ClosePreferences()

If FindMapElement(WOEIDMap(), Location$)
  WOEID$ = WOEIDMap()
Else 
  WOEID$ = "707991"
EndIf


If CreatePopupMenu(0)
  OpenSubMenu("Location")
  MaxMenuItems = 1
  ForEach WOEIDMap()
    MaxMenuItems + 1
    MenuItem(MaxMenuItems, MapKey(WOEIDMap()))
    If WOEIDMap() = WOEID$
      LastMenuItem = MaxMenuItems
      SetMenuItemState(0, LastMenuItem, 1)
    EndIf
  Next
  CloseSubMenu()
  MenuBar()
  MenuItem(1, "Exit")
EndIf


CreateImage(0, 20, 20)
StartDrawing(ImageOutput(0))
Box(0,0,20,20, $F07030)
DrawText(3, 3, "W", $FFFFFF, $F07030)
StopDrawing()

AddSysTrayIcon(0, WindowID(0), ImageID(0))

AddWindowTimer(0, 1, 60000)


Result$ = GetWeatherData(WOEID$)

Exit = #False
Repeat
  Event = WaitWindowEvent()
  
  Select Event
    Case #PB_Event_Timer 
      If EventTimer() = 1
        Result$ = GetWeatherData(WOEID$)
      EndIf
    Case #PB_Event_SysTray
      Select EventType()
        Case #PB_EventType_LeftClick
          MessageRequester("Weather informations", Result$)
        Case #PB_EventType_RightClick : DisplayPopupMenu(0, WindowID(0))
      EndSelect
    Case #PB_Event_Menu
      MenuItem = EventMenu()
      Select MenuItem
        Case 1 : Exit = #True
        Case 2 To MaxMenuItems
          If FindMapElement(WOEIDMap(), GetMenuItemText(0, MenuItem))
            WOEID$ = WOEIDMap()
            SetMenuItemState(0, LastMenuItem, 0)
            SetMenuItemState(0, MenuItem, 1)
            LastMenuItem = MenuItem
            OpenPreferences(IniFile$)
            WritePreferenceString("Actual", MapKey(WOEIDMap()))
            ClosePreferences()
            Result$ = GetWeatherData(WOEID$)
          EndIf
       EndSelect
    Case #PB_Event_CloseWindow
      Exit = #True
  EndSelect
  
Until Exit
It generates its own ini file at the first program start.
Inside this ini file you can place your own locations.
By default it is the place were I live :mrgreen:

look at http://weather.yahoo.com/ to find out your location(s).

My ini file looks like this at the moment:

Code: Select all

Actual = Worms
Worms = 707991
Mannheim = 673711
Heidelberg = 658421
Bensheim = 637767
You can use left click on the icon for more informations,
right click for a popupmenu where you can choose a location or exit the program.

Have fun

Bernd
Top
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Re: Weather, systray, popupmenu and preferences combined

Post by rsts »

Nice! :D

Many thanks for sharing with us.

cheers
Top
metalos
User
User
Posts: 29
Joined: Thu Apr 19, 2012 8:32 am

Re: Weather, systray, popupmenu and preferences combined

Post by metalos »

Great code, but how to get the url of the icon the same weather temp data ?
Top
infratec
Always Here
Always Here
Posts: 7582
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Weather, systray, popupmenu and preferences combined

Post by infratec »

metalos wrote:how to get the url of the icon the same weather temp data ?
Which icon :?:

I didn't understand what you mean.

Bernd
Top
metalos
User
User
Posts: 29
Joined: Thu Apr 19, 2012 8:32 am

Re: Weather, systray, popupmenu and preferences combined

Post by metalos »

Sorry I meant the image that represents the current weather conditions. This image works with codes from 0 to 47. I would like to know how to get the url of the image at the same temp weather data. Thank you in advance for your help.

Here is the API documentation: http://developer.yahoo.com/weather/
Top
infratec
Always Here
Always Here
Posts: 7582
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Weather, systray, popupmenu and preferences combined

Post by infratec »

Hi metalos,

I don't think that they are free to use.
I'm also not sure if they are available from yahoo.

Go to:
http://weather.yahoo.com/

with firefox,
than show the page informations and you will see a picture where all icons are inside.

But there are also free icons available.
You have just to number them.

http://www.webresourcesdepot.com/free-w ... ollection/

Bernd
Top
User avatar
VB6_to_PBx
Enthusiast
Enthusiast
Posts: 627
Joined: Mon May 09, 2011 9:36 am

Re: Weather, systray, popupmenu and preferences combined

Post by VB6_to_PBx »

another Website with free Weather Icons

http://www.iconarchive.com/category/nature-icons.html
 
PureBasic .... making tiny electrons do what you want !

"With every mistake we must surely be learning" - George Harrison
Top
Post Reply

Return to “Tricks 'n' Tips”