Das Notes Forum
Lotus Notes / Domino Sonstiges => Tipps und Tricks => Thema gestartet von: TMC am 05.05.04 - 23:59:00
-
Ich werfe hier mal *ungetestet* ein VBA-Script rein, mit dem die Bildabmessung eines JPEG-Bildes festgestellt werden kann. Hatte ich mal aus dem Web gezogen, allerdings leider keinen Quellen-Link mehr (ist tot) .....
Sub prüfenJPG()
Dim Width As Long, Height As Long, iCounter As Long
Dim Pfad As Variant, DateiName() As String
Dim ret As Boolean
Dim dName As String
icount = -1
Pfad = Application.GetOpenFilename("Text Files (*.jpg), *.jpg")
If Pfad <> False Then
ret = SizeJPG(Pfad, Width, Height)
If ret Then
DateiName = Split(Pfad, "\")
Do Until dName <> "" Or iCounter > 100
iCounter = iCounter + 1
If InStr(1, DateiName(iCounter), "jpg") Or InStr(1, DateiName(iCounter), "JPG") Then _
dName = DateiName(iCounter)
Loop
MsgBox "Das Bild : " & dName & " hat die Formate:" & vbLf & _
"Höhe:" & vbTab & Height & vbLf & _
"Breite:" & vbTab & Width
Else
MsgBox "Es handelt sich nicht um eine JPG-Datei!", vbCritical, "INFO"
End If
Else
MsgBox "Vorgang wurde vom Benutzer abgebrochen!", vbInformation, "INFO"
End If
End Sub
Public Function SizeJPG(ByRef FilePath As Variant, Width As Long, _
Height As Long) As Boolean
Dim nFNr As Long
Dim nFlag As Integer
Dim nDummy As String
Dim nOffset As Long
Dim nValue As String
Dim nWidth As Long
Dim nHeight As Long
nFNr = FreeFile
Open FilePath For Binary Access Read As #nFNr
If Input$(1, #nFNr) <> Chr$(255) Then
Close #nFNr
Exit Function
End If
nFlag = Asc(Input$(1, #nFNr))
If nFlag <> &HD8 Then
Close #nFNr
Exit Function
End If
nDummy = Input$(2, #nFNr)
Do
nOffset = Asc(Input$(1, #nFNr)) * 256 + _
Asc(Input$(1, #nFNr))
nValue = Input$(nOffset - 2, #nFNr)
If (nFlag = &HC0) Or (nFlag = &HC2) Then
nWidth = Asc(Mid$(nValue, 4, 1))
nWidth = nWidth * 256 + Asc(Mid$(nValue, 5, 1))
nHeight = Asc(Mid$(nValue, 2, 1))
nHeight = nHeight * 256 + Asc(Mid$(nValue, 3, 1))
End If
If Input$(1, #nFNr) <> Chr$(255) Then
Exit Do
End If
nFlag = Asc(Input$(1, #nFNr))
Loop While nFlag <> &HD9
Close #nFNr
Width = nWidth
Height = nHeight
SizeJPG = True
End Function