Color de fondo de pantalla

[madiazg]

Hola, estoy intentando establecer el color del fondo de pantalla. He localizado el registro de Windows donde se almacena este valor y puedo modificarlo.

procedure TForm1.Button2Click(Sender: TObject);
resourcestring
  rsClaveRegistro = 'Control Panel\Colors\';
  rsBackground = 'Background';
begin
  with TRegistry.Create() do
  try
    RootKey := HKEY_CURRENT_USER;
    OpenKey(rsClaveRegistro,false);
        WriteString(rsBackground, '0 0 0');
  finally
    Free();
  end;
end;

El problema es que, aunque cambie el valor del registro, este cambio no surte efecto.
¿Cómo hacer que el cambio del registro produzca el efecto deseado?
¿Hay alguna otra forma de cambiar el color de fondo del escritorio?
Gracias y saludos...
Miguel Angel

[aeff]

saludos, no encuentro por ningún lado a mi alrededor la manera de aplicar los cambios realizado a Desktop de la forma que quieres, te propongo una solución:

implementa esto en la unit:

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;

ahora un ejemplo de uso, en el evento onClick de un button pon esto:

Código Delphi [-]
procedure TForm1.Button1Click(Sender: TObject);
begin
  SetDesktopBackground(RGB(40, 110, 112));
end;

bueno, esto es un invento bruto pero al menos simula lo que quieres,

espero que te funcione y te sirva de algo

saludos

aeff!!

[madiazg]

Muy bien pensado y funciona perfectamente.
No se me hubiera ocurrido simular de esta forma el fondo negro del escritorio.
Muchas gracias y saludos...
Miguel Angel

[dec]

Hola,

Un buen truco. Podrías publicarlo como tal en la sección correspondiente. Yo también le estuve dando algunas vueltas a este tema y no llegué a sitio alguno, y no se me hubiera ocurrido cambiar el color de fondo de la pantalla colocando como papel tapiz una imagen de dicho color. Muy bueno.

[aeff]

hola dec, ¿como se publican los trucos? y gracias

[madiazg], ok!

saludos

[dec]

Hola,

En el apartado de trucos, más concretamente en Insertar nuevo truco.

[aeff]

Empezado por dec

Hola,

En el apartado de trucos, más concretamente en Insertar nuevo truco.

ok, creo que ya lo registre como un truco

[fide]

Oyeme ese truco es una maravilla por que no cree ni en las restricciones de fondo que se le aplican a XP con el Active Directory. Lo unico malo es que es un poquito lento. Pero que se va a hacer. Si asi resuelve el problema jejeje...

[fide]

Bueno. Aqui una sencilla modificacion del truco anterior, pero no para cambiar el color de fondo. Sino la imagen de fondo pero con ADSI. Esto cambia el fondo del escritorio aunque este restringida esta opcion por el admin de red jejejeje.

Código Delphi [-]
uses ShlObj, ActiveX, ComObj, Registry;

procedure SetDesktopBackgroundImage(vBmpPath: String);
var
  shDesk: IActiveDesktop;
  vWallPOp: TWallPaperOpt;
begin

 try
  shDesk := (CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop);
  shDesk.SetWallpaper(StringToOleStr(vBmpPath), 0);
  vWallPOp.dwSize := Sizeof(TWallPaperOpt);
  vWallPOp.dwStyle := WPSTYLE_TILE;
  shDesk.SetWallpaperOptions(vWallPOp, 0);
  shDesk.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
 finally
  FreeObjectInstance(Pointer(shDesk));
 end;

end;

Aqui un ejemplo de uso...

Código Delphi [-]
procedure TForm1.Button1Click(Sender: TObject);
begin

  SetDesktopBackgroundImage(ExtractFilePath(Application.ExeName) + 'bmp.bmp');

end;

[aeff]

mi querido Fide, antes de publicar codigos en el club, por favor, haz una busqueda por el Club para ver si no existe ya esto mismo, esto que acabas de publicar esta escrito aqui mismo, la razon por la que es un poco lento es en parte debido al tamaÑo del bitmap que se crea, pero solo es una pequeÑa parte, la otra es problema del SO y la PC,

otra cosa, eso funciona?
no creen?

suerte!

[[cHackAll]]

Empezado por aeff

...antes de publicar codigos en el club, por favor, haz una busqueda por el Club para ver si no existe ya esto mismo, esto que acabas de publicar esta escrito aqui mismo...

Bueno en mi humilde opinion no es un crimen redundar; la telaraña es un compendio de repeticiones y el Club tambien cae en ello, vi que fide no realizó una "publicación" y tambien creo que realizar una búsqueda para realizar cualquier post en el Club lo convertiría en un tedioso GoogleClubDelphi o algo así...

Tampoco creo que sea lo mismo lo de éste hilo, SetWallpaperOptions es un método no analizado en tal hilo, y tampoco ví la liberación del objeto.

Empezado por aeff

...otra cosa, eso funciona?
no creen?

Seguramente la respuesta nos la dará el mismo Delphi.

Saludos

[aeff]

hmmmm, ok! de acuerdo contigo *cHackAll*, si funciona el truco!

[fide]

Okas, aunque no creo que lo que publique aqui esta replicado cuando balla a postear algo debes en cuando mirare a ver si no esta duplicado.