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

=== Как получить и изменить координаты иконок на столе? ===
// 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:
 http://www.luckie-online.de/programme/luckiedipssfx.exe
 (Complete demo to save/restore the positions of desktop icons, nonVCL)
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 01832