You may have noticed that using SystemParametersInfo to change the wallpaper when ActiveDesktop is turned on doesn't work. The reason is because you need to use the IActiveDesktop COM interface. Using SystemParametersInfo still works, but it doesn't update the wallpaper.
Note that the IActiveDesktop interface requires a Shell32.dll version >= 4.71. The document titled "Get a File Version" demonstrates how to check the file version and uses the shell32.dll as an example.
Here is an example of using IActiveDesktop to work with
the wallpaper. It assumes that you have 3 labels on a form
and two buttons with the default names.
uses
ComObj, // For CreateComObject and Initialization/Finalization of COM
ShlObj; // For IActiveDesktop
{ The CLASS ID for ActiveDesktop is not defined in ShlObj, while the IID is so we define it here. }
const
CLSID_ActiveDesktop : TGUID = '{75048700-EF1F11D0-9888-06097DEACF9}';
{ Demonstrate getting the Wallpaper }
procedure TForm1.Button1Click(Sender: TObject);
var
ActiveDesktop : IActiveDesktop;
CurrentWallpaper : string;
CurrentPattern : string;
WallpaperOptions : TWallpaperOpt;
TmpBuffer : PWideChar;
begin
// Create the ActiveDesktop COM Object
ActiveDesktop:=CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;
// We now need to allocate some memory to get the current Wallpaper.
// However, tmpBuffer is a PWideChar which means 2 bytes make
// up one Char. In order to compenstate for the WideChar, we
// allocate enough memory for MAX_PATH*2
tmpBuffer := AllocMem(MAX_PATH*2);
try
ActiveDesktop.GetWallpaper(tmpBuffer, MAX_PATH*2, 0);
CurrentWallpaper := tmpBuffer;
finally
FreeMem(tmpBuffer);
end;
if CurrentWallpaper <> '' then
Label1.Caption := 'Current Wallpaper: ' + CurrentWallpaper
else
Label1.Caption := 'No Wallpaper set';
// Now get the current Wallpaper options.
// The second parameter is reserved and must be 0.
WallpaperOptions.dwSize := SizeOf(WallpaperOptions);
ActiveDesktop.GetWallpaperOptions(WallpaperOptions, 0);
case WallpaperOptions.dwStyle of
WPSTYLE_CENTER : Label2.Caption := 'Centered';
WPSTYLE_TILE : Label2.Caption := 'Tiled';
WPSTYLE_STRETCH : Label2.Caption := 'Stretched';
WPSTYLE_MAX : Label2.Caption := 'Maxed';
end;
{Now get the desktop pattern. The pattern is a string of decimals whose bit pattern represents a picture. Each decimal represents the on/off state of the 8 pixels in that row. }
tmpBuffer := AllocMem(256);
try
ActiveDesktop.GetPattern(tmpBuffer, 256, 0);
CurrentPattern := tmpBuffer;
finally
FreeMem(tmpBuffer);
end;
if CurrentPattern <> '' then
Label3.Caption := CurrentPattern
else
Label3.Caption := 'No Pattern set';
end;
{ Demonstrate setting the wallpaper }
procedure TForm1.Button2Click(Sender: TObject);
var
ActiveDesktop: IActiveDesktop;
begin
ActiveDesktop := CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;
ActiveDesktop.SetWallpaper('c:\downloads\images\test.bmp', 0);
ActiveDesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
end;
Responds:
Good programming. But I just calling
SystemParametersInfo( SPI_SETDESKWALLPAPER, 0, @WallpaperBMPFileAndPath[1], 3);
procedure TForm1.Button1Click(Sender:TObject);
var
x,y : Integer;
Bmp : TBitmap;
begin
bmp:=TBitmap.Create;
bmp.LoadFromFile('c:\windows\streifen.bmp');
for x:=0 to (image1.width div bmp.width) do
for y:=0 to (image1.height div bmp.height) do
Image1.Canvas.Draw(x*bmp.width,y*bmp.height,bmp);
bmp.Free;
end;
uses jpeg;
procedure TForm1.Button1Click(Sender: TObject);
var
bmp : TImage;
jpg : TJpegImage;
begin
bmp := TImage.Create(nil);
jpg := TJpegImage.Create;
bmp.picture.bitmap.LoadFromFile('c:\picture.bmp');
jpg.Assign( bmp.picture.bitmap );
//Here you can set the jpg object's
//properties as compression, size and more
jpg.SaveToFile('c:\picture.jpg');
jpg.Free;
bmp.Free;
end;
Question:
How do I display a bitmap to the client area of an MDI parent
form?
Answer:
Here are the necessary steps to add wallpaper to a MDI parent
form:
Create a new project
Set the form's FormStyle to fsMDIForm
Drop an image on the form and select a bitmap into it.
Find the { Private Declarations } comment in the form's
definition and add these lines right after it:
FClientInstance : TFarProc;
FPrevClientProc : TFarProc;
procedure ClientWndProc(var Message: TMessage);
Find the "implementation" line and the {$R *.DFM} line that
follows it. After that line, enter this code:
procedure TMainForm.ClientWndProc(var Message: TMessage);
var
Dc : hDC;
Row : Integer;
Col : Integer;
begin
with Message do
case Msg of
WM_ERASEBKGND:
begin
Dc := TWMEraseBkGnd(Message).Dc;
for Row := 0 to ClientHeight div Image1.Picture.Height do
for Col := 0 to ClientWidth div Image1.Picture.Width do
BitBlt(Dc,
Col * Image1.Picture.Width,
Row * Image1.Picture.Height,
Image1.Picture.Width,
Image1.Picture.Height,
Image1.Picture.Bitmap.Canvas.Handle,
0,
0,
SRCCOPY);
Result := 1;
end;
else
Result := CallWindowProc(FPrevClientProc,
ClientHandle,
Msg,
wParam,
lParam);
end;
end;
In the OnCreate method for the form, type the following lines
of code:
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle,
GWL_WNDPROC));
SetWindowLong(ClientHandle,
GWL_WNDPROC, LongInt(FClientInstance));
Add a new form to your project and set its FormStyle property to
fsMDIChild.
Now you have a working MDI project with "wallpaper" where the image
bitmap is tiled to cover the MDI form's client area.