MyResizer.vb 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315
  1. Imports System.Runtime.InteropServices
  2. Imports System.Windows.Interop
  3. Imports System.Windows.Threading
  4. Public Class MyResizer
  5. Private Delegate Sub RefreshDelegate()
  6. Private Structure POINT
  7. Public x As Integer
  8. Public y As Integer
  9. Public Sub New(x As Integer, y As Integer)
  10. Me.x = x
  11. Me.y = y
  12. End Sub
  13. End Structure
  14. Private Structure MINMAXINFO
  15. Public ptReserved As POINT
  16. Public ptMaxSize As POINT
  17. Public ptMaxPosition As POINT
  18. Public ptMinTrackSize As POINT
  19. Public ptMaxTrackSize As POINT
  20. End Structure
  21. Private Structure RECT
  22. Public left As Integer
  23. Public top As Integer
  24. Public right As Integer
  25. Public bottom As Integer
  26. Public Shared Empty As RECT = Nothing
  27. Public ReadOnly Property Width() As Integer
  28. Get
  29. Return Math.Abs(Me.right - Me.left)
  30. End Get
  31. End Property
  32. Public ReadOnly Property Height() As Integer
  33. Get
  34. Return Me.bottom - Me.top
  35. End Get
  36. End Property
  37. Public Sub New(left As Integer, top As Integer, right As Integer, bottom As Integer)
  38. Me.left = left
  39. Me.top = top
  40. Me.right = right
  41. Me.bottom = bottom
  42. End Sub
  43. Public Sub New(rcSrc As RECT)
  44. Me.left = rcSrc.left
  45. Me.top = rcSrc.top
  46. Me.right = rcSrc.right
  47. Me.bottom = rcSrc.bottom
  48. End Sub
  49. End Structure
  50. <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)>
  51. Private Class MONITORINFO
  52. Public cbSize As Integer = Marshal.SizeOf(GetType(MONITORINFO))
  53. Public rcMonitor As RECT = Nothing
  54. Public rcWork As RECT = Nothing
  55. Public dwFlags As Integer = 0
  56. End Class
  57. Private Structure PointAPI
  58. Public X As Integer
  59. Public Y As Integer
  60. End Structure
  61. Private ReadOnly target As Window = Nothing
  62. Private resizeRight As Boolean = False
  63. Private resizeLeft As Boolean = False
  64. Private resizeUp As Boolean = False
  65. Private resizeDown As Boolean = False
  66. Private ReadOnly leftElements As New Dictionary(Of UIElement, Short)()
  67. Private ReadOnly rightElements As New Dictionary(Of UIElement, Short)()
  68. Private ReadOnly upElements As New Dictionary(Of UIElement, Short)()
  69. Private ReadOnly downElements As New Dictionary(Of UIElement, Short)()
  70. Private startMousePoint As PointAPI = Nothing
  71. Private startWindowSize As Size = Nothing
  72. Private startWindowLeftUpPoint As POINT = Nothing
  73. Private Shared workAreaMaxHeight As Integer = -1
  74. Private hs As HwndSource
  75. Public Sub New(target As Window)
  76. Me.target = target
  77. If IsNothing(target) Then Throw New Exception("Invalid Window handle")
  78. AddHandler target.SourceInitialized, AddressOf Me.MyMacClass_SourceInitialized
  79. End Sub
  80. Private Sub MyMacClass_SourceInitialized(sender As Object, e As EventArgs)
  81. Me.hs = (TryCast(PresentationSource.FromVisual(CType(sender, Visual)), HwndSource))
  82. Me.hs.AddHook(AddressOf Me.WndProc)
  83. End Sub
  84. Private Function WndProc(hwnd As IntPtr, msg As Integer, wParam As IntPtr, lParam As IntPtr, ByRef handled As Boolean) As IntPtr
  85. If msg = 36 Then
  86. WmGetMinMaxInfo(hwnd, lParam)
  87. handled = True
  88. End If
  89. Return CType(0, IntPtr)
  90. End Function
  91. Private Shared Sub WmGetMinMaxInfo(hwnd As IntPtr, lParam As IntPtr)
  92. Dim mINMAXINFO As MINMAXINFO = CType(Marshal.PtrToStructure(lParam, GetType(MINMAXINFO)), MINMAXINFO)
  93. Dim flags As Integer = 2
  94. Dim intPtr As IntPtr = MonitorFromWindow(hwnd, flags)
  95. Dim flag As Boolean = intPtr <> IntPtr.Zero
  96. If flag Then
  97. Dim mONITORINFO As New MONITORINFO()
  98. GetMonitorInfo(intPtr, mONITORINFO)
  99. Dim rcWork As RECT = mONITORINFO.rcWork
  100. Dim rcMonitor As RECT = mONITORINFO.rcMonitor
  101. mINMAXINFO.ptMaxPosition.x = Math.Abs(rcWork.left - rcMonitor.left)
  102. mINMAXINFO.ptMaxPosition.y = Math.Abs(rcWork.top - rcMonitor.top)
  103. mINMAXINFO.ptMaxSize.y = Math.Abs(rcWork.bottom - rcWork.top)
  104. workAreaMaxHeight = mINMAXINFO.ptMaxSize.y
  105. If rcWork.Height = rcMonitor.Height Then
  106. mINMAXINFO.ptMaxSize.y -= 2
  107. End If
  108. End If
  109. Marshal.StructureToPtr(mINMAXINFO, lParam, True)
  110. End Sub
  111. Private Declare Function GetMonitorInfo Lib "user32" (hMonitor As IntPtr, lpmi As MONITORINFO) As Boolean
  112. Private Declare Function MonitorFromWindow Lib "User32" (handle As IntPtr, flags As Integer) As IntPtr
  113. Private Sub connectMouseHandlers(element As UIElement)
  114. AddHandler element.MouseLeftButtonDown, AddressOf Me.element_MouseLeftButtonDown
  115. End Sub
  116. Public Sub addResizerRight(element As UIElement)
  117. Me.connectMouseHandlers(element)
  118. Me.rightElements.Add(element, 0)
  119. End Sub
  120. Public Sub addResizerLeft(element As UIElement)
  121. Me.connectMouseHandlers(element)
  122. Me.leftElements.Add(element, 0)
  123. End Sub
  124. Public Sub addResizerUp(element As UIElement)
  125. Me.connectMouseHandlers(element)
  126. Me.upElements.Add(element, 0)
  127. End Sub
  128. Public Sub addResizerDown(element As UIElement)
  129. Me.connectMouseHandlers(element)
  130. Me.downElements.Add(element, 0)
  131. End Sub
  132. Public Sub addResizerRightDown(element As UIElement)
  133. Me.connectMouseHandlers(element)
  134. Me.rightElements.Add(element, 0)
  135. Me.downElements.Add(element, 0)
  136. End Sub
  137. Public Sub addResizerLeftDown(element As UIElement)
  138. Me.connectMouseHandlers(element)
  139. Me.leftElements.Add(element, 0)
  140. Me.downElements.Add(element, 0)
  141. End Sub
  142. Public Sub addResizerRightUp(element As UIElement)
  143. Me.connectMouseHandlers(element)
  144. Me.rightElements.Add(element, 0)
  145. Me.upElements.Add(element, 0)
  146. End Sub
  147. Public Sub addResizerLeftUp(element As UIElement)
  148. Me.connectMouseHandlers(element)
  149. Me.leftElements.Add(element, 0)
  150. Me.upElements.Add(element, 0)
  151. End Sub
  152. Private Sub element_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs)
  153. GetCursorPos(startMousePoint)
  154. startMousePoint.X = GetWPFSize(startMousePoint.X)
  155. startMousePoint.Y = GetWPFSize(startMousePoint.Y)
  156. startWindowSize = New Size(target.Width, target.Height)
  157. startWindowLeftUpPoint = New POINT(target.Left, target.Top)
  158. Dim key As UIElement = CType(sender, UIElement)
  159. If leftElements.ContainsKey(key) Then resizeLeft = True
  160. If rightElements.ContainsKey(key) Then resizeRight = True
  161. If upElements.ContainsKey(key) Then resizeUp = True
  162. If downElements.ContainsKey(key) Then resizeDown = True
  163. RunInNewThread(AddressOf updateSizeLoop, "窗口大小调整检测")
  164. End Sub
  165. Private Sub updateSizeLoop()
  166. Try
  167. While resizeDown OrElse resizeLeft OrElse resizeRight OrElse resizeUp
  168. target.Dispatcher.Invoke(AddressOf updateSize, DispatcherPriority.Render)
  169. target.Dispatcher.Invoke(AddressOf updateMouseDown, DispatcherPriority.Render)
  170. Thread.Sleep(0)
  171. End While
  172. Catch
  173. End Try
  174. End Sub
  175. Private Sub updateSize()
  176. Dim pointAPI As PointAPI = Nothing
  177. GetCursorPos(pointAPI)
  178. pointAPI.X = GetWPFSize(pointAPI.X)
  179. pointAPI.Y = GetWPFSize(pointAPI.Y)
  180. Try
  181. Dim NewWidth As Double = -1
  182. Dim NewHeight As Double = -1
  183. Dim NewLeft As Double = -10000
  184. Dim NewTop As Double = -10000
  185. If resizeRight Then
  186. If target.Width = target.MinWidth Then
  187. If startMousePoint.X < pointAPI.X Then
  188. NewWidth = startWindowSize.Width - (startMousePoint.X - pointAPI.X)
  189. End If
  190. Else
  191. If startWindowSize.Width - ((startMousePoint.X - pointAPI.X)) >= target.MinWidth Then
  192. NewWidth = startWindowSize.Width - (startMousePoint.X - pointAPI.X)
  193. Else
  194. NewWidth = target.MinWidth
  195. End If
  196. End If
  197. End If
  198. If resizeDown Then
  199. If target.Height = target.MinHeight Then
  200. If startMousePoint.Y < pointAPI.Y Then
  201. If workAreaMaxHeight > 0 Then
  202. NewHeight = If((startWindowSize.Height - (startMousePoint.Y - pointAPI.Y) + target.Top <= workAreaMaxHeight), (startWindowSize.Height - ((startMousePoint.Y - pointAPI.Y))), ((workAreaMaxHeight) - target.Top))
  203. Else
  204. NewHeight = startWindowSize.Height - (startMousePoint.Y - pointAPI.Y)
  205. End If
  206. End If
  207. Else
  208. If startWindowSize.Height - (startMousePoint.Y - pointAPI.Y) >= target.MinHeight Then
  209. If workAreaMaxHeight > 0 Then
  210. NewHeight = If((startWindowSize.Height - (startMousePoint.Y - pointAPI.Y) + target.Top <= (workAreaMaxHeight)), (startWindowSize.Height - (startMousePoint.Y - pointAPI.Y)), ((workAreaMaxHeight) - target.Top))
  211. Else
  212. NewHeight = startWindowSize.Height - (startMousePoint.Y - pointAPI.Y)
  213. End If
  214. Else
  215. NewHeight = target.MinHeight
  216. End If
  217. End If
  218. End If
  219. If resizeLeft Then
  220. If target.Width = target.MinWidth Then
  221. If startMousePoint.X > pointAPI.X Then
  222. NewWidth = startWindowSize.Width + startMousePoint.X - pointAPI.X
  223. NewLeft = startWindowLeftUpPoint.x - (startMousePoint.X - pointAPI.X)
  224. Else
  225. NewWidth = target.MinWidth
  226. NewLeft = startWindowLeftUpPoint.x + startWindowSize.Width - target.Width
  227. End If
  228. Else
  229. If startWindowSize.Width + (startMousePoint.X - pointAPI.X) >= target.MinWidth Then
  230. NewWidth = startWindowSize.Width + (startMousePoint.X - pointAPI.X)
  231. NewLeft = startWindowLeftUpPoint.x - (startMousePoint.X - pointAPI.X)
  232. Else
  233. NewWidth = target.MinWidth
  234. NewLeft = startWindowLeftUpPoint.x + startWindowSize.Width - target.Width
  235. End If
  236. End If
  237. End If
  238. If resizeUp Then
  239. If target.Height = target.MinHeight Then
  240. If startMousePoint.Y > pointAPI.Y Then
  241. NewHeight = startWindowSize.Height + startMousePoint.Y - pointAPI.Y
  242. NewTop = startWindowLeftUpPoint.y - (startMousePoint.Y - pointAPI.Y)
  243. Else
  244. NewHeight = target.MinHeight
  245. NewTop = startWindowLeftUpPoint.y + startWindowSize.Height - target.Height
  246. End If
  247. Else
  248. If startWindowSize.Height + (startMousePoint.Y - pointAPI.Y) >= target.MinHeight Then
  249. NewHeight = startWindowSize.Height + startMousePoint.Y - pointAPI.Y
  250. NewTop = startWindowLeftUpPoint.y - (startMousePoint.Y - pointAPI.Y)
  251. Else
  252. NewHeight = target.MinHeight
  253. NewTop = startWindowLeftUpPoint.y + startWindowSize.Height - target.Height
  254. End If
  255. End If
  256. End If
  257. If NewWidth > 10 AndAlso Math.Abs(NewWidth - target.Width) > 0.7 Then target.Width = NewWidth
  258. If NewHeight > 10 AndAlso Math.Abs(NewHeight - target.Height) > 0.7 Then target.Height = NewHeight
  259. If NewLeft > -9999 AndAlso Math.Abs(NewLeft - target.Left) > 0.7 Then target.Left = NewLeft
  260. If NewTop > -9999 AndAlso Math.Abs(NewTop - target.Top) > 0.7 Then target.Top = NewTop
  261. Catch
  262. End Try
  263. End Sub
  264. Private Sub updateMouseDown()
  265. Dim flag = (GetAsyncKeyState(&H1) And &H8000) = 0 '调用原生API判断鼠标是否抬起,如果使用WPF的API的话鼠标不在窗口上时不会更新状态 (#5655)
  266. If flag Then
  267. resizeRight = False
  268. resizeLeft = False
  269. resizeUp = False
  270. resizeDown = False
  271. End If
  272. End Sub
  273. Private Declare Function GetCursorPos Lib "user32.dll" (<Out()> ByRef lpPoint As PointAPI) As Boolean
  274. Private Declare Function GetAsyncKeyState Lib "user32.dll" (vKey As Integer) As Short
  275. End Class