Option Explicit
DefInt A-Z
Dim Bold, Reverse, Bcolor, Fcolor, Css, ox, oy
Dim Connected As Boolean
Dim WantDisconnect As Boolean
Dim ccount As Long
Dim ln11() As Byte
Dim gTest As Long
Dim ArrowArr(2) As Byte
Dim WinPos As WINDOWPOS
Dim m_cTT As New cTooltip
Implements ISubclass
Dim WantQuit As Boolean
'---------------------------
Dim MsgCome As Boolean
'fd
'fd
'fd
'---------------------------
Dim Dealing As Boolean

Private Sub Box1_GotFocus()
On Error Resume Next
txtKeyboard.SetFocus
End Sub

Private Sub Check1_Click()
On Error Resume Next
txtKeyboard.SetFocus
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
    Case Else
        tb.UnFocusMe
End Select

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 13
    If Not Connected Then
        Call Connect
        KeyAscii = 0
    End If
End Select
End Sub

Private Sub Form_Load()
With ln1
    .X1 = 0
    .X2 = 20000
    .Y1 = 0
    .Y2 = 0
    .BorderColor = vb3DShadow
End With
With ln2
    .X1 = 0
    .X2 = 20000
    .Y1 = 1
    .Y2 = 1
    .BorderColor = vb3DHighlight
End With
With tb
    .AddButton "address", , "ַ"
    .AddButton "lock", , "סBBS"
    .AddButton "quit", , "վ"
    .AddButton "connect", , "ٴ"
    .AddButton "batch", , "ִ(F2)"
    .AddButton "idle", True, "ֹ"
    .AddButton "find"
    .AddButton "tcp", , "TCP"
    .AddButton "filedownload", , "ǳ"
    .AddButton "downfile", , "(F3)"
    .AddButton "editfile", , "±༭", False
    .AddSplit
    .AddButton "bold", , ""
    .AddButton "color", , "ñɫ"
    .AddSplit
    .AddButton "help", , ""
End With
Set Box1.Logo = imgLogo
Box1.LogoVisible = True
mnFastQuit.Caption = "[&F]վ!" & vbTab & "Alt_Q"
Dim tLeft As Long, tTop As Long, tWidth As Long, tHeight As Long, tWindowState As Long
tLeft = Val(gIni.GetSetting("Settings", "WinLeft", 27))
tTop = Val(gIni.GetSetting("Settings", "WinTop", 31))
tWidth = Val(gIni.GetSetting("Settings", "WinWidth", 732))
tHeight = Val(gIni.GetSetting("Settings", "WinHeight", 518))
SetWindowPos hwnd, 0, tLeft, tTop, tWidth, tHeight, &H4
tWindowState = Val(gIni.GetSetting("Settings", "WinState", 0))
Me.WindowState = tWindowState
ReDim ln11(255)
ArrowArr(0) = 27
ArrowArr(1) = 91
InitToolTip
Caption = CurSite.SiteName
#If IDEMODE <> 1 Then
    AttachMessage Me, hwnd, WM_WINDOWPOSCHANGED
#End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Static Unloading As Boolean
WantQuit = True
If Unloading = False Then
    #If IDEMODE <> 1 Then
        DetachMessage Me, hwnd, WM_WINDOWPOSCHANGED
    #End If
    Disconnect
    DoEvents
    Box1.KillMe
    Unloading = True
    Unload Me
End If
'DoEvents
End Sub

Private Sub Form_Resize()
'tb.Visible = False
On Error Resume Next
tb.Enabled = False
DoEvents
tb.Move -3, 2
Box1.Move 0, 31, ScaleWidth, ScaleHeight - 31
tb.Enabled = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim t As Long
#If IDEMODE = 1 Then
    Dim r As RECT
    GetWindowRect hwnd, r
    With r
        gIni.SaveSetting "Settings", "WinLeft", .Left
        gIni.SaveSetting "Settings", "WinTop", .Top
        gIni.SaveSetting "Settings", "WinWidth", .Right - .Left
        gIni.SaveSetting "Settings", "WinHeight", .Bottom - .Top
    End With
#Else
    With WinPos
        gIni.SaveSetting "Settings", "WinLeft", .x
        gIni.SaveSetting "Settings", "WinTop", .y
        gIni.SaveSetting "Settings", "WinWidth", .cx
        gIni.SaveSetting "Settings", "WinHeight", .cy
    End With
#End If
gIni.SaveSetting "Settings", "WinState", Me.WindowState
With CurSite
    'MsgBox .Host
    gIni.SaveSetting "Settings", "LastHost", .Host
    gIni.SaveSetting "Settings", "LastPort", .Port
    gIni.SaveSetting "Settings", "LastSiteName", .SiteName
    gIni.SaveSetting "Settings", "LastLoginScript", .LoginStr
End With
'End
End Sub

Private Sub List1_Click()
txtKeyboard.SetFocus
End Sub

Private Sub mnAbout_Click()
Dim tfrm As Form
Set tfrm = New frmAbout
tfrm.Show 1, Me
Unload tfrm
Set tfrm = Nothing
End Sub

Private Sub mnAddress_Click()
frmAddress.Show 1, Me
End Sub

Private Sub mnDisconnect_Click()
Disconnect
End Sub

Private Sub mnF1_Click()
ShowFrmInput
End Sub

Private Sub mnIntroduce_Click()
frmIntroduce.Show 1, Me
End Sub

Private Sub mnmru_Click(Index As Integer)
'On Error Resume Next
Dim tarr() As String
tarr = Split(mnmru(Index).Tag, sepchar8)
With CurSite
    .SiteName = Mid(mnmru(Index).Caption, 4)
    .Host = tarr(0)
    .Port = Val(tarr(1))
    .LoginStr = tarr(2)
End With
SetFirstMRU CLng(Index)
Connect
End Sub

Private Sub mnQuit_Click()
Unload Me
End Sub

Private Sub tb_Click(button As button)
Select Case button.Key
    Case "address"
        frmAddress.Show 1, Me
    Case "lock"
    
    Case "quit"
        Winsock1.SendData 33: DoEvents
        Winsock1.SendData 33: DoEvents
        Winsock1.SendData 33: DoEvents
        Winsock1.SendData 13
        Winsock1.SendData 10
        
    Case "connect"
        If Connected Then
            With CurSite
                gIni.SaveSetting "Settings", "CurSiteName", .SiteName
                gIni.SaveSetting "Settings", "CurHost", .Host
                gIni.SaveSetting "Settings", "CurPort", .Port
                gIni.SaveSetting "Settings", "CurLoginScript", .LoginStr
            End With
            Shell App.Path & "\" & App.EXEName & " connect", vbNormalFocus
        Else
            Call Connect
        End If
    Case "batch"
        Winsock1.SendData "cy"
    Case "idle"
    
    Case "find"
    
    Case "tcp"
        tb.SetButtonEnabled "tcp", False
    Case "filedownload"
        MsgBox tb.GetButtonEnabled("tcp")
    Case "downfile'"
    
    Case "editfile"
    
    Case "bold"
        Debug.Print Me.Left & "!"
        Debug.Print Me.Top & "!"
        Debug.Print Me.Width & "!"
        Debug.Print Me.Height & "!"
    Case "color"
        Box1.test
    Case "help"
        picTrack.Visible = Not picTrack.Visible

End Select
End Sub

Private Sub Timer1_Timer()
Main
'On Error Resume Next
'Debug.Print Me.ActiveControl.Name
End Sub

Private Sub txtKeyboard_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case 38
    'SendChars "27;91;65"
    ArrowArr(2) = 65
    Winsock1.SendData ArrowArr
Case 40
    ArrowArr(2) = 66
    Winsock1.SendData ArrowArr
    'SendChars "27;91;66"
Case 37
    ArrowArr(2) = 68
    Winsock1.SendData ArrowArr
    'SendChars "27;91;68"
Case 39
    ArrowArr(2) = 67
    Winsock1.SendData ArrowArr
    'SendChars "27;91;67"
End Select

End Sub
  
Private Sub txtKeyboard_KeyPress(KeyAscii As Integer)
Winsock1.SendData Chr(KeyAscii)
Select Case KeyAscii
Case 114, 82 'r,R
    If MsgCome Then
        'Main
        ShowFrmInput
    End If
End Select
KeyAscii = 0
'Static l As Long
'If KeyAscii >= 0 Then
'    Winsock1.SendData CByte(KeyAscii)
'    Exit Sub
'Else
'    l& = KeyAscii + 65536
'    Winsock1.SendData l
'    l = 0
'End If
'SendChars str$(l& \ 256) + ";" + str$(l& Mod 256)
End Sub
  
Function Inkey() As Byte
Dim b As Byte
While Winsock1.BytesReceived = 0
    If WantDisconnect Then Exit Function
    Nop
Wend
Winsock1.GetData b: Inkey = b
If Check1.Value Then List1.AddItem b & "(" & Chr(b) & ")", 0
End Function
  
Sub Nop()
If WantQuit Then Exit Sub
DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
End Sub
  
Function VVV(d$)
VVV = Val(d$): d$ = Mid$(d$, InStr(d$ + ";", ";") + 1)
End Function
  
Sub SendChars(d$)
Dim b As Byte
While d$ <> ""
    b = VVV(d$)
    Winsock1.SendData b
    If Check1.Value Then List1.AddItem "-> b & (" & Chr(b) & ")", 0
Wend
End Sub

Private Sub Form_MouseUp(button As Integer, Shift As Integer, x As Single, y As Single)
If button = 2 Then mybbs.Show
End Sub

Private Sub Winsock1_Close()
Box1.Clear
Box1.LogoVisible = True
Connected = False
txtKeyboard.Enabled = False
Winsock1.Close
End Sub

Private Sub Winsock1_Connect()
On Error Resume Next
Connected = True
txtKeyboard.Enabled = True
txtKeyboard.SetFocus
Box1.LogoVisible = False
End Sub

Public Sub Connect()
On Error Resume Next
frmConnecting.Show 1, Me
Caption = CurSite.SiteName
AddMRU CurSite
WantDisconnect = False
txtKeyboard.SetFocus
'If Winsock1.State = sckConnected Then Timer1.Enabled = True
'Call Main
End Sub

Public Sub Disconnect()
WantDisconnect = True
Winsock1_Close
End Sub

'-------------------------
Private Sub Main()
Dim b As Byte, c As Byte, d As Byte, s As String, dat As String, v As Long, xx As Long, yy As Long, LL
Dim ColorChanged As Boolean
'Debug.Print "Main Begin!-------- " & Winsock1.BytesReceived
Box1.PauseBlink = True
Dealing = True
BeginDeal:
While Winsock1.BytesReceived > 0
If WantQuit Then End
b = Inkey
Select Case b
Case 255
    c = Inkey
    d = Inkey
    If c = 253 And (d = 1 Or d = 24) Then
        SendChars "255;251;" & d: GoTo L2
    End If
    If c = 254 And d = 1 Then
        SendChars "255;252;1": GoTo L2
    End If
    If c = 251 And d = 1 Then
        SendChars "255;253;1": GoTo L2
    End If
    If c = 250 Then
        While d <> 240: d = Inkey: Wend:
        SendChars "255;250;24;0;118;116;49;48;48;255;240"
        GoTo L2
    End If
    If c = 253 Then
        SendChars "255;252;" & d: GoTo L2
    End If
Case 27
    s = ""
    c = Inkey
    If c <> 91 Then GoTo L2
L1:
    dat = Chr$(Inkey)
    If InStr(" 0123456789;", dat$) > 1 Then
        s$ = s$ + dat: GoTo L1
    End If
    Select Case dat$
    Case "m"
        FlushBuffer
        If s$ = "" Then
            Box1.HighLight = True
            Box1.Reverse = False
            Box1.ForeGround = 37
            Box1.BackGround = 40
            Box1.Blink = False
        End If
        While s$ <> ""
            v = VVV(s$)
            If v > 29 And v < 38 Then: Box1.ForeGround = v
            If v > 39 And v < 48 Then: Box1.BackGround = v
            If v = 0 Then
                Box1.HighLight = False
                Box1.Reverse = False
                Box1.ForeGround = 37
                Box1.BackGround = 40
                Box1.Blink = False
            End If
            If v = 1 Then
                Box1.HighLight = True
            End If
            If v = 5 Then: Box1.Blink = True
            If v = 7 Then: Box1.Reverse = True
        Wend
    Case "K"
        Box1.ClrEoL
    Case "H"
        FlushBuffer
        yy = VVV(s$): xx = VVV(s$): Box1.GotoXY CLng(xx), CLng(yy)
    Case "J"
        ccount = 0
        Box1.Clear
    Case "A"
        FlushBuffer
        yy = VVV(s$)
        Box1.MoveUp CLng(yy)
    Case "B"
        FlushBuffer
        yy = VVV(s$)
        Box1.MoveDown CLng(yy)
    Case "C"
        FlushBuffer
        xx = VVV(s$)
        Box1.MoveRight CLng(xx)
    Case "D"
        FlushBuffer
        xx = VVV(s$)
        Box1.MoveLeft CLng(xx)
    End Select
Case 7
    Beep
    MsgCome = True
Case 8
    FlushBuffer
    Box1.MoveLeft 1
Case 13
    FlushBuffer
    Box1.GotoX 1
Case 0
Case 10
    FlushBuffer
    Box1.MoveDown 1
Case Else
    ln11(ccount) = b
    ccount = ccount + 1
End Select
L2:
Wend
FlushBuffer
Box1.Redraw
Nop
If Winsock1.BytesReceived > 0 Then GoTo BeginDeal
Box1.PauseBlink = False
If Check1.Value Then List1.AddItem "-------------------------------", 0
'Debug.Print "Main Complete!-------"
Dealing = False
End Sub

