|
Imports System.Runtime.InteropServices
Public Class Form1
'先引入API函数ReleaseCapture、SendMessage
<DllImport("user32.dll")> _
Public Shared Function ReleaseCapture() As Boolean
End Function
<DllImport("user32.dll")> _
Public Shared Function SendMessage(ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Boolean
End Function
Private Const WM_SYSCOMMAND As Integer = &H112
'点击窗口左上角那个图标时的系统信息
Private Const WM_MOVING As Integer = &H216
'鼠标移动消息
Private Const SC_MOVE As Integer = &HF010
'移动信息
Dim HTCAPTION As IntPtr = New IntPtr(&H2)
'表示鼠标在窗口标题栏时的系统信息
Private Const WM_NCHITTEST As Integer = &H84
'鼠标在窗体客户区(除了标题栏和边框以外的部分)时发送的消息
Dim HTCLIENT As IntPtr = New IntPtr(&H1)
'表示鼠标在窗口客户区的系统消息
Private Const SC_MAXIMIZE As Integer = &HF030
'最大化信息
Private Const SC_MINIMIZE As Integer = &HF020
'最小化信息
'再override 一下WindProc函数
Protected Overrides Sub WndProc(ByRef m As Message)
Select Case m.Msg
Case WM_MOVING
'如果鼠标移
MyBase.WndProc(m)
'调用基类的窗口过程——WndProc方法处理这个消息
If m.Result = DirectCast(HTCLIENT, IntPtr) Then
'如果返回的是HTCLIENT
m.Result = DirectCast(HTCAPTION, IntPtr)
'把它改为HTCAPTION
'直接返回退出方法
Return
End If
Exit Select
End Select
MyBase.WndProc(m)
'如果不是鼠标移动或单击消息就调用基类的窗口过程进行处理
End Sub
'再override一下OnMouseMove函数
Protected Overrides Sub OnMouseMove(ByVal e As MouseEventArgs)
If e.Button = MouseButtons.Left Then
ReleaseCapture()
SendMessage(Me.Handle, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0)
End If
MyBase.OnMouseMove(e)
End Sub
'实现窗体类似于QQ最小化的动画效果
Public Const IDANI_OPEN As System.Int32 = 1
Public Const IDANI_CAPTION As System.Int32 = 3
<System.Runtime.InteropServices.StructLayout(System.Runtime.InteropServices.LayoutKind.Sequential)> _
Private Structure RECT
Public Sub New(ByVal rectangle As System.Drawing.Rectangle)
Left = rectangle.Left
Top = rectangle.Top
Right = rectangle.Right
Bottom = rectangle.Bottom
End Sub
Public Sub New(ByVal location As System.Drawing.Point, ByVal size As System.Drawing.Size)
Left = location.X
Top = location.Y
Right = location.X + size.Width
Bottom = location.Y + size.Height
End Sub
Public Left As System.Int32
Public Top As System.Int32
Public Right As System.Int32
Public Bottom As System.Int32
End Structure
<System.Runtime.InteropServices.DllImport("user32.dll")> _
Private Shared Function DrawAnimatedRects(ByVal hwnd As System.IntPtr, ByVal idAni As Integer, <System.Runtime.InteropServices.In()> ByRef lprcFrom As RECT, <System.Runtime.InteropServices.In()> ByRef lprcTo As RECT) As Boolean
End Function
<System.Runtime.InteropServices.DllImport("user32.dll", SetLastError:=True)> _
Private Shared Function FindWindow(ByVal lpClassName As String, ByVal lpWindowName As String) As System.IntPtr
End Function
<System.Runtime.InteropServices.DllImport("user32.dll", SetLastError:=True)> _
Private Shared Function FindWindowEx(ByVal hwndParent As System.IntPtr, ByVal hwndChildAfter As System.IntPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As System.IntPtr
End Function
<System.Runtime.InteropServices.DllImport("user32.dll")> _
Private Shared Function GetWindowRect(ByVal hWnd As System.IntPtr, ByRef lpRect As RECT) As Boolean
End Function
''' <summary>
''' 动画隐藏/显示窗口
''' </summary>
''' <param name="form">form窗口</param>
''' <param name="show">true显示、false隐藏</param>
Public Shared Sub ShowHideAnimated(ByVal form As System.Windows.Forms.Form, ByVal show As System.Boolean)
Dim from As New RECT(form.Location, form.Size)
Dim [to] As RECT
Dim hWnd As System.IntPtr = FindWindowEx(FindWindow("Shell_TrayWnd", Nothing), System.IntPtr.Zero, "TrayNotifyWnd", Nothing)
If hWnd <> System.IntPtr.Zero Then
GetWindowRect(hWnd, [to])
Else
[to].Left = System.Windows.Forms.SystemInformation.VirtualScreen.Right - form.Width
[to].Top = System.Windows.Forms.SystemInformation.VirtualScreen.Bottom - System.Windows.Forms.SystemInformation.CaptionHeight - (System.Windows.Forms.SystemInformation.FrameBorderSize.Height * 2)
[to].Right = System.Windows.Forms.SystemInformation.VirtualScreen.Right
[to].Bottom = System.Windows.Forms.SystemInformation.VirtualScreen.Bottom
End If
If show Then
DrawAnimatedRects(form.Handle, IDANI_CAPTION, [to], from)
form.Show()
Else
form.Hide()
DrawAnimatedRects(form.Handle, IDANI_CAPTION, from, [to])
End If
End Sub
'外加让textbox内容改变后自动滚动到最底端:
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
TextBox1.AppendText(DateTime.Now.ToString() & "/r/n")
TextBox1.SelectionStart = TextBox1.Text.Length
'textBox1.SelectionLength = 0;
TextBox1.ScrollToCaret()
End Sub
End Class
|
|
|
|
|
This is a rounded form, you can implement a button to replace the background picture
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Data
Imports System.Drawing
Imports System.Text
Imports System.Windows.Forms
Imports System.Drawing.Drawing2D
Imports System.Linq
Imports System.Runtime.InteropServices
Public Class Form1
Const CS_DropSHADOW As Integer = &H20000
Const GCL_STYLE As Integer = (-26)
'声明Win32 API
<dllimport("user32.dll", charset:="CharSet.Auto)"> _
Public Shared Function SetClassLong(ByVal hwnd As IntPtr, ByVal nIndex As Integer, ByVal dwNewLong As Integer) As Integer
End Function
<dllimport("user32.dll", charset:="CharSet.Auto)"> _
Public Shared Function GetClassLong(ByVal hwnd As IntPtr, ByVal nIndex As Integer) As Integer
End Function
'定义鼠标消息常量
Private Const WM_NCHITTEST As Integer = &H84
Private Const HT_LEFT As Integer = 10
Private Const HT_RIGHT As Integer = 11
Private Const HT_TOP As Integer = 12
Private Const HT_TOPLEFT As Integer = 13
Private Const HT_TOPRIGHT As Integer = 14
Private Const HT_BOTTOM As Integer = 15
Private Const HT_BOTTOMLEFT As Integer = 16
Private Const HT_BOTTOMRIGHT As Integer = 17
Private Const HT_CAPTION As Integer = 2
'处理Windows消息
Protected Overrides Sub WndProc(ByRef Msg As Message)
If Msg.Msg = WM_NCHITTEST Then
'获取鼠标位置
Dim nPosX As Integer = (Msg.LParam.ToInt32() And 65535)
Dim nPosY As Integer = (Msg.LParam.ToInt32() >> 16)
'右下角
If nPosX >= Me.Right - 6 AndAlso nPosY >= Me.Bottom - 6 Then
Msg.Result = New IntPtr(HT_BOTTOMRIGHT)
Return
'左上角
ElseIf nPosX <= Me.Left + 6 AndAlso nPosY <= Me.Top + 6 Then
Msg.Result = New IntPtr(HT_TOPLEFT)
Return
'左下角
ElseIf nPosX <= Me.Left + 6 AndAlso nPosY >= Me.Bottom - 6 Then
Msg.Result = New IntPtr(HT_BOTTOMLEFT)
Return
'右上角
ElseIf nPosX >= Me.Right - 6 AndAlso nPosY <= Me.Top + 6 Then
Msg.Result = New IntPtr(HT_TOPRIGHT)
Return
ElseIf nPosX >= Me.Right - 2 Then
Msg.Result = New IntPtr(HT_RIGHT)
Return
ElseIf nPosY >= Me.Bottom - 2 Then
Msg.Result = New IntPtr(HT_BOTTOM)
Return
ElseIf nPosX <= Me.Left + 2 Then
Msg.Result = New IntPtr(HT_LEFT)
Return
ElseIf nPosY <= Me.Top + 2 Then
Msg.Result = New IntPtr(HT_TOP)
Return
Else
Msg.Result = New IntPtr(HT_CAPTION)
Return
End If
End If
MyBase.WndProc(Msg)
End Sub
Public Sub SetWindowRegion()
Dim FormPath As System.Drawing.Drawing2D.GraphicsPath
FormPath = New System.Drawing.Drawing2D.GraphicsPath()
Dim rect As New Rectangle(0, 0, Me.Width, Me.Height)
FormPath = GetRoundedRectPath(rect, 10)
Me.Region = New Region(FormPath)
End Sub
Private Function GetRoundedRectPath(ByVal rect As Rectangle, ByVal radius As Integer) As GraphicsPath
Dim diameter As Integer = radius
Dim arcRect As New Rectangle(rect.Location, New Size(diameter, diameter))
Dim path As New GraphicsPath()
' 左上角
path.AddArc(arcRect, 180, 90)
' 右上角
arcRect.X = rect.Right - diameter
path.AddArc(arcRect, 270, 90)
' 右下角
arcRect.Y = rect.Bottom - diameter
path.AddArc(arcRect, 0, 90)
' 左下角
arcRect.X = rect.Left
path.AddArc(arcRect, 90, 90)
path.CloseFigure()
'闭合曲线
Return path
End Function
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'API函数加载,实现窗体边框阴影效果
SetClassLong(Me.Handle, GCL_STYLE, GetClassLong(Me.Handle, GCL_STYLE) Or CS_DropSHADOW)
End Sub
Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim g As Graphics = Me.CreateGraphics
Dim pen As New Pen(Brushes.Gray, 1)
g.DrawLine(pen, 0, 0, 0, Me.Height)
g.DrawLine(pen, 0, 0, Me.Width, 0)
g.DrawLine(pen, Me.Width - 1, 0, Me.Width - 1, Me.Height)
g.DrawLine(pen, 0, Me.Height - 1, Me.Width, Me.Height - 1)
pen.Dispose()
End Sub
Private Sub Form1_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
'采用界面二重缓冲
SetStyle(ControlStyles.SupportsTransparentBackColor, True)
SetStyle(ControlStyles.AllPaintingInWmPaint, True)
SetStyle(ControlStyles.UserPaint, True)
SetStyle(ControlStyles.DoubleBuffer, True)
Me.Refresh()
SetWindowRegion()
End Sub
Private curFileName As String = ""
Private curBitmap As Bitmap
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim opfile As New OpenFileDialog()
opfile.Title = "请选择一个图像"
opfile.Multiselect = True
opfile.Filter = "所有图像文件|*.jpg;*.png;*.bmp;*.gif"
If opfile.ShowDialog() = DialogResult.OK Then
Try
curFileName = opfile.FileName
curBitmap = DirectCast(Image.FromFile(curFileName), Bitmap)
Me.BackgroundImage = DirectCast(curBitmap, Image)
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End If
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Me.Close()
End Sub
End Class
|
|
|
|
|
Public Class Form1
Private Sub btn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btn.Click
Dim n As Double
For i = -1 To 1 Step 0.0005
Me.Opacity = System.Math.Abs(i)
Me.Refresh()
Next i
End Sub
End Class
|
|
|
|
|