Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Рабочий стол
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 19.02.2015, 15:44
DJDrugsounD DJDrugsounD вне форума
Прохожий
 
Регистрация: 29.06.2012
Сообщения: 11
Репутация: 10
Вопрос скриншот иконок рабочего стола

Доброе время суток. Стоит задача сделать скриншот рабочего стола без обоев, чтоб были только иконки на прозрачном фоне. Возможно ли это?
Ответить с цитированием
  #2  
Старый 19.02.2015, 18:19
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

можно с рабочего стола получить все элементы и уже потом отрисовать их на Bitmap.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #3  
Старый 20.02.2015, 10:30
DJDrugsounD DJDrugsounD вне форума
Прохожий
 
Регистрация: 29.06.2012
Сообщения: 11
Репутация: 10
По умолчанию

Цитата:
Сообщение от NumLock
можно с рабочего стола получить все элементы и уже потом отрисовать их на Bitmap.

А не подскажите как это сделать?

Нагуглил как добраться до элементов рабочего стола
Код:
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;
но потом можно получить только координаты элементов путём отправки сообщения LVM_GETITEMPOSITION.

А как получить иконку или же сам элемент целиком чтоб отрисовать его на битмапе неизвестно.
Ответить с цитированием
  #4  
Старый 20.02.2015, 11:21
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

через LVM_GETITEM получить имя ярлыка, далее через IShellLink и IPersistFile получить исходный объект, иконку...
для LVM_GETITEM выделять память/писать/читать через VirtualAllocEx / WriteProcessMemory / ReadProcessMemory
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #5  
Старый 21.02.2015, 22:03
DJDrugsounD DJDrugsounD вне форума
Прохожий
 
Регистрация: 29.06.2012
Сообщения: 11
Репутация: 10
По умолчанию

Нашёл вот такой код
Код:
procedure TForm1.GetListViewGrid(ALVHandle: HWND; AColumnCount, AItemCount: Integer; ADataGrid: TStringGrid);
const
cchTextMax=255;
var
  hProcess: THandle;
  dwProcessID: DWORD;
   dwWriten: SIZE_T;
  LVItemCount: Integer;
  i, j, nTextLength: Integer;
  pLVItem: ^LV_ITEM;
  LVItem: LV_ITEM;
  pszText: PChar;
  svText: ShortString;
begin
  if ALVHandle = 0 then Exit;
  // Получаем количество строк
  LVItemCount := ListView_GetItemCount(ALVHandle);
 if AItemCount > LVItemCount then exit;
 if AItemCount > 0 then LVItemCount:=AItemCount;
 //Получаем ID процесса, которому принадлежит найденное окно
 dwProcessID := 0;
  GetWindowThreadProcessId(ALVHandle, @dwProcessID);
 if dwProcessID = 0 then
  ExitProcess(GetLastError);
  // Открываем процесс
  hProcess := 0;
  hProcess := OpenProcess(PROCESS_ALL_ACCESS, True, dwProcessID);
  if hProcess = 0 then
  ExitProcess(GetLastError);
  // Выделяем в нем память под текстовый буффер
  pszText := VirtualAllocEx(hProcess, nil, cchTextMax,
                            MEM_COMMIT or MEM_TOP_DOWN, PAGE_READWRITE);
   // Выделяем в нем память под структуру LVITEM
  pLVItem := VirtualAllocEx(hProcess, nil, SizeOf(LV_ITEM),
                                     MEM_COMMIT or MEM_TOP_DOWN, PAGE_READWRITE);
  //Устанавливаем колич строк и столбцов в TStringGrid
  ADataGrid.RowCount := LVItemCount ;
  ADataGrid.ColCount := AColumnCount ;

  // Заполняем структуру
  ZeroMemory(@LVItem, SizeOf(LV_ITEM));
  LVItem.mask := LVIF_TEXT;
  LVItem.pszText := pszText;
  LVItem.cchTextMax := cchTextMax;

  //Считываем строки
  for i := 0 to LVItemCount - 1 do
  begin
    LVItem.iSubItem := 0;
    // Пишем ее в память удаленного процесса
    if not WriteProcessMemory(hProcess, pLVItem, @LVItem,
                 SizeOf(LV_ITEM), dwWriten) then Exit;
    nTextLength := SendMessage(ALVHandle, LVM_GETITEMTEXT,
                                i, Integer(pLVItem));
    // Читаем результат
    ZeroMemory(@svText, cchTextMax);
    ReadProcessMemory(hProcess, LVItem.pszText, @svText[1],
     nTextLength, dwWriten);
     //заполняем строки TStringGrid
    ADataGrid.Cells[0, i + 1] := StrPas(PChar(@svText[1]));
    Memo1.Lines.Add(StrPas(PChar(@svText[1])));
   //Считываем столбцы
   for j := 0 to AColumnCount - 1 do
    begin
      LVItem.iSubItem := j;
      // Пишем ее в память удаленного процесса
      if not WriteProcessMemory(hProcess, pLVItem, @LVItem,
                                SizeOf(LV_ITEM), dwWriten) then Exit;
      nTextLength := SendMessage(ALVHandle, LVM_GETITEMTEXT,
                                 i, Integer(pLVItem));
      // Читаем результат
      ZeroMemory(@svText, cchTextMax);
      ReadProcessMemory(hProcess, LVItem.pszText,
                        @svText[1], nTextLength, dwWriten);
      //заполняем столбцы TStringGrid
      ADataGrid.Cells[j + 1, i + 1] := StrPas(PChar(@svText[1]));
    end;
  end;

 // Освобождаем ранее выделенную память
  VirtualFreeEx(hProcess, pszText, 0, MEM_RELEASE);
  VirtualFreeEx(hProcess, pLVItem, 0, MEM_RELEASE);
  // Закрываем описатель процесса
  CloseHandle(hProcess);
