Solved

DDraw/VB image conversion

Posted on 2000-04-12
14
319 Views
Last Modified: 2007-10-18
I am using a DirectDraw Type library and I am not sure on how to convert a picture from an image control to a form that I can use to blit to the back buffer. I seriously need help.
0
Comment
Question by:frogman_j
  • 4
  • 4
  • 3
  • +1
14 Comments
 
LVL 2

Expert Comment

by:Crin
ID: 2707617
What do you mean by DirectDraw Type library?

Do you mean standard Image control?

If so, Me.Picture = Me.Image1.Picture works fine...

Please specify problem more detailed.

Sincerely yours,

Crin

PS. Sorry, english is not my native...
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 2707644
Why so many points? 200 is the standard rate for a difficult question. 400 perhaps for something that is excruciatingly hard to crack. But 1200 is just frivolous...
0
 
LVL 2

Expert Comment

by:Crin
ID: 2707689
Agree with caraf_g...
Is your problem REALLY so serious (for example, you need release software within nearest 20 minutes?  :))

Sincerely yours,

Crin
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 2707840
True, but what's more important, you'll probably get optimal help for a 400 pointer... put in a 1200 pointer and you'll be attracting the chancers who are hoping to get away with half-baked answers ;-)
0
 
LVL 2

Expert Comment

by:Crin
ID: 2707894
Seems to be just a typo... think this is 12 pts question... 120 - if trouble is really serious :)))

Crin
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 2707958
<g>
0
 
LVL 32

Accepted Solution

by:
Erick37 earned 1200 total points
ID: 2708223
Here is some code modified from the example program available at:
http://www.vbonline.com/vb-mag/9811/article/directdraw.htm

In order to use BltFast, the picture must be copied to a DirectDrawSurface.  The function CreateDDSFromBitmap shows how to do this.  The original code loaded the picture from a file, but I modified it to get the picture from an Image control.  The picture is tiled, so each loop BltFasts a different portion of the picture, giving an animation effect.

Once you have the picture as an IDirectDrawSurface (lpDDSPic), use this code to copy it to the backbuffer (Declared as Dim lpDDSBack As IDirectDrawSurface):

Call lpDDSBack.BltFast(x, y, lpDDSPic, rc, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)

Here is the full code:

Option Explicit

' DirectDraw Stuff
' If you referenced the Patrice Scribe's
' TLB and you get an error, try changing the variable
' to DirectDrawxxxxx instead of IDirectDrawxxxx
Dim lpDD As IDirectDraw
Dim lpDDSFront As IDirectDrawSurface
Dim lpDDSBack  As IDirectDrawSurface
Dim lpDDSPic   As IDirectDrawSurface

' Some other vars
Dim bEnd As Boolean ' True  = App is ending
Dim x As Long, y As Long

' API Declarations
' Win32
Const IMAGE_BITMAP = 0
Const LR_LOADFROMFILE = &H10
Const LR_CREATEDIBSECTION = &H2000
Const SRCCOPY = &HCC0020

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

' GDI32
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
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

' USER32
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

' Loads a bitmap in a DirectDraw surface used for BltFast
Public Function CreateDDSFromBitmap(dd As IDirectDraw, img As Image) As IDirectDrawSurface
    Dim hbm As Long ' Handle on bitmap
    Dim bm As BITMAP ' Bitmap header
    Dim ddsd As DDSURFACEDESC ' Surface description
    Dim dds As IDirectDrawSurface ' Created surface
    Dim hdcImage As Long ' Handle on image
    Dim mhdc As Long ' Handle on surface context
   
    'Get picture handle
    hbm = img.Picture.handle
   
    ' Get bitmap info
    GetObject hbm, Len(bm), bm
    ' Fill surface description
    With ddsd
    .dwSize = Len(ddsd)
    .dwFlags = DDSD_CAPS + DDSD_HEIGHT + DDSD_WIDTH
    .DDSCAPS.dwCaps = DDSCAPS_OFFSCREENPLAIN
    .ddpfPixelFormat.dwSize = 8
    .dwWidth = bm.bmWidth
    .dwHeight = bm.bmHeight
    End With
   
    ' Create surface
    dd.CreateSurface ddsd, dds, Nothing
    ' Create memory device
    hdcImage = CreateCompatibleDC(ByVal 0&)
    ' Select the bitmap in this memory device
    SelectObject hdcImage, hbm
    ' Restore the surface
    dds.Restore
    ' Get the surface's DC
    dds.GetDC mhdc
    ' Copy from the memory device to the DirectDrawSurface
    StretchBlt mhdc, 0, 0, ddsd.dwWidth, ddsd.dwHeight, hdcImage, 0, 0, _
        bm.bmWidth, bm.bmHeight, SRCCOPY
    ' Release the surface's DC
    dds.ReleaseDC mhdc
    ' Release the memory device and the bitmap
    DeleteDC hdcImage
    ' Returns the new surface
    Set CreateDDSFromBitmap = dds
End Function

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyEscape 'Press ESC to exit
            bEnd = True
        Case vbKeyLeft ' Move the picture object left/right respectively
            x = x - 5
            If x < 0 Then x = 0
        Case vbKeyRight
            x = x + 5
            If x + 84 > 640 Then x = 640 - 84
        Case vbKeyUp
            y = y - 5
            If y < 0 Then y = 0
        Case vbKeyDown
            y = y + 5
            If y + 88 > 480 Then y = 480 - 88
    End Select
End Sub

Private Sub Form_Load()
    Dim ddsd As DDSURFACEDESC
    Dim ddc  As DDSCAPS
    Dim ddck As DDCOLORKEY
    Dim rc   As RECT
    Dim i    As Long

    ' Initialize DirectDraw
    Call DirectDrawCreate(ByVal 0&, lpDD, Nothing)
    Call lpDD.SetCooperativeLevel(Me.hwnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN Or DDSCL_ALLOWREBOOT)
    Call lpDD.SetDisplayMode(640, 480, 8)
   
    ' Create a front and a bitmap surfaces
    With ddsd
        .dwSize = Len(ddsd)
        .dwFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
        .DDSCAPS.dwCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
        .dwBackBufferCount = 1
    End With
    Call lpDD.CreateSurface(ddsd, lpDDSFront, Nothing)
   
    ' Retrieve the back buffer
    With ddc
        .dwCaps = DDSCAPS_BACKBUFFER
    End With
    Call lpDDSFront.GetAttachedSurface(ddc, lpDDSBack)
   
    ' Create a surface with image in picturebox
    Set lpDDSPic = CreateDDSFromBitmap(lpDD, Image1)
   
    ' Set the color key
    With ddck
        .dwColorSpaceHighValue = RGB(0, 0, 0)
        .dwColorSpaceLowValue = .dwColorSpaceHighValue
    End With
    Call lpDDSPic.SetColorKey(DDCKEY_SRCBLT, ddck)
   
    Me.Show
   
    ' Now, start blitting until the end
    While Not bEnd
        DoEvents ' be nice
       
        ' Clear the front buffer
        Call ClearBuffer(lpDDSBack)
       
        ' See what part of the composite picture we need to blt
        Select Case i
        Case 0
            rc.Left = 1
        Case 1
            rc.Left = 86
        Case 2
            rc.Left = 171
        Case 3
            rc.Left = 1
        Case 4
            rc.Left = 86
        Case 5
            rc.Left = 171
        End Select
        rc.Right = rc.Left + 84
       
        If i > 2 Then
            rc.Top = 90
        Else
            rc.Top = 1
        End If
       
        rc.Bottom = rc.Top + 88
       
        ' Copy the needed region
        Call lpDDSBack.BltFast(x, y, lpDDSPic, rc, _
            DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
       
        ' Wait for vertical blank to end
        Call WaitForVerticalBlank
       
        ' Copy the work area surface onto the front buffer
        Call lpDDSFront.Flip(Nothing, DDFLIP_WAIT)
       
        ' Synchronize to reasonable speed
        Call Sleep(80)
       
        ' Increment and see the i value
        i = i + 1
        If i > 5 Then i = 0
    Wend
   
    Unload Me
End Sub

' Clears the buffer
Sub ClearBuffer(ByRef lpDDS As IDirectDrawSurface)
Dim fx As DDBLTFX

    ' Fill out the blt operation description
    With fx
        .dwSize = Len(fx)
        .dwFillColor = RGB(0, 0, 0)
    End With
   
    ' Color fill the surface
    Call lpDDS.Blt(ByVal 0&, Nothing, ByVal 0&, DDBLT_WAIT Or DDBLT_COLORFILL, fx)
End Sub

' Copies a whole buffer onto another
Sub CopyBuffer(ByRef lpDDSSrc As IDirectDrawSurface, ByRef lpDDSDest As IDirectDrawSurface)
Dim ddsd As DDSURFACEDESC
Dim rc   As RECT

    ' Get the surface desc for the source surface
    With ddsd
        .dwSize = Len(ddsd)
        .dwFlags = DDSD_WIDTH Or DDSD_HEIGHT
    End With
    Call lpDDSSrc.GetSurfaceDesc(ddsd)
   
    ' Now, copy the whole source onto the dest buffer
    rc.Left = 0
    rc.Top = 0
    rc.Right = ddsd.dwWidth
    rc.Bottom = ddsd.dwHeight
   
    ' BltFast the surface
    Call lpDDSDest.BltFast(0, 0, lpDDSSrc, rc, DDBLTFAST_WAIT) ' Set this flag if that surface has a source key Or DDBLTFAST_SRCCOLORKEY)
End Sub

Sub WaitForVerticalBlank()
    ' This waits for the veritcal blank to end
    Call lpDD.WaitForVerticalBlank(DDWAITVB_BLOCKEND, 0)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call lpDD.RestoreDisplayMode
    Set lpDDSPic = Nothing
    Set lpDDSBack = Nothing
    Set lpDDSFront = Nothing
    Set lpDD = Nothing
End Sub
0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 

Author Comment

by:frogman_j
ID: 2708651
I was just frustrated because I don't have the experience with windows or directx, and don't know any where to learn windows(not MFC) programming. Oh, and the ddraw.tlb can be obtained at various places on the internet for you who don't know what I'm talking about.
0
 

Author Comment

by:frogman_j
ID: 2708656
I also have 1531 idle points and wanted to get the answer FAST!
0
 
LVL 32

Expert Comment

by:Erick37
ID: 2708675
Here is a generic function derived from the code above.  It takes a picture object and blt's it to the DirectDrawSurface passed to the function.

' Blt's a picture in a DirectDraw surface
Public Function CopyPicToDDS(dd As IDirectDraw, pic As StdPicture, dds As IDirectDrawSurface) As Long
    Dim hbm As Long ' Handle on bitmap
    Dim bm As BITMAP ' Bitmap header
    Dim ddsd As DDSURFACEDESC ' Surface description
    Dim hdcImage As Long ' Handle on image
    Dim mhdc As Long ' Handle on surface context
    Dim lRet As Long
     
    'Get picture handle
    hbm = pic.Handle
     
    ' Get bitmap info
    GetObject hbm, Len(bm), bm
    ' Fill surface description
    With ddsd
    .dwSize = Len(ddsd)
    .dwFlags = DDSD_CAPS + DDSD_HEIGHT + DDSD_WIDTH
    .DDSCAPS.dwCaps = DDSCAPS_OFFSCREENPLAIN
    .ddpfPixelFormat.dwSize = 8
    .dwWidth = bm.bmWidth
    .dwHeight = bm.bmHeight
    End With
     
    ' Create memory device
    hdcImage = CreateCompatibleDC(ByVal 0&)
    ' Select the bitmap in this memory device
    SelectObject hdcImage, hbm
    ' Restore the surface
    dds.Restore
    ' Get the surface's DC
    dds.GetDC mhdc
    ' Copy from the memory device to the DirectDrawSurface
    lRet = StretchBlt(mhdc, 0, 0, ddsd.dwWidth, ddsd.dwHeight, hdcImage, 0, 0, _
        bm.bmWidth, bm.bmHeight, SRCCOPY)
    ' Release the surface's DC
    dds.ReleaseDC mhdc
    ' Release the memory device and the bitmap
    DeleteDC hdcImage
    CopyPicToDDS = lRet 'return value of StretchBlt
   
End Function


The function can be called like this:

Call CopyPicToDDS(lpDD, Image1.Picture, lpDDSBack)

Where:
lpDDS is the IDirectDraw object
Image1.Picture is the picture object
lpDDSBack is the (Back) IDirectDrawSurface object

0
 
LVL 32

Expert Comment

by:Erick37
ID: 2708714
Actually, you can omit the first parameter (dd) as it is not used in this function.

BTW: this code references the DirectX5.tlb available at
http:\\www.chez.com\scribe
0
 

Author Comment

by:frogman_j
ID: 2709663
Erick37

Danke schön! I'm actually using a different typelib but the method you used should work anyway. I am actually doing this for a really lame ass VB class at school and I just wanted to make an awesome game, but I needed some info on DirectX. Thanks again. I like the first example better.

frogman_j
0
 

Author Comment

by:frogman_j
ID: 2709671
You Left out 2 things though:

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

0
 
LVL 32

Expert Comment

by:Erick37
ID: 2709725
Thanks!
Glad it helped.

I did not notice the missing declares at first, probably because I referenced the Win32.tlb; so the compiler did not complain.  When I ran the sample on my Win95 computer, it did catch the omissions.

Good luck on the game.
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now