Comercio en dx8

por santi55 Jue Dic 23, 2010 12:25 pm

aca clickeas y te da el item, y cuando pasas el mause por el item te dice la info
bueno, para mi es mejor ponerle una imagen atras, pero para eso hay q indexar y ahora no tengo ganas de eso

empesamos

Modulo:

Código:: Sub RenderComercio() Dim i, X, Y As Integer Dim GrhInventorioUser(1 To 25) As grh Dim GrhInventarioOtro(1 To 25) As grh Dim Blanco(3) As Long Dim Rojo(3) As Long Blanco(0) = D3DColorXRGB(255, 255, 255) Blanco(1) = D3DColorXRGB(255, 255, 255) Blanco(2) = D3DColorXRGB(255, 255, 255) Blanco(3) = D3DColorXRGB(255, 255, 255) Rojo(0) = D3DColorXRGB(170, 0, 0) Rojo(1) = D3DColorXRGB(170, 0, 0) Rojo(2) = D3DColorXRGB(170, 0, 0) Rojo(3) = D3DColorXRGB(170, 0, 0) For i = 1 To 25 InitGrh GrhInventorioUser(i), UserInventory(i).grhindex InitGrh GrhInventarioOtro(i), OtherInventory(i).grhindex Next i = 0 For Y = 1 To 5 For X = 1 To 5 i = i + 1 If UserInventory(i).Amount <> 0 Then DDrawGrhtoSurface GrhInventorioUser(i), 32 * X + (5 * 32) + 96, 32 * Y + 64, False, 0, Blanco(), 0, False Text_Render font_list(1), UserInventory(i).Amount, 32 * Y + 64, 32 * X + (5 * 32) + 96, 32, 32, ARGB(255, 255, 255, 200), DT_TOP Or DT_LEFT, True End If If OtherInventory(i).grhindex <> 0 Then If OtherInventory(i).PuedeUsar <> 0 Then DDrawGrhtoSurface GrhInventarioOtro(i), 32 * X + 32, 32 * Y + 64, False, 0, Rojo() Else DDrawGrhtoSurface GrhInventarioOtro(i), 32 * X + 32, 32 * Y + 64, False, 0, Blanco() End If Text_Render font_list(1), OtherInventory(i).Amount, 32 * Y + 64, 32 * X + 32, 32, 32, ARGB(255, 255, 255, 200), DT_TOP Or DT_LEFT, True End If Text_Render font_list(1), UserGLD, 32 * 5 + 64, 32 * 5 + 64, 32, 32, ARGB(120, 255, 120, 200), DT_TOP Or DT_LEFT, True Next X, Y End Sub 'Sub DibujarNombreMapa() ' If NombreMapaEspera > 0 Then NombreMapaEspera = NombreMapaEspera - (timerTicksPerFrame * 4) ' If NombreMapaEspera <= 0 Then ' Alphal = Alphal - (timerTicksPerFrame * 6) ' If Alphal < 1 Then Alphal = 0 ' End If 'Text_Render font_list(2), NombreDelMapaActual, 20, 20, 600, 400, D3DColorARGB(Val(Alphal), 255, 255, 255), DT_TOP Or DT_LEFT, False, Val(Alphal) 'End Sub Function QueCuadro(xl As Integer, yl As Integer) As Byte If (xl >= (32 * 1) + (5 * 32) + 96) And (xl <= (32 * 5) + (6 * 32) + 96) And (yl >= (32 * 1) + 64) And (yl <= (32 * 5) + 64) Then QueCuadro = 1 ElseIf (xl >= 32 * 1 + 32) And (xl <= 32 * 6 + 32) And (yl >= (32 * 1) + 64) And (yl <= (32 * 5) + 64) Then QueCuadro = 2 End If End Function Function Queitem(px As Integer, py As Integer) Dim X As Byte, Y As Byte, i As Byte, b As Byte b = QueCuadro(px, py) i = 0 Select Case b Case 1 px = (px - (5 * 32) - 96) \ 32 py = (py - 64) \ 32 Case 2 px = (px - 32 - 16) / 32 py = (py - 64 - 16) / 32 Case Else Exit Function End Select For Y = 1 To 5 For X = 1 To 5 i = i + 1 If X = px And Y = py Then Queitem = i: Exit Function Next X, Y End Function Sub ImputComercio(px As Integer, py As Integer) If py > 300 Then SendData "FINCOM" Exit Sub End If Dim b As Byte Dim ti As Byte b = QueCuadro(px, py) ti = Queitem(px, py) If b = 0 Or ti > 25 Or ti < 1 Then Exit Sub coso ti, b End Sub Sub DibujarInfoComercio(px As Integer, py As Integer) Dim b As Byte Dim ti As Byte b = QueCuadro(px, py) ti = Queitem(px, py) If b = 0 Or ti = 0 Then Exit Sub Select Case b Case 2 'tipos de armas. '2 = Golpe '3 = defensa '11 = modificador '24 = hechiso Text_Render font_list(1), OtherInventory(ti).Name, frmMain.MouseY, frmMain.MouseX + 10, 300, 300, ARGB(255, 255, 255, 255), DT_TOP Or DT_LEFT, True Select Case OtherInventory(ti).ObjType Case 2: Text_Render font_list(1), "Hit: " & OtherInventory(ti).MinHit & "/" & OtherInventory(ti).MaxHit, frmMain.MouseY + 10, frmMain.MouseX + 10, 300, 300, ARGB(255, 255, 255, 255), DT_TOP Or DT_LEFT, True Case 3: Text_Render font_list(1), "Def: " & OtherInventory(ti).MinDef & "/" & OtherInventory(ti).MaxDef, frmMain.MouseY + 10, frmMain.MouseX + 10, 300, 300, ARGB(255, 255, 255, 255), DT_TOP Or DT_LEFT, True Case 11: Text_Render font_list(1), "Mod: " & OtherInventory(ti).MinModificador & "/" & OtherInventory(ti).MaxModificador, frmMain.MouseY + 10, frmMain.MouseX + 10, 300, 300, ARGB(255, 255, 255, 255), DT_TOP Or DT_LEFT, True Case 24: Text_Render font_list(1), "- Hechizo-", frmMain.MouseY + 10, frmMain.MouseX + 10, 300, 300, ARGB(255, 255, 255, 255), DT_TOP Or DT_LEFT, True End Select Text_Render font_list(1), "Precio: " & OtherInventory(ti).Valor, frmMain.MouseY + 20, frmMain.MouseX + 10, 300, 300, ARGB(255, 255, 0, 255), DT_TOP Or DT_LEFT, True Case 1 Text_Render font_list(1), UserInventory(ti).Name, frmMain.MouseY, frmMain.MouseX + 10, 300, 300, ARGB(255, 255, 255, 255), DT_TOP Or DT_LEFT, True Select Case UserInventory(ti).ObjType Case 2: Text_Render font_list(1), "Hit: " & UserInventory(ti).MinHit & "/" & UserInventory(ti).MaxHit, frmMain.MouseY + 10, frmMain.MouseX + 10, 300, 300, ARGB(255, 255, 255, 255), DT_TOP Or DT_LEFT, True Case 3: Text_Render font_list(1), "Def: " & UserInventory(ti).MinDef & "/" & UserInventory(ti).MaxDef, frmMain.MouseY + 10, frmMain.MouseX + 10, 300, 300, ARGB(255, 255, 255, 255), DT_TOP Or DT_LEFT, True Case 11: Text_Render font_list(1), "Mod: " & UserInventory(ti).MinModificador & "/" & UserInventory(ti).MaxModificador, frmMain.MouseY + 10, frmMain.MouseX + 10, 300, 300, ARGB(255, 255, 255, 255), DT_TOP Or DT_LEFT, True Case 24: Text_Render font_list(1), "- Hechizo-", frmMain.MouseY + 10, frmMain.MouseX + 10, 300, 300, ARGB(255, 255, 255, 255), DT_TOP Or DT_LEFT, True End Select Text_Render font_list(1), "Precio: " & UserInventory(ti).Valor, frmMain.MouseY + 20, frmMain.MouseX + 10, 300, 300, ARGB(255, 255, 0, 255), DT_TOP Or DT_LEFT, True End Select End Sub Sub coso(II As Byte, Cual As Byte) Select Case Cual Case 2 Select Case Comerciando Case 1 If UserGLD >= OtherInventory(II).Valor Then Call SendData("COMP" & II & "," & 1) Else AddtoRichTextBox frmMain.rectxt, "No tenés suficiente oro.", 2, 51, 223, 1, 1 Exit Sub End If Case 2 Call SendData("RETI" & II & "," & 1) Case 3 Call SendData("SAVE" & II & "," & 1) End Select ' If lista = 1 Then Call ActualizarInformacionComercio(0) Case 1 ' LastIndex2 = List1(1).ListIndex Select Case Comerciando Case 1 If UserInventory(II).Equipped = 0 Then Call SendData("VEND" & II & "," & 1) Else AddtoRichTextBox frmMain.rectxt, "No podes vender el item porque lo estás usando.", 2, 51, 223, 1, 1 Exit Sub End If Case 2 If UserInventory(II).Equipped = 0 Then Call SendData("DEPO" & II & "," & 1) Else AddtoRichTextBox frmMain.rectxt, "No podes depositar el item porque lo estás usando.", 2, 51, 223, 1, 1 Exit Sub End If Case 3 If UserInventory(II).Equipped = 0 Then 'If Val(precio.Text) > 0 Then ' Call SendData("POVE" & II & "," & 1 & "," & precio.Text) ' Else ' AddtoRichTextBox frmMain.rectxt, "¡Debes elegir un precio de venta!", 2, 51, 223, 1, 1 ' Exit Sub 'End If Else AddtoRichTextBox frmMain.rectxt, "No puedes poner el item a la venta porque lo estás usando.", 2, 51, 223, 1, 1 Exit Sub End If End Select ' If lista = 0 Then Call ActualizarInformacionComercio(1) End Select End Sub

en el shownextframe buscan:

Código:: RenderSounds

y abajo ponen:

Código:: If Comerciando <> 0 Then RenderComercio: DibujarInfoComercio frmMain.MouseX, frmMain.MouseY

ahora buscan:

Código:: Private Sub Renderer_Click()

y reemplazan ese sub por:

Código:: Private Sub Renderer_Click() If Cartel Then Cartel = False If Comerciando = 0 Then Call ConvertCPtoTP(MouseX, MouseY, tX, tY) If Abs(UserPos.Y - tY) > 6 Then Exit Sub If Abs(UserPos.X - tX) > 8 Then Exit Sub If EligiendoWhispereo Then Call SendData("WH" & tX & "," & tY) EligiendoWhispereo = False Exit Sub End If If UsingSkill = 0 Then SendData "LC" & tX & "," & tY Else frmMain.MousePointer = vbDefault If UsingSkill = Magia Then If (TiempoTranscurrido(LastHechizo) < IntervaloSpell Or TiempoTranscurrido(Hechi) < IntervaloSpell / 4) Then Exit Sub Else: Hechi = Timer End If ElseIf UsingSkill = Proyectiles Then If (TiempoTranscurrido(LastFlecha) < IntervaloFlecha Or TiempoTranscurrido(Flecho) < IntervaloFlecha / 4) Then Exit Sub Else: Flecho = Timer End If End If Call SendData("WLC" & tX & "," & tY & "," & UsingSkill) UsingSkill = 0 End If ElseIf Comerciando <> 0 Then ImputComercio Val(MouseX), Val(MouseY) End If If boton = vbRightButton Then Call SendData("/TELEPLOC") boton = 0 End Sub

