Вызывает диалог выбора иконки

Delphi , Программа и Интерфейс , Диалоги и Фреймы

Автор: Babay_S
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Вызывает диалог выбора иконки (как при смене значка на десктопе)

Зависимости: uses activex;
Автор:       Babay_S
Copyright:   Мои раскопки
Дата:        27 сентября 2002 г.
***************************************************** }

uses activex;

function ChangeIconDialog(hOwner: LongInt; Filename: string; var IconIndex:
  LongInt): LongInt;
{Вызывает диалог выбора иконки (как при смене значка на десктопе)
Параметры
hOwner - хэндл родителя.
FileName - полный путь файла с иконками (должен существовать).
Если в указанном файле нет иконок, вызываются иконки Shell32.dll.
IconIndex возвращает номер иконки в файле.
Результат выполнения функции возвращает 1 если иконка выбрана и 0 если отмена
Далее эту иконку можно вытащить с помощью вполне документированной функции
ExtractIconEx из той же библиотеки.
}

implementation

function SHChangeIconDialog(hOwner: LongInt; sFilename: LPWSTR; nBuf: LongInt;
  var nIconIndex: LongInt): LongInt;
  stdcall; external 'Shell32.dll' index 62;

function ChangeIconDialog(hOwner: LongInt; Filename: string; var IconIndex:
  LongInt): LongInt;
var
  nFileName: LPWSTR;
  FNLen: Integer;
  i: LongInt;
begin
  FNLen := Length(FileName) + 1;
  nFileName := CoTaskMemAlloc(FnLen * sizeof(WideChar));
  StringToWideChar(FileName, nFileName, FnLen);
  if FileName = '' then
    nFileName := nil;
  Result := SHChangeIconDialog(hOwner, nFileName, 0, IconIndex);
  CoTaskMemFree(nFileName);
end;

Доработанная функция

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Вызывает диалог выбора иконки. Доработанная

Функция вызова диалогового окно "Изменение иконки"

Зависимости: Windows, SysUtils
Автор:       Alex Sal'nikov, alex-co@narod.ru, Москва
Copyright:   Доработка библиотеки JVCL
Дата:        15 июля 2003 г.
***************************************************** }

uses
  Windows, SysUtils;

function ChangeIconDialog(hOwner: tHandle; var FileName: string; var IconIndex:
  Integer): Boolean;
// Функция вызова диалогового окно "Изменение иконки"

implementation

resourcestring
  SNotSupported = 'This function is not supported by your version of Windows';

function ChangeIconDialog(hOwner: tHandle; var FileName: string; var IconIndex:
  Integer): Boolean;
type
  SHChangeIconProc = function(Wnd: HWND; szFileName: PChar; Reserved: Integer;
    var lpIconIndex: Integer): DWORD; stdcall;
  SHChangeIconProcW = function(Wnd: HWND; szFileName: PWideChar;
    Reserved: Integer; var lpIconIndex: Integer): DWORD; stdcall;
const
  Shell32 = 'shell32.dll';
var
  ShellHandle: THandle;
  SHChangeIcon: SHChangeIconProc;
  SHChangeIconW: SHChangeIconProcW;
  Buf: array[0..MAX_PATH] of Char;
  BufW: array[0..MAX_PATH] of WideChar;
begin
  Result := False;
  SHChangeIcon := nil;
  SHChangeIconW := nil;
  ShellHandle := Windows.LoadLibrary(PChar(Shell32));
  try
    if ShellHandle <> 0 then
    begin
      if Win32Platform = VER_PLATFORM_WIN32_NT then
        SHChangeIconW := GetProcAddress(ShellHandle, PChar(62))
      else
        SHChangeIcon := GetProcAddress(ShellHandle, PChar(62));
    end;

    if Assigned(SHChangeIconW) then
    begin
      StringToWideChar(FileName, BufW, SizeOf(BufW));
      Result := SHChangeIconW(hOwner, BufW, SizeOf(BufW), IconIndex) = 1;
      if Result then
        FileName := BufW;
    end
    else if Assigned(SHChangeIcon) then
    begin
      StrPCopy(Buf, FileName);
      Result := SHChangeIcon(hOwner, Buf, SizeOf(Buf), IconIndex) = 1;
      if Result then
        FileName := Buf;
    end
    else
      raise Exception.Create(SNotSupported);
  finally
    if ShellHandle <> 0 then
      FreeLibrary(ShellHandle);
  end;
end;

Пример использования:

procedure TForm1.Button1Click(Sender: TObject);
var
  file: string;
  index: Integer;
begin
  ChangeIconDialog(Handle, file, index);
  Edit1.Text := file;
  Edit2.Text := IntToStr(index);
end;

Перевод контента на русский язык:

Код Delphi создает диалоговое окно для выбора иконки. Функция ChangeIconDialog принимает три параметра:.handle владельца окна, строку, содержащую полный путь к файлу с иконками, и переменную, возвращающую индекс выбранной иконки.

Код использует библиотеку Shell32.dll для отображения диалогового окна выбора иконки. Если система не поддерживает эту функцию, она будет вызывать исключение с сообщением "Функция не поддерживается вашей версией Windows".

Разбивка кода:

1. Первая часть кода определяет функцию ChangeIconDialog и ее параметры.
2. Секция реализации кода использует функции CoTaskMemAlloc и CoTaskMemFree для выделения и освобождения памяти для широкого символьного массива, который используется для хранения имени файла.
3. Функция SHChangeIconDialog вызывается с параметрами владельца окна, имени файла и индекса иконки. Эта функция отображает диалоговое окно выбора иконки.
4. Если система не поддерживает эту функцию, она будет вызывать исключение.
5. Код использует блок try-finally для освобождения памяти, выделенной для имени файла.

Вторая часть кода - это модифицированная версия той же функции, но с дополнительной обработкой ошибок и поддержкой 64-разрядных систем.

Новые элементы в второй части кода:

1. Секция resourcestring определяет строковый константный, который будет использоваться для отображения сообщения об ошибке, если система не поддерживает эту функцию.
2. Код использует тип alias (SHChangeIconProc) для определения указателя на функцию SHChangeIcon.
3. Код также определяет другой тип alias (SHChangeIconProcW) для широкосимвольной версии функции SHChangeIcon.
4. Код загружает библиотеку shell32.dll и получает указатель на функцию SHChangeIcon или SHChangeIconW, в зависимости от архитектуры системы.
5. Если система не поддерживает эту функцию, она будет вызывать исключение с сообщением "Функция не поддерживается вашей версией Windows".

Код также включает в себя раздел примера использования, который демонстрирует, как вызвать функцию ChangeIconDialog и отобразить индекс выбранной иконки в текстовом редакторе.

В целом, этот код предоставляет способ выбора иконки с помощью диалогового окна и возвращает индекс выбранной иконки. Код спроектирован для работы на обоих 32-разрядных и 64-разрядных системах, а также включает обработку ошибок для ловли исключений, которые могут возникнуть при выполнении кода.

Вызывает диалог выбора иконки, позволяющий пользователю изменить значок в приложении.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Диалоги и Фреймы ::