Date: 02-16-2022
Return to Index
created by gbSnippets
'This snippet allows you to browse a PowerBASIC resource file (*.pbr), displaying
'any icons or bitmaps it contains and converting the images to DATA statements.
'See the snippet http://gbl_00470 for information on converting resource images
'to DATA statements. The snippet on this page makes use of that capability.
'Using gbConverter
'1. Replace the #Resource file name in this snippet with the name of your own
' PowerBASIC resource file (*.pbr) that you want to browse.
'2. Select the type of image (icon or bitmap). The listbox will show the names
' of the resource images of that type.
'3. Select an image by clickingon the image name inthe listbox. The selected
' image and DATA statements will be automatically displayed.
'4 If you want the image resized, type in a new size or select a pre-defined
' size from the combobox dropdown list. Because of limits on the number of
' allow DATA statements, icons are displayed at a maximum size of 90x90.
' The DATA statements will reflect the displayed size.
'Key Features
'1. Uses Built-in System Icons
' The snippet uses toolbar icons found in comctl32.inc, so using your own
' *.pbr file will not change the look of the user interface.
'2. Resource Image Browser
' The snippet uses API to extract a list of icons and bitmaps found within
' the *.pbr (once it is compiled into the EXE). Resource image dimensions
' are also read.
'3. Conversion to DATA statements
' Any of the icons can be converted to DATA statements which allow recreation
' of an image within an application without the use of resource files or
' image files.
'4. Speech Synthesis Demonstration
' When images are found that exceed the 90x90 limit, the snippet (optionally)
' says "Image exceeds size limits!".
'5. Composite Image
' For ease of viewing, all of the resource images can be displayed in a
' single, composite image.
'6. Resource Image Display
' Displays both icons and bitmaps (bitmap display is easy whereas displaying
' icons takes a bit more code).
'Compiler Comments:
'This code is written to compile in PBWin10. To compile in PBWin9, replace this line:
Set oSp = New Dispatch In "SAPI.SpVoice"
'with this line:
Let oSp = NewCOM "SAPI.SpVoice"
'Primary Code:
'For brevity, the code is shown only in the compilable example, but here are
'descriptions of the key functions.
'1. CreateDATAStatements - generates a Function, with DATA statements, to recreate an image
'2. GetIconDimensions - determines the size of icon resources.
'3. GetBitmapDimensions - determines the size of bitmap resources.
'4. GetResourceNames and EnumResNameProc - creates a list of available resource images.
'5. DisplayIcon - displays icons or bitmaps in a graphic target.
'6. AddToolbar - creates toolbar, with imagelist that contains built-in system icons
'7. DisplayAllImages - creates composite of all resource images
'8. ReadText - gives verbal text warning when images sizes exceed 90x90 limit
'Compilable Example: (Jose Includes)
'This snippet allows you to browse the icons/bitmaps within a compiled EXE.
'You can select which type of image (icon or bitmap) to display and can resize
'the image as well. It generates a complete Function that includes
'the Data statements and the code needed to convert the DATA statements to a bit
'string that can be loaded into graphic targets. Finally, the entire list of
'resource images can be viewed as a composite image. An optional text-to-speech
'feature is provided to identify icons which exceed the DATA limit of 90x90 pixels.
#Compiler PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Debug Error On 'catch array/pointer errors - OFF in production
#Debug Display On 'display untrapped errors - OFF in production
#Include "Win32API.inc"
#Include "CommCtrl.inc"
#Resource "gbsnippets.pbr"
Global hDlg, hComboBox, hFont, hGWindow, hFont as DWord
Global imgNames() As String, imgTypes() as Long '0-both 1-icon 2-bmp
Global imgW, imgH, imgCurrent As Long
'Control Equates
%ID_Graphic = 300 : %ID_Data = 550 : %ID_DataLabel = 200 : %ID_CheckIcon = 851
%ID_ComboBox = 250 : %ID_ListBox = 831 :%ID_Toolbar = 850 : %ID_CheckBMP = 852
'Toolbar Equates
%IDT_Save = 200 : %IDT_CopyImage = 201 : %IDT_CopyDATA = 202 : %IDT_DisplayAll = 203
Function PBMain() As Long
Dim cItems(3) As String, Style&, hIcon as DWord
style& = %WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoHScroll _
Or %WS_HScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %WS_TabStop
cItems(0) = "16x16" : cItems(1) = "32x32" : cItems(2) = "48x48" : cItems(3) = "90x90"
Dialog New Pixels, 0, "gbResourceViewer: Resource Image Viewer and DATA Converter",300,300,600,410, %WS_OverlappedWindow To hDlg
hIcon = LoadIcon(ByVal %Null, ByVal %IDI_Information) 'use system icon to avoid resource images
SendMessage hDlg, %WM_SETICON, %ICON_BIG, hIcon
SendMessage hDlg, %WM_SETICON, %ICON_SMALL, hIcon
Control Add Label, hDlg, 100,"Resource Names:", 30,35,100,20
Control Add Label, hDlg, 101,"DATA Statements:", 150,35,140,20
Control Add Label, hDlg, 102,"Image Size:", 30,270,75,20
Control Add Checkbox, hDlg, %ID_CheckIcon,"Icons", 30,240,50,20: Control Set Check hDlg, %ID_CheckIcon, 1
Control Add Checkbox, hDlg, %ID_CheckBMP,"BMPs", 90,240,50,20 : Control Set Check hDlg, %ID_CheckBMP, 1
Control Add ComboBox, hDlg, %ID_ComboBox, cItems(), 30,285,110,100, %CBS_DropDown Or %WS_TabStop
Control Handle hDlg, %ID_ComboBox To hComboBox
ComboBox Select hDlg, %ID_ComboBox, 2
Control Add Graphic, hDlg, %ID_Graphic,"", 30, 315,32,32, %WS_Visible 'w,h will change once resources are read
Graphic Attach hDlg, %ID_Graphic
Control Add ListBox, hDlg, %ID_ListBox, , 30,50,100,200, %LBS_Notify Or %WS_TabStop Or %WS_VScroll, %WS_Ex_ClientEdge
Control Add TextBox, hDlg, %ID_Data,"mydata.txt", 150,50,360,210, Style&, %WS_Ex_StaticEdge
Font New "Courier New" To hFont
Control Set Font hDlg, %ID_Data, hFont
Font New "MS Sans Serif", 8, 1 TO hFont
Control Set Font hDlg, 100, hFont : Control Set Font hDlg, 101, hFont : Control Set Font hDlg, 102, hFont
AddToolbar
GetResourceNames : GetImageDimensions(1) : ResizeControls : DisplayIcon : CreateDataStatements
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local temp$, hBMP as DWord
Select Case CB.Msg
Case %WM_Size
ResizeControls
Case %WM_Command
Select Case CB.Ctl
Case %ID_CheckIcon, %ID_CheckBMP
GetResourceNames : GetImageDimensions(1) : ResizeControls : DisplayIcon : CreateDataStatements
Case %ID_ListBox
If CB.Ctlmsg = %LBN_SelChange Then
ListBox Get Select hDlg, %ID_ListBox To imgCurrent
GetImageDimensions(1) : ResizeControls : DisplayIcon : CreateDataStatements
End If
Case %IdOk
If GetParent(GetFocus) = hComboBox Then DisplayIcon
Case %ID_ComboBox 'image size
Select Case CB.Ctlmsg
Case %CBN_EditChange
Control Get Text hDlg, %ID_ComboBox To temp$
imgW = Val(Parse$(temp$,"x",1))
imgH = Val(Parse$(temp$,"x",2))
DisplayIcon
Case %CBN_SelChange
ComboBox Get Text hDlg, %ID_ComboBox To temp$
imgW = Val(Parse$(temp$,"x",1))
imgH = Val(Parse$(temp$,"x",2))
DisplayIcon
End Select
Case %IDT_Save
SaveDATAToFile
Case %IDT_CopyImage
Control Handle hDlg, %ID_Graphic To hBMP
Clipboard Reset
Clipboard Set Bitmap hBMP
Case %IDT_CopyDATA
Control Get Text hDlg, %ID_Data To temp$
Clipboard Reset
Clipboard Set Text temp$
Case %IDT_DisplayAll : DisplayAllImages
End Select
Case %WM_NOTIFY
If CB.Nmcode = %TTN_GetDispInfo Then
Local P as TOOLTIPTEXT Ptr
P = CB.lParam
Select Case CB.NmID 'or this: @P.hdr.idFrom
Case 200 : @P.@lpszText = "Save DATA Statements"
Case 201 : @P.@lpszText = "Copy Image"
Case 202 : @P.@lpszText = "Copy DATA Statements"
Case 203 : @P.@lpszText = "Display All Images"
End Select
End If
End Select
End Function
Sub ResizeControls
Local dX As Long, dY As Long
Dialog Get Client hDlg To dX, dY
Control Set Size hDlg, %ID_Data, dX - 170, dY - 70
End Sub
Sub DisplayIcon
Local hLst As DWord
ResizeControls
Control Kill hDlg,%ID_Graphic
Control Add Graphic, hDlg, %ID_Graphic,"", 30,315,imgW,imgH, %WS_Visible
Graphic Attach hDlg, %ID_Graphic
Graphic Clear
If imgCurrent = 0 Then
'do nothing
ElseIf imgTypes(imgCurrent) = 1 Then '1=icon 2=bmp
ImageList New Icon imgW,imgH,24,100 To hLst 'create icon imagelist
ImageList Add Icon hLst, imgNames(imgCurrent) 'just a single icon in the imagelist
Graphic ImageList (0,0), hLst, 1,0,%ILD_Normal 'copy the icon to the Graphic control
ImageList Kill hLst 'remove the imagelist
Else
Graphic Render imgNames(imgCurrent), (0,0)-(imgW,imgH)
End If
End Sub
Sub CreateDATAStatements
Local temp$, i As Long, xsize&, ysize&, bmp$, P As Long Ptr
If imgCurrent Then
Graphic Attach hDlg, %ID_Graphic
Graphic Get Bits To bmp$
P = StrPTR(bmp$)
xsize& = CVL(bmp$,1) : ysize& = CVL(bmp$,5)
temp$ = "Function BitString() As String"
temp$ = temp$ + $CrLf + " 'bit string for: " + imgNames(imgCurrent) + " "+ Str$(xsize&) + "x" + LTrim$(Str$(ysize&))
temp$ = temp$ + $CrLf + " Local bmp$, i As Long"
For i = 0 To (xsize& * ysize& + 1)
temp$ = temp$ + IIF$(i Mod 30, ", ", $CrLf + " DATA ") + Hex$(@P,6)
Incr P
Next i
temp$ = temp$ + $CrLf + " For i = 1 to DataCount"
temp$ = temp$ + $CrLf + " bmp$ = bmp$ + Mkl$(Val("+Chr$(34)+"&H"+Chr$(34)+"+Read$(i)))"
temp$ = temp$ + $CrLf + " Next i"
temp$ = temp$ + $CrLf + " Function = bmp$" + $CrLf + "End Function"
End If
Control Set Text hDlg, %ID_Data, temp$ 'temp$ is empty is imgCurrent=0
End Sub
Sub GetResourceNames
Local i As Long, iCheckIcon&, iCheckBMP&
ReDim imgNames(0), imgTypes(0)
Control Get Check hDlg, %ID_CheckIcon To iCheckIcon&
If iCheckIcon Then EnumResourceNames GetModuleHandle(""), ByVal %RT_Group_Icon, CodePTR(EnumResNameProc), 1 'icon
Control Get Check hDlg, %ID_CheckBMP To iCheckBMP&
If iCheckBMP Then EnumResourceNames GetModuleHandle(""), ByVal %RT_Bitmap, CodePTR(EnumResNameProc), 2 'bmp
ListBox Reset hDlg, %ID_ListBox
If (UBound(imgNames) = 0) Or (iCheckBMP& = 0 AND iCheckIcon& = 0) Then
ListBox Add hDlg, %ID_ListBox, "<no images>"
imgCurrent = 0
Else
For i = 1 To UBound(imgNames) : ListBox Add hDlg, %ID_ListBox, LCase$(imgNames$(i)) : Next i
imgCurrent = 1
End If
ListBox Select hDlg, %ID_ListBox, 1
End Sub
Function EnumResNameProc (ByVal hModule As DWord, ByVal lpszType As Asciiz Ptr, _
ByVal lpszName As Asciiz Ptr, ByVal lParam As Long) As Long
Local strName As String, imgCount As Long
If xIs_IntResource(lpszName) Then
strName = "#" + Format$(lpszName)
Else
strName = @lpszName
End If
imgCount = UBound(imgNames)+1
ReDim Preserve imgNames(imgCount), imgTypes(imgCount)
imgNames(imgCount) = strName
imgTypes(imgCount) = lParam
Function = %TRUE
End Function
Sub GetImageDimensions(Warn as Long) '1 = warn verbally if icon is too large 0 = do not warn verbally
If imgTypes(imgCurrent) = 1 Then
GetIconDimensions(Warn)
ElseIf imgTypes(imgCurrent) = 2 Then
GetBitmapDimensions(Warn)
Else
Control Set Text hDlg, %ID_ComboBox, "0x0"
End If
End Sub
Sub GetBitmapDimensions(Warn As Long)
Local hBMP As DWord, temp$
Graphic Bitmap Load imgNames(imgCurrent), 0, 0 To hBMP
Graphic Attach hBMP, 0
Graphic Get Client To imgW, imgH
Graphic Bitmap End
If imgW > 90 Or imgH > 90 Then temp$ = " ("+LTrim$(Str$(imgW))+"x"+LTrim$(Str$(imgH))+")" 'keep original size info
' If Warn Then If imgW > 90 Or imgH > 90 Then Beep 'ReadText ("Image exceeds size limits!")
If imgW > 90 Then imgW = 90
If imgH > 90 Then imgH = 90
Control Set Text hDlg, %ID_ComboBox, Str$(imgW) + "x" + Str$(imgH) + temp$
End Sub
Sub GetIconDimensions(Warn As Long)
Local hIcon As DWord, P As IconInfo, tempz as AsciiZ * %Max_Path, temp$
tempz = imgNames(imgCurrent)
hIcon = LoadImage(GetModuleHandle(""), tempz, %IMAGE_ICON, 0, 0, %LR_DEFAULTCOLOR)
GetIconInfo hIcon, P
DestroyIcon hIcon '
imgW = P.xHotSpot*2 : imgH = P.yHotSpot*2
If imgW > 90 Or imgH > 90 Then temp$ = " ("+LTrim$(Str$(imgW))+"x"+LTrim$(Str$(imgH))+")" 'keep original size info
' If Warn Then If imgW > 90 Or imgH > 90 Then Beep 'ReadText ("Image exceeds size limits!")
If imgW > 90 Then imgW = 90
If imgH > 90 Then imgH = 90
Control Set Text hDlg, %ID_ComboBox, Str$(imgW) + "x" + Str$(imgH) + temp$
End Sub
Sub AddToolbar
Local hLst as DWord, BMP As TBADDBITMAP, i as Long
'add toolbar
Control Add Toolbar, hDlg, %ID_Toolbar,"", 0,0,0,0, %TbStyle_Tooltips Or %TbStyle_Flat
'create imagelist
'adds all 3 small icon bitmaps from the comctl32.dll images - total of 32 icons
BMP.hInst = %HINST_COMMCTRL
BMP.nID = %IDB_STD_SMALL_COLOR
Control Send hDlg, %ID_Toolbar, %TB_ADDBITMAP, 0, VarPTR(BMP) 'add comctrl32.dll icons to internal toolbar imagelist
BMP.nID = %IDB_VIEW_SMALL_COLOR
Control Send hDlg, %ID_Toolbar, %TB_ADDBITMAP, 0, VarPTR(BMP) 'add comctrl32.dll icons to internal toolbar imagelist
BMP.nID = %IDB_HIST_SMALL_COLOR
Control Send hDlg, %ID_Toolbar, %TB_ADDBITMAP, 0, VarPTR(BMP) 'add comctrl32.dll icons to internal toolbar imagelist
Control Send hDlg, %ID_Toolbar, %TB_GETIMAGELIST, 0, 0 To hLst 'handle of image list created by API
ImageList Get Count hLst To i 'necessary to access imagelist with Graphic statements
'attach imagelist
Toolbar Set ImageList hDlg, %ID_Toolbar, hLst, 0
'create buttons
Toolbar Add Button hDlg, %ID_Toolbar, 9, %IDT_Save, %TbStyle_Button, ""
' Toolbar Add Button hDlg, %ID_Toolbar, 2, %IDT_CopyImage, %TbStyle_Button, ""
Toolbar Add Button hDlg, %ID_Toolbar, 2, %IDT_CopyDATA, %TbStyle_Button, ""
Toolbar Add Button hDlg, %ID_Toolbar, 18, %IDT_DisplayAll, %TbStyle_Button, ""
End Sub
Sub DisplayAllImages
Local hLst As DWord
Local i,x,y,yMax,imgOld,gW, gH, tempX, tempY As Long
imgOld = imgCurrent : gW = 800 : gH = 600
Graphic Window "Resource Images (Composite)", 200,200,gW,gH To hGWindow
x = 10 : y = 10 : yMax = 0
For imgCurrent = 1 To UBound(imgNames)
GetImageDimensions(0)
If (x+imgW+10) > gW Then x = 10 : y = y + yMax + 30 : yMax = 0
Graphic Attach hGWindow, 0, Redraw
If imgTypes(imgCurrent) = 1 Then '1=icon 2=bmp
ImageList New Icon imgW,imgH,24,1 To hLst 'create icon imagelist
ImageList Add Icon hLst, imgNames(imgCurrent) 'just a single icon in the imagelist
Graphic ImageList (x,y), hLst, 1,0,%ILD_Normal 'copy the icon to the Graphic Window
ImageList Kill hLst 'remove the imagelist
Else
Graphic Render imgNames(imgCurrent), (x,y)-(x+imgW,y+imgH)
End If
Graphic Set Pos (x,y+imgH+10) : Graphic Print LCase$(imgNames(imgCurrent))
Graphic Text Size LCase$(imgNames(imgCurrent)) To tempX,tempY
x = x + Max&(imgW,tempX) + 10
If imgH > yMax Then yMax = imgH
Next i
Graphic Redraw
imgCurrent = imgOld
GetImageDimensions(0)
End Sub
Sub SaveDATAToFile
Local title$, folder$, filter$, start$, defaultext$, flags&, filevar$, countvar&, temp$
title$ = "Save DATA As" 'if "", then "Save As" is used
folder$ = Exe.Path$ 'if "", Then current directory is used
filter$ = Chr$("PowerBASIC (*.bas)", 0, "*.bas", 0)
start$ = "mydata" 'starting filename
defaultext$ = "bas"
flags& = %OFN_PathMustExist Or %OFN_Explorer Or %OFN_OverWritePrompt
Display SaveFile hDlg, 100, 100, "Save File", folder$, filter$, start$, _
defaultext$, flags& To filevar$, countvar&
If Len(filevar$) Then
Control Get Text hDlg, %ID_Data To temp$
Open filevar$ For Output As #1
Print #1, temp$
Close #1
End If
End Sub
Sub ReadText (sText As String)
Local vRes, vTxt, vTime As Variant, oSp as Dispatch
Let oSp = NewCOM "SAPI.SpVoice"
If IsFalse IsObject(oSp) Then Exit Sub
vTxt = sText
Object Call oSp.Speak(vTxt) To vRes
vTime = -1 As Long
Object Call oSp.WaitUntilDone(vTime) To vRes
End Sub
Function xIS_INTRESOURCE (ByVal dwInteger AS DWord) As Long
Shift RIGHT dwInteger, 16
Function = (dwInteger = 0)
End Function
'gbs_00481
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm