PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Weather, systray, popupmenu and preferences combined

https://www.purebasic.fr/english/viewtopic.php?t=43504

Page 1 of 1

Weather, systray, popupmenu and preferences combined

Posted: Sun Sep 05, 2010 6:08 pm
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

Re: Weather, systray, popupmenu and preferences combined

Posted: Sun Sep 05, 2010 10:17 pm
by rsts
Nice! :D

Many thanks for sharing with us.

cheers

Re: Weather, systray, popupmenu and preferences combined

Posted: Sun Sep 02, 2012 8:16 pm
by metalos
Great code, but how to get the url of the icon the same weather temp data ?

Re: Weather, systray, popupmenu and preferences combined

Posted: Mon Sep 03, 2012 1:04 pm
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

Re: Weather, systray, popupmenu and preferences combined

Posted: Mon Sep 03, 2012 1:42 pm
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/

Re: Weather, systray, popupmenu and preferences combined

Posted: Mon Sep 03, 2012 2:48 pm
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

Re: Weather, systray, popupmenu and preferences combined

Posted: Mon Sep 03, 2012 7:14 pm
by VB6_to_PBx
another Website with free Weather Icons

http://www.iconarchive.com/category/nature-icons.html
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited