Cards
By Jsventor
Difficulty: 2/5 Should be easy to add
Start With Server Side!In Mod Types, Add this stuff in the appropriate places.
Code:
Public Const MAX_CARDS = 100
Code:
Public Const ITEM_TYPE_CARD = 14
Code:
Type CardRec
Name As String
Description As String
HPTake As Long
MPTake As Long
SPTake As Long
HPGive As Long
MPGive As Long
SPGive As Long
ExpGive As Long
ItemTake As Long
ItemTakeDur As Long
ItemTakeVal As Long
ItemGive As Long
ItemGiveDur As Long
ItemGiveVal As Long
Rarity As Long
Picture As Long
Map As Long
X As Long
Y As Long
End Type
Code:
Public Card(1 To MAX_CARDS) As CardRec
Under;
Code:
Call SendNpcs(Index)
Add;
Code:
Call SendCards(Index)
Add this sun to the bottom of
ModGameLogic;
Code:
Sub UseCard(ByVal Index As Long, ByVal CardNum As Long, InvNum As Long)
Call PlayerMsg(Index, "You attempt to use card number " & CardNum & ", " & Card(CardNum).Name, Yellow)
Dim HP As Long
Dim MP As Long
Dim SP As Long
Dim EXP As Long
Dim HPTake As Long
Dim MPTake As Long
Dim SPTake As Long
Dim HPGive As Long
Dim MPGive As Long
Dim SPGive As Long
Dim MapNum As Long
Dim X As Long
Dim Y As Long
MapNum = Card(CardNum).Map
X = Card(CardNum).X
Y = Card(CardNum).Y
HP = GetPlayerHP(Index)
MP = GetPlayerMP(Index)
SP = GetPlayerSP(Index)
EXP = GetPlayerExp(Index)
HPTake = Card(CardNum).HPTake
HPGive = Card(CardNum).HPGive
MPTake = Card(CardNum).MPTake
MPGive = Card(CardNum).MPGive
SPTake = Card(CardNum).SPTake
SPGive = Card(CardNum).SPGive
If HP < HPTake Or MP < MPTake Or SP < SPTake Then
Call PlayerMsg(Index, "You do not have what it takes to use this card!", BrightRed)
Exit Sub
End If
If Card(CardNum).HPTake > 0 Then
Call SetPlayerHP(Index, HP - Card(CardNum).HPTake / 4)
Call PlayerMsg(Index, HPTake & " HP Has been taken away!", Red)
Call SendHP(Index)
End If
If Card(CardNum).HPGive > 0 Then
Call SetPlayerHP(Index, HP + Card(CardNum).HPGive / 4)
Call PlayerMsg(Index, HPGive & " HP Has been given!", Green)
Call SendHP(Index)
End If
If Card(CardNum).MPTake > 0 Then
Call SetPlayerMP(Index, MP - Card(CardNum).MPTake / 4)
Call PlayerMsg(Index, MPTake & " MP Has been taken away!", Red)
Call SendMP(Index)
End If
If Card(CardNum).MPGive > 0 Then
Call SetPlayerMP(Index, MP + Card(CardNum).MPGive / 4)
Call PlayerMsg(Index, MPGive & " MP Has been given!", Green)
Call SendMP(Index)
End If
If Card(CardNum).SPTake > 0 Then
Call SetPlayerSP(Index, SP - Card(CardNum).SPTake / 4)
Call PlayerMsg(Index, SPTake & " SP Has been taken away!", Red)
Call SendSP(Index)
End If
If Card(CardNum).SPGive > 0 Then
Call SetPlayerSP(Index, SP + Card(CardNum).SPGive / 4)
Call PlayerMsg(Index, SPGive & " SP Has been given!", Green)
Call SendSP(Index)
End If
If Card(CardNum).ExpGive > 0 Then
Call SetPlayerExp(Index, EXP + Card(CardNum).ExpGive)
Call PlayerMsg(Index, HPGive & " EXP Has been given!", Green)
End If
'Warping
If MapNum > 0 And X > 0 And Y > 0 Then
Call PlayerWarp(Index, MapNum, X, Y)
Call PlayerMsg(Index, "You have warped to " & Map(MapNum).Name, Blue)
End If
'Give Item
If Item(Card(CardNum).ItemGive).Type <> ITEM_TYPE_CURRENCY Then
Call Give_Item(Index, Card(CardNum).ItemGive, Card(CardNum).ItemGiveDur)
Call PlayerMsg(Index, "You have gained a " & Item(Card(CardNum).ItemGive).Name, Green)
Else
If Item(Card(CardNum).ItemGive).Type = ITEM_TYPE_CURRENCY Then
Call GiveItem(Index, Card(CardNum).ItemGive, Card(CardNum).ItemGiveVal)
Call PlayerMsg(Index, "You have gained " & Card(CardNum).ItemGiveVal & " Of " & Item(Card(CardNum).ItemGive).Name, Green)
End If
Call SendInventory(Index)
End If
'Take item
If Item(Card(CardNum).ItemTake).Type <> ITEM_TYPE_CURRENCY Then
Call TakeItem(Index, Card(CardNum).ItemTake, 1)
Call PlayerMsg(Index, "You have lost a " & Item(Card(CardNum).ItemTake).Name, Green)
Else
If Item(Card(CardNum).ItemGive).Type = ITEM_TYPE_CURRENCY Then
Call TakeItem(Index, Card(CardNum).ItemTake, Card(CardNum).ItemGiveVal)
Call PlayerMsg(Index, "You have glost " & Card(CardNum).ItemTakeVal & " Of " & Item(Card(CardNum).ItemTake).Name, Green)
End If
Call SendInventory(Index)
End If
Call TakeItem(Index, GetPlayerInvItemNum(Index, InvNum), 0)
Call CloseCard(Index)
End Sub
Under;
Code:
Call LoadNpcs
Add;
Code:
Call SetStatus("Loading Cards...")
Call LoadCards
In ModServerTCP Add;
Code:
Sub SendCards(ByVal Index As Long)
Dim Packet As String
Dim i As Long
For i = 1 To MAX_CARDS
If Trim(Card(i).Name) <> "" Then
Call SendUpdateCardTo(Index, i)
End If
Next i
End Sub
Code:
Sub SendUpdateCardToAll(ByVal CardNum As Long)
Dim Packet As String
Packet = "UPDATECARD" & SEP_CHAR & CardNum & SEP_CHAR & Trim(Card(CardNum).Name) & SEP_CHAR & Trim(Card(CardNum).Description) & SEP_CHAR & Card(CardNum).HPTake & SEP_CHAR & Card(CardNum).MPTake & SEP_CHAR & Card(CardNum).SPTake & SEP_CHAR & Card(CardNum).HPGive & SEP_CHAR & Card(CardNum).MPGive & SEP_CHAR & Card(CardNum).SPGive & SEP_CHAR & Card(CardNum).ExpGive & SEP_CHAR & Card(CardNum).ItemTake & SEP_CHAR & Card(CardNum).ItemTakeDur & SEP_CHAR & Card(CardNum).ItemTakeVal & SEP_CHAR & Card(CardNum).ItemGive & SEP_CHAR & Card(CardNum).ItemGiveDur & SEP_CHAR & Card(CardNum).ItemGiveVal & SEP_CHAR & Card(CardNum).Rarity & SEP_CHAR & Card(CardNum).Picture & SEP_CHAR & Card(CardNum).Map & SEP_CHAR & Card(CardNum).X & SEP_CHAR & Card(CardNum).Y & END_CHAR
Call SendDataToAll(Packet)
End Sub
Code:
Sub SendUpdateCardTo(ByVal Index As Long, ByVal CardNum As Long)
Dim Packet As String
Packet = "UPDATECARD" & SEP_CHAR & CardNum & SEP_CHAR & Trim(Card(CardNum).Name) & SEP_CHAR & Trim(Card(CardNum).Description) & SEP_CHAR & Card(CardNum).HPTake & SEP_CHAR & Card(CardNum).MPTake & SEP_CHAR & Card(CardNum).SPTake & SEP_CHAR & Card(CardNum).HPGive & SEP_CHAR & Card(CardNum).MPGive & SEP_CHAR & Card(CardNum).SPGive & SEP_CHAR & Card(CardNum).ExpGive & SEP_CHAR & Card(CardNum).ItemTake & SEP_CHAR & Card(CardNum).ItemTakeDur & SEP_CHAR & Card(CardNum).ItemTakeVal & SEP_CHAR & Card(CardNum).ItemGive & SEP_CHAR & Card(CardNum).ItemGiveDur & SEP_CHAR & Card(CardNum).ItemGiveVal & SEP_CHAR & Card(CardNum).Rarity & SEP_CHAR & Card(CardNum).Picture & SEP_CHAR & Card(CardNum).Map & SEP_CHAR & Card(CardNum).X & SEP_CHAR & Card(CardNum).Y & END_CHAR
Call SendDataTo(Index, Packet)
End Sub
Sub SendDisplayCard(ByVal Index As Long, ByVal CardNum As Long, InvNum As Long)
Dim Packet As String
Packet = "DISPLAYCARD" & SEP_CHAR & CardNum & SEP_CHAR & InvNum & SEP_CHAR & Trim(Card(CardNum).Name) & SEP_CHAR & Trim(Card(CardNum).Description) & SEP_CHAR & Card(CardNum).Rarity & SEP_CHAR & Card(CardNum).Picture & END_CHAR
Call SendDataTo(Index, Packet)
End Sub
Code:
Sub SendEditCardTo(ByVal Index As Long, ByVal CardNum As Long)
Dim Packet As String
Packet = "EDITCARD" & SEP_CHAR & CardNum & SEP_CHAR & Trim(Card(CardNum).Name) & SEP_CHAR & Trim(Card(CardNum).Description) & SEP_CHAR & Card(CardNum).HPTake & SEP_CHAR & Card(CardNum).MPTake & SEP_CHAR & Card(CardNum).SPTake & SEP_CHAR & Card(CardNum).HPGive & SEP_CHAR & Card(CardNum).MPGive & SEP_CHAR & Card(CardNum).SPGive & SEP_CHAR & Card(CardNum).ExpGive & SEP_CHAR & Card(CardNum).ItemTake & SEP_CHAR & Card(CardNum).ItemTakeDur & SEP_CHAR & Card(CardNum).ItemTakeVal & SEP_CHAR & Card(CardNum).ItemGive & SEP_CHAR & Card(CardNum).ItemGiveDur & SEP_CHAR & Card(CardNum).ItemGiveVal & SEP_CHAR & Card(CardNum).Rarity & SEP_CHAR & Card(CardNum).Picture & SEP_CHAR & Card(CardNum).Map & SEP_CHAR & Card(CardNum).X & SEP_CHAR & Card(CardNum).Y & END_CHAR
Call SendDataTo(Index, Packet)
End Sub
Code:
Sub CloseCard(ByVal Index As Long)
Dim Packet As String
Packet = "CLOSECARD" & END_CHAR
Call SendDataTo(Index, Packet)
End Sub
In
Sub Handledata add these to the top;
Code:
Dim CardNum As Long
Dim HP As Long
Dim MP As Long
Dim SP As Long
Dim EXP As Long
Dim HPTake As Long
Dim MPTake As Long
Dim SPTake As Long
Dim HPGive As Long
Dim MPGive As Long
Dim SPGive As Long
Add these packets in handledata;
Code:
If LCase(Parse(0)) = "discardcard" Then
CardNum = Val(Parse(1))
InvNum = Val(Parse(2))
Call TakeItem(Index, GetPlayerInvItemNum(Index, InvNum), 0)
Call CloseCard(Index)
Call PlayerMsg(Index, "You have discarded " & Card(CardNum).Name, BrightRed)
Exit Sub
End If
' :::::::::::::::::::::
' :: Use card packet ::
' :::::::::::::::::::::
If LCase(Parse(0)) = "usecard" Then
CardNum = Val(Parse(1))
InvNum = Val(Parse(2))
' Prevent hacking
If CardNum <= 0 Or CardNum > MAX_CARDS Then
Call HackingAttempt(Index, "Invalid cardNum")
Exit Sub
End If
Call UseCard(Index, CardNum, InvNum)
Exit Sub
End If
Above
CASE_ITEM_TYPE_SPELL in Handledata add;
Code:
Case ITEM_TYPE_CARD
' Get the Card num
n = Item(GetPlayerInvItemNum(Index, InvNum)).Data1
If n > 0 Then
Call PlayerMsg(Index, "You Have Set " & Card(n).Name & " As a card!", Yellow)
Call SendDisplayCard(Index, n, InvNum)
End If
Add this packet;
Code:
' ::::::::::::::::::::::::::::::
' :: Request edit Card packet ::
' ::::::::::::::::::::::::::::::
If LCase(Parse(0)) = "requesteditcard" Then
' Prevent hacking
If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
Call HackingAttempt(Index, "Admin Cloning")
Exit Sub
End If
Call SendDataTo(Index, "CARDEDITOR" & END_CHAR)
Exit Sub
End If
Code:
' ::::::::::::::::::::::
' :: Edit Card packet ::
' ::::::::::::::::::::::
If LCase(Parse(0)) = "editcard" Then
' Prevent hacking
If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
Call HackingAttempt(Index, "Admin Cloning")
Exit Sub
End If
' The card #
n = Val(Parse(1))
' Prevent hacking
If n < 0 Or n > MAX_CARDS Then
Call HackingAttempt(Index, "Invalid Card Index")
Exit Sub
End If
Call AddLog(GetPlayerName(Index) & " editing card #" & n & ".", ADMIN_LOG)
Call SendEditCardTo(Index, n)
End If
Code:
' ::::::::::::::::::::::
' :: Save card packet ::
' ::::::::::::::::::::::
If LCase(Parse(0)) = "savecard" Then
' Prevent hacking
If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
Call HackingAttempt(Index, "Admin Cloning")
Exit Sub
End If
n = Val(Parse(1))
If n < 0 Or n > MAX_CARDS Then
Call HackingAttempt(Index, "Invalid card Index")
Exit Sub
End If
' Update the item
Card(n).Name = Parse(2)
Card(n).Description = Parse(3)
Card(n).HPTake = Val(Parse(4))
Card(n).MPTake = Val(Parse(5))
Card(n).SPTake = Val(Parse(6))
Card(n).HPGive = Val(Parse(7))
Card(n).MPGive = Val(Parse(8))
Card(n).SPGive = Val(Parse(9))
Card(n).ExpGive = Val(Parse(10))
Card(n).ItemTake = Val(Parse(11))
Card(n).ItemTakeDur = Val(Parse(12))
Card(n).ItemTakeVal = Val(Parse(13))
Card(n).ItemGive = Val(Parse(14))
Card(n).ItemGiveDur = Val(Parse(15))
Card(n).ItemGiveVal = Val(Parse(16))
Card(n).Rarity = Val(Parse(17))
Card(n).Picture = Val(Parse(18))
Card(n).Map = Val(Parse(19))
Card(n).X = Val(Parse(20))
Card(n).Y = Val(Parse(21))
' Save it
Call SendUpdateCardToAll(n)
Call SaveCard(n)
Call AddLog(GetPlayerName(Index) & " saved card #" & n & ".", ADMIN_LOG)
Exit Sub
End If
In ModDatabase add;
Code:
Sub SaveCards()
Dim i As Long
For i = 1 To MAX_CARDS
Call SaveCard(i)
Next i
End Sub
And;
Code:
Sub SaveCard(ByVal CardNum As Long)
Dim FileName As String
Dim f As Long
FileName = App.Path & "\Cards\Card" & CardNum & ".GXL"
f = FreeFile
Open FileName For Binary As #f
Put #f, , Card(CardNum)
Close #f
End Sub
Code:
Sub CheckCards()
Dim i As Long
For i = 1 To MAX_CARDS
If Not FileExist("Cards\Card" & i & ".GXL") Then
Call SaveCards
End If
Next
End Sub
Code:
Sub LoadCards()
Dim FileName As String
Dim i As Long
Dim f As Long
Call CheckCards
For i = 1 To MAX_CARDS
Call SetStatus("Loading cards... " & Int((i / MAX_CARDS) * 100) & "%")
FileName = App.Path & "\Cards\Card" & i & ".GXL"
f = FreeFile
Open FileName For Binary As #f
Get #f, , Card(i)
Close #f
DoEvents
Next
End Sub
Now, in your server folder, make a new Folder and call it "Cards"
[size=15pt]
Client Side![/size]
Put these in the apprpriate spots in
ModTypesCode:
Public Const MAX_CARDS = 100
Code:
Public Const ITEM_TYPE_CARD = 14
In
ModGlobalsCode:
Public InCardEditor As Boolean
Code:
Public Card(1 To MAX_CARDS) As CardRec
Packets to put in
Sub HandelData;
Code:
If (LCase(Parse(0)) = "closecard") Then
frmMirage.lblCardInv.Caption = vbNullString
frmMirage.lblcardNum.Caption = vbNullString
frmMirage.CardName.Caption = vbNullString
frmMirage.Desc.Caption = vbNullString
frmMirage.lblrarity.Caption = vbNullString
frmMirage.picCard.Visible = False
Exit Sub
End If
'Display Card Packet
If (LCase(Parse(0)) = "displaycard") Then
n = Val(Parse(1))
If n <= 0 Or n > MAX_CARDS Then
Exit Sub
End If
InvNum = Val(Parse(2))
Dim JPIC As Long
' Update the item
frmMirage.lblcardNum.Caption = n
frmMirage.lblCardInv.Caption = InvNum
frmMirage.CardName.Caption = Parse(3)
frmMirage.Desc.Caption = Parse(4)
frmMirage.lblrarity.Caption = Val(Parse(5))
JPIC = Val(Parse(6))
If FileExist("gfx\Cards\" & JPIC & ".bmp") Then
frmMirage.picCard.Picture = LoadPicture(App.Path & "\gfx\Cards\" & JPIC & ".bmp")
End If
frmMirage.picCard.Visible = True
Exit Sub
End If
' ::::::::::::::::::::::::
' :: card editor packet ::
' ::::::::::::::::::::::::
If (LCase(Parse(0)) = "cardeditor") Then
InCardEditor = True
frmIndex.Show
frmIndex.lstIndex.Clear
' Add the names
For i = 1 To MAX_CARDS
frmIndex.lstIndex.AddItem i & ": " & Trim(Card(i).Name)
Next i
frmIndex.lstIndex.ListIndex = 0
Exit Sub
End If
' ::::::::::::::::::::::::
' :: Update Card packet ::
' ::::::::::::::::::::::::
If (LCase(Parse(0)) = "updatecard") Then
n = Val(Parse(1))
' Update the card
Card(n).Name = Parse(2)
Card(n).Description = Parse(3)
Card(n).HPTake = Val(Parse(4))
Card(n).MPTake = Val(Parse(5))
Card(n).SPTake = Val(Parse(6))
Card(n).HPGive = Val(Parse(7))
Card(n).MPGive = Val(Parse(8))
Card(n).SPGive = Val(Parse(9))
Card(n).expGive = Val(Parse(10))
Card(n).ItemTake = Val(Parse(11))
Card(n).ItemTakeDur = Val(Parse(12))
Card(n).ItemTakeVal = Val(Parse(13))
Card(n).ItemGive = Val(Parse(14))
Card(n).ItemGiveDur = Val(Parse(15))
Card(n).ItemGiveVal = Val(Parse(16))
Card(n).Rarity = Val(Parse(17))
Card(n).Picture = Val(Parse(18))
Card(n).Map = Val(Parse(19))
Card(n).X = Val(Parse(20))
Card(n).Y = Val(Parse(21))
Exit Sub
End If
' ::::::::::::::::::::::
' :: Edit card packet :: <- Used for card editor admins only
' ::::::::::::::::::::::
If (LCase(Parse(0)) = "editcard") Then
n = Val(Parse(1))
' Update the item
Card(n).Name = Parse(2)
Card(n).Description = Parse(3)
Card(n).HPTake = Val(Parse(4))
Card(n).MPTake = Val(Parse(5))
Card(n).SPTake = Val(Parse(6))
Card(n).HPGive = Val(Parse(7))
Card(n).MPGive = Val(Parse(8))
Card(n).SPGive = Val(Parse(9))
Card(n).expGive = Val(Parse(10))
Card(n).ItemTake = Val(Parse(11))
Card(n).ItemTakeDur = Val(Parse(12))
Card(n).ItemTakeVal = Val(Parse(13))
Card(n).ItemGive = Val(Parse(14))
Card(n).ItemGiveDur = Val(Parse(15))
Card(n).ItemGiveVal = Val(Parse(16))
Card(n).Rarity = Val(Parse(17))
Card(n).Picture = Val(Parse(18))
Card(n).Map = Val(Parse(19))
Card(n).X = Val(Parse(20))
Card(n).Y = Val(Parse(21))
' Initialize the item editor
Call CardEditorInit
Exit Sub
End If
Now go to FrmMirage, and make a picture box, name it PicCard and set its Visibility to False. make it 161x225 Pixels.
In it, add A label at the top for The name, And one under it for Description, and one under that for rarity. look at the screens for an example, of course you can change it.
name them as listed;
Name = CardName
For the description label = Desc
rarity = lblRarity
And then, add two more labels under it, make one say "Use Card" And the other say "Discard"
In the use Card Click Code add;
Code:
Call SendUseCard(lblcardNum.Caption, lblCardInv.Caption)
And in the Discard one;
Code:
Call SendDiscardCard(lblcardNum.Caption, lblCardInv.Caption)
Now add two more labels, and make there visibilty set to false (In the piccard) name one;
lblcardnumAnd the other;
lblcardinvNow, also, if you wanna add an exit label, simply make a label and in the code add;
Code:
[icCard.visible = false
Add this Type in
ModTypes;
Code:
Type CardRec
Name As String
Description As String
HPTake As Long
MPTake As Long
SPTake As Long
HPGive As Long
MPGive As Long
SPGive As Long
expGive As Long
ItemTake As Long
ItemTakeDur As Long
ItemTakeVal As Long
ItemGive As Long
ItemGiveDur As Long
ItemGiveVal As Long
Rarity As Long
Picture As Long
Map As Long
X As Long
Y As Long
End Type
In
ModGameLogic Add these;
Code:
Public Sub CardEditorInit()
On Error Resume Next
frmCardEditor.txtName.Text = Card(EditorIndex).Name
frmCardEditor.txtDesc.Text = Card(EditorIndex).Description
frmCardEditor.HPTake.Value = Card(EditorIndex).HPTake
frmCardEditor.MPTake.Value = Card(EditorIndex).MPTake
frmCardEditor.SPTake.Value = Card(EditorIndex).SPTake
frmCardEditor.HPGive.Value = Card(EditorIndex).HPGive
frmCardEditor.MPGive.Value = Card(EditorIndex).MPGive
frmCardEditor.SPGive.Value = Card(EditorIndex).SPGive
frmCardEditor.expGive.Text = Card(EditorIndex).expGive
frmCardEditor.ItemTake.Value = Card(EditorIndex).ItemTake
frmCardEditor.ItemTakeDur.Text = Card(EditorIndex).ItemTakeDur
frmCardEditor.ItemTakeValue.Text = Card(EditorIndex).ItemTakeVal
frmCardEditor.ItemGive.Value = Card(EditorIndex).ItemGive
frmCardEditor.ItemGiveDur.Text = Card(EditorIndex).ItemGiveDur
frmCardEditor.ItemGiveValue.Text = Card(EditorIndex).ItemGiveVal
frmCardEditor.Rarity.Value = Card(EditorIndex).Rarity
frmCardEditor.ItemPic.Value = Card(EditorIndex).Picture
frmCardEditor.Map.Value = Card(EditorIndex).Map
frmCardEditor.X.Value = Card(EditorIndex).X
frmCardEditor.Y.Value = Card(EditorIndex).Y
frmCardEditor.Show vbModal
End Sub
Public Sub CardEditorOk()
Card(EditorIndex).Name = frmCardEditor.txtName.Text
Card(EditorIndex).Description = frmCardEditor.txtDesc.Text
Card(EditorIndex).HPTake = frmCardEditor.HPTake.Value
Card(EditorIndex).MPTake = frmCardEditor.MPTake.Value
Card(EditorIndex).SPTake = frmCardEditor.SPTake.Value
Card(EditorIndex).HPGive = frmCardEditor.HPGive.Value
Card(EditorIndex).MPGive = frmCardEditor.MPGive.Value
Card(EditorIndex).SPGive = frmCardEditor.SPGive.Value
Card(EditorIndex).expGive = frmCardEditor.expGive.Text
Card(EditorIndex).ItemTake = frmCardEditor.ItemTake.Value
Card(EditorIndex).ItemTakeDur = frmCardEditor.ItemTakeDur.Text
Card(EditorIndex).ItemTakeVal = frmCardEditor.ItemTakeValue.Text
Card(EditorIndex).ItemGive = frmCardEditor.ItemGive.Value
Card(EditorIndex).ItemGiveDur = frmCardEditor.ItemGiveDur.Text
Card(EditorIndex).ItemGiveVal = frmCardEditor.ItemGiveValue.Text
Card(EditorIndex).Rarity = frmCardEditor.Rarity.Value
Card(EditorIndex).Picture = frmCardEditor.ItemPic.Value
Card(EditorIndex).Map = frmCardEditor.Map.Value
Card(EditorIndex).X = frmCardEditor.X.Value
Card(EditorIndex).Y = frmCardEditor.Y.Value
Call SendSaveCard(EditorIndex)
InCardEditor = False
Unload frmCardEditor
End Sub
Public Sub cardEditorCancel()
InCardEditor = False
Unload frmCardEditor
End Sub
In the
ItemEditorOk Code add this;
Code:
If (frmItemEditor.cmbType.ListIndex = ITEM_TYPE_CARD) Then
Item(EditorIndex).Data1 = frmItemEditor.CardNum.Value
Item(EditorIndex).Data2 = 0
Item(EditorIndex).Data3 = 0
End If
Now Head Over to
ModClientTcp and add these;
Code:
Sub SendUseCard(ByVal CardNum As Long, InvNum As Long)
Dim Packet As String
Packet = "USECARD" & SEP_CHAR & CardNum & SEP_CHAR & InvNum & END_CHAR
Call SendData(Packet)
End Sub
Sub SendDiscardCard(ByVal CardNum As Long, InvNum As Long)
Dim Packet As String
Packet = "DISCARDCARD" & SEP_CHAR & CardNum & SEP_CHAR & InvNum & END_CHAR
Call SendData(Packet)
End Sub
Sub SendRequestEditCard()
Dim Packet As String
Packet = "REQUESTEDITCARD" & END_CHAR
Call SendData(Packet)
End Sub
Sub SendSaveCard(ByVal CardNum As Long)
Dim Packet As String
Packet = "SAVECARD" & SEP_CHAR & CardNum & SEP_CHAR & Trim(Card(CardNum).Name) & SEP_CHAR & Trim(Card(CardNum).Description) & SEP_CHAR & Card(CardNum).HPTake & SEP_CHAR & Card(CardNum).MPTake & SEP_CHAR & Card(CardNum).SPTake & SEP_CHAR & Card(CardNum).HPGive & SEP_CHAR & Card(CardNum).MPGive & SEP_CHAR & Card(CardNum).SPGive & SEP_CHAR & Card(CardNum).expGive & SEP_CHAR & Card(CardNum).ItemTake & SEP_CHAR & Card(CardNum).ItemTakeDur & SEP_CHAR & Card(CardNum).ItemTakeVal & SEP_CHAR & Card(CardNum).ItemGive & SEP_CHAR & Card(CardNum).ItemGiveDur & SEP_CHAR & Card(CardNum).ItemGiveVal & SEP_CHAR & Card(CardNum).Rarity & SEP_CHAR & Card(CardNum).Picture & SEP_CHAR & Card(CardNum).Map & SEP_CHAR & Card(CardNum).X & SEP_CHAR & Card(CardNum).Y & END_CHAR
Call SendData(Packet)
End Sub
In the item editor, go to CmbType, and in the Item data at the end, add a 0, and in the list, add a "Card"
Then add a scrollbar and name it
CardNum, make it enabled = false, in the change code add;
Code:
lbl1.Caption = CardNum.Value
If CardNum.Value > 0 Then
lblcardName.Caption = "Card Name: " & Card(CardNum.Value).Name
Else
lblcardName.Caption = "No Card Selected"
End If
Add a label named
lblcardnameIn the
CmbType Click Event add this;
Code:
If (cmbType.ListIndex = ITEM_TYPE_CARD) Then
cardNum.enabled = true
End If
In frmIndex, in CmdOk, add this;
Code:
If InCardEditor = True Then
Call SendData("EDITCARD" & SEP_CHAR & EditorIndex & END_CHAR)
End If
In the Cancel button add;
Code:
InCardEditor = False
In the admin panel, add a button that says "Edit Card" and in it add;
Code:
If GetPlayerAccess(MyIndex) >= ADMIN_MAPPER Then
Call SendRequestEditCard
Else: Call AddText("You are not authorized to carry out that action", BrightRed)
End If
frmadmin.Visible = False
CARDS DOWNLOAD CLICK HERE
FORMS DOWNLOAD CLICK HERENow, in the download I gave, it has basic card pictures in a folder,
PUT THE FOLDER IN THE GFX FOLDER! and put the forms in your project, and
enjoy!!
And last but not least, add the frmCardEditor which is provided in the post!
Made an edit!
Details:
Fixed the item taking and giving item so it checks it, also, I added a KillPlayer sub that is used in the UseCard sub if you die from a card!
THIS SHOULD BE ADDED AS SOON AS POSSIBLE!
[size=200]EDITDelete your Usecard sub and put this instead!
Code:
Sub UseCard(ByVal Index As Long, ByVal CardNum As Long, InvNum As Long)
Call PlayerMsg(Index, "You attempt to use card number " & CardNum & ", " & Card(CardNum).Name, Yellow)
Dim HP As Long
Dim MP As Long
Dim SP As Long
Dim EXP As Long
Dim HPTake As Long
Dim MPTake As Long
Dim SPTake As Long
Dim HPGive As Long
Dim MPGive As Long
Dim SPGive As Long
Dim MapNum As Long
Dim X As Long
Dim Y As Long
MapNum = Card(CardNum).Map
X = Card(CardNum).X
Y = Card(CardNum).Y
HP = GetPlayerHP(Index)
MP = GetPlayerMP(Index)
SP = GetPlayerSP(Index)
EXP = GetPlayerExp(Index)
HPTake = Card(CardNum).HPTake
HPGive = Card(CardNum).HPGive
MPTake = Card(CardNum).MPTake
MPGive = Card(CardNum).MPGive
SPTake = Card(CardNum).SPTake
SPGive = Card(CardNum).SPGive
If HP + 1 < HPTake Or MP + 1 < MPTake Or SP + 1 < SPTake Then
Call PlayerMsg(Index, "You do not have what it takes to use this card!", BrightRed)
Exit Sub
End If
If Card(CardNum).HPTake > 0 Then
Call SetPlayerHP(Index, HP - Card(CardNum).HPTake)
Call PlayerMsg(Index, HPTake & " HP Has been taken away!", Red)
Call SendHP(Index)
End If
If Card(CardNum).HPGive > 0 Then
Call SetPlayerHP(Index, HP + Card(CardNum).HPGive)
Call PlayerMsg(Index, HPGive & " HP Has been given!", Green)
Call SendHP(Index)
End If
If Card(CardNum).MPTake > 0 Then
Call SetPlayerMP(Index, MP - Card(CardNum).MPTake)
Call PlayerMsg(Index, MPTake & " MP Has been taken away!", Red)
Call SendMP(Index)
End If
If Card(CardNum).MPGive > 0 Then
Call SetPlayerMP(Index, MP + Card(CardNum).MPGive)
Call PlayerMsg(Index, MPGive & " MP Has been given!", Green)
Call SendMP(Index)
End If
If Card(CardNum).SPTake > 0 Then
Call SetPlayerSP(Index, SP - Card(CardNum).SPTake)
Call PlayerMsg(Index, SPTake & " SP Has been taken away!", Red)
Call SendSP(Index)
End If
If Card(CardNum).SPGive > 0 Then
Call SetPlayerSP(Index, SP + Card(CardNum).SPGive)
Call PlayerMsg(Index, SPGive & " SP Has been given!", Green)
Call SendSP(Index)
End If
If Card(CardNum).ExpGive > 0 Then
Call SetPlayerExp(Index, EXP + Card(CardNum).ExpGive)
Call PlayerMsg(Index, HPGive & " EXP Has been given!", Green)
End If
'Warping
If MapNum > 0 And X > 0 And Y > 0 Then
Call PlayerWarp(Index, MapNum, X, Y)
Call PlayerMsg(Index, "You have warped to " & Map(MapNum).Name, Blue)
End If
'Give Item
If Not HasItem(Index, Card(CardNum).ItemGive) And Card(CardNum).ItemGive = 0 Then
Call PlayerMsg(Index, "You do not have the proper item needed for this card!", BrightBlue)
Exit Sub
End If
If Item(Card(CardNum).ItemGive).Type <> ITEM_TYPE_CURRENCY Then
Call Give_Item(Index, Card(CardNum).ItemGive, Card(CardNum).ItemGiveDur)
Call PlayerMsg(Index, "You have gained a " & Item(Card(CardNum).ItemGive).Name, Green)
Else
If Item(Card(CardNum).ItemGive).Type = ITEM_TYPE_CURRENCY Then
Call GiveItem(Index, Card(CardNum).ItemGive, Card(CardNum).ItemGiveVal)
Call PlayerMsg(Index, "You have gained " & Card(CardNum).ItemGiveVal & " Of " & Item(Card(CardNum).ItemGive).Name, Green)
End If
Call SendInventory(Index)
End If
'Take item
If Not HasItem(Index, Card(CardNum).ItemTake) And Card(CardNum).ItemGive = 0 Then
Call PlayerMsg(Index, "You do not have the proper item needed for this card!", BrightBlue)
Exit Sub
End If
If Item(Card(CardNum).ItemTake).Type <> ITEM_TYPE_CURRENCY Then
Call TakeItem(Index, Card(CardNum).ItemTake, 1)
Call PlayerMsg(Index, "You have lost a " & Item(Card(CardNum).ItemTake).Name, Green)
Else
If Item(Card(CardNum).ItemGive).Type = ITEM_TYPE_CURRENCY Then
Call TakeItem(Index, Card(CardNum).ItemTake, Card(CardNum).ItemGiveVal)
Call PlayerMsg(Index, "You have glost " & Card(CardNum).ItemTakeVal & " Of " & Item(Card(CardNum).ItemTake).Name, Green)
End If
Call SendInventory(Index)
End If
Call TakeItem(Index, GetPlayerInvItemNum(Index, InvNum), 0)
Call CloseCard(Index)
If GetPlayerHP(Index) = 0 Then
Call KillPlayer(Index, "Card Number " & CardNum & ", " & Card(CardNum).Name)
End If
End Sub
Sub KillPlayer(ByVal Index As Long, Cause As String)
Dim EXP As Long
' Player is dead
Call PlayerMsg(Index, "You have been killed by " & Cause, BrightRed)
' Drop all worn items by Index
If GetPlayerWeaponSlot(Index) > 0 Then
Call PlayerMapDropItem(Index, GetPlayerWeaponSlot(Index), 0)
End If
If GetPlayerArmorSlot(Index) > 0 Then
Call PlayerMapDropItem(Index, GetPlayerArmorSlot(Index), 0)
End If
If GetPlayerHelmetSlot(Index) > 0 Then
Call PlayerMapDropItem(Index, GetPlayerHelmetSlot(Index), 0)
End If
If GetPlayerShieldSlot(Index) > 0 Then
Call PlayerMapDropItem(Index, GetPlayerShieldSlot(Index), 0)
End If
' Calculate exp to give attacker
EXP = Int(GetPlayerExp(Index) / 10)
' Make sure we dont get less then 0
If EXP < 0 Then
EXP = 0
End If
If EXP = 0 Then
Call PlayerMsg(Index, "You lost no experience points.", BrightRed)
Else
Call SetPlayerExp(Index, GetPlayerExp(Index) - EXP)
Call PlayerMsg(Index, "You lost " & EXP & " experience points.", BrightRed)
End If
' Warp player away
Call PlayerWarp(Index, START_MAP, START_X, START_Y)
' Restore vitals
Call SetPlayerHP(Index, GetPlayerMaxHP(Index))
Call SetPlayerMP(Index, GetPlayerMaxMP(Index))
Call SetPlayerSP(Index, GetPlayerMaxSP(Index))
Call SendHP(Index)
Call SendMP(Index)
Call SendSP(Index)
End Sub
New EditDescription, instead of making it load separate files from a folder, I made it work like the rest of the GFX, with this it will Blt from a surfaceOk, this is all Client side!In sub InitDirectX Add this before the end sub,
Code:
' Init Card ddsd type and load the bitmap
DDSD_Card.lFlags = DDSD_CAPS
DDSD_Card.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
Set DD_CardSurf = DD.CreateSurfaceFromFile(App.Path & "\GFX\cards.bmp", DDSD_Card)
DD_CardSurf.SetColorKey DDCKEY_SRCBLT, key
Ok, now add this in sub DestroyDirectX
Code:
Set DD_CardSurf = Nothing
In the top of Mod DirectX under Option Explicit add these,
Code:
Public DD_CardSurf As DirectDrawSurface7
Public DDSD_Card As DDSURFACEDESC2
Ok now, change
Code:
Private Sub ItemPic_Change()
To
Code:
Private Sub ItemPic_Change()
lblPic.Caption = ItemPic.Value
End Sub
In FrmCardEditor add a timer, name it whatever you want, set its interval to 50 and
enabled = true, in it add this..
Code:
Call CardEditorBltCard(frmCardEditor.ItemPic.Value)
Now add this at the bottom of
ModGameLogicCode:
Public Sub CardEditorBltCard(ByVal PicNum As Long)
With rec
.top = ((PicNum) * CARD_Y)
.Bottom = .top + CARD_Y
.Left = 0
.Right = .Left + CARD_X
End With
With rec_pos
.top = 0
.Bottom = CARD_Y
.Left = 0
.Right = CARD_X
End With
DD_CardSurf.BltToDC frmCardEditor.picPic.hDC, rec, rec_pos
frmCardEditor.picPic.Refresh
' If you wanna use BitBlt instead
'Call BitBlt(frmCardEditor.picPic.hDC, 0, 0, CARD_X, CARD_Y, frmCardEditor.picCards.hDC, 0, frmCardEditor.ItemPic.Value * CARD_Y, SRCCOPY)
End Sub
Now search for "displaycard" and replace that with this,
Code:
If (LCase(Parse(0)) = "displaycard") Then
n = Val(Parse(1))
If n <= 0 Or n > MAX_CARDS Then
Exit Sub
End If
InvNum = Val(Parse(2))
Dim JPIC As Long
' Update the item
frmMirage.lblcardNum.Caption = n
frmMirage.lblCardInv.Caption = InvNum
frmMirage.CardName.Caption = Parse(3)
frmMirage.Desc.Caption = Parse(4)
frmMirage.lblrarity.Caption = Val(Parse(5))
JPIC = Val(Parse(6))
frmMirage.picCard.Refresh
Call BltCard(JPIC)
Exit Sub
End If
Now add this at the bottom of
ModGameLogic Code:
Sub BltCard(ByVal PicNum As Long)
frmMirage.picCard.Visible = True
With rec
.top = ((PicNum) * CARD_Y)
.Bottom = .top + CARD_Y
.Left = 0
.Right = .Left + CARD_X
End With
With rec_pos
.top = 0
.Bottom = CARD_Y
.Left = 0
.Right = CARD_X
End With
DD_CardSurf.BltToDC frmMirage.picCard.hDC, rec, rec_pos
frmMirage.picCard.Refresh
End Sub
And last but not least, add these in
modTypesCode:
' card sizes
Public Const CARD_X = 161
Public Const CARD_Y = 225
So now you can change the size of cards
Now add this image in your GFX folder!
ENJOY!
Login
Register
FAQ
Search
Members
