| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1011 人关注过本帖
标题:[求助]如何产生类似网页中的滚动条效果
只看楼主 加入收藏
桃源书生
Rank: 1
等 级:新手上路
帖 子:99
专家分:3
注 册:2006-7-3
结帖率:33.33%
收藏
 问题点数:0 回复次数:9 
[求助]如何产生类似网页中的滚动条效果
因为窗体空间有限,有些控件放不下了,请问能不能使用滚动条,产生类似网页中滚动条的效果,使窗体空间增加?谢谢!
搜索更多相关主题的帖子: 网页中 效果 滚动 空间 窗体 
2006-11-27 10:28
flyly
Rank: 1
等 级:新手上路
帖 子:254
专家分:0
注 册:2006-11-13
收藏
得分:0 
簡單,用資源加進去

2006-11-27 10:43
桃源书生
Rank: 1
等 级:新手上路
帖 子:99
专家分:3
注 册:2006-7-3
收藏
得分:0 

我是菜鸟,不知道“资源”指什么?如何添加进去?请详细指教,谢谢!

2006-11-27 11:11
xkd_0405
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2006-11-25
收藏
得分:0 
我也想问这个问题,我也碰到了这样的问题
2006-11-27 14:40
flyly
Rank: 1
等 级:新手上路
帖 子:254
专家分:0
注 册:2006-11-13
收藏
得分:0 
這個方法類似于一些黑客軟件,比如一些遠程控制的程序,有客戶端生成服務端一樣,

2006-11-27 14:45
桃源书生
Rank: 1
等 级:新手上路
帖 子:99
专家分:3
注 册:2006-7-3
收藏
得分:0 
因为VB中的窗体最大为11500X15360,控件多的话就放不下了,不知道能不能把这个范围变大一些?
2006-11-27 15:11
flyly
Rank: 1
等 级:新手上路
帖 子:254
专家分:0
注 册:2006-11-13
收藏
得分:0 
靠,你做的是什麽阿?馬蜂窩阿?

2006-11-27 15:13
桃源书生
Rank: 1
等 级:新手上路
帖 子:99
专家分:3
注 册:2006-7-3
收藏
得分:0 
以下是引用flyly在2006-11-27 15:13:46的发言:
靠,你做的是什麽阿?馬蜂窩阿?

难道真的解决不了了?

2006-11-27 15:37
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 

下面是偶正在用的实现滚动条,并可以用鼠标滚轮移动屏幕,很好用的:
放在模块中:
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 - 100 Then
Form1.VScroll1.Value = Form1.VScroll1.Value + 100
Else
Form1.VScroll1.Value = Form1.VScroll1.Max
End If
ElseIf wParam = 7864320 Then
If Form1.VScroll1.Value >= 100 Then
Form1.VScroll1.Value = Form1.VScroll1.Value - 100
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
End If
If Frame1.Width > Me.Width Then
HScroll1.Visible = True
Else
HScroll1.Visible = False
End If
HScroll1.Left = 0
HScroll1.Top = Me.ScaleHeight - HScroll1.Height
VScroll1.Left = Me.ScaleWidth - VScroll1.Width
VScroll1.Top = 0
HScroll1.Width = Me.ScaleWidth
VScroll1.Height = Me.ScaleHeight
If VScroll1.Visible = True Then
If HScroll1.Visible = True Then
HScroll1.Width = Abs(Me.ScaleWidth - VScroll1.Width)
VScroll1.Height = Abs(Me.ScaleHeight - HScroll1.Height)
End If
End If
HScroll1.Max = (Frame1.Width - Me.Width) + 3 * VScroll1.Width
VScroll1.Max = (Frame1.Height - Me.Height) + 3 * HScroll1.Height
HScroll1.ZOrder
VScroll1.ZOrder
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnHook Me.hwnd
End Sub
Private Sub HScroll1_Change()
Frame1.Left = -HScroll1.Value
End Sub
Private Sub VScroll1_Change()
Frame1.Top = -VScroll1.Value
End Sub
Private Sub VScroll1_GotFocus() '此段可防止滚动条闪烁,借用一个按钮控件
Command1.SetFocus
End Sub

2006-11-28 19:42
快速回复:[求助]如何产生类似网页中的滚动条效果
数据加载中...
 
   



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

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