Introdução

Sistema de Craft

Olá, faz tempo que não posto algo aqui na área de tutoriais então vim disponibilizar o sistema de Craft que por meio de um pedido resolvi compartilhar.
O Sistema é bem simples porém tem um Editor, além de eu deixar bem pratico de ser adicionado ao Projeto
A "formula" do Craft é: Item1+Qntia1 + Item2+Qntia2 = Resultado + QntiaResultado.

Mídia

Vídeo Demonstração

[Você precisa estar registrado e conectado para ver este link.]

Material

Download e Tutorial

Arquivos Necessários: Download
Obs: a FrmMainPic são as Pics que tem que ser colocadas na FrmMain via Ctrl+C e Ctrl+V para ficar mais simples 'u'


Bom primeiro baixe os arquivos necessários e adicione ao seu projeto.

Pronto!?, Então podemos começar primeiro vamos ao servidor que tem pouca coisa para configurar...

Vá ao ModHandleData e encontre a Sub InitMessages e no final Antes de End Sub Adicione:

Código:

    HandleDataSub(CRequestEditCraft) = GetAddress(AddressOf HandleRequestEditCraft) 'Craft System
    HandleDataSub(CSaveCraft) = GetAddress(AddressOf HandleSaveCraft)
    HandleDataSub(CRequestCraft) = GetAddress(AddressOf HandleRequestCraft)
    HandleDataSub(CCraftLogUpdate) = GetAddress(AddressOf HandleCraftUpdate)
    HandleDataSub(CPlayerHandleCraft) = GetAddress(AddressOf HandleCraftOk)
    HandleDataSub(CCraftItemAdd) = GetAddress(AddressOf HandleCraftItemAdd)

Feito Isso vá ao ModEnumerations e procure por Public Enum ClientPackets e antes de ' Make sure CMSG_COUNT is below everything else adicione: 

Código:

    CRequestEditCraft 'Craft System
    CSaveCraft
    CRequestCraft
    CCraftLogUpdate
    CPlayerHandleCraft
    CCraftItemAdd

e Em Public Enum ServerPackets antes de ' Make sure SMSG_COUNT is below everything else adicione:

Código:

    SCraftEditor ' Craft System
    SUpdateCraft
    SPlayerCraft
    SInCraft

Agora já configurado os Pacotes vá para ModTypes e antes de Private Type PlayerRec adicione:

Código:

    'Variaveis do Jogador Craft
    Private Type PlayerCraftRec
        Name As String * NAME_LENGTH
        Item1 As Long
        Item1Value As Long
        Item2 As Long
        Item2Value As Long
        Resultado As Long
        ResultadoValue As Long
        Cost As Long
    End Type

e Dentro da Private Type PlayerRec adicione:
      

Código:

Craft As PlayerCraftRec 'Sistema de Craft

No mesmo Modulo procure por Private Type TempPlayerRec:
       

Código:

InCraft As Boolean 'Sistema de Craft

no ModHandleData procure por Sub HandlePlayerMove dentro abaixo de:

Código:

' if stunned, stop them moving
    If TempPlayer(index).StunDuration > 0 Then
        Call SendPlayerXY(index)
        Exit Sub
    End If

Adicione:

Código:

' Craft System - Remove Craft Walk
    If TempPlayer(index).InCraft = True Then
        TempPlayer(index).InCraft = False
        SendInCraft index
    End If

Em ModPlayer procure por Sub JoinGame(ByVal index As Long) e dentro encontre Call SendHotbar(index) abaixo adicione:

Código:

Call SendCraftS(index) 'Sistema de Craft

Agora vá em ModGeneral e procure por Private Sub LoadGameData() e antes de End Sub adicione:

Código:

    Call SetStatus("Loading Crafts...") 'Sistema de Craft
    Call LoadCraft

Obs: Agora crie uma pasta no DataFiles do servidor chamada Craft

Certo Servidor Configurado! Agora vamos para o Client.

Vá ao ModHandleData e encontre a Sub InitMessages e antes de ' Error handler adicione:

Código:

    HandleDataSub(SCraftEditor) = GetAddress(AddressOf HandleCraftEditor) 'Craft System
    HandleDataSub(SUpdateCraft) = GetAddress(AddressOf HandleUpdateCraft)
    HandleDataSub(SPlayerCraft) = GetAddress(AddressOf HandlePlayerCraft)
    HandleDataSub(SInCraft) = GetAddress(AddressOf HandleInCraft)

