CHAT for QB64 - Printable Version

Code: (Select All)
Randomize Timer







'profile data -----------------------------------------------------------------------------------------



my_name$ = "user" 'your nickname

my_info$ = "i am ...." 'short introduction

my_color&& = _RGB32(55 + 200 * Rnd, 55 + 200 * Rnd, 55 + 200 * Rnd, 255) 'your color

'----------------------------------------------------------------------------------------------------------



Const fc$ = "sudlikam"



connect_ip$ = "95.138.193.62"

connect_port$ = "60000"

mess_c = 20





my_name$ = my_name$ + "_" + LTrim$(Str$(Int(100 * Rnd(1))))



bg&& = _RGB32(30, 10, 10): _Title "client - " + my_name$

max_client = 100: Dim c$(max_client - 1, 9), active(max_client - 1), cpic(max_client - 1, 1), mess$(mess_c - 1), v(max_client - 1, 1)

monx = 1000: mony = 550: mon = _NewImage(monx, mony, 32): Screen mon



'connection

Dim Shared connection&, dat$, mess$

Do: _Limit 10: If InKey$ = Chr$(27) Then System

    connection& = _OpenClient("TCP/IP:" + connect_port$ + ":" + connect_ip$)

    If connection& = 0 Then Print "no connection"

Loop Until connection&







send "0nam" + my_name$: send "1inf" + my_info$

send "4col" + Right$("00" + Hex$(_Red(my_color&&)), 2) + Right$("00" + Hex$(_Green(my_color&&)), 2) + Right$("00" + Hex$(_Blue(my_color&&)), 2) + Right$("00" + Hex$(_Alpha(my_color&&)), 2)





Do: _Limit 20



    If Abs(Timer - sign_timer) > 2 Then send "sign": sign_timer = Timer



    Do

        s$ = get2$

        If Len(s$) Then

            Select Case Mid$(s$, 5, 4)

                Case "5pos", "0nam", "1inf", "3msg", "4col"

                    c$(Val(Left$(s$, 4)), Val(Mid$(s$, 5, 1))) = Mid$(s$, 9)

                Case "addc": active(Val(Left$(s$, 4))) = 1: Sound 2000, .2

                Case "delc": active(Val(Left$(s$, 4))) = 0

                    If cpic(Val(Left$(s$, 4)), 1) Then _FreeImage cpic(Val(Left$(s$, 4)), 0)

                    cpic(Val(Left$(s$, 4)), 1) = 0

                Case "cmsg": mess$(cm) = Mid$(s$, 9): cm = (cm + 1) Mod mess_c

                Case "srok": srok = Timer

            End Select

        End If

    Loop While Len(s$)











    'show header

    While _MouseInput: Wend





    Color my_color&&: Print my_name$; "- client   ",

    If Abs(srok - Timer) > 5 Then

        Color _RGB32(255, 0, 0): Print "Server no answer"

    Else

        Color _RGB32(0, 255, 0): Print "Server is OK ! "

    End If



    Color _RGB32(150, 150, 150): Print String$(monx / 8 - 1, "-"): Print "connected : ";



    startx = 14 * 8: starty = 2 * 16: show_info = -1

    For c = 0 To max_client - 1: If active(c) = 0 Then _Continue

        If c$(c, 4) = "" Then

            Color _RGB32(150, 150, 150)

        Else

            For t = 0 To 3: co(t) = Val("&h" + Mid$(c$(c, 4), t * 2 + 1, 2)): Next t

            Color _RGB32(0, 0, 0), _RGB32(co(0), co(1), co(2), co(3))

        End If

        If Len(c$(c, 0)) * 8 + startx > monx - 10 Then startx = 0: starty = starty + 16

        _PrintString (startx, starty), c$(c, 0)

        If _MouseX > startx And _MouseX < startx + Len(c$(c, 0)) * 8 And _MouseY > starty And _MouseY < starty + 16 Then show_info = c

        startx = startx + (Len(c$(c, 0)) + 2) * 8

    Next c



    If show_info <> -1 Then

        Color _RGB32(100, 100, 100), _RGB32(255, 255, 255): startx = _MouseX

        If startx + Len(c$(show_info, 1)) * 8 > monx - 10 Then startx = monx - 10 - Len(c$(show_info, 1)) * 8

        _PrintString (startx, _MouseY + 16), c$(show_info, 1)

    End If





    Color , bg&&



    'show message my type

    Color my_color&&: If Int(Timer * 10) And 1 Then cr$ = "_" Else cr$ = " "

    Locate mony / 16 - 2, 1: Print mess$; cr$;



    'show messages

    For t = 0 To mess_c - 1

        y = mony / 16 - 2 - mess_c: Locate y + t, 1: s$ = mess$((cm + t) Mod mess_c)

        Color _RGBA32(Val("&h" + Mid$(s$, 1, 2)), Val("&h" + Mid$(s$, 3, 2)), Val("&h" + Mid$(s$, 5, 2)), Val("&h" + Mid$(s$, 7, 2)))

    Print Mid$(s$, 19): Next t



    _Display: Color , _RGB32(0, 0, 0): Cls





    Line (0, mony - (mess_c + 4) * 16)-(monx, mony), bg&&, BF



    'type message

    k$ = InKey$

    If Len(k$) Then

        a = Asc(k$)

        If a = 27 Then System

        If a = 13 And Len(mess$) Then send "3msg" + mess$: mess$ = ""

        If a = 8 Then mess$ = Left$(mess$, Len(mess$) - 1)

        felt = (a > 31 And a < 91) Or (a > 96 And a < 123)

        If felt Then mess$ = mess$ + k$

    End If



Loop





err1: hiba = 1: Resume Next



Sub send (s$): s2$ = s$ + fc$: Put connection&, , s2$: End Sub

Function get2$

    If Len(dat$) = 0 Then Get connection&, , st$: dat$ = dat$ + st$

    If Len(dat$) = 0 Then Exit Function

    ok = -1: For t = 1 To Len(dat$)

        If Mid$(dat$, t, Len(fc$)) = fc$ Then ok = t: Exit For

    Next t

    If ok = -1 Then Exit Function

    get2$ = Left$(dat$, ok - 1): dat$ = Mid$(dat$, ok + Len(fc$))

End Function