Problemstellung:
Für 32Bit und 64Bit Office Versionen
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:
Ähnliche Artikel
Weiterlesen...