你好，我想问一个问题，scrollwindow()是怎么用的？
我在vb6下想自己做个带滚动条的窗口，我把 windows程序设计 那本书的一段代码改成vb语法，结果我的那段程序滚动条滚动时不能刷新窗口，我检查一下发现，在收到wm_vscroll 消息后，执行scrollwindow（），updatewindow（），时，没有发送wm_paint 消息，看了2 天也没看明白，实在搞不懂了，在c编译的程序是没问题的，为何在vb下不行，请不吝赐教！
以下为代码：
Option Explicit
'' Win32 Constants
Public Const CS_BYTEALIGNCLIENT = &H1000
Public Const CS_BYTEALIGNWINDOW = &H2000
Public Const CS_CLASSDC = &H40
Public Const CS_DBLCLKS = &H8
Public Const CS_HREDRAW = &H2
Public Const CS_INSERTCHAR = &H2000
Public Const CS_KEYCVTWINDOW = &H4
Public Const CS_NOCLOSE = &H200
Public Const CS_NOKEYCVT = &H100
Public Const CS_NOMOVECARET = &H4000
Public Const CS_OWNDC = &H20
Public Const CS_PARENTDC = &H80
Public Const CS_PUBLICCLASS = &H4000
Public Const CS_SAVEBITS = &H800
Public Const CS_VREDRAW = &H1
Public Const WS_BORDER = &H800000
Public Const WS_CAPTION = &HC00000
Public Const WS_CHILD = &H40000000
Public Const WS_CLIPCHILDREN = &H2000000
Public Const WS_CLIPSIBLINGS = &H4000000
Public Const WS_DISABLED = &H8000000
Public Const WS_DLGFRAME = &H400000
Public Const WS_GROUP = &H20000
Public Const WS_HSCROLL = &H100000
Public Const WS_MAXIMIZE = &H1000000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_MINIMIZE = &H20000000
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_OVERLAPPED = &H0&
Public Const WS_POPUP = &H80000000
Public Const WS_SYSMENU = &H80000
Public Const WS_TABSTOP = &H10000
Public Const WS_THICKFRAME = &H40000
Public Const WS_VISIBLE = &H10000000
Public Const WS_VSCROLL = &H200000
Public Const WS_CHILDWINDOW = (WS_CHILD)
Public Const WS_ICONIC = WS_MINIMIZE
Public Const WS_SIZEBOX = WS_THICKFRAME
Public Const WS_POPUPWINDOW = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
Public Const WS_TILED = WS_OVERLAPPED
Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
Public Const WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW
Public Const WS_EX_ACCEPTFILES = &H10&
Public Const WS_EX_DLGMODALFRAME = &H1&
Public Const WS_EX_NOPARENTNOTIFY = &H4&
Public Const WS_EX_TOPMOST = &H8&
Public Const WS_EX_TRANSPARENT = &H20&
Public Const WM_ACTIVATE = &H6
Public Const WM_CLOSE = &H10
Public Const WM_CREATE = &H1
Public Const WM_DESTROY = &H2
Public Const WM_ENABLE = &HA
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONDBLCLK = &H209
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MOUSEACTIVATE = &H21
Public Const WM_MOUSEFIRST = &H200
Public Const WM_MOUSELAST = &H209
Public Const WM_MOUSEMOVE = &H200
Public Const WM_MOVE = &H3
Public Const WM_NULL = &H0
Public Const WM_PAINT = &HF
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_SHOWWINDOW = &H18
Public Const WM_SIZE = &H5
Public Const WM_QUIT = &H12
Public Const WM_VSCROLL As Long = &H115
Public Const WM_HSCROLL As Long = &H114
Public Const SW_NORMAL As Long = 1
Public Const IDC_ARROW As Long = 32512&
Public Const IDI_APPLICATION = 32512&
Public Const WHITE_BRUSH = 0
Public Const TA_LEFT = 0
Public Const TA_TOP = 0
Public Const TA_BOTTOM = 8
Public Const TA_CENTER = 6
Public Const GWL_EXSTYLE = (-20)
Public Const GWL_STYLE = (-16)
Public Const GWL_WNDPROC = (-4)
Public Const COLOR_WINDOW As Long = 5
Public Const SB_VERT As Long = 1
Public Const SB_HORZ As Long = 0
Public Const SB_LINELEFT As Long = 0
Public Const SB_LINERIGHT As Long = 1
Public Const SB_PAGELEFT As Long = 2
Public Const SB_PAGERIGHT As Long = 3
Public Const SB_THUMBTRACK As Long = 5
Public Const SB_LEFT As Long = 6
Public Const SB_RIGHT As Long = 7
Public Const SB_LINEUP As Long = 0
Public Const SB_LINEDOWN As Long = 1
Public Const SB_PAGEUP As Long = 2
Public Const SB_PAGEDOWN As Long = 3
Public Const SB_TOP As Long = 6
Public Const SB_BOTTOM As Long = 7
Public Const SIF_RANGE = &H1
Public Const SIF_PAGE = &H2
Public Const SIF_POS = &H4
Public Const SIF_DISABLENOSCROLL = &H8
Public Const SIF_TRACKPOS = &H10
Public Const SIF_ALL = (SIF_RANGE Or SIF_PAGE Or SIF_POS Or SIF_TRACKPOS)
Public Const CW_USEDEFAULT = &H80000000
'' Win32 Structs
Public Type TEXTMETRIC
tmHeight As Long
tmAscent As Long
tmDescent As Long
tmInternalLeading As Long
tmExternalLeading As Long
tmAveCharWidth As Long
tmMaxCharWidth As Long
tmWeight As Long
tmOverhang As Long
tmDigitizedAspectX As Long
tmDigitizedAspectY As Long
tmFirstChar As Byte
tmLastChar As Byte
tmDefaultChar As Byte
tmBreakChar As Byte
tmItalic As Byte
tmUnderlined As Byte
tmStruckOut As Byte
tmPitchAndFamily As Byte
tmCharSet As Byte
End Type
Public Type SCROLLINFO
cbSize As Long
fMask As Long
nMin As Long
nMax As Long
nPage As Long
nPos As Long
nTrackPos As Long
End Type
Public Type WNDCLASS
style As Long
lpfnWndProc As Long
cbClsextra As Long
cbWndExtra As Long
hInstance As Long
hIcon As Long
hCursor As Long
hbrBackground As Long
lpszMenuName As String
lpszClassName As String
End Type
Public Type POINTAPI
x As Long
y As Long
End Type
Public Type MSG
hWnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Public Type CREATESTRUCT
lpCreateParams As Long
hInstance As Long
hMenu As Long
hWndParent As Long
cy As Long
cx As Long
y As Long
x As Long
style As Long
lpszName As String
lpszClass As String
ExStyle As Long
End Type
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type PAINTSTRUCT
hdc As Long
fErase As Long
rcPaint As RECT
fRestore As Long
fIncUpdate As Long
rgbReserved As Byte
End Type
'' Win32 APi Declarations
Public Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" (Class As WNDCLASS) As Long
Public Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long
Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Public Declare Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
Public Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As MSG) As Long
Public Declare Sub PostQuitMessage Lib "user32.dll" (ByVal nExitCode As Long)
Public Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function ShowWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function UpdateWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
Public Declare Function BeginPaint Lib "user32.dll" (ByVal hWnd As Long, ByRef lpPaint As PAINTSTRUCT) As Long
Public Declare Function EndPaint Lib "user32.dll" (ByVal hWnd As Long, ByRef lpPaint As PAINTSTRUCT) As Long
Public Declare Function LoadCursor Lib "user32.dll" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Public Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As String) As Long
Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Public Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Public Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SetTextAlign Lib "gdi32" (ByVal hdc As Long, ByVal wFlags As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function ScrollWindow Lib "user32" (ByVal hWnd As Long, ByVal XAmount As Long, ByVal YAmount As Long, _
lpRect As Any, lpClipRect As Any) As Long
Public Declare Function SetScrollInfo Lib "user32" (ByVal hWnd As Long, ByVal N As Long, lpcScrollInfo As SCROLLINFO, ByVal bool As Boolean) As Long
Public Declare Function GetScrollInfo Lib "user32.dll" (ByVal hWnd As Long, ByVal N As Long, ByRef lpScrollInfo As SCROLLINFO) As Long
Public Declare Function loword Lib "TLBINF32" (ByVal DWord As Long) As Integer
Public Declare Function hiword Lib "TLBINF32" (ByVal DWord As Long) As Integer
Public Declare Function wsprintf Lib "user32.dll" (ByVal lpstr As String, ByVal lpcstr As String, ByRef OptionalArguments As Any) As Long
'Public Declare Function InvalidateRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT, ByVal bErase As Long) As Long
Public Declare Function InvalidateRect Lib "user32" _
(ByVal hWnd As Long, _
lpRect As Any, _
ByVal bErase As Long) As Long
''
Public PrevWndProc As Long
Public cxChar As Integer, cxCaps As Integer, cyChar As Integer, cxClient As Integer, cyClient As Integer, iMaxWidth As Integer
Public a(100, 10) As Long
Public Function strlen(ByRef lpstr As String) As Long
strlen = LenB(StrConv(lpstr, vbFromUnicode))
End Function
Public Function Max(ByVal a As Long, ByVal b As Long)
Max = IIf(a > b, a, b)
End Function
Public Function Min(ByVal a As Long, ByVal b As Long)
Min = IIf(a < b, a, b)
End Function
Public Sub Hook(hWnd As Long)
If PrevWndProc = 0 Then
PrevWndProc = SetWindowLong(hWnd, _
GWL_WNDPROC, _
AddressOf WndProc)
End If
End Sub
Public Sub UnHook(hWnd As Long)
If PrevWndProc > 0 Then
Call SetWindowLong(hWnd, GWL_WNDPROC, PrevWndProc)
PrevWndProc = 0
End If
End Sub
Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim hdc As Long
Dim tm As TEXTMETRIC
Dim ps As PAINTSTRUCT
Dim i As Long, j As Long, iPaintBeg As Long, iPaintEnd As Long, x As Long, y As Long
Dim szbuffer As String * 4
Dim si As SCROLLINFO
Dim iHorzPos As Long, iVertPos As Long
Select Case uMsg
Case WM_CREATE
hdc = GetDC(hWnd)
GetTextMetrics hdc, tm
cxChar = tm.tmAveCharWidth
cyChar = tm.tmHeight + tm.tmExternalLeading
cxCaps = IIf(tm.tmPitchAndFamily & 1, 3, 2) * cxChar / 2
ReleaseDC hWnd, hdc
iMaxWidth = 8 * cxChar * UBound(a, 2)
WndProc = 0
Exit Function
Case WM_SIZE
cxClient = loword(lParam)
cyClient = hiword(lParam)
'// Set vertical scroll bar range and page size
si.cbSize = Len(si)
si.fMask = SIF_RANGE Or SIF_PAGE
si.nMin = 0
si.nMax = UBound(a, 1) - 1
si.nPage = cyClient / cyChar
Call SetScrollInfo(hWnd, SB_VERT, si, True)
'// Set horizontal scroll bar range and page size
si.cbSize = Len(si)
si.fMask = SIF_RANGE Or SIF_PAGE
si.nMin = 0
si.nMax = 2 + iMaxWidth / cxChar
si.nPage = cxClient / cxChar
Call SetScrollInfo(hWnd, SB_HORZ, si, True)
WndProc = 0
Exit Function
Case WM_VSCROLL
si.cbSize = Len(si)
si.fMask = SIF_ALL
Call GetScrollInfo(hWnd, SB_VERT, si)
iVertPos = si.nPos
Select Case loword(wParam)
Case SB_LINEUP
si.nPos = si.nPos - 1
Case SB_LINEDOWN
si.nPos = si.nPos + 1
Case SB_PAGEUP
si.nPos = si.nPos - si.nPage
Case SB_PAGEDOWN
si.nPos = si.nPos + si.nPage
Case SB_THUMBTRACK
si.nPos = si.nTrackPos
Case SB_TOP
si.nPos = si.nMin
Case SB_BOTTOM
si.nPos = si.nMax
End Select
si.fMask = SIF_POS
SetScrollInfo hWnd, SB_VERT, si, True
GetScrollInfo hWnd, SB_VERT, si
If (si.nPos <> iVertPos) Then
Call ScrollWindow(hWnd, 0, cyChar * (iVertPos - si.nPos), Null, Null)
Call UpdateWindow(hWnd)
End If
WndProc = 0
Exit Function
Case WM_HSCROLL
si.cbSize = Len(si)
si.fMask = SIF_ALL
Call GetScrollInfo(hWnd, SB_HORZ, si)
iHorzPos = si.nPos
Select Case loword(wParam)
Case SB_LINELEFT
si.nPos = si.nPos - 1
Case SB_LINERIGHT
si.nPos = si.nPos + 1
Case SB_PAGELEFT
si.nPos = si.nPos - si.nPage
Case SB_PAGERIGHT
si.nPos = si.nPos + si.nPage
Case SB_THUMBTRACK
si.nPos = si.nTrackPos
Case SB_LEFT
si.nPos = si.nMin
Case SB_RIGHT
si.nPos = si.nMax
Case Else
End Select
si.fMask = SIF_POS
SetScrollInfo hWnd, SB_HORZ, si, True
GetScrollInfo hWnd, SB_HORZ, si
If (si.nPos <> iHorzPos) Then
Call ScrollWindow(hWnd, cxChar * (iHorzPos - si.nPos), 0, 0, 0)
Call UpdateWindow(hWnd)
End If
WndProc = 0
Exit Function
Case WM_PAINT
hdc = BeginPaint(hWnd, ps)
'// Get vertical scroll bar position
si.cbSize = Len(si)
si.fMask = SIF_POS
GetScrollInfo hWnd, SB_VERT, si
iVertPos = si.nPos
' // Get horizontal scroll bar position
GetScrollInfo hWnd, SB_HORZ, si
iHorzPos = si.nPos
'// Find painting limits
iPaintBeg = Max(0, iVertPos + ps.rcPaint.Top / cyChar)
iPaintEnd = Min(UBound(a, 1) - 1, iVertPos + ps.rcPaint.Bottom / cyChar)
Debug.Print 1
For i = iPaintBeg To iPaintEnd
x = cxChar * (1 - iHorzPos)
y = cyChar * (i - iVertPos)
'Debug.Print iPaintBeg, iPaintEnd, iVertPos, iHorzPos
For j = 0 To UBound(a, 2) - 1
szbuffer = Str(a(i, j))
TextOut hdc, x + 8 * j * cxChar, y, szbuffer, strlen(szbuffer)
'SetTextAlign hdc, TA_LEFT Or TA_TOP
Next j
Next i
EndPaint hWnd, ps
WndProc = 0
Exit Function
Case WM_DESTROY
Call PostQuitMessage(0)
End Select
'WndProc = CallWindowProc(PrevWndProc, hwnd, MSG, wParam, lParam)
WndProc = DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function
Sub Main()
Dim i As Long, j As Long
For i = 0 To 99
For j = 0 To 9
a(i, j) = i * j
Next j
Next i
CreateMainForm "sa", "gh", 800, 500
End Sub
Public Sub CreateMainForm(lpClassName As String, lpWindowName As String, nWidth As Long, nHeight As Long)
'功能：创建窗体
'参数：title 窗体的标题文字 | nWidth 宽度 | nHeight 高度
Dim hWnd As Long
Dim lpMsg As MSG
If RegWinClass(lpClassName) = 0 Then '注册窗口类
MsgBox "registerwindowclass fail!"
Exit Sub
End If
'创建窗体并返回其句柄
hWnd = CreateWindowEx(0, lpClassName, lpWindowName, WS_OVERLAPPEDWINDOW Or WS_VSCROLL Or WS_HSCROLL, _
0, 0, nWidth, nHeight, 0, 0, App.hInstance, ByVal 0&)
'如果窗体创建成功则显示它并进如消息循环
If hWnd <> 0 Then
ShowWindow hWnd, SW_NORMAL
UpdateWindow hWnd
Do While GetMessage(lpMsg, 0, 0, 0)
TranslateMessage lpMsg
DispatchMessage lpMsg
Loop
End If
UnregisterClass lpClassName, App.hInstance '卸载注册类 很重要如果不卸载的话你自己试试就知道了 :)
End Sub
Public Function RegWinClass(lpClassName As String) As Long
'功能：注册窗口类
'参数：lpClassName 类名
Dim lpwcx As WNDCLASS
With lpwcx
'.cbSize = Len(lpwcx)
.style = CS_HREDRAW Or CS_VREDRAW Or CS_DBLCLKS 'Or CS_OWNDC
.lpszClassName = lpClassName
.hInstance = App.hInstance
.cbClsextra = 0
.cbWndExtra = 0
.hCursor = LoadCursor(0, IDC_ARROW)
.lpfnWndProc = lpFnToLong(AddressOf WndProc)
.lpszMenuName = vbNullString
.hbrBackground = GetStockObject(WHITE_BRUSH)
.hIcon = LoadIcon(0, IDI_APPLICATION)
'.hIconSm = 0
End With
RegWinClass = RegisterClass(lpwcx)
End Function
Public Function lpFnToLong(ByVal lpfn As Long) As Long
lpFnToLong = lpfn
End Function