VB如何在刷新ListView的时候不改变滚动条的位置
程序代码：
Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Public Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long
Public Type PROCESSENTRY32
dwSize As Long
cntusage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 1024
End Type
Public Sub GetProcessList(ListView As ListView) ' 取得进程
'On Error Resume Next
Dim Pid() As Process
Dim h As Long, proc As PROCESSENTRY32, snap As Long, Text As String, ListViewItem As ListItem, strItem As String
Dim theloop As Long, i As Long: i = 1
ListView.ListItems.Clear
snap = CreateToolhelp32Snapshot(TH32CS_SNAPall, 0) '获得进程快照的句柄
proc.dwSize = Len(proc)
theloop = Process32First(snap, proc) '获取第一个进程，并得到其返回值
ReDim Pid(proc.dwSize)
Do While theloop <> 0 '当返回值非零时继续获取下一个进程
ListView.ListItems.Add , , proc.szExeFile
If proc.szExeFile = "csrss.exe" Or _
proc.szExeFile = "svchost.exe" Or _
proc.szExeFile = "alg.exe" Or _
proc.szExeFile = "winlogin.exe" Or _
proc.szExeFile = "smss.exe" And ( _
Left(PidToProcessPath(proc.th32ProcessID), 19) <> "C:\Windows\System32" Or _
Left(PidToProcessPath(proc.th32ProcessID), 17) <> "C:\Windows\System") Then
ListView.ListItems(i).ForeColor = vbRed
End If
Pid(i - 1).Pid = proc.th32ProcessID
Pid(i - 1).ParentPid = proc.th32ParentProcessID
Pid(i - 1).ProcessPath = PidToProcessPath(proc.th32ProcessID)
theloop = Process32Next(snap, proc)
i = i + 1 '你注释掉这句试一下
Loop
'MsgBox "ProcessList项数:" & ListView.ListItems.Count'调试程序用,防止出现35560错误
'MsgBox "数组Pid长度:" & UBound(Pid) + 1 '调试程序用,防止出现35560错误
For h = 0 To i - 2
ListView.ListItems(h + 1).SubItems(1) = Pid(h).Pid
'If Pid(h).Pid <> Pid(h).ParentPid Then
'ListView.ListItems(h + 1).SubItems(2) = Pid(h).ParentPid
'End If
ListView.ListItems(h + 1).SubItems(2) = AccessPermissions(Pid(h).Pid)
ListView.ListItems(h + 1).SubItems(3) = Pid(h).ProcessPath
Next
End Sub
Private Sub Tmr_GetProcessList_Timer()
Dim SelectIndex As Long, Pos As Long
If ProcessList.SelectedItem.Index <> -1 Then
SelectIndex = ProcessList.SelectedItem.Index
End If
GetProcessList ProcessList
ProcessList.ListItems(1).Selected = False
ProcessList.ListItems(SelectIndex).Selected = True
End Sub
Tmr_GetProcessList的Interval为1000,每次列表浏览到一半就刷新了,滚动条回到顶部,弄得无法正常浏览
