Дата публикации статьи: 10.07.2003 00:00

[введение] Вы попробовали использовать PaintPicture и ужасное качество анимации заставило вас кричать от ужаса. Вы попробовали BitBlt и нашли, что скорость обновления целого экрана 640x480 оставляет желать лучшего. Вы готовы к DirectDraw! Как вы уже могли догадаться, DirectDraw быстр. Он получает свою скорость из-за прямого доступа к 2D видеокарте, но с тех пор, как появился DirectX, вам не надо изучать специфические инструкции каждой отдельной видеокарты. Ну разве не чудесно?

Вообще-то, DirectX не имел официальной поддержки VB до тех пор, пока не вышел DirectX 7. Чтобы получить доступ к функциям DirectX 3-6 из VB, вам потребуются Type Library с сайта {Visual Basic Area 51}. Эти библиотеки позволят вам получить доступ к DirectX из VB. И что самое хорошее, это библиотеки абсолютно бесплатны. Теперь, перейдем к обучению.

[программа]

Для начала, вам надо объявить несколько типов и т. д. Вы увидите, для чего они нужны позже.

Первая переменная "dir" будет использована для того, чтобы указать, в какую сторону движется мяч (примером будет мяч, прыгающий на фоне). Затем, нам понадобятся несколько констант, которые будут использованы, чтобы загрузить растровый рисунок. Затем тип BITMAP. Он будет хранить всю информацию об растровом изображении. Тип используется позже, для загрузки BMP.


'Направление движения спрайта
Dim dir As Integer

'Константы
Const LR_LOADFROMFILE = &H10
Const LR_CREATEDIBSECTION = &H2000
Const SRCCOPY = &HCC0020

'Определение BMP для вызова функции LoadImage
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type

Теперь, несколько API. Вам должны быть знакомы многие из них, если вы изучали BitBlt.



'Функции, используемые в программе
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Функция LoadImage здесь самая важная. Эта функция интегральная часть процедуры загрузки изображения в буфер. Кстати о буферах, нам ведь надо их объявить! Вот объявления буферов:


Dim dd As IDirectDraw2 'Главный объект DirectDraw

' Наши буфера
Dim ddsFront As IDirectDrawSurface2 ' Главная поверхность
Dim ddsBack As IDirectDrawSurface2 ' Задний буфер
Dim BackDrop As IDirectDrawSurface2 'Буфер для фона
Dim Sprite As IDirectDrawSurface2 'Буфер для спрайта



dd - это главный объект DirectDraw. Остальные объекты - буфера (или поверхности). Поверхности в DirectDraw - это эквиваленты Memory DC, которые использовались в BitBlt Tutorial. Поверхности - это место в памяти, куда вы загружаете изображения. Также, вы копируете их содержимое на главную поверхность, чтобы увидеть что-либо на экране. Стало понятней? Мы объявили главную (переднюю) поверхность - это то, что видит пользователь. Задний буфер - здесь собирается сцена. Последние два буфера служат для хранения фона и спрайта.

Далее: как DirectDraw узнает в каком месте буфера находится нужный спрайт? Как он узнает какого размера спрайт? Да он и не знает. Вам надо самим сказать ему об этом, передав структуру RECT.


'Вот они - RECTS
'Они используются для хранения информации о картинке
'I.E. Верхний левый угол, ширина, высота.
Dim BackDropRect As RECT
Dim SpriteRect As RECT


Теперь, когда мы сохранили информацию о изображениях, надо описать передняя и заднюю поверхности.


'Описание поверхностей
Dim ddsdFront As DDSURFACEDESC
Dim ddsdBack As DDSURFACEDESC
Dim ddCaps As DDSCAPS


Dim Running As Boolean ' Была ли нажата клавиша Escape



Последняя переменная "running" указывает на то, нажал ли пользователь клавишу Esc или нет. Если да, тогда надо прервать выполнение программы и выгрузить форму. Затем, надо уничтожить поверхности в процедуре Unload.

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'This exits the loop, therefore letting the unload
'me function do its thing.
If KeyCode = vbKeyEscape Then
Running = False
End If
End Sub




Теперь, можно написать процедуру Form_Load. Здесь собирается все вышесказанное. Происходит вызов функции загружающей растровое изображение. Эта функция показана в конце учебника.



Private Sub Form_Load()
'направление - налево и мяч начинает с точки 20
dir = 1
coorx = 20
'Учтановить переменную ключевого цвета
Dim ddck As DDCOLORKEY



В этом месте происходит присвоение некоторым переменным их начальных значений. "Dir" - это направление движение мяча и он начинает двигаться влево. "coorx" говорит сам за себя - координата мяча по оси X. Теперь, очень важная переменная - "ddck". Эта переменная содержит ключевой цвет. Ключевой цвет - это цвет, который при наложении спрайта на фон будет прозрачным.



'Создать устройство DirectDraw.
DirectDrawCreate ByVal 0&, dd, Nothing

'Полноэкранный режим без заголовка окна
dd.SetCooperativeLevel frmMain.hwnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN
'Экран будет в режиме 640x480 с 8-битным цветом (256 цветов)
dd.SetDisplayMode 640, 480, 8, 0, 0



Здесь мы инициализировали полноэкранный режим. Сначала инициализируется DirectDraw, затем мы создаем эксклюзивный полноэкранный режим. Он эксклюзивный (то есть не делится ни с кем ресурсами), потому что не может быть более одного полноэкранного окна. Затем мы устанавливаем режим дисплея в 640x480x8.



With ddsdFront
'Как много памяти займет поверхность?
.dwSize = Len(ddsdFront)

.dwFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
' Описать главную поверхность, на которую можно будет копировать готовую сцену
.DDSCAPS.dwCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP _
Or DDSCAPS_COMPLEX Or DDSCAPS_SYSTEMMEMORY
' Описать 1 задний буфер
.dwBackBufferCount = 1
End With

'Создать передний буфер
dd.CreateSurface ddsdFront, ddsFront, Nothing


ddCaps.dwCaps = DDSCAPS_BACKBUFFER

'Создать задний буфер
ddsFront.GetAttachedSurface ddCaps, ddsBack



Эта часть очень важна, так что будьте внимательны. Заполняется описание передней поверхности. Первая переменная задает сколько памяти будет использоваться. Затем, мы устанавливаем флаги. Мы описываем поверхность как главную и с возможностью копирования на нее сцены. Затем, мы задаем количество задних буферов. В нашем случае один. Затем, мы создаем переднюю поверхность с прикремленным к ней задним буфером.



'Загрузить BMP
Set BackDrop = LoadBitmapIntoDXS(dd, app.path & "\background.bmp")
Set Sprite = LoadBitmapIntoDXS(dd, app.path & "\circle2.bmp")



Настал момент для загрузки в свободные буфера графики. Вызывается процедура LoadBitmap, которая выполняет загрузку изображений в буфера.


'Установить ключевой цвет
With ddck
.dwColorSpaceHighValue = RGB(0, 0, 0)
.dwColorSpaceLowValue = .dwColorSpaceHighValue
End With
'Set the color key
Call Sprite.SetColorKey(DDCKEY_SRCBLT, ddck)

Еще одна очень важная часть. Здесь определяется ключевой цвет. Что такое ключевой цвет? Когда вы определяете некий цвет ключевым, он будет игнорироваться при наложении спрайта на уже готовое изображение, чтобы создать эффект прозрачности. Вот для чего спрайты рисуют на черном фоне. Вы можете установить любой цвет ключевым. Последняя строка устанавливает ключевой цвет для буфера Sprite. Вы можете устанавливать ключевые цвета для тех буферов, которым это необходимо.



'Определить RECTS

'Фон
BackDropRect.Left = 0
BackDropRect.Top = 0
BackDropRect.Right = 640
BackDropRect.Bottom = 480

'Спрайт
SpriteRect.Left = 0
SpriteRect.Top = 0
SpriteRect.Right = 77
SpriteRect.Bottom = 63

Здесь заполняются важные структуры RECT. Left и Top указывают на верхний левый угол изображения на поверхности. Right и Bottom задают правый нижний его угол. Таким образом задается размер переводимого изображения. Если вы укажете координаты, не соответствующие рисункам, которые вы загрузили в буфер, результат может быть плачевным.

' Показать форму
frmMain.Show
'Прога работает
Running = True
'Здесь находится цикл, очищающий задний буфер,
'копирующий фон на него,
'затем копирующий спрайт с учетом ключевого цвета (т. е. прозрачный)
'на фон.
Do Until Running = False
' Позволить Форточкам делать свою работу
DoEvents

'Скопировать фон на задний буфер
Call ddsBack.BltFast(0, 0, BackDrop, BackDropRect, DDBLTFAST_WAIT)
'Скопировать спрайт на задний буфер
Call ddsBack.BltFast(coorx, 50, Sprite, SpriteRect, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)



Последние выражения копируют сперва фон на задний буфер, а затем и спрайт. DDBLTFAST_WAIT заставляет программу выждать, пока изображенеи не будет полностью скопировано, перед тем, как продолжать работу. Помните выставлять в этом месте DoEvents. Это позволит Windows заниматься другими делами, например отслеживать нажатие клавиш.


'Если движемся влево:
If dir = 1 Then
coorx = coorx + 5
'Если движемся вправо:
Else
coorx = coorx - 5
End If

