vb.net 初始屏幕界面透明实现方法

来源:互联网 发布:数控车图纸及编程 编辑:程序博客网 时间:2024/05/24 02:58



很多大程序的启动时间较长,为了不让用户等得烦躁,一般在启动的时候会显示一个启动界面,高级些的启动界面还会显示正在加载的内容,并且界面的图片是带透明背景的。
不过这里要实现的仅是VB.Net程序启动界面透明化,意思是像png图片那样可以看到背景(只在vb.net初始屏幕放png图片是没办法实现的),至于正在加载内容的提示,有时间再研究了。

先新建vb.net窗体应用程序,并添加一个初始屏幕





添加后,把主窗体和初始屏幕窗体重新命名成frmMain和frmStart (这里命名成自己喜欢的即可,只是后期代码中要对应),效果如下


初始屏幕中的各种控件全部删除,结果如下



准备一张png图片作为启动界面,我从网上选择了个地球图标,将它保存到项目目录中


然后把png图片加载到资源文件,方法如下 (保存地球图标的时候名字写成earch了,只因手速太快,不过代码中也写earch就行了)







接下来,打开初始屏幕代码界面,粘贴如下代码
Imports System.TextImports System.Runtime.InteropServicesPublic Class frmStart    Private Sub frmStart_Load(sender As Object, e As EventArgs) Handles Me.Load        Dim bb As Bitmap        bb = vbnetStartForm.My.Resources.Resources.earch        Dim bmp As New Bitmap(bb)        SetBits(bmp)    End Sub#Region "窗体移动"    <DllImport("user32.dll")>    Public Shared Function ReleaseCapture() As Boolean    End Function    <DllImport("user32.dll")>    Public Shared Function SendMessage(hwnd As IntPtr, wMsg As Integer, wParam As Integer, lParam As Integer) As Boolean    End Function    Public Const WM_SYSCOMMAND As Integer = &H112    Public Const SC_MOVE As Integer = &HF010    Public Const HTCAPTION As Integer = &H2    '无边框窗体移动#End Region#Region "调用UpdateLayeredWindow函数"    Protected Overrides ReadOnly Property CreateParams() As CreateParams        '重载窗体的CreateParams方法        Get            Const WS_MINIMIZEBOX As Integer = &H20000            ' Winuser.h中定义            Dim cp As CreateParams = MyBase.CreateParams            cp.Style = cp.Style Or WS_MINIMIZEBOX            ' 允许最小化操作            cp.ExStyle = cp.ExStyle Or &H80000            ' WS_EX_LAYERED            Return cp        End Get    End Property    Public Sub SetBits(bitmap__1 As Bitmap)        '调用UpdateLayeredWindow()方法。this.BackgroundImage为你事先准备的带透明图片。        'if (!haveHandle) return;        If Not Bitmap.IsCanonicalPixelFormat(bitmap__1.PixelFormat) OrElse Not Bitmap.IsAlphaPixelFormat(bitmap__1.PixelFormat) Then            Throw New ApplicationException("图片必须是32位带Alhpa通道的图片。")        End If        Dim oldBits As IntPtr = IntPtr.Zero        Dim screenDC As IntPtr = Win32.GetDC(IntPtr.Zero)        Dim hBitmap As IntPtr = IntPtr.Zero        Dim memDc As IntPtr = Win32.CreateCompatibleDC(screenDC)        Try            Dim topLoc As New Win32.Point(Left, Top)            Dim bitMapSize As New Win32.Size(bitmap__1.Width, bitmap__1.Height)            Dim blendFunc As New Win32.BLENDFUNCTION()            Dim srcLoc As New Win32.Point(0, 0)            hBitmap = bitmap__1.GetHbitmap(Color.FromArgb(0))            oldBits = Win32.SelectObject(memDc, hBitmap)            blendFunc.BlendOp = Win32.AC_SRC_OVER            blendFunc.SourceConstantAlpha = 255            blendFunc.AlphaFormat = Win32.AC_SRC_ALPHA            blendFunc.BlendFlags = 0            Win32.UpdateLayeredWindow(Handle, screenDC, topLoc, bitMapSize, memDc, srcLoc,                0, blendFunc, Win32.ULW_ALPHA)        Finally            If hBitmap <> IntPtr.Zero Then                Win32.SelectObject(memDc, oldBits)                Win32.DeleteObject(hBitmap)            End If            Win32.ReleaseDC(IntPtr.Zero, screenDC)            Win32.DeleteDC(memDc)        End Try    End Sub#End Region#Region "Win32 API声明"    Class Win32        <StructLayout(LayoutKind.Sequential)>        Public Structure Size            Public cx As Int32            Public cy As Int32            Public Sub New(x As Int32, y As Int32)                cx = x                cy = y            End Sub        End Structure        <StructLayout(LayoutKind.Sequential, Pack:=1)>        Public Structure BLENDFUNCTION            Public BlendOp As Byte            Public BlendFlags As Byte            Public SourceConstantAlpha As Byte            Public AlphaFormat As Byte        End Structure        <StructLayout(LayoutKind.Sequential)>        Public Structure Point            Public x As Int32            Public y As Int32            Public Sub New(x As Int32, y As Int32)                Me.x = x                Me.y = y            End Sub        End Structure        Public Const AC_SRC_OVER As Byte = 0        Public Const ULW_ALPHA As Int32 = 2        Public Const AC_SRC_ALPHA As Byte = 1        Public Declare Auto Function CreateCompatibleDC Lib "gdi32.dll" (hDC As IntPtr) As IntPtr        Public Declare Auto Function GetDC Lib "user32.dll" (hWnd As IntPtr) As IntPtr        <DllImport("gdi32.dll", ExactSpelling:=True)>        Public Shared Function SelectObject(hDC As IntPtr, hObj As IntPtr) As IntPtr        End Function        <DllImport("user32.dll", ExactSpelling:=True)>        Public Shared Function ReleaseDC(hWnd As IntPtr, hDC As IntPtr) As Integer        End Function        Public Declare Auto Function DeleteDC Lib "gdi32.dll" (hDC As IntPtr) As Integer        Public Declare Auto Function DeleteObject Lib "gdi32.dll" (hObj As IntPtr) As Integer        Public Declare Auto Function UpdateLayeredWindow Lib "user32.dll" (hwnd As IntPtr, hdcDst As IntPtr, ByRef pptDst As Point, ByRef psize As Size, hdcSrc As IntPtr, ByRef pptSrc As Point,            crKey As Int32, ByRef pblend As BLENDFUNCTION, dwFlags As Int32) As Integer        Public Declare Auto Function ExtCreateRegion Lib "gdi32.dll" (lpXform As IntPtr, nCount As UInteger, rgnData As IntPtr) As IntPtr    End Class#End Region    Private Sub frmStart_MouseDown(sender As Object, e As MouseEventArgs) Handles MyBase.MouseDown        ReleaseCapture()        SendMessage(Me.Handle, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0)        '窗体移动    End SubEnd Class


然后再打开项目属性窗口




将初始屏幕设置成frmStart


没意外的话,最后按F5就可以看到令人期待的透明载入界面了


当主界面初始化完成后,初始屏幕消失,主界面出现



文章比较乱请多包涵,下面的地址是我在写文章时测试的项目文件源码,有兴趣的朋友可以下载测试下,有什么问题可留言,我看到后会尽量回复

http://download.csdn.net/detail/ivanwfy/9888101


原创粉丝点击