Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - .NET

Страница: 1 |

 

  Вопрос: LVM_GETITEMCOUNT помогите плиз Добавлено: 12.03.09 00:26  

Автор вопроса:  dimon
Нужно получить список пунктов из чужого ListView"а и текст выделенного пункта.
Нашел несколько примеров, для диспетчера задач, раб. стола.
Скопировал, пришлось заменить

Public Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
(ByVal hwndParent As Long, _
ByVal hwndChildAfter As Long, _
ByVal lpszClass As Any, _ на stringByVal lpszWindow As Any) As Long на string
Any VB2005 не принимает.



Public Class Form1

    Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

    Public Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
    (ByVal hwndParent As Long, _
    ByVal hwndChildAfter As Long, _
    ByVal lpszClass As String, _
    ByVal lpszWindow As String) As Long

    Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim SLV As Long ' хэндл SysListView32
        Dim col As Long
        Dim IconCount As Integer
        Const LVM_GETITEMCOUNT As Long = 4100 ' получаем количество иконнок

        SLV = FindWindow("Progman", "Program Manager") 'ищем окно класса Progman
        SLV = FindWindowEx(SLV, vbNull, "SHELLDLL_DefView", "") 'внутри него ищем SHELLDLL_DefView
        SLV = FindWindowEx(SLV, vbNull, "SysListView32", "") 'И наконец получаем хэндл нашего SysListView32
        IconCount = SendMessage(SLV, LVM_GETITEMCOUNT, 0, 0) ' получаем количество итемов... здесь прога стопорится, Integer не вмещает кол-во итемов, если сделать Dim IconCount As double или long, IconCount"у присваивается значение SLV- явно не то что надо.
Здесь неверно определяется хэндл SysListView32? или
SendMessage неправильно посылается?


End Sub

End Class

Ответить

  Ответы Всего ответов: 8  

Номер ответа: 1
Автор ответа:
 Ra$cal



ICQ: 8068014 

Вопросов: 18
Ответов: 817
 Web-сайт: www.rascalspb.narod.ru
 Профиль | | #1
Добавлено: 12.03.09 07:19
сделай long. вызови SendMessage и прочитай код последней ошибки через GetLastError и напиши сюда

Ответить

Номер ответа: 2
Автор ответа:
 mc-black



ICQ: 308-534-060 

Вопросов: 20
Ответов: 1860
 Web-сайт: mc-black.narod.ru/dzp.htm
 Профиль | | #2
Добавлено: 12.03.09 08:45
Integer 16-битное знаковое целое,
Double - 64-битное представление чисел с плавающей точкой.
SendMessage как и большинство API-функций возвращает значение в EAX (соглашение о вызовах STDCALL), то есть в 32-битный регистр. Поэтому больше всего подходит тип Long - целое знаковое 32-битное число. Поэтому с типами ты конкретно напортачил. Из твоего вопроса можно подумать, что ты считаешь Double и Long одним и тем же.

Ответить

Номер ответа: 3
Автор ответа:
 GDK



Вопросов: 13
Ответов: 348
 Профиль | | #3 Добавлено: 12.03.09 11:57
Делал такое уже. Написал класс для листвью "чужой" проги. Количество итемов - ваще без проблем. Текст итемов и текст Subитемов(т.е. текст в 2...n-й колонке) чуть сложнее. Писал в VBA Ворд. Если надо всё ещё скопирую. Класс достаточно большой.


Это кусочек проверенного работающего кода:

  1. Private Const LVM_FIRST As Long = &H1000
  2. Private Const LVM_GETHOTITEM As Long = (LVM_FIRST + 61)
  3. Private Const LVM_GETITEMCOUNT As Long = (LVM_FIRST + 4)
  4.  
  5. Public Property Get GetItemCount() As Long
  6. Dim i As Long
  7. i = SendMessage(HWndObjm, LVM_GETITEMCOUNT, 0, 0)
  8. GetItemCount = i
  9. End Property

Ответить

Номер ответа: 4
Автор ответа:
 GDK



Вопросов: 13
Ответов: 348
 Профиль | | #4 Добавлено: 12.03.09 12:02
Ну а сам посмотри правильный ли хендл. Например определи класс окна по его хендлу. И попробуй Spy++ из VS 2006.

Ответить

Номер ответа: 5
Автор ответа:
 dimon



Вопросов: 6
Ответов: 23
 Профиль | | #5 Добавлено: 12.03.09 14:48
Если long- ошибки нет, но присваивается значение типа 4600939783- это явно не кол-во итемов...

Ответить

Номер ответа: 6
Автор ответа:
 dimon



Вопросов: 6
Ответов: 23
 Профиль | | #6 Добавлено: 12.03.09 15:57
Писал в VBA Ворд. Если надо всё ещё скопирую

Скопируй плиз, он с APIфункциями так же как .net работает?

Ответить

Номер ответа: 7
Автор ответа:
 dimon



Вопросов: 6
Ответов: 23
 Профиль | | #7 Добавлено: 12.03.09 16:37
Да, похоже проблема с SendMessage, повписывал прямо хендлы разных листвью взятые из winspy, значение IconCount не меняется-4294967296.... (&Н100000000)

Может надо перед
Public Class Form1
...
...

 что то типа Imports.System... прописать? (я в этом вообще не соображаю, сори за тупые вопросы :-)))

Ответить

Номер ответа: 8
Автор ответа:
 GDK



Вопросов: 13
Ответов: 348
 Профиль | | #8 Добавлено: 12.03.09 16:59
Ну смотри.
Public Function InitObjectGN(HWndGNp As Long) 'Перепиши "под себя" эту функцию
Её целью было получить хендл родительского окна, обнаружить хендл моего SysListView32 и занести это в глобальные переменные объекта.

Dim HWndGNm As Long - Туда надо будет внести хендл родительского окошка
Dim HWndObjm As Long - А сюда - хендл окна вашего SysListView32.

.нет - ваще не знаю разбирайся сам(сори за тупые ответы).
Будут вопросы - не поленюсь ответить. Если замучаешься ждать - пиши в почту, постараюсь поспешить. В .нет редко заглядываю.

