![]() |
|
Tipp 0253
|
24-bit-Bitmap erstellen
|
 |
|
Autor/Einsender:
Datum: |
|
Alexander Csadek
14.07.2002 |
|
| Entwicklungsumgebung: |
|
VB 6 |
|
|
|
Es gibt in VB keine Funktion, mit der schnell mal ein Bitmap in 24-bit-Farbtiefe und in gewünschter Größe angelegt werden kann. Solch eine Funktion ist aber nicht besonders
kompliziert, da bei 24-bit-Farbtiefe nur zwei Bitmap-InfoHeader beschrieben
werden müssen.
|
|
Die eigentliche Bildgröße in Bytes muss berechnet werden. Hierbei wird die Bildbreite in Pixel mit 3 multipliziert, da ja die Farbanteile (rot, grün und blau) jeweils ein Byte brauchen. Zu beachten ist noch, ob die Bildbreite durch 4 teilbar ist. Wenn nicht, dann muss die Bildbreite um Leerbytes (Rest der Division durch 4) erweitert werden,
da ansonsten viele Grafik-Programme das Bitmap nicht als Bitmap erkennen bzw. nicht korrekt
darstellen würden. DirectX zum Beispiel, würde das Bitmap nicht laden.
|
|
Das Bitmap steht in der Datei auf dem Kopf. Die letzte Pixel-Zeile vom Bild kommt in der Datei als Erster. Weiter ist noch zu beachten, dass die Farbanteile Rot und Blau vertauscht sind.
|
|
Hier die eigentlich Funktion zum Erstellen eines 24-bit-Bitmaps.
|
|
| Code im Codebereich des Moduls |
|
| |
Option Explicit
Type BITMAPFILEHEADER
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Public Sub CreateBMPFile(ByVal BMPFile As String, _
ByVal w As Long, ByVal h As Long, BGColor As cRGB)
Dim intBMPFile As Integer
Dim x As Long
Dim y As Long
Dim WidthHelper As Long
Dim gudtBMPFileHeader As BITMAPFILEHEADER
Dim gudtBMPInfoHeader As BITMAPINFOHEADER
Dim gudtBMPData() As Byte
On Error GoTo ErrHandle
intBMPFile = FreeFile()
Open BMPFile For Binary Access Write Lock Read As intBMPFile
WidthHelper = (w * 3) + (w Mod 4)
gudtBMPFileHeader.bfOffBits = 54
gudtBMPFileHeader.bfReserved1 = 0
gudtBMPFileHeader.bfReserved2 = 0
gudtBMPFileHeader.bfSize = (WidthHelper * h)
gudtBMPFileHeader.bfType = 19778
Put intBMPFile, , gudtBMPFileHeader
gudtBMPInfoHeader.biBitCount = 24
gudtBMPInfoHeader.biClrImportant = 0
gudtBMPInfoHeader.biClrUsed = 0
gudtBMPInfoHeader.biCompression = 0
gudtBMPInfoHeader.biHeight = h
gudtBMPInfoHeader.biPlanes = 1
gudtBMPInfoHeader.biSize = 40
gudtBMPInfoHeader.biSizeImage = (WidthHelper * h)
gudtBMPInfoHeader.biWidth = w
gudtBMPInfoHeader.biXPelsPerMeter = 3780
gudtBMPInfoHeader.biYPelsPerMeter = 3780
Put intBMPFile, , gudtBMPInfoHeader
ReDim gudtBMPData(WidthHelper - 1, h - 1)
For y = 0 To (h - 1)
For x = 0 To (w - 1)
gudtBMPData((x * 3), (h - 1) - y) = BGColor.b
gudtBMPData((x * 3) + 1, (h - 1) - y) = BGColor.g
gudtBMPData((x * 3) + 2, (h - 1) - y) = BGColor.r
Next x
Next y
Put intBMPFile, , gudtBMPData
Close intBMPFile
Exit Sub
ErrHandle:
MsgBox "Fehler beim Erstellen des Bitmaps." & vbCr & _
Err.Number & "-" & Err.Description, vbExclamation
End
End Sub
|
|
|
|
|
|
|
| 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 (5 kB)
|
Downloads bisher: [ 1373 ]
|
|
|
Vorheriger Tipp
Zum Seitenanfang 