Специалисты по VB и Delphi

[Odrick]

Хм... Наткнулся на одну замечательную статью, описывающую методы замены цветов по маске:
http://delphigfx.mastak.ru/2d/010/2d_10.htm
В конце приводиться пример по замене цветов на DirectX. Это все правда на Delphi... Насколько реально сделать то же на VB? Может кто-то помочь? Я в Delphi не силен...

[hCORe]

Там используется DelphiX. Это библиотека для "комфортной и удобной" работы с DirectX 7-8 под Delphi. Не думаю, что её можно использовать в VB. Так что ищи пример с использованием "родных" интерфейсов DX. Его-то можно будет почти что построчно перевести на VB (в теории, конечно.)

[Odrick]

Да вот нет больше таких примеров - все что нарыл... В принципе родной VB-шный PictureBox умеет такое делать. Если в него врисовывать цветной квадрат с помощью PaintPicture с параметром vbSrcAnd, то серый цвет на исходном рисунке корректно заменяется на этот цвет. Но вот как полученный рисунок с PictureBox'a на поверхность DirectDraw потом всунуть? Есть вроде один метод: GetSurfaceFromDC. Но как его правильно использовать, ума не приложу... Конструкция типа:
Set MySurface = dd.GetSurfaceFromDC(Picture1.hDC)
дает ошибку.
Может кто знает? Это было бы решением проблемы...

[hCORe]

Так и GDI-шные API (в частности, BitBlt) тоже умеют это делать! Рисование по маске с ними будет быстрее, чем с PaintPicture. Насчет GetSurfaceFromDC - даже не знаю, что ответить. Тупое решение: попробуй поставить у PictureBox AutoRedraw в True. Может поможет? О результатах сообщи.

[Odrick]

В общем вроде нашел как это делаеться:

Код: Выделить всё

Public Function GetPicFromDC(ByVal DC As Long, ByVal Width As Integer, ByVal Height As Integer) As DirectDrawSurface7
Dim Surf As DirectDrawSurface7, Desc As DDSURFACEDESC2
With Desc
   .lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT
   .ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
   .lWidth = Width
   .lHeight = Height
End With
Set Surf = DD.CreateSurface(Desc) 'Create a empty surface

'BitBlt the given DC to the surface
Dim SurfDC As Long
SurfDC = Surf.GetDC()
BitBlt SurfDC, 0, 0, Width, Height, DC, 0, 0, vbSrcCopy
Surf.ReleaseDC(SurfDC)

Set GetPicFromDC = Surf
End Function


еще не пробовал, но на первый взгляд все правильно и логично

[Odrick]

Хм, не работает, однако

[Odrick]

В общем все довольно просто получаеться. Даже проще, чем в статье описано. По большому счету нет смысла делать попиксельно наложение маски. Вся соль в том, что поверхность DirectDraw имееет DC, с которым можно работать стандартными апи-шными функциями. Вот я наваял такую элементарную функцийку:

Код: Выделить всё

Public Sub MergeSurfaces(Dest as DirectDrawSurface7, Source as DirectDrawSurface7, SourStartX as Integer, SourStartY as Integer, DestWidth as Integer, DestHeight as Integer, DestStartX as Integer, DesctStartY as Integer, Method as Long)
    Dim DC1 as Long
    Dim DC2 as Long

    DC1 = Dest.GetDC
    DC2 = Source.GetDC

    BitBlt DC1, DestStartX, DestStartY, DestWidth, DestHeight, DC2, SourStartX, SourStartY, Method

    Dest.ReleaseDC DC1
    Source.ReleaseDC DC2
End Sub


Потом вызываем эту функцию и подставляем первым парамертом исходную порхность с рисунком, вторым - поверхность со сплошной цветовой маской. Ну а дальше по тексту - координаты, ширина, высота и т.д. А последний парамерт - это самое интересное. Если подставить vbSrcCopy - произведется простое копирование (что иногда очччень полезно), если vbSrcAnd - как раз наше пресловутое сложение с маской. Проверил - работает на ура Може, правда где то с синтаксисом наглючил, но смысл тот