Necesito saber como se usan algunas apis GDI

[Juan Luis López]

Hola a todos!!!
Este es mi primer Post.
Estoy creando una libreriá de funciones para desarrollar juegos 2d en visual basic.
Todo funciona bien me faltan algunas cosas en el modulo de sonido y arreglar el tema de los sprites.
Bueno, la libreria usa gdi (es porke kiero usar gdi) y al copiar y dibujar bitmaps, me surgen algunas dudas.
la cosa es que copio el bitmap que he puesto en un control picturebox con bitblt o transparentblt. pero he visto que hay otras funciones para cargar un bitmap en la memoria (lo que seria mas rapido, el problema es que no entiendo muy bien como va el sistema.
Sé que necesito CreatecompatibleDC u createcompatibleBitmap y select object, pero no se como funcionan exactamente...
Puede alguien ayudarme y explicar como funcionan cada una y algun ejemplo?¿puedo cargar un bitmap en la memoria directamente de un archivo *.bmp?

Gracias

[LeandroA]

Hola no se cuanto mas rapido sea todo, pero seguramente vas a ganar un poco mas de rendimiento de la memoria al no usar pictureBox,

vamos a utilizar el LoadPicture de VB puede que LoadImage API sea un poco mas rapido y optimo pero despues lo vemos.

si vos queres obtener el hdc de un StdPicture tenes que hacer lo siguiente

Código: [Seleccionar]

Option Explicit
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GdiTransparentBlt Lib "gdi32.dll" (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 crTransparent As Long) As Boolean

Private Sub Form_Load()
    Dim oImage As StdPicture
    Dim lHDC As Long
    Dim ViejoBmp As Long
   
    Set oImage = LoadPicture("C:\Users\Windows\Desktop\14.bmp")  'leemos la imagen
    lHDC = CreateCompatibleDC(0&) 'Creamos un hdc en la memoria
    ViejoBmp = SelectObject(lHDC, oImage.Handle) 'le asignamos el Bitmap a nuestro hdc
   
    'pintamos en nuestro formulario la imagen (las dimenciones 50 son al azar)
    Me.AutoRedraw = True
    GdiTransparentBlt Me.hdc, 0, 0, 50, 50, lHDC, 0, 0, 50, 50, vbMagenta

   
    SelectObject lHDC, ViejoBmp 'Restauramos el antiguo BMP al dc
    DeleteDC lHDC 'Destruimos el hdc
End Sub

para trabajar de esta manera vas a tener que tener las medidas en Pixel de la imagen
un metodo si trabajas dentro de un formulario (no te va a servir desde un modulo clase)

Código: [Seleccionar]

    ImgWidth = Me.ScaleX(oImage.Width, vbHimetric, vbPixels)
    ImgHeight = Me.ScaleY(oImage.Height, vbHimetric, vbPixels)
si quere hacerlo con apis podes utilizar este otro

Código: [Seleccionar]

Private Declare Function ApiGetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

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

'----------------------Esto va en alguna rutina
    Dim tBMP As BITMAP
    ApiGetObject oImage, Len(tBMP), tBMP
   
    ImgWidth = tBMP.bmWidth
    ImgHeight = tBMP.bmHeight

bien eso es todo ahora te muestro un ejemplo de como pintar un sprite donde las medidas de las imagenes son todas iguales
Ejemplo:


crea un proyecto nuevo agrega un modulo clase "Class1" y guarda esa imagen en el mismo directorio del proyecto, y en un formulario un timer1

Modulo Clase

Código: [Seleccionar]

Option Explicit
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function GdiTransparentBlt Lib "gdi32.dll" (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 crTransparent As Long) As Boolean
Private Declare Function ApiGetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

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

Private m_oBitmap As StdPicture
Private m_Width As Long
Private m_Height As Long
Private m_RowCount As Long
Private m_ColumCount As Long
Private m_CellsWidth As Long
Private m_CellsHeight As Long
Private m_SrcHDC As Long
Private m_MaskColor As OLE_COLOR
Private m_OldBMP As Long

Public Property Let Image(oBitmap As StdPicture)
    Dim tBMP As BITMAP

    If Not oBitmap Is Nothing Then
        Set m_oBitmap = oBitmap
   
        If m_SrcHDC <> 0 Then ClearMem
   
        m_SrcHDC = CreateCompatibleDC(0)
        m_OldBMP = SelectObject(m_SrcHDC, m_oBitmap.Handle)
   
        ApiGetObject oBitmap.Handle, Len(tBMP), tBMP
       
        m_Width = tBMP.bmWidth
        m_Height = tBMP.bmHeight
       
        m_CellsWidth = m_Width \ m_ColumCount
        m_CellsHeight = m_Height \ m_RowCount
    End If

End Property

Private Sub ClearMem()
    SelectObject m_SrcHDC, m_OldBMP
    DeleteDC m_SrcHDC
    m_SrcHDC = 0
End Sub

Public Property Let Row(ByVal RowNum As Long)
    m_RowCount = RowNum
End Property

Public Property Let Colum(ByVal ColumNum As Long)
    m_ColumCount = ColumNum
End Property

Public Property Let TransparentColor(ByVal Color As OLE_COLOR)
    m_MaskColor = Color
End Property

Public Function Render(ByVal hdc As Long, ByVal CellNum As Long, ByVal x As Long, ByVal y As Long) As Boolean
    Dim lLeft As Long, lTop As Long
     
    lLeft = (CellNum Mod m_ColumCount) * m_CellsWidth
    lTop = ((CellNum) \ m_ColumCount) * m_CellsHeight

    Render = GdiTransparentBlt(hdc, x, y, m_CellsWidth, m_CellsHeight, m_SrcHDC, lLeft, lTop, m_CellsWidth, m_CellsHeight, m_MaskColor)

End Function

Private Sub Class_Terminate()
    If m_SrcHDC <> 0 Then ClearMem
End Sub

En el formulario

Código: [Seleccionar]

Option Explicit

Private cRender As Class1
Private Frame As Long

Private Sub Form_Load()
    Set cRender = New Class1
    With cRender
        .Colum = 6
        .Row = 5
        .TransparentColor = vbMagenta
        .Image = LoadPicture(App.Path & "\14.bmp")
    End With
    Timer1.Interval = 100
End Sub

Private Sub Timer1_Timer()
    Me.Cls
    cRender.Render Me.hdc, Frame, 10, 10
    Frame = Frame + 1
    If Frame = 29 Then Frame = 0
End Sub

bien como te decia el sprite tiene todas imagenes iguales en secuencia ahora si vas a utilizar un sprite con todas imagenes de distinto tamaño tenes que crear tu propio sistema de cordenadas para cada fragmento.

Saludos.

[Juan Luis López]

Entonces lo que hago es crear un compatibleDC y con select object asigno la imagen a ese hdc?
Luegos cojo las coordenadas y medidas de mi nuevo hdc (el de la memoria) y dibujo en un form.
eso es lo que entiendo.

Luego la clase de sprites... puedo crear mas instancias de la clase para usar varios sprites?

Este es el modulo de graficos que tengo hecho (sin modificaciones)
Me sirve para ahorrarme el picturebox en el proyecto gracias.

Ahora tengo que investigar lo de los sprites porque no lo entendi muy bien.

por cierto qué tipo de variables es un stdPicture?

Gracias por tu ayuda.

Aquí el módulo a ver que se puede mejorar (mañana cambiaré lo del picturebox)

Código: [Seleccionar]

Option Explicit
'API's para dibujar
Public Declare Function TransparentBlt Lib "msimg32.dll" (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 crTransparent As Long) As Boolean
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
'API's para ventanas
Public Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Const HWND_TOPMOST = -1
Const SWP_SHOWWINDOW = &H40
 
Public MyScreenWidth As Long
Public MyScreenHeight As Long
 
Public GDKBitmaps() As Bitmap 'Matriz donde se guardan los bitmaps del juego
 
Public Type Bitmap
    Handle As Long
    SourceX As Long
    SourceY As Long
    SourceWidth As Long
    SourceHeight As Long
End Type
 
'Variables globales
Public MyScreen                                  'Variable que guarda el objeto empleado como pantalla
Public MyBitmapsSource As Picturebox  'Variable que guarda el objeto empleado como recurso de bitmaps
Public MyScreenHDC As Long              'Variable que guarda el HDC del objeto empleado como pantalla
Public MyBitmapsSourceHDC As Long  'Variable que guarda el HDC del objeto que contiene los bitmaps
'********************************************************************************
'*************** Grupo de funciones para inicializar elementos ***************************
'********************************************************************************
 
'//Establece como pantalla del juego un objeto PictureBox
Public Sub SetScreenFromPictureBox(Picturebox As Picturebox)
Picturebox.ScaleMode = vbPixels
Picturebox.AutoRedraw = True
Picturebox.BackColor = vbBlack
Set MyScreen = Picturebox
End Sub
'//Establece como pantalla del juego un objeto Form
Public Sub SetScreenFromForm(Form As Form)
Form.ScaleMode = vbPixels
Form.AutoRedraw = True
Form.BackColor = vbBlack
Set MyScreen = Form
End Sub
'//Establece como recurso de Bitmaps un objeto PictureBox
Public Sub SetBitmapsSource(Picturebox As Picturebox)
Picturebox.ScaleMode = vbPixels
Picturebox.AutoRedraw = True
Picturebox.BackColor = vbRed
Picturebox.AutoSize = True
Picturebox.BorderStyle = 0
MyBitmapsSourceHDC = Picturebox.hdc
Set MyBitmapsSource = Picturebox
End Sub
'//Establece la altura y anchura en pixels de una ventana
Public Sub SetWindowSize(Window As Form, Width As Long, Height As Long)
SetWindowPos Window.hWnd, 0, 0, 0, Width, Height, SWP_SHOWWINDOW
Window.Left = (Screen.Width / 2) - (Window.Width / 2)
Window.Top = (Screen.Height / 2) - (Window.Height / 2)
Window.ScaleMode = vbPixels
MyScreenWidth = Width
MyScreenHeight = Height
End Sub
'//Establece el título de una ventana
Public Sub SetWindowTitle(Window As Form, Title As String)
SetWindowText Window.hWnd, Title
Window.ScaleMode = vbPixels
End Sub
 
 
'********************************************************************************
'*************** Grupo de funciones para dibujar bitmaps ******************************
'********************************************************************************
'//Dibuja un bitmap en la posicion (x,y) de la pantalla con una ampliacion de (Zoom) tomando como transparente el color (TransparentColor)
Public Sub ZoomPutBitmap(Fx As Long, Fy As Long, Fwidth As Long, Fheight As Long, Zoom As Integer, X As Long, Y As Long, TransparentColor As Long)
MyScreenHDC = MyScreen.hdc
TransparentBlt MyScreenHDC, X, Y, Fwidth * Zoom, Fheight * Zoom, MyBitmapsSourceHDC, Fx, Fy, Fwidth, Fheight, TransparentColor
End Sub
'//Dibuja un bitmap en la posicion (x,y) de la pantalla cambiando su anchura y altura tomando como transparente el color (TransparentColor)
Public Sub PutBitmapElastic(Fx As Long, Fy As Long, Fwidth As Long, Fheight As Long, NewWidth As Long, NewHeight As Long, X As Long, Y As Long, TransparentColor As Long)
MyScreenHDC = MyScreen.hdc
TransparentBlt MyScreenHDC, X, Y, NewWidth, NewHeight, MyBitmapsSourceHDC, Fx, Fy, Fwidth, Fheight, TransparentColor
End Sub
'//Dibuja un bitmap en la posicion (x,y) de la pantalla tomando como transparente el color (TransparentColor)
Public Sub PutBitmap(Fx As Long, Fy As Long, Fwidth As Long, Fheight As Long, X As Long, Y As Long, TransparentColor As Long)
MyScreenHDC = MyScreen.hdc
TransparentBlt MyScreenHDC, X, Y, Fwidth, Fheight, MyBitmapsSourceHDC, Fx, Fy, Fwidth, Fheight, TransparentColor
End Sub
'//Carga en la matriz GDKBitmaps un bitmap especifico
Public Sub LoadBitmap(Handle As Long, SourceX As Long, SourceY As Long, SourceWidth As Long, SourceHeight As Long)
        ReDim Preserve GDKBitmaps(0 To Handle)
        GDKBitmaps(Handle).Handle = Handle
        GDKBitmaps(Handle).SourceX = SourceX
        GDKBitmaps(Handle).SourceY = SourceY
        GDKBitmaps(Handle).SourceWidth = SourceWidth
        GDKBitmaps(Handle).SourceHeight = SourceHeight
        'Recargar el bitmap vacio
        GDKBitmaps(0).Handle = 0
        GDKBitmaps(0).SourceX = 0
        GDKBitmaps(0).SourceY = 0
        GDKBitmaps(0).SourceWidth = 0
        GDKBitmaps(0).SourceHeight = 0
End Sub
'//Coloca un bitmap sin dibujo a un objeto. Se emplea a la hora de borrar un objeto
Public Sub PutEmptyBitmap(Solid As Solid)
Solid.Bitmap = 0
End Sub
'//Dibuja un bitmap que esta guardado en la matriz GDKBitmaps pasandole el handle, en la posicion (X,Y)
Public Sub PutBitmapFromHandle(Handle As Long, X As Long, Y As Long, TransparentColor As Long)
MyScreenHDC = MyScreen.hdc
TransparentBlt MyScreenHDC, X, Y, GDKBitmaps(Handle).SourceWidth, GDKBitmaps(Handle).SourceHeight, MyBitmapsSourceHDC, GDKBitmaps(Handle).SourceX, GDKBitmaps(Handle).SourceY, GDKBitmaps(Handle).SourceWidth, GDKBitmaps(Handle).SourceHeight, TransparentColor
End Sub
'//Carga un bitmap al objeto empleado como recurso de bitmaps
Public Sub LoadBitmapFromFile(BitmapFile As String)
MyBitmapsSource.Picture = LoadPicture(BitmapFile)
MyBitmapsSourceHDC = MyBitmapsSource.hdc
End Sub
'//Carga un bitmap al objeto empleado como pantalla para fondo
Public Sub LoadBitmapForBackground(BitmapFile As String)
MyScreen.Picture = LoadPicture(BitmapFile)
MyScreenHDC = MyScreen.hdc
End Sub
'//Se emplea para ver los bitmaps dibujados una vez establecidos con ZoomPutBitmap, PutBitmapElastic o PutBitmap
Public Sub SeeScreen()
MyScreen.Refresh
End Sub
'//Se emplea para limpiar la pantalla antes de actualizarla con mas bitmaps
Public Sub ClearScreen()
MyScreen.Cls
End Sub