-
Notifications
You must be signed in to change notification settings - Fork 1
/
frmPublicChat.frm
351 lines (306 loc) · 10.3 KB
/
frmPublicChat.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
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
VERSION 5.00
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Begin VB.Form frmPublicChat
AutoRedraw = -1 'True
Caption = "公共聊天区"
ClientHeight = 3945
ClientLeft = 60
ClientTop = 345
ClientWidth = 5115
Icon = "frmPublicChat.frx":0000
LockControls = -1 'True
NegotiateMenus = 0 'False
ScaleHeight = 3945
ScaleWidth = 5115
StartUpPosition = 3 '窗口缺省
Begin Othello.FlatButton fltbtnReload
Height = 315
Left = 4335
TabIndex = 2
Top = 165
Width = 705
_ExtentX = 1244
_ExtentY = 556
Caption = "刷新"
MousePointer = 99
Style = 2
Enabled = 0 'False
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
EnableHot = -1 'True
ForeColor = -2147483631
End
Begin VB.Timer tmrReload
Enabled = 0 'False
Interval = 1000
Left = 4545
Top = 1500
End
Begin InetCtlsObjects.Inet ietChat
Left = 4455
Top = 645
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
URL = "http://"
RequestTimeout = 30
End
Begin VB.TextBox txtTalk
CausesValidation= 0 'False
Enabled = 0 'False
Height = 3015
Left = 120
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 3
TabStop = 0 'False
Top = 615
Width = 4155
End
Begin VB.ComboBox cboTalk
Enabled = 0 'False
Height = 300
Left = 1140
TabIndex = 0
Top = 165
Width = 2220
End
Begin Othello.FlatButton fltbtnSendTalk
Default = -1 'True
Height = 315
Left = 3525
TabIndex = 1
Top = 165
Width = 705
_ExtentX = 1244
_ExtentY = 556
Caption = "发送"
MousePointer = 99
Style = 2
Enabled = 0 'False
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
EnableHot = -1 'True
ForeColor = -2147483631
End
Begin VB.Label lblUserName
AutoSize = -1 'True
Caption = "聊天:"
Height = 180
Left = 495
TabIndex = 4
Top = 225
Width = 450
End
End
Attribute VB_Name = "frmPublicChat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mlngSecond As Long
Dim FormVisible As Boolean
Dim mblnServerOK As Boolean
Private Sub fltbtnReload_Click(Button As Integer)
Call ReloadChat
Call SetControlFocus(cboTalk)
End Sub
Private Sub fltbtnSendTalk_Click(Button As Integer)
Dim strUrl As String
Dim strStatus As String
Dim strData As String
Dim strTalk As String
Dim strRecord As String
Dim i As Long
On Error Resume Next
If Trim(cboTalk.Text) = "" Then
Call SetControlFocus(cboTalk)
Exit Sub
End If
If Len(cboTalk.Text) > 50 Or Not CheckString(cboTalk.Text) Then
Call MessageBox(Me.hWnd, LoadString(176), vbExclamation, LoadString(177))
Call SetControlFocus(cboTalk)
Exit Sub
End If
strTalk = cboTalk.Text
cboTalk.Text = ""
strUrl = gstrSave_ServerUrl & SERVER_ACTION_CHAT_SEND & _
"?username=" & ToUrlString(gMyUserInfo.UserName) & _
"&name=" & ToUrlString(GetDisplayName(gMyUserInfo.UserName, gMyUserInfo.Name)) & _
"&password=" & MD5(gMyUserInfo.Password) & _
"&text=" & ToUrlString(strTalk) & _
"&" & MakeServerPassword() & _
"&" & MakeVersion()
tmrReload.Enabled = False
mlngSecond = 0
If ServerCommand(ietChat, mblnServerOK, strUrl, strStatus, strData) Then
If strStatus = STATUS_OK Then
txtTalk.Text = ""
For i = 1 To GetFieldCount(strData)
strRecord = GetField(strData, i)
Call Chat(GetRecord(strRecord, 1), GetRecord(strRecord, 2), GetRecord(strRecord, 3))
Next i
For i = 0 To cboTalk.ListCount - 1
If strTalk = cboTalk.List(i) Then
tmrReload.Enabled = True
Call SetControlFocus(cboTalk)
Exit Sub
End If
Next i
If cboTalk.ListCount >= 20 Then
For i = cboTalk.ListCount - 1 To 1 Step -1
cboTalk.List(i) = cboTalk.List(i - 1)
Next i
cboTalk.List(0) = strTalk
Else
Call cboTalk.AddItem(strTalk, 0)
End If
End If
End If
tmrReload.Enabled = True
Call SetControlFocus(cboTalk)
End Sub
Private Sub Form_Activate()
Call SetControlFocus(cboTalk)
End Sub
Private Sub Form_Load()
On Error Resume Next
Call Me.Move(gwifSave_PublicChatWindow.Left, gwifSave_PublicChatWindow.Top, gwifSave_PublicChatWindow.Width, gwifSave_PublicChatWindow.Height)
Me.WindowState = glngSave_PublicChatWindowState
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next
If UnloadMode = vbFormControlMenu Then
Cancel = True
Call Me.HideEx
End If
End Sub
Private Sub Form_Resize()
If Me.WindowState = vbMinimized Then
Call Me.HideEx
Me.WindowState = vbNormal
Exit Sub
End If
If Me.Width < LIMIT_WIDTH + 500 Or Me.Height < LIMIT_HEIGHT Then Exit Sub
Call lblUserName.Move(230, 350)
Call txtTalk.Move(220, 750, ScaleWidth - GetTwipX(31), ScaleHeight - GetTwipY(70))
Call cboTalk.Move(lblUserName.Left + lblUserName.Width + GetTwipX(3), lblUserName.Top - GetTwipY(4), ScaleWidth - lblUserName.Width - GetTwipX(150))
Call fltbtnSendTalk.Move(cboTalk.Left + cboTalk.Width + GetTwipX(8), lblUserName.Top - GetTwipY(4))
Call fltbtnReload.Move(fltbtnSendTalk.Left + fltbtnSendTalk.Width + GetTwipX(8), lblUserName.Top - GetTwipY(4))
End Sub
Public Sub EnableChat(ByVal Name As String)
lblUserName.Caption = Name & ":"
cboTalk.Enabled = True
fltbtnSendTalk.Enabled = True
fltbtnReload.Enabled = True
txtTalk.Enabled = True
tmrReload.Enabled = True
Call ReloadChat
End Sub
Public Sub DisableChat()
lblUserName.Caption = LoadString(255)
cboTalk.Enabled = False
fltbtnSendTalk.Enabled = False
fltbtnReload.Enabled = False
txtTalk.Enabled = False
tmrReload.Enabled = False
End Sub
Private Sub ietChat_StateChanged(ByVal State As Integer)
On Error Resume Next
Select Case State
Case icResponseReceived
mblnServerOK = True
Case icError '11
mblnServerOK = False
Case icResponseCompleted
'mblnServerOK = True
Dim strStatus As String
Dim strData As String
Dim i As Long
Dim strRecord As String
If GetServerExecute(ietChat, strStatus, strData) Then
If strStatus = STATUS_OK Then
txtTalk.Text = ""
'Call SetControlFocus(cboTalk)
For i = 1 To GetFieldCount(strData)
strRecord = GetField(strData, i)
Call Chat(GetRecord(strRecord, 1), GetRecord(strRecord, 2), GetRecord(strRecord, 3))
Next i
End If
End If
End Select
End Sub
Public Sub Chat(ByVal Who As String, ByVal Talk As String, ByVal ChatDate As String)
Dim Temp As String
Temp = Who & ": " & Talk & vbTab & "[" & Format(ChatDate, "yyyy-m-d hh:mm:ss") & "]"
txtTalk.Text = Temp & vbCrLf & txtTalk.Text
' 存储聊天数据，以备保存。
'Call lstChatData.AddItem(Temp)
End Sub
Private Function ReloadChat() As Boolean
Dim strUrl As String
strUrl = gstrSave_ServerUrl & SERVER_ACTION_CHAT_GET & _
"?username=" & ToUrlString(gMyUserInfo.UserName) & _
"&password=" & MD5(gMyUserInfo.Password) & _
"&" & MakeServerPassword() & _
"&" & MakeVersion()
ReloadChat = ServerExecute(ietChat, strUrl)
End Function
Private Sub tmrReload_Timer()
On Error Resume Next
If Not gblnLogin Or Not Me.Visible Then
tmrReload.Enabled = False
mlngSecond = 0
Exit Sub
End If
mlngSecond = mlngSecond + 1
If mlngSecond > PUBLIC_CHAT_RELOAD_TIME Then
mlngSecond = 0
tmrReload.Enabled = False
Call ReloadChat
tmrReload.Enabled = True
End If
End Sub
Private Sub lblUserName_Change()
Call Form_Resize
End Sub
Public Sub ShowEx()
On Error Resume Next
FormVisible = True
Call Me.Show(vbModeless)
If gblnLogin Then Call ReloadChat
tmrReload.Enabled = True
mlngSecond = 0
End Sub
Public Sub HideEx()
tmrReload.Enabled = False
mlngSecond = 0
FormVisible = False
Call Me.Hide
End Sub
Public Sub FormMinimize()
If Me.Visible Then
Call Me.Hide
End If
End Sub
Public Sub FormNormal()
If FormVisible Then
Call Me.Show(vbModeless)
End If
End Sub