Обновим картинку ?!

[petroff]

У меня есть вопрос на который я сам пока не могу найти ответа...
Для вас он конечно будет смешной ,... что поделать я еше пока учусь !

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


Dim dx As New DirectX7 'объявляем об использовании DirectX7
Dim dd As DirectDraw7 'объявляем об использовании DirectDraw7.
Dim Primary As DirectDrawSurface7
Dim Back As DirectDrawSurface7
Dim x As Integer
Dim Intro As DirectDrawSurface7
Dim Sprites As DirectDrawSurface7

Dim ddsd1 As DDSURFACEDESC2
Dim ddsd2 As DDSURFACEDESC2
Dim caps As DDSCAPS2

Private Sub Form_KeyPress(KeyAscii As Integer)

Call Form_Unload(0)
End Sub

Private Sub Form_Load()
Set dd = dx.DirectDrawCreate("")
Me.Show
Call dd.SetCooperativeLevel(Me.hWnd, DDSCL_FULLSCREEN Or DDSCL_EXCLUSIVE)
Call dd.SetDisplayMode(640, 480, 16, 0, DDSDM_DEFAULT)
ddsd1.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
ddsd1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
ddsd1.lBackBufferCount = 1
Set Primary = dd.CreateSurface(ddsd1)
caps.lCaps = DDSCAPS_BACKBUFFER
Set Back = Primary.GetAttachedSurface(caps)
ddsd2.lFlags = DDSD_CAPS
ddsd2.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
Set Intro = dd.CreateSurfaceFromFile("b.bmp", ddsd2)
ddsd2.lHeight = 32
ddsd2.lWidth = 32
Set Sprites = dd.CreateSurfaceFromFile("s.bmp ", ddsd2)
Dim key As DDCOLORKEY
key.low = 0
key.high = 0
Sprites.SetColorKey DDCKEY_SRCBLT, key
UpdateBack
UpdateObject
Call Primary.Flip(Back, DDFLIP_WAIT)

End Sub
Sub UpdateBack()
Dim rcRect As RECT 'уже знакомые нам переменные
Dim ddrval As Long
rcRect.Left = 0
rcRect.Top = 0
rcRect.Right = 640
rcRect.Bottom = 480
Call Back.BltFast(0, 0, Intro, rcRect, DDBLTFAST_NOCOLORKEY Or DDBLTFAST_WAIT)
End Sub
Sub UpdateObject()
Dim ddrval As Long 'буфер для прорисовки спрайта.
Dim rcRect As RECT 'тип данных, задающий позицию спрайта
rcRect.Left = 0
rcRect.Top = 0
rcRect.Right = 30
rcRect.Bottom = 30


y = 300
''Call Back.DrawText(1, 1, "FFFFFFFFFFFFf", False)
Call Back.BltFast(x, y, Sprites, rcRect, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT)
End Sub

Private Sub Form_Unload(Cancel As Integer)
Timer1.Enabled = False
Call dd.RestoreDisplayMode
Call dd.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL)
Set Back = Nothing
Set Primary = Nothing
Set dd = Nothing
End
End Sub

Private Sub Timer1_Timer()
UpdateBack
UpdateObject
Call Primary.Flip(Back, DDFLIP_WAIT)
End Sub

код примитивный , дожен по таймеру обновлять картинку....
Подозреваю что я не умею очишать back буфер

[Yurich]

1. Я не увидел цикличности в фу-ии FLIP. Может это пока и не надо?
2. Код слабо структурирован, сразу понять трудно, но даже при беглом взгляде видна ошибка:
UpdateBack - в BackBuffer копируется одна картинка (Intro)
UpdateObject - следом за ней другая (Sprites)
Call Primary.Flip(Back, DDFLIP_WAIT)

А где Clear Back Buffer???

Последовательность должна быть примерно такой:
a) Clear Back Buffer
b) Update Or Modify Surfaces
c) Blit, Blit, Blit...
d) Flip

3. Для чистки Surfaces, в том числе и BackBuffer попробуй это:
'========================
Public Sub ClearBuffer(ddsBack as DirectDrawSurface7, BackgroundColor As Color)
Dim ddsdStore As DDSURFACEDESC2 'Вспомогательная структура описания
ddsBack.GetSurfaceDesc ddsdStore 'Получить описание очищаемой поверхности
'Заполняем структуру RECT, так, чтобы она охватывала всю поверхность
With rc
.Top = 0
.Left = 0
.Right = ddsdStore.lWidth 'Вот зачем нам надо было описание поверхности
.Bottom = ddsdStore.lHeight 'Высота и ширина подгоняются под нее
End With
' Заполняем цветом область, указанную в RECT
ddsBack.BltColorFill rc, RGB(BackgroundColor.Red, BackgroundColor.Green, BackgroundColor.Blue)
End Sub

4. 'Создание поверхности из картинки в файле:
'======================================
Public Function LoadPic(ByVal FileName As String, Optional CKey As Long = 0) As DirectDrawSurface7

'Объявления
Dim dds As DirectDrawSurface7 'Временная вспомогательная поверхность
Dim ddsd As DDSURFACEDESC2 'Описание временной поверхности
Dim StorePic As Long 'Временное хранилище картинки
Dim Bmp As Win32.BITMAP 'Тип BITMAP, описывающий растровое изображение
Dim hDCPicture As Long, hDCSurface As Long 'DC картинки и поверхности
Dim ddCK As DDCOLORKEY 'Для установки ключевого цвета

Const LR_LOADFROMFILE = &H10
Const LR_CREATEDIBSECTION = &H2000


'Загружаем картинку и получаем объект картинки
StorePic = LoadImage(0&, FileName, 0, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION) 'Загружаем картинку из файла
'Получаем описание картинки в структуру BITMAP
Win32.GetObject StorePic, Len(Bmp), Bmp

'Теперь, создаем поверхность
ddsd.lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT 'Необходимые флаги
ddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN 'Поверхность оффскринная
ddsd.lHeight = Bmp.bmHeight 'Высота поверхности как у картинки
ddsd.lWidth = Bmp.bmWidth 'Ширина поверхности как у картинки
'Вызываем метод, создающий поверхность
Set dds = dd.CreateSurface(ddsd) 'dd - глобальный объект DirectDraw7

'Получаем DC картинки
hDCPicture = Win32.CreateCompatibleDC(ByVal 0&)
Win32.SelectObject hDCPicture, StorePic
'Переводим картинку на поверхность
Call dds.restore
hDCSurface = dds.GetDC 'Подготовка к прямому доступу к поверхности
Call Win32.StretchBlt(hDCSurface, 0, 0, Bmp.bmWidth, Bmp.bmHeight, hDCPicture, 0, 0, Bmp.bmWidth, Bmp.bmHeight, SRCCOPY) 'Это копирует картинку в буфер
Call dds.ReleaseDC(hDCSurface) 'Конец прямого доступа к поверхности
Call Win32.DeleteDC(hDCPicture) 'Уничтожить объект картинки - больше не нужен

'Устанавливаем ключевой цвет
ddCK.low = RGB(BColor.Red, BColor.Green, BColor.Blue) 'Работает правильно только в 24-битном цвете (Но для случая 0 пойдет)
ddCK.high = ddCK.low
Call dds.SetColorKey(DDCKEY_SRCBLT, ddCK)
'Возвращаем объект
Set LoadPic = dds
'Set dds = Nothing
End Function

5. Для смены картинок лучше предварительно создать несколько Surfaces и затем блитировать каждую из них в нужное время.

[petroff]

Спасибо за ценый совет .... становится ясна картина...седгодня буду пробывать ..Сдается мне что дело имено в очистке буфера.....

Я не знаю но я не хотел использовать функции win32.... хотел разобратся во всем сам...


Цикличность flip у меня должна проходить по таймеру ...

Большое спасибо за совет


Буду пробывать.....

[petroff]

Вот ..блин не помогло ...добавил я clearbufer и все равно все тоже .Картинка рисуется а передвинутся не может
Вот полный пример прикрепил может кто у себя запустит, и обяснит мне мою ошибку .....

[Yurich]

Вот, работающий код:

Option Explicit

Dim dx As New DirectX7 'объявляем об использовании DirectX7
Dim dd As DirectDraw7 'объявляем об использовании DirectDraw7.
Dim Primary As DirectDrawSurface7
Dim Back As DirectDrawSurface7
Dim rcRect As RECT 'тип данных, задающий позицию спрайта

Dim x As Long
Dim y As Long

Dim dxSprite As Long
Dim dySprite As Long

Dim Intro As DirectDrawSurface7
Dim Sprites As DirectDrawSurface7

Dim ddsd1 As DDSURFACEDESC2
Dim ddsd2 As DDSURFACEDESC2
Dim caps As DDSCAPS2

Dim Running As Boolean

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

