[SOLVED] Find background image of current display on Windows 10
lazarus / 39-Graphics

----------------------------------------------------------------------
kinnon_2000 · 2021-09-28 20:56

Hello,

I'm currently messing with a bit of code that tries to find the
desktop background image and load it into  a TImage.
The reason for this is to sample some colours from that image and
eventually colour form content based on those colours.

I'm using Windows 10 using themes which cycle through a selection of
different wallpaper images.

The issue I'm having is capturing the wallpaper for the current
display in a multi-display setup. At the moment, my code is sampling
from the last updated theme image, rather than identifying the image
on the current display.

Can anyone help identify which display the form is sitting on, and how
to locate the image thats actually being used as the desktop wallpaper
on that display?

I'm avoiding screen capturing as I dont want interference from active
windows or dialogs floating about.

I've attached a little demo project for anyone who is interested in
looking at this.

The code in my form is as follows:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,  fileutil, LCLIntf,
LCLType; type   { TForm1 }   TForm1 = class(TForm)    Button1:
TButton;    Image1: TImage;    Shape1: TShape;    Shape2: TShape;   
Shape3: TShape;    procedure Button1Click(Sender: TObject);  private 
public  end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1
} // pick a colour any colourfunction pickRandImageClr(Bmp:TBitmap):
TColor;var x, y: Integer;begin  Randomize();x:=random(Bmp.Width); 
Randomize();y:=random(Bmp.height); 
result:=rgbToColor(Byte(Bmp.Canvas.Pixels[x,y]),                   
 Byte(Bmp.Canvas.Pixels[x,y] shr 8),                   
 Byte(Bmp.Canvas.Pixels[x,y] shr 16));end; procedure
TForm1.Button1Click(Sender: TObject);var    filename, progdir:String; 
  nClr:TColor; // new color, old colorbegin 
progdir:=extractfilepath(paramstr(0)); // this program directory  //
todo - determine the current display   // find the current wallpaper
for this display ... ish  // this currently returns the last updated
wallpaper, not just the one on this display  filename:=SysUtils.GetEnv
ironmentVariable('APPDATA')+'\Microsoft\Windows\Themes\TranscodedWallp
aper';  CopyFile(filename, progdir+'wallpaper.jpg'); 
Image1.Picture.LoadFromFile(progdir+'wallpaper.jpg'); 
Image1.refresh;   // test the sampling of colours in my image 
Shape1.Brush.Color:=pickRandImageClr(Image1.picture.Bitmap); 
Shape2.Brush.Color:=pickRandImageClr(Image1.picture.Bitmap); 
Shape3.Brush.Color:=pickRandImageClr(Image1.picture.Bitmap);end; end.

----------------------------------------------------------------------
kinnon_2000 · 2021-09-29 21:32

Hello,

I've made some progress with this problem, based on a bit of python
code on github:
https://github.com/ChoppaReid/Wallpaper_Reader/blob/master/Win10WPRead
er.py

which says the paths for each wallpaper are stored in ..
HKEY_CURRENT_USER\Control Panel\Desktop\TranscodedImageCache_000 or
001, etc

So, after more digging, I found an interesting function on stack
overflow which looks promising, but isn't decoding the value correctly
and gives back some mess of characters...

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i // from
https://stackoverflow.com/questions/35578394/read-reg-binary-as-
string-using-tregistry-class-in-delphi// uses registryfunction
ReadBinString(RootKey: HKEY; Access: LongWord; const KeyName, 
ValueName: string; Encoding: TEncoding): string;var  Registry:
TRegistry;  Bytes: TBytes;begin  Registry :=
TRegistry.Create(Access);  try    Registry.RootKey := RootKey;    if
Registry.OpenKeyReadOnly(KeyName) then begin      SetLength(Bytes,
Registry.GetDataSize(ValueName));     
Registry.ReadBinaryData(ValueName, Pointer(Bytes)^, Length(Bytes));  
  Result := Encoding.GetString(Bytes);    end else begin      Result
:= '';    end;  finally    Registry.Free;  end;end;
testing with the following in my button click:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
showmessage(ReadBinString(HKEY_CURRENT_USER, KEY_WOW64_64KEY,        
                 'Control Panel\Desktop',                         
 'TranscodedImageCache_000',                         
 TEncoding.ANSI));
Looking the the registry the type is REG_BINARY, and I can see the 
path characters down the right in regedit.

Again, any help decoding the values to strings would be greatly
appreciated.

All the best,
Al

----------------------------------------------------------------------
loaded · 2021-09-30 14:00

Hi , I was able to get file path this way in my own computer ;
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
TForm1.Button1Click(Sender: TObject);var  Retro: TRegistry;  // add
uses Registry  i,bi:  integer;  pathb:  array of byte;  paths:  
string;begin  Retro := TRegistry.Create;  try    Retro.RootKey :=
HKEY_CURRENT_USER;    if Retro.OpenKey('Control Panel\Desktop', false)
then    begin      bi := Retro.GetDataSize('TranscodedImageCache');  
  if (bi > 0) then      begin        SetLength(pathb, bi);       
