Bug défilement texte

**skysool** · 21/03/2020, 21h57

Bonjour,

je cherche désespérement à résoudre depuis plusieurs semaines un bug d'affichage de texte, je me tourne vers vous pour espérer résoudre mon probleme...

Dans les grandes lignes j'ai un client relié à un serveur.
En executant une action depuis le client, ce dernier envoi une requete au serveur qui execute une procédure dit "EVENT".
Cet event permet alors d'afficher sur le client une série de textes pré-programmés.

Tout fonctionne à ceci pret que ma boucle s'execute mal...
Le texte défile toutes les x secondes, mais par moment cela saute et passe directement du texte 1 au texte 3.

Quelqu'un pourrait-il d'un oeil neuf me dire si il a une idée ? Voyez-vous une erreur ?

Voici mon code coté serveur pour l'execution du process :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub EventProcess2(ByVal index As Long, IDEvent As Long)
Dim i As Long, u As Long, s As Long, packet As String, SaveEvent As Long
 
    If Not IsConnected(index) Then Exit Sub
    If IDEvent <= 0 Or IDEvent > 1000 Then Exit Sub
 
    USER(index).EventenCours = IDEvent
    USER(index).UserEvent = VAL(GetVar(App.Path & "\accounts\" & Trim$(GetUserLogin(index)) & ".ini", "CHAR" & USER(index).CharNum, "Event" & USER(index).EventenCours))
    USER(index).UserIDAction = VAL(GetVar(App.Path & "\accounts\" & Trim$(GetUserLogin(index)) & ".ini", "CHAR" & USER(index).CharNum, "EventAction" & USER(index).EventenCours))
 
    If USER(index).UserIDAction <= 0 Then
        USER(index).UserIDAction = 1
    End If
 
     ' ===================================== EVENT DEJA REALISE / ACTION EN COURS ? =====================================
    If GetVar(App.Path & "\Events\events" & USER(index).EventenCours & ".ini", "BOUCLE", "valeur") = 0 Then
        If USER(index).UserIDEvent = 1 And USER(index).UserIDAction > 100 Then
            Exit Sub
        End If
    Else
        If USER(index).UserIDAction > 100 Then
            USER(index).UserIDAction = 1
            Call PutVar(App.Path & "\accounts\" & Trim$(GetUserLogin(index)) & ".ini", "CHAR" & USER(index).CharNum, "EventAction" & USER(index).EventenCours, 1)
        End If
    End If
 
    If USER(index).UserIDAction = 1 Then
        Call PutVar(App.Path & "\accounts\" & Trim$(GetUserLogin(index)) & ".ini", "CHAR" & USER(index).CharNum, "SaveMAP", GetUserMap(index))
        Call PutVar(App.Path & "\accounts\" & Trim$(GetUserLogin(index)) & ".ini", "CHAR" & USER(index).CharNum, "SaveX", GetUserX(index))
        Call PutVar(App.Path & "\accounts\" & Trim$(GetUserLogin(index)) & ".ini", "CHAR" & USER(index).CharNum, "SaveY", GetUserY(index))
    End If
 
 
     ' ================================================== RATTRAPAGE ? ==================================================
    If USER(index).UserIDAction > 1 And USER(index).UserIDAction <> 100 And USER(index).Rattrapage = False Then
        Call PutVar(App.Path & "\accounts\" & Trim$(GetUserLogin(index)) & ".ini", "CHAR" & USER(index).CharNum, "SaveMAP", GetUserMap(index))
        Call PutVar(App.Path & "\accounts\" & Trim$(GetUserLogin(index)) & ".ini", "CHAR" & USER(index).CharNum, "SaveX", GetUserX(index))
        Call PutVar(App.Path & "\accounts\" & Trim$(GetUserLogin(index)) & ".ini", "CHAR" & USER(index).CharNum, "SaveY", GetUserY(index))
        Call EventRattrappage(index)
    End If
 
    Call PutVar(App.Path & "\accounts\" & Trim$(GetUserLogin(index)) & ".ini", "CHAR" & USER(index).CharNum, "eventencours", VAL(USER(index).EventenCours))
 
    If Not IsConnected(index) Then Exit Sub
        USER(index).Rattrapage = True
 
 
 
    ' ======================================= AFFICHER UN MESSAGE ===========================================
        If GetVar(App.Path & "\Events\events" & USER(index).EventenCours & ".ini", "ACTION" & USER(index).UserIDAction, "Type") = 2 Then
            Call SendDataTo(index, "picnpc" & SEP_CHAR & GetVar(App.Path & "\Events\events" & USER(index).EventenCours & ".ini", "ACTION" & USER(index).UserIDAction, "Data1") & SEP_CHAR & END_CHAR)
            Call QueteMsg2(index, GetVar(App.Path & "\Events\events" & USER(index).EventenCours & ".ini", "ACTION" & USER(index).UserIDAction, "String1"))
            GoTo FinAction
        End If
 
 
 
 
       ' ======================================= FIN DE L'ACTION ===========================================
 
FinAction:
 
        ' Indique si une action est encore à réaliser
        If USER(index).UserIDAction > 100 Then
            Call SendDataTo(index, "attendre2" & SEP_CHAR & VAL(GetVar(App.Path & "\Events\events" & USER(index).EventenCours & ".ini", "ACTION100", "Data9")) & SEP_CHAR & END_CHAR)
            Call PutVar(App.Path & "\accounts\" & Trim$(GetUserLogin(index)) & ".ini", "CHAR" & USER(index).CharNum, "EventAction" & USER(index).EventenCours, "101")
            GoTo fin
        End If
 
              'Invite à passer à l'action suivante
        USER(index).UserIDAction = USER(index).UserIDAction + 1
        Call PutVar(App.Path & "\accounts\" & Trim$(GetUserLogin(index)) & ".ini", "CHAR" & USER(index).CharNum, "EventAction" & USER(index).EventenCours, VAL(USER(index).UserIDAction))
         GoTo Attendre
 
 
 
 ' =========================================== ATTENTE PROCHAINE ACTION ? ===========================================
 
Attendre:
 
        'Active attente prochaine action
        If GetVar(App.Path & "\Events\events" & USER(index).EventenCours & ".ini", "ACTION" & USER(index).UserIDAction - 1, "Type") <> 1 Or GetVar(App.Path & "\Events\events" & USER(index).EventenCours & ".ini", "ACTION" & USER(index).UserIDAction - 1, "Type") <> 6 Or GetVar(App.Path & "\Events\events" & USER(index).EventenCours & ".ini", "ACTION" & USER(index).UserIDAction - 1, "Type") <> 7 Then
        Call SendDataTo(index, "attendre" & SEP_CHAR & VAL(GetVar(App.Path & "\Events\events" & USER(index).EventenCours & ".ini", "ACTION" & USER(index).UserIDAction - 1, "Data9")) & SEP_CHAR & END_CHAR)
        End If
 
 
        'Active attente2 prochaine action
        If GetVar(App.Path & "\Events\events" & USER(index).EventenCours & ".ini", "ACTION" & USER(index).UserIDAction, "Type") = 0 Then
            Call SendDataTo(index, "attendre2" & SEP_CHAR & VAL(GetVar(App.Path & "\Events\events" & USER(index).EventenCours & ".ini", "ACTION" & USER(index).UserIDAction - 1, "Data9")) & SEP_CHAR & END_CHAR)
            Call PutVar(App.Path & "\accounts\" & Trim$(GetUserLogin(index)) & ".ini", "CHAR" & USER(index).CharNum, "EventAction" & USER(index).EventenCours, "101")
            GoTo fin
        End If
 
Exit Sub
 
 
 
           ' =========================================== FIN EVENT ===========================================
fin:
 
    Call PutVar(App.Path & "\accounts\" & Trim$(USER(index).Login) & ".ini", "CHAR" & USER(index).CharNum, "Event" & USER(index).EventenCours, "1")
    USER(index).InEvent = False
    USER(index).Rattrapage = False
    USER(index).UserIDAction = 101
    USER(index).EventenCours = 0
    Call PutVar(App.Path & "\accounts\" & Trim$(GetUserLogin(index)) & ".ini", "CHAR" & USER(index).CharNum, "eventencours", 0)
    Call SendDataTo(index, "eventoff" & SEP_CHAR & END_CHAR)
    Call SendDataTo(index, "closetxtq" & SEP_CHAR & END_CHAR)
 
End Sub

Voici mon code coté client :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
 If (LCase$(Parse(0)) = "attendre") Then
        If USER(MyIndex).Sec > USER(MyIndex).Waiting Then
            Call SendNext
            USER(MyIndex).Sec = 0
        End If
 
 
        If Val(Parse(1)) >= 1 Then
            USER(MyIndex).Waiting = Val(Parse(1))
            USER(MyIndex).WaitingTime = GetTickCount
            USER(MyIndex).Sec = 1
        Else
            Call SendNext
        End If
    Exit Sub
    End If

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Sub Attendre()
 
    If USER(MyIndex).Sec = 0 Then Exit Sub
 
    If GetTickCount > USER(MyIndex).WaitingTime + 1000 Then
        USER(MyIndex).WaitingTime = GetTickCount
        USER(MyIndex).Sec = USER(MyIndex).Sec + 1
 
 
        If USER(MyIndex).Sec > USER(MyIndex).Waiting Then
            Call SendNext
            USER(MyIndex).Waiting = 0
            USER(MyIndex).Sec = 0
        End If
    End If
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
        If (LCase$(Parse(0)) = "attendre2") Then
        If Val(Parse(1)) >= 1 Then
            USER(MyIndex).Waiting2 = Val(Parse(1))
            USER(MyIndex).WaitingTime2 = GetTickCount
            USER(MyIndex).Sec2 = 1
        Else
            InEvent = False
            Call CloseTxt
            frmMirage.CacheBAS.Visible = False
            frmMirage.Cachehaut.Visible = False
            USER(MyIndex).Waiting2 = 0
            USER(MyIndex).WaitingTime2 = 0
            USER(MyIndex).Sec2 = 0
        End If
    Exit Sub
    End If

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
Sub Attendre2()
    If USER(MyIndex).Sec2 = 0 Then Exit Sub
 
    If GetTickCount > USER(MyIndex).WaitingTime2 + 2000 Then '<== test bug event ?
        USER(MyIndex).WaitingTime2 = GetTickCount
        USER(MyIndex).Sec2 = USER(MyIndex).Sec2 + 1
 
        If USER(MyIndex).Sec2 + 1 > USER(MyIndex).Waiting2 Then '<== test bug +1
            Call CloseTxt
            frmMirage.CacheBAS.Visible = False
            frmMirage.Cachehaut.Visible = False
            frmMirage.PicNExt.Visible = False
            frmMirage.PicOK.Visible = False
            frmMirage.Label5.Enabled = True
            USER(MyIndex).Waiting2 = 0
            InEvent = False
            USER(MyIndex).Sec2 = 0
        End If
    End If
 
End Sub

Voici le sub coté client permettant de relancer la boucle coté serveur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Sub SendNext()
Dim packet As String
 
    packet = "next" & SEP_CHAR & END_CHAR
    Call SendData(packet)
End Sub

Un grand merci à toutes les personnes qui voudront bien m'aider

**skysool** · 24/03/2020, 18h22

Faute de réponses j'ai actualisé mon post

Pitié une âme charitable en cette periode de confinement pourrait prendre un peu de temps à me lire et m'aider

?

Merci

[EDIT 25/03/2020]
J'ai continué toute la journée mes recherches, en vain...

J'ai oublié de rajouter le code coté serveur suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
    Case "next"
        If USER(index).EventenCours > 0 Then
            Call EventProcess(index, USER(index).EventenCours)
        End If
    Exit Sub

Bug défilement texte

VB 6 et antérieur

Discussions similaires

Partager

Partager