Imports System
Imports System.Drawing
Imports System.Collections
Imports System.ComponentModel
Imports System.Windows.Forms
Imports System.Data
Imports System.Runtime.InteropServices
Public Class mainform
Private Structure RECT
Public left As Integer
Public top As Integer
Public right As Integer
Public bottom As Integer
End Structure
Private Structure APPBARDATA
Public cbSize As Integer
Public hWnd As IntPtr
Public uCallbackMessage As Integer
Public uEdge As Integer
Public rc As RECT
Public lParam As IntPtr
End Structure
Private Enum ABMsg As Integer
ABM_NEW = 0
ABM_REMOVE = 1
ABM_QUERYPOS = 2
ABM_SETPOS = 3
ABM_GETSTATE = 4
ABM_GETTASKBARPOS = 5
ABM_ACTIVATE = 6
ABM_GETAUTOHIDEBAR = 7
ABM_SETAUTOHIDEBAR = 8
ABM_WINDOWPOSCHANGED = 9
ABM_SETSTATE = 10
End Enum
Private Enum ABNotify As Integer
ABN_STATECHANGE = 0
ABN_POSCHANGED
ABN_FULLSCREENAPP
ABN_WINDOWARRANGE
End Enum
Private Enum ABEdge As Integer
ABE_LEFT = 0
ABE_TOP = 1
ABE_RIGHT = 2
ABE_BOTTOM = 3
End Enum
Private fBarRegistered As Boolean = False
Private Declare Function SHAppBarMessage Lib "shell32.dll" Alias "SHAppBarMessage" _
(ByVal dwMessage As Integer, <MarshalAs(UnmanagedType.Struct)> ByRef pData As _
APPBARDATA) As Integer
Private Declare Function GetSystemMetrics Lib "user32" Alias "GetSystemMetrics" _
(ByVal nIndex As Integer) As Integer
Private Declare Function MoveWindow Lib "user32" Alias "MoveWindow" (ByVal hwnd As Integer, _
ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, _
ByVal bRepaint As Integer) As Integer
Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" _
(ByVal lpString As String) As Integer
Private uCallBack As Integer
Dim icons As Integer = 0
Private Sub mainform_DragDrop(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles Me.DragDrop
If e.Data.GetDataPresent(DataFormats.FileDrop) Then
Dim files() As String = DirectCast(e.Data.GetData(DataFormats.FileDrop, False), String())
For Each file As String In files
Dim pb As New PictureBox
pb.Size = New Size(32, 32)
pb.Location = New Point(12 + (icons * 44), 12)
pb.Tag = file
Dim icon As Icon = icon.ExtractAssociatedIcon(file)
pb.Image = icon.ToBitmap
pb.Cursor = Cursors.Hand
AddHandler pb.DoubleClick, AddressOf pb_DoubleClick
ToolTip1.SetToolTip(pb, file)
Me.Controls.Add(pb)
icons += 1
Next
End If
End Sub
Private Sub pb_DoubleClick(ByVal sender As System.Object, ByVal e As System.EventArgs)
Process.Start(DirectCast(sender, PictureBox).Tag.ToString)
End Sub
Private Sub mainform_DragOver(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles Me.DragOver
If e.Data.GetDataPresent(DataFormats.FileDrop) Then
e.Effect = DragDropEffects.Copy
Else
e.Effect = DragDropEffects.None
End If
End Sub
Private Sub mainform_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
RegisterBar()
End Sub
Private Sub appBar_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
Me.ClientSize = New System.Drawing.Size(1024, 56)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedToolWindow
RegisterBar()
Me.Invalidate()
End Sub
Private Sub mainform_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
e.Graphics.DrawLine(New Pen(Color.White, 3), 0, 0, Me.Width, 0)
e.Graphics.DrawLine(New Pen(Color.White, 3), 0, 0, 0, Me.Height)
e.Graphics.DrawLine(New Pen(Color.Black, 3), 0, Me.Height - 3, Me.Width, Me.Height - 3)
e.Graphics.DrawLine(New Pen(Color.Black, 3), Me.Width - 3, 0, Me.Width - 3, Me.Height)
End Sub
Private Sub RegisterBar()
Dim abd As New APPBARDATA
abd.cbSize = Marshal.SizeOf(abd)
abd.hWnd = Me.Handle
If Not fBarRegistered Then
uCallBack = RegisterWindowMessage("AppBarMessage")
abd.uCallbackMessage = uCallBack
Dim ret As Integer = SHAppBarMessage(CType(ABMsg.ABM_NEW, Integer), abd)
fBarRegistered = True
ABSetPos()
Else
SHAppBarMessage(CType(ABMsg.ABM_REMOVE, Integer), abd)
fBarRegistered = False
End If
End Sub
Private Sub ABSetPos()
Dim abd As New APPBARDATA()
abd.cbSize = Marshal.SizeOf(abd)
abd.hWnd = Me.Handle
abd.uEdge = CInt(ABEdge.ABE_BOTTOM)
If abd.uEdge = CInt(ABEdge.ABE_LEFT) OrElse abd.uEdge = CInt(ABEdge.ABE_RIGHT) Then
abd.rc.top = 0
abd.rc.bottom = SystemInformation.PrimaryMonitorSize.Height
If abd.uEdge = CInt(ABEdge.ABE_LEFT) Then
abd.rc.left = 0
abd.rc.right = Size.Width
Else
abd.rc.right = SystemInformation.PrimaryMonitorSize.Width
abd.rc.left = abd.rc.right - Size.Width
End If
Else
abd.rc.left = 0
abd.rc.right = SystemInformation.PrimaryMonitorSize.Width
If abd.uEdge = CInt(ABEdge.ABE_TOP) Then
abd.rc.top = 0
abd.rc.bottom = Size.Height
Else
abd.rc.bottom = SystemInformation.PrimaryMonitorSize.Height
abd.rc.top = abd.rc.bottom - Size.Height
End If
End If
' Query the system for an approved size and position.
SHAppBarMessage(CInt(ABMsg.ABM_QUERYPOS), abd)
' Adjust the rectangle, depending on the edge to which the
' appbar is anchored.
Select Case abd.uEdge
Case CInt(ABEdge.ABE_LEFT)
abd.rc.right = abd.rc.left + Size.Width
Exit Select
Case CInt(ABEdge.ABE_RIGHT)
abd.rc.left = abd.rc.right - Size.Width
Exit Select
Case CInt(ABEdge.ABE_TOP)
abd.rc.bottom = abd.rc.top + Size.Height
Exit Select
Case CInt(ABEdge.ABE_BOTTOM)
abd.rc.top = abd.rc.bottom - Size.Height
Exit Select
End Select
' Pass the final bounding rectangle to the system.
SHAppBarMessage(CInt(ABMsg.ABM_SETPOS), abd)
' Move and size the appbar so that it conforms to the
' bounding rectangle passed to the system.
MoveWindow(abd.hWnd, abd.rc.left, abd.rc.top, abd.rc.right - abd.rc.left, abd.rc.bottom - abd.rc.top, True)
End Sub
Protected Overloads Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
If m.Msg = uCallBack Then
Select Case m.WParam.ToInt32()
Case CInt(ABNotify.ABN_POSCHANGED)
ABSetPos()
Exit Select
End Select
End If
MyBase.WndProc(m)
End Sub
Protected Overloads Overrides ReadOnly Property CreateParams() As System.Windows.Forms.CreateParams
Get
Dim cp As CreateParams = MyBase.CreateParams
cp.Style = cp.Style And (Not 12582912)
' WS_CAPTION
cp.Style = cp.Style And (Not 8388608)
' WS_BORDER
cp.ExStyle = 128 Or 8
' WS_EX_TOOLWINDOW | WS_EX_TOPMOST
Return cp
End Get
End Property
End Class