whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1541)

Database (90)
Files (137)
Forms (107)
Graphic (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Math (76)
Misc (126)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (266)
VCL (242)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

27 Visitors Online


 
...get/set the positions of desktop icons?
Autor: Anthony Baratta / Alexander Kramarenko
[ Print tip ]  

Tip Rating (53):  
     




// 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, nilnil);
  Result := FindWindowEx(Result, 0, nilnil);
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)

 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners