Skip to content
Permalink
Browse files

Use VB6 timer for Clan Invite; show timer on dialog

* Like the frmRealm, this form does not need high-resolution timers to
  count down from 30 seconds.
* Since it no longer uses the system timer callback system, this could
  address issue #9 - will need testing.
* Update form layout to make clear the Clan Tag and Clan Full Name parts,
  and to add the timer.
  • Loading branch information...
nmbook committed Mar 28, 2017
1 parent dc60d63 commit 9559883ad7a0f52b9c34b9cd6ef202cd14bcd2ff
Showing with 113 additions and 50 deletions.
  1. +113 −32 trunk/frmClanInvite.frm
  2. +0 −1 trunk/modGlobals.bas
  3. +0 −17 trunk/modTimerProcs.bas
@@ -3,17 +3,23 @@ Begin VB.Form frmClanInvite
BackColor = &H00000000&
BorderStyle = 3 'Fixed Dialog
Caption = "Warcraft III Clan Invitation"
ClientHeight = 1905
ClientHeight = 2145
ClientLeft = 75
ClientTop = 465
ClientWidth = 3105
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1905
ScaleHeight = 2145
ScaleWidth = 3105
ShowInTaskbar = 0 'False
StartUpPosition = 1 'CenterOwner
Begin VB.Timer tmrTimeout
Enabled = 0 'False
Interval = 1000
Left = 0
Top = 0
End
Begin VB.CommandButton cmdDecline
Cancel = -1 'True
Caption = "&Decline"
@@ -28,8 +34,8 @@ Begin VB.Form frmClanInvite
EndProperty
Height = 375
Left = 120
TabIndex = 4
Top = 1440
TabIndex = 6
Top = 1680
Width = 1455
End
Begin VB.CommandButton cmdAccept
@@ -46,30 +52,72 @@ Begin VB.Form frmClanInvite
EndProperty
Height = 375
Left = 1560
TabIndex = 3
Top = 1440
TabIndex = 5
Top = 1680
Width = 1455
End
Begin VB.Label lblUser
Begin VB.Label lblTimer
Alignment = 2 'Center
BackColor = &H00000000&
Caption = "A. Random Person"
Caption = "Timer"
BeginProperty Font
Name = "Tahoma"
Size = 13.5
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 375
Height = 255
Left = 120
TabIndex = 0
Top = 120
TabIndex = 4
Top = 1320
Width = 2895
End
Begin VB.Label lblInv
Alignment = 2 'Center
BackColor = &H00000000&
Caption = "Inviter"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 120
TabIndex = 3
Top = 1080
Width = 2895
End
Begin VB.Label lblName
Alignment = 2 'Center
BackColor = &H00000000&
Caption = "Clan Full Name"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 120
TabIndex = 2
Top = 720
Width = 2895
End
Begin VB.Label lblClan
Alignment = 2 'Center
BackColor = &H00000000&
Caption = "Clan %clan"
BeginProperty Font
@@ -84,13 +132,14 @@ Begin VB.Form frmClanInvite
ForeColor = &H00FFFFFF&
Height = 375
Left = 120
TabIndex = 2
Top = 960
TabIndex = 1
Top = 360
Width = 2895
End
Begin VB.Label lblInvite
Alignment = 2 'Center
BackColor = &H00000000&
Caption = "has invited you to join"
Caption = "You have been invited to join"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
@@ -103,8 +152,8 @@ Begin VB.Form frmClanInvite
ForeColor = &H00FFFFFF&
Height = 255
Left = 120
TabIndex = 1
Top = 600
TabIndex = 0
Top = 120
Width = 2895
End
End
@@ -121,14 +170,21 @@ Private Const REQUEST_NAME As Integer = 2
Private Const REQUEST_INV As Integer = 3
Private Const REQUEST_ISNEW As Integer = 4

Public Sub cmdAccept_Click()
Private Const CLAN_TIMER_TIMEOUT As Integer = 30
Private Const CLAN_BUTTON_TIMEOUT As Integer = 28

Private Ticks As Integer
Private vArray() As Variant

Private Sub cmdAccept_Click()
Dim oRequest As udtServerRequest
Dim vArray() As Variant

If (g_Clan.PendingInvitation) Then
If FindServerRequest(oRequest, g_Clan.PendingInvitationCookie, SID_CLANINVITATIONRESPONSE) Then
vArray = oRequest.Tag
Call frmChat.ClanHandler.InvitationResponse(vArray(REQUEST_ISNEW), vArray(REQUEST_COOKIE), vArray(REQUEST_TAG), vArray(REQUEST_INV), clresAccept)
Call frmChat.ClanHandler.InvitationResponse( _
CBool(vArray(REQUEST_ISNEW)), CLng(vArray(REQUEST_COOKIE)), _
CStr(vArray(REQUEST_TAG)), CStr(vArray(REQUEST_INV)), clresAccept)
g_Clan.PendingInvitation = False
End If
End If
@@ -138,14 +194,16 @@ Public Sub cmdAccept_Click()
Unload Me
End Sub

