Module1.bas

Attribute VB_Name = "Module1"
Option Explicit
'
' Copyright © 1997-1999 Brad Martinez, http://www.mvps.org
'
' ============================================================================
' VB (and COM) recognize the following graphic files: BMP, DIB, GIF, JPG, WMF, EMF, ICO, CUR
' each containing the following propietary image file format signatures:
' (all IMGSIG_* and IMGTERM_* constants are user-defined)

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' BMP, DIB (bitmap):

'typedef struct tagBITMAPFILEHEADER {
'    WORD      bfType;   // "BM"
'    DWORD   bfSize;    // size of file, should match FRXITEMHDR*.dwSizeImage
'    WORD      bfReserved1;
'    WORD      bfReserved2;
'    DWORD   bfOffBits;
'} BITMAPFILEHEADER;

Public Const IMGSIG_BMPDIB = &H4D42   ' "BM" ('424D') WORD @ image offset 0

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' GIF:

' First 3 bytes is "GIF", next 3 bytes is version, '87a', '89a', etc.

Public Const IMGSIG_GIF = &H464947   ' "GIF" ('4749 | 46') masked DWORD @ image offset 0
Public Const IMGTERM_GIF = &H3B      ' ";" (semicolon), WORD @ offset Len(image) - 1

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' JPG:

' SOI = Start Of Image = 'FFD8'
'   This marker must be present in any JPG file *once* at the beginning of the file.
'    (Any JPG file starts with the sequence FFD8.)
' EOI = End Of Image = 'FFD9'
'    Similar to EOI: any JPG file ends with FFD9.
' APP0 = it's the marker used to identify a JPG file which uses the JFIF specification = FFE0

' integers
Public Const IMGSIG_JPG = &HD8FF       ' ('FFD8') WORD @ offset image 0, may have APP0
Public Const IMGTERM_JPG = &HD9FF   ' ('FFD9') WORD @ offset Len(image) - 2

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' WMF, EMF:

' first try to read the DWORD enhanced metafile signature @ image offset 40 (&H28)
' (ENHMETAHEADER.dSignature member)

Public Const ENHMETA_SIGNATURE = &H464D4520   ' ('2045 | 4D46') " EMF" (in wingdi.h)

' If that fails, try to read the DWORD METAHEADER.mtSize member @ image offset 6
' (it should equal FRXITEMHDR*.dwSizeImage), and check mtHeaderSize too.

Public Type METAHEADER   ' mh
  mtType As Integer
  mtHeaderSize As Integer   ' Len(mh)
  mtVersion As Integer
  mtSize As Long   ' size of image
  mtNoObjects As Integer
  mtMaxRecord As Long
  mtNoParameters As Integer
End Type

' If that fails, read the 16bit Aldus Placeable metafile header key:

' "Q129658 SAMPLE: Reading and Writing Aldus Placeable Metafiles" or
' "Q66949: INFO: Windows Metafile Functions & Aldus Placeable Metafiles"
'typedef struct {
'    DWORD           dwKey;   // 0x9AC6CDD7
'    WORD              hmf;
'    SMALL_RECT  bbox;
'    WORD              wInch;
'    DWORD           dwReserved;
'    WORD              wCheckSum;
'} APMHEADER, *PAPMHEADER;  // APMFILEHEADER

Public Const IMGSIG_WMF_APM = &H9AC6CDD7   ' ('D7CD | C69A') DWORD @ image offset 0

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' ICO, CUR:

' First check NEWHEADER.ResType, then, since there may be a discrepency in
' the cursor's CURSORDIRENTRY and CURSORDIR structs, read the NEWHEADER
' ResCount member, multiply that by Len(ICONDIRENTRY) (or 16 bytes) to find
' the BITMAPINFOHEADER, then read it's biSize member, which should be
' Len(BITMAPINFOHEADER) (or 40 bytes)

Public Const RES_ICON = 1
Public Const RES_CURSOR = 2

