怎么实现用鼠标的滚轮改变窗体的大小(高分)
如何实现用鼠标的滚轮改变窗体的大小(高分求助)
下面是一个窗体内的控件,能随窗体大小变化而变化的代码,
不足的是,只能通过拖动窗体的边或角来改变窗体的大小.
哪位高手能提供用鼠标滚轮能改变这窗体的大小而不用去拖动窗体的边角了?
(要求是当鼠标移到该窗体内时,就可以实现上述功能)
Private Sub Form_Load()
form1.Height = Screen.Height / 3
form1.Width = Screen.Width / 5
End Sub
Private Sub Form_Resize()
Image1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
------解决方案--------------------
在Form_Resize中改变控件大小
------解决方案--------------------
控件也按照比例缩放
======窗口代码======
Option Explicit
Private Sub Form_Load()
FormOldWidth = Me.ScaleWidth
FormOldHeight = Me.ScaleHeight
Dim Obj As Control 'Control是一个对象,表示所有 Visual Basic 内部控件的类名
For Each Obj In Me
'Tag返回或设置一个表达式用来存储程序中需要的额外数据。
Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
Next Obj
dSize = 300 '单位 Me.ScaleMode
Hook Me.hWnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnHook Me.hWnd
End Sub
Private Sub Form_Resize()
Dim Pos
Dim Obj As Control
Dim ScaleX As Double
Dim ScaleY As Double
ScaleX = Me.ScaleWidth / FormOldWidth
ScaleY = Me.ScaleHeight / FormOldHeight
For Each Obj In Me
Pos = Split(Obj.Tag, " ")
If IsArray(Pos) Then _
Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
Next Obj
End Sub
=======模块代码========
Option Explicit
Declare Function CallWindowProc _
Lib "USER32 " Alias "CallWindowProcA " _
(ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Declare Function SetWindowLong _
Lib "USER32 " Alias "SetWindowLongA " _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function SystemParametersInfo _
Lib "USER32 " Alias "SystemParametersInfoA " _
(ByVal uAction As Long, _
ByVal uParam As Long, _
lpvParam As Any, _
ByVal fuWinIni As Long) As Long
Public Const GWL_WNDPROC = -4
Public Const WM_MOUSEWHEEL = &H20A
Global lpPrevWndProc As Long
Global FormOldWidth As Long
Global FormOldHeight As Long
Global dSize As Long
Public Sub Hook(ByVal hWnd As Long)
lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, _
AddressOf WindowProc)
End Sub
Public Sub UnHook(ByVal hWnd As Long)
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(hWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub
Function WindowProc(ByVal hw As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Select Case uMsg
Case WM_MOUSEWHEEL
Dim wzDelta As Integer, wKeys As Integer
wzDelta = HiWord(wParam)
wKeys = LoWord(wParam)
If wParam < 0 Then
Form1.Width = Form1.Width + dSize
Form1.Height = Form1.Height + dSize * FormOldHeight / FormOldWidth
Else
Form1.Width = Form1.Width - dSize
Form1.Height = Form1.Height - dSize * FormOldHeight / FormOldWidth
下面是一个窗体内的控件,能随窗体大小变化而变化的代码,
不足的是,只能通过拖动窗体的边或角来改变窗体的大小.
哪位高手能提供用鼠标滚轮能改变这窗体的大小而不用去拖动窗体的边角了?
(要求是当鼠标移到该窗体内时,就可以实现上述功能)
Private Sub Form_Load()
form1.Height = Screen.Height / 3
form1.Width = Screen.Width / 5
End Sub
Private Sub Form_Resize()
Image1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
------解决方案--------------------
在Form_Resize中改变控件大小
------解决方案--------------------
控件也按照比例缩放
======窗口代码======
Option Explicit
Private Sub Form_Load()
FormOldWidth = Me.ScaleWidth
FormOldHeight = Me.ScaleHeight
Dim Obj As Control 'Control是一个对象,表示所有 Visual Basic 内部控件的类名
For Each Obj In Me
'Tag返回或设置一个表达式用来存储程序中需要的额外数据。
Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
Next Obj
dSize = 300 '单位 Me.ScaleMode
Hook Me.hWnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnHook Me.hWnd
End Sub
Private Sub Form_Resize()
Dim Pos
Dim Obj As Control
Dim ScaleX As Double
Dim ScaleY As Double
ScaleX = Me.ScaleWidth / FormOldWidth
ScaleY = Me.ScaleHeight / FormOldHeight
For Each Obj In Me
Pos = Split(Obj.Tag, " ")
If IsArray(Pos) Then _
Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
Next Obj
End Sub
=======模块代码========
Option Explicit
Declare Function CallWindowProc _
Lib "USER32 " Alias "CallWindowProcA " _
(ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Declare Function SetWindowLong _
Lib "USER32 " Alias "SetWindowLongA " _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function SystemParametersInfo _
Lib "USER32 " Alias "SystemParametersInfoA " _
(ByVal uAction As Long, _
ByVal uParam As Long, _
lpvParam As Any, _
ByVal fuWinIni As Long) As Long
Public Const GWL_WNDPROC = -4
Public Const WM_MOUSEWHEEL = &H20A
Global lpPrevWndProc As Long
Global FormOldWidth As Long
Global FormOldHeight As Long
Global dSize As Long
Public Sub Hook(ByVal hWnd As Long)
lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, _
AddressOf WindowProc)
End Sub
Public Sub UnHook(ByVal hWnd As Long)
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(hWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub
Function WindowProc(ByVal hw As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Select Case uMsg
Case WM_MOUSEWHEEL
Dim wzDelta As Integer, wKeys As Integer
wzDelta = HiWord(wParam)
wKeys = LoWord(wParam)
If wParam < 0 Then
Form1.Width = Form1.Width + dSize
Form1.Height = Form1.Height + dSize * FormOldHeight / FormOldWidth
Else
Form1.Width = Form1.Width - dSize
Form1.Height = Form1.Height - dSize * FormOldHeight / FormOldWidth