[APORTE] Sistema de Canjeo

Bueno esta es una guia para hacer un sistema de canje desde un dat.
Esto a mi me funciono con una version de TPao clon o con 11.5, bueno empecemos:

Empezamos con el servidor.
buscar:

'Flags
Public Type UserFlags

y arriba:
Public Type tPremiosCanjes
ObjName As String
ObjIndexP As Integer
ObjRequiere As Integer
ObjDescripcion As String
ObjMaxAt As Byte
ObjMinAt As Byte
ObjMindef As Byte
ObjMaxdef As Byte
ObjMinAtMag As Byte
ObjMaxAtMag As Byte
ObjMinDefMag As Byte
ObjMaxDefMag As Byte
End Type

Busca:
Public SpawnList() As tCriaturasEntrenador

Abajo:
Public PremiosList() As tPremiosCanjes

Busca:
Public Sub CargarSpawnList()

Arriva:

Public Sub CargarPremiosList()
Dim p As Integer, LoopC As Integer
p = val(GetVar(App.Path & "\Dat\Premios.dat", "INIT", "NumPremios"))
'canjeo [Dylan.-]
ReDim PremiosList(p) As tPremiosCanjes


For LoopC = 1 To p
PremiosList(LoopC).ObjName = GetVar(App.Path & "\Dat\Premios.dat", "PREMIO" & LoopC, "Nombre")
PremiosList(LoopC).ObjIndexP = val(GetVar(App.Path & "\Dat\Premios.dat", "PREMIO" & LoopC, "NumObj"))
PremiosList(LoopC).ObjRequiere = val(GetVar(App.Path & "\Dat\Premios.dat", "PREMIO" & LoopC, "Requiere"))
PremiosList(LoopC).ObjMaxAt = GetVar(App.Path & "\Dat\Premios.dat", "PREMIO" & LoopC, "AtaqueMaximo")
PremiosList(LoopC).ObjMinAt = GetVar(App.Path & "\Dat\Premios.dat", "PREMIO" & LoopC, "AtaqueMinimo")
PremiosList(LoopC).ObjMindef = GetVar(App.Path & "\Dat\Premios.dat", "PREMIO" & LoopC, "DefensaMinima")
PremiosList(LoopC).ObjMaxdef = GetVar(App.Path & "\Dat\Premios.dat", "PREMIO" & LoopC, "DefensaMaxima")
PremiosList(LoopC).ObjMinAtMag = GetVar(App.Path & "\Dat\Premios.dat", "PREMIO" & LoopC, "AtaqueMagicoMinimo")
PremiosList(LoopC).ObjMaxAtMag = GetVar(App.Path & "\Dat\Premios.dat", "PREMIO" & LoopC, "AtaqueMagicoMaximo")
PremiosList(LoopC).ObjMinDefMag = GetVar(App.Path & "\Dat\Premios.dat", "PREMIO" & LoopC, "DefensaMagicaMinima")
PremiosList(LoopC).ObjMaxDefMag = GetVar(App.Path & "\Dat\Premios.dat", "PREMIO" & LoopC, "DefensaMagicaMaxima")
PremiosList(LoopC).ObjDescripcion = GetVar(App.Path & "\Dat\Premios.dat", "PREMIO" & LoopC, "Descripcion")
Next LoopC
End Sub

Busca:
Call BanIpCargar

Abajo:
Call CargarPremiosList

Arriba de:
'Resetea el inventario
If UCase$(rData) = "/RESETINV" Then

poner:
'Información de los objetos
If UCase$(Left$(rData, 3)) = "IPX" Then
rData = Right$(rData, Len(rData) - 3)

If val(rData) > 0 And val(rData) < UBound(PremiosList) + 1 Then _
Call SendData(SendTarget.ToIndex, UserIndex, 0, "INF" & PremiosList(val(rData)).ObjRequiere & "," & PremiosList(val(rData)).ObjMaxAt & "," & PremiosList(val(rData)).ObjMinAt & "," & PremiosList(val(rData)).ObjMaxdef & "," & PremiosList(val(rData)).ObjMindef & "," & PremiosList(val(rData)).ObjMaxAtMag & "," & PremiosList(val(rData)).ObjMinAtMag & "," & PremiosList(val(rData)).ObjMaxDefMag & "," & PremiosList(val(rData)).ObjMinDefMag & "," & PremiosList(rData).ObjDescripcion & "," & UserList(UserIndex).Stats.PuntosDeTorneo & "," & ObjData(PremiosList(rData).ObjIndexP).GrhIndex)
Exit Sub
End If
'Requerimientos de los objetos
If UCase$(Left$(rData, 3)) = "SPX" Then
rData = Right$(rData, Len(rData) - 3)
Dim Premio As Obj

If val(rData) > 0 And val(rData) < UBound(PremiosList) + 1 Then

Premio.Amount = 1
Premio.ObjIndex = PremiosList(val(rData)).ObjIndexP

End If

'Si no tiene los puntos necesarios
If UserList(UserIndex).Stats.PuntosDeTorneo < PremiosList(val(rData)).ObjRequiere Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||No tienes suficientes puntos para este objeto." & FONTTYPE_INFO)
Exit Sub
End If

'Si no tenemoss lugar lo tiramos al piso
'If Not MeterItemEnInventario(UserIndex, Premio) Then
' Call SendData(SendTarget.ToIndex, UserIndex, 0, "||No puedo cargar mas objetos." & FONTTYPE_INFO)
'Exit Sub
'End If

'Metemos en inventario
Call MeterItemEnInventario(UserIndex, Premio)
Call UpdateUserInv(True, UserIndex, 0)

