| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1525 人关注过本帖
标题:如何实现用鼠标的滚轮改变窗体的大小
只看楼主 加入收藏
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
结帖率:94.12%
收藏
 问题点数:0 回复次数:5 
如何实现用鼠标的滚轮改变窗体的大小

下面是一个窗体内的控件,能随窗体大小变化而变化的代码,
不足的是,只能通过拖动窗体的边或角来改变窗体的大小.
哪位高手能提供用鼠标滚轮能改变这窗体的大小而不用去拖动窗体的边角了?
(要求是当鼠标移到该窗体内时,就可以实现上述功能)
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

搜索更多相关主题的帖子: 鼠标 滚轮 窗体 
2007-08-12 10:19
multiple1902
Rank: 8Rank: 8
等 级:贵宾
威 望:42
帖 子:4881
专家分:671
注 册:2007-2-9
收藏
得分:0 

用钩子捕捉MouseWheel事件。

2007-08-12 10:25
multiple1902
Rank: 8Rank: 8
等 级:贵宾
威 望:42
帖 子:4881
专家分:671
注 册:2007-2-9
收藏
得分:0 
你去mndsoft找一下一个VB6的代码窗口鼠标滚轮增强 也许可以解决你的问题
2007-08-12 10:26
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 

谢谢,已解决:
控件也按照比例缩放
======窗口代码======
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
End If
Case Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, _
uMsg, wParam, lParam)
End Select
End Function

Public Function HiWord(LongIn As Long) As Integer
HiWord = (LongIn And &HFFFF0000) \ &H10000
End Function

Public Function LoWord(LongIn As Long) As Integer
LoWord = LongIn And &HFFFF&
End Function

2007-08-12 21:32
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
上面的方法,操作鼠标的滚轮可以固定比例地同时放大和缩小窗体及内部的控件,但如果用鼠标去拖窗体的边角来放大和缩小又无法保证窗体内的控件的固定比例了,看来鱼和熊掌无法同得啊
2007-08-12 21:37
jxyga111
Rank: 8Rank: 8
来 自:中華人民共和國
等 级:贵宾
威 望:33
帖 子:6015
专家分:895
注 册:2008-3-21
收藏
得分:0 
mndsoft
这个是什么意思
2008-06-14 11:48
快速回复:如何实现用鼠标的滚轮改变窗体的大小
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.037995 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved