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 sDataRet <> '' then begin // 3. Convert sDataRet to a number and subtract 1, // convert back to a string, and write it to the registry sDataRet2 := 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;