VB.NET 2008 - Get Desktop Icons Text Width & Text Height
I am developing an application in VB.NET 2008, in which I try to get Desktop Icons Text Width & Text Height.
So far I have obtained all desktop icons positions, but I really can't figure by myself how to get Desktop Icons Text Width & Text Height.
Here is the VB.NET 2008 code that I use:
Imports System.Runtime.InteropServices
Module mdlDesktopIcons
Private Const STANDARD_RIGHTS_REQUIRED As Integer = &HF0000
Private Const SECTION_QUERY As Integer = &H1S
Private Const SECTION_MAP_WRITE As Integer = &H2S
Private Const SECTION_MAP_READ As Integer = &H4S
Private Const SECTION_MAP_EXECUTE As Integer = &H8S
Private Const SECTION_EXTEND_SIZE As Integer = &H10S
Private Const SECTION_ALL_ACCESS As Integer = STANDARD_RIGHTS_REQUIRED Or SECTION_QUERY Or SECTION_MAP_WRITE Or SECTION_MAP_READ Or SECTION_MAP_EXECUTE Or SECTION_EXTEND_SIZE
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Integer, ByVal bInheritHandle As Integer, ByVal dwProcessId As Integer) As IntPtr
Private Const PROCESS_VM_OPERATION As Integer = &H8S
Private Const PROCESS_VM_READ As Integer = &H10S
Private Const PROCESS_VM_WRITE As Integer = &H20S
Public Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As IntPtr, ByVal lpAddress As Integer, ByVal dwSize As Integer, ByVal flAllocationType As Integer, ByVal flProtect As Integer) As IntPtr
Public Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As IntPtr, ByVal lpAddress As IntPtr, ByVal dwSize As Integer, ByVal dwFreeType As Integer) As Integer
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As IntPtr) As Integer
Public Const MEM_COMMIT As Integer = &H1000S
Private Const MEM_RESERVE As Integer = &H2000S
Public Const MEM_RELEASE As Integer = &H8000S
Public Const PAGE_READWRITE As Integer = &H4
Public Function GetMemSharedNT(ByVal pid As Integer, ByVal memSize As Integer, ByRef hProcess As IntPtr) As IntPtr
hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0, pid)
GetMemSharedNT = VirtualAllocEx(hProcess, 0, memSize, MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
End Function
Public Sub FreeMemSharedNT(ByVal hProcess As IntPtr, ByVal MemAddress As IntPtr, ByVal memSize As Integer)
VirtualFreeEx(hProcess, MemAddress, memSize, MEM_RELEASE)
CloseHandle(hProcess)
End Sub
Public Structure POINTAPI
Dim x As Integer
Dim y As Integer
End Structure
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As IntPtr, ByVal hWndChildAfter As Integer, ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As IntPtr, ByRef lpdwProcessId As Integer) As IntPtr
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As IntPtr, ByVal nIndex As Integer) As Integer
Private Const GWL_STYLE As Integer = (-16)
Private Const LVS_AUTOARRANGE As Integer = &H100S
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByRef lpBuffer As POINTAPI, ByVal nSize As Integer, ByRef lpNumberOfBytesWritten As Integer) As Integer
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByRef lpBuffer As POINTAPI, ByVal nSize As Integer, ByRef lpNumberOfBytesWritten As Integer) As Integer
Private Declare Function GetParent Lib "user32" (ByVal hWnd As IntPtr) As IntPtr
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer
Private Const LVM_FIRST As Integer = &H1000S
Private Const LVM_GETITEMCOUNT As Integer = (LVM_FIRST + 4)
Private Const LVM_GETITEMPOSITION As Integer = (LVM_FIRST + 16)
Private Const WM_COMMAND As Integer = &H111S
Private Const IDM_TOGGLEAUTOARRANGE As Integer = &H7041S
<StructLayout(LayoutKind.Sequential)> Private Structure LVITEM
Dim mask As Int32
Dim iItem As Int32
Dim iSubItem As Int32
Dim state As Int32
Dim stateMask As Int32
Dim pszText As IntPtr
Dim cchTextMax As Int32
Dim iImage As Int32
Dim lParam As Int32
Dim iIndent As Int32
End Structure
Private m_OriginalPoint() As POINTAPI
Private m_AutoArrange As Boolean
Public Function SaveDesktop() As Boolean
Dim lvi As LVITEM
Dim pid As Integer
Dim tid As IntPtr
Dim hProcess As IntPtr
Dim SysShared As IntPtr
Dim dwSize As Integer
Dim IconCount As Integer
Dim BytesWritten As Integer
Dim BytesRead As Integer
Dim handleDesktop As IntPtr
Dim styleHandle As Integer
' Get a handle to the desktop listview
handleDesktop = GetSysLVHwnd()
If handleDesktop.Equals(IntPtr.Zero) Then
Return False
End If
' Get the style of the listview
styleHandle = GetWindowLong(handleDesktop, GWL_STYLE)
' If the list view is set for auto-arrange we have to turn it off for the time being
If (styleHandle And LVS_AUTOARRANGE) = LVS_AUTOARRANGE Then
m_AutoArrange = True
Dim handleParent As IntPtr
handleParent = GetParent(handleDesktop)
SendMessage(handleParent, WM_COMMAND, IDM_TOGGLEAUTOARRANGE, 0)
End If
' See how many icons there are on the desktop
IconCount = SendMessage(handleDesktop, LVM_GETITEMCOUNT, 0, 0)
If IconCount = 0 Then
Return False
End If
ReDim m_OriginalPoint(IconCount - 1)
dwSize = Len(m_OriginalPoint(0))
' Get the thread and process ids
tid = GetWindowThreadProcessId(handleDesktop, pid)
' Get the position
SysShared = GetMemSharedNT(pid, dwSize, hProcess)
WriteProcessMemory(hProcess, SysShared, m_OriginalPoint(0), dwSize, BytesWritten)
For i As Integer = 0 To IconCount - 1
SendMessage(handleDesktop, LVM_GETITEMPOSITION, i, SysShared)
ReadProcessMemory(hProcess, SysShared, m_OriginalPoint(i), dwSize, BytesRead)
Next i
FreeMemSharedNT(hProcess, SysShared, dwSize)
If m_AutoArrange Then
' Restore auto-arrange
End If
Return True
End Function
Private Function GetSysLVHwnd() As IntPtr
Dim lHandle As IntPtr
lHandle = FindWindow("Progman", vbNullString)
lHandle = FindWindowEx(lHandle, 0, "SHELLDLL_defVIEW", vbNullString)
Return FindWindowEx(lHandle, 0, "SysListView32", vbNullString)
End Function
End Module
I really need your help.
Sincerely,