Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Как получить и изменить координаты иконок на столе?

01.01.2007
// For Win9x:
//-------------------------------------------
 
uses
 
CommCtrl,
 
IPCThrd; (from your Delphi\Demos\Ipcdemos directory)
 
function GetDesktopListViewHandle: THandle;
var
  S
: String;
begin
 
Result := FindWindow('ProgMan', nil);
 
Result := GetWindow(Result, GW_CHILD);
 
Result := GetWindow(Result, GW_CHILD);
 
SetLength(S, 40);
 
GetClassName(Result, PChar(S), 39);
 
if PChar(S) <> 'SysListView32' then Result := 0;
end;
 
procedure TForm1
.Button1Click(Sender: TObject);
 type
   
PInfo = ^TInfo;
   
TInfo = packed record
     infoPoint
: TPoint;
     infoText
: array[0..255] of Char;
     infoItem
: TLVItem;
     infoFindInfo
: TLVFindInfo;
   
end;
var
   r
: TRect;
   hWnd
: THandle;
   i
, iCount : Integer;
 
   
Info: PInfo;
   
SharedMem: TSharedMem;
begin
  hWnd
:= GetDesktopWindow();
 
GetWindowRect(hWnd,r);
 
Memo.Lines.Add('Bottom: ' +  IntToStr(r.Bottom));
 
Memo.Lines.Add('Right: ' + IntToStr(r.Right));
 
  hWnd
:= GetDesktopListViewHandle;
  iCount
:= ListView_GetItemCount(hWnd);
 
Memo.Lines.Add('# Icons: ' + IntToStr(iCount));
 
 
SharedMem := TSharedMem.Create('', SizeOf(TInfo));
 
Info := SharedMem.Buffer;
 
   
with Info^ do
   
try
     infoItem
.pszText := infoText;
     infoItem
.cchTextMax := 255;
     infoItem
.mask := LVIF_TEXT;
     
try
       
begin
         
for i := 0 to iCount - 1 do
         
begin
           infoItem
.iItem := i;
           
try
             ListView_GetItem
(hWnd, infoItem);
             ListView_GetItemPosition
(hWnd, I, infoPoint);
             
Memo.Lines.Add('Icon: ' + infoText);
             
Memo.Lines.Add('   X: ' + IntToStr(infoPoint.X));
             
Memo.Lines.Add('   Y: ' + IntToStr(infoPoint.Y));
           
except
           
end;
         
end;
       
end;
     
finally
     
end;
   
finally
     
SharedMem.Free;
   
end;
end;
// For NT, Win2k, XP:
//-------------------------------------------
// Unit to save/restore the positions of desktop icons to/from the registry)
 
unit dipsdef
;
 
interface
 
uses
 
Windows, CommCtrl;
 
const
 
RegSubKeyName = 'Software\LVT\Desktop Item Position Saver';
 
procedure
RestoreDesktopItemPositions;
procedure
SaveDesktopItemPositions;
 
implementation
 
uses
  uvirtalloc
, registry;
 
procedure
SaveListItemPosition(LVH : THandle; RemoteAddr : Pointer);
var
  lvi
: TLVITEM;
  lenlvi
: integer;
  nb
: integer;
  buffer
: array [0..MAX_PATH] of char;
 
Base : Pointer;
  Base2
: PByte;
  i
, ItemsCount : integer;
 
Apoint : TPoint;
  key
: HKEY;
 
Dummy : integer;
begin
 
ItemsCount := SendMessage(LVH, LVM_GETITEMCOUNT, 0, 0);
 
Base := RemoteAddr;
  lenlvi
:= SizeOf(lvi);
 
FillChar(lvi, lenlvi, 0);
  lvi
.cchTextMax := 255;
  lvi
.pszText := Base;
  inc
(lvi.pszText, lenlvi);
 
 
WriteToRemoteBuffer(@lvi, Base, 255);
 
  Base2
:= Base;
  inc
(Base2, Lenlvi);
 
 
RegDeleteKey(HKEY_CURRENT_USER, RegSubKeyName);
 
 
RegCreateKeyEx(HKEY_CURRENT_USER,
   
PChar(RegSUbKeyName),
   
0,
   
nil,
    REG_OPTION_NON_VOLATILE
,
    KEY_SET_VALUE
,
   
nil,
    key
,
   
nil);
 
 
for i := 0 to ItemsCount - 1 do
 
begin
    nb
:= SendMessage(LVH, LVM_GETITEMTEXT, i, LParam(Base));
 
   
ReadRemoteBuffer(Base2, @buffer, nb + 1);
   
FillChar(Apoint, SizeOf(Apoint), 0);
 
   
WriteToRemoteBuffer(@APoint, Base2, SizeOf(Apoint));
   
SendMessage(LVH, LVM_GETITEMPOSITION, i, LParam(Base) + lenlvi);
 
   
ReadRemoteBuffer(Base2, @Apoint, SizeOf(Apoint));
   
RegSetValueEx(key, @buffer, 0, REG_BINARY, @Apoint, SizeOf(APoint));
 
end;
 
RegCloseKey(key);
end;
 
 
procedure
RestoreListItemPosition(LVH : THandle; RemoteAddr : Pointer);
type
 
TInfo = packed record
    lvfi
: TLVFindInfo;
   
Name : array [0..MAX_PATH] of char;
 
end;
var
 
SaveStyle : Dword;
 
Base : Pointer;
 
Apoint : TPoint;
  key
: HKey;
  idx
: DWord;
  info
: TInfo;
  atype
: Dword;
  cbname
, cbData : Dword;
  itemidx