Private Sub FlushBuffer()
'Debug.Print "FlushBuffer" & Now
Box1.OutText ln11, ccount
ccount = 0
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
If Not Dealing Then Main
End Sub

Private Sub InitToolTip()
With m_cTT
    Call .Create(Me)
    .MaxTipWidth = 240
    .DelayTime(ttDelayShow) = 20000
    .AddTool tb, ""
End With
End Sub

Private Sub tb_ButtonHover(HoverOut As Boolean, ToolTip As String)
m_cTT.ToolText(tb) = ToolTip
End Sub

Private Property Let ISubclass_MsgResponse(ByVal RHS As EMsgResponse)
'
End Property
Private Property Get ISubclass_MsgResponse() As EMsgResponse
ISubclass_MsgResponse = emrPostProcess
End Property

Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case iMsg
Case WM_WINDOWPOSCHANGED
    If Me.WindowState = 0 Then CopyMemory WinPos, ByVal lParam, 28
End Select
End Function

Private Sub ShowFrmInput()
#If IDEMODE = 1 Then
    Dim r As RECT, r1 As RECT
    GetWindowRect hwnd, r
    SystemParametersInfo SPI_GETWORKAREA, vbNull, r1, 0
    SetWindowPos frmInput.hwnd, 0, r.Left + 3, r1.Bottom - r1.Top - 80, 0, 0, SWP_NOSIZE Or SWP_NOACTIVATE
#Else
    Dim r As RECT
    SystemParametersInfo SPI_GETWORKAREA, vbNull, r, 0
    SetWindowPos frmInput.hwnd, 0, WinPos.x + 3, r.Bottom - r.Top - 80, 0, 0, SWP_NOSIZE Or SWP_NOACTIVATE
#End If
frmInput.Show 1, Me
End Sub

















-----------------------------------------------------------------
        '----update text buffer
        t = i - p
        CopyMemory LineBuffer(p1), bts(p), t
        Box1.OutText LineBuffer, p1 + t
        p1 = 0
        '-------------------------------------------------------
        
        
        
    
        s = ""
        i = i + 1
        c = bts(i)
        If c <> 91 Then GoTo EndParseEsc
L1:
        i = i + 1
        If Check1.Value Then List1.AddItem bts(i) & "(" & Chr(bts(i)) & ")", 0        'zzz
        dat = Chr$(bts(i))
        If InStr(" 0123456789;", dat$) > 1 Then
            s$ = s$ + dat: GoTo L1
        End If
        Select Case dat$
        Case "m"
            If s$ = "" Then
                Box1.HighLight = True
                Box1.Reverse = False
                Box1.ForeGround = 37
                Box1.BackGround = 40
                Box1.Blink = False
            End If
            While s$ <> ""
                v = VVV(s$)
                If v > 29 And v < 38 Then: Box1.ForeGround = v
                If v > 39 And v < 48 Then: Box1.BackGround = v
                If v = 0 Then
                    Box1.HighLight = False
                    Box1.Reverse = False
                    Box1.ForeGround = 37
                    Box1.BackGround = 40
                    Box1.Blink = False
                End If
                If v = 1 Then
                    Box1.HighLight = True
                End If
                If v = 5 Then: Box1.Blink = True
                If v = 7 Then: Box1.Reverse = True
            Wend
        Case "K"
            Box1.ClrEoL
        Case "H"
            yy = VVV(s$): xx = VVV(s$): Box1.GotoXY CLng(xx), CLng(yy)
        Case "J"
            Box1.Clear
        Case "A"
            yy = VVV(s$)
            Box1.MoveUp CLng(yy)
        Case "B"
            yy = VVV(s$)
            Box1.MoveDown CLng(yy)
        Case "C"
            xx = VVV(s$)
            Box1.MoveRight CLng(xx)
        Case "D"
            xx = VVV(s$)
            Box1.MoveLeft CLng(xx)
        End Select
        
EndParseEsc:
        p = i + 1
















---------------------------------------------------------------------------------


Option Explicit
Dim Connected As Boolean
Dim LineBuffer(255) As Byte
Dim OldBts() As Byte, HaveOldBts As Boolean
Dim bts() As Byte
Dim bts1() As Byte
Dim ArrowArr(2) As Byte
Dim WinPos As WINDOWPOS
Dim m_cTT As New cTooltip
Implements ISubclass
'---------------------------
Dim MsgCome As Boolean
'---------------------------
Dim Dealing As Boolean
Private Const MaxDelay As Long = 40000

Private Sub Box1_GotFocus()
On Error Resume Next
txtKeyboard.SetFocus
End Sub

Private Sub Check1_Click()
On Error Resume Next
txtKeyboard.SetFocus
End Sub

Private Sub Command2_Click()
Dim ts As String
Dim i As Long, t As Long
t = List1.ListCount - 1
ts = InputBox("")
For i = 0 To t
    If InStr(1, List1.List(i), ts) <> 0 Then
        List1.ListIndex = i
        Exit For
    End If
Next i
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
    Case Else
        tb.UnFocusMe
End Select

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 13
    If Not Connected Then
        Call Connect
        KeyAscii = 0
    End If
End Select
End Sub

Private Sub Form_Load()
With ln1
    .X1 = 0
    .X2 = 20000
    .Y1 = 0
    .Y2 = 0
    .BorderColor = vb3DShadow
End With
With ln2
    .X1 = 0
    .X2 = 20000
    .Y1 = 1
    .Y2 = 1
    .BorderColor = vb3DHighlight
End With
With tb
    .AddButton "address", , "ַ"
    .AddButton "lock", , "סBBS"
    .AddButton "quit", , "վ"
    .AddButton "connect", , "ٴ"
    .AddButton "batch", , "ִ(F2)"
    .AddButton "idle", True, "ֹ"
    .AddButton "find"
    .AddButton "tcp", , "TCP"
    .AddButton "filedownload", , "ǳ"
    .AddButton "downfile", , "(F3)"
    .AddButton "editfile", , "±༭", False
    .AddSplit
    .AddButton "bold", , ""
    .AddButton "color", , "ñɫ"
    .AddSplit
    .AddButton "help", , ""
End With
Set Box1.Logo = imgLogo
Box1.LogoVisible = True
mnFastQuit.Caption = "[&F]վ!" & vbTab & "Alt_Q"
Dim tLeft As Long, tTop As Long, tWidth As Long, tHeight As Long, tWindowState As Long
tLeft = Val(gIni.GetSetting("Settings", "WinLeft", 27))
tTop = Val(gIni.GetSetting("Settings", "WinTop", 31))
tWidth = Val(gIni.GetSetting("Settings", "WinWidth", 732))
tHeight = Val(gIni.GetSetting("Settings", "WinHeight", 518))
SetWindowPos hwnd, 0, tLeft, tTop, tWidth, tHeight, &H4
tWindowState = Val(gIni.GetSetting("Settings", "WinState", 0))
Me.WindowState = tWindowState
ReDim ln11(255)
ArrowArr(0) = 27
ArrowArr(1) = 91
InitToolTip
Caption = CurSite.SiteName
#If IDEMODE <> 1 Then
    AttachMessage Me, hwnd, WM_WINDOWPOSCHANGED
#End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Static Unloading As Boolean
If Unloading = False Then
    #If IDEMODE <> 1 Then
        DetachMessage Me, hwnd, WM_WINDOWPOSCHANGED
    #End If
    Disconnect
    DoEvents
    Box1.KillMe
    Unloading = True
    Unload Me
End If
'DoEvents
End Sub

Private Sub Form_Resize()
'tb.Visible = False
On Error Resume Next
tb.Enabled = False
DoEvents
tb.Move -3, 2
Box1.Move 0, 31, ScaleWidth, ScaleHeight - 31
tb.Enabled = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim t As Long
#If IDEMODE = 1 Then
    Dim r As RECT
    GetWindowRect hwnd, r
    With r
        gIni.SaveSetting "Settings", "WinLeft", .Left
        gIni.SaveSetting "Settings", "WinTop", .Top
        gIni.SaveSetting "Settings", "WinWidth", .Right - .Left
        gIni.SaveSetting "Settings", "WinHeight", .Bottom - .Top
    End With
#Else
    With WinPos
        gIni.SaveSetting "Settings", "WinLeft", .x
        gIni.SaveSetting "Settings", "WinTop", .y
        gIni.SaveSetting "Settings", "WinWidth", .cx
        gIni.SaveSetting "Settings", "WinHeight", .cy
    End With
#End If
gIni.SaveSetting "Settings", "WinState", Me.WindowState
With CurSite
    'MsgBox .Host
    gIni.SaveSetting "Settings", "LastHost", .Host
    gIni.SaveSetting "Settings", "LastPort", .Port
    gIni.SaveSetting "Settings", "LastSiteName", .SiteName
    gIni.SaveSetting "Settings", "LastLoginScript", .LoginStr
End With
'End
End Sub

Private Sub List1_Click()
txtKeyboard.SetFocus
End Sub

Private Sub mnAbout_Click()
Dim tfrm As Form
Set tfrm = New frmAbout
tfrm.Show 1, Me
Unload tfrm
Set tfrm = Nothing
End Sub

Private Sub mnAddress_Click()
frmAddress.Show 1, Me
End Sub

Private Sub mnDisconnect_Click()
Disconnect
End Sub

Private Sub mnF1_Click()
ShowFrmInput
End Sub

Private Sub mnIntroduce_Click()
frmIntroduce.Show 1, Me
End Sub

Private Sub mnmru_Click(Index As Integer)
'On Error Resume Next
Dim tarr() As String
tarr = Split(mnmru(Index).Tag, sepchar8)
With CurSite
    .SiteName = Mid(mnmru(Index).Caption, 4)
    .Host = tarr(0)
    .Port = Val(tarr(1))
    .LoginStr = tarr(2)
End With
SetFirstMRU CLng(Index)
Connect
End Sub

Private Sub mnQuit_Click()
Unload Me
End Sub

Private Sub InitToolTip()
With m_cTT
    Call .Create(Me)
    .MaxTipWidth = 240
    .DelayTime(ttDelayShow) = 20000
    .AddTool tb, ""
End With
End Sub

Private Sub tb_ButtonHover(HoverOut As Boolean, ToolTip As String)
m_cTT.ToolText(tb) = ToolTip
End Sub

Private Property Let ISubclass_MsgResponse(ByVal RHS As EMsgResponse)
'
End Property
Private Property Get ISubclass_MsgResponse() As EMsgResponse
ISubclass_MsgResponse = emrPostProcess
End Property

Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case iMsg
Case WM_WINDOWPOSCHANGED
    If Me.WindowState = 0 Then CopyMemory WinPos, ByVal lParam, 28
End Select
End Function

Private Sub ShowFrmInput()
#If IDEMODE = 1 Then
    Dim r As RECT, r1 As RECT
    GetWindowRect hwnd, r
    SystemParametersInfo SPI_GETWORKAREA, vbNull, r1, 0
    SetWindowPos frmInput.hwnd, 0, r.Left + 3, r1.Bottom - r1.Top - 80, 0, 0, SWP_NOSIZE Or SWP_NOACTIVATE
#Else
    Dim r As RECT
    SystemParametersInfo SPI_GETWORKAREA, vbNull, r, 0
    SetWindowPos frmInput.hwnd, 0, WinPos.x + 3, r.Bottom - r.Top - 80, 0, 0, SWP_NOSIZE Or SWP_NOACTIVATE
#End If
frmInput.Show 1, Me
End Sub

Private Sub tb_Click(button As button)
Select Case button.Key
    Case "address"
        frmAddress.Show 1, Me
    Case "lock"
    
    Case "quit"
        Winsock1.SendData 33: DoEvents
        Winsock1.SendData 33: DoEvents
        Winsock1.SendData 33: DoEvents
        Winsock1.SendData 13
        Winsock1.SendData 10
        
    Case "connect"
        If Connected Then
            With CurSite
                gIni.SaveSetting "Settings", "CurSiteName", .SiteName
                gIni.SaveSetting "Settings", "CurHost", .Host
                gIni.SaveSetting "Settings", "CurPort", .Port
                gIni.SaveSetting "Settings", "CurLoginScript", .LoginStr
            End With
            Shell App.Path & "\" & App.EXEName & " connect", vbNormalFocus
        Else
            Call Connect
        End If
    Case "batch"
        Winsock1.SendData "cy"
    Case "idle"
    
    Case "find"
    
    Case "tcp"
        tb.SetButtonEnabled "tcp", False
    Case "filedownload"
        MsgBox tb.GetButtonEnabled("tcp")
    Case "downfile'"
    
    Case "editfile"
    
    Case "bold"
    Case "color"
        Box1.test
    Case "help"
        picTrack.Visible = Not picTrack.Visible

End Select
End Sub

Private Sub txtKeyboard_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case 38
    ArrowArr(2) = 65
    Winsock1.SendData ArrowArr
Case 40
    ArrowArr(2) = 66
    Winsock1.SendData ArrowArr
Case 37
    ArrowArr(2) = 68
    Winsock1.SendData ArrowArr
Case 39
    ArrowArr(2) = 67
    Winsock1.SendData ArrowArr
End Select
End Sub
  
Private Sub txtKeyboard_KeyPress(KeyAscii As Integer)
Winsock1.SendData Chr(KeyAscii)
Select Case KeyAscii
Case 114, 82 'r,R
    If MsgCome Then
        'Main
        ShowFrmInput
    End If
End Select
KeyAscii = 0
End Sub
  
Private Sub Form_MouseUp(button As Integer, Shift As Integer, x As Single, y As Single)
If button = 2 Then mybbs.Show
End Sub

