Foxtable(狐表)用户栏目专家坐堂 → 以下无边框窗体阴影效果代码版主能否帮忙改写成狐表窗体可调用的


  共有3699人关注过本帖树形打印复制链接

主题:以下无边框窗体阴影效果代码版主能否帮忙改写成狐表窗体可调用的

帅哥哟,离线,有人找我吗?
有点甜
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/11/21 11:54:00 [显示全部帖子]

全局代码
 
Public Class ShadowForm
    Inherits windows.forms.Form
 
    Public isRoundShadow As Boolean = True
    Public isShowShadow As Boolean = True
    Private WithEvents _MainForm As windows.forms.Form
    Private _ShadowWidth As Integer = 9
    Private _ShadowImage As Bitmap
 
    Public Property ShadowWidth As Integer
        Get
            Return _ShadowWidth
        End Get
        Set(value As Integer)
            Me._ShadowWidth = value
            ReSet()
        End Set
    End Property
    Protected Overrides ReadOnly Property CreateParams As windows.forms.CreateParams
        Get
            Dim x As windows.forms.CreateParams = MyBase.CreateParams
            x.ExStyle = x.ExStyle Or &H80000
            Return x
        End Get
    End Property
 
    Public Shared Function RegisterShadowForm(form As windows.forms.Form) As ShadowForm
        Return New ShadowForm(form)
    End Function
    Private Sub New(form As windows.forms.Form)
 
        ' 此调用是设计器所必需的.
        'InitializeComponent()
        Me.FormBorderStyle = Windows.Forms.FormBorderStyle.None
 
        ' 在 InitializeComponent() 调用之后添加任何初始化.
        _MainForm = form
        InitMe()
    End Sub
 
    Private Sub InitMe()
        _MainForm.Owner = Me
        Me.ShowInTaskbar = False
    End Sub
 
    Public Sub SizeChanged(sender As Object, e As System.EventArgs) Handles _MainForm.SizeChanged
        ReSet()
    End Sub
    Public Sub LocationChange(sender As Object, e As System.EventArgs) Handles _MainForm.LocationChanged
        Me.Location = New Point(_MainForm.Location.X - Me._ShadowWidth, _MainForm.Location.Y - Me._ShadowWidth)
    End Sub
    Private Sub ShowMe(sender As Object, e As EventArgs) Handles _MainForm.Shown
        Me.Show()
        ReSet()
    End Sub
 
 
    Public Sub ReSet()
        If Me.isShowShadow Then
            SetSizeLocation()
            SetShadowImage()
            setPaint()
        End If
    End Sub
 
    Private Sub SetSizeLocation()
        Me.Size = New Size(_MainForm.Size.Width + 2 * Me._ShadowWidth, _MainForm.Size.Height + 2 * Me._ShadowWidth)
        Me.Location = New Point(_MainForm.Location.X - Me._ShadowWidth, _MainForm.Location.Y - Me._ShadowWidth)
    End Sub
    Private Function SetShadowImage() As Bitmap
        If IsNothing(_ShadowImage) Then
            _ShadowImage = New Bitmap(System.Windows.Forms.Screen.PrimaryScreen.Bounds.Width, System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height)
        End If
        Graphics.FromImage(_ShadowImage).Clear(Color.Transparent)
        If isRoundShadow Then
            _ShadowImage = SetRoundShadowStyle()
        Else
            _ShadowImage = SetShadowStyle()
        End If
        Return _ShadowImage
    End Function
    Private Function SetRoundShadowStyle()
        '_ShadowImage = New Bitmap(Me.Width, Me.Height)
        Dim g As Graphics = Graphics.FromImage(_ShadowImage)
        g.SmoothingMode = SmoothingMode.HighQuality
        Dim pen As Pen = New Pen(Color.FromArgb(0), 2)
        For i As Integer = 0 To _ShadowWidth Step 1
            pen.Color = Color.FromArgb((255 / 10 / _ShadowWidth) * i, 0, 0, 0)
            g.DrawPath(pen, CreateRoundPath(New Rectangle(i, i, Me.Width - 2 * i - 1, Me.Height - 2 * i - 1)))
        Next
        Return _ShadowImage
    End Function
    Private Function CreateRoundPath(rect As Rectangle)
        Dim cornerRadius As Integer = ShadowWidth * 0.6
        Dim roundedRect As GraphicsPath = New GraphicsPath()
        roundedRect.AddArc(rect.X, rect.Y, cornerRadius * 2, cornerRadius * 2, 180, 90)
        roundedRect.AddLine(rect.X + cornerRadius, rect.Y, rect.Right - cornerRadius * 2, rect.Y)
        roundedRect.AddArc(rect.X + rect.Width - cornerRadius * 2, rect.Y, cornerRadius * 2, cornerRadius * 2, 270, 90)
        roundedRect.AddLine(rect.Right, rect.Y + cornerRadius * 2, rect.Right, rect.Y + rect.Height - cornerRadius * 2)
        roundedRect.AddArc(rect.X + rect.Width - cornerRadius * 2, rect.Y + rect.Height - cornerRadius * 2, cornerRadius * 2, cornerRadius * 2, 0, 90)
        roundedRect.AddLine(rect.Right - cornerRadius * 2, rect.Bottom, rect.X + cornerRadius * 2, rect.Bottom)
        roundedRect.AddArc(rect.X, rect.Bottom - cornerRadius * 2, cornerRadius * 2, cornerRadius * 2, 90, 90)
        roundedRect.AddLine(rect.X, rect.Bottom - cornerRadius * 2, rect.X, rect.Y + cornerRadius * 2)
        roundedRect.CloseFigure()
        Return roundedRect
    End Function
    Protected Overridable Function SetShadowStyle()
        '_ShadowImage = New Bitmap(Me.Width, Me.Height)
        Dim g As Graphics = Graphics.FromImage(_ShadowImage)
 
        Dim pen As Pen = New Pen(Color.FromArgb(0), 2)
        For i As Integer = 0 To _ShadowWidth Step 1
            pen.Color = Color.FromArgb((255 / 10 / _ShadowWidth) * i, 0, 0, 0)
            g.DrawRectangle(pen, New Rectangle(i, i, Me.Width - 2 * i - 1, Me.Height - 2 * i - 1))
        Next
        Return _ShadowImage
    End Function
 
    Private Sub setPaint()
        Dim zero As IntPtr = IntPtr.Zero
        Dim dc As IntPtr = GetDC(IntPtr.Zero)
        Dim hgdiobj As IntPtr = IntPtr.Zero
        Dim hdc As IntPtr = CreateCompatibleDC(dc)
        Try
            Dim pptdst As WinPoint = New WinPoint
            pptdst.x = Me.Left
            pptdst.y = Me.Top
            Dim psize As WinSize = New WinSize
