• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 417
  • Last Modified:

Icon placement on desktop

Can anyone tell me how to find the current position of all the icons on the desktop?

I'd like to create a small app to store the layout of the icons and allow me to restore them at a later time.  
0
t1pimp
Asked:
t1pimp
  • 2
  • 2
1 Solution
 
jk970Commented:
'-------desktop.bas---------------

Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const OPEN_ALWAYS = 4
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const SECTION_MAP_WRITE = &H2
Public Const FILE_MAP_WRITE = SECTION_MAP_WRITE
Public Const PAGE_READWRITE As Long = &H4

Const LVM_GETTITEMCOUNT& = (&H1000 + 4)
Const LVM_SETITEMPOSITION& = (&H1000 + 15)
Const LVM_FIRST = &H1000
Const LVM_GETITEMPOSITION = (LVM_FIRST + 16)
Const LVM_GETITEMTEXT = LVM_FIRST + 45

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Sub CopyMemoryOne Lib "kernel32" Alias "RtlMoveMemory" _
(ByVal hpvDest&, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Sub CopyMemoryTwo Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, ByVal hpvSource&, ByVal cbCopy As Long)
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam _
As Any) As Long
Declare Function SendMessageByLong& Lib "user32" Alias "SendMessageA" _
(ByVal hwnd&, ByVal wMsg&, ByVal wParam&, ByVal lParam&)
Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String)
Private Declare Function FindWindowEx& Lib "user32" Alias _
"FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter _
As Long, ByVal lpClassName As String, ByVal lpWindowName As String)
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 ReleaseDC Lib "user32" (ByVal hwnd As Long, _
ByVal hdc As Long) As Long
Public Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, _
lpRect As Any, ByVal bErase As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, lpSecurityAttributes As Any, _
ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As _
Long, ByVal hTemplateFile As Long) As Long
Public Declare Function CreateFileMappingTwo Lib "kernel32" Alias _
"CreateFileMappingA" (ByVal hFile As Long, lpFileMappigAttributes _
As Any, ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, _
ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As Long
Public Declare Function MapViewOfFile Lib "kernel32" (ByVal _
hFileMappingObject As Long, ByVal dwDesiredAccess As Long, ByVal _
dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, ByVal _
dwNumberOfBytesToMap As Long) As Long
Public Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress _
As Any) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject _
As Long) As Long
Public Declare Function FlushViewOfFile Lib "kernel32" (ByVal lpBaseAddress _
As Long, ByVal dwNumberOfBytesToFlush As Long) As Long
Public Type LV_ITEM ' might need this if we ever figure out
    mask As Long    ' how to retrieve the text
    iItem As Long
    iSubItem As Long
    State As Long
    stateMask As Long
    pszText As Long
    cchTextMax As Long
    iImage As Long
    lParam As Long  ' I think we might need a second
    iIndent As Long ' memory mapped file
End Type
Public Type POINTAPI
        x As Long
        y As Long
End Type
Dim c As POINTAPI
Public IconPosition() As POINTAPI
Public IconPosition2() As POINTAPI
Public TempIconPosition2 As POINTAPI
Dim pNull As Long
Dim MyValue%, MyValue2%
Dim sFileName As String
Dim CurrentDirectory As String
Dim hdesk&, i%
Global icount&

Public Sub FindIcons()
'no error trapping done  quick and dirty code
pNull = 0
hdesk = FindWindow("progman", vbNullString)
hdesk = FindWindowEx(hdesk, 0, "shelldll_defview", vbNullString)
hdesk = FindWindowEx(hdesk, 0, "syslistview32", vbNullString)
icount = SendMessageByLong(hdesk, LVM_GETTITEMCOUNT, 0, 0&)
If icount = 0 Then MsgBox "Error occurred: No icons found", _
vbOKOnly, "DeskTop": Unload Form1: End
Form1.Text1.Text = Str(icount) + "  icons detected    "
ReDim IconPosition(icount) As POINTAPI
ReDim IconPosition2(icount) As POINTAPI
CurrentDirectory = App.Path
If Right$(CurrentDirectory, 1) <> "\" Then _
CurrentDirectory = CurrentDirectory + "\"
sFileName = CurrentDirectory + "TEMPPPPP.PPP"
hFile = CreateFile(sFileName, GENERIC_READ Or GENERIC_WRITE, 0, _
                   ByVal pNull, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, _
                   pNull)
hFileMap = CreateFileMappingTwo(hFile, ByVal pNull, PAGE_READWRITE, _
0, 16, "MyMapping")
pFileMap = MapViewOfFile(hFileMap, FILE_MAP_WRITE, 0, 0, 0)
For i = 0 To icount - 1
    Call SendMessageByLong(hdesk, LVM_GETITEMPOSITION, i, pFileMap)
    CopyMemoryTwo c, pFileMap, 8
    Form1.List1.AddItem Str(i + 1) + "    x-" + Str(c.x) + "    y-" _
    + Str(c.y)
    IconPosition(i) = c
    IconPosition2(i) = c
Next i
FlushViewOfFile pFileMap, 8
UnmapViewOfFile pFileMap
CloseHandle hFileMap
CloseHandle hFile
End Sub

Sub RefreshDesktop()
xcc% = InvalidateRect(0, ByVal 0, 0)
End Sub

Sub MarkIcons()
hwndSrc% = 0
hSrcDC% = GetDC(hwndSrc%)
For i = 0 To icount - 1
Test$ = Str(i + 1)
        zs% = TextOut(hSrcDC%, IconPosition(i).x, _
        IconPosition(i).y, Test$, Len(Test$))
Next i
Dmy% = ReleaseDC(hwndSrc%, hSrcDC%)
End Sub

'------------end of desktop.bas--------------

------------form1.frm---------------------
VERSION 5.00
Begin VB.Form Form1
   AutoRedraw      =   -1  'True
   Caption         =   "DeskTop Icons"
   ClientHeight    =   5805
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5805
   ScaleWidth      =   4680
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Command2
      Caption         =   "Refresh"
      Height          =   375
      Left            =   1920
      TabIndex        =   3
      Top             =   4080
      Width           =   855
   End
   Begin VB.CommandButton Command1
      Caption         =   "Mark Icon Positions"
      Height          =   495
      Left            =   480
      TabIndex        =   2
      Top             =   3960
      Width           =   1335
   End
   Begin VB.ListBox List1
      Height          =   2985
      Left            =   600
      TabIndex        =   1
      Top             =   600
      Width           =   3615
   End
   Begin VB.TextBox Text1
      Height          =   375
      Left            =   600
      TabIndex        =   0
      Top             =   120
      Width           =   3615
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Command1_Click()
MarkIcons
End Sub

Private Sub Command2_Click()
RefreshDesktop
End Sub


Private Sub Form_Load()
FindIcons
End Sub

End Sub
----------end of form1.frm--------------


hope this serves u'r purpose.........
0
 
t1pimpAuthor Commented:
ok. So I cut and pasted this into VB6, and no go.  Is this for VB5?  I've never even seen VB5 so I'm not sure what the differences are?
0
 
jk970Commented:
this will work fine in vb6. the problem is that when u cut and copy from and html page, long lines get scattered,and u'll get compile errors. which u can easily rectify. and the code of form1.frm given above should be pasted into notepad and saved as form1.frm and then add it to the project (after removing the default form1.frm in the project). and the code of declare.bas u can directly paste it into a module in the project. i can mail u the vb project file if u want.
0
 
t1pimpAuthor Commented:
Perfect!  I figured out what I was doing wrong last night... this is exactly what I was looking for. Thanx!
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now