VB.NET GDI+ 天气预报

来源：互联网发布：怎么用软件开网店编辑：程序博客网时间：2024/05/19 02:42

最近闲来无事，想起天气预报那个工具很不好用，所以想自己做一个。

于是顺便体验下WPF的魅力，就用WPF开始动工了。进度很快，技术上不是很难摸，

一天吧就完成了决大部分主要功能。其实就是一个显示界面加城市选择设置部分。

这里也大概贴一下代码

    Private Sub MainWindow_MouseLeftButtonDown(ByVal sender As Object, ByVal e As System.Windows.Input.MouseButtonEventArgs) Handles Me.MouseLeftButtonDown        Me.DragMove()    End Sub    Private Sub MainWindow_Loaded(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles Me.Loaded        'Dim desktopHwnd As IntPtr = GetDesktopPtr()        'Dim ownHwnd As IntPtr = New WindowInteropHelper(Me).Handle        'Dim result As IntPtr = SetParent(ownHwnd, desktopHwnd)              Dim address As String = ""        address = GetAddress()        'Dim weather() As String = ws.getWeatherbyCityName(address)        'LoadData(weather)    End Sub    Function LoadData(ByVal weather() As String) As Boolean        Try            Dim Today_ImageStream, Tomorrow_ImageStream, AfterTomorrow_ImageStream As FileStream            Dim Today_Image, Tomorrow_Image, AfterTomorrow_Image As New BitmapImage()            Dim gifLen As Integer            Dim gifName As String            Dim filePath As String            'today            lblTime.Content = Now.Year & "年" & Now.Month & "月" & Now.Day & "日             星期" & ConvertToChinese(Now.DayOfWeek)            lblAddress.Content = weather(1).ToString            Dim len As Integer = weather(10).ToString.IndexOf("℃") - 9            lblNow.Content = weather(10).ToString.Substring(10, len)            lblWind.Content = weather(6).ToString.Substring(weather(6).ToString.IndexOf(" "))            gifLen = weather(9).ToString.Length            If gifLen = 5 Then                gifName = "0" & weather(9).ToString.Replace("gif", "png")            Else                gifName = weather(9).ToString.Replace("gif", "png")            End If            filePath = path & "images\"            Today_ImageStream = New FileStream(filePath & gifName, FileMode.Open)            Today_Image.BeginInit()            Today_Image.StreamSource = Today_ImageStream            Today_Image.EndInit()            ImgNow.Source = Today_Image            lblTodayTemp.Content = weather(5).ToString.Replace("/", "--")            ImgToday.Source = Today_Image            lblToday.Content = weather(6).ToString.Substring(0, weather(6).ToString.IndexOf(" "))            'tomorrow            If weather(9).ToString = weather(16).ToString Then                ImgTomo.Source = Today_Image            Else                gifLen = weather(16).ToString.Length                If gifLen = 5 Then                    gifName = "0" & weather(16).ToString.Replace("gif", "png")                Else                    gifName = weather(16).ToString.Replace("gif", "png")                End If                Tomorrow_Image = New BitmapImage()                Tomorrow_ImageStream = New FileStream(filePath & gifName, FileMode.Open)                Tomorrow_Image.BeginInit()                Tomorrow_Image.StreamSource = Tomorrow_ImageStream                Tomorrow_Image.EndInit()                ImgTomo.Source = Tomorrow_Image            End If            lblTomo.Content = weather(13).ToString.Substring(0, weather(13).ToString.IndexOf(" "))            lblTomorrowTemp.Content = weather(12).ToString.Replace("/", "--")            'the day after tomorrow            If weather(21).ToString = weather(9).ToString Then                ImgAfter.Source = Today_Image            ElseIf weather(16).ToString = weather(21).ToString Then                ImgAfter.Source = Tomorrow_Image            Else                gifLen = weather(21).ToString.Length                If gifLen = 5 Then                    gifName = "0" & weather(21).ToString.Replace("gif", "png")                Else                    gifName = weather(21).ToString.Replace("gif", "png")                End If                AfterTomorrow_Image = New BitmapImage()                AfterTomorrow_ImageStream = New FileStream(filePath & gifName, FileMode.Open)                AfterTomorrow_Image.BeginInit()                AfterTomorrow_Image.StreamSource = AfterTomorrow_ImageStream                AfterTomorrow_Image.EndInit()                ImgAfter.Source = AfterTomorrow_Image            End If            lblAfterTomo.Content = weather(18).ToString.Substring(0, weather(18).ToString.IndexOf(" "))            lblAfterTomorrowTemp.Content = weather(17).ToString.Replace("/", "--")            Return True        Catch ex As Exception            MsgBox(ex.ToString, MsgBoxStyle.Critical)            Return False        End Try    End Function    Function ConvertToChinese(ByVal weekday As Integer) As String        Select Case weekday            Case 1                Return "一"            Case 2                Return "二"            Case 3                Return "三"            Case 4                Return "四"            Case 5                Return "五"            Case 6                Return "六"            Case 0                Return "日"        End Select        Return ""    End Function

嗯，很好，一切很顺利。我很得意，哈哈。然而就在我沾沾自喜的时候，我想这个东西应该要贴在桌面上吧，和win7小工具一样的效果。而且应该不是难事，我没放心上。

谁知道噩梦来了。不看不知道啊，原来win7的桌面是如此的诡异，分了很多层。如果没有使用aero主题的话，还好说，可是这是个废话啊，用win7的人肯定都喜欢那家伙啊。

也许我这样写不清楚，我说代码吧。开始本想很简单，我就准备使用API SetWindowsPos ，可是事实上我太傻了，呵呵，这样只是把程序放在最后一层，但是屏蔽不了win+D这个显示桌面命令，一样不能贴住桌面（有人叫嵌入桌面）。看下代码吧，当作记录下。

SetWindowPos(winHelp.Handle, HWND_BOTTOM, 0, 0, 0, 0, SetWindowPosFlags.IgnoreMove Or SetWindowPosFlags.IgnoreResize) <DllImport("user32.dll", SetLastError:=True)> _    Public Function SetWindowPos(ByVal hWnd As IntPtr, ByVal hWndInsertAfter As IntPtr, ByVal X As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal uFlags As SetWindowPosFlags) As Boolean    End Function    <Flags()> _    Public Enum SetWindowPosFlags As UInteger        ''' <summary>If the calling thread and the thread that owns the window are attached to different input queues,         ''' the system posts the request to the thread that owns the window. This prevents the calling thread from         ''' blocking its execution while other threads process the request.</summary>        ''' <remarks>SWP_ASYNCWINDOWPOS</remarks>        SynchronousWindowPosition = &H4000        ''' <summary>Prevents generation of the WM_SYNCPAINT message.</summary>        ''' <remarks>SWP_DEFERERASE</remarks>        DeferErase = &H2000        ''' <summary>Draws a frame (defined in the window's class description) around the window.</summary>        ''' <remarks>SWP_DRAWFRAME</remarks>        DrawFrame = &H20        ''' <summary>Applies new frame styles set using the SetWindowLong function. Sends a WM_NCCALCSIZE message to         ''' the window, even if the window's size is not being changed. If this flag is not specified, WM_NCCALCSIZE         ''' is sent only when the window's size is being changed.</summary>        ''' <remarks>SWP_FRAMECHANGED</remarks>        FrameChanged = &H20        ''' <summary>Hides the window.</summary>        ''' <remarks>SWP_HIDEWINDOW</remarks>        HideWindow = &H80        ''' <summary>Does not activate the window. If this flag is not set, the window is activated and moved to the         ''' top of either the topmost or non-topmost group (depending on the setting of the hWndInsertAfter         ''' parameter).</summary>        ''' <remarks>SWP_NOACTIVATE</remarks>        DoNotActivate = &H10        ''' <summary>Discards the entire contents of the client area. If this flag is not specified, the valid         ''' contents of the client area are saved and copied back into the client area after the window is sized or         ''' repositioned.</summary>        ''' <remarks>SWP_NOCOPYBITS</remarks>        DoNotCopyBits = &H100        ''' <summary>Retains the current position (ignores X and Y parameters).</summary>        ''' <remarks>SWP_NOMOVE</remarks>        IgnoreMove = &H2        ''' <summary>Does not change the owner window's position in the Z order.</summary>        ''' <remarks>SWP_NOOWNERZORDER</remarks>        DoNotChangeOwnerZOrder = &H200        ''' <summary>Does not redraw changes. If this flag is set, no repainting of any kind occurs. This applies to         ''' the client area, the nonclient area (including the title bar and scroll bars), and any part of the parent         ''' window uncovered as a result of the window being moved. When this flag is set, the application must         ''' explicitly invalidate or redraw any parts of the window and parent window that need redrawing.</summary>        ''' <remarks>SWP_NOREDRAW</remarks>        DoNotRedraw = &H8        ''' <summary>Same as the SWP_NOOWNERZORDER flag.</summary>        ''' <remarks>SWP_NOREPOSITION</remarks>        DoNotReposition = &H200        ''' <summary>Prevents the window from receiving the WM_WINDOWPOSCHANGING message.</summary>        ''' <remarks>SWP_NOSENDCHANGING</remarks>        DoNotSendChangingEvent = &H400        ''' <summary>Retains the current size (ignores the cx and cy parameters).</summary>        ''' <remarks>SWP_NOSIZE</remarks>        IgnoreResize = &H1        ''' <summary>Retains the current Z order (ignores the hWndInsertAfter parameter).</summary>        ''' <remarks>SWP_NOZORDER</remarks>        IgnoreZOrder = &H4        ''' <summary>Displays the window.</summary>        ''' <remarks>SWP_SHOWWINDOW</remarks>        ShowWindow = &H40    End Enum

看起来很吓人，呵呵，大部分都是参数，很easy。

好吧，既然这样不行，再想，开始转战用SetParent。这个API本事不小哦，而且战斗力很强，完全可以胜任，而且已经被N多大神征服了。嗯，用吧，就是他。代码：

Public Function GetDesktopPtr() As IntPtr 'http://blog.csdn.net/mkdym/article/details/7018318 ' 情况一 Dim hwndWorkerW As IntPtr = IntPtr.Zero Dim hShellDefView As IntPtr = IntPtr.Zero Dim hwndDesktop As IntPtr = IntPtr.Zero Dim hProgMan As IntPtr = FindWindow("ProgMan", Nothing) If hProgMan <> IntPtr.Zero Then hShellDefView = FindWindowEx(hProgMan, IntPtr.Zero, "SHELLDLL_DefView", Nothing) If hShellDefView <> IntPtr.Zero Then 'hwndDesktop = FindWindowEx(hShellDefView, IntPtr.Zero, "SysListView32", "FolderView") hwndDesktop = FindWindowEx(hShellDefView, IntPtr.Zero, "SysListView32", Nothing) End If End If If hwndDesktop <> IntPtr.Zero Then Return hwndDesktop End If ' 情况二 While hwndDesktop = IntPtr.Zero '必须存在桌面窗口层次 hwndWorkerW = FindWindowEx(IntPtr.Zero, hwndWorkerW, "WorkerW", Nothing) '获得WorkerW类的窗口 If hwndWorkerW = IntPtr.Zero Then Exit While End If '未知错误 hShellDefView = FindWindowEx(hwndWorkerW, IntPtr.Zero, "SysListView32", Nothing) If hShellDefView = IntPtr.Zero Then Continue While End If hwndDesktop = FindWindowEx(hShellDefView, IntPtr.Zero, "SysListView32", Nothing) End While Return hwndDesktop End Function Declare Function SetActiveWindow Lib "user32" Alias "SetActiveWindow" (ByVal hwnd As IntPtr) As IntPtr Declare Function ShowWindow Lib "user32" Alias "ShowWindow" (ByVal hwnd As IntPtr, ByVal nCmdShow As IntPtr) As IntPtr Public Declare Function GetPrivateProfileString Lib "KERNEL32.DLL" Alias "GetPrivateProfileStringA" ( _ ByVal lpAppName As String, _ ByVal lpKeyName As String, ByVal lpDefault As String, _ ByVal lpReturnedString As System.Text.StringBuilder, ByVal nSize As Integer, _ ByVal lpFileName As String) As Integer Public Declare Function WritePrivateProfileString Lib "KERNEL32.DLL" Alias "WritePrivateProfileStringA" ( _ ByVal lpAppName As String, _ ByVal lpKeyName As String, _ ByVal lpString As String, _ ByVal lpFileName As String) As Integer <DllImport("User32.dll", EntryPoint:="FindWindowEx")> _ Public Function FindWindowEx(ByVal hwndParent As IntPtr, ByVal hwndChildAfter As IntPtr, ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr End Function <DllImport("user32.dll", EntryPoint:="FindWindow")> _ Public Function FindWindow(ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr End Function <DllImport("user32.dll", EntryPoint:="GetWindow")> _ Public Function GetWindow(ByVal hwnd As IntPtr, ByVal wCmd As IntPtr) As IntPtr End Function <DllImport("user32.dll", EntryPoint:="SetParent")> _ Public Function SetParent(ByVal hWndChild As IntPtr, ByVal hWndNewParent As IntPtr) As IntPtr

    End Function

         '这三句就看可以使用了

         Dim desktopHwnd As IntPtr = GetDesktopPtr()         Dim ownHwnd As IntPtr = New WindowInteropHelper(Me).Handle         Dim result As IntPtr = SetParent(ownHwnd, desktopHwnd)

里面有熟悉的代码和注释？别奇怪，是COPY来的，呵呵。运行代码后，觉得很牛逼吧，不错，是贴上去了。可是我想看看换个桌面图片看看什么效果。我靠，一换完蛋了，刚刚那个效果不见了。赶紧还原动作啊，折腾了半天，毛都不见了。赶紧去问娘啊，哥啊的，度娘说，很多人都是这样。遇到AERO主题下，由于有任务栏下面那个小窗体，窗体句柄不太好找了，能不能成功可能就要看人品和运气了。算了，不行咋办？听说还可以消息拦截，要不试下？好吧，我再找度娘。得到代码几行，经验+100。

 'Dim winHelp As WindowInteropHelper = New WindowInteropHelper(Me)    'Protected Overrides Sub OnSourceInitialized(ByVal e As EventArgs)    '    MyBase.OnSourceInitialized(e)    '    Dim hwndSource As HwndSource = TryCast(PresentationSource.FromVisual(Me), HwndSource)    '    If hwndSource IsNot Nothing Then    '        hwndSource.AddHook(New HwndSourceHook(AddressOf Me.WndProc))    '    End If    'End Sub    'Protected Overridable Function WndProc(ByVal hwnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr, ByRef handled As Boolean) As IntPtr    '    Return IntPtr.Zero    'End Function    'Protected Overridable Function WndProc(ByVal hwnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr, ByRef handled As Boolean) As IntPtr    '    'If msg = WM_SIZE Then    '    'MsgBox("")    '    'If WindowState = WindowState.Minimized Then    '    '    SetWindowPos(winHelp.Handle, HWND_BOTTOM, 0, 0, 0, 0, SetWindowPosFlags.IgnoreMove Or SetWindowPosFlags.IgnoreResize)    '    '    handled = True    '    'End If    '    WindowState = WindowState.Maximized    '    'End If    '    Return IntPtr.Zero    'End Function

上面的代码有很多是注释了N遍，我也没恢复过来，可见我调的多认真，哈哈。哎，上面的代码主要就是取拦截消息，我的确也狠狠研究了下windows消息。结果也很失望，消息是拦截掉了，可是不知道怎么屏蔽掉这个显示桌面让他最小化的。什么办法都用了，只有那个windowstate给点脸，不过效果不太好，其他都不理我。
这个时候我想放弃了。可是难得有时间想做个东西啊，好不甘心啊，玛德，睡觉都在想着他，可怜吧。我最后想回头用GDI+来试试，实在不行用鼠标穿透看看。结果是行了，哈哈，赶紧做吧。我哼哧哼哧的又搞了一天，好了，试试效果吧。哎，那家伙怎么一直在最上面啊，怎么都盖不住啊，显示桌面是没有效果，但是其他的文件打开还是被他挡住了啊。我回头一看，原来我用了topmost，擦，难怪显示桌面萎了。这时候我好像骂人啊，为了这个功能花了几天时间没磨出一个屁来。而且用win7的人都知道，任务栏右下角还有个按钮显示桌面的，那个功能和win+D的原理还不一样。哎，彻底失望了。

GDI+的代码就不贴了，没啥意思。写这个主要想记录下我这几天的经历，也留下一点代码，我觉得蛮有用的。现在这个天气预报是做好了，就是不能完成win7小工具那样贴在桌面上的功能，就自己辛苦点，再按下显示桌面显示吧。没办法了。如果有人知道怎么做，也指点下我吧，谢谢。那个东西我传上去了，有兴趣的可以下载看看。

忘记告诉你们了，上面提到的方法在XP下完全没有问题，win7下是选择性的，哈哈。

点击下载程序