Playing with gdiplusx

Articles - Playing with GDIPLUSX - 20071112

Intro

This article is about my first experiences with the GDIPLUSX classes. These classes are so big that they are really intimidating for a newbie. I decided to take baby steps, and try to learn a few things.

I needed to produce some images for the upcoming ctl32_menu class that I am writing, so I decided to play a little. Since Office already has hundreds of icons to play with, this is what i did.

(I see that Cesar has also written a blog entry regarding this subject: http://weblogs.foxite.com/cesarchalom/archive/2007/11/12/5388.aspx#5397 )

STEP1 Ask MS OFFICE to give us a copy of its images.

To get some images to play with, we open a new Excel Spreadsheet, select Tools - Macro - Visual Basic Editor from the menu, click on the first page, and copy paste this code in the code window:

Option Explicit

Public Sub GetOfficeButton()

' Affiche une boîte de dialogue pour choisir le dossier d'extraction
Dim Dlg As Office.FileDialog
Set Dlg = Application.FileDialog(msoFileDialogFolderPicker)
Dlg.AllowMultiSelect = False
Dlg.Show
Dlg.InitialFileName = Application.ThisWorkbook.Path & "\"
If Dlg.SelectedItems.Count > 0 Then

Const FileExt As String = ".bmp"
Const nbFileDigit As Integer = 5

Dim ExtractDirectory As String: ExtractDirectory = Dlg.SelectedItems(1)
If Right$(ExtractDirectory, 1) <> "\" Then ExtractDirectory = ExtractDirectory & "\"

' Bouton temporaire
Dim TblBtn As Office.CommandBarButton
Set TblBtn = Application.CommandBars(1).Controls.Add(Office.msoControlButton)

' Extraction
On Error Resume Next
Dim nBtn As Integer
Do ' Comme on ne connait pas le nombre de boutons
nBtn = nBtn + 1 ' Incrémente le nombre de boutons trouvés
TblBtn.FaceId = nBtn ' Attribut l'image du bouton
If Err.Number = -2147467259 Then Exit Do ' Si le bouton n'a pas été trouvé (on est arrivé à la fin), on quitte la boucle
Dim BtnId As String: BtnId = FormatInt(nBtn, nbFileDigit) ' Formatage du nom de l'image
SavePicture TblBtn.Picture, ExtractDirectory & BtnId & FileExt ' Enregistre l'image
SavePicture TblBtn.Mask, ExtractDirectory & BtnId & ".msk"
Loop
Err.Clear
On Error GoTo 0

MsgBox "Terminer" & vbNewLine & nBtn & " images extraites.", vbInformation, "GetOfficeButton"

TblBtn.Delete ' Supprime le bouton temporaire
End If
End Sub

Private Function FormatInt(ByVal n As Integer, ByVal Lenght As String) As String
Dim sn As String: sn = CStr(n)
If Len(sn) < Lenght Then
FormatInt = String(Lenght - Len(sn), "0") & sn
Exit Function
End If
FormatInt = n
End Function

I got this code from the web, so the credit goes to the original author. I think here: http://www.vbfrance.com/codes/EXTRACTION-ICONES-MENU-OFFICE_38526.aspx

We run this code, create a folder in the dialog, and after a while we will have about 32.000 bmp and msk files in that folder. Now what we have is a bmp and msk pair for each icon in Office. A lot of this icons are empty or duplicated.

The msk file is the mask for the bmp file. The white area should be transparent, the black area should be opaque in the bmp.

Step 2 Continue with VFP and GDIPLUSX

For this step you will need the GDIPLUSX files: http://www.codeplex.com/VFPX/Wiki/View.aspx?title=GDIPlusX&referringTitle=Home

The following code will get rid of empty and duplicate icons, will merge bmp files with msk files, making transparent areas white, convert original white pixels to rgb(254,254,254), and create different versions of the images in bmp and png format.

This is just so you can see the power of the GDIPLUSX classes.

This is the code, copy paste in a prg and run it, point it to the folder where you have the Office icons.

*!* disabled matrix (not a grayscale colormatrix, it is an attempt to emulate disabled bitmaps, but it is not 100% right

*!* maybe someone can stumble upon the matrix used by MS to do disabled bitmaps?

#Define _COLORMATRIX_DISABLED 0.2125, 0.2125, 0.2125, 0, 0, 0.2577, 0.2577, 0.2577, 0, 0, 0.0361, 0.0361, 0.0361, 0, 0, 0, 0, 0, 1, 0, 0.38, 0.38, 0.38, 0, 1

*!* CCIR 709 grayscale matrix http://www.w3.org/TR/PNG-Decoders.html (10.6. Decoder color handling)

#Define _COLORMATRIX_709 0.212671, 0.212671, 0.212671, 0, 0, 0.715160, 0.715160, 0.715160, 0, 0, 0.072169, 0.072169, 0.072169, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1

*!* average grayscale matrix

#Define _COLORMATRIX_AVERAGE 0.3333, 0.3333, 0.3333, 0, 0, 0.3333, 0.3333, 0.3333, 0, 0, 0.3333, 0.3333, 0.3333, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1

*!* Bob Powell grayscale matrix http://www.bobpowell.net

#Define _COLORMATRIX_BOB 0.30, 0.30, 0.30, 0, 0, 0.59, 0.59, 0.59, 0, 0, 0.11, 0.11, 0.11, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1

*!* sepia matrix http://msdn.microsoft.com/msdnmag/issues/05/01/NETMatters

#Define _COLORMATRIX_SEPIA 0.393, 0.349, 0.272, 0 ,0, 0.769, 0.686, 0.534, 0, 0, 0.189, 0.168, 0.131, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1

Clear

Do Locfile("System.prg")

Set Safety Off

Local m.lcFolder, ;

m.lcFileSpec, ;

m.lcFileName, ;

m.lcFileData

m.lcFolder = Getdir("","","Bitmaps source folder",64)

If Empty(m.lcFolder) Then

Return

Endif

Set Default To (m.lcFolder)

*!* Create cursor to hold files:

Create Cursor FILELIST (CRC32 C(20), FILENAME C(254))

Index On CRC32 Tag CRC32

Set Order To CRC32

*!* Create files array:

m.lcFileSpec = Addbs(m.lcFolder) + "*.bmp"

Local Array m.laFiles(5)

m.lnFilecount = Adir(m.laFiles, m.lcFileSpec)

*!* Delete empty bitmaps:

Clear

?"Deleting empty bitmaps"

For m.lnx = 1 To m.lnFilecount

m.lcFileName = m.lcFolder + m.laFiles(m.lnx,1)

m.lcFileData = Filetostr(m.lcFileName)

m.lcCRC32 = Padl(Sys(2007, m.lcFileData, -1, 1), 10, "0")

*!* we already know that an empty bitmap has a crc32 of 3558865349

If m.lcCRC32 = "3558865349" Then

Delete File (m.lcFileName)

Delete File (Forceext(m.lcFileName, "msk"))

Else

Insert Into FILELIST (CRC32, FILENAME) Values (m.lcCRC32, m.lcFileName)

Endif

??"."

Endfor

*!* Delete duplicate bitmaps:

?"Deleting duplicate bitmaps"

m.oldcrc32 = "#"

Scan

??"."

If FILELIST.CRC32 == m.oldcrc32 Then

Delete File (FILELIST.FILENAME)

Delete File (Forceext(FILELIST.FILENAME, "msk"))

Else

m.oldcrc32 = FILELIST.CRC32

Endif

Endscan

If Not Directory("bmp") Then

Mkdir "bmp"

Endif

If Not Directory("bmp\normal") Then

Mkdir "bmp\normal"

Endif

*!* combine bmp with msk:

m.lnFilecount = Adir(m.laFiles, m.lcFileSpec)

Clear

?"Replacing RGB(255,255,255) with RGB(254,254,254)."

?"Replacing MSK RGB(255,255,255) with RGB(255,255,255)"

For m.lnx = 1 To m.lnFilecount

m.lcFileName = m.lcFolder + m.laFiles(m.lnx,1)

m.lcDIB1 = Filetostr(m.lcFileName)

If Empty(Sys(2000, Forceext(m.lcFileName, "msk"))) Then

m.lcDIBM = Filetostr(m.lcFileName)

Else

m.lcDIBM = Filetostr(Forceext(m.lcFileName, "msk"))

Endif

m.lcWhite1 = Chr(0xff) + Chr(0xff) + Chr(0xff)

m.lcWhite2 = Chr(0xfe) + Chr(0xfe) + Chr(0xfe)

*!* bitmaps are 16x16 pixels big: 256 pixels total, x 3 colors (8 bits each: 24 bits each pixel) = 768 bytes

m.lnStart = Len(m.lcDIB1) - 16*16*3

m.lcDIB2 = Left(m.lcDIB1, m.lnStart)

For m.lnPixelIndex = 0 To 255 && 256 pixels total * 3 colors

m.lcPixel = Substr(m.lcDIB1, m.lnStart + 1 + m.lnPixelIndex * 3, 3)

m.lcMask = Substr(m.lcDIBM, m.lnStart + 1 + m.lnPixelIndex * 3, 3)

If m.lcMask = m.lcWhite1 Then

m.lcDIB2 = m.lcDIB2 + m.lcWhite1

Else

If m.lcPixel = m.lcWhite1 Then

m.lcDIB2 = m.lcDIB2 + m.lcWhite2

Else

m.lcDIB2 = m.lcDIB2 + m.lcPixel

Endif

Endfor

Strtofile(m.lcDIB2, ("bmp\normal\" + Juststem(m.lcFileName) + ".bmp"))

*!* Delete original bmp and msk files

Delete File(m.lcFileName)

Delete File (Forceext(m.lcFileName, "msk"))

??"."

Endfor

*!* Create folders

If Not Directory("png") Then

Mkdir "png"

Endif

If Not Directory("bmp") Then

Mkdir "bmp"

Endif

If Not Directory("png\disabled") Then

Mkdir "png\disabled"

Endif

If Not Directory("bmp\disabled") Then

Mkdir "bmp\disabled"

Endif

If Not Directory("png\grayscale") Then

Mkdir "png\grayscale"

Endif

If Not Directory("bmp\grayscale") Then

Mkdir "bmp\grayscale"

Endif

If Not Directory("png\hot") Then

Mkdir "png\hot"

Endif

If Not Directory("bmp\hot") Then

Mkdir "bmp\hot"

Endif

If Not Directory("png\normal") Then

Mkdir "png\normal"

Endif

If Not Directory("bmp\normal") Then

Mkdir "bmp\normal"

Endif

If Not Directory("png\pushed") Then

Mkdir "png\pushed"

Endif

If Not Directory("bmp\pushed") Then

Mkdir "bmp\pushed"

Endif

If Not Directory("png\sepia") Then

Mkdir "png\sepia"

Endif

If Not Directory("bmp\sepia") Then

Mkdir "bmp\sepia"

Endif

**************************************************************************

m.lcFolder = Application.DefaultFilePath + "\bmp\normal"

m.lcFileSpec = Addbs(m.lcFolder) + "*.bmp"

m.lnFilecount = Adir(m.laFiles, m.lcFileSpec)

**************************************************************************

Clear

?"Creating pngs"

For m.lnx = 1 To m.lnFilecount

BitmapToPng(Addbs(m.lcFolder) + m.laFiles(m.lnx,1))

m.lcSourceFile = Application.DefaultFilePath + "\png\normal\" + Forceext(m.laFiles(m.lnx,1), "png")

With _Screen.System.Drawing

m.loBitmap = .Bitmap.fromfile(m.lcSourceFile)

Endwith

m.loClrMatrix = _Screen.System.Drawing.Imaging.ColorMatrix.New(_COLORMATRIX_DISABLED)

m.lcTargetFile = Application.DefaultFilePath + "\png\disabled\" + Juststem(m.lcSourceFile) + "_d.png"