Tipp 0173 Bitmap-Informationen auslesen
Autor/Einsender:
Datum:
  Detlev Schubert
12.12.2001
Entwicklungsumgebung:   VB 6
Gerade für Programme, die mit Grafiken arbeiten, ist es oftmals notwendig, etwas mehr über eine eingeladene oder angezeigte Datei zu ermitteln. Dieses Beispiel zeigt auf, wie es möglich ist, alle notwendigen Informationen wie Größe in Pixel und Farbtiefe über die entsprechende Bitmap-Grafik auszulesen.
Code im Codebereich des Moduls
 
Option Explicit

Dim Nr As Integer
Dim D As String, P As String, T As String

Private Sub Dir1_Change()
  File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
  On Error Resume Next
  Dir1.Path = Drive1.Drive
  Drive1.Drive = Dir1.Path
End Sub

Private Sub File1_Click()
  Dim Wdth As Long, Hght As Long

  Label1.Caption = ""
  D$ = File1.FileName
  P$ = File1.Path
  If Right$(P$, 1) <> "\" Then P$ = P$ & "\"
  If Not IsBitmap(P$ & D$) Then Exit Sub

  T$ = BitmapType(P$ & D$)
  If InStr(T$, "keine") = 0 Then
    BMPSize P$ & D$, Wdth&, Hght&
    T$ = T$ & vbCrLf & "Bildgrösse:" & Str(Wdth&) & " x" & _
         Str(Hght&) & " Pixel" & vbCrLf & "Dateigrösse: " & _
         Format$(FileLen(P$ & D$), "###,###") & " Bytes"
  End If
  Label1.Caption = T$
End Sub

Function BitmapType(D As String) As String
  Dim Dmmy As String * 28
  Dim Bits As Integer

  Nr = FreeFile
  Open D$ For Binary As #Nr
    Get #Nr, , Dmmy
    Get #Nr, , Bits
  Close #Nr

  Select Case Bits
    Case 1
      T$ = "Monochrome "
    Case 4
      T$ = "16-Farben-"
    Case 8
      T$ = "256-Farben-"
    Case 16
      T$ = "High Color-"
    Case 24
      T$ = "True Color-"
    Case Else
      T$ = "keine "
  End Select
  BitmapType = T$ & "Bitmap"
End Function

Sub BMPSize(D As String, Wdth As Long, Hght As Long)
  Dim Dmmy As String * 18

  Nr = FreeFile
  Open D$ For Binary As #Nr
    Get #Nr, , Dmmy
    Get #Nr, , Wdth
    Get #Nr, , Hght
  Close #Nr
End Sub

Function IsBitmap(D As String)
  Dim Kenn As String

  Nr = FreeFile
  Kenn$ = Space(2)
  Open D$ For Binary As #Nr
    Get #Nr, , Kenn$
  Close #Nr
  IsBitmap = (Kenn$ = "BM")
End Function
 
Weitere Links zum Thema
24-bit-Bitmap erstellen
BMP-Grafik als JPG-Grafik speichern
Farb-Bitmaps zu Graustufen konvertieren

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (57,6 kB) Downloads bisher: [ 1205 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Samstag, 24. September 2011