Tipp 0198 Bitmaps binär in DD-Surface laden
Autor/Einsender:
Datum:
  Alexander Csadek
14.02.2002
Entwicklungsumgebung:
DirectX-Version:
  VB 6
DirectX 7
Dieser Tipp basiert auf unserem Tipp Binäre Ressourcen-Datei und zeigt wie Bitmaps direkt aus einer binären Ressourcen-Datei in eine DirectDraw-Surface geschrieben werden können.
Es gibt zwar die Ressourcen-Datei bei Visual Basic, die mit in eine *.exe-Datei kompiliert wird, aber die Möglichkeit mit einer binären Ressourcen-Datei zu arbeiten hat mehrere Vorteile. Zum einem sind die mühsam erstellten Ressourcen geschützter und zum anderen bleibt die *.exe-Datei klein und muss nicht ausgetauscht werden, wenn sich einmal eine Ressource ändern sollte.
Das Prinzip ist ganz einfach. Die gewünschten Ressourcen werden binär eingelesen und nacheinander in eine Datei geschrieben. Die Anzahl und Größe ist auch noch wichtig, da man diese zum Auslesen wieder braucht.
Der erste Schritt ist das Kombinieren der Ressourcen. Hierfür werden die gewünschten Ressourcen mit open binary access geöffnet. Danach wird die Größe der Ressourcen ermittelt und eingelesen.
Wichtig ist noch der allgemeine FileHeader. In diesem werden die Anzahl der Ressourcen und die Gesamtgröße in Bytes gespeichert. Damit kann man erkennen, ob jemand versucht hat die Binär-Datei zu manipulieren.
Für jeder Ressource wird noch ein InfoHeader erstellt. In diesem wird der Name, die Größe in Bytes und das StartByte geschrieben an der die Ressource in der Binär-Datei beginnt. Der FileHeader, die InfoHeader pro Ressource und natürlich die Ressourcen selbst werden dann in eine neue Datei geschrieben. Und schon ist die binäre Ressourcen-Datei fertig.
Nun kommt der 2. Schritt, das Auslesen der Bitmaps und in eine DirectDrawSurface schreiben.
Die Namen der Bitmaps müssen nicht unbedingt in die Binär-Datei geschrieben werden, da die Bitmaps ja nicht wieder auf die Festplatte geschrieben werden müssen. So können die Namen leer lassen oder der InfoHeader abgeändert werden. Dabei muss aber dann beachtet werden, dass der InfoHeader-Satz kürzer ist.
Die Binär-Datei wird zunächst mit open binary access geöffnet. Anschließend wird der FileHeader eingelesen und die Größe der Datei mit der im FileHeader gespeicherten Größe verglichen. Ist diese nicht gleich, dann stimmt etwas mit der Binär-Datei nicht.
Als nächstes werden die InfoHeader pro Bitmap eingelesen. Mit dem StartByte und der Größe können nun die einzelnen Bitmaps aus dem InfoHeader der Binär-Datei eingelesen werden. Danach werden die Bitmaps mit der Funktion StretchDIBits direkt in die DirectDraw-Surface geschrieben.
Code im Codebereich des Moduls Globals
 
Option Explicit

Global Const SPRITE_WIDTH = 125
Global Const SPRITE_HEIGHT = 125

Declare Function StretchDIBits Lib "gdi32" (ByVal hdc As Long, _
      ByVal x As Long, ByVal y As Long, ByVal dx As Long, _
      ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, _
      ByVal wSrcWidth As Long, ByVal wSrcHeight As Long, _
      lpBits As Any, lpBitsInfo As BITMAPINFO, ByVal wUsage _
      As Long, ByVal dwRop As Long) As Long

Global Const SRCCOPY = &HCC0020
Global Const DIB_RGB_COLORS = 0

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

Type RGBQUAD
  rgbBlue As Byte
  rgbGreen As Byte
  rgbRed As Byte
  rgbReserved As Byte
End Type

Type BITMAPINFO
  bmiHeader As BITMAPINFOHEADER
  bmiColors(0 To 255) As RGBQUAD
End Type

Global gudtBMPFileHeader As BITMAPFILEHEADER
Global gudtBMPInfo As BITMAPINFO 
Global gudtBMPData() As Byte

Sub ExtractData(strFileName As String, lngOffset As Long)
  Dim intBMPFile As Integer
  Dim i As Integer

  Erase gudtBMPInfo.bmiColors

  intBMPFile = FreeFile()
  Open strFileName For Binary Access Read Lock Write As intBMPFile

  Get intBMPFile, lngOffset, gudtBMPFileHeader

  Get intBMPFile, , gudtBMPInfo.bmiHeader
  If gudtBMPInfo.bmiHeader.biClrUsed <> 0 Then
    For i = 0 To gudtBMPInfo.bmiHeader.biClrUsed - 1
      Get intBMPFile, , gudtBMPInfo.bmiColors(i).rgbBlue
      Get intBMPFile, , gudtBMPInfo.bmiColors(i).rgbGreen
      Get intBMPFile, , gudtBMPInfo.bmiColors(i).rgbRed
      Get intBMPFile, , gudtBMPInfo.bmiColors(i).rgbReserved
    Next i
  ElseIf gudtBMPInfo.bmiHeader.biBitCount = 8 Then
    Get intBMPFile, , gudtBMPInfo.bmiColors
  End If

  If gudtBMPInfo.bmiHeader.biBitCount = 8 Then
    ReDim gudtBMPData(FileSize(gudtBMPInfo.bmiHeader.biWidth, _
          gudtBMPInfo.bmiHeader.biHeight))
  Else
    ReDim gudtBMPData(gudtBMPInfo.bmiHeader.biSizeImage - 1)
  End If

  Get intBMPFile, , gudtBMPData

  If gudtBMPInfo.bmiHeader.biBitCount = 8 Then
    gudtBMPFileHeader.bfOffBits = 1078
    gudtBMPInfo.bmiHeader.biSizeImage = _
          FileSize(gudtBMPInfo.bmiHeader.biWidth, _
          gudtBMPInfo.bmiHeader.biHeight)
    gudtBMPInfo.bmiHeader.biClrUsed = 0
    gudtBMPInfo.bmiHeader.biClrImportant = 0
    gudtBMPInfo.bmiHeader.biXPelsPerMeter = 0
    gudtBMPInfo.bmiHeader.biYPelsPerMeter = 0
  End If
  Close intBMPFile
End Sub

Private Function FileSize(lngWidth As Long, _
      lngHeight As Long) As Long

  If lngWidth Mod 4 > 0 Then
    FileSize = ((lngWidth \ 4) + 1) * 4 * lngHeight - 1
  Else
    FileSize = lngWidth * lngHeight - 1
  End If
End Function
 
Code im Codebereich des Moduls DDraw
 
Option Explicit

Dim mobjDX As DirectX7
Dim mobjDD As DirectDraw7
Dim msurfFront As DirectDrawSurface7
Dim msurfBack As DirectDrawSurface7

Global gsurfFirst As DirectDrawSurface7
Global gsurfSecond As DirectDrawSurface7

Dim mrectScreen As RECT

Const SCREEN_WIDTH = 800
Const SCREEN_HEIGHT = 600
Const SCREEN_BITDEPTH = 16

Public Sub Initialize(frmInit As Form)
  Dim ddsdMain As DDSURFACEDESC2
  Dim ddsdFlip As DDSURFACEDESC2
  Dim i As Integer
  Dim j As Integer

  Set mobjDX = New DirectX7

  Set mobjDD = mobjDX.DirectDrawCreate("")

  mobjDD.SetCooperativeLevel frmInit.hWnd, DDSCL_FULLSCREEN Or _
        DDSCL_EXCLUSIVE

  mobjDD.SetDisplayMode SCREEN_WIDTH, SCREEN_HEIGHT, _
        SCREEN_BITDEPTH, 0, DDSDM_DEFAULT

  ddsdMain.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
  ddsdMain.lBackBufferCount = 1
  ddsdMain.ddsCaps.lCaps = DDSCAPS_COMPLEX Or DDSCAPS_FLIP Or _
        DDSCAPS_PRIMARYSURFACE

  Set msurfFront = mobjDD.CreateSurface(ddsdMain)

  ddsdFlip.ddsCaps.lCaps = DDSCAPS_BACKBUFFER
  Set msurfBack = msurfFront.GetAttachedSurface(ddsdFlip.ddsCaps)

  mrectScreen.Right = SCREEN_WIDTH
  mrectScreen.Bottom = SCREEN_HEIGHT

  ClearBuffer
End Sub

Public Sub Flip()
  msurfFront.Flip Nothing, DDFLIP_WAIT
  ClearBuffer
End Sub

Public Sub ClearBuffer()
  msurfBack.BltColorFill mrectScreen, 0
End Sub

Public Sub LoadSprite(msurfSprite As DirectDrawSurface7, _
      lngOffset As Long, intWidth As Integer, intHeight _
      As Integer, lngColorKey As Long)
  Dim ddckKey As DDCOLORKEY
  Dim ddsdNewSprite As DDSURFACEDESC2
  Dim lngTemp As Long

  ddsdNewSprite.lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT
  ddsdNewSprite.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
  ddsdNewSprite.lWidth = intWidth
  ddsdNewSprite.lHeight = intHeight

  Set msurfSprite = mobjDD.CreateSurface(ddsdNewSprite)

  ddckKey.low = lngColorKey
  ddckKey.high = lngColorKey
  msurfSprite.SetColorKey DDCKEY_SRCBLT, ddckKey

  ExtractData App.Path & "\binary.dat", lngOffset

  lngTemp = msurfSprite.GetDC
  StretchDIBits lngTemp, 0, 0, gudtBMPInfo.bmiHeader.biWidth, _
        gudtBMPInfo.bmiHeader.biHeight, 0, 0, _
        gudtBMPInfo.bmiHeader.biWidth, _
        gudtBMPInfo.bmiHeader.biHeight, _
        gudtBMPData(0), gudtBMPInfo, _
        DIB_RGB_COLORS, SRCCOPY
  msurfSprite.ReleaseDC lngTemp
End Sub

Public Sub DisplaySprite(msurfSprite As DirectDrawSurface7, _
      intX As Integer, intY As Integer)
  Dim rectSource As RECT

  With rectSource
    .Left = 0
    .Right = SPRITE_WIDTH
    .Top = 0
    .Bottom = SPRITE_HEIGHT
  End With

  msurfBack.BltFast intX, intY, msurfSprite, rectSource, _
        DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT
End Sub

Public Sub Terminate(frmTerm As Form)
  Set gsurfSecond = Nothing
  Set gsurfFirst = Nothing
  Set msurfBack = Nothing
  Set msurfFront = Nothing
  Call mobjDD.RestoreDisplayMode
  Call mobjDD.SetCooperativeLevel(frmTerm.hWnd, DDSCL_NORMAL)
  Set mobjDD = Nothing
End Sub
 
Code im Codebereich der Form
 
Option Explicit

Dim mblnRunning As Boolean

Dim mlngLocationFirst As Long
Dim mlngLocationSecond As Long

Private Sub Form_Load()
  cmdDisplay.Caption = "&Grafiken aus der Binär-Datei lesen" & _
                       vbCrLf & "und in das Surface laden"
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  mblnRunning = False
End Sub

Private Sub cmdCombine_Click()
  Dim intFreeFile As Integer
  Dim bytFirst() As Byte
  Dim bytSecond() As Byte

  intFreeFile = FreeFile()
  Open App.Path & "\first.bmp" For _
        Binary Access Read Lock Write As intFreeFile

  ReDim bytFirst(LOF(intFreeFile) - 1)
  Get intFreeFile, , bytFirst
  Close intFreeFile

  intFreeFile = FreeFile()
  Open App.Path & "\second.bmp" For _
        Binary Access Read Lock Write As intFreeFile
  ReDim bytSecond(LOF(intFreeFile) - 1)
  Get intFreeFile, , bytSecond
  Close intFreeFile

  intFreeFile = FreeFile()
  Open App.Path & "\binary.dat" For _
        Binary Access Read Write Lock Write As intFreeFile
  mlngLocationFirst = Seek(intFreeFile)
  Put intFreeFile, , bytFirst
  mlngLocationSecond = Seek(intFreeFile)
  Put intFreeFile, , bytSecond
  Close intFreeFile

  cmdDisplay.Enabled = True
End Sub

Private Sub cmdDisplay_Click()
 Dim F_Hight As Long
 Dim F_Width As Long

  F_Hight = frmMain.Height
  F_Width = frmMain.Width

  DDraw.Initialize Me

  DDraw.LoadSprite gsurfFirst, mlngLocationFirst, _
        SPRITE_WIDTH, SPRITE_HEIGHT, 0
  DDraw.LoadSprite gsurfSecond, mlngLocationSecond, _
        SPRITE_WIDTH, SPRITE_HEIGHT, 0

  mblnRunning = True
  Do While mblnRunning
    DDraw.DisplaySprite gsurfFirst, 0, 0
    DDraw.DisplaySprite gsurfSecond, SPRITE_WIDTH, 0
    DDraw.Flip
    DoEvents
  Loop

  DDraw.Terminate Me

  frmMain.Height = F_Hight
  frmMain.Width = F_Width
  frmMain.Move (Screen.Width - F_Hight) / 2, _
               (Screen.Height - F_Hight) / 2
End Sub
 
Weitere Links zum Thema
Soundkarten-Informationen auslesen
Hinweis
Um dieses Beispiel ausführen zu können, wird die DirectX 7 for Visual Basic Type Library benötigt (siehe dazu die Erläuterungen in der DirectX-Rubrik).

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  (33 kB) Downloads bisher: [ 888 ]

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: Montag, 12. September 2011