: DWord;
begin
 
SaveStyle := GetWindowLong(LVH, GWL_STYLE);
 
if (SaveStyle and LVS_AUTOARRANGE) = LVS_AUTOARRANGE then
   
SetWindowLong(LVH, GWL_STYLE, SaveStyle xor LVS_AUTOARRANGE);
 
 
RegOpenKeyEx(HKEY_CURRENT_USER, RegSubKeyName, 0, KEY_QUERY_VALUE, key);
 
 
FillChar(info, SizeOf(info), 0);
 
Base := RemoteAddr;
 
  idx
:= 0;
  cbname
:= MAX_PATH;
  cbdata
:= SizeOf(APoint);
 
 
while (RegEnumValue(key, idx, info.Name, cbname, nil, @atype, @Apoint, @cbData) <>
    ERROR_NO_MORE_ITEMS
) do
 
begin
   
if (atype = REG_BINARY) and (cbData = SizeOf(Apoint)) then
   
begin
      info
.lvfi.flags := LVFI_STRING;
      info
.lvfi.psz := Base;
      inc
(info.lvfi.psz, SizeOf(info.lvfi));
     
WriteToRemoteBuffer(@info, Base, SizeOf(info.lvfi) + cbname + 1);
      itemidx
:= SendMessage(LVH, LVM_FINDITEM, - 1, LParam(Base));
     
if itemidx > -1 then
       
SendMessage(LVH, LVM_SETITEMPOSITION, itemidx, MakeLong(Apoint.x, Apoint.y));
   
end;
    inc
(idx);
    cbname
:= MAX_PATH;
    cbdata
:= SizeOf(APoint);
 
end;
 
RegCloseKey(key);
 
 
SetWindowLong(LVH, GWL_STYLE, SaveStyle);
end;
 
function GetSysListView32: THandle;
begin
 
Result := FindWindow('Progman', nil);
 
Result := FindWindowEx(Result, 0, nil, nil);
 
Result := FindWindowEx(Result, 0, nil, nil);
end;
 
procedure
SaveDesktopItemPositions;
var
  pid
: integer;
  rembuffer
: PByte;
  hTarget
: THandle;
begin
  hTarget
:= GetSysListView32;
 
GetWindowThreadProcessId(hTarget, @pid);
 
if (hTarget = 0) or (pid = 0) then
   
Exit;
  rembuffer
:= CreateRemoteBuffer(pid, $FFF);
 
if Assigned(rembuffer) then
 
begin
   
SaveListItemPosition(hTarget, rembuffer);
   
DestroyRemoteBuffer;
 
end;
end;
 
procedure
RestoreDesktopItemPositions;
var
  hTarget
: THandle;
  pid
: DWord;
  rembuffer
: PByte;
begin
  hTarget
:= GetSysListView32;
 
GetWindowThreadProcessId(hTarget, @pid);
 
if (hTarget = 0) or (pid = 0) then
   
Exit;
  rembuffer
:= CreateRemoteBuffer(pid, $FFF);
 
if Assigned(rembuffer) then
 
begin
   
RestoreListItemPosition(hTarget, rembuffer);
   
DestroyRemoteBuffer;
 
end;
end;
 
end.
unit uvirtalloc;
 
interface
 
uses
 
Windows, SysUtils;
 
function CreateRemoteBuffer(Pid : DWord; Size: Dword): PByte;
procedure
WriteToRemoteBuffer(Source : PByte;
                               
Dest : PByte;
                               
Count : Dword);
 
function ReadRemoteBuffer (Source : PByte;
                           
Dest : PByte;
                           
Count : Dword): Dword;
 
procedure
DestroyRemoteBuffer;
 
implementation
 
var
  hProcess
: THandle;
 
RemoteBufferAddr: PByte;
 
BuffSize : DWord;
 
function CreateRemoteBuffer;
begin
 
RemoteBufferAddr := nil;
  hProcess
:= OpenProcess(PROCESS_ALL_ACCESS, FALSE, Pid);
 
if (hProcess = 0) then
    RaiseLastWin32Error
;
 
 
Result := VirtualAllocEx(hProcess,
                           
nil,
                           
Size,
                            MEM_COMMIT
,
                            PAGE_EXECUTE_READWRITE
);
 
  Win32Check
(Result <> nil);
 
RemoteBufferAddr := Result;
 
BuffSize := Size;
end;
 
procedure
WriteToRemoteBuffer;
var
 
BytesWritten: Dword;
begin
 
if hProcess = 0 then
   
Exit;
 Win32Check
(WriteProcessMemory(hProcess,
                               
Dest,
                               
Source,
                               
Count,
                               
BytesWritten));
end;
 
function ReadRemoteBuffer;
begin
 
Result := 0;
 
if hProcess = 0 then
     
Exit;
 
  Win32Check
(ReadProcessMemory(hProcess,
                               
Source,
                               
Dest ,
                               
Count,
                               
Result));
end;
 
procedure
DestroyRemoteBuffer;
begin
   
if (hProcess > 0)  then
     
begin
       
if Assigned(RemoteBufferAddr) then
         Win32Check
(Boolean(VirtualFreeEx(hProcess,
                                         
RemoteBufferAddr,
                                         
0,
                                          MEM_RELEASE
)));
       
CloseHandle(hProcess);
     
end;
end;
 
end.

Other Source for NT, Win2k, XP only:

https://www.luckie-online.de/programme/luckiedipssfx.exe

(Complete demo to save/restore the positions of desktop icons, nonVCL)

Взято с сайта https://www.swissdelphicenter.ch/en/tipsindex.php