Recent

Author Topic: [SOLVED] Find background image of current display on Windows 10  (Read 4475 times)

kinnon_2000

  • New Member
  • *
  • Posts: 22
[SOLVED] Find background image of current display on Windows 10
« on: September 28, 2021, 10:56:09 pm »
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][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
  9.   fileutil, LCLIntf, LCLType;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     Button1: TButton;
  17.     Image1: TImage;
  18.     Shape1: TShape;
  19.     Shape2: TShape;
  20.     Shape3: TShape;
  21.     procedure Button1Click(Sender: TObject);
  22.   private
  23.   public
  24.   end;
  25.  
  26. var
  27.   Form1: TForm1;
  28.  
  29. implementation
  30.  
  31. {$R *.lfm}
  32.  
  33. { TForm1 }
  34.  
  35. // pick a colour any colour
  36. function pickRandImageClr(Bmp:TBitmap): TColor;
  37. var x, y: Integer;
  38. begin
  39.   Randomize();x:=random(Bmp.Width);
  40.   Randomize();y:=random(Bmp.height);
  41.   result:=rgbToColor(Byte(Bmp.Canvas.Pixels[x,y]),
  42.                      Byte(Bmp.Canvas.Pixels[x,y] shr 8),
  43.                      Byte(Bmp.Canvas.Pixels[x,y] shr 16));
  44. end;
  45.  
  46. procedure TForm1.Button1Click(Sender: TObject);
  47. var
  48.     filename, progdir:String;
  49.     nClr:TColor; // new color, old color
  50. begin
  51.   progdir:=extractfilepath(paramstr(0)); // this program directory
  52.   // todo - determine the current display
  53.  
  54.   // find the current wallpaper for this display ... ish
  55.   // this currently returns the last updated wallpaper, not just the one on this display
  56.   filename:=SysUtils.GetEnvironmentVariable('APPDATA')+'\Microsoft\Windows\Themes\TranscodedWallpaper';
  57.   CopyFile(filename, progdir+'wallpaper.jpg');
  58.   Image1.Picture.LoadFromFile(progdir+'wallpaper.jpg');
  59.   Image1.refresh;
  60.  
  61.   // test the sampling of colours in my image
  62.   Shape1.Brush.Color:=pickRandImageClr(Image1.picture.Bitmap);
  63.   Shape2.Brush.Color:=pickRandImageClr(Image1.picture.Bitmap);
  64.   Shape3.Brush.Color:=pickRandImageClr(Image1.picture.Bitmap);
  65. end;
  66.  
  67. end.
  68.  
« Last Edit: October 01, 2021, 07:11:38 pm by kinnon_2000 »

kinnon_2000

  • New Member
  • *
  • Posts: 22
Re: Find background image of current display on Windows 10
« Reply #1 on: September 29, 2021, 11:32:46 pm »
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/Win10WPReader.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][+][-]
  1. // from https://stackoverflow.com/questions/35578394/read-reg-binary-as-string-using-tregistry-class-in-delphi
  2. // uses registry
  3. function ReadBinString(RootKey: HKEY; Access: LongWord; const KeyName,
  4.   ValueName: string; Encoding: TEncoding): string;
  5. var
  6.   Registry: TRegistry;
  7.   Bytes: TBytes;
  8. begin
  9.   Registry := TRegistry.Create(Access);
  10.   try
  11.     Registry.RootKey := RootKey;
  12.     if Registry.OpenKeyReadOnly(KeyName) then begin
  13.       SetLength(Bytes, Registry.GetDataSize(ValueName));
  14.       Registry.ReadBinaryData(ValueName, Pointer(Bytes)^, Length(Bytes));
  15.       Result := Encoding.GetString(Bytes);
  16.     end else begin
  17.       Result := '';
  18.     end;
  19.   finally
  20.     Registry.Free;
  21.   end;
  22. end;