ahora buscan:

Enum ecomercio

y reemplazan el enum por este:

Enum ecomercio
Nada = 0
ComercioNPC = 1
ComercioUsuario = 2
ComercioBanco = 3
Canjes = 4
End Enum

Buscan:

Código:: Comerciando = ComercioBanco

y lo reemplazan por

Código:: Comerciando =2

y por ultimo buscan (aparece 3 veces):

Código:: frmComerciar.Show

y lo reemplazan por:

Código:: 'frmComerciar.Show

el code no es nada muy complejo, y queda bastante lindo
si quieren ponerle fondo, despues lo dejo

seria indexar una imagen, y despues en el sub rendercoercio, abajo de:

Código:: Rojo(3) = D3DColorXRGB(170, 0, 0)

ponen:

Código:: DDrawGrhtoSurface GrhFondo, 32 * 1 + (5 * 32) + 96, 32 * 1 + 64, False, 0, Blanco(), 0, False DDrawGrhtoSurface GrhFondo, 32 * 1 + 32, 32 * 1 + 64, False, 0, Rojo()

y grhfondo lo cambian por el grh q tenga el grafico.

Bueno Gente, eso es todo

Entonces:
Cuando Pasas El Mause, te dice la info depende el tipo de item que sea.
Cuando No lo podes usar, Se dibuja en rojo.
Dibuja los items del otro coso y de tu inventario.

Suerte!