jrs123 发表于 2007-8-12 10:19

如何实现用鼠标的滚轮改变窗体的大小

<P>下面是一个窗体内的控件,能随窗体大小变化而变化的代码,<BR>不足的是,只能通过拖动窗体的边或角来改变窗体的大小.<BR>哪位高手能提供用鼠标滚轮能改变这窗体的大小而不用去拖动窗体的边角了?<BR>(要求是当鼠标移到该窗体内时,就可以实现上述功能)<BR>Private Sub Form_Load()<BR>  form1.Height = Screen.Height / 3<BR>  form1.Width = Screen.Width / 5<BR>End Sub</P>
<P>Private Sub Form_Resize()<BR>  Image1.Move 0, 0, ScaleWidth, ScaleHeight<BR>End Sub<BR></P>

multiple1902 发表于 2007-8-12 10:25

<P>用钩子捕捉MouseWheel事件。</P>

multiple1902 发表于 2007-8-12 10:26

你去mndsoft找一下一个VB6的代码窗口鼠标滚轮增强 也许可以解决你的问题

jrs123 发表于 2007-8-12 21:32

<P>谢谢,已解决:<BR>控件也按照比例缩放<BR>======窗口代码======<BR>Option Explicit</P>
<P>Private Sub Form_Load()<BR>    FormOldWidth = Me.ScaleWidth<BR>    FormOldHeight = Me.ScaleHeight<BR>    <BR>    Dim Obj As Control  'Control是一个对象，表示所有 Visual Basic 内部控件的类名<BR>    For Each Obj In Me<BR>      'Tag返回或设置一个表达式用来存储程序中需要的额外数据。<BR>      Obj.Tag = Obj.Left &amp; " " &amp; Obj.Top &amp; " " &amp; Obj.Width &amp; " " &amp; Obj.Height &amp; " "<BR>    Next Obj<BR>    <BR>    dSize = 300 '单位 Me.ScaleMode<BR>    <BR>    Hook Me.hWnd<BR>End Sub</P>
<P>Private Sub Form_Unload(Cancel As Integer)<BR>    UnHook Me.hWnd<BR>End Sub</P>
<P>Private Sub Form_Resize()<BR>    Dim Pos<BR>    Dim Obj As Control<BR>    Dim ScaleX As Double<BR>    Dim ScaleY As Double<BR>    ScaleX = Me.ScaleWidth / FormOldWidth<BR>    ScaleY = Me.ScaleHeight / FormOldHeight<BR>    For Each Obj In Me<BR>        Pos = Split(Obj.Tag, " ")<BR>        If IsArray(Pos) Then _<BR>            Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY<BR>    Next Obj<BR>End Sub</P>
<P>=======模块代码========<BR>Option Explicit</P>
<P>Declare Function CallWindowProc _<BR>Lib "USER32" Alias "CallWindowProcA" _<BR>(ByVal lpPrevWndFunc As Long, _<BR>ByVal hWnd As Long, _<BR>ByVal Msg As Long, _<BR>ByVal wParam As Long, _<BR>ByVal lParam As Long) As Long</P>
<P>Declare Function SetWindowLong _<BR>Lib "USER32" Alias "SetWindowLongA" _<BR>(ByVal hWnd As Long, _<BR>ByVal nIndex As Long, _<BR>ByVal dwNewLong As Long) As Long</P>
<P>Declare Function SystemParametersInfo _<BR>Lib "USER32" Alias "SystemParametersInfoA" _<BR>(ByVal uAction As Long, _<BR>ByVal uParam As Long, _<BR>lpvParam As Any, _<BR>ByVal fuWinIni As Long) As Long</P>
<P><BR>Public Const GWL_WNDPROC = -4<BR>Public Const WM_MOUSEWHEEL = &amp;H20A</P>
<P>Global lpPrevWndProc As Long<BR>Global FormOldWidth As Long<BR>Global FormOldHeight As Long<BR>Global dSize As Long</P>
<P>Public Sub Hook(ByVal hWnd As Long)<BR>lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, _<BR>AddressOf WindowProc)<BR>End Sub</P>
<P>Public Sub UnHook(ByVal hWnd As Long)<BR>Dim lngReturnValue As Long<BR>lngReturnValue = SetWindowLong(hWnd, GWL_WNDPROC, lpPrevWndProc)<BR>End Sub</P>
<P>Function WindowProc(ByVal hw As Long, _<BR>ByVal uMsg As Long, _<BR>ByVal wParam As Long, _<BR>ByVal lParam As Long) As Long</P>
<P>    Select Case uMsg<BR>        Case WM_MOUSEWHEEL<BR>            Dim wzDelta As Integer, wKeys As Integer<BR>            wzDelta = HiWord(wParam)<BR>            wKeys = LoWord(wParam)<BR>            If wParam &lt; 0 Then<BR>                Form1.Width = Form1.Width + dSize<BR>                Form1.Height = Form1.Height + dSize * FormOldHeight / FormOldWidth<BR>            Else<BR>                Form1.Width = Form1.Width - dSize<BR>                Form1.Height = Form1.Height - dSize * FormOldHeight / FormOldWidth<BR>            End If<BR>        Case Else<BR>            WindowProc = CallWindowProc(lpPrevWndProc, hw, _<BR>            uMsg, wParam, lParam)<BR>    End Select<BR>End Function</P>
<P>Public Function HiWord(LongIn As Long) As Integer<BR>    HiWord = (LongIn And &amp;HFFFF0000) \ &amp;H10000<BR>End Function</P>
<P>Public Function LoWord(LongIn As Long) As Integer<BR>    LoWord = LongIn And &amp;HFFFF&amp;<BR>End Function</P>

jrs123 发表于 2007-8-12 21:37

上面的方法,操作鼠标的滚轮可以固定比例地同时放大和缩小窗体及内部的控件,但如果用鼠标去拖窗体的边角来放大和缩小又无法保证窗体内的控件的固定比例了,看来鱼和熊掌无法同得啊

jxyga111 发表于 2008-6-14 11:48

mndsoft
这个是什么意思

页: [1]

编程论坛