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,每次列表浏览到一半就刷新了,滚动条回到顶部,弄得无法正常浏览