psize.cx = Me.Width
psize.cy = Me.Height
            Dim pblend As BLENDFUNCTION = New BLENDFUNCTION()
            Dim pprsrc As WinPoint = New WinPoint
pprsrc.x = 0
pprsrc.y = 0
            hgdiobj = _ShadowImage.GetHbitmap(Color.FromArgb(0))
            zero = SelectObject(hdc, hgdiobj)
            pblend.BlendOp = 0
            pblend.SourceConstantAlpha = Byte.Parse("255")
            pblend.AlphaFormat = 1
            pblend.BlendFlags = 0
            If Not UpdateLayeredWindow(MyBase.Handle, dc, pptdst, psize, hdc, pprsrc, 0, pblend, 2) Then
                Dim x = GetLastError()
            End If
            Return
        Finally
            If hgdiobj <> IntPtr.Zero Then
                SelectObject(hdc, zero)
                DeleteObject(hgdiobj)
            End If
            ReleaseDC(IntPtr.Zero, dc)
            DeleteDC(hdc)
        End Try
    End Sub
 
#Region "import dll"
    <DllImport("gdi32.dll")> _
    Private Shared Function DeleteDC(hdc As IntPtr) As Boolean
 
    End Function
    <DllImport("user32.dll")> _
    Private Shared Function ReleaseDC(hwnd As IntPtr, hdc As IntPtr) As Integer
 
    End Function
    <DllImport("kernel32.dll")> _
    Private Shared Function GetLastError() As Integer
 
    End Function
    <DllImport("user32.dll")> _
    Private Shared Function UpdateLayeredWindow(hwnd As IntPtr, sdc As IntPtr, ByRef loc As WinPoint, ByRef size As WinSize, srcdc As IntPtr, ByRef sloc As WinPoint, c As Integer, ByRef bd As BLENDFUNCTION, x As Integer) As Integer
 
    End Function
    <DllImport("gdi32.dll")> _
    Private Shared Function CreateCompatibleDC(intptr As IntPtr) As IntPtr
 
    End Function
    <DllImport("user32.dll")> _
    Private Shared Function GetDC(hwnd As IntPtr) As IntPtr
 
    End Function
    <DllImport("gdi32.dll")> _
    Private Shared Function DeleteObject(hwnd As IntPtr) As Boolean
 
    End Function
    <DllImport("gdi32.dll")> _
    Private Shared Function SelectObject(hwnd As IntPtr, obj As IntPtr) As Integer
 
    End Function
#End Region
#Region "WinStructure"
 
    Structure WinPoint
        Dim x As Integer
        Dim y As Integer
    End Structure
    Structure WinSize
        Dim cx As Integer
        Dim cy As Integer
    End Structure
 
    Structure BLENDFUNCTION
        Dim BlendOp As Byte
        Dim BlendFlags As Byte
        Dim SourceConstantAlpha As Byte
        Dim AlphaFormat As Byte
    End Structure
#End Region
 
End Class
 
调用代码
 
Dim f = Forms("窗口1")
f.show
Dim frm = ShadowForm.RegisterShadowForm(f.baseform)
frm.show
frm.reset
f.show
[此贴子已经被作者于2018/11/21 11:57:59编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/11/21 12:56:00 [显示全部帖子]

以下是引用dyz1009在2018/11/21 12:40:00的发言:
甜版,貌似不行,在窗体的AfterLoad中调用会造成狐表闪退。

 

不能写在AfterLoad中,你可以开启timertick事件,写到里面去

 

e.Form.TimerEnabled = False
Dim f = e.form
Dim frm = ShadowForm.RegisterShadowForm(f.baseform)
frm.show
frm.reset
f.show


 回到顶部