Private Sub Winsock1_Close()
Box1.Clear
Box1.LogoVisible = True
Connected = False
txtKeyboard.Enabled = False
Winsock1.Close
End Sub

Private Sub Winsock1_Connect()
On Error Resume Next
Connected = True
txtKeyboard.Enabled = True
txtKeyboard.SetFocus
Box1.LogoVisible = False
End Sub

Public Sub Connect()
On Error Resume Next
frmConnecting.Show 1, Me
Caption = CurSite.SiteName
AddMRU CurSite
txtKeyboard.SetFocus
End Sub

Public Sub Disconnect()
Winsock1_Close
End Sub

'#########################################################################################################################################
'#########################################################################################################################################
  
Sub SendBytes(ParamArray Bytes())
Dim i As Long, t As Long, btArr() As Byte
t = UBound(Bytes)
ReDim btArr(t)
For i = 0 To t
    btArr(i) = Bytes(i)
'    If Check1.Value Then List1.AddItem "-> b & (" & Chr(b) & ")", 0
Next i
Winsock1.SendData btArr
End Sub
  
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
If Not Dealing Then Main
End Sub

Private Sub Main()
'On Error Resume Next
On Error GoTo errHandle
Dim c As Byte, d As Byte, s As String, dat As String, v As Long, LL
Dim p As Long   'ıʼָ
Dim p1 As Long   'ıδָ
Dim btsUbound As Long
Dim mi As Long, j As Long, t As Long, t1 As Long, ts As String, tarr As Variant
Dim b As Byte, xx As Long, yy As Long
Dim EscStartIdx As Long, BlankEscStr As Boolean, DelayCount As Long
Dim BaseI As Long
Dim EscStr As String

Box1.PauseBlink = True
Dealing = True
DelayCount = 0
BeginDeal:
Debug.Print "GetData Begin!"
Winsock1.GetData bts, 8209
btsUbound = UBound(bts)
If HaveOldBts Then
    HaveOldBts = False
    t = UBound(OldBts) + 1
    ReDim Preserve bts(btsUbound + t)
    MoveMemory bts(t), bts(0), btsUbound + 1
    CopyMemory bts(0), OldBts(0), t
End If
p = 0
p1 = 0
For mi = 0 To btsUbound
    If Check1.Value Then List1.AddItem bts(mi) & "(" & Chr(bts(mi)) & ")", 0        'zzz
    Select Case bts(mi)
    Case 255            '--------------------- TelnetЭ -----------------------------------
        '----update text buffer
        t = mi - p
        CopyMemory LineBuffer(p1), bts(p), t
        p1 = p1 + t
        '--
        BaseI = mi       'Save Base mi Index
        mi = mi + 1
        If Check1.Value Then List1.AddItem bts(mi) & "(" & Chr(bts(mi)) & ")", 0        'zzz
        c = bts(mi)
        'c = GetNextByte
        mi = mi + 1
        If Check1.Value Then List1.AddItem bts(mi) & "(" & Chr(bts(mi)) & ")", 0        'zzz
        d = bts(mi)
        'd = GetNextByte
        If c = 253 And (d = 1 Or d = 24) Then
            SendBytes 255, 251, d
        ElseIf c = 254 And d = 1 Then
            SendBytes 255, 252, 1
        ElseIf c = 251 And d = 1 Then
            SendBytes 255, 253, 1
        ElseIf c = 250 Then
            While d <> 240
                mi = mi + 1
                If Check1.Value Then List1.AddItem bts(mi) & "(" & Chr(bts(mi)) & ")", 0        'zzz
                d = bts(mi)
                'd = GetNextByte
            Wend
            SendBytes 255, 250, 24, 0, 118, 116, 49, 48, 48, 255, 240
        ElseIf c = 253 Then
            SendBytes 255, 252, d
        End If
        p = mi + 1
        If Err Then MsgBox "!!!!!!"
    Case 27         '------------------------ Ʒ --------------------------------
        '----update text buffer
        t = mi - p
        CopyMemory LineBuffer(p1), bts(p), t
        Box1.OutText LineBuffer, p1 + t
        p1 = 0
        '-------------------------------------------------------
        BaseI = mi       'Save Base mi Index
        mi = mi + 1
        If Check1.Value Then List1.AddItem bts(mi) & "(" & Chr(bts(mi)) & ")", 0        'zzz
        c = bts(mi)
        'c = GetNextByte
        If c <> 91 Then GoTo EndParseEsc
        'õһֻ";"ַ
        EscStartIdx = mi + 1
        Do ' While mi < btsUbound
            mi = mi + 1
            If Check1.Value Then List1.AddItem bts(mi) & "(" & Chr(bts(mi)) & ")", 0        'zzz
            b = bts(mi)
            'b = GetNextByte
            If b < 48 Or b > 59 Then  '0-9,":",";"
                If mi = EscStartIdx Then
                    BlankEscStr = True
                Else
                    tarr = Split(StrConv(MidB(bts, EscStartIdx + 1, mi - EscStartIdx), vbUnicode), ";")
                    t = UBound(tarr)
                    BlankEscStr = False
                End If
'                Debug.Print "---------------- " & EscStr
'                If EscStr = "" Then
'                    BlankEscStr = True
'                Else
'                    tarr = Split(StrConv(EscStr, vbUnicode), ";")
'                    t = UBound(tarr)
'                    BlankEscStr = False
'                End If
                Select Case b
                    Case 109    'm
                        If BlankEscStr Then
                            Box1.HighLight = True
                            Box1.Reverse = False
                            Box1.ForeGround = 37
                            Box1.BackGround = 40
                            Box1.Blink = False
                        Else
                            For j = 0 To t
                                If IsNumeric(tarr(j)) Then
                                    t1 = tarr(j)
                                    If t1 > 29 And t1 < 38 Then
                                        Box1.ForeGround = t1
                                    ElseIf t1 > 39 And t1 < 48 Then
                                        Box1.BackGround = t1
                                    ElseIf t1 = 0 Then
                                        Box1.HighLight = False
                                        Box1.Reverse = False
                                        Box1.ForeGround = 37
                                        Box1.BackGround = 40
                                        Box1.Blink = False
                                    ElseIf t1 = 1 Then
                                        Box1.HighLight = True
                                    ElseIf t1 = 5 Then
                                        Box1.Blink = True
                                    ElseIf t1 = 7 Then
                                        Box1.Reverse = True
                                    End If
                                End If
                            Next j
                        End If
                    Case 107, 75 'k,K  '򵥶
                        Box1.ClrEoL
                    Case 72 'H
                        If BlankEscStr Then
                            xx = 1
                            yy = 1
                        Else
                            If t < 1 Then ReDim Preserve tarr(1)
                            yy = Val(tarr(0))
                            xx = Val(tarr(1))
                            If xx < 0 Then xx = 1
                            If yy < 0 Then yy = 1
                        End If
                        Box1.GotoXY xx, yy
                    Case 74 'J  '򵥶
                        Box1.Clear
                    Case 65 'A
                        If BlankEscStr Then
                            t = 1
                        Else
                            t = Val(tarr(0))
                            If t < 1 Then t = 1
                        End If
                        Box1.MoveUp t
                    Case 66 'B
                        If BlankEscStr Then
                            t = 1
                        Else
                            t = Val(tarr(0))
                            If t < 1 Then t = 1
                        End If
                        Box1.MoveDown t
                    Case 67 'C
                        If BlankEscStr Then
                            t = 1
                        Else
                            t = Val(tarr(0))
                            If t < 1 Then t = 1
                        End If
                        Box1.MoveRight t
                    Case 68 'D
                        If BlankEscStr Then
                            t = 1
                        Else
                            t = Val(tarr(0))
                            If t < 1 Then t = 1
                        End If
                        Box1.MoveLeft t
                    Case 77 'M
                        If BlankEscStr = False Then
                            t = Val(tarr(0))
                            DelayCount = DelayCount + t
                        End If
                        If DelayCount <= MaxDelay Then
                            Box1.Redraw
                            Sleep t
                            Debug.Print Chr(bts(mi + 1))
                        End If
                    Case 80 'P
                        If BlankEscStr Then
                            Winsock1.SendData CByte(32)
                        Else
                            Winsock1.SendData CByte(2) ' "q" 'CByte(81)
                        End If
                    Case 115    's
                        Box1.SaveXY
                    Case 117    'u
                        Box1.RestoreXY
                    Case 76 'L  'ڹǰn
                        If BlankEscStr Then
                        Else
                        End If
'                    Case Else
'                        Debug.Print b & "!!!!!!!!!!!!!!!!!!!!!!!!!!"
                End Select
                Exit Do
            Else
                EscStr = EscStr & ChrB(b)
            End If
        Loop
EndParseEsc:
        p = mi + 1
        If Err Then MsgBox "!!!!!!~~"
    '-------------------------------------- ı ----------------------------------------------
    Case 7
        '----update text buffer
        t = mi - p
        CopyMemory LineBuffer(p1), bts(p), t
        p1 = p1 + t
        '--
        Beep
        MsgCome = True
        p = mi + 1
    Case 8
        '----update text buffer
        t = mi - p
        CopyMemory LineBuffer(p1), bts(p), t
        Box1.OutText LineBuffer, p1 + t
        p1 = 0

        '--
        Box1.MoveLeft 1
        p = mi + 1
    Case 13
        '----update text buffer
        t = mi - p
        CopyMemory LineBuffer(p1), bts(p), t
        Box1.OutText LineBuffer, p1 + t
        p1 = 0
        '--
        Box1.GotoX 1
        p = mi + 1
    Case 0
        '----update text buffer
        t = mi - p
        CopyMemory LineBuffer(p1), bts(p), t
        p1 = p1 + t
        '--
        p = mi + 1
    Case 10
        '----update text buffer
        t = mi - p
        CopyMemory LineBuffer(p1), bts(p), t
        Box1.OutText LineBuffer, p1 + t
        p1 = 0
        '--
        Box1.MoveDown 1
        p = mi + 1
    End Select
L2:
Next mi
'If Err Then Debug.Print "!!!!!!!!!!!!!!!!!!!!!!!!!" & Err
'If Err = 9 Then 'overflow
'    t = btsUbound - BaseI
'    ReDim OldBts(t)
'    CopyMemory OldBts(0), bts(BaseI), t + 1
'    HaveOldBts = True
'    Debug.Print "Error Occured on " & Now & "!" & StrConv(OldBts, vbUnicode)
'    p = BaseI
'    p1 = 0
'    DoEvents
'    GoTo BeginDeal
'End If

If p <= btsUbound Then   'ı
    t = btsUbound - p + 1
    CopyMemory LineBuffer(p1), bts(p), t
    p1 = p1 + t
    Box1.OutText LineBuffer, p1
End If

EndOfParse:

DoEvents: DoEvents: DoEvents
If Winsock1.BytesReceived > 0 Then GoTo BeginDeal

'-------------------------------------------------------
Box1.Redraw
Box1.PauseBlink = False
If Check1.Value Then List1.AddItem "-------------------------------", 0
Dealing = False
Debug.Print "GetData Endd!"
'Exit Sub
'errHandle:
'    t = btsUbound - BaseI
'    ReDim OldBts(t)
'    CopyMemory OldBts(0), bts(BaseI), t + 1
'    HaveOldBts = True
'    Debug.Print "Error Occured on " & Now & "!" & StrConv(OldBts, vbUnicode)
'    DoEvents
'    Dealing = False
Exit Sub
errHandle:
    t = btsUbound - BaseI
    ReDim OldBts(t)
    CopyMemory OldBts(0), bts(BaseI), t + 1
    HaveOldBts = True
    Debug.Print "Error Occured on " & Now & "!" & StrConv(OldBts, vbUnicode)
    p = BaseI
    p1 = 0
    DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
    Dealing = False
End Sub

'----------------------------------------------------------
Private Sub UserControl_Resize1()
If Not_Shown Then Exit Sub
Dim i As Long, t As Single, t1 As Long
BoxWidth = UserControl.ScaleWidth
BoxHeight = UserControl.ScaleHeight
BoxRect.Right = BoxWidth
BoxRect.Bottom = BoxHeight
If mLogoVisible Then
    UserControl.Refresh
    UserControl.PaintPicture mLogo, (UserControl.ScaleWidth - mLogoWidth) / 2, (UserControl.ScaleHeight - mLogoHeight) / 2
End If
'For i = 12 To 1 Step -1
'    t1 = FontInfos(i).BoxWidth
'    If t1 <= BoxWidth Then
'        t = FontInfos(i).FontSize
'        If UserControl.FontSize <> t Then
'           mybbs.Caption = UserControl.FontSize & "," & t & "," & Now
'            UserControl.FontSize = t
'            Debug.Print "@@@@@@@@" & SetBitmapDimensionEx(BufferDc, t1&, BoxHeight&, ByVal 0&)
'            'Debug.Print "#######" & GetLastError
'            SetBitmapDimensionEx BlinkDc, t1, BoxHeight, 0
'            SetBitmapDimensionEx TmpDc, t1, BoxHeight, 0
'            SetBitmapDimensionEx TmpDc1, t1, BoxHeight, 0
'            mCellWidth = UserControl.TextWidth("") / 2
'            mCellHeight = UserControl.TextHeight("")
'            'MsgBox UserControl.FontSize
''            SetGDIFonts
''            BoxDc = UserControl.hdc
'
''            SetGDIFonts
''            MsgBox t
'            'RedrawScreen
'            'MsgBox "!"
'        End If
        'Box1.FontSize = FontInfos(i).FontSize   '@@
'        Exit For
'    End If
'Next i
RaiseEvent Resize
End Sub