If coorx >= 350 Then dir = 2
If coorx <= 10 Then dir = 1



Здесь обновляется позиция спрайта. Если Dir=1, тогда спрайт движется влево, если Dire=2, тогда вправо.




'Копировать задний буфер на главную поверхность
On Error Resume Next
Do
ddsFront.Flip Nothing, 0
If Err.Number = DDERR_SURFACELOST Then ddsFront.Restore: Err.Number = 0
Loop Until Err.Number = 0
Loop
'Выгрузить все, что можно
Unload Me
End Sub



Теперь, часть, где задний буфер с приготовленно на нем сценой копируется на главную поверхность, чтобы пользователь мог что-нибудь увидеть. Если поверхность потеряна, программа просто пропускает этот момент, вместо того, чтобы выдавать ошибку. Процедура Unload Me происходит, когда нажата клавиши Escape.

Это была процедура Form_Load. Также, нам нужна еще и Form_Unload. Если вы не обнулите (установите в nothing) поверхности, ваша программа выполнит то, что обычно называют crash. DirectDraw не прощает даже таких мелочей.

Private Sub Form_Unload(Cancel As Integer)
'Если вы создали еще какие нибудь объекты DirectDraw, обнуляйте их
' здесь, иначе программа выдаст сбой!


dd.FlipToGDISurface
' Восставновить режим дисплея.
dd.RestoreDisplayMode
' Вернуться к нормальному режиму.
dd.SetCooperativeLevel frmMain.hwnd, DDSCL_NORMAL
'Сначала обнуляем задний буфер. Затем главную поверхность.
' Иначе - ХЛОП!

' Сбросить буфера
Set Sprite = Nothing
Set BackDrop = Nothing
Set ddsBack = Nothing
Set ddsFront = Nothing

'Уничтожить объект DirectDraw. Убедитесь, что делаете это в последнюю очередь Set dd = Nothing
End Sub



Здесь мы восстанавливаем режим дисплея, в котором работает Windows и возвращаемся в оконный режим из полноэкранного. Затем сбрасываются буфера спрайта и фона. За ними в мусорку следуют задний буфер и передняя поверхность. СНАЧАЛА ИДЕТ ЗАДНИЙ БУФЕР, А ТОЛЬКО ПОТОМ ПЕРЕДНЯЯ ПОВЕРХНОСТЬ! В конце-концов, уничтожаем объект DirectDraw.

Ну и наконец, вот функция, которая загружает растровые изображения. Вы можете попробовать устанавливать ColorKey здесь, вместо того, чтобы делать это в Form_Load.



Private Function LoadBitmapIntoDXS(DXObject As IDirectDraw2, ByVal BMPFile As String) As IDirectDrawSurface2

Dim hBitmap As Long ' Указатель на bitmap
Dim dBitmap As BITMAP
Dim TempDXD As DDSURFACEDESC
Dim TempDXS As IDirectDrawSurface2 ' Временная поверхность.
Dim dcBitmap As Long
Dim dcDXS As Long ' Указатель на поверхность
Dim ddck As DDCOLORKEY ' Colorkeys


'все в черное
ddck.dwColorSpaceLowValue = 0
ddck.dwColorSpaceHighValue = 0

'Загрузить BMP с LoadImage API
hBitmap = LoadImage(ByVal 0&, BMPFile, 0, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)

' BMP Info
GetObject hBitmap, Len(dBitmap), dBitmap

' Временная поверхность
With TempDXD
.dwSize = Len(TempDXD)
.dwFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
.DDSCAPS.dwCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
.dwWidth = dBitmap.bmWidth
.dwHeight = dBitmap.bmHeight
End With
' Создать временную поверхность DX
DXObject.CreateSurface TempDXD, TempDXS, Nothing

' Создать DC
dcBitmap = CreateCompatibleDC(ByVal 0&)
' Выбрать BMP в DC
SelectObject dcBitmap, hBitmap

' Восстановить память для временной поверхности
TempDXS.Restore
' назначит dc к surface dc
TempDXS.GetDC dcDXS
' Blit BMP из API DC в DX DC используя BitBlt
StretchBlt dcDXS, 0, 0, TempDXD.dwWidth, TempDXD.dwHeight, dcBitmap, 0, 0, dBitmap.bmWidth, dBitmap.bmHeight, Win32.SRCPAINT




' Использовать colorkey
TempDXS.SetColorKey DDCKEY_SRCBLT, ddck

' Возвратить созданную поверхность DX
Set LoadBitmapIntoDXS = TempDXS

' Стересть временные объекты
TempDXS.ReleaseDC dcDXS
DeleteDC dcBitmap
DeleteObject hBitmap
Set TempDXS = Nothing


End Function