Retro.ReadBinaryData('TranscodedImageCache', pathb[0], bi);        for
i := 0 to bi - 1 do  paths := paths + chr(pathb[i]);       
ShowMessage(replacestr(copy(paths,25,bi-25),chr(0),''));  // add uses
StrUtils      end;    end;   finally    Retro.Free;  end;end;

----------------------------------------------------------------------
kinnon_2000 · 2021-10-01 16:59

Thank you for your help Loaded!!

That worked a charm and I've adapted it into my little sample program,
included for anyone interested.

This little program will work out which monitor its on and sample
colours from the wallpaper image (needs improvement but the idea is
there).

I suspect some tweaking might be in order for single displays if they
use only the registry  value of TranscodeImageCache without the _000
numbers (I have yet to test on sginle monitor or > 2 monitors)

The unit 1 code is as follows for anyone interested:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,  fileutil, LCLIntf,
LCLType, Registry, StrUtils, regexpr; type   { TForm1 }   TForm1 =
class(TForm)    Button1: TButton;    gb0: TGroupBox;    gb2:
TGroupBox;    gb1: TGroupBox;    Img0: TImage;    Img2: TImage;   
Img1: TImage;    Panel2: TPanel;    Panel3: TPanel;    Shape1:
TShape;    Shape2: TShape;    Shape3: TShape;    procedure
Button1Click(Sender: TObject);  private    public  end; var  Form1:
TForm1; implementation {$R *.lfm} { TForm1 } // pick a colour any
colourfunction pickRandImageClr(Bmp:TBitmap): TColor;var x, y:
Integer;begin  Randomize();x:=random(Bmp.Width); 
Randomize();y:=random(Bmp.height); 
result:=rgbToColor(Byte(Bmp.Canvas.Pixels[x,y]),                   
 Byte(Bmp.Canvas.Pixels[x,y] shr 8),                   
 Byte(Bmp.Canvas.Pixels[x,y] shr 16));end; function GetPath(RootKey:
HKEY; const KeyName, ValueName: string): string;var  Retro: TRegistry;
 // add uses Registry  i,bi:  integer;  pathb:  array of byte;  paths:
  string;begin  Retro := TRegistry.Create;  try    Retro.RootKey :=
RootKey;    if Retro.OpenKey(KeyName, false) then    begin     
paths:='';      bi := Retro.GetDataSize('TranscodedImageCache');     
if (bi > 0) then      begin        SetLength(pathb, bi);       
Retro.ReadBinaryData(ValueName, pathb[0], bi);        for i := 0 to bi
- 1 do  paths := paths + chr(pathb[i]);       
result:=replacestr(copy(paths,25,bi-25),chr(0),''); // add uses
StrUtils      end;    end;   finally    Retro.Free;  end;end; //
return the filepath only, stopping at \\?function GetFileName(const
Source:String):String;var  s: PChar;  delim:String;  i: Integer;  c,
res: String;begin  s:=PChar(Source);  delim:='\\?';res:='';  repeat  
i:=Pos(delim, s);    if i=0 then Break;    c:=Copy(s, 1, i-1);   
res:=res+c;    inc(s, i + Length(delim)-1);  until i = 0;  result
:=res;end; procedure TForm1.Button1Click(Sender: TObject);var   
p:tpoint;// this will be the center position of my form    r:Trect;//
rect of current monitor    i, thisMonitor, monitorCount:Integer;   
thisMonitorString:String;    img:TImage;begin  // determine the
current monitor  p:=TPoint.create(left+width Div 2, top+height div
2);  for thisMonitor:=0 to screen.MonitorCount-1 do begin     
r:=screen.Monitors[thisMonitor].WorkareaRect;//.BoundsRect;      if
PtInRect(r,p) = true then break;//thisMonitor is the current screen 
end;  // read each monitor wallpaper 
monitorCount:=screen.MonitorCount;  for i:=0 to monitorCount-1 do 
begin // for each monitor     
 thisMonitorString:=GetPath(HKEY_CURRENT_USER,                       
         'Control Panel\Desktop',                                 
'TranscodedImageCache_00'+inttostr(i));     
 if(thisMonitorString<>'') then       begin // monitor string found  
        thisMonitorString:=GetFileName(thisMonitorString);           
 // load this picture into the correct image             img :=
Form1.FindComponent('Img' + IntToStr(i)) AS TImage;             if img
is TImage then with img as TImage do             begin               
 img.Picture.LoadFromFile(thisMonitorString);                 
if(i=thisMonitor) then                  begin                      //
test the sampling of colours in image                     
Shape1.Brush.Color:=pickRandImageClr(img.picture.Bitmap);            
        Shape2.Brush.Color:=pickRandImageClr(img.picture.Bitmap);    
               
Shape3.Brush.Color:=pickRandImageClr(img.picture.Bitmap);            
         // draw something to indicate which display form is on      
               img.Picture.Bitmap.Canvas.Ellipse(0,0,100,100)        
        end;                  img.refresh;             end;     
 end;  end;end; end.