Архив исходников программ, модулей и компонентов на Delphi


Начальная страница

Поиск по базе



Операционная система
Настройка приложения
Взаимодействия приложений
Файлы и директории
Строки и символы
Математика
Базы данных
Интернет и сеть
Мультимедиа
Аппаратная часть
VCL
Другие разделы [0]
 

Количество записей в базе - 537
Сегодня добавлено – 0

Диалоговые окна



Вернуться к списку функций
 Вызывает диалог выбора иконки. Доработанная

 Прислал: Alex Sal'nikov (Москва) ( 15 июля 2003 г. )
©  Доработка библиотеки JVCL
 Описание:
Функция вызова диалогового окно "Изменение иконки"

 Зависимости:
Windows, SysUtils

 Ограничения:
Проверено в D7 и WinXP, должно работать под D3-D7, не поддерживается в Win95

 Исходный текст:
{ **** UBPFD *********** by http://kladovka.net.ru/delphibase/ ****
>> Вызывает диалог выбора иконки. Доработанная

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

Зависимости: 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;


Вернуться к списку функций

Наверх ▲