Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Низкоуровневое программирование > Win Api
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 21.02.2014, 12:47   #31
Аватар
Старожил
 
Аватар для Аватар
 
Регистрация: 17.11.2010
Сообщений: 19,042
По умолчанию

Чет не понял какая беда. Все ест вплоть до HIcon
Код:
type
  GRPICONDIR = packed record
    idReserved:Word;//зарезервировано, всегда 0
    idType:Word;    //тип образа: 1 - иконка, 0 - курсор
    idCount:Word;   //число иконок типа RT_ICON
  end;
  PGRPICONDIR = ^GRPICONDIR;

  GRPICONDIRENTRY = packed record
    bWidth:Byte;       //ширина иконки в пикселях (если больше 255, то 0)
    bHeight:Byte;      //высота иконки в пикселях (если больше 255, то 0)
    bColorCount:Byte;  //число цветов (если больше 255, то 0)
    bReserved:Byte;    //зарезервировано, всегда 0
    wPlanes:Word;      //?
    wBitCount:Word;    //глубина цвета, в битах
    dwBytesInRes:DWORD;//размер в байтах битового образа иконки
    nId:Word;          //ID ресурса иконки
  end;
  PGRPICONDIRENTRY = ^GRPICONDIRENTRY;

function EnumResourceNamesCallback(hModule: HMODULE; lpType, lpName: PAnsiChar; lParam: Longint): BOOL; stdcall;
var sn,st: String;
    HRsrc,Data,HRsrcIcon,DataIcon: THandle;
    pGrp: PGRPICONDIR;
    pElm: PGRPICONDIRENTRY;
    i: Integer;
    LockIcon: Pointer;
    Icon: HIcon;
begin
  Result:=True;
  if HiWord(Cardinal(lpName))<>0 then sn:=lpName else sn:=Format('#%d',[LOWORD(lpName)]);
  if HiWord(Cardinal(lpType))<>0 then st:=lpType else st:=Format('#%d',[LOWORD(lpType)]);
  Form1.Memo1.Lines.Add(Format('Type=%s Name=%s',[st,sn]));
  HRsrc:=FindResource(hModule,lpName,lpType);
  if HRsrc=0 then Exit;
  Data:=LoadResource(hModule,HRsrc);
  if Data=0 then Exit;
  try
    pGrp:=LockResource(Data);
    if pGrp=nil then Exit;
    Form1.Memo1.Lines.Strings[Form1.Memo1.Lines.Count-1]:=
      Form1.Memo1.Lines.Strings[Form1.Memo1.Lines.Count-1]+Format(' Count=%d',[pGrp^.idCount]);
    pElm:=PGRPICONDIRENTRY(DWORD(pGrp)+SizeOf(GRPICONDIR));
    for i:=1 to pGrp^.idCount do begin
      try
        Form1.Memo1.Lines.Add(Format('%d Id=%d',[i,pElm^.nId]));
        HRsrcIcon:=FindResource(hModule,MakeIntResource(pElm^.nId),RT_ICON);
        if HRsrcIcon=0 then Continue;
        DataIcon:=LoadResource(hModule,HRsrcIcon);
        if DataIcon=0 then Continue;
        try
          LockIcon:=LockResource(DataIcon);
          if LockIcon=nil then Continue;
          Icon:=CreateIconFromResourceEx(LockIcon,SizeofResource(hModule,DataIcon),True,$00030000,0,0,LR_DEFAULTCOLOR);
          if Icon=0 then Continue;
          Form1.Memo1.Lines.Strings[Form1.Memo1.Lines.Count-1]:=
            Form1.Memo1.Lines.Strings[Form1.Memo1.Lines.Count-1]+Format(' HIcon=%d',[DWORD(Icon)]);
          DestroyIcon(Icon);
        finally
          FreeResource(DataIcon);
        end;
      finally
        pElm:=PGRPICONDIRENTRY(DWORD(pElm)+SizeOf(GRPICONDIRENTRY));
      end;
    end;
  finally
    FreeResource(Data);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var xModule: HMODULE;
begin
  xModule:=LoadLibraryEx(PChar('shell32.dll'),0,LOAD_LIBRARY_AS_DATAFILE);
  if (xModule=INVALID_HANDLE_VALUE) then Exit;
  EnumResourceNames(xModule,RT_GROUP_ICON,@EnumResourceNamesCallback,0);
  FreeLibrary(xModule);
end;
Если бы архитекторы строили здания так, как программисты пишут программы, то первый залетевший дятел разрушил бы цивилизацию
Аватар вне форума Ответить с цитированием
Старый 22.02.2014, 17:24   #32
3D Hunter
Сумрачная тень
Форумчанин
 
Аватар для 3D Hunter
 
Регистрация: 05.03.2009
Сообщений: 689
По умолчанию

Все работает. Спасибо! Ошибка была совсем в другом. Моя невнимательность.
"ковыряю изнутри" (с)
3D Hunter вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

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

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Получить имена физических дисков. Ant-kul C# (си шарп) 2 16.12.2012 15:08
Получить имена всех листов в книге Temnota Microsoft Office Excel 6 26.12.2009 07:36
Получить список ресурсов и сохранить их отдельно Alex Cones Общие вопросы Delphi 16 14.11.2009 13:45
Получить HWND рабочего стола без иконок Son Win Api 4 24.06.2009 15:57
Получить доменные имена lamerx Работа с сетью в Delphi 1 10.10.2008 16:57