'------------------------- telnet ---------------------------------
'        If c = 253 And (d = 1 Or d = 24) Then
'            SendBytes 255, 251, d
'        ElseIf c = 254 And d = 1 Then
'            SendBytes 255, 252, 1
'        ElseIf c = 251 And d = 1 Then
'            SendBytes 255, 253, 1
            'SendBytes 255, 251, 3
            'SendBytes 255, 253, 1
'        ElseIf c = 250 Then
'            While d <> 240
'                d = GetNextByte
'            Wend
'            SendBytes 255, 250, 24, 0, 118, 116, 49, 48, 48, 255, 240
'        ElseIf c = 253 Then
'            SendBytes 255, 252, d
'        End If


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

'        Select Case Box1.GetBlockText(46, 2, 7)
'            Case "y] ", "] ["   'б!
'                '
'                curBbsState = bbsViewBoards
'                Box1.BotFocusLine = 23
'                Box1.TopFocusLine = 4
'                Caption = "б!"
'            Case "Ctrl-P]"    'б!    'ж⣡Ҫӿж
'                'ģʽ
'                curBbsState = bbsViewBoard
'                Box1.BotFocusLine = 23
'                Box1.TopFocusLine = 4
'                Caption = "б!"
'            Case "Enter> "  '   '
'                '
'                curBbsState = bbsViewAnnounce
'                Box1.BotFocusLine = 23
'                Box1.TopFocusLine = 4
'                Caption = "!"
'            Case Else       '˵
'                If InStr(1, Box1.GetBlockText(50, 1, 30), "") <> 0 Then
'                    curBbsState = bbsViewMenu
'                    Box1.BotFocusLine = 23
'                    Box1.TopFocusLine = 10
'                    Caption = "˵б!"
'                ElseIf InStr(1, UCase(Trim(Box1.GetBlockText(1, 24, 80))), "ENTER") Then
'                    curBbsState = bbsPressEnter
'                    Box1.BotFocusLine = -1
'                Else    'δ֪
'                    curBbsState = bbsStateUnknown
'                    Box1.BotFocusLine = -1
'                End If
'        End Select

'-----------------------------
Private Sub Timer1_Timer()
Select Case curBbsState
Case bbsViewingPost
    If ScrollDown Then Winsock1.SendData CByte(106) Else Winsock1.SendData CByte(107)
    DoEvents: DoEvents: DoEvents
Case bbsViewBoard
    If ScrollDown Then Winsock1.SendData CByte(6) Else Winsock1.SendData CByte(2)
    DoEvents: DoEvents: DoEvents
Case Else
    ''
End Select
Timer1.Enabled = False
End Sub


'-------------------------------------------------------------------
'Private Function Correct(bts() As Byte, StartIdx As Long, Count As Long) As String
'Dim bt1() As Byte
'Dim bt() As Byte
'Dim i As Long, j As Long, t As Long, ct As Long
'Dim ts As String, ts1 As String
'Dim TwoBt() As Byte, CharCount As Long, MaxCharCount As Long
'Dim ti As Long
'If CStr(bt) = "" Then Exit Function
'
'bt = Text
't = UBound(bt)
'ts = StrConv(bt, vbUnicode)
'If Trim(ts) = "" Then
'    Correct = ts
'    Exit Function
'End If
''ct = -1
'For i = 0 To t
'    If bt(i) < 128 Then
'        ct = ct + 1
'    End If
'Next i
'If (t - ct) Mod 2 Then
'    Correct = ts
'    Exit Function
'End If
'Debug.Print ts & "!!!!!!"
'CharCount = 0
'For j = 1 To Len(ts)
'    TwoBt = StrConv(Mid(ts, j, 1), vbFromUnicode)
'    If UBound(TwoBt) Then   'Ϊ
'        If TwoBt(0) >= &HB0 And TwoBt(0) <= &HD7 And TwoBt(1) >= &HA1 And TwoBt(1) <= &HF9 Then
'            CharCount = CharCount + 2
'        End If
'    ElseIf TwoBt(0) < 128 Then
'        CharCount = CharCount + 1
'    End If
'Next j
'MaxCharCount = CharCount '+ 1
'ti = -1
'For i = t To 0 Step -1
''For i = 0 To t
'    bt1 = bt
'    bt1(i) = 128
'    ts = StrConv(bt1, vbUnicode)
'    CharCount = 0
'    For j = 1 To Len(ts)
'        TwoBt = StrConv(Mid(ts, j, 1), vbFromUnicode)
'        If UBound(TwoBt) Then   'Ϊ
'            If TwoBt(0) >= &HB0 And TwoBt(0) <= &HD7 And TwoBt(1) >= &HA1 And TwoBt(1) <= &HF9 Then
'                CharCount = CharCount + 2
'            ElseIf InStr(1, "", StrConv(TwoBt, vbUnicode)) <> 0 Then
'                CharCount = CharCount + 3
'            End If
'        ElseIf TwoBt(0) < 128 Then
'            CharCount = CharCount + 1
'        End If
'    Next j
'    If CharCount >= MaxCharCount Then 'ȷĺ
'        'Debug.Print i; ":   _" & StrConv(Text, vbUnicode)
'        ti = i
'        MaxCharCount = CharCount
'        'Exit For
'    End If
'Next i
'If ti <> -1 Then
'    If ti > t Then
'        Correct = StrConv(bt, vbUnicode)
'    Else
'        'Debug.Print ">>>" & StrConv(Text, vbUnicode)
'        bt(ti) = 32
'        Correct = StrConv(bt, vbUnicode)
'    End If
'Else
'    Correct = StrConv(bt, vbUnicode)
'End If
'End Function



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

Private Sub GetDirInfo1(DirPrefix As String, DirIndex As Long)
Dim i  As Long, ItemCount As Long, ts As String
Dim fn As Integer, dirts As String, curLineStr As String, DirTitle As String
DirTitle = mybbs.Box1.GetLineText(1)
gDataDealed = False
mybbs.SendBytes 57, 57, 57, 13 '999\n
While Not gDataDealed
    If Quitting Then Exit Sub
    DoEvents
Wend
ItemCount = Val(Mid(mybbs.Box1.GetLineText(mybbs.Box1.CurItem), 3)) '- 1
gDataDealed = False
mybbs.SendBytes 49, 13  '1\n
While Not gDataDealed
    If Quitting Then Exit Sub
    DoEvents
Wend
For i = 1 To ItemCount
    'curLineStr = mybbs.Box1.GetLineText(mybbs.Box1.CurItem)
    If mybbs.Box1.GetBlockText(9, mybbs.Box1.CurItem, 4) = "Ŀ¼" Then
    'If Mid(mybbs.Box1.GetLineText(mybbs.Box1.CurItem), 9, 4) = "Ŀ¼" Then
        dirts = dirts & "<a href='dir" & DirPrefix & IIf(DirIndex, "." & DirIndex, "") & "." & i & ".htm'>" & mybbs.Box1.GetLineText(mybbs.Box1.CurItem) & "</a><br>"
        gDataDealed = False
        mybbs.SendBytes 13 '\n
        While Not gDataDealed
            If Quitting Then Exit Sub
            DoEvents
        Wend
        GetDirInfo DirPrefix & IIf(DirIndex, "." & DirIndex, ""), i
        '--
        gDataDealed = False
        mybbs.SendBytes 113 'q
        While Not gDataDealed
            If Quitting Then Exit Sub
            DoEvents
        Wend
        SleepWithEvents 10
    Else    'ļ
        dirts = dirts & "<a href='file" & DirPrefix & IIf(DirIndex, "." & DirIndex, "") & "." & i & ".htm'>" & mybbs.Box1.GetLineText(mybbs.Box1.CurItem) & "</a><br>"
        gDataDealed = False
        mybbs.SendBytes 13 '\n
        While Not gDataDealed
            If Quitting Then Exit Sub
            DoEvents
        Wend
        fn = FreeFile
        Open "c:\test\file" & DirPrefix & IIf(DirIndex, "." & DirIndex, "") & "." & i & ".htm" For Output As #fn
        Print #fn, "<html><meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">" & _
                   "<head><title>" & mybbs.Box1.GetLineText(mybbs.Box1.CurItem) & "</title></head><body>" & _
                   "<pre>" & DownFile & "<pre></body></html>"
        Close #fn
        gDataDealed = False
        mybbs.SendBytes 113 'q
        While Not gDataDealed
            If Quitting Then Exit Sub
            DoEvents
        Wend
        SleepWithEvents 10
    End If
    gDataDealed = False
    mybbs.SendBytes 106 'j
    While Not gDataDealed
        If Quitting Then Exit Sub
        DoEvents
    Wend
Next i
fn = FreeFile
dirts = "<html><meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">" & _
        "<head><title>" & mybbs.Box1.GetLineText(mybbs.Box1.CurItem) & "</title></head><body>" & _
        dirts & "</body></html>"

Open "c:\test\dir" & DirPrefix & IIf(DirIndex, "." & DirIndex, "") & ".htm" For Output As #fn
Print #fn, dirts
Close #fn
End Sub





'-----------------------------------------------------------------
Private Function DownFile1() As String
Dim ts As String, t As Long, Progress As Long
If curBbsState = bbsViewPostDone Then
    ts = mybbs.Box1.GetTexts(0, 22)
Else
    If Not mybbs.Dealing Then
        ts = mybbs.Box1.GetLineText(1) & vbCrLf
    End If
    mybbs.EnterCount = 23
    While curBbsState = bbsViewingPost Or curBbsState = bbsStateUnknown
        If Quitting Then Exit Function
        ts = ts & mybbs.Box1.GetTexts(1, 22)
        mybbs.SendBytesWaitReturn 1, bbsViewingPost, 32
        Progress = Val(mybbs.Box1.GetBlockText(13, 24, 2))
        If Progress Then
            SetProgressBarValue m_hProgBar, Progress '100
        End If
        SleepWithEvents 10
    Wend
'    While mybbs.EnterCount < 2 And curBbsState <> bbsViewPostDone
'        If Quitting Then Exit Function
'        DoEvents
'    Wend
'    SleepWithEvents 10
    ts = ts & mybbs.Box1.GetTexts(23 - mybbs.Box1.ScreenUpCount, 22)
End If
SetProgressBarValue m_hProgBar, 100
DownFile = ts
    
'    While curBbsState = bbsViewingPost Or curBbsState = bbsStateUnknown
'        If Quitting Then Exit Function
'        If mybbs.EnterCount > 1 Then
'            ts = ts & mybbs.Box1.GetTexts(1, 22)
'            Progress = Val(mybbs.Box1.GetBlockText(13, 24, 2))
'            If Progress Then
'                SetProgressBarValue m_hProgBar, Progress '100
'            End If
'            mybbs.EnterCount = 0
'            gDataDealed = False
'            mybbs.Winsock1.SendData CByte(32)
'            While Not gDataDealed
'                If Quitting Then Exit Function
'                DoEvents
'            Wend
'        End If
'        SleepWithEvents 10
'    Wend
'    While mybbs.EnterCount < 2 And curBbsState <> bbsViewPostDone
'        If Quitting Then Exit Function
'        DoEvents
'    Wend
'    SleepWithEvents 10
'    ts = ts & mybbs.Box1.GetTexts(23 - mybbs.Box1.ScreenUpCount, 22)
'End If
'SetProgressBarValue m_hProgBar, 100
'DownFile = ts
End Function











'==================================================================================
Option Explicit
Private mX As Long, mY As Long
Private mSavedX As Long, mSavedY As Long

Private BlinkDc As Long, BufferDc As Long
Private LineDc As Long
Private TmpDc As Long, TmpDc1 As Long

Private mCellWidth As Long, mCellHeight As Long, mTextSize As Long
Private bgHBrush As Long, whiteBrush As Long
Private WhitePen As Long
Private mHighLight As Long
Private mReverse As Boolean
Private mForeGround As Long
Private mForeColor As Long
Private mBackGround As Long
Private mBackColor As Long
Private mBlink As Boolean
Private mUnderLine As Boolean
Private mFontIndex As Long
Private mFullScreen As Boolean

Private mLogo As StdPicture, mLogoVisible As Boolean, mLogoWidth As Long, mLogoHeight As Long
Private BoxWidth As Long, BoxHeight As Long
Private Not_Shown As Boolean
Private mCaretRect As RECT
Private mCaretShown As Boolean
Private Type CellType
    ForeGround As Long
    BackGround As Long
    HighLight As Long
    Reverse As Boolean
    Blink As Boolean
    UnderLine As Boolean
    FontIndex As Long
End Type

Private mChars(255, 25) As Byte
Private mCells(81, 25) As CellType
Private mCell As CellType

Public Event Resize()
Public Event Click(ClickAction As eClickAction)
Public Event WantPopupMenu(X As Single, Y As Single)

Private BoxRect As RECT
Private mFocusedLine As Long
Private mTopFocusLine As Long
Private mBotFocusLine As Long

Public Enum eClickAction
    eClickNone
    eClickBack
    eClickPageUp
    eClickPageDown
    eClickNext
    eClickLast
    eClickEnter
    eClickItem
    eClickPageFirst
    eClickPageLast
    eSetCursorPos
    eClickAnyKey
    eClickUnknown
    eClickUrl
End Enum
Private CurClickAction As eClickAction
Private mBlinkDown As Boolean
Private mUrl As String

Private SelStartX As Long, SelStartY As Long, SelEndX As Long, SelEndY As Long
Private mSelecting As Boolean
Private mShiftMode As Boolean
'Private mNeedCorrect As Boolean
Private mScreenUpCount As Long

Private Sub UserControl_Initialize()
Dim i As Long
bgHBrush = CreateSolidBrush(vbBlack)
whiteBrush = CreateSolidBrush(vbWhite)
Not_Shown = True
mBotFocusLine = -1
mFocusedLine = -1
End Sub

