[bambus]

Добрый день!
Подскажите пожалуйста, а лучше привести часть кода, чтобы определить расположение ярлыка по которму была запущена программа.
Цель - получить координаты этого ярлыка, чтобы форма программы была расположена точь-в-точь в начальных координатах ярлыка.
Еще точнее - хочу сделать замену вложенным папкам для группировки программ на рабочем столе (по аналогии с андроидом).

[Alegun]

Сообщение от bambus

...определить путь по которому была запущена программа...

Код:

unit Unit1;
{©Drkb v.3(2007): www.drkb.ru}
interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
   Button1: TButton;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses TlHelp32;

function GetExeFilePath(ExeFileName: String): String;
var
hSnapshot, hSnapshot2: THandle;
Proc: TProcessEntry32;
m: TModuleEntry32;
begin
Result := '';
hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
try
   proc.dwSize := Sizeof(proc);
   if Process32First(hSnapshot, proc) then
   repeat
     if AnsiSameText(proc.szExeFile, ExeFileName) then
     begin
       hSnapshot2 := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,
         proc.th32ProcessID);
       try
         m.dwSize := SizeOf(TModuleEntry32);
         if Module32First(hSnapshot2, m) then
         begin
           Result := m.szExePath;
           Exit;
         end;
       finally
         CloseHandle(hSnapshot2);
       end;
     end;
   until not Process32Next(hSnapshot, proc);
finally
   CloseHandle(hSnapshot);
end;
end;

...определить расположение ярлыка по которму была запущена программа...

он скорее всего на рабочем столе, узнать подробную инфу из него

Код:

uses ShlObj, ComObj, ActiveX, CommCtrl; 
type 
PShellLinkInfoStruct = ^TShellLinkInfoStruct; 
TShellLinkInfoStruct = record 
   FullPathAndNameOfLinkFile: array[0..MAX_PATH] of Char; 
   FullPathAndNameOfFileToExecute: array[0..MAX_PATH] of Char; 
   ParamStringsOfFileToExecute: array[0..MAX_PATH] of Char; 
   FullPathAndNameOfWorkingDirectroy: array[0..MAX_PATH] of Char; 
   Description: array[0..MAX_PATH] of Char; 
   FullPathAndNameOfFileContiningIcon: array[0..MAX_PATH] of Char; 
   IconIndex: Integer; 
   HotKey: Word; 
   ShowCommand: Integer; 
   FindData: TWIN32FINDDATA; 
end; 

procedure GetLinkInfo(lpShellLinkInfoStruct: PShellLinkInfoStruct); 
var 
ShellLink: IShellLink; 
PersistFile: IPersistFile; 
AnObj: IUnknown; 
begin 
// access to the two interfaces of the object 
AnObj       := CreateComObject(CLSID_ShellLink); 
ShellLink   := AnObj as IShellLink; 
PersistFile := AnObj as IPersistFile; 

// Opens the specified file and initializes an object from the file contents. 
PersistFile.Load(PWChar(WideString(lpShellLinkInfoStruct^.FullPathAndNameOfLinkFile)), 0); 

with ShellLink do 
begin 
   // Retrieves the path and file name of a Shell link object. 
   GetPath(lpShellLinkInfoStruct^.FullPathAndNameOfFileToExecute, 
     SizeOf(lpShellLinkInfoStruct^.FullPathAndNameOfLinkFile), 
     lpShellLinkInfoStruct^.FindData, 
     SLGP_UNCPRIORITY); 

   // Retrieves the description string for a Shell link object. 
   GetDescription(lpShellLinkInfoStruct^.Description, 
     SizeOf(lpShellLinkInfoStruct^.Description)); 

   // Retrieves the command-line arguments associated with a Shell link object. 
   GetArguments(lpShellLinkInfoStruct^.ParamStringsOfFileToExecute, 
     SizeOf(lpShellLinkInfoStruct^.ParamStringsOfFileToExecute)); 

   // Retrieves the name of the working directory for a Shell link object. 
   GetWorkingDirectory(lpShellLinkInfoStruct^.FullPathAndNameOfWorkingDirectroy, 
     SizeOf(lpShellLinkInfoStruct^.FullPathAndNameOfWorkingDirectroy)); 

   // Retrieves the location (path and index) of the icon for a Shell link object. 
   GetIconLocation(lpShellLinkInfoStruct^.FullPathAndNameOfFileContiningIcon, 
     SizeOf(lpShellLinkInfoStruct^.FullPathAndNameOfFileContiningIcon), 
     lpShellLinkInfoStruct^.IconIndex); 

   // Retrieves the hot key for a Shell link object. 
   GetHotKey(lpShellLinkInfoStruct^.HotKey); 

   // Retrieves the show (SW_) command for a Shell link object. 
   GetShowCmd(lpShellLinkInfoStruct^.ShowCommand); 
end; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
const 
br = #13#10; 
var 
LinkInfo: TShellLinkInfoStruct; 
s: string; 
begin 
FillChar(LinkInfo, SizeOf(LinkInfo), #0); 
LinkInfo.FullPathAndNameOfLinkFile := 'C:\WINNT\Profiles\user\Desktop\FileName.lnk'; 
GetLinkInfo(@LinkInfo); 
with LinkInfo do 
   s := FullPathAndNameOfLinkFile + br + 
     FullPathAndNameOfFileToExecute + br + 
     ParamStringsOfFileToExecute + br + 
     FullPathAndNameOfWorkingDirectroy + br + 
     Description + br + 
     FullPathAndNameOfFileContiningIcon + br + 
     IntToStr(IconIndex) + br + 
     IntToStr(LoByte(HotKey)) + br + 
     IntToStr(HiByte(HotKey)) + br + 
     IntToStr(ShowCommand) + br + 
     FindData.cFileName + br + 
     FindData.cAlternateFileName; 
Memo1.Lines.Add(s); 
end;

...Цель - получить координаты этого ярлыка...

сначало нужно получить дескриптор рабочего стола, который представляет из себя обычный ListView

Код:

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;

а дальше - вот пример сохранения/изменения координат ярлычков на рабочке

Код:

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

З.Ы.

...чтобы форма программы была расположена точь-в-точь в начальных координатах ярлыка...

при показе формы подставить ей координаты относительно GetCursorPos() или

Код:

Form1.Left:= mouse.CursorPos.x;
Form1.Top:= mouse.CursorPos.y;