Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VB 6 et antérieur Discussion :

Bug défilement texte


Sujet :

VB 6 et antérieur

  1. #1
    Membre à l'essai
    Bug défilement texte
    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

  2. #2
    Membre à l'essai
    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

###raw>template_hook.ano_emploi###