当前位置:我的异常网» VB » 给VB窗体加滚动条是否有新的办法解决思路

给VB窗体加滚动条是否有新的办法解决思路

www.myexceptions.net  网友分享于：2013-01-08  浏览：30次

给VB窗体加滚动条是否有新的办法

程序所有窗体已设计好了，用加图片的方法实现似乎已很困难，请问大家是否有什么新的办法？谢谢

------解决方案--------------------

加滚动条本身很容易，一两句代码就可以实现，关键是我们加的滚动条要能响应事件，所以没什么简单的办法

------解决方案--------------------

偶现在用的也是关于图片的超长窗体,楼主可试试下面方法:

先在窗体上拖一个双屏幕长的frame1框(你的所有内容都可以在这上面拖出),高18000;宽15085;(窗体的属性Scalemode取1-Twip)

然后拖水平与垂直的两个滚动条;(注意:要在窗体上拖出)

Vscrloo1(竖滚动条)属性:LargeChange=20000,Max=11055

HScroll1(横)属性:LargeChange=8000;Max=1000;Top=18000;Width=14040

上面是偶的选用参数,你也可自选;

建立一个模块:下面代码放进去

Option Explicit

Public Type POINTL

x As Long

y As Long

End Type

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

Declare Function ScreenToClient Lib "user32 " _

(ByVal hwnd As Long, xyPoint As POINTL) As Long

Public Const GWL_WNDPROC = -4

Public Const SPI_GETWHEELSCROLLLINES = 104

Public Const WM_MOUSEWHEEL = &H20A

Public WHEEL_SCROLL_LINES As Long

Global lpPrevWndProc As Long

Public Sub Hook(ByVal hwnd As Long)

lpPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)

Call SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, WHEEL_SCROLL_LINES, 0)

If WHEEL_SCROLL_LINES > Form1.VScroll1.Max Then

WHEEL_SCROLL_LINES = Form1.VScroll1.Max

End If

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

Dim pt As POINTL

Select Case uMsg

Case WM_MOUSEWHEEL

If wParam = -7864320 Then

If Form1.VScroll1.Value <= Form1.VScroll1.Max - 300 Then '4个300值可调鼠标滚轮移动屏幕的速度,可取300-1000(值越大,移动速度越快)

Form1.VScroll1.Value = Form1.VScroll1.Value + 300

Else

Form1.VScroll1.Value = Form1.VScroll1.Max

End If

ElseIf wParam = 7864320 Then

If Form1.VScroll1.Value > = 300 Then

Form1.VScroll1.Value = Form1.VScroll1.Value - 300

Else

Form1.VScroll1.Value = 0

End If

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

下面代码放在窗体中:

Private Sub Form_Load()

Hook Me.hwnd

End Sub

Private Sub Form_Resize()

If Frame1.Height > Me.Height Then

VScroll1.Visible = True

Else

VScroll1.Visible = False

文章评论