'Avisamos por consola
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Has obtenido: " & ObjData(Premio.ObjIndex).name & " (Cantidad: " & Premio.Amount & ")" & FONTTYPE_GUILD)

'Restamos & actualizams
UserList(UserIndex).Stats.PuntosDeTorneo = UserList(UserIndex).Stats.PuntosDeTorneo - PremiosList(val(rData)).ObjRequiere
Call SendUserStatsBox(UserIndex)
Exit Sub
End If
'Dylan.- Sistema de Premios

Arriba de:
Case "ACTUALIZAR"

poner:

Case "CCANJE"
Dim Premios As Integer, SX As String
SX = "PRM" & UBound(PremiosList) & ","

For Premios = 1 To UBound(PremiosList)
SX = SX & PremiosList(Premios).ObjName & ","
Next Premios

Call SendData(SendTarget.ToIndex, UserIndex, 0, SX & UserList(UserIndex).Stats.PuntosDeTorneo)
Call SendData(SendTarget.ToIndex, UserIndex, 0, "INF" & PremiosList(val(rData)).ObjRequiere & "," & PremiosList(val(rData)).ObjMaxAt & "," & PremiosList(val(rData)).ObjMinAt & "," & PremiosList(val(rData)).ObjMaxdef & "," & PremiosList(val(rData)).ObjMindef & "," & PremiosList(val(rData)).ObjMaxAtMag & "," & PremiosList(val(rData)).ObjMinAtMag & "," & PremiosList(val(rData)).ObjMaxDefMag & "," & PremiosList(val(rData)).ObjMinDefMag & "," & PremiosList(val(rData)).ObjDescripcion)
'sistema de premios [Dylan.-]
Exit Sub

Cliente:
se bajan esto y lo agregan al cliente con Ctrl D


[Tienes que estar registrado y conectado para ver este vínculo]

En el Frmmain van a tener que hacer en la interface un texto que diga Canjes pero momentaneamente creamos un label y dentro le ponemos

SendData ("CCANJE")

Arriba de:
Case "SPL"

pongan:
Case "PRM"
Rdata = Right(Rdata, Len(Rdata) - 3)

For i = 1 To Val(ReadField(1, Rdata, 44))
frmCanjes.ListaPremios.AddItem ReadField(i + 1, Rdata, 44)
Next i

frmCanjes.Show , frmMain
Exit Sub

Case "INF" 'Sistema de Canjeo - [Dylan.-] 2011...
Rdata = Right(Rdata, Len(Rdata) - 3)
With frmCanjes
.Requiere.Caption = ReadField(1, Rdata, 44)
.lAtaque.Caption = ReadField(3, Rdata, 44) & "/" & ReadField(2, Rdata, 44)
.lDef.Caption = ReadField(5, Rdata, 44) & "/" & ReadField(4, Rdata, 44)
.lAM.Caption = ReadField(7, Rdata, 44) & "/" & ReadField(6, Rdata, 44)
.lDM.Caption = ReadField(9, Rdata, 44) & "/" & ReadField(8, Rdata, 44)
.lDescripcion.Text = ReadField(10, Rdata, 44)
.lPuntos.Caption = ReadField(11, Rdata, 44)

If .Requiere.Caption = "0" Then
.Requiere.Caption = "N/A"
End If
If .lAtaque.Caption = "0/0" Then
.lAtaque.Caption = "N/A"
End If
If .lDef.Caption = "0/0" Then
.lDef.Caption = "N/A"
End If
If .lAM.Caption = "0/0" Then
.lAM.Caption = "N/A"
End If
If .lDM.Caption = "0/0" Then
.lDM.Caption = "N/A"
End If

Dim Grhpremios As Integer
Grhpremios = ReadField(12, Rdata, 44)
Call engine.GrhRenderToHdc(Grhpremios, .Picture1.hdc, 0, 0)
.Picture1.Refresh
End With
Exit Sub

Creo que ahi estaría, esta echo en DX8 es solamente la parte de renderizado en picture del frmcanjes, se pueden basar en el renderizado del picture de frmcomerciar si tiene Dx7, es una pavada, cualquier cosa si tiene problema con eso me avisan que posteo...

Ahora el dat lo ponemos en la carpeta Dat del servidor con el nombre Premios.dat y dentro le ponemos:
Simplemente un ejemplo, es facil de entender, asi que no creo que necesiten explicacion de que sirve cada linea...


[INIT]
NumPremios=1

[PREMIO1]
Nombre=Daga de Hielo
NumObj=854
Requiere=70
AtaqueMinimo=11
AtaqueMaximo=13
DefensaMinima=0
DefensaMaxima=0
AtaqueMagicoMinimo=0
AtaqueMagicoMaximo=0
DefensaMagicaMinima=0
DefensaMagicaMaxima=0
Descripcion=La antigua daga de hielo antes utilizada en Tierras Perdidas pero ahora al perecer tiene un gran poder.


Nota: Si no tiene defensa magica por ejemplo le ponemos valores 0 en mininma y maxima.
Espero que entiendan y disfruten! cualquier error diganme!

Buen aporte funciona en 13.0?

Lo he testeado solo en 11.5 igual ahora averiguo y te informo.

Solo Funciona en 11.5, para que funcione en 13.0, hay que adaptarlo...
Testeado y funciona en 11.5...
(Es el que usaron en Spiller AO)

Edit: Tampoco va acá.

Buen aporte, mala sección. xD
Movido a Programación.

Cerrado, falta fuente.

Movido a 11.5