Registriert seit: 1. Feb 2018
3.691 Beiträge
Delphi 11 Alexandria
|
AW: Wallpaper und Windows 8+
13. Okt 2018, 18:58
so habe ich es nun. in der hoffnung das alles korrekt ist widme ich mich nun tests.
Delphi-Quellcode:
function GetTranscodedImageCache: WideString;
const
CDataValue: string = 'TranscodedImageCache';
CKeyName: string = 'Control Panel\Desktop\';
var
regist: TRegistry;
KeyExists: Boolean;
vSize, i: Integer;
tmpStr: WideString;
begin
Result := '';
regist := TRegistry.Create(KEY_READ);
try
regist.RootKey := HKEY_CURRENT_USER;
try
KeyExists := regist.OpenKey(CKeyName, false);
if (KeyExists) then
begin
regist.Access := KEY_READ;
vSize := regist.GetDataSize(CDataValue);
if (vSize > 0) then
begin
tmpStr := '';
SetLength(tmpStr, vSize div 2);
regist.ReadBinaryData(CDataValue, tmpStr[1], vSize);
Delete(tmpStr,1,12);
for i := 1 to length(tmpStr)-1 do
if ( (tmpStr[i]=Char(#0)) and (tmpStr[i+1]=Char(#0)) ) then
begin
Delete(tmpStr, i, Length(tmpStr));
Break;
end;
Result := tmpStr;
end;
regist.CloseKey;
end;
except
regist.CloseKey;
end
finally
regist.Free;
end;
end;
function GetWallpaperBitmap: String;
const
SPI_GETDESKWALLPAPER = $0073;
var
wpFName: array [0..MAX_PATH] of Char;
begin
if SystemParametersInfo(SPI_GETDESKWALLPAPER, MAX_PATH, @wpFName, 0)
then Result := String(wpFName)
else Result := '';
end;
function GetWallpaperFilename: String;
var
tmpStr: String;
begin
tmpStr := GetWallpaperBitmap;
if Pos('TranscodedWallpaper',tmpStr) > 0 then
Result := GetTranscodedImageCache
else Result := tmpStr;
end;
Geändert von KodeZwerg (14. Okt 2018 um 11:53 Uhr)
|
|
Zitat
|