Public Type NEWHEADER   ' was ICONDIR (ICONHEADER?)
  Reserved As Integer   ' must be 0
  ResType As Integer    ' RES_ICON or RES_CURSOR
  ResCount As Integer   ' number of images (ICONDIRENTRYs) in the file (group)
End Type

'Public Type ICONDIRENTRY
'  bWidth As Byte                ' Width, in pixels, of the image
'  bHeight As Byte               ' Height, in pixels, of the image
'  bColorCount As Byte        ' Number of colors in image (0 if >=8bpp)
'  bReserved As Byte          ' Reserved ( must be 0)
'  wPlanes As Integer           ' Color Planes
'  wBitCount As Integer        ' Bits per pixel
'  dwBytesInRes As Long    ' How many bytes in this resource?
'  dwImageOffset As Long   ' Where in the file is this image?
'End Type
'
'Public Type CURSORDIRENTRY
'  ' The new CURSORDIR struct defines the first 4 Byte members instead as: (!!??)
''  wWidth As Integer
''  wHeight As Integer
'  bWidth As Byte                ' Width, in pixels, of the image
'  bHeight As Byte               ' Height, in pixels, of the image
'  bColorCount As Byte        ' Number of colors in image (0 if >=8bpp)
'  bReserved As Byte          ' Reserved ( must be 0)
'  wXHotspot As Integer      ' x-coordinate, in pixels, of the cursor hot spot.
'  wYHotspot As Integer      ' y-coordinate, in pixels, of the cursor hot spot.
'  dwBytesInRes As Long    ' How many bytes in this resource?
'  dwImageOffset As Long   ' Where in the file is this image?
'End Type

' user-defined struct sizes
Public Const SIZEOFDIRENTRY = 16
Public Const SIZEOFBITMAPINFOHEADER = 40

' assumes that NEWHEADER.Reserved is 0 (which it's supposed to be)
Public Const IMGSIG_ICO = &H10000      ' see above, DWORD @ image offset 0
Public Const IMGSIG_CUR = &H20000    ' see above, DWORD @ image offset 0

' ============================================================================
' VB FRX/CTX/DSX/DOX/PGX binary file item header formats:

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' TexBox.Text when Multiline = True has WORD text size value

Public Type FRXITEMHDRW   ' fihw
  dwSizeText As Integer   ' size of text
End Type

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Label.Caption and VB3 frx has DWORD image/text size value

Public Type FRXITEMHDRDW   ' fihdw
  dwSizeImage As Long   ' size of image/text
End Type

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' VB intrinsic control StdPictures (other blobs?) use FRXITEMHDR

Public Type FRXITEMHDR   ' fih
  dwSizeImageEx As Long   ' = dwSizeImage + 8
  dwKey As Long                 ' &H746C "lt" ( | 6C74 | )
  dwSizeImage As Long       ' size of image (= dwSizeImageEx - 8)
End Type

' frx binary when Form.Icon is deleted in designtime:
'   0800 0000 6C74 0000 0000 0000   ....lt......  (just the FRXITEMHDR, no data)

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Comctl32.ocx, Mscomctl.ocx StdPictures (other blobs?) use FRXITEMHDREX

Public Type GUID    ' 16 bytes (128 bits)
  dwData1 As Long      ' 4 bytes
  wData2 As Integer     ' 2 bytes
  wData3 As Integer     ' 2 bytes
  abData4(7) As Byte   ' 8 bytes, zero based
End Type

Public Type FRXITEMHDREX   ' fihex, 28 bytes
  dwSizeImageEx As Long   ' = dwSizeImage + 24
  clsid As GUID                    ' CLSID_StdPicture, CLSID_?
  dwKey As Long                 ' &H746C "lt" ( | 6C74 | )
  dwSizeImage As Long       ' size of image (= dwSizeImageEx - 24)
End Type

Public Const FIH_Key = &H746C

' ============================================================================

Public Enum CBoolean   ' enum members are Long data types
  CFalse = 0
  CTrue = 1
End Enum

Public Const S_OK = 0    ' indicates successful HRESULT

