Discussion :

[cincap]

Bonsoir à toutes et à tous,

Serait t'il possible à l'ouverture de l'application, d'afficher dans un Timage le fond d'écran actuel de son pc (WindowsXp).

Pour le changer pas de problème, des tas de solution existent.

J'ai pas mal testé des codes sans résultat.

Merci d'avance,

@+,

Cincap

[Andnotor]

Comme ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
function GetWallPaperFileName: string;
const
  SPI_GETDESKWALLPAPER = $73;
begin
  SetLength(Result, Max_Path);
  SystemParametersInfo(SPI_GETDESKWALLPAPER, Max_Path, PChar(Result), 0);
end;

[cincap]

Bonjour à toutes et à tous,

@ Andnotor, merci, c'est super et efficace cette fonction, cela fonctionne en passant par un Bitmap temporaire bien entendu.

Pour ceux que cela intéresse :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
procedure TFwp.FormCreate(Sender: TObject);
Var
Bmp : TBitmap;
begin
  Bmp := TBitmap.Create;
  Bmp.loadfromfile(GetWallPaperFileName);
  ImPw1.Picture.assign(Bmp);
end;

Décidément, très fort !

@+,

Cincap

[Andnotor]

Le bitmap temporaire n'est pas requis, Qui plus est, avec Active Desktop, cela pourrait être un JPeg. Et même un PNG sous Vista.
LoadFromFile directement sur le TImage . (En prenant soin d'ajouter les unités JPeg et Png... pour assurer la compatibilité ascendante)

[cincap]

@ Andnotor, si je fais ceçi, c'est ok :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
procedure TFwp.FormCreate(Sender: TObject);
Var Bmp : Tbitmap;
begin
 Bmp := TBitmap.Create;
 Bmp.loadfromfile(GetWallPaperFileName);
 image1.Picture.assign(bmp);
end;

si je fais ceçi, j'ai un message d'erreur :

Extension d'image inconnue (.bmp)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
 procedure TFwp.FormCreate(Sender: TObject);
 begin
 
 image1.Picture.loadfromfile(GetWallPaperFileName);
end;

Par contre, j'aurai voulu charger d'autres formats et les appliquer comme fond, cela ne fonctionne pas, voici mon code.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
procedure TFwp.BappliquerClick(Sender: TObject);
var
  BMP, AVIBmp :TBitmap ;
  JPG,JPEG :TJPegImage ;
     
  x, Setsize :integer;
begin
Bmp := TBitmap.Create;

 try
   for x:= 0 to listeimg.Count -1 do
   begin
    
     case AnsiIndexText(ExtractFileExt(listeimg.Items[x]), ['.JPG', '.JPEG', '.BMP']) 

of
       0 : //JPg
           begin
             Jpg := TJPegImage.Create;
             Jpg.LoadFromFile(listeimg.Items[x]);
             Bmp.Assign(Jpg);
             Jpg.Free;
           end;

       1 : //JPeg
           begin
             Jpeg := TJPegImage.Create;
             Jpeg.LoadFromFile(listeimg.Items[x]);
             Bmp.Assign(Jpeg);
             Jpeg.Free;
           end;

       2 : //Bitmap
           Bmp.LoadFromFile(listeimg.Items[x]);
    
          else Raise Exception.Create('Format d''image non supporté !!!');

     end;
    image1.Picture.Assign(bmp); // jusqu'ici c'est ok

    //ApplyWallPaper(bmp, rgStyle.ItemIndex); //Erreur
    end;
    
 finally

   Bmp.Free;

 end;
 end;

Ceçi fonctionne : ApplyWallPaper(Op1.FileName, rgStyle.ItemIndex); //Est une procédure que voici.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
procedure ApplyWallPaper(const FileName: string; wpStyle: DWORD = WPSTYLE_CENTER);
const
  GUID: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';
var
  ComObj       : IUnknown;
  Buffer       : PWideChar;
  WallPaperOpt : TWallPaperOpt;
begin
  if not FileExists(FileName) then Exit;
  Buffer := AllocMem(MAX_PATH);
  StringToWideChar(FileName, Buffer, MAX_PATH);
  WallPaperOpt.dwStyle := wpStyle;
  WallPaperOpt.dwSize := SizeOf(WallPaperOpt);
  ComObj := CreateComObject(GUID);
  with ComObj as IActiveDesktop do
  begin
    SetWallpaperOptions(WallPaperOpt, 0);
    SetWallpaper(Buffer, 0);
    ApplyChanges(AD_APPLY_ALL); //(AD_APPLY_ALL or AD_APPLY_FORCE);
  end;
  FreeMem(Buffer);
end;

@+,

Cincap

[cincap]

@ Andnotor, j'ai corrigé le chargement pour éviter d'utiliser une variable Bmp comme suggéré, ce qui donne ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
procedure TFwp.FormCreate(Sender: TObject);
begin

 image1.Picture.bitmap.loadfromfile(GetWallPaperFileName);

end;

Pour le reste du problème aucune idée !

@+,

Cincap

[Andnotor]

Oui mais non... Cesses de focaliser sur le bitmap !

En fait cela fonctionne sur Picture.LoadFromFile. Ce qui semble poser problème est la longueur de Result (initialisée à Max_Path).

En fixant la taille réelle de la chaîne résultante, ça fonctionne .

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
function GetWallPaperFileName: string;
const
  SPI_GETDESKWALLPAPER = $73;
begin
  SetLength(Result, Max_Path);
  SystemParametersInfo(SPI_GETDESKWALLPAPER, Max_Path, PChar(Result), 0);
  SetLength(Result, StrLen(PChar(Result)));
end;

Pour ce qui est le changement du papier peint, utilises simplement la fonction inverse:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
procedure SetWallPaper(aFileName :string);
begin
  SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar(aFileName), SPIF_UPDATEINIFILE);
end;

Enfin, Jpg et JPeg sont deux extensions pour le même format (Tu les as d'ailleurs justement traités de la même façon). Alors simplifies le Case.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
case ... of
  0,1 : //Jpg ou JPeg
  2 : //Bitmap
  else ...
end;

[cincap]

Bonjour à toutes et à tous,

@ Andnotor, Bien vu pour le case par contre utiliser uniquement ta procédure pour le changement, cela ne fonctionne pas correctement, en effet je ne sais plus choisir le style, avec "rgStyle.ItemIndex" (tile, centrer ect..) et avec une image jpg, le fond ne se regénère pas par rapport à ma procédure "ApplyWallPaper".

Enfin, je n'arrive pas a charger la photo avec ces deux procédures :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
 
procedure TFwp.BappliquerClick(Sender: TObject);
var
  BMP, AVIBmp :TBitmap ;
  JPG,JPEG :TJPegImage ;
  PNG : TPNGObject ;
 
  x, Setsize :integer;
begin
Bmp := TBitmap.Create;
 
 try
   for x:= 0 to listeimg.Count -1 do
   begin
 
     case AnsiIndexText(ExtractFileExt(listeimg.Items[x]), ['.JPG', '.JPEG', '.BMP']) 
 
of
       0, 1 : //JPg et jpeg
           begin
             Jpg := TJPegImage.Create;
             Jpg.LoadFromFile(listeimg.Items[x]);
             Bmp.Assign(Jpg);
             Jpg.Free;
           end;
 
        2 : //Bitmap
           Bmp.LoadFromFile(listeimg.Items[x]);
 
        3 : //Png
           begin
           Png := TPNGObject.Create;
           Png.LoadFromFile(listeimg.Items[x]);
           Bmp.assign(Png);
           Png.free;
           end;
 
          else Raise Exception.Create('Format d''image non supporté !!!');
 
     end;
    image1.Picture.Assign(bmp); // jusqu'ici c'est ok
 
    //ApplyWallPaper(bmp, rgStyle.ItemIndex); //Erreur
    end;
 
 finally
 
   Bmp.Free;
 
 end;
 end;

Voila, à l'occasion.

@+,

Cincap

[Andnotor]

Il y a encore un autre paramètre possible: SPI_SETDESKPATERN.

Il est clair que Active Desktop doit être activé pour du JPeg. La fonction ApplyWallPaper force certainement cette activation.
Mais garde un oeil sur les ressources. Active Desktop est assez gourmand.

Ensuite ApplyWallPaper attend un nom de fichier en paramètre et tu essayes de lui passer un Bitmap
Le Case est inutile ! Passes-lui directement le nom de ton fichier.

[cincap]

@ Andnotor, voila, le nettoyage est fait et les formats sont acceptés plus simplement.

Merci de tes précieux conseils au nom de tous.

@+,

Cincap