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

Code:

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;

Code:

//-------------------------------------------

// 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.

Code:

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.