gbResourceViewer - Resource Image Viewer / Convert to DATA

Category: Utilities

Date: 03-28-2012

Return to Index

'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, 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:
'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
#Debug Error On     'catch array/pointer errors - OFF in production
#Debug Display On   'display untrapped errors   - OFF in production
#Include ""
#Include ""
#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 NewTo 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
   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
      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))
                  Case %CBN_SelChange
                     ComboBox Get Text hDlg, %ID_ComboBox To temp$
                     imgW = Val(Parse$(temp$,"x",1))
                     imgH = Val(Parse$(temp$,"x",2))
               End Select
            Case %IDT_Save
            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
   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
      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
      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 LongAs Long
   Local strName As String, imgCount As Long
   If xIs_IntResource(lpszName) Then
      strName = "#" + Format$(lpszName)
      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
   ElseIf imgTypes(imgCurrent) = 2 Then
      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
   Control Send hDlg, %ID_Toolbar, %TB_ADDBITMAP, 0, VarPTR(BMP)    'add comctrl32.dll icons to internal toolbar imagelist
   Control Send hDlg, %ID_Toolbar, %TB_ADDBITMAP, 0, VarPTR(BMP)    'add comctrl32.dll icons to internal toolbar imagelist
   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)
      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
         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
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 DWordAs Long
   Shift RIGHT dwInteger, 16
   Function = (dwInteger = 0)
End Function
'Date: 03-10-2012

created by gbSnippets