Private Sub UserControl_Show()
Dim tBmp As Long, r As RECT
BlinkDc = CreateCompatibleDC(UserControl.hdc)
BufferDc = CreateCompatibleDC(UserControl.hdc)
LineDc = CreateCompatibleDC(UserControl.hdc)
TmpDc = CreateCompatibleDC(UserControl.hdc)
TmpDc1 = CreateCompatibleDC(UserControl.hdc)
tBmp = CreateCompatibleBitmap(UserControl.hdc, 1024, 768)
SelectObject BlinkDc, tBmp
tBmp = CreateCompatibleBitmap(UserControl.hdc, 1024, 768)
SelectObject BufferDc, tBmp
With r
    .Right = 1024
    .Bottom = 768
End With
FillRect BufferDc, r, bgHBrush
FillRect BlinkDc, r, bgHBrush
tBmp = CreateCompatibleBitmap(UserControl.hdc, 1024, 1)
SelectObject LineDc, tBmp
tBmp = CreateCompatibleBitmap(UserControl.hdc, 1024, 768)
SelectObject TmpDc, tBmp
tBmp = CreateCompatibleBitmap(UserControl.hdc, 1024, 768)
SelectObject TmpDc1, tBmp
WhitePen = CreatePen(0, 0, vbWhite)
SelectObject BufferDc, WhitePen
SetBkColor BufferDc, vbBlack
SetBkColor BlinkDc, vbBlack
SetTextColor BufferDc, vbWhite
SetTextColor BlinkDc, vbWhite
SetBkMode BufferDc, 2
SetBkMode TmpDc, 2
SetBkMode TmpDc1, 2
SetBkMode BlinkDc, 2
'UserControl_Resize
End Sub

Private Sub UserControl_Paint()
If Not_Shown Then
    Not_Shown = False
    UserControl_Resize
End If
If mLogoVisible Then
    UserControl.Cls
    UserControl.PaintPicture mLogo, (UserControl.ScaleWidth - mLogoWidth) / 2, (UserControl.ScaleHeight - mLogoHeight) / 2
Else
Redraw
End If
End Sub

Private Sub UserControl_Resize()
On Error Resume Next
If Not_Shown Then Exit Sub
Dim i As Long, t As Single, t1 As Long, t2 As Long, bw As Long, bh As Long
For i = 13 To 1 Step -1
    bh = FontInfos(i).BoxHeight
    bw = FontInfos(i).BoxWidth
    If bh <= UserControl.ScaleHeight And (bw <= UserControl.ScaleWidth Or mFullScreen) Then
        t = FontInfos(i).FontSize
        If UserControl.FontSize <> t Then
            Timer1.Tag = Timer1.Enabled
            UserControl.FontSize = t
            BoxWidth = bw
            BoxHeight = bh
            BoxRect.Right = BoxWidth
            BoxRect.Bottom = BoxHeight
            SetGDIFonts
            If mLogoVisible = False Then ReRenderScreen
            mSelecting = False
            mBlinkDown = False
            Timer1.Enabled = Timer1.Tag
        End If
        Exit For
    End If
Next i
If mLogoVisible Then
    UserControl.Cls
    UserControl.PaintPicture mLogo, (UserControl.ScaleWidth - mLogoWidth) / 2, (UserControl.ScaleHeight - mLogoHeight) / 2
End If
RaiseEvent Resize
End Sub

Private Sub UserControl_Terminate()
On Error Resume Next
Dim tIco As StdPicture
For Each tIco In gcCursors
    Set tIco = Nothing
Next
Set gcCursors = Nothing
DeleteObject bgHBrush
DeleteObject whiteBrush
DeleteObject WhitePen
DeleteDC BlinkDc
DeleteDC BufferDc
DeleteDC LineDc
DeleteDC TmpDc
DeleteDC TmpDc1
End Sub
'############################################################################

Public Sub Clear()
FillRect BlinkDc, BoxRect, bgHBrush
FillRect BufferDc, BoxRect, bgHBrush
mX = 0
mY = 0
ZeroMemory mCells(0, 0), 81 * 26 * 24&
'??ZeroMemory mChars(0, 0), 256 * 26&
FillMemory mChars(0, 0), 256 * 26&, 32
HighLight = 1
Reverse = False
ForeGround = 37
BackGround = 40
Blink = False
UnderLine = False
FontIndex = 0
'zzz reset fontface
End Sub

Public Sub Clear1()
Dim r As RECT
With r
    .Left = mCellWidth * mX
    .Top = mCellHeight * mY
    .Bottom = .Top + mCellHeight
    .Right = BoxWidth
End With
FillRect BufferDc, r, bgHBrush
FillRect BlinkDc, r, bgHBrush
With r
    .Left = 0
    .Top = mCellHeight * (mY + 1)
    .Right = BoxWidth
    .Bottom = BoxHeight
End With
FillRect BlinkDc, r, bgHBrush
FillRect BufferDc, r, bgHBrush
'??ZeroMemory mChars(mX, mY), 256 * (26 - mY)
FillMemory mChars(mX, mY), 256 * (26 - mY), 32
ZeroMemory mCells(mX, mY), 81 * (26 - mY) * 24&
mX = 0
mY = 0
End Sub

Public Sub GotoXY(X As Long, Y As Long)
mX = X - 1
mY = Y - 1
End Sub

Public Sub GotoX(X As Long)
mX = X - 1
End Sub

Public Sub GotoY(Y As Long)
mY = Y - 1
End Sub

Public Sub ClrEoL()
Dim r As RECT
With r
    .Left = mCellWidth * mX
    .Top = mCellHeight * mY
    .Bottom = .Top + mCellHeight
    .Right = BoxWidth
End With
FillRect BufferDc, r, bgHBrush
FillRect BlinkDc, r, bgHBrush
ZeroMemory mCells(mX, mY), (81 - mX) * 24
'??ZeroMemory mChars(mX, mY), 256 - mX
FillMemory mChars(mX, mY), 256 - mX, 32
HighLight = 1
Reverse = False
ForeGround = 37
BackGround = 40
Blink = False
End Sub

Public Property Get CellWidth() As Long
CellWidth = mCellWidth
End Property

Public Property Get CellHeight() As Long
CellHeight = mCellHeight
End Property

Public Sub SaveXY()
mSavedX = mX
mSavedY = mY
End Sub

Public Sub RestoreXY()
mX = mSavedX
mY = mSavedY
End Sub

Public Sub MoveUp(n As Long)
mY = mY - n
If mY < 0 Then
    MoveScreenDown -mY
    mY = 0
End If
End Sub

Public Sub MoveDown(n As Long)
mY = mY + n
If mY > 23 Then
    MoveScreenUp
    mY = 23
End If
End Sub

Public Sub MoveLeft(n As Long)
mX = mX - n
If mX < 0 Then mX = 0
End Sub

Public Sub MoveRight(n As Long)
mX = mX + n
If mX > 81 Then mX = 80
End Sub

Public Property Let ForeGround(NewForeGround As Long)
'On Error Resume Next
If mForeGround = NewForeGround Then Exit Property
mForeGround = NewForeGround
If mReverse Then
    mBackColor = gColors(mForeGround - 30)
    SetBkColor BufferDc, mBackColor
Else
    mForeColor = gColors(mForeGround - 30 + 8 * mHighLight)
    SetTextColor BufferDc, mForeColor
End If
If mBlink Then
    SetTextColor BlinkDc, mBackColor Xor mForeColor
End If
mCell.ForeGround = NewForeGround
End Property

Public Property Let BackGround(NewBackGround As Long)
'On Error Resume Next
If mBackGround = NewBackGround Then Exit Property
mBackGround = NewBackGround
If mReverse Then
    mForeColor = gColors(mBackGround - 40 + 8 * mHighLight)
    SetTextColor BufferDc, mForeColor
Else
    mBackColor = gColors(NewBackGround - 40)
    SetBkColor BufferDc, mBackColor
End If
If mBlink Then
    SetTextColor BlinkDc, mBackColor Xor mForeColor
End If
mCell.BackGround = NewBackGround
End Property

Public Property Let HighLight(NewHighLight As Long)
'On Error Resume Next
If mHighLight = NewHighLight Then Exit Property
mHighLight = NewHighLight
mForeColor = gColors(mForeGround - 30 + 8 * mHighLight)
SetTextColor BufferDc, mForeColor
If mBlink Then
    SetTextColor BlinkDc, mBackColor Xor mForeColor
End If
mCell.HighLight = NewHighLight
End Property

Public Property Let Reverse(NewReverse As Boolean)
'On Error Resume Next
If mReverse = NewReverse Then Exit Property
mReverse = NewReverse
If mReverse Then
    mBackColor = gColors(mForeGround - 30)
    SetBkColor BufferDc, mBackColor
    mForeColor = gColors(mBackGround - 40 + 8 * mHighLight)
    SetTextColor BufferDc, mForeColor
Else
    mBackColor = gColors(mBackGround - 40)
    SetBkColor BufferDc, mBackColor
    mForeColor = gColors(mForeGround - 30 + 8 * mHighLight)
    SetTextColor BufferDc, mForeColor
End If
If mBlink Then
    SetTextColor BlinkDc, mBackColor Xor mForeColor
End If
mCell.Reverse = NewReverse
End Property

Public Property Let Blink(NewBlink As Boolean)
If mBlink = NewBlink Then Exit Property
mBlink = NewBlink
SetTextColor BlinkDc, mBackColor Xor mForeColor
mCell.Blink = mBlink
End Property

Public Property Let UnderLine(NewUnderLine As Boolean)
mUnderLine = NewUnderLine
mCell.UnderLine = NewUnderLine
End Property

Public Property Let FontIndex(NewFontIndex As Long)
On Error GoTo kkk
If NewFontIndex > 3 Or NewFontIndex = mFontIndex Then Exit Property
mFontIndex = NewFontIndex
Dim tLF As Long
UserControl.FontName = gFontNames(NewFontIndex)
tLF = GetCurrentObject(BufferDc, OBJ_FONT)
DeleteObject tLF
tLF = CreateLogFont(UserControl.Font, UserControl.hdc)
SelectObject BufferDc, tLF
SelectObject BlinkDc, tLF
SelectObject TmpDc, tLF
SelectObject TmpDc1, tLF
mCell.FontIndex = NewFontIndex
kkk:
Debug.Print "FontIndex=" & NewFontIndex & "  !! " & gFontNames(NewFontIndex)
End Property

Private Sub Timer1_Timer()
mBlinkDown = Not mBlinkDown
BitBlt BufferDc, 0, 0, BoxWidth, BoxHeight, BlinkDc, 0, 0, vbSrcInvert      '%%%%
BitBlt UserControl.hdc, 0, 0, BoxWidth, BoxHeight, BufferDc, 0, 0, vbSrcCopy      '%%%%
End Sub

Public Property Get hwnd() As Long
hwnd = UserControl.hwnd
End Property

Public Property Set Logo(NewLogo As VB.Image)
Set mLogo = NewLogo.Picture
mLogoWidth = NewLogo.Width
mLogoHeight = NewLogo.Height
End Property

Public Property Get LogoVisible() As Boolean
LogoVisible = mLogoVisible
End Property

Public Property Let LogoVisible(NewVisible As Boolean)
If mLogoVisible = NewVisible Then Exit Property
mLogoVisible = NewVisible
If mLogoVisible Then
    Timer1.Enabled = False
    Timer2.Enabled = False
    UserControl.Refresh
    UserControl.PaintPicture mLogo, (UserControl.ScaleWidth - mLogoWidth) / 2, (UserControl.ScaleHeight - mLogoHeight) / 2
Else
    InitDatas
    Clear
    UserControl.Cls
    mBlinkDown = False
    Timer1.Enabled = True
    Timer2.Enabled = True
End If
UserControl.Enabled = Not NewVisible
End Property

Public Sub KillMe()
Timer1.Enabled = False
End Sub

Public Property Let PauseBlink(NewPauseBlink As Boolean)
mBlinkDown = False
Timer1.Enabled = Not NewPauseBlink
End Property

Public Property Let PauseCaretBlink(NewPauseBlink As Boolean)
Timer2.Enabled = Not NewPauseBlink
End Property

Private Sub SetCaretPosition(X As Long, Y As Long)
With mCaretRect
    .Left = X
    .Right = X + mCellWidth
    .Top = Y - 2
    .Bottom = Y
End With
End Sub

Private Sub Timer2_Timer()
If mCaretShown Then
    mCaretShown = False
    InvertRect UserControl.hdc, mCaretRect
Else
    mCaretShown = True
    InvertRect UserControl.hdc, mCaretRect
End If
End Sub

Public Function GetTexts(Optional Y1 As Long = 0, Optional Y2 As Long = 23) As String
Dim ts As String, ts1 As String
Dim i As Long, bts(255) As Byte
If Y1 < 0 Then Y1 = 0
For i = Y1 To Y2
    CopyMemory bts(0), mChars(0, i), 256
    ts1 = RTrim(StrConv(bts, vbUnicode))
    'ts1 = Left(ts1, InStr(1, ts1, vbNullChar) - 1)
    ts = ts & ts1 & vbCrLf
Next i
'Clipboard.Clear
'Clipboard.SetText ts
GetTexts = ts
End Function

Public Sub MoveScreenUp()
ScrollDC BufferDc, 0, -mCellHeight, 0, 0, 0, 0
ScrollDC BlinkDc, 0, -mCellHeight, 0, 0, 0, 0
MoveMemory mChars(0, 0), mChars(0, 1), 256 * 25
MoveMemory mCells(0, 0), mCells(0, 1), 81 * 25 * 24&
mScreenUpCount = mScreenUpCount + 1
'MsgBox "Screenup!"
End Sub

Public Sub InsertBlankLinesBefore(LineCount As Long, Optional NoEraseBlankLines As Boolean = False)
Dim t As Long, r As RECT
t = 23 - (LineCount + mY)
If t > 23 Then Exit Sub
With r
    .Right = BoxWidth
    .Top = mCellHeight * mY
    .Bottom = BoxHeight
End With
ScrollDCA BufferDc, 0, mCellHeight * LineCount, r, 0, 0, 0
ScrollDCA BlinkDc, 0, mCellHeight * LineCount, r, 0, 0, 0
MoveMemory mChars(0, mY + LineCount), mChars(0, mY), 256 * t
MoveMemory mCells(0, mY + LineCount), mCells(0, mY), 81 * t * 24&
'--
If NoEraseBlankLines Then Exit Sub
r.Bottom = r.Top + mCellHeight * LineCount
FillRect BufferDc, r, bgHBrush
FillRect BlinkDc, r, bgHBrush
ZeroMemory mCells(0, mY), 81 * LineCount * 24&
FillMemory mChars(0, mY), 256 * LineCount&, 32
End Sub

Public Sub MoveScreenDown(DownCount As Long)
If DownCount > 23 Then DownCount = 23
ScrollDC BufferDc, 0, mCellHeight, 0, 0, 0, 0
ScrollDC BlinkDc, 0, mCellHeight, 0, 0, 0, 0
MoveMemory mChars(0, 1), mChars(0, 0), 256 * 25
MoveMemory mCells(0, 1), mCells(0, 0), 81 * 25 * 24&
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
    If mSelecting Then CancelSelecting   'ѡȡѡ
    SelStartX = X \ mCellWidth
    SelStartY = Y \ mCellHeight
    SelEndX = SelStartX
    SelEndY = SelStartY
End If
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Dim tx As Long, ty As Long
Dim ts As String, i As Long, t As Long, t1 As Long, t2 As Long, b As Byte
tx = X \ mCellWidth
ty = Y \ mCellHeight
If Button = 1 Then
    If tx < 0 Then
        tx = 0
    ElseIf tx > 80 Then
        tx = 80
    End If
    If ty < 0 Then
        ty = 0
    ElseIf ty > 23 Then
        ty = 23
    End If
    If tx <> SelEndX Or ty <> SelEndY Then
        SelEndX = tx
        SelEndY = ty
        If tx > 0 Then
            If mChars(tx, ty) > 127 Then
                If SelStartX > tx Then
                    t1 = tx
                    t2 = SelStartX
                Else
                    t1 = SelStartX
                    t2 = tx
                End If
                t = 0
                For i = t1 To t2
                    If mChars(i, ty) > 127 Then t = t + 1
                Next i
                If t Mod 2 = 0 Then
                    GoTo NoSelect
                End If
            End If
        End If
        SelectRegion SelStartX, SelStartY, SelEndX, SelEndY, (Shift And vbShiftMask) > 0
        Redraw
NoSelect:
    End If
ElseIf gMouseEnabled Then
        If ty >= mTopFocusLine And ty <= mBotFocusLine Then
            If mFocusedLine <> ty Then FocusLine ty
        Else
            If mFocusedLine > -1 Then FocusLine -1
        End If
        If CheckUrl(tx, ty) Then
            UserControl.MousePointer = 99
            UserControl.MouseIcon = gcCursors("hand")
            CurClickAction = eClickUrl
        ElseIf curBbsState = bbsPostTitleToEnter Or curBbsState = bbsPressEnter Then
            UserControl.MousePointer = 99
            UserControl.MouseIcon = gcCursors("enter")
            CurClickAction = eClickEnter
        ElseIf curBbsState = bbsWritingPost Then
            CurClickAction = eSetCursorPos
            UserControl.MousePointer = 3
        ElseIf curBbsState = bbsPressAnyKey Then
            CurClickAction = eClickAnyKey
            UserControl.MousePointer = 3
        ElseIf curBbsState = bbsStateUnknown Then
            CurClickAction = eClickUnknown
            UserControl.MousePointer = 3
        ElseIf curBbsState = bbsLeaving Then
            CurClickAction = eClickItem
            UserControl.MousePointer = 0
        ElseIf tx < 10 Then
            UserControl.MousePointer = 99
            UserControl.MouseIcon = gcCursors("back")
            CurClickAction = eClickBack
        ElseIf curBbsState = bbsViewPostDone Then
            If ty > 0 And ty < 12 Then
                UserControl.MousePointer = 99
                UserControl.MouseIcon = gcCursors("last")
                CurClickAction = eClickLast
            ElseIf ty < 22 And ty > 11 Then
                UserControl.MousePointer = 99
                UserControl.MouseIcon = gcCursors("next")
                CurClickAction = eClickNext
            Else
                UserControl.MousePointer = 3
                If ty < 12 Then
                    CurClickAction = eClickLast
                Else
                    CurClickAction = eClickNext
                End If
            End If
        ElseIf curBbsState = bbsViewingPost Then
            If ty > 0 And ty < 12 Then
                UserControl.MousePointer = 99
                UserControl.MouseIcon = gcCursors("pageup")
                CurClickAction = eClickPageUp
            ElseIf ty < 22 And ty > 11 Then
                UserControl.MousePointer = 99
                UserControl.MouseIcon = gcCursors("pagedown")
                CurClickAction = eClickPageDown
            Else
                UserControl.MousePointer = 3
                If ty < 12 Then
                    CurClickAction = eClickPageUp
                Else
                    CurClickAction = eClickPageDown
                End If
            End If
        ElseIf ty < 3 Then
            If curBbsState <> bbsViewMenu Then
                UserControl.MousePointer = 99
                UserControl.MouseIcon = gcCursors("pageup")
                CurClickAction = eClickPageUp
            End If
        ElseIf ty > 22 Then
            If curBbsState <> bbsViewMenu Then
                UserControl.MousePointer = 99
                UserControl.MouseIcon = gcCursors("pagedown")
                CurClickAction = eClickPageDown
            End If
        Else
            UserControl.MousePointer = 0
            If mFocusedLine > -1 Then
                CurClickAction = eClickItem
            Else
                CurClickAction = eClickNone
            End If
        End If
End If
Err.Clear
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
    If mSelecting Then
    
    Else
        If gMouseEnabled Then RaiseEvent Click(CurClickAction)
    End If
Else
    RaiseEvent WantPopupMenu(X + 2, Y + 2)
End If
End Sub

Private Sub UserControl_DblClick()
If Not gMouseEnabled Then Exit Sub
Select Case CurClickAction
    Case eClickPageUp
        RaiseEvent Click(eClickPageFirst)
    Case eClickPageDown
        RaiseEvent Click(eClickPageLast)
End Select
End Sub

Public Sub OutText(ByRef bts() As Byte, ByVal nCount As Long)
    On Error GoTo kkk
    If nCount = 0 Then Exit Sub
    Dim tx As Long, ty As Long
    Dim ts As String, i As Long
    tx = mCellWidth * mX
    ty = mCellHeight * mY
    ts = StrConv(LeftB(bts, nCount), vbUnicode)
    TextOut BufferDc, tx, ty, ts, nCount
    If mBlink Then      '@
        TextOut BlinkDc, tx, ty, ts, nCount
        If mUnderLine Then
            i = ty + mCellHeight - 1
            MoveTo BufferDc, tx, i, ByVal 0&
            LineTo BufferDc, tx + mCellWidth * nCount, i
            MoveTo BlinkDc, tx, i, ByVal 0&
            LineTo BlinkDc, tx + mCellWidth * nCount, i
        End If
    Else
        If mUnderLine Then
            i = ty + mCellHeight - 1
            MoveTo BufferDc, tx, i, ByVal 0&
            LineTo BufferDc, tx + mCellWidth * nCount, i
        End If
        Dim r As RECT
        With r
            .Left = mCellWidth * mX
            .Top = mCellHeight * mY
            .Bottom = .Top + mCellHeight
            .Right = (mX + nCount) * mCellWidth
        End With
        FillRect BlinkDc, r, bgHBrush
    End If
    If nCount + mX > 80 Then nCount = 80 - mX
    For i = 0 To nCount - 1
        CopyMemory mCells(mX + i, mY), mCell, 24
    Next i
    CopyMemory mChars(mX, mY), bts(0), nCount
    mX = mX + nCount
    Exit Sub
kkk:
    Debug.Print "err!!!!!!!!! " & mX & "," & mY & ": " & ts
    Debug.Print "err in OutText: " & Err.Description
End Sub

Public Sub UnSelectRegion(x1 As Long, Y1 As Long, x2 As Long, Y2 As Long)
Dim i  As Long, j As Long, t As Long, ts As String, t1 As Long
Dim bts(81) As Byte, tx As Long, ct1 As Long, tForeColor As Long
Dim ShowBlink As Boolean
Dim b As Boolean, b1 As Boolean, r As Boolean, r1 As Boolean, h As Long, h1 As Long
Dim bTmp As Boolean
Dim f As Long, f1 As Long, bk As Long, bk1 As Long
LoadCellAttributes x1, Y1
With mCells(x1, Y1)
    b = .Blink
    r = .Reverse
    h = .HighLight
    f = .ForeGround
    bk = .BackGround
End With
For i = Y1 To Y2
    t = x1
    For j = x1 To x2
        With mCells(j, i)
            b1 = .Blink
            r1 = .Reverse
            h1 = .HighLight
            f1 = .ForeGround
            bk1 = .BackGround
        End With
        If b1 <> b Or r1 <> r Or h1 <> h Or f1 <> f Or bk1 <> bk Then
            b = b1
            r = r1
            h = h1
            f = f1
            bk = bk1
            ts = StrConv(MidB(bts, t + 1, j - t), vbUnicode)
            LoadCellAttributes t, i
            TextOut BufferDc, t * mCellWidth, mCellHeight * i, ts, j - t
            If mCells(t, i).Blink Then TextOut BlinkDc, t * mCellWidth, mCellHeight * i, ts, j - t
            t = j
        End If
        bts(j) = mChars(j, i)
        If bts(j) = 0 Then bts(j) = 32
    Next j
    LoadCellAttributes t, i
    ts = StrConv(MidB(bts, t + 1, x2 - t), vbUnicode)
    TextOut BufferDc, t * mCellWidth, mCellHeight * i, ts, x2 - t
Next i
End Sub

Private Sub LoadCellAttributes(X As Long, Y As Long)
Dim tForeColor As Long, tBackColor As Long
Dim tForeGround As Long, tBackGround As Long
Dim tHighLight As Long, tReverse As Boolean, tBlink As Boolean
With mCells(X, Y)
    tForeGround = .ForeGround
    tBackGround = .BackGround
    tHighLight = .HighLight
    tReverse = .Reverse
    tBlink = .Blink
    If tForeGround = 0 Then tForeGround = 37
    If tBackGround = 0 Then tBackGround = 40
End With
If tReverse Then
    tBackColor = gColors(tForeGround - 30)
    tForeColor = gColors(tBackGround - 40 + 8 * tHighLight)
Else
    tBackColor = gColors(tBackGround - 40)
    tForeColor = gColors(tForeGround - 30 + 8 * tHighLight)
End If
SetBkColor BufferDc, tBackColor
SetTextColor BufferDc, tForeColor
If tBlink Then
    SetTextColor BlinkDc, tBackColor Xor tForeColor
End If
End Sub

Private Sub InitDatas()
mForeGround = 37
mBackGround = 40
mHighLight = 1
mBlink = False
mReverse = False
With mCell
    .BackGround = mBackGround
    .ForeGround = mForeGround
    .HighLight = mHighLight
    .Reverse = mReverse
    .Blink = mBlink
End With
End Sub

Public Sub SelectRegion(ByVal x1 As Long, ByVal Y1 As Long, ByVal x2 As Long, ByVal Y2 As Long, Optional ShiftDown As Boolean = False)
Dim i  As Long, j As Long, t As Long, ts As String, t1 As Long
Dim b As Boolean, b1 As Boolean, bts(81) As Byte, tx As Long, ct1 As Long, tForeColor As Long
Dim m As Boolean, m1 As Boolean, ShowBlink As Boolean, LineMode As Boolean
Dim u As Boolean, u1 As Boolean, ut As Long, ui As Long

If x1 = x2 And Y1 = Y2 Then
    BitBlt BufferDc, 0, 0, BoxWidth, BoxHeight, TmpDc, 0, 0, vbSrcCopy      '%%%%
    BitBlt BlinkDc, 0, 0, BoxWidth, BoxHeight, TmpDc1, 0, 0, vbSrcCopy       '%%%%
    Exit Sub
End If
Timer1.Tag = Timer1.Enabled
Timer1.Enabled = False
If mSelecting Then   'ѡȻָδѡDC
    BitBlt BufferDc, 0, 0, BoxWidth, BoxHeight, TmpDc, 0, 0, vbSrcCopy      '%%%%
    BitBlt BlinkDc, 0, 0, BoxWidth, BoxHeight, TmpDc1, 0, 0, vbSrcCopy       '%%%%
Else    '򱸷δѡDC
    If mFocusedLine > -1 Then UnFocusLine
    If mBlinkDown Then  '˸ΪתһΣָ
        BitBlt BufferDc, 0, 0, BoxWidth, BoxHeight, BlinkDc, 0, 0, vbSrcInvert      '%%%%
    End If
    BitBlt UserControl.hdc, 0, 0, BoxWidth, BoxHeight, BufferDc, 0, 0, vbSrcCopy      '%%%%
    BitBlt TmpDc, 0, 0, BoxWidth, BoxHeight, BufferDc, 0, 0, vbSrcCopy      '%%%%
    BitBlt TmpDc1, 0, 0, BoxWidth, BoxHeight, BlinkDc, 0, 0, vbSrcCopy      '%%%%
    mSelecting = True