Feito isso vá em ModEnumerations e procure por Public Enum ClientPackets e antes de ' Make sure CMSG_COUNT is below everything else adicione:

Código:

    CRequestEditCraft 'Craft System
    CSaveCraft
    CRequestCraft
    CCraftLogUpdate
    CPlayerHandleCraft
    CCraftItemAdd

e Em Public Enum ServerPackets antes de ' Make sure SMSG_COUNT is below everything else adicione:

Código:

    SCraftEditor ' Craft System
    SUpdateCraft
    SPlayerCraft
    SInCraft

Agora já configurado os Pacotes vá para ModTypes e antes de Private Type PlayerRec adicione:

Código:

    'Variaveis do Jogador Craft
    Private Type PlayerCraftRec
        Name As String * NAME_LENGTH
        Item1 As Long
        Item1Value As Long
        Item2 As Long
        Item2Value As Long
        Resultado As Long
        ResultadoValue As Long
        Cost As Long
    End Type

No mesmo Modulo procure por Private Type PlayerRec:

Código:

    Craft As PlayerCraftRec 'Sistema de Craft

Agora vá na frmMain e na PicInventory de dois cliques para abrir a Private Sub picInventory_DblClick() e dentro da mesma Acima de ' are we in a shop? adicione:

Código:

'In Craft? Send Item to Craft Window
    If CraftMode = True Then
        If Item(GetPlayerInvItemNum(MyIndex, InvNum)).Type = ITEM_TYPE_CURRENCY Then
        ItemNumAddCraft = GetPlayerInvItemNum(MyIndex, InvNum)
        PicValueCraft.Visible = True
        Else
        PlayerCraftItemAdd GetPlayerInvItemNum(MyIndex, InvNum), 1
        ItemNumAddCraft = 0
        PicValueCraft.Visible = False
        End If
        Exit Sub
    End If

Agora na FrmMain de um duplo clique e vá até o final dos codes e adicione:

Código:

Private Sub cmdAdminCraft_Click()
PlayerCraftOk 0, 4 'Retirar esse Comando quando adicionar Npc Craft
End Sub

Private Sub imgCraftCancel_Click()
PlayerCraftOk 0, 0
End Sub

Private Sub imgCraftOk_Click()
PlayerCraftOk 0, 1
End Sub

Private Sub imgItem1_Click()
PlayerCraftOk 0, 2
End Sub

Private Sub imgItem2_Click()
PlayerCraftOk 0, 3
End Sub

Private Sub lblCancelValueCraft_Click()
ItemNumAddCraft = 0
PicValueCraft.Visible = False
End Sub

Private Sub lblOkValueCraft_Click()
Call PlayerCraftItemAdd(ItemNumAddCraft, Trim$(TxtCraftCurrency))
ItemNumAddCraft = 0
PicValueCraft.Visible = False
End Sub

Vá no modDirectDraw7 e no final do Modulo adicione:

Código:

Public Sub bltCraft()
Dim I As Long, x As Long, y As Long, CraftNum As Long, CraftPic As Long, CraftNumValue As Long
Dim Amount As String
Dim rec As RECT, rec_pos As RECT
Dim colour As Long

' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler

    If Not InGame Then Exit Sub
    frmMain.PicCraft.Cls

    For I = 1 To 3
    Select Case I
    Case 1
    CraftNum = Player(MyIndex).Craft.Item1
    CraftNumValue = Player(MyIndex).Craft.Item1Value
    Case 2
    CraftNum = Player(MyIndex).Craft.Item2
    CraftNumValue = Player(MyIndex).Craft.Item2Value
    Case 3
    CraftNum = Player(MyIndex).Craft.Resultado
    CraftNumValue = Player(MyIndex).Craft.ResultadoValue
    Case Else
    CraftNum = 0
    CraftNumValue = 0
    End Select

    If CraftNum > 0 And CraftNum <= MAX_CRAFTS Then
    CraftPic = Item(CraftNum).Pic
    If CraftPic > 0 And CraftPic <= NumItems Then
        Select Case I
        Case 1
                With rec_pos
                    .top = 13
                    .Bottom = .top + PIC_Y
                    .Left = 12
                    .Right = .Left + PIC_X
                End With
        Case 2
                With rec_pos
                    .top = 13
                    .Bottom = .top + PIC_Y
                    .Left = 56
                    .Right = .Left + PIC_X
                End With
        Case 3
                With rec_pos
                    .top = 51
                    .Bottom = .top + PIC_Y
                    .Left = 34
                    .Right = .Left + PIC_X
                End With
        End Select
            
                With rec
                    .top = 0
                    .Bottom = 32
                    .Left = 32
                    .Right = 64
                End With

        ' Load item if not loaded, and reset timer
            ItemTimer(CraftPic) = GetTickCount + SurfaceTimerMax
              If DDS_Item(CraftPic) Is Nothing Then
            Call InitDDSurf("Items\" & CraftPic, DDSD_Item(CraftPic), DDS_Item(CraftPic))
            End If
             
            'Engine_BltToDC DDS_SpellIcon(SkillTreepic), rec, rec_pos, frmMain.PicSkillTree, False
            Call Engine_BltToDC(DDS_Item(CraftPic), rec, rec_pos, frmMain.PicCraft, False)
         
            ' If item is a stack - draw the amount you have
            y = rec_pos.top + 22
            x = rec_pos.Left + 14
                
            If CraftNumValue > 1 Then
            DrawText frmMain.PicCraft.hDC, x, y, CraftNumValue, QBColor(White)
            End If
            frmMain.PicCraft.Refresh
         
            End If
    End If
Next

' Error handler
    Exit Sub
errorhandler:
    HandleError "EditorSkillTree_BltIcon", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub

End Sub

Agora para abrir o editor Crie um Botão na PicAdmin e adicione dentro:
   

Código:

' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler
    If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then
        Exit Sub
    End If

    SendRequestEditCraft

    ' Error handler
    Exit Sub
errorhandler:
    HandleError "cmdCraft_Click", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub

Pronto agora só testar o sistema, caso encontrem bugs me avise :3!

Considerações finais

Créditos

llAliferll 'Fazer o sistema :3
Belzebu 'Cobaia para achar Bugs para Correção.
Junior 'Base linda do Video (Se não colocar Crédito ele Xora)

queria abrir o craft atravez de um botao na tela do meu game igual o de inventario e char etc.. como posso fazer isso? desde ja agradeço boa tarde

Bom... Teria de saber o nome da Pic da Aba que você quer abrir ... Eu não sei o nome porquê não baixei, mas vou baixar e-e 
estava procurando esse sistema há muito tempo, mesmo não sabendo se ele "combina" Com o servidor que quero fazer '-'

Mas, Crie um Command Button ou Img e Coloque qualquer nome que você queira ...
dps de criar o botão ou img, dê 2 clicks em cima dele...
E coloque esse código lá dentro: 

Código:

picXXX.Visible = True   'No lugar da "picXXX" Você muda para o nome da pic que você quer que abra ...


Bom, acho que vá funcionar, mas vai tero problema de só abrir e não conseguir fechar...

Para isso, Coloque uma label com a Caption [X] E o nome qual você quiser ...
Dê 2 clicks e coloque o código: 

Código:

picXXX.Visible = False  'No lugar da "picXXX" Você muda para o nome da pic que você quer que abra ...


Agora, explicando
PìcXXX é o nome da sua picture
.Visible é a visibilidade da picture
=True isso é se você quer que seja Visível ou Invisível
True=Visível
False=Invisível

Bom, só sei esse jeito... mas se o Alifer ou outro membro poder ajudar...
queria saber como faz para fazer um botão de dupla visibilidade
No caso, 1 click visibilidade = True, +1 click Visibilidade = False
Tentei colocar 
picXXX.Visible = True
Else
picXXX.Visible = False



Mas não deu certo... se alguém podesse ajudar quanto a isso, nós agradeceríamos.


Bom, como eu dizia, Ótimo topico, Aliffer, obrigado pelo sistema +2 <3 <3

error na hora de copilar pro servidor nessa linha
 
 Call SetStatus("Loading Crafts...") 'Sistema de Craft (erro na linha de baixo dessa)
    
------>>> Call LoadCraft <--------


End Sub

[Você precisa estar registrado e conectado para ver este link.] escreveu:error na hora de copilar pro servidor nessa linha
 
 Call SetStatus("Loading Crafts...") 'Sistema de Craft (erro na linha de baixo dessa)
    
------>>> Call LoadCraft <--------


End Sub

Você adicionou o modCraftServer ao projeto? Pois eu mesmo fiz o tutorial em uma engine zerada aqui e não deu sequer um erro...

Além de colocar os arquivos na pasta Src do projeto é necessário adicionar a Form e o Modulo a partir do Vb6...
Obs: O sistema vem com um botão para abrir a janela de Craft.
[Você precisa estar registrado e conectado para ver esta imagem.]

OBS: Procurem por :

Código:

Call SetStatus("Clearing animations...")
Call ClearAnimations

em baixo add:

Código:

Call SetStatus("Clearing crafts...")
Call ClearCraftS

De nd

Belo sistema digamos que para ficar perfeito falto fazer com que alem de ter os dois itens gastasse uma determinada quantia de gold e tivesse uma porcentagem de chance de falhar fazendo com que perdesse os 2 itens e o gold e não adquirisse nada (brhuehue) kkk dificultar um pouquinho pra esses players hehehe e encontrei um problema o sistema funcionou porém só com acesso ADMIN com player normal não funcionou, se pudesse dar uma olha pelo menos nessa ultima parte que falei ajudaria muito de qualquer forma +1 parabéns pelo sistema

Yo! dei um pequeno sinal de vida e venho pedir desculpas... o sistema eu testei bem antes de disponibilizar porém ainda existem bugs para mim que não sou profissional nem nada do tipo é quase impossível fazer algo perfeito sem bugs.


Sobre criar itens somente usando admin foi uma condição colocada por mim pois eu estava testando um npc para crafts e a janela não ficar aberta torto a direito .-. e nego craftando o que bem entendesse...


Para resolver é somente retirar está parte no ModCraftServer em HandleCraftItemAdd:

Código:

If Player(index).Access < ADMIN_DEVELOPER Then
    If TempPlayer(index).InCraft = False Then Exit Sub
    End If

E acabei de notar um "bug" que foi erro meu na hora de criar os packets... irei explicar o que ocorre bom não é possivel colocar um valor maior que 255 'As byte

Então tenho o dever de passar a correção imediata.

Vamos começar pelo Client... Procure por:

Código:

Public Sub PlayerCraftItemAdd(ByVal ItemNum As Long, ByVal ItemNumValue As Byte)

Então substitua toda a Sub por:

Código:

Public Sub PlayerCraftItemAdd(ByVal ItemNum As Long, ByVal ItemNumValue As Long)
    Dim Buffer As clsBuffer
    Set Buffer = New clsBuffer
    
    Buffer.WriteLong CCraftItemAdd
    Buffer.WriteLong ItemNum
    Buffer.WriteLong ItemNumValue
    SendData Buffer.ToArray()
    Set Buffer = Nothing
End Sub

Pronto Agora vamos para o Servidor... E procure por:

Código:

Sub HandleCraftItemAdd(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)

E dentro procure por:

ResultadoValue As Byte 'Não tenho muita certeza se está a byte se estiver as long deixe se estiver as byte troque para as long .-.

ainda dentro dessa sub procure por:

Código:

ItemNumValue = Buffer.ReadByte

e troque por:

Código:

ItemNumValue = Buffer.ReadLong

Bom feito isso... teste um valor acima de 255 no craft ^^!

Muito bom o seu sistema. Adorei a janelinha de craft ^-^
+1

Bartolomeu é so fazer assim : Picx.visible = Not Picx.visible...
ótimo sistema Alifer  irei usar com toda certeza +1cred.

Bom dia a todos, bom venho aqui me desculpar hoje porque depois de um bom tempo me dei conta que o sistema estava com um problema no carregamento causando Latência para inicialização do Servidor. E trouxe a correção :/ por inexperiência minha acabei fazendo besteira...

Bom o problema está no ModCraft do Servidor...
Procure por Sub LoadCraft() e substitua ela toda por:

Código:

Sub LoadCraft()
    Dim filename As String
    Dim i As Long
    Dim F As Long
    Call CheckCrafts

    For i = 1 To MAX_CRAFTS
        filename = App.Path & "\data\craft\craft" & i & ".dat"
        F = FreeFile
        Open filename For Binary As #F
        Get #F, , Craft(i)
        Close #F
    Next

End Sub

Ainda no modulo procure por Sub CheckCraft(ByVal CraftNum As Long) e troque ela toda por:

Código:

Sub CheckCrafts()
    Dim i As Long

    For i = 1 To MAX_CRAFTS

        If Not FileExist("\Data\craft\craft" & i & ".dat") Then
            Call SaveCraft(i)
        End If

    Next

End Sub

É só isso desculpe o problema que eu posso ter provocado no projeto de vocês ^^'