Wallpaper und Windows 8+

[HolgerX]

Hmm..

Angelehnt an
https://github.com/kujason/FindWallp...dWallpaper.vbs

scheint bei nur einem Monitor das Bild in 'TranscodedImageCache' abgespeichert zu sein.

Bei meheren Monitoren wird ein '_XXX' als Index an TranscodedImageCache angehängt (z.B. TranscodedImageCache_000 für Monitor idx 0)
Dort steht in den BIN Daten dann zusätzlich hinter dem Bildnamen noch (meiner Meinung nach) die Device ID des Monitores.

----- Debuggerauszug des WideChar Array -------------------
('?', #1, '?', #8, '?', '', '?', '', '?', '?', '?', 'a', 'C', ':', '\', 'W', 'i', 'n', 'd', 'o', 'w', 's', '\', 'W', 'e', 'b', '\', 'W', 'a', 'l', 'l', 'p', 'a', 'p', 'e', 'r', '\', 'W', 'i', 'n', 'd', 'o', 'w', 's', '\', 'i', 'm', 'g', '0', '.', 'j', 'p', 'g', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '\', '\', '?', '\', 'D', 'I', 'S', 'P', 'L', 'A', 'Y', '#', 'L', 'G', 'D', '0', '4', '6', 'C', '#', '5', '&', '2', '5', 'a', 'f', 'c', 'a', '1', '8', '&', '0', '&', 'U', 'I', 'D', '1', '0', '9', '0', '6', '0', '8', '#', '{', 'e', '6', 'f', '0', '7', 'b', '5', 'f', '-', 'e', 'e', '9', '7', '-', '4', 'a', '9', '0', '-', 'b', '0', '7', '6', '-', '3', '3', 'f', '5', '7', 'b', 'f', '4', 'e', 'a', 'a', '7', '}', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '')


Ach, noch ein Hinweis:
In TranscodedImageCache steht immer das 'letzte' Bild, welches verwendet wurde.
Wird der Hintergrund duch z.B. einfarbigen Hintergrund ersetzt, bleibt der Name in TranscodedImageCache stehen.

Deshalb erst SystemParametersInfo(SPI_GETDESKWALLPAPER.. und wenn dort '..\TranscodedWallpaper' drinnen steht, dann den Originalnamen über TranscodedImageCache auslesen

[KodeZwerg]

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;

[HolgerX]

Hmm..

Hab mal noch nen bisschen recherchiert:

Ab Windows 8 gibt es IDesktopWallpaper, damit ist es möglich, nicht nur 'das' Wallpaper-File auszulesen, sondern je Monitor.

Anbei ein Testprogram.

Habe mir hierfür die benötigten Deklarationen zusammen geschrieben, so das nicht die ganze Win32 API für ShObjIdl eingebunden werden muss.

Zusätzlich habe ich deine Funktion für die Registry noch mal 'verschönert'


(Quelle WindowsAPI : https://github.com/CMCHTPC/WindowsAPI )

(Das Testtool ist mit Delphi 6 erstellt und auf Windows 8.1 getestet worden)

[KodeZwerg]

ich bin baff!! super leistung holger, wie du nun den cache ausliest, als teil eines records, das finde ich echt genial!!!
plus dazu noch einen völlig neue methode mal so reingezaubert, echt toll recherchiert und bestens umgesetzt.
ich bin mehr als begeistert!!!
habe es noch nicht versucht selbst zu kompilieren, deine .exe zeigts mir ja bestens an =)

wobei beim lesen mir eine sache auffällt.

Delphi-Quellcode:

procedure TForm1.ButtonRegClick(Sender: TObject);
var
  s : string;
begin
  s := GetWallpaperName;

  if Pos('',s) > 0 then // <<<--- gehört da nicht TranscodedWallpaper noch rein? also
  if (Pos('transcodedwallpaper',LowerCase(s)) > 0) then

    Edit1.Text := GetWallpaperCache
  else
    Edit1.Text := s;
end;

edit
also um das was ich wollte zu erreichen muss diese änderung rein.
sonst kommt als Registry ergebnis ...\AppData\Roaming\Microsoft\Windows\Themes\TranscodedWallpaper mit änderung erhalte ich wieder das gewünschte, IDesktopWallpaper funktioniert bestens, sowie als auch.

[HolgerX]

Zitat von KodeZwerg:

Delphi-Quellcode:

procedure TForm1.ButtonRegClick(Sender: TObject);
var
  s : string;
begin
  s := GetWallpaperName;

  if Pos('',s) > 0 then // <<<--- gehört da nicht TranscodedWallpaper noch rein? also
  if (Pos('transcodedwallpaper',LowerCase(s)) > 0) then

    Edit1.Text := GetWallpaperCache
  else
    Edit1.Text := s;
end;

Hast recht, ist leider ein Flüchtigkeitsfehler, da ich parallel nach IDesktopWallpaper am Suchen war