Да, раз говоришь что не соображаешь - адресные пространства твоей проги и чужой разные. Это надо учитывать.
В "моём" классе смотри Public Property Get GetItemText(ItemIndex As Long, ColumnIndex As Long) As String



  1.  
  2. 'Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  3. Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  4. 'Напpавляет сообщение окну пpикладной задачи.
  5. 'Паpаметpы:
  6.      'Wnd: Окно, котоpое будет пpинимать сообщение, или $FFFF для всех пеpекpываемых или всплывающих окон.
  7.      'Msg: Тип сообщения.
  8.      'wParam: Дополнительная инфоpмация о сообщении.
  9.      'lParam: Дополнительная инфоpмация о сообщении.
  10. 'Возвpащаемое значение:
  11.      'Не нуль в случае успешного завеpшения; 0 - если нет.
  12. Private Const WM_COMMAND = &H111
  13. Private Const LVM_FIRST As Long = &H1000
  14. Private Const LVM_GETHOTITEM As Long = (LVM_FIRST + 61)
  15. Private Const LVM_GETITEMCOUNT As Long = (LVM_FIRST + 4)
  16. Private Const LVM_GETITEMSTATE As Long = (LVM_FIRST + 44)
  17. Private Const LVM_GETSELECTEDCOUNT As Long = (LVM_FIRST + 50)
  18. Private Const LVM_GETSELECTIONMARK As Long = (LVM_FIRST + 66)
  19. Private Const LVM_GETTOPINDEX As Long = (LVM_FIRST + 39)
  20. Private Const LVM_GETITEMTEXTA As Long = (LVM_FIRST + 45)
  21. Private Const LVM_GETITEMTEXTW As Long = (LVM_FIRST + 115)
  22. Private Const LVM_GETITEMRECT As Long = (LVM_FIRST + 14)
  23.  
  24. Private Const LVIS_SELECTED As Long = &H2
  25. Private Const LVIF_TEXT As Long = &H1
  26.  
  27. Private Const WM_LBUTTONDOWN As Long = &H201
  28. Private Const WM_LBUTTONUP As Long = &H202
  29. Private Const WM_KEYDOWN As Long = &H100
  30. Private Const WM_KEYUP As Long = &H101
  31. Private Const WM_VSCROLL As Long = &H115
  32. Private Const WM_HSCROLL As Long = &H114
  33. Private Const WM_CHAR As Long = &H102
  34.  
  35.  
  36.  
  37.  
  38. Private Declare Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hWnd As Long, ByRef lpdwProcessId As Long) As Long
  39.  
  40. Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
  41. Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
  42. Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
  43. Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
  44. Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
  45.  
  46. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
  47.  
  48. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  49.  
  50.  
  51. Private Const WM_USER As Long = &H400
  52. Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
  53. Private Const SYNCHRONIZE As Long = &H100000
  54. Private Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)
  55. Private Const PROCESS_DUP_HANDLE As Long = (&H40)
  56. Private Const MEM_COMMIT As Long = &H1000
  57. Private Const MEM_TOP_DOWN As Long = &H100000
  58. Private Const PAGE_READWRITE As Long = &H4
  59. Private Const TB_GETBUTTON As Long = (WM_USER + 23)
  60. Private Const MEM_RELEASE As Long = &H8000
  61.  
  62. Private Const PROCESS_QUERY_INFORMATION = 1024
  63. Private Const PROCESS_VM_OPERATION = &H8
  64. Private Const PROCESS_VM_READ = &H10
  65. Private Const PROCESS_VM_WRITE = &H20
  66. Private Const MAX_LVMSTRING As Long = 255
  67.  
  68.  
  69. Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hWnd As Long, ByRef lpRect As RECT) As Long
  70.  
  71.  
  72. Private Type LV_ITEM
  73.    mask         As Long
  74.    iItem        As Long
  75.    iSubItem     As Long
  76.    state        As Long
  77.    stateMask    As Long
  78.    pszText      As Long
  79.    cchTextMax   As Long
  80.    iImage       As Long
  81.    lParam       As Long
  82.    iIndent      As Long
  83. End Type
  84.  
  85.  
  86.  
  87. Private Type RECT
  88.     Left As Long
  89.     Top As Long
  90.     Right As Long
  91.     Bottom As Long
  92. End Type
  93.  
  94.  
  95.  
  96. Dim HWndGNm As Long
  97. Dim HWndObjm As Long
  98.  
  99.  
  100.  
  101. Public Function InitObjectGN(HWndGNp As Long)
  102. Dim FObjf As New FGDK
  103. Dim HWndGNf As Long
  104. Dim GNWinArrf() As Long
  105.  
  106. HWndGNf = HWndGNp
  107. HWndGNm = HWndGNf
  108.  
  109. GNWinArrf() = FObjf.GetGNChWind(HWndGNf)
  110. HWndObjm = GNWinArrf(14)
  111. Set FObjf = Nothing
  112. End Function
  113.  
  114.  
  115.  
  116. Public Property Get GetWinTop() As Long
  117. Dim GNRectf As RECT
  118. Call GetWindowRect(HWndObjm, GNRectf) 'Получаем прямоугольник окна списка
  119. GetWinTop = GNRectf.Top
  120. End Property
  121. Public Property Get GetWinBottom() As Long
  122. Dim GNRectf As RECT
  123. Call GetWindowRect(HWndObjm, GNRectf) 'Получаем прямоугольник окна списка
  124. GetWinBottom = GNRectf.Bottom
  125. End Property
  126. Public Property Get GetWinLeft() As Long
  127. Dim GNRectf As RECT
  128. Call GetWindowRect(HWndObjm, GNRectf) 'Получаем прямоугольник окна списка
  129. GetWinLeft = GNRectf.Left
  130. End Property
  131. Public Property Get GetWinRight() As Long
  132. Dim GNRectf As RECT
  133. Call GetWindowRect(HWndObjm, GNRectf) 'Получаем прямоугольник окна списка
  134. GetWinRight = GNRectf.Right
  135. End Property
  136.  
  137. Public Property Get GetWinWidth() As Long
  138. Dim GNRectf As RECT
  139. Call GetWindowRect(HWndObjm, GNRectf) 'Получаем прямоугольник окна списка
  140. GetWinWidth = GNRectf.Right - GNRectf.Left
  141. End Property
  142. Public Property Get GetWinHeigt() As Long
  143. Dim GNRectf As RECT
  144. Call GetWindowRect(HWndObjm, GNRectf) 'Получаем прямоугольник окна списка
  145. GetWinHeigt = GNRectf.Bottom - GNRectf.Top
  146. End Property
  147.  
  148. Public Property Get GetHWndTrNameList() As Long
  149. GetHWndTrNameList = HWndObjm
  150. End Property
  151.  
  152. Public Property Get GetHWndGN() As Long
  153. GetHWndGN = HWndGNm
  154. End Property
  155.  
  156.  
  157. Public Property Get GetItemText(ItemIndex As Long, ColumnIndex As Long) As String
  158. Dim i As Long
  159. Dim BufStr As String
  160. Dim Columnf As Long
  161. Dim NumItemf As Long
  162. Dim BufStrArr() As Byte
  163. Dim PtrItmTxt As Long
  164. Dim PtrItem As Long
  165. Dim Itemf As LV_ITEM
  166.  
  167. Dim procidf As Long
  168. Dim ProcHnd As Long
  169.  
  170. ReDim BufStrArr(1023)
  171.  
  172. Columnf = ColumnIndex
  173. NumItemf = ItemIndex
  174.  
  175. Call GetWindowThreadProcessId(HWndObjm, procidf) ' найти PID окна
  176.  
  177. 'Открываем процесс для чтения/записи, получая при этом его хендл
  178. ProcHnd = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, procidf)
  179.  
  180. 'Выделяем память в чужом процессе для строки с текстом итема, получая при этом указатель на эту память
  181. PtrItmTxt = VirtualAllocEx(ProcHnd, 0, 1023, MEM_COMMIT, PAGE_READWRITE)
  182.  
  183. 'Заполняем структуру, описывающую итем из листвью32
  184. Itemf.mask = LVIF_TEXT
  185. Itemf.cchTextMax = 1023
  186. Itemf.iSubItem = Columnf
  187. Itemf.pszText = PtrItmTxt
  188.  
  189. 'Выделяем память в чужом процессе для структуры, описывающей итем и получаем при этом указатель на эту память
  190. PtrItem = VirtualAllocEx(ProcHnd, 0, Len(Itemf), MEM_COMMIT, PAGE_READWRITE)
  191.  
  192. 'Копируем в выделенную для структуры итема память, переменную Itemf, содержащую все необходимые данные для извлечения текста итема
  193. Call WriteProcessMemory(ProcHnd, PtrItem, Itemf, Len(Itemf), 0)
  194.  
  195. 'Отсылаем окну сообщение, в ответ на которое окно списка поместит текст итема в память, _
  196. которая выделена для текста в чужом процессе итема и указатель которой находится в структуре, _
  197. которая находится в чужом процессе по указателю PtrItem
  198. Call SendMessage(HWndObjm, LVM_GETITEMTEXTA, NumItemf, ByVal PtrItem)
  199.  
  200. 'Считываем текст итема, находящийся в памяти чужого процесса по указателю PtrItmTxt, в массив
  201. Call ReadProcessMemory(ProcHnd, PtrItmTxt, BufStrArr(0), 1023, 0)
  202.  
  203. 'Освобождаем память, выделенную в чужом процессе для текста итема
  204. Call VirtualFreeEx(ProcHnd, PtrItmTxt, 0, MEM_RELEASE)
  205. 'Освобождаем память, выделенную в чужом процессе для структуры, описывающей итем
  206. Call VirtualFreeEx(ProcHnd, PtrItem, 0, MEM_RELEASE)
  207. 'Ну и оставим в покое чужой процесс      (до поры до времени, до клика пользователя :))
  208. Call CloseHandle(ProcHnd)
  209.  
  210. 'Превращаем массив в нормальную строку
  211. For i = 0 To 1023
  212.     If Chr(BufStrArr(i)) = vbNullChar Then Exit For
  213.     BufStr = BufStr & Chr(BufStrArr(i))
  214. Next i
  215. GetItemText = BufStr
  216. End Property
  217.  
  218. Public Property Get GetItemRect(ByVal NumItem As Long) As String
  219. Dim i As Long
  220. Dim BufStr As String
  221. Dim NumItemf As Long
  222. Dim PtrItem As Long
  223. Dim ItRect As RECT
  224.  
  225. Dim procidf As Long
  226. Dim ProcHnd As Long
  227.  
  228.  
  229. NumItemf = NumItem
  230.  
  231. Call GetWindowThreadProcessId(HWndObjm, procidf) ' найти PID окна
  232.  
  233. 'Открываем процесс для чтения/записи, получая при этом его хендл
  234. ProcHnd = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, procidf)
  235.  
  236. 'Выделяем память в чужом процессе для структуры, описывающей прямоугольник итема и получаем при этом указатель на эту память
  237. PtrItem = VirtualAllocEx(ProcHnd, 0, Len(ItRect), MEM_COMMIT, PAGE_READWRITE)
  238.  
  239. 'Отсылаем окну сообщение, в ответ на которое окно списка поместит прямоугольник итема в память, _
  240. которая выделена для этого в чужом процессе итема и указатель которой находится в структуре, _
  241. которая находится в чужом процессе по указателю PtrItem
  242. Call SendMessage(HWndObjm, LVM_GETITEMRECT, NumItemf, ByVal PtrItem)
  243.  
  244. 'Считываем прямоугольник итема, находящийся в памяти чужого процесса по указателю PtrItem
  245. Call ReadProcessMemory(ProcHnd, PtrItem, ItRect, Len(ItRect), 0)
  246.  
  247. 'Освобождаем память, выделенную в чужом процессе для структуры, описывающей прямоугольник итема
  248. Call VirtualFreeEx(ProcHnd, PtrItem, 0, MEM_RELEASE)
  249. 'Ну и оставим в покое чужой процесс      (до поры до времени, до клика пользователя :))
  250. Call CloseHandle(ProcHnd)
  251.  
  252. BufStr = ItRect.Bottom & "\" & ItRect.Left & "\" & ItRect.Right & "\" & ItRect.Top
  253. GetItemRect = BufStr
  254.  
  255. End Property
  256.  
  257.  
  258. Public Function ItemMousClick(ByVal NumItem As Long) As Boolean
  259. Dim i As Long
  260. Dim BufStr As String
  261. Dim BufStrArr() As String
  262. Dim ItemRect As RECT
  263. Dim X As Long
  264. Dim Y As Long
  265. Dim HeightWin As Long
  266.  
  267. BufStr = Me.GetItemRect(NumItem)
  268. BufStrArr() = VBA.Split(BufStr, "\")
  269. ItemRect.Bottom = CLng(VBA.Round(VBA.Val(BufStrArr(0)), 0))
  270. ItemRect.Left = CLng(VBA.Round(VBA.Val(BufStrArr(1)), 0))
  271. ItemRect.Right = CLng(VBA.Round(VBA.Val(BufStrArr(2)), 0))
  272. ItemRect.Top = CLng(VBA.Round(VBA.Val(BufStrArr(3)), 0))
  273.  
  274. Y = ItemRect.Top + ((ItemRect.Bottom - ItemRect.Top) / 2)
  275. X = &H20
  276. 'X = ItemRect.Left + ((ItemRect.Right - ItemRect.Left) / 2)
  277.  
  278. If ItemRect.Left < 0 Then
  279.     For i = 1 To Round(ItemRect.Left * -1 / 7, 0) + 5
  280.         Call PostMessage(HWndObjm, WM_KEYDOWN, &H25, &H14B00001)
  281.         Call PostMessage(HWndObjm, WM_KEYUP, &H25, &HC14B0001)
  282.     Next i
  283. End If
  284.  
  285. HeightWin = Me.GetWinHeigt
  286. If ItemRect.Bottom > HeightWin Then
  287. '    i = ItemRect.Bottom - HeightWin
  288.     Call PostMessage(HWndObjm, WM_LBUTTONDOWN, 1, (HeightWin - 25) * 65536 + X)
  289.     Call PostMessage(HWndObjm, WM_LBUTTONUP, 0, (HeightWin - 25) * 65536 + X)
  290.  
  291.     For i = 1 To Round((ItemRect.Bottom - HeightWin) / 25, 0) + 4
  292.         Call PostMessage(HWndObjm, WM_KEYDOWN, &H28, &H15000001)
  293.         Call PostMessage(HWndObjm, WM_KEYUP, &H28, &HC1500001)
  294.     Next i
  295.     Call Sleep(500)
  296.     BufStr = Me.GetItemRect(NumItem)
  297.     Erase BufStrArr()
  298.     BufStrArr() = VBA.Split(BufStr, "\")
  299.     ItemRect.Bottom = CLng(VBA.Round(VBA.Val(BufStrArr(0)), 0))
  300.     ItemRect.Left = CLng(VBA.Round(VBA.Val(BufStrArr(1)), 0))
  301.     ItemRect.Right = CLng(VBA.Round(VBA.Val(BufStrArr(2)), 0))
  302.     ItemRect.Top = CLng(VBA.Round(VBA.Val(BufStrArr(3)), 0))
  303.     Y = ItemRect.Top + ((ItemRect.Bottom - ItemRect.Top) / 2)
  304. '    Debug.Print Y & "  IF"
  305. End If
  306.  
  307. If ItemRect.Top < 0 Then
  308. '    i = ItemRect.Bottom - HeightWin
  309.     Call PostMessage(HWndObjm, WM_LBUTTONDOWN, 1, 25 * 65536 + X)
  310.     Call PostMessage(HWndObjm, WM_LBUTTONUP, 0, 25 * 65536 + X)
  311.  
  312.     For i = 1 To Round((ItemRect.Top * -1) / 15, 0) + 3
  313.         Call PostMessage(HWndObjm, WM_KEYDOWN, &H26, &H14800001)
  314.         Call PostMessage(HWndObjm, WM_KEYUP, &H26, &HC1480001)
  315.     Next i
  316.     Call Sleep(500)
  317.     BufStr = Me.GetItemRect(NumItem)
  318.     Erase BufStrArr()
  319.     BufStrArr() = VBA.Split(BufStr, "\")
  320.     ItemRect.Bottom = CLng(VBA.Round(VBA.Val(BufStrArr(0)), 0))
  321.     ItemRect.Left = CLng(VBA.Round(VBA.Val(BufStrArr(1)), 0))
  322.     ItemRect.Right = CLng(VBA.Round(VBA.Val(BufStrArr(2)), 0))
  323.     ItemRect.Top = CLng(VBA.Round(VBA.Val(BufStrArr(3)), 0))
  324.     Y = ItemRect.Top + ((ItemRect.Bottom - ItemRect.Top) / 2)
  325. '    Debug.Print Y & "  IF"
  326. End If
  327.  
  328.  
  329. 'Debug.Print Y
  330. Call PostMessage(HWndObjm, WM_LBUTTONDOWN, 1, Y * 65536 + X)
  331. Call PostMessage(HWndObjm, WM_LBUTTONUP, 0, Y * 65536 + X)
  332.  
  333. ItemMousClick = True
  334. End Function
  335.  
  336. Public Function SendEnter()
  337.  
  338. Call PostMessage(HWndObjm, WM_CHAR, &HD, &H1C0001)
  339.  
  340. End Function
  341.  
  342. Public Property Get ATest()
  343.  
  344. i = SendMessage(HWndObjm, LVM_GETITEMSTATE, 1, LVIS_SELECTED)
  345. Debug.Print i & " - HHHHH"
  346.  
  347. End Property
  348.  
  349.  
  350. Public Property Get SelectedItems() As Scripting.Dictionary
  351. Dim BufDict As New Scripting.Dictionary
  352. Dim i As Long
  353. Dim BufStr As String
  354. Dim j As Long
  355.  
  356. j = Me.GetItemCount
  357. If j = 0 Then
  358.     Set SelectedItems = Nothing
  359.     Exit Property
  360. End If
  361.  
  362. For i = 0 To j - 1
  363.     j = SendMessage(HWndObjm, LVM_GETITEMSTATE, i, LVIS_SELECTED)
  364.     BufStr = Me.GetItemText(i, 0)
  365.     If j > 0 Then
  366.         Call BufDict.Add(i, BufStr)
  367.     End If
  368. Next i
  369. Set SelectedItems = BufDict
  370. End Property
  371.  
  372. Public Property Get SelectedCount() As Long
  373. Dim i As Long
  374. Dim j As Long
  375. Dim Rez As Long
  376.  
  377. j = Me.GetItemCount
  378.  
  379. For i = 0 To j - 1
  380.     j = SendMessage(HWndObjm, LVM_GETITEMSTATE, i, LVIS_SELECTED)
  381.     Rez = Rez + j
  382. Next i
  383.  
  384. SelectedCount = Rez
  385.  
  386. End Property
  387.  
  388. Public Property Get GetItemCount() As Long
  389. Dim i As Long
  390. i = SendMessage(HWndObjm, LVM_GETITEMCOUNT, 0, 0)
  391. GetItemCount = i
  392. End Property
  393.  
  394.  
  395. Public Property Get FirstSelItem() As Long
  396. Dim i As Long
  397. Dim j As Long
  398. Dim Rez As Long
  399.  
  400. j = Me.GetItemCount
  401. Rez = -1
  402. For i = 0 To j - 1
  403.     j = SendMessage(HWndObjm, LVM_GETITEMSTATE, i, LVIS_SELECTED)
  404.     If j > 0 Then
  405.         Rez = i
  406.         Exit For
  407.     End If
  408. Next i
  409.  
  410. FirstSelItem = Rez
  411.  
  412. End Property
  413.  
  414.  

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам