Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to change the desktop wallpaper through code Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
Change the desktop wallpaper through code 30-Aug-02
Category
System
Language
Delphi 2.x
Views
59
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Tomas Rutkauskas 

Does anyone have any idea how to change the wallpaper background in Windows. 
Browsers can do it, but I have no idea how to do this in Delphi. I need to write an 
app which changes the background wallpaper on demand.

Answer:

Solve 1:
1   
2   procedure TfrmWallpaperChanger.ChangeWallPaper(Bitmap: string);
3   var
4     pBitmap: pchar;
5   begin
6     bitmap := bitmap + #0;
7     pBitmap := @bitmap[1];
8     SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, pBitmap, SPIF_UPDATEINIFILE);
9   end;



Solve 2:

10  procedure TForm1.Button1Click(Sender: TObject);
11  var
12    St: array[0..100] of Char;
13  begin
14    St := 'C:\Windows\MyWallPaper.bmp';
15    SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, @St, SPIF_SENDCHANGE);
16  end;



Solve 3:

You can easily change the wallpaper for a Windows 95/ NT system from a Delphi 
application. Here's the code:

17  procedure ChangeIt;
18  var
19    Reg: TRegIniFile;
20  begin
21    Reg := TRegIniFile.Create('Control Panel');
22    Reg.WriteString('desktop', 'Wallpaper', 'c:\windows\forest.bmp');
23    Reg.WriteString('desktop', 'TileWallpaper', '1');
24    Reg.Free;
25    SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);
26  end;


That's it! When you execute this procedure, you'll see the wallpaper change to the 
FOREST.BMP image. (This assumes that you're not using this image already.)


Solve 4:

The code below supports setting the exact position of the wallpaper and the ability 
to resize the wallpaper to fit the screen

27  uses
28    Registry, WinProcs, SysUtils;
29  
30  const
31    {WallPaperStyles}
32    WPS_Tile = 0;
33    WPS_Center = 1;
34    WPS_SizeToFit = 2;
35    WPS_XY = 3;
36  
37    {sWallpaperBMPPath: Path to a BMP file
38    nStyle: Any of the above WallPaperStyles
39    nX, nY: If the nStyle is set to WPS_XY, nX and nY can be used to set the exact
40                 position of the wall paper}
41  
42  procedure SetWallpaperExt(sWallpaperBMPPath: string; nStyle, nX, nY: integer);
43  var
44    reg: TRegIniFile;
45    s1: string;
46    X, Y: integer;
47  begin
48    {Change registry:
49   
50    HKEY_CURRENT_USER\
51    Control Panel\Desktop
52       TileWallpaper (REG_SZ)
53       Wallpaper (REG_SZ)
54       WallpaperStyle (REG_SZ)
55       WallpaperOriginX (REG_SZ)
56       WallpaperOriginY (REG_SZ)
57    }
58    reg := TRegIniFile.Create('Control Panel\Desktop');
59    with reg do
60    begin
61      s1 := '0';
62      X := 0;
63      Y := 0;
64      case nStyle of
65        WPS_Tile: s1 := '1';
66        WPS_Center: nStyle := WPS_Tile;
67        WPS_XY:
68          begin
69            nStyle := WPS_Tile;
70            X := nX;
71            Y := nY;
72          end;
73      end;
74      WriteString('', 'Wallpaper', sWallpaperBMPPath);
75      WriteString('', 'TileWallpaper', s1);
76      WriteString('', 'WallpaperStyle', IntToStr(nStyle));
77      WriteString('', 'WallpaperOriginX', IntToStr(X));
78      WriteString('', 'WallpaperOriginY', IntToStr(Y));
79    end;
80    reg.Free;
81    {Let everyone know that we changed a system parameter}
82    SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);
83  end;
84  
85  //Here are two examples on how to call the above SetWallpaperExt() //function.
86  
87  set wallpaper to winnt.bmp and stretch it to fit the screen
88  
89  SetWallpaperExt('c:\winnt\winnt.bmp', WPS_SizeToFit, 0, 0);
90  
91  set the wallpaper origin to (10, 200)
92  
93  SetWallpaperExt('c:\winnt\winnt.bmp', WPS_XY, 10, 200);


Solve 5:

94  { ... }
95  type
96    TThemeWallpaperItem = record
97      Filename: TFilename;
98      Pattern: TFilename;
99      Tile: Boolean;
100     Style: TWallpaperStyle;
101     ScreensaverActive: Boolean;
102   end;
103 
104   TWallpaperValues = (wvWallpaper, wvPattern, wvTileWallpaper,
105     wvWallpaperStyle, wvScreensaverActive);
106 
107 const
108   ThemeWallpaperSectionName = 'Control Panel\Desktop';
109   ThemeWallpaperValueNames: array[TWallpaperValues] of string = ('Wallpaper',
110     'Pattern', 'TileWallpaper', 'WallPaperStyle', 'ScreensaveActive');
111 
112 procedure TThemeFile.WriteWallpaperToWindows;
113 var
114   RegInifile: TRegIniFile;
115 const
116   DefaultSectionName = 'Control Panel\Desktop';
117 begin
118   RegInifile := TRegIniFile.Create;
119   try
120     RegIniFile.RootKey := HKEY_CURRENT_USER;
121     {TWallpaperValues = (wvWallpaper, wvPattern, wvTileWallpaper, wvWallpaperStyle,
122                                              wvScreensaverActive);}
123     RegIniFile.WriteString(DefaultSectionName, 
124 ThemeWallpaperValueNames[wvWallpaper],
125       FWallpaper.Filename);
126     RegIniFile.WriteString(DefaultSectionName, ThemeWallpaperValueNames[wvPattern],
127       FWallpaper.Pattern);
128     RegIniFile.WriteBool(DefaultSectionName,
129       ThemeWallpaperValueNames[wvTileWallpaper],
130       FWallpaper.Tile);
131     RegIniFile.WriteInteger(DefaultSectionName,
132       ThemeWallpaperValueNames[wvWallPaperStyle],
133       Integer(FWallpaper.Style))
134   finally
135     RegInifile.Free;
136   end;
137   SystemParametersInfo(SPI_SETDESKWALLPAPER, SPI_SETDESKWALLPAPER,
138     PChar(FWallpaper.Filename), SPIF_SENDCHANGE or
139     SPIF_UPDATEINIFILE);
140   SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, Ord(FWallPaper.ScreensaverActive),
141     nil, SPIF_SENDCHANGE or SPIF_UPDATEINIFILE);
142   RefreshDesktop;
143 end;
144 
145 
146 Solve 6:
147 
148 { ... }
149 uses
150   Registry, JPEG;
151 
152 type
153   TWallPaperStyle = (wpsCenter, wpsStretch, wpsTile);
154 
155 const
156   WALLPAPERSTYLESTRS: array[TWallPaperStyle] of string = ('Center', 'Stretch',
157     'Tile');
158 
159 function StrToWallPaperStyle(const s: string): TWallPaperStyle;
160 var
161   wps: TWallPaperStyle;
162 begin
163   result := wpsStretch;
164   for wps := wpsCenter to wpsTile do
165     if AnsiCompareText(s, WALLPAPERSTYLESTRS[wps]) = 0 then
166     begin
167       result := wps;
168       exit;
169     end;
170 end;
171 
172 function RegGetWallPaperStyle: TWallPaperStyle;
173 var
174   Reg: TRegistry;
175   Center,
176     Tile: boolean;
177   s: string;
178 begin
179   result := wpsStretch;
180   Center := false;
181   Tile := false;
182   Reg := TRegistry.Create;
183   try
184     if Reg.OpenKey('Control Panel\Desktop', false) then
185     begin
186       if Reg.ValueExists('TileWallpaper') then
187       begin
188         s := Reg.ReadString('TileWallpaper');
189         Tile := (s = '1');
190       end;
191       if Reg.ValueExists('WallpaperStyle') then
192       begin
193         s := Reg.ReadString('WallpaperStyle');
194         Center := (s = '0');
195       end;
196       if Tile then
197         result := wpsTile
198       else if Center then
199         result := wpsCenter;
200     end;
201   finally
202     Reg.Free;
203   end;
204 end;
205 
206 procedure RegSetWallPaperStyle(wps: TWallPaperStyle);
207 var
208   Reg: TRegistry;
209 begin
210   Reg := TRegistry.Create;
211   try
212     if Reg.OpenKey('Control Panel\Desktop', true) then
213     begin
214       case wps of
215         wpsCenter:
216           begin
217             Reg.WriteString('TileWallpaper', '0');
218             Reg.WriteString('WallpaperStyle', '0');
219           end;
220         wpsStretch:
221           begin
222             Reg.WriteString('TileWallpaper', '0');
223             Reg.WriteString('WallpaperStyle', '2');
224           end;
225         wpsTile:
226           begin
227             Reg.WriteString('TileWallpaper', '1');
228             {Reg.WriteString('WallpaperStyle', '0');}
229           end;
230       end;
231     end;
232   finally
233     Reg.Free;
234   end;
235 end;
236 
237 procedure ChangeWallpaper(lpNewPaper: string; wps: TWallPaperStyle);
238 var
239   Reg: TRegistry;
240 const
241   SFolderKey = '\Control Panel\Desktop';
242 begin
243   if not FileExists(lpNewPaper) or (CompareText('.bmp', ExtractFileExt(lpNewPaper)) 
244 <>
245     0) then
246     exit;
247   Reg := TRegistry.Create;
248   try
249     if Reg.OpenKey(SFolderKey, false) then
250     begin
251       Reg.WriteString('Wallpaper', lpNewPaper);
252       Reg.CloseKey;
253     end;
254   finally
255     Reg.Free;
256   end;
257   RegSetWallPaperStyle(wps);
258   SystemParametersInfo(20, 0, PChar(lpNewPaper), $2);
259 end;
260 
261 procedure SetWallpaper(const AFilename, NewFilename: string; wps:
262   TWallPaperStyle);
263 var
264   IsBitmapFile: boolean;
265   bmp: TBitmap;
266   pic: TPicture;
267 begin
268   if FileExists(AFilename) then
269   begin
270     IsBitmapFile := AnsiCompareText('.bmp', ExtractFileExt(AFilename) = 0;
271       if not IsBitmapFile then
272       begin
273         if (NewFilename = '') or (AnsiCompareText('.bmp', 
274 ExtractFileExt(NewFilename)
275           <> 0) then
276           raise Exception.Create('Wallpaper must be a bitmap file (*.bmp)');
277           bmp := TBitmap.Create;
278           try
279             pic := TPicture.Create;
280             try
281               pic.LoadFromFile(AFilename);
282               bmp.Assign(pic.Graphic);
283             finally
284               pic.Free;
285             end;
286             bmp.PixelFormat := pf24bit;
287             bmp.SaveToFile(NewFilename);
288             ChangeWallpaper(NewFilename, wps);
289           finally
290             bmp.Free;
291           end;
292       end
293       else
294         ChangeWallpaper(AFilename, wps);
295   end;
296 end;
297 
298 procedure TForm1.FormCreate(Sender: TObject);
299 var
300   wps: TWallPaperStyle;
301 begin
302   WallpaperCmbx.Clear; {TComboBox, style = csDropDownList, Sorted = false}
303   for wps := wpsCenter to wpsTile do
304     WallpaperCmbx.Items.Add(WALLPAPERSTYLESTRS[wps]);
305   wps := RegGetWallPaperStyle;
306   WallpaperCmbx.ItemIndex := ord(wps);
307 end;
308 
309 procedure TForm1Button1Click(Sender: TObject);
310 var
311   F, NewFName: string;
312   wps: TWallPaperStyle;
313 begin
314   with TOpenPictureDialog.Create(Self) do
315   try
316     if Execute then
317     begin
318       F := Filename;
319       if AnsiCompareText('.bmp', ExtractFileExt(F)) <> 0 then
320         NewFName := ChangeFileExt(F, '.bmp')
321       else
322         NewFName := '';
323       wps := TWallPaperStyle(WallPaperCmbx.ItemIndex);
324       SetWallpaper(F, NewFName, wps);
325   finally
326     Free;
327   end;
328 end;


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC