| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1249 人关注过本帖
标题:《奥运邮集》软件的滚动条——“抛砖引玉篇”(之一)
只看楼主 加入收藏
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
结帖率:94.12%
收藏
 问题点数:0 回复次数:6 
《奥运邮集》软件的滚动条——“抛砖引玉篇”(之一)
将偶《奥运邮集》“滚动条”代码在此发帖,抛砖引玉,希望看到更好更简捷的方案!
条件:在窗体上放一个高32000,宽15200的Frame控件,再从工具箱拖放水平与垂直二个滚动条,各属性设置如图所示:(图内的红色所示数据是经过一番调试后得出的);
垂直滚动条VScrollBar——(1)滚动条的高(2)鼠标点击空白区时滚动条移动快慢值(见滚动条示例图)(3)与窗体左边缘距离(4)移动最大值(5)鼠标点击两端黑三角箭头,滚动条移动快慢值(见滚动条示例图)(6)与窗体顶端距离(7)滚动条的宽
水平滚动条HScrollBar——(1)滚动条的垂直方向的高(即条宽)(2)鼠标点击空白区时滚动条移动快慢值(见滚动条示例图)(3)与窗体左边缘距离(4)移动最大值(5)鼠标点击两端黑三角箭头,滚动条移动快慢值(见滚动条示例图)(6)与窗体顶端距离(7)滚动条的总宽度(长度)

垂直滚动条属性设置.jpg (22.37 KB)
图片附件: 游客没有浏览图片的权限,请 登录注册


水平滚动条属性设置.jpg (21.86 KB)
图片附件: 游客没有浏览图片的权限,请 登录注册


滚动条XJ8.jpg (128.84 KB)
图片附件: 游客没有浏览图片的权限,请 登录注册
搜索更多相关主题的帖子: 奥运邮集 软件 抛砖引玉 滚动 
2008-04-06 12:03
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
期望您提供更好的滚动条代码和对本组代码的注释
制作滚动条除了对属性的设置之外,还要一组代码和一个模块。下面是放在窗体上的有关代码:
偶是知其然,不知其所以然。所以希望各位高手能对下面的代码进行注释,让大家多学点
Private Sub Form_Load()
    Hook Me.hWnd
    If WindowState = 0 Then
    End If
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
    For Each pForm In Forms
        Unload pForm
    Next
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
2008-04-06 12:14
论坛元老
Rank: 1
等 级:新手上路
帖 子:812
专家分:0
注 册:2008-3-31
收藏
得分:0 
学习了

怎么不可以用Discuz代码呢!
2008-04-06 23:06
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
完整的"滚动条"方案,除了上面的程序外,还要加一个模块,代码如下:
补充一点:该“滚动条”方案还必需实现用鼠标滚轮对超长页面进行上下移动。
目前偶发现该模块的一个不足之处,就是每增加一个超长页面都要相应的增加三组代码,一但页面增加多时,软件运行的速度就会很慢。也许这是VB6又一个不可优化的缺陷。
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
clare 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 > xj1.VScroll1.Max Then
        WHEEL_SCROLL_LINES = xj1.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 xj1.VScroll1.Value <= xj1.VScroll1.Max - 1000 Then '其中-1000是用鼠标滚轮移动页面时速度快慢的调整,可取300-1000
                    xj1.VScroll1.Value = xj1.VScroll1.Value + 1000
                Else
                    xj1.VScroll1.Value = xj1.VScroll1.Max
                End If
            ElseIf wParam = 7864320 Then
                If xj1.VScroll1.Value >= 1000 Then
                    xj1.VScroll1.Value = xj1.VScroll1.Value - 1000
                Else
                    xj1.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
2008-04-10 18:51
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
谁能优化一下这组代码
每个需要设置滚动条的窗体,如xj1、xj2、xj3......都要重复下面一组代码(每组代码窗体名有12处)。窗体数量多了,就占用大量的资源,所以工程内窗体越多,软件启动速度越慢。是否有更好的更简便的方案,希望能有高手优化一下这个方案:
要求是:窗体上设有滚动条,且鼠标滚轮也可以移动窗体内的页面上下移动。
    If WHEEL_SCROLL_LINES > xj1.VScroll1.Max Then
        WHEEL_SCROLL_LINES = xj1.VScroll1.Max
    End If
    If wParam = -7864320 Then
                If xj1.VScroll1.Value <= xj1.VScroll1.Max - 1000 Then
                   xj1.VScroll1.Value = xj1.VScroll1.Value + 1000
                Else
                    xj1.VScroll1.Value = xj1.VScroll1.Max
                End If
            ElseIf wParam = 7864320 Then
                If xj1.VScroll1.Value >= 1000 Then
                    xj1.VScroll1.Value = xj1.VScroll1.Value - 1000
                Else
                    xj1.VScroll1.Value = 0
                End If
            End If
2008-04-18 08:50
aa956742
Rank: 1
等 级:新手上路
帖 子:4
专家分:0
注 册:2008-4-16
收藏
得分:0 
不错哦,谢谢分享!
2008-04-18 19:58
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
希望有更好的方案在此发帖
2008-05-22 13:51
快速回复:《奥运邮集》软件的滚动条——“抛砖引玉篇”(之一)
数据加载中...
 
   



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

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