Private Sub Form_Load()
Timer1.Enabled = False ' это лучше сразу установить в окне свойств
Set dd = dx.DirectDrawCreate("")
Me.Show
Call dd.SetCooperativeLevel(Me.hWnd, DDSCL_FULLSCREEN Or DDSCL_EXCLUSIVE)
Call dd.SetDisplayMode(640, 480, 16, 0, DDSDM_DEFAULT)
ddsd1.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
ddsd1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
ddsd1.lBackBufferCount = 1
Set Primary = dd.CreateSurface(ddsd1)
caps.lCaps = DDSCAPS_BACKBUFFER
Set Back = Primary.GetAttachedSurface(caps)
ddsd2.lFlags = DDSD_CAPS
ddsd2.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
Set Intro = dd.CreateSurfaceFromFile(App.Path & "\b.bmp", ddsd2)
ddsd2.lHeight = 32
ddsd2.lWidth = 32
Set Sprites = dd.CreateSurfaceFromFile(App.Path & "\s.bmp ", ddsd2)
Dim key As DDCOLORKEY
key.low = 0
key.high = 0
Sprites.SetColorKey DDCKEY_SRCBLT, key

x = 100
y = 100
dxSprite = 5
dySprite = 5

Running = True
Timer1.Enabled = True


Do While Running
DoEvents ' будем жалостливы к системе
ClearrBuffer
UpdateBack
UpdateObject
Primary.Flip Back, DDFLIP_WAIT
Loop

Timer1.Enabled = False
Call dd.RestoreDisplayMode
Call dd.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL)
Set Back = Nothing
Set Primary = Nothing
Set dd = Nothing
End


End Sub
Sub UpdateBack()
With rcRect
.Left = 0
.Top = 0
.Right = 640
.Bottom = 480
End With
Call Back.BltFast(0, 0, Intro, rcRect, DDBLTFAST_NOCOLORKEY Or DDBLTFAST_WAIT)
End Sub

Sub UpdateObject()
With rcRect
.Left = 0
.Top = 0
.Right = 30
.Bottom = 30
End With

Back.BltFast x, y, Sprites, rcRect, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT

' вывод текста

Back.SetForeColor RGB(255, 255, 255)
Back.SetFontTransparency True
Back.DrawText x + 30, y - 30, "This is Sprite", False

End Sub

Private Sub Timer1_Timer()
If x < 100 Or x > 540 Then dxSprite = -dxSprite
If y < 100 Or y > 380 Then dySprite = -dySprite
x = x + dxSprite
y = y + dySprite
End Sub

Public Sub ClearrBuffer()
Dim ddsdStore As DDSURFACEDESC2 'Вспомогательная структура описания
Back.GetSurfaceDesc ddsdStore 'Получить описание очищаемой поверхности
'Заполняем структуру RECT, так, чтобы она охватывала всю поверхность
With rcRect
.Top = 0
.Left = 0
.Right = ddsdStore.lWidth 'Вот зачем нам надо было описание поверхности
.Bottom = ddsdStore.lHeight 'Высота и ширина подгоняются под нее
End With
' Заполняем цветом область, указанную в RECT
Back.BltColorFill rcRect, RGB(0, 0, 0)
End Sub

[petroff]

УРа ...Круто !!!! Все зароботало .... а главное я понял свою ошибку ...не обявил перемены x и y
Не думал что это на столько важно ....
Все тема закрыта ...Огромное спасибо Yurich ' у

P.s Я пробовал запускать без очистки back буфер, и результат тотже..... Нужно ли его очишать каждый раз перед обновлением картинки ?

[Yurich]

Результ тот-же, т.к. основная картинка закрывает весь экран и ложится на него первой. Установи режим 800х600

Call dd.SetDisplayMode(800, 600, 16, 0, DDSDM_DEFAULT)

и увидишь в чем разница.
Ошибок было много, но главная ошибка не в переменных Х и У. Как я уже писал, ты не обеспечил цикл рендеринга в Form_Load:

Sub Form_Load()
Настройка DX
Загрузка картинок
Флип первого кадра ...
... И ВСЕ, тут программа стопорится!
End Sub
Ни таймер, ни клава, вообще ничего после End Sub работать не будет!

Поясни мне-деду, как класть проект на форум (у меня ни-фига не получамши). При попытке вставить приложение выдается "Страница не доступна". Может в настройках Explorer-a че-то не так?

[petroff]

Ага ...понятно .

.......Поясни мне-деду, как класть проект на форум (у меня ни-фига не получамши). При попытке вставить приложение выдается "Страница не доступна". Может в настройках Explorer-a че-то не так?..........

Та че там вроде все просто ..нажал на "добавить приложение " потом "обзор"...да там вроде все описанно .... может у тя ехплоер .. я то под оперой сижу