![]() |
Tipp 0251
|
Animation in PictureBox
|
 |
|
Autor/Einsender: Datum: |
|
Alexander Csadek 29.06.2002 |
|
Entwicklungsumgebung:
DirectX-Version: |
|
VB 6
DirectX 7 |
|
|
Wie sicherlich bekannt ist, kann man mit DirectDraw nicht nur im Vollbild-Modus (Fullscreen) arbeiten, sondern auch die Darstellung in ein Fenster zeichnen lassen.
|
DirectDraw kann aber auch veranlasst werden, in eine PictureBox zu zeichnen. Es muss hierbei lediglich der Clipper auf die PictureBox gesetzt werden, und die Größe des Rechteckes wird dann von der PictureBox anstatt von der Form eingelesen.
|
|
|
Option Explicit
Dim DX7 As New DirectX7
Dim DD7 As DirectDraw7
Dim SurfaceDesc As DDSURFACEDESC2
Dim PrimarySurface As DirectDrawSurface7
Dim BackBuffer As DirectDrawSurface7
Dim ddClipper As DirectDrawClipper
Dim bmpBild1 As DirectDrawSurface7
Dim AniCount As Single
Dim AniRunning As Boolean
Dim r1 As RECT
Dim r2 As RECT
Dim running As Boolean
Dim FrameTime As Long
Private Sub Form_Load()
Dim srcrect As RECT
Dim Aniline As Integer
Me.Show
Me.Refresh
Initialization
BitmapLaden
running = True
Do
FrameTime = GetTime
DX7.GetWindowRect Picture1.hWnd, r1
BackBuffer.BltColorFill r2, 0
Aniline = AniCount \ 9
With srcrect
.Left = 101 * (AniCount - (Aniline * 9))
.Right = .Left + 101
.Top = 102 * Aniline
.Bottom = .Top + 102
End With
BackBuffer.BltFast 0, 0, bmpBild1, srcrect, DDBLTFAST_WAIT
If AniRunning Then
AniCount = AniCount + 1
If AniCount > 43 Then AniCount = 0
End If
With r2
.Left = 0: .Right = Picture1.ScaleWidth
.Top = 0: .Bottom = Picture1.ScaleHeight
End With
PrimarySurface.Blt r1, BackBuffer, r2, DDBLT_WAIT
DoEvents
Do Until GetTime - FrameTime > 40
Loop
Loop While running
Terminate
End Sub
Sub Initialization()
Set DD7 = DX7.DirectDrawCreate("")
DD7.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL
With SurfaceDesc
.lFlags = DDSD_CAPS
.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
End With
Set PrimarySurface = DD7.CreateSurface(SurfaceDesc)
With SurfaceDesc
.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
.lHeight = Picture1.ScaleHeight
.lWidth = Picture1.ScaleWidth
End With
Set BackBuffer = DD7.CreateSurface(SurfaceDesc)
Set ddClipper = DD7.CreateClipper(0)
ddClipper.SetHWnd Picture1.hWnd
PrimarySurface.SetClipper ddClipper
End Sub
Sub BitmapLaden()
Dim BmpDesc As DDSURFACEDESC2
BmpDesc.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
BmpDesc.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
BmpDesc.lWidth = 909
BmpDesc.lHeight = 510
Set bmpBild1 = _
DD7.CreateSurfaceFromFile(App.Path & "\vbfun.bmp", BmpDesc)
End Sub
Function GetTime() As Long
GetTime = DX7.TickCount
End Function
Sub Terminate()
Set bmpBild1 = Nothing
Set ddClipper = Nothing
Set BackBuffer = Nothing
Set PrimarySurface = Nothing
DD7.RestoreDisplayMode
DD7.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL
End
End Sub
Private Sub cmd_Start_Click()
AniRunning = True
cmd_Stop.Enabled = cmd_Stop.Enabled Xor -1
cmd_Start.Enabled = cmd_Start.Enabled Xor -1
End Sub
Private Sub cmd_Stop_Click()
AniRunning = False
cmd_Start.Enabled = cmd_Start.Enabled Xor -1
cmd_Stop.Enabled = cmd_Stop.Enabled Xor -1
End Sub
Private Sub cmd_Beenden_Click()
running = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, _
UnloadMode As Integer)
Terminate
End Sub
|
|
|
|
|
|
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 (324
kB)
|
Downloads bisher: [ 2046
]
|
|
|