Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: Juan Luis López en Mayo 08, 2011, 01:18:14 pm
-
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
-
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
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)
ImgWidth = Me.ScaleX(oImage.Width, vbHimetric, vbPixels)
ImgHeight = Me.ScaleY(oImage.Height, vbHimetric, vbPixels)
si quere hacerlo con apis podes utilizar este otro
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:
(http://infrangelux.sytes.net/FileX/down.php?InfraDown=/14.bmp)
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
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
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.
-
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)
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