End If
mShiftMode = ShiftDown
If Not mShiftMode Then     'ûסShiftʱ
    LineMode = Y1 - Y2 'һʼģʽ
    If LineMode Then    'ԭ
        Dim tX1 As Long, tX2 As Long
        If Y1 > Y2 Then
            tX1 = x2
            tX2 = x1
        Else
            tX1 = x1
            tX2 = x2
        End If
        x1 = 0
        x2 = 80
    End If
End If
If x1 > x2 Then
    t = x1
    x1 = x2
    x2 = t
End If
If Y1 > Y2 Then
    t = Y1
    Y1 = Y2
    Y2 = t
End If
SetBkColor BufferDc, 12632256
tForeColor = 8421504
SetTextColor BufferDc, tForeColor
SetTextColor BlinkDc, 12632256 Xor tForeColor
b = True
m = True
u = True
For i = Y1 To Y2
    t = x1
    t1 = x1
    For j = x1 To x2
        b1 = mCells(j, i).HighLight
        m1 = mCells(j, i).Blink
        u1 = mCells(j, i).UnderLine
        If b <> b1 Then
            If b Then tForeColor = 8421504 Else tForeColor = 0
            SetTextColor BufferDc, tForeColor
            ts = StrConv(MidB(bts, t + 1, j - t), vbUnicode)
            TextOut BufferDc, t * mCellWidth, mCellHeight * i, ts, j - t
            t = j
            b = b1
            If m Then
               ShowBlink = True
               If b1 Then tForeColor = 0 Else tForeColor = 8421504
               SetTextColor BlinkDc, 12632256 Xor tForeColor
               GoTo jmp
            End If
        End If
        If m <> m1 Then
            If m Then ShowBlink = True Else t1 = j
            If b1 Then tForeColor = 8421504 Else tForeColor = 0
            SetTextColor BlinkDc, 12632256 Xor tForeColor
            m = m1
        End If
        
jmp:
        If ShowBlink Then
            ts = StrConv(MidB(bts, t1 + 1, j - t1), vbUnicode)
            TextOut BlinkDc, t1 * mCellWidth, mCellHeight * i, ts, j - t1
            t1 = j
            ShowBlink = False
        End If
        bts(j) = mChars(j, i)
    Next j
    If b Then tForeColor = 8421504 Else tForeColor = 0
    SetTextColor BufferDc, tForeColor
    ts = StrConv(MidB(bts, t + 1, x2 - t), vbUnicode)
    TextOut BufferDc, t * mCellWidth, mCellHeight * i, ts, x2 - t
    If m Then
        If b1 Then tForeColor = 0 Else tForeColor = 8421504
        SetTextColor BlinkDc, 12632256 Xor tForeColor
        ts = StrConv(MidB(bts, t1 + 1, j - t1), vbUnicode)
        TextOut BlinkDc, t1 * mCellWidth, mCellHeight * i, ts, j - t1
    End If
Next i
If LineMode Then    'ģʽ£Ҫصͷβ
    t = Y1 * mCellHeight
    t1 = tX1 * mCellWidth
    BitBlt BufferDc, 0, t, t1, mCellHeight, TmpDc, 0, t, vbSrcCopy
    BitBlt BlinkDc, 0, t, t1, mCellHeight, TmpDc1, 0, t, vbSrcCopy
    i = tX2 * mCellWidth
    j = Y2 * mCellHeight
    t = (80 - tX2) * mCellWidth
    BitBlt BufferDc, i, j, t, mCellHeight, TmpDc, i, j, vbSrcCopy
    BitBlt BlinkDc, i, j, t, mCellHeight, TmpDc1, i, j, vbSrcCopy
End If
mBlinkDown = False
Timer1.Enabled = Timer1.Tag
End Sub


Public Sub CancelSelecting()
If mFocusedLine > -1 Then UnFocusLine
BitBlt BufferDc, 0, 0, BoxWidth, BoxHeight, TmpDc, 0, 0, vbSrcCopy      '%%%%
BitBlt BlinkDc, 0, 0, BoxWidth, BoxHeight, TmpDc1, 0, 0, vbSrcCopy       '%%%%
mSelecting = False
Redraw
LoadAttributesFromCell mCell
End Sub

Public Property Get Selecting() As Boolean
Selecting = mSelecting
End Property

Private Sub LoadAttributesFromCell(Cell As CellType)
With Cell
    mForeGround = .ForeGround
    mBackGround = .BackGround
    mHighLight = .HighLight
    mReverse = .Reverse
    mBlink = .Blink
End With
If mReverse Then
    mBackColor = gColors(mForeGround - 30)
    mForeColor = gColors(mBackGround - 40 + 8 * mHighLight)
Else
    mBackColor = gColors(mBackGround - 40)
    mForeColor = gColors(mForeGround - 30 + 8 * mHighLight)
End If
SetBkColor BufferDc, mBackColor
SetTextColor BufferDc, mForeColor
SetTextColor BlinkDc, mBackColor Xor mForeColor
End Sub

Private Sub SetGDIFonts()
Dim tLF As Long
tLF = CreateLogFont(UserControl.Font, UserControl.hdc)
SelectObject BufferDc, tLF
SelectObject BlinkDc, tLF
SelectObject TmpDc, tLF
SelectObject TmpDc1, tLF
mCellWidth = UserControl.TextWidth("") / 2
mCellHeight = UserControl.TextHeight("")
End Sub

Public Sub Redraw()
BitBlt UserControl.hdc, 0, 0, BoxWidth, BoxHeight, BufferDc, 0, 0, vbSrcCopy      '%%%%
SetCaretPosition mCellWidth * mX, mCellHeight * (mY + 1)
End Sub

Private Sub ReRenderScreen()
Dim r As RECT
With r
    .Right = 1024
    .Bottom = 768
End With
FillRect BufferDc, r, bgHBrush
FillRect BlinkDc, r, bgHBrush
UnSelectRegion 0, 0, 80, 24
UserControl.Cls
Redraw
End Sub

Public Function GetLineText(Line As Long) As String
Dim bt(255) As Byte
CopyMemory bt(0), mChars(0, Line - 1), 256
GetLineText = Trim(StrConv(bt, vbUnicode))
End Function

Public Function GetBlockText(X As Long, Y As Long, CharCount As Long) As String
Dim bt() As Byte
ReDim bt(CharCount - 1)
CopyMemory bt(0), mChars(X - 1, Y - 1), CharCount
GetBlockText = StrConv(bt, vbUnicode)
End Function

Public Sub FocusLine(Line As Long)
Dim i As Long, t As Long
Dim ty As Long
Dim PrevBlank As Boolean

If mFocusedLine > -1 Then
    t = (mFocusedLine + 1) * mCellHeight - 1
    BitBlt BufferDc, 0, t, BoxWidth, 1, LineDc, 0, 0, vbSrcCopy
    BitBlt UserControl.hdc, 0, t, BoxWidth, 1, BufferDc, 0, t, vbSrcCopy
End If
mFocusedLine = Line
ty = (Line + 1) * mCellHeight - 1
BitBlt LineDc, 0, 0, BoxWidth, 1, BufferDc, 0, ty, vbSrcCopy
PrevBlank = True
MoveTo BufferDc, 0, ty, 0
For i = 0 To 80
    If mChars(i, Line) = 32 Then
        If Not PrevBlank Then
            LineTo BufferDc, i * mCellWidth, ty
        End If
        PrevBlank = True
    ElseIf PrevBlank Then
        PrevBlank = False
        MoveTo BufferDc, mCellWidth * i, ty, 0
    End If
Next i
BitBlt UserControl.hdc, 0, ty, BoxWidth, 1, BufferDc, 0, ty, vbSrcCopy
End Sub

Public Sub UnFocusLine()
Dim t As Long
t = (mFocusedLine + 1) * mCellHeight - 1
BitBlt BufferDc, 0, t, BoxWidth, 1, LineDc, 0, 0, vbSrcCopy
BitBlt UserControl.hdc, 0, t, BoxWidth, 1, BufferDc, 0, t, vbSrcCopy
mFocusedLine = -1
End Sub

Public Property Let TopFocusLine(ByVal NewTopFocusLine As Long)
mTopFocusLine = NewTopFocusLine - 1
End Property

Public Property Let BotFocusLine(ByVal NewBotFocusLine As Long)
mBotFocusLine = NewBotFocusLine - 1
End Property

Public Property Get CurClickedItem() As Long
If mFocusedLine < 0 Then Exit Property
CurClickedItem = mFocusedLine + 1
End Property

Public Property Get ClickedItemIsNull() As Boolean
Dim bt(80) As Byte
If mFocusedLine < 0 Then Exit Property
CopyMemory bt(0), mChars(0, mFocusedLine), 81
If Trim(StrConv(bt, vbUnicode)) = "" Then
    ClickedItemIsNull = True
End If
End Property

Public Property Get CurItem() As Long
CurItem = mY + 1
End Property

Public Property Get ClickedMenuKeyCode() As Byte
If mFocusedLine < 0 Then Exit Property
Dim i As Long, bt As Long, ts As String, t As Long
ts = GetLineText(mFocusedLine + 1)
t = Len(ts)
For i = 1 To t
    bt = Asc(Mid(ts, i, 1))
    If (bt > 47 And bt < 58) Or (bt > 64 And bt < 91) Or (bt > 96 And bt < 123) Then
        ClickedMenuKeyCode = CByte(bt)
        Exit For
    End If
Next i
End Property

Public Sub UpdateCursorState()
    On Error Resume Next
    Dim p As POINTAPI, r As RECT, tx As Single, ty As Single
    GetCursorPos p
    GetWindowRect UserControl.hwnd, r
    tx = p.X - r.Left
    ty = p.Y - r.Top
    UserControl_MouseMove 0, 0, tx, ty
    If Err Then Debug.Print Err.Description & "!!!!!!!!!!!!!!! updatecursorstate!"
End Sub

Private Function CheckUrl(tx As Long, ty As Long) As Boolean
Dim i As Long, x1 As Long, x2 As Long, t As Long, DotCount As Long, b As Byte, bRetVal As Boolean
x2 = tx - 1
For i = tx To 80
    b = mChars(i, ty)
    If b = 32 Or b > 128 Then Exit For
    If b = 46 Then DotCount = DotCount + 1
    x2 = i
Next i
x1 = tx + 1
For i = tx To 0 Step -1
    b = mChars(i, ty)
    If b = 32 Or b > 128 Then Exit For
    If b = 46 Then DotCount = DotCount + 1
    x1 = i
Next i
If mChars(tx, ty) = 46 Then DotCount = DotCount - 1
If DotCount > 0 Then
    Dim bt() As Byte
    t = x2 - x1 + 1
    ReDim bt(t - 1)
    CopyMemory bt(0), mChars(x1, ty), t
    mUrl = StrConv(bt, vbUnicode)
    If InStr(1, mUrl, "..") Then Exit Function
    bRetVal = True
    If bt(0) = mChars(tx, ty) Then
        If Not IsLetterOrNumber(CLng(bt(0))) Then
            bRetVal = False
        End If
    ElseIf bt(t - 1) = mChars(tx, ty) Then
        If Not IsLetterOrNumber(CLng(bt(t - 1))) Then
            bRetVal = False
        End If
    End If
    If bRetVal And DotCount = 1 Then
        If InStr(1, mUrl, "@") + InStr(1, mUrl, "//") = 0 Then
            bRetVal = False
        End If
    End If
    CheckUrl = bRetVal
End If
End Function

Public Property Get ClickedUrl() As String
On Error Resume Next
Dim ts As String, t As Long
ts = mUrl
If Not IsLetterOrNumber(Asc(Left(ts, 1))) Then
    ts = Mid(ts, 2)
End If
If Not IsLetterOrNumber(Asc(Right(ts, 1))) Then
    ts = Left(ts, Len(ts) - 1)
End If
If InStr(1, ts, "http://", vbTextCompare) = 1 Or InStr(1, ts, "mailto:", vbTextCompare) = 1 Or InStr(1, ts, "ftp://", vbTextCompare) = 1 Or InStr(1, ts, "telnet:", vbTextCompare) = 1 Then
ElseIf InStr(1, ts, "@") Then
    ts = "mailto:" & ts
ElseIf InStr(1, ts, "bbs.", vbTextCompare) = 1 Then
    ts = "telnet:" & ts
Else
    ts = "http://" & ts
End If
ClickedUrl = ts
End Property

Public Property Let Enabled(NewEnabled As Boolean)
UserControl.Enabled = NewEnabled
End Property
Public Property Get Enabled() As Boolean
Enabled = UserControl.Enabled
End Property

Public Sub CopyText()
If mSelecting = False Then Exit Sub
Dim ts As String, ts1 As String
Dim i As Long, bts(80) As Byte, t As Long
Dim tSelStartX As Long, tSelStartY As Long, tSelEndX As Long, tSelEndY As Long
If mShiftMode Then  'ɫ
    If SelStartY > SelEndY Then
        tSelStartY = SelEndY
        tSelEndY = SelStartY
    Else
        tSelStartY = SelStartY
        tSelEndY = SelEndY
    End If
    If SelStartX > SelEndX Then
        tSelStartX = SelEndX
        tSelEndX = SelStartX
    Else
        tSelStartX = SelStartX
        tSelEndX = SelEndX
    End If
    ts = GetEscText(tSelStartX, tSelStartY, tSelEndX, tSelEndY)
