完整的……最后混点分分！
function TMainForm.RefreshScreenIcons:BOOL;
var
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;
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
// 1. open HKEY_CURRENT_USER/Control Panel/Desktop/WindowMetrics
if OpenKey('Control Panel/Desktop/WindowMetrics', False) then
begin
// 2. Get the value for that key
strDataRet := ReadString('Shell Icon Size');
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 OpenKey('Control Panel/Desktop/WindowMetrics', False) then
begin
WriteString('Shell Icon Size', strDataRet2);
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 OpenKey('Control Panel/Desktop/WindowMetrics', False) then
begin
WriteString('Shell Icon Size', strDataRet);
CloseKey;
// 6. broadcast the change again
BroadcastChanges;
Result := True;
end;
end;
end;
end;
finally
Free;
end;
end;