testing with the following in my button click:
Code: Pascal  [Select][+][-]
  1. showmessage(ReadBinString(HKEY_CURRENT_USER, KEY_WOW64_64KEY,
  2.                            'Control Panel\Desktop',
  3.                            'TranscodedImageCache_000',
  4.                            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

  • Hero Member
  • *****
  • Posts: 824
Re: Find background image of current display on Windows 10
« Reply #2 on: September 30, 2021, 04:00:52 pm »
Hi , I was able to get file path this way in my own computer ;
Code: Pascal  [Select][+][-]
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. var
  3.   Retro: TRegistry;  // add uses Registry
  4.   i,bi:  integer;
  5.   pathb:  array of byte;
  6.   paths:   string;
  7. begin
  8.   Retro := TRegistry.Create;
  9.   try
  10.     Retro.RootKey := HKEY_CURRENT_USER;
  11.     if Retro.OpenKey('Control Panel\Desktop', false) then
  12.     begin
  13.       bi := Retro.GetDataSize('TranscodedImageCache');
  14.       if (bi > 0) then
  15.       begin
  16.         SetLength(pathb, bi);
  17.         Retro.ReadBinaryData('TranscodedImageCache', pathb[0], bi);
  18.         for i := 0 to bi - 1 do  paths := paths + chr(pathb[i]);
  19.         ShowMessage(replacestr(copy(paths,25,bi-25),chr(0),''));  // add uses StrUtils
  20.       end;
  21.     end;
  22.    finally
  23.     Retro.Free;
  24.   end;
  25. end;
Check out  loaded on Strava
https://www.strava.com/athletes/109391137

kinnon_2000

  • New Member
  • *
  • Posts: 22
Re: Find background image of current display on Windows 10
« Reply #3 on: October 01, 2021, 06:59:24 pm »
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][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
  9.   fileutil, LCLIntf, LCLType, Registry, StrUtils, regexpr;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     Button1: TButton;
  17.     gb0: TGroupBox;
  18.     gb2: TGroupBox;
  19.     gb1: TGroupBox;
  20.     Img0: TImage;
  21.     Img2: TImage;
  22.     Img1: TImage;
  23.     Panel2: TPanel;
  24.     Panel3: TPanel;
  25.     Shape1: TShape;
  26.     Shape2: TShape;
  27.     Shape3: TShape;
  28.     procedure Button1Click(Sender: TObject);
  29.   private
  30.  
  31.  
  32.   public
  33.   end;
  34.  
  35. var
  36.   Form1: TForm1;
  37.  
  38. implementation
  39.  
  40. {$R *.lfm}
  41.  
  42. { TForm1 }
  43.  
  44. // pick a colour any colour
  45. function pickRandImageClr(Bmp:TBitmap): TColor;
  46. var x, y: Integer;
  47. begin
  48.   Randomize();x:=random(Bmp.Width);
  49.   Randomize();y:=random(Bmp.height);
  50.   result:=rgbToColor(Byte(Bmp.Canvas.Pixels[x,y]),
  51.                      Byte(Bmp.Canvas.Pixels[x,y] shr 8),
  52.                      Byte(Bmp.Canvas.Pixels[x,y] shr 16));
  53. end;
  54.  
  55. function GetPath(RootKey: HKEY; const KeyName, ValueName: string): string;
  56. var
  57.   Retro: TRegistry;  // add uses Registry
  58.   i,bi:  integer;
  59.   pathb:  array of byte;
  60.   paths:   string;
  61. begin
  62.   Retro := TRegistry.Create;
  63.   try
  64.     Retro.RootKey := RootKey;
  65.     if Retro.OpenKey(KeyName, false) then
  66.     begin
  67.       paths:='';
  68.       bi := Retro.GetDataSize('TranscodedImageCache');
  69.       if (bi > 0) then
  70.       begin
  71.         SetLength(pathb, bi);
  72.         Retro.ReadBinaryData(ValueName, pathb[0], bi);
  73.         for i := 0 to bi - 1 do  paths := paths + chr(pathb[i]);
  74.         result:=replacestr(copy(paths,25,bi-25),chr(0),''); // add uses StrUtils
  75.       end;
  76.     end;
  77.    finally
  78.     Retro.Free;
  79.   end;
  80. end;
  81.  
  82. // return the filepath only, stopping at \\?
  83. function GetFileName(const Source:String):String;
  84. var
  85.   s: PChar;
  86.   delim:String;
  87.   i: Integer;
  88.   c, res: String;
  89. begin
  90.   s:=PChar(Source);
  91.   delim:='\\?';res:='';
  92.   repeat
  93.     i:=Pos(delim, s);
  94.     if i=0 then Break;
  95.     c:=Copy(s, 1, i-1);
  96.     res:=res+c;
  97.     inc(s, i + Length(delim)-1);
  98.   until i = 0;
  99.   result :=res;
  100. end;
  101.  
  102. procedure TForm1.Button1Click(Sender: TObject);
  103. var
  104.     p:tpoint;// this will be the center position of my form
  105.     r:Trect;// rect of current monitor
  106.     i, thisMonitor, monitorCount:Integer;
  107.     thisMonitorString:String;
  108.     img:TImage;
  109. begin
  110.   // determine the current monitor
  111.   p:=TPoint.create(left+width Div 2, top+height div 2);
  112.   for thisMonitor:=0 to screen.MonitorCount-1 do begin
  113.       r:=screen.Monitors[thisMonitor].WorkareaRect;//.BoundsRect;
  114.       if PtInRect(r,p) = true then break;//thisMonitor is the current screen
  115.   end;
  116.   // read each monitor wallpaper
  117.   monitorCount:=screen.MonitorCount;
  118.   for i:=0 to monitorCount-1 do
  119.   begin // for each monitor
  120.        thisMonitorString:=GetPath(HKEY_CURRENT_USER,
  121.                                   'Control Panel\Desktop',
  122.                                   'TranscodedImageCache_00'+inttostr(i));
  123.        if(thisMonitorString<>'') then
  124.        begin // monitor string found
  125.             thisMonitorString:=GetFileName(thisMonitorString);
  126.              // load this picture into the correct image
  127.              img := Form1.FindComponent('Img' + IntToStr(i)) AS TImage;
  128.              if img is TImage then with img as TImage do
  129.              begin
  130.                   img.Picture.LoadFromFile(thisMonitorString);
  131.                   if(i=thisMonitor) then
  132.                   begin
  133.                       // test the sampling of colours in image
  134.                       Shape1.Brush.Color:=pickRandImageClr(img.picture.Bitmap);
  135.                       Shape2.Brush.Color:=pickRandImageClr(img.picture.Bitmap);
  136.                       Shape3.Brush.Color:=pickRandImageClr(img.picture.Bitmap);
  137.                        // draw something to indicate which display form is on
  138.                        img.Picture.Bitmap.Canvas.Ellipse(0,0,100,100)
  139.                   end;
  140.                   img.refresh;
  141.              end;
  142.        end;
  143.   end;
  144. end;
  145.  
  146. end.


 

TinyPortal © 2005-2018