Bueno, esto es realmente un invento pero simula el proceso original, je je je!!
Código Delphi
[-]
...
uses ShlObj, ActiveX, ComObj, Registry;
...
procedure SetDesktopBackground(Color: TColor);
var
tmpFile: array[0..MAX_PATH] of Char;
rValue, gValue, bValue, fName: string;
Bmp: TBitmap;
Reg: TRegistry;
shDesk: IActiveDesktop;
vWallPOp: TWallPaperOpt;
begin
GetEnvironmentVariable('TEMP', tmpFile, MAX_PATH);
fName := string (tmpFile) + '\dbg.bmp';
rValue := IntToStr(GetRValue(Color));
gValue := IntToStr(GetGValue(Color));
bValue := IntToStr(GetBValue(Color));
Bmp := TBitmap.Create;
Bmp.Width := 1;
Bmp.Height := 1;
Bmp.Canvas.Pixels[0,0] := Color;
Bmp.SaveToFile(fName);
Bmp.Free;
Reg := TRegistry.Create;
Reg.OpenKey('\Control Panel\Colors\', false);
Reg.WriteString('Background',rValue + ' ' + gValue + ' ' + bValue);
Reg.Free;
shDesk := (CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop);
shDesk.SetWallpaper(StringToOleStr(fName), 0);
vWallPOp.dwSize := Sizeof(TWallPaperOpt);
vWallPOp.dwStyle := WPSTYLE_TILE;
shDesk.SetWallpaperOptions(vWallPOp, 0);
shDesk.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
shDesk.SetWallpaper('', 0);
DeleteFile(fName);
FreeObjectInstance(Pointer(shDesk));
end;
un ejmplo de llamada
Código Delphi
[-]
procedure TForm1.Button1Click(Sender: TObject);
begin
SetDesktopBackground(RGB(40, 110, 112));
end;