afa opening a specific tab in the property page, I wrote this for CommentConfig and it's hard-wired to open the Comment tab, but it could be generalized.
What's not shown in this code snip is processing WMDropFiles message.
I load a StringList with the file names from the drag & drop. The way
I used it, if the CommentConfig program was open you could drag & drop
a bunch of files onto the program form and it would open them all to the
Comment Property Page Tab if it existed, instead of doing it by hand for
each file.
sei is an array of SHELLEXECUTEINFO structs with the same length
as FileList that you find out by handling WMDropFiles.
for each file dropped it does ShellExecuteEx with the 'properties' verb.
Then it looks for a child window with a Title containing whatever string
you are looking for. In this case 'Comment'
procedure TForm1.ProcessFiles;
var
x: Integer;
CharsCopied: Cardinal;
WindowHandle, CommentHandle: HWND;
MyMsg: TMessage;
AnError, Found: boolean;
MaxTabs: Integer;
begin
MaxTabs := 4;
for x := 0 to Count - 1 do
begin
AnError := False;
Found := False;
ZeroMemory(@sei[x], sizeof(SHELLEXECUTEINFO));
sei[x].cbSize := sizeof(SHELLEXECUTEINFO);
sei[x].fMask := SEE_MASK_INVOKEIDLIST;
sei[x].lpVerb := 'properties';
sei[x].nShow := SW_SHOW;
sei[x].lpFile := PChar(FileNameList[x]);
sei[x].Wnd := Handle;
if not ShellExecuteEx(@sei[x]) then
raise Exception.Create('ShellExecuteEx Failed!');
Sleep(500);
WindowHandle := GetForegroundWindow;
MyMsg.Msg := PSM_SETCURSEL;
MyMsg.lParam := 0;
MyMsg.wParam := 1;
while (not AnError) and (MyMsg.wParam < MaxTabs) and (not Found) do
begin
if not PostMessage(WindowHandle, MyMsg.Msg, MyMsg.wParam, MyMsg.lParam) then
begin
ShowMessage('PostMessage Error!');
AnError := True;
end;
Sleep(200);
CommentHandle := GetWindow(WindowHandle, GW_CHILD);
CharsCopied := GetWindowText(CommentHandle, Title, sizeof(Title) - 1);
if Pos('Comment', Title) > 0 then
Found := True;
Inc(MyMsg.wParam);
end; // While
end; // For
end; // ProcessFiles
Show Posts