Public Sub cmdDecline_Click()
Private Sub cmdDecline_Click()
Dim oRequest As udtServerRequest
Dim vArray() As Variant

If (g_Clan.PendingInvitation) Then
If FindServerRequest(oRequest, g_Clan.PendingInvitationCookie, SID_CLANINVITATIONRESPONSE) Then
vArray = oRequest.Tag
Call frmChat.ClanHandler.InvitationResponse(vArray(REQUEST_ISNEW), vArray(REQUEST_COOKIE), vArray(REQUEST_TAG), vArray(REQUEST_INV), clresDecline)
Call frmChat.ClanHandler.InvitationResponse( _
CBool(vArray(REQUEST_ISNEW)), CLng(vArray(REQUEST_COOKIE)), _
CStr(vArray(REQUEST_TAG)), CStr(vArray(REQUEST_INV)), clresDecline)
g_Clan.PendingInvitation = False
End If
End If
@@ -157,25 +215,48 @@ End Sub

Private Sub Form_Load()
Dim oRequest As udtServerRequest
Dim vArray() As Variant

If (g_Clan.PendingInvitation) Then
If FindServerRequest(oRequest, g_Clan.PendingInvitationCookie, SID_CLANINVITATIONRESPONSE, , False) Then
Me.Icon = frmChat.Icon
Ticks = CLAN_TIMER_TIMEOUT

vArray = oRequest.Tag
lblUser.Caption = CStr(vArray(REQUEST_INV))
lblClan.Caption = StringFormat("Clan {0}: {1}", CStr(vArray(REQUEST_TAG)), CStr(vArray(REQUEST_NAME)))
lblClan.Caption = StringFormat("Clan {0}", CStr(vArray(REQUEST_TAG)))
lblClan.ForeColor = RTBColors.JoinUsername
lblName.Caption = CStr(vArray(REQUEST_NAME))
lblInv.Caption = StringFormat("Invited by: {0}", CStr(vArray(REQUEST_INV)))
Call tmrTimeout_Timer

cmdAccept.Enabled = False
cmdDecline.Enabled = False
tmrTimeout.Enabled = True
Exit Sub
End If
End If

Me.Icon = frmChat.Icon
cmdAccept.Enabled = False
cmdDecline.Enabled = False

ClanAcceptTimerID = SetTimer(frmClanInvite.hWnd, 0, 2000, AddressOf ClanInviteTimerProc)
' no pending invite...
Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
If ClanAcceptTimerID > 0 Then
KillTimer 0, ClanAcceptTimerID
tmrTimeout.Enabled = False
End Sub

Private Sub tmrTimeout_Timer()
If Ticks <= CLAN_BUTTON_TIMEOUT Then
cmdAccept.Enabled = True
cmdDecline.Enabled = True
End If

If Ticks <= 0 Then
cmdDecline_Click
Exit Sub
End If

lblTimer.Caption = StringFormat("Invitation expires in {0} second{1}...", _
Ticks, IIf(Ticks <> 1, "s", vbNullString))

Ticks = Ticks - 1
End Sub

@@ -11,7 +11,6 @@ Public Database As New clsDatabase
Public ReconnectTimerID As Long
Public ExReconnectTimerID As Long
Public SCReloadTimerID As Long
Public ClanAcceptTimerID As Long
Public QueueTimerID As Long
Public rtbWhispersVisible As Boolean
Public cboSendHadFocus As Boolean
@@ -62,23 +62,6 @@ Public Sub ScriptReload_TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal
End If
End Sub

'/* Timer proc for invite accept form - deny accept/decline of the invitation for 3 sec */
Public Function ClanInviteTimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTimer As Long)
Call KillTimer(frmClanInvite.hWnd, ClanAcceptTimerID)
ClanAcceptTimerID = 0

frmClanInvite.cmdAccept.Enabled = True
frmClanInvite.cmdDecline.Enabled = True

ClanAcceptTimerID = SetTimer(frmClanInvite.hWnd, 0, 28000, AddressOf ClanInviteTimerProc2)
End Function

'/* Timer proc 2 for invite accept form - autodeclines after 30 seconds */
Public Function ClanInviteTimerProc2(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTimer As Long)
Call KillTimer(frmClanInvite.hWnd, ClanAcceptTimerID)
Call frmClanInvite.cmdDecline_Click
End Function


' Timer procedure for the queue
Public Sub QueueTimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTimer As Long)

0 comments on commit 9559883

Please sign in to comment.
You can’t perform that action at this time.