Else    'ı
    '---------------------------
    If SelStartY > SelEndY Then
        tSelStartY = SelEndY
        tSelEndY = SelStartY
        tSelStartX = SelEndX
        tSelEndX = SelStartX
    Else
        tSelStartY = SelStartY
        tSelEndY = SelEndY
        tSelStartX = SelStartX
        tSelEndX = SelEndX
    End If
    CopyMemory bts(0), mChars(tSelStartX, tSelStartY), IIf(tSelStartY = tSelEndY, tSelEndX, 80) - tSelStartX
    ts1 = StrConv(LeftB(bts, 80 - tSelStartX), vbUnicode)
    ts = ts & ts1
    For i = tSelStartY + 1 To tSelEndY - 1
        CopyMemory bts(0), mChars(0, i), 81
        ts1 = StrConv(bts, vbUnicode)
        ts = ts & vbCrLf & ts1
    Next i
    If tSelStartY <> tSelEndY Then
        CopyMemory bts(0), mChars(0, tSelEndY), tSelEndX + 1
        ts1 = StrConv(LeftB(bts, tSelEndX + 1), vbUnicode)
        ts = ts & vbCrLf & ts1
    End If
    '----------
End If
Clipboard.Clear
Clipboard.SetText ts
CancelSelecting
End Sub

Private Function GetEscText(x1 As Long, Y1 As Long, x2 As Long, Y2 As Long) As String
Dim i  As Long, j As Long, t As Long, ts As String, t1 As Long
Dim bts(81) As Byte, tx As Long, ct1 As Long, tForeColor As Long
Dim ShowBlink As Boolean
Dim b As Boolean, b1 As Boolean, r As Boolean, r1 As Boolean, h As Long, h1 As Long
Dim bTmp As Boolean
Dim f As Long, f1 As Long, bk As Long, bk1 As Long
Dim EscStr As String, EscHead As String
Dim Need0 As Boolean, Need1 As Boolean
EscHead = Chr(27) & Chr(27) & "["
b = False
r = False
h = 1
f = 0
bk = 0
For i = Y1 To Y2
    t = x1
    For j = x1 To x2
        If mCells(j, i).ForeGround = 0 Then
            b1 = False
            r1 = False
            h1 = 1
            f1 = 37
            bk1 = 40
        Else
            With mCells(j, i)
                b1 = .Blink
                r1 = .Reverse
                h1 = .HighLight
                f1 = .ForeGround
                bk1 = .BackGround
            End With
        End If
        ts = ""
        Need0 = False
        Need1 = False
        If b1 <> b Then
            If b1 Then ts = ts & ";5" Else Need0 = True: If h Then Need1 = True
            b = b1
        End If
        If r1 <> r Then
            If r1 Then ts = ts & ";7" Else Need0 = True: If h Then Need1 = True
            r = r1
        End If
        If h1 <> h Then
            If h1 Then Need1 = True Else Need0 = True
            h = h1
        End If
        If Need1 Then
            ts = ";1" & ts
        End If
        If Need0 Then
            ts = ";0" & ts
        End If
        If f1 <> f Then
            If Not (Need0 And f1 = 37) Then ts = ts & ";" & f1
            f = f1
        ElseIf Need0 Then
            ts = ts & ";" & f1
            f = f1
        End If
        If bk1 <> bk Then
            If Not (Need0 And bk1 = 40) Then ts = ts & ";" & bk1
            bk = bk1
        ElseIf Need0 Then
            ts = ts & ";" & bk1
            bk = bk1
        End If
        If Len(ts) Then
            ts = EscHead & Mid(ts, 2) & "m"
            EscStr = EscStr & StrConv(ts, vbFromUnicode)
        End If
        bts(j) = mChars(j, i)
        If bts(j) = 0 Then bts(j) = 32
        EscStr = EscStr & ChrB(bts(j))
    Next j
    EscStr = EscStr & ChrB(13) & ChrB(10)
Next i
GetEscText = StrConv(EscStr, vbUnicode)
End Function

Public Sub ShowLineMark()
Dim tx As Long, ty As Long, tCell As CellType
Dim tForeGround As Long, tBackGround As Long
Dim tHighLight As Long, tReverse As Boolean, tBlink As Boolean, tUnderLine As Boolean
Dim bts() As Byte
Dim Y As Long
Y = 23 - mScreenUpCount
ReDim bts(1)
CopyMemory bts(0), mChars(0, Y), 2
bts = StrConv(Left(StrConv(bts, vbUnicode), 1), vbFromUnicode)
'---
tx = mX: ty = mY
CopyMemory tCell, mCell, 24
tForeGround = mForeGround
tBackGround = mBackGround
tHighLight = mHighLight
tReverse = mReverse
tBlink = mBlink
tUnderLine = mUnderLine
'---
mX = 0: mY = Y
bts(0) = mChars(0, Y)
ForeGround = 37
BackGround = 40
HighLight = 1
UnderLine = True
Reverse = True
Blink = False
OutText bts, UBound(bts) + 1
'---
mX = tx: mY = ty
LoadCellAttributes mX, mY
CopyMemory mCell, tCell, 24
mForeGround = tForeGround
mBackGround = tBackGround
mHighLight = tHighLight
mReverse = tReverse
mBlink = tBlink
mUnderLine = tUnderLine
Redraw
End Sub

Public Property Get ScreenUpCount() As Long
ScreenUpCount = mScreenUpCount
End Property

Public Property Let ScreenUpCount(NewCount As Long)
mScreenUpCount = NewCount
End Property

Public Sub FullScreenCorrect()
'mNeedCorrect = True
'zzzzzzzzz
Dim bt1(80) As Byte
Dim bt(80) As Byte
Dim i As Long, j As Long, t As Long, ct As Long
Dim ts As String, ts1 As String
Dim TwoBt() As Byte, CharCount As Long, MaxCharCount As Long
Dim tx As Long
Dim X As Long, Y As Long
For Y = 0 To 23
    CopyMemory bt(0), mChars(0, Y), 81
    ts = RTrim(StrConv(bt, vbUnicode))
    If ts = "" Then GoTo ContinueY
    ct = 0
    For X = 0 To 80
        If bt(X) < 128 Then ct = ct + 1
    Next X
    If (80 - ct) Mod 2 Then GoTo ContinueY
    'Debug.Print "Y:" & y
    CharCount = 0
    For X = 1 To Len(ts)
        TwoBt = StrConv(Mid(ts, X, 1), vbFromUnicode)
        If UBound(TwoBt) Then
            If TwoBt(0) >= &HB0 And TwoBt(0) <= &HD7 And TwoBt(1) >= &HA1 And TwoBt(1) <= &HF9 Then
                CharCount = CharCount + 2
            ElseIf InStr(1, "", StrConv(TwoBt, vbUnicode)) <> 0 Then
                CharCount = CharCount + 3
            End If
        ElseIf TwoBt(0) < 128 Then
            CharCount = CharCount + 1
        End If
    Next X
    MaxCharCount = CharCount '+ 1
    tx = -1
    'For x = 80 To 0 Step -1
    For X = 0 To 80 ' Step -1
        'bt1 = bt
        CopyMemory bt1(0), bt(0), 81
        bt1(X) = 128
        ts = StrConv(bt1, vbUnicode)
        CharCount = 0
        For j = 1 To Len(ts)
            TwoBt = StrConv(Mid(ts, j, 1), vbFromUnicode)
            If UBound(TwoBt) Then
                If TwoBt(0) >= &HB0 And TwoBt(0) <= &HD7 And TwoBt(1) >= &HA1 And TwoBt(1) <= &HF9 Then
                    CharCount = CharCount + 2
                ElseIf InStr(1, "񣺣", StrConv(TwoBt, vbUnicode)) <> 0 Then
                    CharCount = CharCount + 3
                End If
            ElseIf TwoBt(0) < 128 Then
                CharCount = CharCount + 1
            End If
        Next j
        If CharCount > MaxCharCount Then
            tx = X
            MaxCharCount = CharCount
            'Exit For
        End If
    Next X
    If tx <> -1 Then
        tx = tx '- 2
        If tx < 0 Then tx = 0
        If tx <= 80 Then bt(tx) = 32
    End If
ContinueY:
CopyMemory mChars(0, Y), bt(0), 81
Next Y
ReRenderScreen
End Sub

Public Property Let FullScreen(NewFullScreen As Boolean)
mFullScreen = NewFullScreen
End Property

Public Property Get FullScreen() As Boolean
FullScreen = mFullScreen
End Property

Public Property Let HaveBorder(NewHaveBorder As Boolean)
UserControl.BorderStyle = IIf(NewHaveBorder, 1, 0)
End Property

'----------------------------------------------------------
Public Function GetHtmls(x1 As Long, Y1 As Long, x2 As Long, Y2 As Long) As String
Dim i  As Long, j As Long, t As Long, ts As String, t1 As Long
Dim bts(81) As Byte, tx As Long, ct1 As Long, tForeColor As Long
Dim ShowBlink As Boolean
Dim b As Boolean, b1 As Boolean, r As Boolean, r1 As Boolean, h As Long, h1 As Long
Dim bTmp As Boolean
Dim f As Long, f1 As Long, bk As Long, bk1 As Long
Dim OldForeColor As Long, OldBackColor As Long, OldBlink As Boolean, EndTag As String
Dim allts As String
If gHtmlColors(0) = "" Then
    gHtmlColors(0) = "#000000"
    gHtmlColors(1) = "#800000"
    gHtmlColors(2) = "#008000"
    gHtmlColors(3) = "#808000"
    gHtmlColors(4) = "#000080"
    gHtmlColors(5) = "#800080"
    gHtmlColors(6) = "#008080"
    gHtmlColors(7) = "#c0c0c0"
    gHtmlColors(8) = "#808080"
    gHtmlColors(9) = "#ff0000"
    gHtmlColors(10) = "#00ff00"
    gHtmlColors(11) = "#ffff00"
    gHtmlColors(12) = "#0000ff"
    gHtmlColors(13) = "#ff00ff"
    gHtmlColors(14) = "#00ffff"
    gHtmlColors(15) = "#FFFFFF"
End If
OldForeColor = 0
OldBackColor = 15
OldBlink = False
allts = LoadCellAttributesForHtml(x1, Y1, OldForeColor, OldBackColor, OldBlink, EndTag)
With mCells(x1, Y1)
    b = .Blink
    r = .Reverse
    h = .HighLight
    f = .ForeGround
    bk = .BackGround
End With
For i = Y1 To Y2
    t = x1
    For j = x1 To x2
        With mCells(j, i)
            b1 = .Blink
            r1 = .Reverse
            h1 = .HighLight
            f1 = .ForeGround
            bk1 = .BackGround
        End With
        If b1 <> b Or r1 <> r Or h1 <> h Or f1 <> f Or bk1 <> bk Then
            b = b1
            r = r1
            h = h1
            f = f1
            bk = bk1
            ts = StrConv(MidB(bts, t + 1, j - t), vbUnicode)
            If Trim(ts) <> "" Then allts = allts & EndTag & LoadCellAttributesForHtml(t, i, OldForeColor, OldBackColor, OldBlink, EndTag)
            'If Trim(ts) <> "" Then allts = allts & LoadCellAttributesForHtml(t, i, OldForeColor, OldBackColor, OldBlink, EndTag)
            allts = allts & Replace(ts, " ", "&nbsp;")
            t = j
        End If
        bts(j) = mChars(j, i)
        If bts(j) = 0 Then bts(j) = 32
    Next j
    ts = StrConv(MidB(bts, t + 1, x2 - t), vbUnicode)
    If Trim(ts) <> "" Then allts = allts & EndTag & LoadCellAttributesForHtml(t, i, OldForeColor, OldBackColor, OldBlink, EndTag)
    'If Trim(ts) <> "" Then allts = allts & LoadCellAttributesForHtml(t, i, OldForeColor, OldBackColor, OldBlink, EndTag)
    allts = allts & Replace(RTrim(ts), " ", "&nbsp;") & "<br>" & vbCrLf
    'allts = RTrim(allts)
Next i
GetHtmls = allts
End Function

Private Function LoadCellAttributesForHtml(X As Long, Y As Long, OldForeColor As Long, OldBackColor As Long, OldBlink As Boolean, EndTag As String) As String
Dim tForeColor As Long, tBackColor As Long
Dim tForeGround As Long, tBackGround As Long
Dim tHighLight As Long, tReverse As Boolean, tBlink As Boolean
Dim ts As String
With mCells(X, Y)
    tForeGround = .ForeGround
    tBackGround = .BackGround
    tHighLight = .HighLight
    tReverse = .Reverse
    tBlink = .Blink
    If tForeGround = 0 Then tForeGround = 37
    If tBackGround = 0 Then tBackGround = 40
End With
If tReverse Then
    tBackColor = tForeGround - 30
    tForeColor = tBackGround - 40 + 8 * tHighLight
Else
    tBackColor = tBackGround - 40
    tForeColor = tForeGround - 30 + 8 * tHighLight
End If
If tBackColor <> OldBackColor Then
    
    ts = "<span style='background-color: " & gHtmlColors(tBackColor)
    OldBackColor = tBackColor
    If tForeColor <> OldForeColor Then
        ts = ts & ";color:" & gHtmlColors(tForeColor)
        OldForeColor = tForeColor
    End If
    ts = ts & "'>"
    'EndTag = "</span>"
ElseIf tForeColor <> OldForeColor Then
    ts = "<font color=" & gHtmlColors(tForeColor) & ">"
    OldForeColor = tForeColor
'    EndTag = "</font>"
    EndTag = ""
End If
If tBlink <> OldBlink Then
    OldBlink = tBlink
End If
LoadCellAttributesForHtml = ts
End Function

Public Sub SetMoueseDisabled()
UserControl.MousePointer = 0
mTopFocusLine = -2
End Sub

Public Property Get CurrentX() As Long
CurrentX = mX
End Property

Public Property Get CurrentY() As Long
CurrentY = mY
End Property
'========================================================================================