end;

по идеи должен считать названия всех элементов рабочего стола. Не работает, вместо текста каждого элемента пустое значение.
Ответить с цитированием
  #6  
Старый 22.02.2015, 09:04
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

ну не я же буду в чужом коде разбираться, правильно?

Код:
procedure TFormMain.FillListView(hListView: THandle);
var
  ProcessId: DWORD;
  hProcess: DWORD;
  ItemCount: Integer;
  i: Integer;
  BufItem: PChar;
  data: array [0..MAX_PATH-1] of Char;
  BufText: PChar;
  LVItem: TLVItem;
  dummy: Cardinal;
  APoint: TPoint;
  itm: TListItem;
begin
  GetWindowThreadProcessId(hListView, ProcessId);
  hProcess:=OpenProcess(PROCESS_ALL_ACCESS, False, ProcessId);
  try
    ItemCount:=ListView_GetItemCount(hListView);
    for i:=0 to ItemCount-1 do
    begin
      BufItem:=VirtualAllocEx(hProcess, nil, SizeOf(TLVItem)+Length(data), MEM_COMMIT, PAGE_EXECUTE_READWRITE);
      try
        BufText:=BufItem;
        Inc(BufText, SizeOf(TLVItem));
        ZeroMemory(@LVItem, SizeOf(TLVItem));
        LVItem.mask:=LVIF_TEXT or LVIF_IMAGE;
        LVItem.iItem:=i;
        LVItem.pszText:=BufText;
        LVItem.cchTextMax:=Length(data);
        WriteProcessMemory(hProcess, BufItem, @LVItem, SizeOf(TLVItem), dummy);
        SendMessage(hListView, LVM_GETITEM, i, LPARAM(BufItem));
        ReadProcessMemory(hProcess, BufItem, @LVItem, SizeOf(TLVItem), dummy);
        ReadProcessMemory(hProcess, BufText, @data[0], Length(data), dummy);
        SendMessage(hListView, LVM_GETITEMPOSITION, i, LPARAM(BufText));
        ReadProcessMemory(hProcess, BufText, @APoint, SizeOf(TPoint), dummy);
        itm:=ListView.Items.Add;
        itm.Caption:=StrPas(@data[0]);
        itm.SetPosition(APoint);
      finally
        VirtualFreeEx(hProcess, BufItem, 0, MEM_RELEASE);
      end;
    end;
  finally
    CloseHandle(hProcess);
  end;
end;
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #7  
Старый 25.02.2015, 19:26
DJDrugsounD DJDrugsounD вне форума
Прохожий
 
Регистрация: 29.06.2012
Сообщения: 11
Репутация: 10
По умолчанию

Цитата:
Сообщение от NumLock
ну не я же буду в чужом коде разбираться, правильно?

спасибо, но всё ровно не работало, были пустые значения.
Но погуглив я узнал что всё из за того что моя система 64 битная. Поэтому чтобы всё работало нужно либо скомпилировать программу под 64 бита, либо использовать другую структуру данных LVItem.

Код:
  TLVItem64 = packed record
    mask      : LongWord;   
    iItem     : LongInt;
    iSubItem  : LongInt;
    state     : LongWord;
    stateMask : LongWord;
    alignment1: LongWord;
    pszText   : Int64;
    cchTextMax: LongInt;
    iImage    : LongInt;
    lParam    : Int64;
    iIndent   : LongInt;
    iGroupId  : LongInt;
    cColumns  : LongWord;
    alignment2: LongWord;
    puColumns : Int64;
    piColFmt  : Int64;
    iGroup    : LongInt;
    alignment3: LongWord;
  end;

с этой структурой всё работает
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 07:37.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter