Содержание материала

Обновить иконки на экране

Code:

{

 Пользовательский интерфейс Твика от Microsoft имеет возможность перестроить кэш значков сейчас.

Затем Windows перестраивает свой внутренний кэш значков. К сожалению, нет единого API для этого.

}

 

uses

  Registry;

 

function RefreshScreenIcons : Boolean;

const

  KEY_TYPE = HKEY_CURRENT_USER;

  KEY_NAME = 'Control Panel\Desktop\WindowMetrics';

  KEY_VALUE = 'Shell Icon Size';

var

  Reg: TRegistry;

  strDataRet, strDataRet2: string;

 

procedure BroadcastChanges;

var

   success: DWORD;

begin

   SendMessageTimeout(HWND_BROADCAST,

                      WM_SETTINGCHANGE,

                      SPI_SETNONCLIENTMETRICS,

                      0,

                      SMTO_ABORTIFHUNG,

                      10000,

                      success);

end;

 

 

begin

  Result := False;

  Reg := TRegistry.Create;

  try

    Reg.RootKey := KEY_TYPE;

    // 1. open HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics

   if Reg.OpenKey(KEY_NAME, False) then

    begin

      // 2. Get the value for that key

     strDataRet := Reg.ReadString(KEY_VALUE);

      Reg.CloseKey;

      if strDataRet <> '' then

      begin

        // 3. Convert sDataRet to a number and subtract 1,

       //    convert back to a string, and write it to the registry

       strDataRet2 := IntToStr(StrToInt(strDataRet) - 1);

        if Reg.OpenKey(KEY_NAME, False) then

        begin

          Reg.WriteString(KEY_VALUE, strDataRet2);

          Reg.CloseKey;

          // 4. because the registry was changed, broadcast

         //    the fact passing SPI_SETNONCLIENTMETRICS,

         //    with a timeout of 10000 milliseconds (10 seconds)

         BroadcastChanges;

          // 5. the desktop will have refreshed with the

         //    new (shrunken) icon size. Now restore things

         //    back to the correct settings by again writing

         //    to the registry and posing another message.

         if Reg.OpenKey(KEY_NAME, False) then

          begin

            Reg.WriteString(KEY_VALUE, strDataRet);

            Reg.CloseKey;

            // 6.  broadcast the change again

           BroadcastChanges;

            Result := True;

          end;

        end;

      end;

    end;

  finally

    Reg.Free;

  end;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

  RefreshScreenIcons

end;

  

{

 В результате окно стирает все значки и пересчитывает их на основе параметров реестра.

Это означает, что если вы изменили раздел DefaultIcon в реестре для

некоторые приложения или файла, на экране появится новый значок, когда

завершено обновление.

 Translated from VB by Thomas Stutz

}

 

 

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить