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

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

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