//-----------Процедуры для объявления иконок-------------------

const

  sr_WindowMetrics='Control Panel\Desktop\WindowMetrics\';

  sr_ShellIconSize='Shell Icon Size';

  WaitCount: Integer=0;

  SaveCursor: TCursor=crDefault;

  WaitCursor: TCursor=crHourGlass;

 

procedure StartWait;

//Устанавливает курсор ожидания (ф-я из RXLib модуль VCLUtils)

begin

  if WaitCount=0 then

    begin

      SaveCursor:=Screen.Cursor;

      Screen.Cursor:=WaitCursor;

    end;

  Inc(WaitCount);

end;

 

procedure StopWait;

//Снимает курсор ожидания (ф-я из RXLib модуль VCLUtils)

begin

  if WaitCount>0 then

    begin

      Dec(WaitCount);

      if WaitCount=0 then

        Screen.Cursor:=SaveCursor;

    end;

end;

 

function WindowsDir: string;

var

  Buffer: array[0..255] of Char;

begin

  GetWindowsDirectory(@Buffer, SizeOf(Buffer));

  Result:=Buffer;

end;

 

function UpdateAllWindowsCallback(WHandle: HWnd; var Parm: Pointer): Boolean; stdcall;

begin

  SendMessage(WHandle, WM_SETTINGCHANGE, 0, 0);

  Result:=true;

end;

 

procedure UpdateAllWindows;

begin

  EnumWindows(@UpdateAllWindowsCallback, WM_SETTINGCHANGE);

end;

 

 

function GetIconCacheFile: string;

begin

  Result:=WindowsDir+'ShellIconCache';

end;

 

procedure DeleteIconCache;

var

  sfile: string;

begin

  sfile:=GetIconCacheFile;

  if fileexists(sfile) then

    begin

      if deletefile(sfile)=false then

        ShowMessage('Can not erase file: '+sfile);

    end;

  // QueryRestartWindows;  //<-- Я не понял, где эта процеДура...

end;

 

 

function RefreshActiveDesktop: Boolean;

const

  CLSID_ActiveDesktop: TGUID='{75048700-EF1F-11D0-9888-006097DEACF9}';

var

  ActiveDesktop: IActiveDesktop;

begin

  try

    ActiveDesktop:=CreateComObject(CLSID_ActiveDesktop)as IActiveDesktop;

    ActiveDesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);

    Result:=true;

  except

    Result:=false;

  end;

end;

 

procedure RefreshDesktop;

var

  wnd: THandle;

  fl: Boolean;

begin

  fl:=RefreshActiveDesktop;

  if fl=false then

    begin

      wnd:=FindWindow('Progman', 'Program Manager');

      if wnd<>0 then

        SendMessage(wnd, WM_COMMAND, $A065, 0)

      else

        UpdateAllWindows;

    end;

end;

 

procedure TMainForm.RebuildIconCache;

var

  news, olds: string;

  sz: Integer;

  RegIni: TRegIniFile;

begin

  DialogExecute(Language.TranslateUserMessage('Please wait till the procedure of rebuilding the icons cache is completed. On old computers it can take up to 60 seconds. Click OK to start.'), Language.TranslateUserMessage('Note:'),

    Language.TranslateUserMessage('Do not show this dialog again'), mtInformation, [mbOk],

    PrDir+'Data.ini', 'Show', 'CacheUpdating', mbOk);

 

  StartWait;

  try

    deletefile(GetIconCacheFile);

    RegIni:=TRegIniFile.Create('');

    RegIni.RootKey:=HKEY_CURRENT_USER;

    olds:=RegIni.ReadString('Control Panel\Desktop\WindowMetrics', sr_ShellIconSize, '32');

 

    //Таким образом исправляем кривые размеры иконок, если в прошлый раз не было завершено обновление кэша

    if (olds='33')or(olds='34') then

      olds:='32'

    else if (olds='49')or(olds='50') then

      olds:='48';

 

    sz:=strtointdef(olds, 32);

    Inc(sz);

    news:=IntToStr(sz);

    RegIni.WriteString('Control Panel\Desktop\WindowMetrics', sr_ShellIconSize, news);

 

    UpdateAllWindows;

    if olds='' then

      olds:='32';

    RegIni.WriteString('Control Panel\Desktop\WindowMetrics', sr_ShellIconSize, olds);

    UpdateAllWindows;

    RefreshDesktop;

  finally

    StopWait;

  end;

end;

//-------------------------------------------------------------

SHChangeNotify(SHCNE_UPDATEIMAGE, SHCNF_DWORD, nil,nil);