TKSoft-Online

Problemstellung:

Manchmal möchte man die Pixelgrößen von Bilddateien mit Hilfe von Access ermitteln.

Lösung:
Es werden Bilder in den Formaten GIF, BMP und JPG ünterstützt.

Folgende Funktion in ein öffentliches Modul kopieren:

Public Type PictureFormat
    sWidth As String
    sHeight As String
End Type
Public Function GetPicSize(sFile As String) As PictureFormat
    Dim ff As Integer
    Dim iWidth As Integer
    Dim iHeight As Integer
    Dim iC As Integer
    Dim sTmp As String
    Dim lL As Long
    Dim sDummy As String
    Dim sExt As String

    sExt = Right(sFile, 3)
    ff = FreeFile()
    Open sFile For Binary Access Read As #ff

    Select Case sExt
        Case "gif"
            Get #ff, 7, iWidth
            Get #ff, 9, iHeight
            Close #ff
        Case "bmp"
            Get #ff, 19, iWidth
            Get #ff, 23, iHeight
            Close #ff
        Case "jpg"
            If Input(2, #ff) <> (Chr$(&HFF) & Chr$(&HD8)) Then
                Close #ff
                Exit Function
            End If
            sDummy = Input(2, #ff)
            Do
                lL = Asc(Input(1, #ff))
                lL = lL * 256 + Asc(Input(1, #ff))
                sTmp = Input(lL - 2, #ff)
                If iC = &HC0 Or iC = &HC2 Then
                    iWidth = Asc(Mid$(sTmp, 4, 1))
                    iWidth = iWidth * 256 + Asc(Mid$(sTmp, 5, 1))
                    iHeight = Asc(Mid$(sTmp, 2, 1))
                    iHeight = iHeight * 256 + Asc(Mid$(sTmp, 3, 1))
                End If
                If Input(1, #ff) <> Chr$(255) Then
                    Exit Do
                End If
                iC = Asc(Input(1, #ff))
            Loop While iC <> &HD9
            Close #ff
        Case Else
            Exit Function
    End Select

    With GetPicSize
        .sWidth = CStr(iWidth)
        .sHeight = CStr(iHeight)
    End With

End Function

Der Aufruf z.B.:

Dim tPictureFormat As PictureFormat

tPictureFormat = GetPicSize("F:\Downloads\Bilder\anz_wt.gif")

MsgBox "Bildbreite: " & tPictureFormat.sWidth & " Pixel" & vbNewLine & _
    "Bildhöhe: " & tPictureFormat.sHeight & " Pixel"

Das Ergebnis: