/
frmFixItem.frm
200 lines (189 loc) · 6.83 KB
/
frmFixItem.frm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
VERSION 5.00
Begin VB.Form frmFixItem
BackColor = &H00000000&
BorderStyle = 0 'None
Caption = "Réparer un objet"
ClientHeight = 5835
ClientLeft = 90
ClientTop = -60
ClientWidth = 4965
ControlBox = 0 'False
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
Picture = "frmFixItem.frx":0000
ScaleHeight = 389
ScaleMode = 3 'Pixel
ScaleWidth = 331
StartUpPosition = 2 'CenterScreen
Begin VB.ComboBox cmbItem
BackColor = &H00FFFFFF&
BeginProperty Font
Name = "Verdana"
Size = 6.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 300
Left = 720
Style = 2 'Dropdown List
TabIndex = 0
Top = 1935
Width = 3465
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Prix :"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 720
TabIndex = 4
Top = 2280
Width = 360
End
Begin VB.Label picCancel
BackStyle = 0 'Transparent
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 4650
TabIndex = 3
Top = 0
Width = 315
End
Begin VB.Label chkFix
BackStyle = 0 'Transparent
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 450
Left = 1920
TabIndex = 2
Top = 5280
Width = 1155
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Sélectionner l'objet à réparer :"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 720
TabIndex = 1
Top = 1680
Width = 2160
End
End
Attribute VB_Name = "frmFixItem"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Form_Load()
Dim i As Long
Dim Ending As String
For i = 1 To 4
If i = 1 Then Ending = ".gif"
If i = 2 Then Ending = ".jpg"
If i = 3 Then Ending = ".png"
If i = 4 Then Ending = ".bmp"
If FileExiste(Rep_Theme & "\Jeu\reparer" & Ending) Then Me.Picture = LoadPNG(App.Path & Rep_Theme & "\Jeu\reparer" & Ending)
Next i
Label1.Font = ReadINI("POLICE", "Police", (App.Path & "\Config\Ecriture.ini"))
Label1.FontSize = ReadINI("POLICE", "PoliceSize", (App.Path & "\Config\Ecriture.ini"))
End Sub
Private Sub chkFix_Click()
Call SendData("fixitem" & SEP_CHAR & cmbItem.ListIndex + 1 & SEP_CHAR & frmTrade.picFixItems.Tag & SEP_CHAR & END_CHAR)
Call cmbItem_Click
End Sub
Private Sub cmbItem_Click()
Dim i As Long
If GetPlayerInvItemNum(MyIndex, cmbItem.ListIndex + 1) > 0 And GetPlayerInvItemNum(MyIndex, cmbItem.ListIndex + 1) < MAX_ITEMS Then
If Item(GetPlayerInvItemNum(MyIndex, cmbItem.ListIndex + 1)).Data1 > -1 And GetPlayerInvItemDur(MyIndex, cmbItem.ListIndex + 1) > -1 Then
i = (Item(GetPlayerInvItemNum(MyIndex, cmbItem.ListIndex + 1)).Data1 - GetPlayerInvItemDur(MyIndex, cmbItem.ListIndex + 1)) * (Item(GetPlayerInvItemNum(MyIndex, cmbItem.ListIndex + 1)).Data2 / 5) \ 2
If i <= 0 Then i = 1
frmFixItem.Label2.Caption = "Prix : " & i & Item(frmTrade.picFixItems.Tag).name
Else
Label2.Caption = "Prix : 0" & Item(frmTrade.picFixItems.Tag).name
End If
Else
Label2.Caption = "Prix : 0" & Item(frmTrade.picFixItems.Tag).name
End If
End Sub
Private Sub cmbItem_Scroll()
Dim i As Long
If GetPlayerInvItemNum(MyIndex, cmbItem.ListIndex + 1) > 0 And GetPlayerInvItemNum(MyIndex, cmbItem.ListIndex + 1) < MAX_ITEMS Then
If Item(GetPlayerInvItemNum(MyIndex, cmbItem.ListIndex + 1)).Data1 > -1 And GetPlayerInvItemDur(MyIndex, cmbItem.ListIndex + 1) > -1 Then
i = (Item(GetPlayerInvItemNum(MyIndex, cmbItem.ListIndex + 1)).Data1 - GetPlayerInvItemDur(MyIndex, cmbItem.ListIndex + 1)) * (Item(GetPlayerInvItemNum(MyIndex, cmbItem.ListIndex + 1)).Data2 / 5) \ 2
If i <= 0 Then i = 1
frmFixItem.Label2.Caption = "Prix : " & i & Item(frmTrade.picFixItems.Tag).name
Else
Label2.Caption = "Prix : 0" & Item(frmTrade.picFixItems.Tag).name
End If
Else
Label2.Caption = "Prix : 0" & Item(frmTrade.picFixItems.Tag).name
End If
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
dr = True
drx = x
dry = y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
If dr Then DoEvents: If dr Then Call Me.Move(Me.Left + (x - drx), Me.Top + (y - dry))
If Me.Left > Screen.Width Or Me.Top > Screen.Height Then Me.Top = Screen.Height \ 2: Me.Left = Screen.Width \ 2
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
dr = False
drx = 0
dry = 0
End Sub
Private Sub picCancel_Click()
Unload Me
If frmTrade.Visible Then frmTrade.SetFocus
End Sub