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 colour
function 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.