Dieser Workshop soll Ihnen eine Einführung in DirectDraw 7/8 geben. Anhand eines Beispiels wird beschrieben, wie Sie z.B. eine Grafik (Sprite) über den Bildschirm (bestimmte Hintergrund-Grafik) "fliegen" lassen können. Was ist DirectDraw? Sicherlich haben die meisten von Ihnen schon den Begriff DirectX gehört - meist in Zusammenhang, wenn es um Spieleprogrammierung geht. Einige von Ihnen werden sich auch fragen, wofür DirectX oder auch DirectDraw noch verwendet werden kann - außer eben der Spieleprogrammierung. Bei DirectDraw handelt es sich um eine Multimedia-Schnittstelle, wie bei allen anderen Komponenten von DirectX auch. Man kann sie als Alternative zu Windows GDI oder dem Picture-Objekt verwenden. Ein typisches Anwendungsbeispiel ist z.B. auch ein Bildschirmschoner, welcher doch gleich viel besser aussieht, wenn er mit DirectDraw erstellt wurde. Ein weiteres Merkmal von DirectDraw ist die Geschwindigkeit-Performance. Wenn Sie so einigermaßen mit dem VB Standard Picture-Objekt und den dazugehörigen Funktionen, wie DrawLine, DrawCircle oder Print, sowie den Eigenschaften CurrentX und CurrentY vertraut sind, werden Sie feststellen, daß dies bereits die halbe Miete bei der Programmierung und dem Verständnis für DirectDraw ist. Einiges zu den Details der Programmierung
Referenzierung von DirectX7 Zunächst muß auf jeden Fall DirectX7a oder DirectX8 installiert sein. Starten Sie die Visual-Basic Entwicklungsumgebung und wählen als Projekt-Typ ein neues Standard EXE Programm aus. Nun muß die dx7vb.dll oder DirectX 7 for Visual Basic Type Libary in das Projekt eingebunden werden. Dies geschieht über den Befehl Projekt - Verweise. Suchen Sie den entsprechenden Eintrag und Klicken dann auf OK.Eine Sprite-Animation (Beispielsanwendung) Schritt 1 - Referenzierung von DirectX und Direct Draw ' Verweis auf DirectX/DirectDraw Private DX7 As New DirectX7 Private DD7 As DirectDraw7 Schritt 2 - Surfaces und benötigte Objekte referenzieren ' Primary Surface repräsentiert den Bildschirm 'alles was hier rein kopiert wird (geblittet), 'landet auf dem Schirm 'Primary Surface festlegen Private PrimSurface As DirectDrawSurface7 ' Darin landen später die Bildschirm-Auflösung etc. Private PrimSurfDesc As DDSURFACEDESC2 Danach den Backbuffer. In diesen wird später geblittet (kopiert). Das Ergebnis wird dann an einen eventuellen zweiten oder dritten Backbuffer (Double, Tripple-Buffering) "weitergereicht". Nachdem alle Buffers durchlaufen sind wird der Inhalt des letzten Buffers auf das Primary Surface übertragen und letztendlich erscheint dieser auf dem Bildschirm. ' Primary Surface repräsentiert den Buffer, alles was hier rein 'kopiert (geblittet) wird landet im Primary Surface und von hier 'aus auf dem Bildschirm 'Back Buffer (Puffer) Surface festlegen Private BackSurface As DirectDrawSurface7 ' Darin Landen später die Bildschirm Auflösung etc. Private BackSurfDesc As DDSURFACEDESC2 ' Legt später fest das BackSurface das Primäre Surface ist Private BackSurfCaps As DDSCAPS2 Nun noch für jede Grafik, 1 Surface und 1 DDSURFACEDESC2. Es werden ja zwei Grafiken benötigt, ein fliegendes Objekt und ein Hintergrund. ' Andere Surfaces, repräsentieren einen Grafikcontainer ' Surface für den Hintergrund Private HinterGrundSurf As DirectDrawSurface7 ' Hintergrund Surface Beschreibung Private HinterGrundDesc As DDSURFACEDESC2 ' Surface für das Sprite Private SpriteSurf As DirectDrawSurface7 ' Sprite Surface Beschreibung Private SpriteDesc As DDSURFACEDESC2 ' Legt später die transparente Farbe fest Private SpriteTransCol As Long ' Surface für den Hintergrund Private HinterGrundSurf As DirectDrawSurface7 ' Hintergrund Surface beschreibung Private HinterGrundDesc As DDSURFACEDESC2 ' Surface für das Sprite Private SpriteSurf As DirectDrawSurface7 ' Sprite Surface beschreibung Private SpriteDesc As DDSURFACEDESC2 ' Legt später die transparente Frabe fest Private SpriteTransCol As Long Public Enum Buffers SingleBuffering = 1 ' 1 Puffer DoubleBuffering = 2 ' 2 Puffer TrippleBuffering = 3 ' 3 Puffer End Enum Und weil wir es immer wieder brauchen, erstellen wir uns profilaktisch schon eimal ein leeres RECT und eine Rückgabe-Variable. ' Rect (enthält Surface, Picture-Objekt oder Fenster-Koordinaten) Private EmptyRect as Rect ' temporäre Rückgabe-Variable Private Retval As Long Das war es erst einmal. Als nächstes wird gezeigt, wie die verschieden DirectDraw Adapter (Grafikkarten) und die möglichen Auflösungen ermittelt werden. Enumeration von DirectDraw kompatibler Grafik-Hardware Zunächst werden zwei Type-Strukturen festgelegt, welche die Informationen der Grafikkarten wiedergeben. Die Deklarationen sollten im globalen Teil des Projekts erfolgen. Public Type DDrawDisplayModeType Width As Long ' maximal mögliche Breite Hight As Long ' maximal mögliche Höhe ColorDepth As Long ' maximale Farbtiefe End Type Public Type DDrawDeviceType DeviceDescription As String ' Grafikkarten Beschreibung DeviceGuid As String ' Grafikkarten GUID DeviceName As String ' Grafikkarten Name DiplayModesCount As Long ' Anz. Bildschirmauflösungen ' Array der Bildschirmauflösungen AviableDisplayModes() As DDrawDisplayModeType End Type Private DDrawDevices() As DdrawDeviceType Nun die benötigten Funktionen: ' Gibt die Anzahl der DirectDraw-kompatiblen Grafikkarten zurück Public Function Get_DDDevicesCount() As Integer ' Enum-Objekt referenzieren Dim DDEnum As DirectDrawEnum ' Enum-Objekt instanzieren Set DDEnum = DX7.GetDDEnum ' Anzahl verfügbarer Grafikkarten (Index beginnend bei 1) Get_DDDevicesCount = DDEnum.GetCount End Function ' Gibt Informationen einer Grafikkarten-Hardware zurück 'Erwartete Parameter: ' DeviceIndex (Ermittelt mit Get_DDDevicesCount) Public Function GetDDDeviceInfo(ByVal DDDeviceIndex As Long) As _ DDrawDeviceType Dim DDEnum As DirectDrawEnum Dim DDDisplayEnum As DirectDrawEnumModes Dim TmpSurface As DDSURFACEDESC2 Dim i As Integer If DDDeviceIndex < 1 Or _ DDDeviceIndex > Get_DDDevicesCount Then _ Exit Function ' DDEnum-Objekt erstellen '(speichert die Grafikkarten-Informationen) Set DDEnum = DX7.GetDDEnum With GetDDDeviceInfo ' Grafikkarten Infos füllen mit Informationen .DeviceDescription = DDEnum.GetDescription(DDDeviceIndex) .DeviceGuid = DDEnum.GetGuid(DDDeviceIndex) .DeviceName = DDEnum.GetName(DDDeviceIndex) ' DirectDraw instanzieren, da DDDsiplayEnum von DirectDraw 'instanziert werden muß Set DD7 = DX7.DirectDrawCreate(.DeviceGuid) ' DDDisplayEnum-Objekt erstellen '(speichert die Grafikkarten-Auflösungen) Set DDDisplayEnum = DD7.GetDisplayModesEnum(DDEDM_DEFAULT, _ TmpSurface) ' Array neu dimensionieren 'i.d.R. ca. 40 verschiedene Auflösungen oder mehr 'z.B. 320x200x8, 320x200x16, 320x200x24, 320x200x32, '640x480x8, usw. .DiplayModesCount = DDDisplayEnum.GetCount ReDim .AviableDisplayModes(.DiplayModesCount) As _ DDrawDisplayModeType For i = 1 To .DiplayModesCount ' Speichern der verschieden Auflösungsmöglichkeiten 'in TmpSurface DDDisplayEnum.GetItem i, TmpSurface ' Type-Struktur mit Auflösungs-Informationen füllen .AviableDisplayModes(i).Width = TmpSurface.lWidth .AviableDisplayModes(i).Hight = TmpSurface.lHeight .AviableDisplayModes(i).ColorDepth = _ TmpSurface.ddpfPixelFormat.lRGBBitCount Next i End With ' DirectDraw aus dem Speicher entfernen Set DD7 = Nothing End Function Um die bisherige Theorie einmal zu testen, einfach einmal nachfolgenden Code in die Sub Main setzen und das Projekt starten. Sub Main() Dim i, j as Integer For i = 1 To Get_DDDevicesCount Dim TmpDeviceInfo As DDrawDeviceType Debug.Print "Grafikkarte " & CStr(i) & ":" & vbCrLf TmpDeviceInfo = GetDDDeviceInfo(i) With TmpDeviceInfo Debug.Print "Name: " & .DeviceName Debug.Print "Beschreibung: " & .DeviceDescription If .DeviceGuid = "" Then Debug.Print "GUID: """"" Else Debug.Print "GUID: " & .DeviceGuid End If Debug.Print "Grafik Modis: " & .DiplayModesCount & vbCrLf For j = 1 To .DiplayModesCount With .AviableDisplayModes(j) Debug.Print vbTab & cStr(j) & ". " & .Width & "x" & _ .Hight & "x" & .ColorDepth End With Next j End With Next i End Sub Die ermittelten Informationen lassen sich auch dem Benutzer in Form einer ComboBox zur Auswahl anbieten. Jetzt sollten Sie also in der Lage sein, die verschiedenen Grafikkarten und deren Informationen mit Hilfe von DirectDraw zu ermitteln. Der nächste Abschnitt beschäftigt sich mit der Initialisierung von DirectDraw, um Zeichen und Bilder auf dem Bildschirm anzuzeigen. Initialisierung von DirectDraw Beim Initialisieren von DirectDraw wird angegeben, welche Grafikkarte (Auflösung) benutzt werden soll. Über ein Flag lässt sich zusätzlich festgelegt, ob DirectDraw im Exklusiv-Modus instanziert werden soll oder nicht. Exklusiv bedeutet, daß kein anderes Programm DirectDraw beanspruchen kann. ' Initialisiert Direct Draw Public Function Init_DDraw(ByVal WindowHwnd As Long, _ ByRef UseDisplayMode As DdrawDisplayModeType, BufferCount As _ Buffers, Optional ByVal DisplayCardGUID As String = "") ' DirectDraw instanzieren ' falls der Grafikkarten GUID nicht gültig ist On Error GoTo DD7Err_Handle ' Wird als Parameter ein Leerstring angegeben, wird die 'Standard-Grafikkarte gewählt Set DD7 = DX7.DirectDrawCreate(DisplayCardGUID) ' CooperativeLevel setzen 'VollBild, ModeX erlauben[300x200x8) und exlusiv '[Nur unser Programm darf DirectDraw benutzen]) 'falls WindowhWnd falsch oder DirectDraw bereits von 'einer anderen Anwendung exklusiv benutzt wird On Error GoTo CoopErr_Handle DD7.SetCooperativeLevel WindowHwnd, DDSCL_FULLSCREEN Or _ DDSCL_ALLOWMODEX Or DDSCL_EXCLUSIVE ' falls die Einstellungn nicht möglich oder ungültig sind On Error GoTo SetErr_Handle DD7.SetDisplayMode UseDisplayMode.Width, _ UseDisplayMode.Hight, UseDisplayMode.ColorDepth, _ 0&, DDSDM_DEFAULT ' Primary Surface festlegen With PrimSurfDesc ' legt fest, daß dieses Surface einen oder mehrere 'Backbuffer hat .lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT ' Als Primary deklarieren .ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or _ DDSCAPS_COMPLEX .lBackBufferCount = BufferCount End With ' Hiermit wäre dann der Primary Surface erstellt Set PrimSurface = DD7.CreateSurface(PrimSurfDesc) ' Backbuffer zuordnen With BackSurfCaps ' als Backbuffer deklarieren .lCaps = DDSCAPS_BACKBUFFER Or DDSCAPS_COMPLEX End With ' Das Primary Surface hat schon einen Backbuffer 'BackSurface soll jetzt diesen Backbuffer repräsentieren 'Backbuffer ausfindig machen und Backsurface zuweisen Set BackSurface = PrimSurface.GetAttachedSurface(BackSurfCaps) ' bei dem Backbuffer arbeiten wir ja nicht mit 'X.CreateSurface(XXDesc), deshalb ist BSurfDesc für den 'Backbuffer auch nicht aktualisiert 'das geschieht hier nun manuell 'Beschreibung des Surfaces '(enthält z.B. die Bildschirmauflösung) BackSurface.GetSurfaceDesc BackSurfDesc ' An dieser Stelle taucht vielleicht die Frage auf, 'wo die Surfaces für Hintergrund und Sprite sind. 'Diese Surfaces werden erst in LoadSurfaces erstellt! Exit Function DD7Err_Handle: If Err.Number = DDERR_GENERIC Then ' Möglicherweise wurde ein Falscher GUID angegeben? DisplayCardGUID = "" ' Auf Standard Grafikkarte setzen Resume End If Unload_DDraw ' Entlädt das Programm und beendet es Exit Function CoopErr_Handle: If Err.Number = DDERR_INVALIDPARAMS Then Unload_DDraw ' Entlädt das Programm und beendet es ElseIf Err.Number = DDERR_EXCLUSIVEMODEALREADYSET Then ' Ein anderes Programm hat schon den Exklusiv Modus Unload_DDraw ' Entlädt das Programm und beendet es End If Unload_DDraw ' Entlädt das Programm und beendet es Exit Function SetErr_Handle: If Err.Number = DDERR_INVALIDMODE Then ' Auflösung nicht möglich, Standard verwenden If UseDisplayMode.ColorDepth = 8 And _ UseDisplayMode.Hight = 480 And _ UseDisplayMode.Width = 640 Then Unload_DDraw ' Entlädt das Programm und beendet es Else UseDisplayMode.ColorDepth = 8 UseDisplayMode.Hight = 480 UseDisplayMode.Width = 640 Resume End If End If Unload_DDraw ' Entlädt das Programm und beendet es Exit Function End Function Anmerkung: Beenden des Programms, und entladen von DirectX ' Herstellen der ursprüngliche Bildschirmauflösung 'und entladen von DirectDraw Public Function Unload_DDraw() ' Bildschirm-Modi wiederherstellen DD7.RestoreDisplayMode ' Set DX7 = Nothing 'DirectX entladen ' Cooperativelevel entfernen DD7.SetCooperativeLevel 0&, DDSCL_NORMAL ' DirectDraw entladen Set DD7 = Nothing Unload Main_Form End Function Im nächsten Abschnitt werden die Surfaces mit Bilddaten gefüllt. Surfaces laden, Grafiken laden, andere Grafikroutinen Beim Laden von Surfaces gibt es mehrere Möglichkeiten:
Public Function LoadSurfaces(Optional ByVal _ SpriteTransparentColor As Long = -1) Dim CK As DDCOLORKEY SpriteTransCol = SpriteTransparentColor ' Das erste Surface (Hintergrund) wollen wir mal in den 'Systemspeicher laden. Die Größe wird sofort festgelegt, um 'zu verhindern, daß dieses anhand der Grafik gestreckt wird. 'Als Grafik wird das Bitmap WOLKEN.BMP verwendet 'Details des Surfaces With HinterGrundDesc .lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH Or _ DDSCAPS_COMPLEX ' legt ein normales Surface fest, und legt dieses im 'Systemspeicher ab .ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or _ DDSCAPS_SYSTEMMEMORY ' Bildschirmauflösung vom Primary Surface erfragen 'und übergeben .lWidth = PrimSurfDesc.lWidth .lHeight = PrimSurfDesc.lHeight End With ' Jetzt füllen wir das Surface mit der Datei Wolken.BMP Set HinterGrundSurf = DD7.CreateSurfaceFromFile(App.Path & _ "\Wolken.bmp", HinterGrundDesc) ' Jetzt laden wir das Sprite in den Grafikkartenspeicher With SpriteDesc ' Auf Caps achten .lFlags = DDSD_CAPS Or DDSCAPS_COMPLEX ' legt ein normales Surface fest, und legt dieses in den 'Grafikkartenspeicher ab 'keine explizite Größenangabe! .ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or _ DDSCAPS_VIDEOMEMORY End With ' Jetzt wird das Surface mit der Ressourcegrafik geladen '(wird für "file" in der CreateSurfaceFromResource ein 'Leerstring verwendet, so wird die eigene Resource benutzt; 'man kann aber auch eine fremde Dll, Ocx oder 'EXE-Datei angeben) 'ACHTUNG: Das Laden von Resourcen funktioniert nur bei 'Ausführung im kompilierten Modus (nicht in der IDE) On Error GoTo Err_IDE ' Sprite aus der Resource laden Set SpriteSurf = DD7.CreateSurfaceFromResource("", "KIPPE", _ SpriteDesc) ' Transparente Farbe zuweisen If SpriteTransparenz <> -1 Then CK.high = SpriteTransCol ' Transparente Farbe Bis CK.low = SpriteTransCol ' Transparente Farbe Von SpriteSurf.SetColorKey DDCKEY_SRCBLT, CK Else SpriteSurf.SetColorKey DDCKEY_SRCBLT, CK End If Exit Function Err_IDE: ' Während des Ausprobierens in der IDE muß das Sprite von 'der Datei geladen werden Set SpriteSurf = DD7.CreateSurfaceFromFile(App.Path & _ "\Kippe.bmp", SpriteDesc) Resume Next End Function Noch etwas zum Blitten (Kopieren). Das Blitten erfolgt mittels einer Schleife. Innerhalb der Schleife wird der BackBuffer kontinuierlich mit neuen Daten gefüllt. Dieser muss dann "geflippt" werden, d.h. an den Primary übergeben und auf den Bildschirm angezeigt werden. Wird nicht der gesamte Bereich des Backbuffers mit Daten gefüllt (z.B. Backbuffer = 1280x1024, dann Blitten von 640x480 Surface auf Koordinaten 0,0 [Links Oben], dann "Flippen"), fängt das Ganze an zu flackern. Also immer Backbuffer ganz füllen, z.B. mit BltColorFill. Der Backbuffer wird nach jedem Flip geleert. Ein Problem tritt allerdings dann auf, wenn die Anwendung den Focus verliert (z.B. ALT+Tab oder das Minimieren der Anwendung). Der Versuch das Surface dann zu Blitten, führt dazu, daß das Surface verloren geht. Es muß dann per Surface.Restore oder DirectDraw7.RestoreAllSurfaces neu geladen werden. Backbuffer mit einer Farbe ausfüllen ' Füllt den gesamten Backbuffer mit der angegeben Farbe 'Die Farbwerte können je nach eingestellter Bit-Tiefe variieren 'Eigentlich nicht notwendig bei diesem Projekt, 'aber mal ganz anschaulich Public Function PaintBackBuffer(ByVal BackColor As OLE_COLOR) ' Gesamten Backuffer mit einer Farbe ausfüllen Retval = BackSurface.BltColorFill(EmptyRect, BackColor) If Retval = DD_OK Then ' Wenn erfolgreich, Funktion beenden Exit Function End If ' wenn nicht dann... If Retval = DDERR_SURFACELOST Then ' Wenn ein Surface verloren geht '(passiert, wenn die Anwendung den Focus verliert) Do DoEvents ' Warten bis die Anwendung den Focus zurückerhält Loop Until DD7.TestCooperativeLevel = DD_OK Else ' ein Anderer Fehler? MsgBox "Fehler " & CStr(Retval) & ": " & _ DDGetErrorString(Retval), vbOKOnly + vbCritical, _ "Fehler " & CStr(Retval) Unload_DDraw End If End Function Fehlerrückmeldungen Die Funktion DDGetErrorString liefert einen String der den Fehler beschreibt. Private Function DDGetErrorString(ByVal hResult As Long) _ As String Select Case hResult Case DD_OK DDGetErrorString = "ALL_OK" Case DDERR_ALREADYINITIALIZED DDGetErrorString = "DDERR_ALREADYINITIALIZED" Case DDERR_CANNOTATTACHSURFACE DDGetErrorString = "DDERR_CANNOTATTACHSURFACE" Case DDERR_CANNOTDETACHSURFACE DDGetErrorString = "DDERR_CANNOTDETACHSURFACE" Case DDERR_CURRENTLYNOTAVAIL DDGetErrorString = "DDERR_CURRENTLYNOTAVAIL" Case DDERR_EXCEPTION DDGetErrorString = "DDERR_EXCEPTION" Case DDERR_GENERIC DDGetErrorString = "DDERR_GENERIC" Case DDERR_HEIGHTALIGN DDGetErrorString = "DDERR_HEIGHTALIGN" Case DDERR_INCOMPATIBLEPRIMARY DDGetErrorString = "DDERR_INCOMPATIBLEPRIMARY" Case DDERR_INVALIDCAPS DDGetErrorString = "DDERR_INVALIDCAPS" Case DDERR_INVALIDCLIPLIST DDGetErrorString = "DDERR_INVALIDCLIPLIST" Case DDERR_INVALIDMODE DDGetErrorString = "DDERR_INVALIDMODE" Case DDERR_INVALIDOBJECT DDGetErrorString = "DDERR_INVALIDOBJECT" Case DDERR_INVALIDPARAMS DDGetErrorString = "DDERR_INVALIDPARAMS" Case DDERR_INVALIDPIXELFORMAT DDGetErrorString = "DDERR_INVALIDPIXELFORMAT" Case DDERR_INVALIDRECT DDGetErrorString = "DDERR_INVALIDRECT" Case DDERR_LOCKEDSURFACES DDGetErrorString = "DDERR_LOCKEDSURFACES" Case DDERR_NO3D DDGetErrorString = "DDERR_NO3D" Case DDERR_NOALPHAHW DDGetErrorString = "DDERR_NOALPHAHW" Case DDERR_NOCLIPLIST DDGetErrorString = "DDERR_NOCLIPLIST" Case DDERR_NOCOLORCONVHW DDGetErrorString = "DDERR_NOCOLORCONVHW" Case DDERR_NOCOOPERATIVELEVELSET DDGetErrorString = "DDERR_NOCOOPERATIVELEVELSET" Case DDERR_NOCOLORKEY DDGetErrorString = "DDERR_NOCOLORKEY" Case DDERR_NOCOLORKEYHW DDGetErrorString = "DDERR_NOCOLORKEYHW" Case DDERR_NODIRECTDRAWSUPPORT DDGetErrorString = "DDERR_NODIRECTDRAWSUPPORT" Case DDERR_NOEXCLUSIVEMODE DDGetErrorString = "DDERR_NOEXCLUSIVEMODE" Case DDERR_NOFLIPHW DDGetErrorString = "DDERR_NOFLIPHW" Case DDERR_NOGDI DDGetErrorString = "DDERR_NOGDI" Case DDERR_NOMIRRORHW DDGetErrorString = "DDERR_NOMIRRORHW" Case DDERR_NOTFOUND DDGetErrorString = "DDERR_NOTFOUND" Case DDERR_NOOVERLAYHW DDGetErrorString = "DDERR_NOOVERLAYHW" Case DDERR_NORASTEROPHW DDGetErrorString = "DDERR_NORASTEROPHW" Case DDERR_NOROTATIONHW DDGetErrorString = "DDERR_NOROTATIONHW" Case DDERR_NOSTRETCHHW DDGetErrorString = "DDERR_NOSTRETCHHW" Case DDERR_NOT4BITCOLOR DDGetErrorString = "DDERR_NOT4BITCOLOR" Case DDERR_NOT4BITCOLORINDEX DDGetErrorString = "DDERR_NOT4BITCOLORINDEX" Case DDERR_NOT8BITCOLOR DDGetErrorString = "DDERR_NOT8BITCOLOR" Case DDERR_NOTEXTUREHW DDGetErrorString = "DDERR_NOTEXTUREHW" Case DDERR_NOVSYNCHW DDGetErrorString = "DDERR_NOVSYNCHW" Case DDERR_NOZBUFFERHW DDGetErrorString = "DDERR_NOZBUFFERHW" Case DDERR_NOZOVERLAYHW DDGetErrorString = "DDERR_NOZOVERLAYHW" Case DDERR_OUTOFCAPS DDGetErrorString = "DDERR_OUTOFCAPS" Case DDERR_OUTOFMEMORY DDGetErrorString = "DDERR_OUTOFMEMORY" Case DDERR_OUTOFVIDEOMEMORY DDGetErrorString = "DDERR_OUTOFVIDEOMEMORY" Case DDERR_OVERLAYCANTCLIP DDGetErrorString = "DDERR_OVERLAYCANTCLIP" Case DDERR_OVERLAYCOLORKEYONLYONEACTIVE DDGetErrorString = "DDERR_OVERLAYCOLORKEYONLYONEACTIVE" Case DDERR_PALETTEBUSY DDGetErrorString = "DDERR_PALETTEBUSY" Case DDERR_COLORKEYNOTSET DDGetErrorString = "DDERR_COLORKEYNOTSET" Case DDERR_SURFACEALREADYATTACHED DDGetErrorString = "DDERR_SURFACEALREADYATTACHED" Case DDERR_SURFACEALREADYDEPENDENT DDGetErrorString = "DDERR_SURFACEALREADYDEPENDENT" Case DDERR_SURFACEBUSY DDGetErrorString = "DDERR_SURFACEBUSY" Case DDERR_CANTLOCKSURFACE DDGetErrorString = "DDERR_CANTLOCKSURFACE" Case DDERR_SURFACEISOBSCURED DDGetErrorString = "DDERR_SURFACEISOBSCURED" Case DDERR_SURFACELOST DDGetErrorString = "DDERR_SURFACELOST" Case DDERR_SURFACENOTATTACHED DDGetErrorString = "DDERR_SURFACENOTATTACHED" Case DDERR_TOOBIGHEIGHT DDGetErrorString = "DDERR_TOOBIGHEIGHT" Case DDERR_TOOBIGSIZE DDGetErrorString = "DDERR_TOOBIGSIZE" Case DDERR_TOOBIGWIDTH DDGetErrorString = "DDERR_TOOBIGWIDTH" Case DDERR_UNSUPPORTED DDGetErrorString = "DDERR_UNSUPPORTED" Case DDERR_UNSUPPORTEDFORMAT DDGetErrorString = "DDERR_UNSUPPORTEDFORMAT" Case DDERR_UNSUPPORTEDMASK DDGetErrorString = "DDERR_UNSUPPORTEDMASK" Case DDERR_VERTICALBLANKINPROGRESS DDGetErrorString = "DDERR_VERTICALBLANKINPROGRESS" Case DDERR_WASSTILLDRAWING DDGetErrorString = "DDERR_WASSTILLDRAWING" Case DDERR_XALIGN DDGetErrorString = "DDERR_XALIGN" Case DDERR_INVALIDDIRECTDRAWGUID DDGetErrorString = "DDERR_INVALIDDIRECTDRAWGUID" Case DDERR_DIRECTDRAWALREADYCREATED DDGetErrorString = "DDERR_DIRECTDRAWALREADYCREATED" Case DDERR_NODIRECTDRAWHW DDGetErrorString = "DDERR_NODIRECTDRAWHW" Case DDERR_PRIMARYSURFACEALREADYEXISTS DDGetErrorString = "DDERR_PRIMARYSURFACEALREADYEXISTS" Case DDERR_NOEMULATION DDGetErrorString = "DDERR_NOEMULATION" Case DDERR_REGIONTOOSMALL DDGetErrorString = "DDERR_REGIONTOOSMALL" Case DDERR_CLIPPERISUSINGHWND DDGetErrorString = "DDERR_CLIPPERISUSINGHWND" Case DDERR_NOCLIPPERATTACHED DDGetErrorString = "DDERR_NOCLIPPERATTACHED" Case DDERR_NOHWND DDGetErrorString = "DDERR_NOHWND" Case DDERR_HWNDSUBCLASSED DDGetErrorString = "DDERR_HWNDSUBCLASSED" Case DDERR_HWNDALREADYSET DDGetErrorString = "DDERR_HWNDALREADYSET" Case DDERR_NOPALETTEATTACHED DDGetErrorString = "DDERR_NOPALETTEATTACHED" Case DDERR_NOPALETTEHW DDGetErrorString = "DDERR_NOPALETTEHW" Case DDERR_BLTFASTCANTCLIP DDGetErrorString = "DDERR_BLTFASTCANTCLIP" Case DDERR_NOBLTHW DDGetErrorString = "DDERR_NOBLTHW" Case DDERR_NODDROPSHW DDGetErrorString = "DDERR_NODDROPSHW" Case DDERR_OVERLAYNOTVISIBLE DDGetErrorString = "DDERR_OVERLAYNOTVISIBLE" Case DDERR_NOOVERLAYDEST DDGetErrorString = "DDERR_NOOVERLAYDEST" Case DDERR_INVALIDPOSITION DDGetErrorString = "DDERR_INVALIDPOSITION" Case DDERR_NOTAOVERLAYSURFACE DDGetErrorString = "DDERR_NOTAOVERLAYSURFACE" Case DDERR_EXCLUSIVEMODEALREADYSET DDGetErrorString = "DDERR_EXCLUSIVEMODEALREADYSET" Case DDERR_NOTFLIPPABLE DDGetErrorString = "DDERR_NOTFLIPPABLE" Case DDERR_CANTDUPLICATE DDGetErrorString = "DDERR_CANTDUPLICATE" Case DDERR_NOTLOCKED DDGetErrorString = "DDERR_NOTLOCKED" Case DDERR_CANTCREATEDC DDGetErrorString = "DDERR_CANTCREATEDC" Case DDERR_NODC DDGetErrorString = "DDERR_NODC" Case DDERR_WRONGMODE DDGetErrorString = "DDERR_WRONGMODE" Case DDERR_IMPLICITLYCREATED DDGetErrorString = "DDERR_IMPLICITLYCREATED" Case DDERR_NOTPALETTIZED DDGetErrorString = "DDERR_NOTPALETTIZED" Case DDERR_UNSUPPORTEDMODE DDGetErrorString = "DDERR_UNSUPPORTEDMODE" Case DDERR_NOMIPMAPHW DDGetErrorString = "DDERR_NOMIPMAPHW" Case DDERR_INVALIDSURFACETYPE DDGetErrorString = "DDERR_INVALIDSURFACETYPE" Case DDERR_NOOPTIMIZEHW DDGetErrorString = "DDERR_NOOPTIMIZEHW" Case DDERR_NOTLOADED DDGetErrorString = "DDERR_NOTLOADED" Case DDERR_NOFOCUSWINDOW DDGetErrorString = "DDERR_NOFOCUSWINDOW" Case DDERR_DCALREADYCREATED DDGetErrorString = "DDERR_DCALREADYCREATED" Case DDERR_NONONLOCALVIDMEM DDGetErrorString = "DDERR_NONONLOCALVIDMEM" Case DDERR_CANTPAGELOCK DDGetErrorString = "DDERR_CANTPAGELOCK" Case DDERR_CANTPAGEUNLOCK DDGetErrorString = "DDERR_CANTPAGEUNLOCK" Case DDERR_NOTPAGELOCKED DDGetErrorString = "DDERR_NOTPAGELOCKED" Case DDERR_MOREDATA DDGetErrorString = "DDERR_MOREDATA" Case DDERR_VIDEONOTACTIVE DDGetErrorString = "DDERR_VIDEONOTACTIVE" Case DDERR_DEVICEDOESNTOWNSURFACE DDGetErrorString = "DDERR_DEVICEDOESNTOWNSURFACE" Case DDERR_NOTINITIALIZED DDGetErrorString = "DDERR_NOTINITIALIZED" Case Else DDGetErrorString = "Unknown " & Hex(hResult) End Select End Function Blitten von Surfaces Nun kommen wir zum wahrscheinlich interessantesten Teil, dem Blitten von Surfaces. ' Diese Funktion füllt den gesamten Backbuffer mit der Grafik, 'die sich imHintergrund-Surface befindet, aus Public Function Blt_Background() Dim TmpDestRect As RECT ' Ziel-Koordinaten eingeben '(Gesamte Primary-Surface-Koordinaten) With TmpDestRect .Bottom = PrimSurfDesc.lHeight .Right = PrimSurfDesc.lWidth End With ' Und jetzt das Blitten 'Leeres RECT übergeben (gesamtes Surface blitten) 'DONOTWAIT bedeutet, daß die Funktion nicht erst zurückkehrt, 'wenn der vorgang beendet ist Retval = BackSurface.Blt(TmpDestRect, HinterGrundSurf, _ EmptyRect, DDBLT_DONOTWAIT) If Retval = DD_OK Then ' Wenn erfolgreich, Funktion beendet Exit Function End If ' wenn nicht dann... If Retval = DDERR_SURFACELOST Then ' Wenn ein Surface verloren geht '(passiert, wenn die Anwendung den Focus verliert) Do DoEvents ' Warten bis die Anwendung den Focus zurückerhält Loop Until DD7.TestCooperativeLevel = DD_OK HinterGrundSurf.restore ' Surface wiederherstellen Else ' ein Anderer Fehler? If Retval = 0 Then Retval = Err.Number MsgBox "Fehler " & CStr(Retval) & ": " & _ DDGetErrorString(Retval), vbOKOnly + vbCritical, _ "Fehler " & CStr(Retval) Unload_DDraw End If End Function Jetzt Blitten wir das Sprite. Mittels einer Schleife wird das Sprite auf dem Bildschirm bewegt - und zwar soll es im Mittelpunkt des Bildschirms im Kreis fliegen. ' Blittet das Sprite auf den Bildschirm Public Function Blt_Sprite(Optional ByVal Speed As Long = 1) Dim MiddleX, MiddleY, Radius As Long Dim TX As Long, TY As Long Static Grad As Long, CK As DDCOLORKEY If Speed < 1 Or Speed > 20 Then Exit Function ' Koordinaten berechnen With SpriteDesc MiddleX = (BackSurfDesc.lWidth - .lWidth) / 2 MiddleY = (BackSurfDesc.lHeight - .lHeight) / 2 Radius = (BackSurfDesc.lHeight - .lHeight) / 2 / 2 Grad = Grad + Speed If Grad > 359 Then Grad = Grad - 360 TX = MiddleX + Cos((Grad / 360) * 2 * 3.141) * Radius TY = MiddleY + Sin((Grad / 360) * 2 * 3.141) * Radius End With ' Blitten mit transparenter Farbe zu den 'ausgerechneten Koordinaten '(EmpyRect = Ganzes Surface) Retval = BackSurface.BltFast(TX, TY, SpriteSurf, EmptyRect, _ DDBLTFAST_DONOTWAIT Or DDBLTFAST_SRCCOLORKEY) If Retval = DD_OK Then ' Wenn erfolgreich, Funktion beenden Exit Function End If ' wenn nicht dann... If Retval = DDERR_SURFACELOST Then ' Wenn ein Surface verloren geht '(passiert, wenn die Anwendung den Focus verliert) Do DoEvents ' Warten bis die Anwendung den Focus zurückerhält Loop Until DD7.TestCooperativeLevel = DD_OK SpriteSurf.restore ' Surface wiederherstellen ' Ist ein Surface im Grafikkartenspeicher reicht das 'alleinige .restore nicht. 'Im Gegensatz zu Surfaces im Systemspeicher muß man das 'Surface neu laden On Error GoTo Err_IDE ' Sprite aus Resource-Datei laden Set SpriteSurf = DD7.CreateSurfaceFromResource("", _ "KIPPE", SpriteDesc) ' Transparente Farbe zuweisen If SpriteTransparenz <> -1 Then CK.high = SpriteTransCol ' Transparente Farbe Bis CK.low = SpriteTransCol ' Transparente Farbe Von SpriteSurf.SetColorKey DDCKEY_SRCBLT, CK Else SpriteSurf.SetColorKey DDCKEY_SRCBLT, CK End If Else ' ein Anderer Fehler? If Retval = 0 Then Retval = Err.Number MsgBox "Fehler " & CStr(Retval) & ": " & _ DDGetErrorString(Retval), vbOKOnly + vbCritical, _ "Fehler " & CStr(Retval) Unload_DDraw End If Exit Function Err_IDE: ' Während des Ausprobiers in der IDE muß das Sprite von der 'Datei geladen werden Set SpriteSurf = DD7.CreateSurfaceFromFile(App.Path & _ "\Kippe.bmp", SpriteDesc) Resume Next End Function Bildschirmausgabe Jetzt werden die DDraw-Information als Text auf den Bildschirm ausgegeben. Public Function PrintProgInfo() Dim AnzahlSurfaces As String Dim ScreenRes As String Dim TotalMem As String Dim FreeMem As String Dim FPS As String Dim SE As DirectDrawEnumSurfaces Dim TempSurfDesc As DDSURFACEDESC2 Dim TempSurfCaps As DDSCAPS2 Static LastTime As Long, FPSCount As Long, LastFps As String ' Auflösung erfragen With BackSurfDesc ScreenRes = "Bildschirmauflösung: " & .lWidth & "x" & _ .lHeight & " bei " & .ddpfPixelFormat.lRGBBitCount & _ " bit" End With ' Speicher und Anzahl Surfaces erfragen With DD7 Set SE = .GetSurfacesEnum(DDENUMSURFACES_DOESEXIST Or _ DDENUMSURFACES_ALL, TempSurfDesc) ' Anzahl Surfaces AnzahlSurfaces = "Anzahl Surfaces: " & CStr(SE.GetCount) ' Gesamt Speicher TotalMem = "Grafikkarten Texturspeicher: " & _ Fix(.GetAvailableTotalMem(TempSurfCaps)) / 1024 & " KB" ' Freier Speicher FreeMem = "Freier Texturspeicher: " & _ Fix(.GetFreeMem(TempSurfCaps) / 1024) & " KB" End With ' Frames ausrechnen If Timer > LastTime + 3 Then FPSCount = FPSCount + 1 If LastTime = 0 Then LastFps = "Frames per Second: am Ermitteln" Else LastFps = "Frames per Second: " & CCur(FPSCount) End If FPSCount = 0 LastTime = Timer FPS = LastFps Else FPSCount = FPSCount + 1 FPS = LastFps End If ' Auf den Bildschirm ausgeben With BackSurface .SetForeColor vbGreen .SetFillColor vbBlack .SetFontTransparency True .DrawBox 10, 10, 400, 200 .DrawText 30, 30, ScreenRes, False .DrawText 30, 60, AnzahlSurfaces, False .DrawText 30, 90, TotalMem, False .DrawText 30, 120, FreeMem, False .DrawText 30, 150, FPS, False End With End Function Jetzt muß man noch den Backbuffer ums Primary-Surface "flippen", und am besten alles noch in einer schleife verpacken. ' Bringt den Backbuffer auf den Bildschirm Public Function FlipToScreen() On Error GoTo Err_Flip PrimSurface.Flip Nothing, DDFLIP_WAIT Exit Function Err_Flip: If Err.Number = DDERR_SURFACELOST Then ' Wenn ein Surface verloren geht '(passiert, wenn die Anwendung den Focus verliert) Do DoEvents ' Warten bis die Anwendung den Focus zurückerhält Loop Until DD7.TestCooperativeLevel = DD_OK PrimSurface.restore ' Surface wiederherstellen Else ' ein Anderer Fehler? If Retval = 0 Then Retval = Err.Number MsgBox "Fehler " & CStr(Retval) & ": " & _ DDGetErrorString(Retval), vbOKOnly + vbCritical, _ "Fehler " & CStr(Retval) Unload_DDraw End If End Function Hauptroutine Jetzt noch die Schleife. Damit das Programm auch beendet werden kann, wird im Form_KeyPress - Ereignis beim Drücken der ESC-Taste Form-Eigenschaft .Tag auf "exit" gesetzt. Während die Schleife ausgeführt wird, kann so über die Form.Tag-Eigenschaft die Abbruch-Bedingung abgefragt werden. ' Hauptschleife Sub StartRunning(ByVal WindowHwnd As Long, _ ByRef ScreenResolution As DDrawDisplayModeType, _ ByVal GUID As String, ByVal BufferCount As Buffers, _ ByVal SpriteSpeed As Long) Init_DDraw WindowHwnd, ScreenResolution, BufferCount, GUID LoadSurfaces RGB(255, 0, 255) ' Beginn der Schleife Do PaintBackBuffer vbBlack Blt_Background PrintProgInfo Blt_Sprite SpriteSpeed FlipToScreen DoEvents Loop Until Main_Form.Tag = "exit" ' Beenden Unload_DDraw End Sub Zusammenfassung Anhand dieses Beispiels sollten Sie nun in der Lage sein, eine Grafik über eine andere Hintergrund-Grafik "bewegen" zu lassen. Natürlich kann DrirectDraw noch vieles mehr. Für weitere Informationenen, empfiehlt es sich das DirectX SDK 7.0a oder 8 auf der Dieser Workshop wurde bereits 16.909 mal aufgerufen.
Anzeige
![]() ![]() ![]() (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
TOP! Unser Nr. 1 ![]() Neu! sevDataGrid 3.0 Mehrspaltige Listen, mit oder ohne DB-Anbindung. Autom. Sortierung, Editieren von Spalteninhalten oder das interaktive Hinzufügen von Datenzeilen sind ebenso möglich wie das Erstellen eines Web-Reports. Tipp des Monats ![]() Dieter Otter PopUp-Menü wird nicht angezeigt :-( In diesem Tipp verraten wir Ihnen, wie Sie Probleme mit PopUp-Menüs umgehen können, wenn diese unter bestimmten Umständen einfach nicht angezeigt werden. TOP Entwickler-Paket ![]() TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
|||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |