Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   API de Windows (https://www.clubdelphi.com/foros/forumdisplay.php?f=7)
-   -   Color de fondo de pantalla (https://www.clubdelphi.com/foros/showthread.php?t=49099)

madiazg 12-10-2007 17:37:40

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

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 14-10-2007 09:11:57

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 14-10-2007 15:49:41

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 14-10-2007 16:36:10

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 14-10-2007 17:09:42

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

[madiazg], ok!

saludos

dec 14-10-2007 17:51:52

Hola,

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

aeff 14-10-2007 18:47:35

Cita:

Empezado por dec (Mensaje 238461)
Hola,

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

ok, creo que ya lo registre como un truco

fide 24-10-2007 14:21:31

Color Desk
 
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 24-10-2007 15:37:23

Cambiar la imagen del desktop
 
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 24-10-2007 21:11:33

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 24-10-2007 22:37:15

Cita:

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.

Cita:

Empezado por aeff
...otra cosa, eso funciona?
no creen?

Seguramente la respuesta nos la dará el mismo Delphi.

Saludos

aeff 25-10-2007 04:49:24

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

fide 27-10-2007 07:40:10

Cierto!
 
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.


La franja horaria es GMT +2. Ahora son las 11:05:16.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi