Create Wallpapers the Easy Way !






3.50/5 (6 votes)
Deal with different pictures (format/sizes) and make them well mounted on your desktop -wallpapers-

Introduction
This is my second post. I tried in this one to help some programmers to deal with graphical concepts, so I take the wallpaper-desktop as a practice for this purpose.
Background
The only hard stuff in this article, I guess, is the use of the API! Because of that, I added a document that will explain how to use this API (API-Explanation file).
Using the Code
Since our project is a little bit wide (of course I mean, than the previous one), I focus my explanation on the class that deals with pictures and creates wallpapers.
So let's start:
- The first thing to do is initialize the picture used to be the 'main' wallpaper, on the other hand it's the property
MyFileBimap
that controls this process.Friend Property MyFileBimap() As String Get Return MyFileNameEx End Get Set(ByVal value As String) If value Is Nothing OrElse value = "" Then MyFileBimapEx = Nothing MyFileNameEx = "" Else MyFileBimapEx = New Bitmap(value) MyFileNameEx = value End If End Set End Property
- Now, I suppose that my picture is really "tiny" since my screen resolution is very large. So I got an idea to include a background in this one. Well, I must notice that my project will directly create a black background if the picture doesn't exist. Here it is the property that will init the background picture.
Friend Property MyBgPic() As Bitmap Get Return MyBgPicEx End Get Set(ByVal value As Bitmap) If value Is Nothing Then MyBgPicEx = Nothing Else If value.Width > MyScreenWidth _ OrElse value.Height > MyScreenHeight Then 'Set the size of the back-ground pic 'as the size of screen resolution MyBgPicEx = New Bitmap(value, MyScreenWidth, MyScreenHeight) Else MyBgPicEx = value End If End If End Set End Property
This property will create the background bitmap to the screen resolution!
You might be wondering why I added this background picture. Honestly guys, do you prefer this kind of wallpaper?

Or do you prefer this one:

I mean, when the system tries to resize the picture to the desktop (depending on your screen resolution), your picture will look really blurred!
So then the idea is to keep the original picture size, and add this one to a bigger, background.
Now, we can call the subroutine that creates our final picture WallpaperChanger
:
Friend Sub WallpaperChanger()
Dim MyXLoc As Int32
Dim MyYLoc As Int32
'
Dim MyGraphic As Graphics
'
If MyBgPicEx Is Nothing Then
MyBgPicEx = New Bitmap(MyScreenWidth, MyScreenHeight)
MyGraphic = Graphics.FromImage(MyBgPicEx)
'Fill the empty area !...in my example i fill it with Black brush
MyGraphic.FillRectangle(Brushes.Black, 0, 0, MyScreenWidth, MyScreenHeight)
Else
'Resize the background picture...
MyBgPicEx = New Bitmap(MyBgPicEx, MyScreenWidth, MyScreenHeight)
MyGraphic = Graphics.FromImage(MyBgPicEx) 'Create a graphic from MyBgPicEx,
'in which will be added our MyFileBitmapEx
End If
As you see, if no background picture is entered, the program will create an empty black area, with height/width equal as those of the screen resolution and on the other hand when (MyBgPicEx
<> Nothing), a resize action will occur.
'Verify the width & height of the picture
If MyFileBimapEx.Width > MyScreenWidth Then
MyXLoc = 0
MyFileBimapEx = New Bitmap_
(MyFileBimapEx, MyScreenWidth, MyFileBimapEx.Height)
Else
MyXLoc = (MyScreenWidth - MyFileBimapEx.Width) / 2
End If
If MyFileBimapEx.Height > MyScreenHeight Then
MyYLoc = 0
MyFileBimapEx = New Bitmap_
(MyFileBimapEx, MyFileBimapEx.Height, MyScreenHeight)
Else
MyYLoc = (MyScreenHeight - MyFileBimapEx.Height) / 2
End If
So now what's about MyXLoc
& MyYLoc
!

Those two variables will exists only if (MyFileBitmapEx
) is smaller than screen resolution, and both give the position (x,y) of MyFileBitmapEx
in MyBgPicEx.
'Draw the FileMyBitmapEx into the MyBgPicEx, in the given location (MyXLoc, MyYLoc) !
MyGraphic.DrawImage(MyFileBimapEx, _
MyXLoc, MyYLoc, MyFileBimapEx.Width, MyFileBimapEx.Height)
- Imagine that somebody will like to add some text to the wallpaper,... since
MyGraphic
is holding (MyBgPicEx
+MyFileBitmapEx
), we can add some text:If MyTextEx.Length > 0 Then MyGraphic.DrawString(MyTextEx, MyFontStyleEx, _ New SolidBrush(MyFontColorEx), MyTextLocEx.X, MyTextLocEx.Y) End If
- Since all effects are added to
MyGraphic
, we are now able to generate our bitmap, and I must notice that it will be saved to disk when you callSavePicture
but before that, let's check the final part ofWallpaperChanger
subroutine.'Create a new pathfile Dim MyStr As String MyStr = System.IO.Path.GetFileNameWithoutExtension(MyFileNameEx) MyNewPath = My.Computer.FileSystem.CombinePath(TempDirEx, MyStr & ".bmp") 'Verif that file doesn't exist If IO.File.Exists(MyNewPath) Then Dim DialogResult As MsgBoxResult = _ MsgBox("Do you want to replace the existing file", _ MsgBoxStyle.Exclamation + MsgBoxStyle.YesNo, "Notification") If DialogResult = MsgBoxResult.No Then MyStr = InputBox("filename", "Enter a valid filename !", _ "", MyScreenWidth / 2, MyScreenHeight / 2) MyNewPath = My.Computer.FileSystem.CombinePath_ (TempDirEx, MyStr & ".bmp") End If End If 'Return the path, so it can be loaded again in preview picture box MyFileNameEx = MyNewPath
As you see, this final part only generates the name of the resulted picture, that will be finally saved to disk using
SavedPicture
:Friend Sub SavePicture() 'Save bitmap to disk... MyBgPicEx.Save(MyFileNameEx, Drawing.Imaging.ImageFormat.Bmp) End Sub
- The most interesting part in this project is how to set the wallpaper and I do that by calling an API function declared as:
Const SPI_SETDESKWALLPAPER = 20 Const SPIF_UPDATEINIFILE = &H1 Const SPIF_SENDWININICHANGE = &H2 Private Declare Auto Function SystemParametersInfo Lib _ "user32" (ByVal uAction As Int32, ByVal uParam As Int32, _ ByVal lpvParam As String, ByVal fuWinIni As Int32) As Integer
and called from
SetWallpaper
:Friend Sub SetWallpaper(ByVal MyBitmap As String) SystemParametersInfo(SPI_SETDESKWALLPAPER, _ 0, MyBitmap, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE) End Sub
-
Yes, as you guessed it:
MyBitmap
is the picture that resulted from the previous transformation.
Other Stuff in this Project
Well, it will take a lot of time for me to explain other stuff, like:
- Changing desktop wallpaper after a given time, I of course used a timer :
Private Sub Timer1_Tick(ByVal sender As Object, ByVal e As System.EventArgs) _ Handles Timer1.Tick If MyCount > Me.ListBox1.Items.Count - 1 Then MyCount = 0 Else MyWallpaper.SetWallpaper(ListBox1.Items.Item(MyCount)) MyCount += 1 End If End Sub
- Selecting the position where to put the text on picture :
Private Sub PictureBox3_MouseClick(ByVal sender As Object, _ ByVal e As System.Windows.Forms.MouseEventArgs) _ Handles PictureBox3.MouseClick Select Case e.Button Case Windows.Forms.MouseButtons.Left 'Store the current position of text MyWallpaper.MyTextLoc = New Point(e.X * Me.ScreenRsX / 232, _ e.Y * Me.ScreenRsY / 201) TextBox2.Text = Format((e.X * Me.ScreenRsX / 232), "0") TextBox3.Text = Format((e.Y * Me.ScreenRsY / 201), "0") Case Windows.Forms.MouseButtons.Right 'Show the resulted wallpaper in fullscreen mode ! Dim MyResizer As New Bitmap(Me.PictureBox3.Image) FullScreen.PictureBox1.Image = Me.PictureBox3.Image FullScreen.Height = MyResizer.Height FullScreen.Width = MyResizer.Width ' FullScreen.Show() MyResizer = Nothing End Select End Sub
Well, to be clear when the RIGHT button is clicked, the resulted wallpaper will be showed in fullscreen mode.
Other thing, I added an invert color subroutine. Somebody might like to add a white text on the picture, and since the textbox also has a white background... this subroutine will invert the color so the user will be able to see what he writes!
Private Function RevertColor(ByVal MyColor As Color) As Color Dim MyAlpha As Int32 Dim MyRGBCvrted As Int32 MyAlpha = MyColor.ToArgb And &HFF000000 'Store alpha... MyRGBCvrted = MyColor.ToArgb And &HFFFFFF _ 'Now eliminate Alpha...and keep only RBG colors MyRGBCvrted = &HFFFFFF - MyRGBCvrted 'Revert color MyRGBCvrted += MyAlpha 'Restore Alpha Return Color.FromArgb(MyRGBCvrted) End Function
Points of Interest
I put in my best effort to make this project clear, and I hope you did find some useful things that will help you on your project. Concerning me, it was another good initiation for me with the GDI+ features provided by .NET !
History
- Version (1.0.0) created on : (26).03.2008 By : GENCOX {Mozads}