'WINOLEAPI CreateStreamOnHGlobal(
'    HGLOBAL hGlobal,            // Memory handle for the stream object
'    BOOL fDeleteOnRelease,  // Whether to free memory when the object is released
'    LPSTREAM * ppstm           // Indirect pointer to the new stream object
');
Declare Function CreateStreamOnHGlobal Lib "ole32" _
                              (ByVal hGlobal As Long, _
                              ByVal fDeleteOnRelease As CBoolean, _
                              ppstm As Any) As Long

'STDAPI OleLoadPicture(
'    IStream * pStream,  // Pointer to the stream that contains picture's data
'    LONG lSize,            // Number of bytes read from the stream
'    BOOL fRunmode,   // The opposite of the initial value of the picture's property
'    REFIID riid,             // interface identifier describing the type of interface pointer to return
'    VOID ppvObj          // Indirect pointer to the object, not AddRef'd!!
');
Declare Function OleLoadPicture Lib "olepro32" _
                              (pStream As Any, _
                              ByVal lSize As Long, _
                              ByVal fRunmode As CBoolean, _
                              riid As GUID, _
                              ppvObj As Any) As Long

Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As GUID) As Long
Declare Function IsEqualGUID Lib "ole32" (rguid1 As GUID, rguid2 As GUID) As Boolean

Public Const sCLSID_StdPicture = "{0BE35204-8F91-11CE-9DE3-00AA004BB851}"
Public Const sIID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"

Public Const GMEM_MOVEABLE = &H2
Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long

Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)

' ============================================================================
' GetOpen/SaveFileName

Public Const MAX_PATH = 260

Public Type OPENFILENAME  '  ofn
  lStructSize As Long
  hWndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  Flags As OFN_Flags
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type

' File Open/Save Dialog Flags
Public Enum OFN_Flags
  OFN_READONLY = &H1
  OFN_OVERWRITEPROMPT = &H2
  OFN_HIDEREADONLY = &H4
  OFN_NOCHANGEDIR = &H8
  OFN_SHOWHELP = &H10
  OFN_ENABLEHOOK = &H20
  OFN_ENABLETEMPLATE = &H40
  OFN_ENABLETEMPLATEHANDLE = &H80
  OFN_NOVALIDATE = &H100
  OFN_ALLOWMULTISELECT = &H200
  OFN_EXTENSIONDIFFERENT = &H400
  OFN_PATHMUSTEXIST = &H800
  OFN_FILEMUSTEXIST = &H1000
  OFN_CREATEPROMPT = &H2000
  OFN_SHAREAWARE = &H4000
  OFN_NOREADONLYRETURN = &H8000&
  OFN_NOTESTFILECREATE = &H10000
  OFN_NONETWORKBUTTON = &H20000
  OFN_NOLONGNAMES = &H40000               ' force no long names for 4.x modules
  OFN_EXPLORER = &H80000                       ' new look commdlg
  OFN_NODEREFERENCELINKS = &H100000
  OFN_LONGNAMES = &H200000                 ' force long names for 3.x modules
  ' ===============================
  ' Win98/NT5 only...
  OFN_ENABLEINCLUDENOTIFY = &H400000           ' send include message to callback
  OFN_ENABLESIZING = &H800000
  ' ===============================
End Enum

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
'

Public Function GetOpenFilePath(hWnd As Long, _
                                                      sFilter As String, _
                                                      iFilter As Integer, _
                                                      sFile As String, _
                                                      sInitDir As String, _
                                                      sTitle As String, _
                                                      sRtnPath As String) As Boolean
  Dim ofn As OPENFILENAME
  
  With ofn
    .lStructSize = Len(ofn)
    .hWndOwner = hWnd
    .lpstrFilter = sFilter & vbNullChar & vbNullChar
    .nFilterIndex = iFilter
    .lpstrFile = sFile & String$(MAX_PATH - Len(sFile), 0)
    .nMaxFile = MAX_PATH
    .lpstrInitialDir = sInitDir
    .lpstrTitle = sTitle & vbNullChar
    .Flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST Or OFN_EXPLORER
  End With
  
  If GetOpenFileName(ofn) Then
    iFilter = ofn.nFilterIndex
    sFile = Mid$(ofn.lpstrFile, ofn.nFileOffset + 1, InStr(ofn.lpstrFile, vbNullChar) - (ofn.nFileOffset + 1))
    sRtnPath = GetStrFromBufferA(ofn.lpstrFile)
    GetOpenFilePath = True
  End If

