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

// 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) Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...