Home
.Todo en el CLIENTE:
Reemplazamos El módulo "DrawPjEnPicture" por:
- Código: Seleccionar todo
Sub DibujaPJ(Grh As Grh, ByVal x As Integer, ByVal y As Integer, Index As Integer)
On Error Resume Next
Dim iGrhIndex As Integer
If Grh.grhindex <= 0 Then Exit Sub
iGrhIndex = GrhData(Grh.grhindex).Frames(Grh.FrameCounter)
Call engine.GrhRenderToHdc(iGrhIndex, frmCuent.PJ(Index).hdc, x, y, True)
frmCuent.PJ(Index).Refresh
End Sub
Sub dibujamuerto(Index As Integer)
End Sub
Sub DibujarTodo(ByVal Index As Integer, Body As Integer, Head As Integer, Casco As Integer, Shield As Integer, Weapon As Integer, Baned As Integer, nombre As String, LVL As Integer, Clase As String, Muerto As Integer)
Dim Grh As Grh
Dim Pos As Integer
Dim loopc As Integer
Dim YBody As Integer
Dim YYY As Integer
Dim XBody As Integer
Dim BBody As Integer
frmCuent.nombre(Index).Caption = nombre
frmCuent.Label1(Index).font = frmMain.font
frmCuent.Label1(Index).font = frmMain.font
frmCuent.Label1(Index).Caption = LVL
frmCuent.Label2(Index).Caption = Clase
XBody = 12
YBody = 15
BBody = 17
If Muerto = 1 Then
Body = 8
Head = 500
Arma = 2
Shield = 2
Weapon = 2
XBody = 10
YBody = 35
BBody = 16
Call dibujamuerto(Index)
End If
Grh = BodyData(Body).Walk(3)
Call DibujaPJ(Grh, XBody, YBody, Index)
If Muerto = 0 Then YYY = BodyData(Body).HeadOffset.y
If Muerto = 1 Then YYY = -9
Pos = YYY + GrhData(GrhData(Grh.grhindex).Frames(Grh.FrameCounter)).pixelHeight
Grh = HeadData(Head).Head(3)
Call DibujaPJ(Grh, BBody, Pos, Index)
If Casco <> 2 And Casco > 0 Then
Call DibujaPJ(CascoAnimData(Casco).Head(3), BBody, Pos, Index)
End If
If Weapon <> 2 And Weapon > 0 Then
Call DibujaPJ(WeaponAnimData(Weapon).WeaponWalk(3), XBody, BBody, Index)
End If
If Shield <> 2 And Shield > 0 Then
Call DibujaPJ(ShieldAnimData(Shield).ShieldWalk(3), XBody, BBody, Index)
End If
End Sub
Buscamos Sub Grh_Render y antes del End Sub agregamos:
- Código: Seleccionar todo
Public Sub GrhRenderToHdc(ByVal grh_index As Long, desthDC As Long, ByVal screen_x As Integer, ByVal screen_y As Integer, Optional transparent As Boolean = False)
Dim file_path As String
Dim src_x As Integer
Dim src_y As Integer
Dim src_width As Integer
Dim src_height As Integer
Dim hdcsrc As Long
Dim MaskDC As Long
Dim PrevObj As Long
Dim PrevObj2 As Long
If grh_index <= 0 Then Exit Sub
'If it's animated switch grh_index to first frame
If GrhData(grh_index).NumFrames <> 1 Then
grh_index = GrhData(grh_index).Frames(1)
End If
file_path = DirGraficos & GrhData(grh_index).FileNum & ".bmp"
src_x = GrhData(grh_index).sX
src_y = GrhData(grh_index).sY
src_width = GrhData(grh_index).pixelWidth
src_height = GrhData(grh_index).pixelHeight
hdcsrc = CreateCompatibleDC(desthDC)
PrevObj = SelectObject(hdcsrc, LoadPicture(file_path))
If transparent = False Then
BitBlt desthDC, screen_x, screen_y, src_width, src_height, hdcsrc, src_x, src_y, vbSrcCopy
Else
MaskDC = CreateCompatibleDC(desthDC)
PrevObj2 = SelectObject(MaskDC, LoadPicture(file_path))
Grh_Create_Mask hdcsrc, MaskDC, src_x, src_y, src_width, src_height
'Render tranparently
BitBlt desthDC, screen_x, screen_y, src_width, src_height, MaskDC, src_x, src_y, vbSrcAnd
BitBlt desthDC, screen_x, screen_y, src_width, src_height, hdcsrc, src_x, src_y, vbSrcPaint
Call DeleteObject(SelectObject(MaskDC, PrevObj2))
DeleteDC MaskDC
End If
Call DeleteObject(SelectObject(hdcsrc, PrevObj))
DeleteDC hdcsrc
Exit Sub
End Sub
Private Sub Grh_Create_Mask(ByRef hdcsrc As Long, ByRef MaskDC As Long, ByVal src_x As Integer, ByVal src_y As Integer, ByVal src_width As Integer, ByVal src_height As Integer)
Dim X As Integer
Dim Y As Integer
Dim TransColor As Long
Dim ColorKey As String
ColorKey = "0"
TransColor = &H0
'Make it a mask (set background to black and foreground to white)
'And set the sprite's background white
For Y = src_y To src_height + src_y
For X = src_x To src_width + src_x
If GetPixel(hdcsrc, X, Y) = TransColor Then
SetPixel MaskDC, X, Y, vbWhite
SetPixel hdcsrc, X, Y, vbBlack
Else
SetPixel MaskDC, X, Y, vbBlack
End If
Next X
Next Y
End Sub
por último, al final del Mod_General, agregamos:
- Código: Seleccionar todo
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
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
'Added by Juan Martín Sotuyo Dodero
Public Declare Function StretchBlt 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As
Es probable qe sea compatible solo con X tipo de sistema de cuentas, está en ustedes adaptarlo al que usen, el código que posteo es para el sistema estándar