End Function

Public Function GetSaveFilePath(hWnd As Long, _
                                                      sFilter As String, _
                                                      iFilter As Integer, _
                                                      sDefExt As String, _
                                                      sFile As String, _
                                                      sInitDir As String, _
                                                      sTitle As String, _
                                                      sRtnPath As String) As Boolean
  Dim ofn As OPENFILENAME
  With ofn
    .lStructSize = Len(ofn)
    .hWndOwner = hWnd
    .lpstrFilter = sFilter & vbNullChar & vbNullChar
    .lpstrFile = sFile & String$(MAX_PATH - Len(sFile), 0)
    .lpstrDefExt = sDefExt
    .nMaxFile = MAX_PATH
    .lpstrInitialDir = sInitDir
    .lpstrTitle = sTitle & vbNullChar
    .Flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT
  End With
  
  If GetSaveFileName(ofn) Then
    iFilter = ofn.nFilterIndex
    sFile = Mid$(ofn.lpstrFile, ofn.nFileOffset + 1, InStr(ofn.lpstrFile, vbNullChar) - (ofn.nFileOffset + 1))
    sRtnPath = GetStrFromBufferA(ofn.lpstrFile)
    GetSaveFilePath = True
  End If

End Function

' Returns the string before first null char (if any) in an ANSII string.

Public Function GetStrFromBufferA(szA As String) As String
  If InStr(szA, vbNullChar) Then
    GetStrFromBufferA = Left$(szA, InStr(szA, vbNullChar) - 1)
  Else
    ' If sz had no null char, the Left$ function
    ' above would rtn a zero length string ("").
    GetStrFromBufferA = szA
  End If
End Function

' Returns the low-order word from the given 32-bit value.

Public Function LOWORD(dwValue As Long) As Integer
  MoveMemory LOWORD, dwValue, 2
End Function

Public Function PictureFromBits(abPic() As Byte) As IPicture  ' not a StdPicture!!
  Dim nLow As Long
  Dim cbMem  As Long
  Dim hMem  As Long
  Dim lpMem  As Long
  Dim IID_IPicture As GUID
  Dim istm As stdole.IUnknown '  IStream
  Dim ipic As IPicture
  
  ' Get the size of the picture's bits
  On Error GoTo Out
  nLow = LBound(abPic)
  On Error GoTo 0
  cbMem = (UBound(abPic) - nLow) + 1
  
  ' Allocate a global memory object
  hMem = GlobalAlloc(GMEM_MOVEABLE, cbMem)
  If hMem Then
    
    ' Lock the memory object and get a pointer to it.
    lpMem = GlobalLock(hMem)
    If lpMem Then
      
      ' Copy the picture bits to the memory pointer and unlock the handle.
      MoveMemory ByVal lpMem, abPic(nLow), cbMem
      Call GlobalUnlock(hMem)
      
      ' Create an ISteam from the pictures bits (we can explicitly free hMem
      ' below, but we'll have the call do it here...)
      If (CreateStreamOnHGlobal(hMem, CTrue, istm) = S_OK) Then
        If (CLSIDFromString(StrPtr(sIID_IPicture), IID_IPicture) = S_OK) Then
          
          ' Create an IPicture from the IStream (the docs say the call does not
          ' AddRef its last param, but it looks like the reference counts are correct..)
          Call OleLoadPicture(ByVal ObjPtr(istm), cbMem, CFalse, IID_IPicture, PictureFromBits)
          
        End If   ' CLSIDFromString
      End If   ' CreateStreamOnHGlobal
    End If   ' lpMem
    
'    Call GlobalFree(hMem)
  End If   ' hMem
      
Out:
End Function