module1.bas

该方案充分发挥人性化的特点

Attribute VB_Name = "Module1"
Option Explicit
'Option Explicit
Public Const MAX_TOOLTIP As Integer = 64
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206

Public Const SW_RESTORE = 9
Public Const SW_HIDE = 0

Public nfIconData As NOTIFYICONDATA


Public Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * MAX_TOOLTIP
End Type

Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public RxBuf As String
Public RxData As String
Public vb218Flag As Integer
Public OnTop As Byte
Public MyName As String
Public NameLength As Integer
Public JoinName As String
Public JoinNameLength As Integer

Public TextLength As Integer

Public TextLenth As Long
Public ShowLength As Long
Public FaceSignLoc As Integer
Public FaceNum As Integer
Public ShowData As String
Public RxDataTemp As String
Public MsgName As Integer
Public WendFlag As Integer

Public CtrlPressed As Boolean
Public AltPressed As Boolean

Public Type POINTAPI
        x As Long
        y As Long
End Type
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public ButtonUpSign As Boolean



Public Sub StringShow(StrToShow As String)
    TextLength = LenB(StrConv(Form1.rtfReceive.Text, vbFromUnicode)) 'Len(form1.rtfReceive.Text)不行
    ShowLength = LenB(StrConv(StrToShow, vbFromUnicode)) 'Len(RxBuf)
    Form1.rtfReceive.SelStart = TextLength ' - ShowLength  'LenB(StrConv(form1.rtfReceive.Text, vbFromUnicode)) 'TextLength '
    Form1.rtfReceive.SelLength = ShowLength
    If MsgName = 1 Then
        Form1.rtfReceive.SelColor = RGB(255, 0, 0)
    ElseIf MsgName = 2 Then
        Form1.rtfReceive.SelColor = RGB(0, 0, 255)
    Else
        Form1.rtfReceive.SelColor = RGB(0, 0, 0)
    End If
    Form1.rtfReceive.SelText = StrToShow
End Sub
Public Sub MsgShow()
    While WendFlag <> 4
        FaceSignLoc = InStr(RxData, "\\")
        If FaceSignLoc > 0 Then
            RxDataTemp = Mid(RxData, FaceSignLoc + 2)
            If Asc(RxDataTemp) >= 0 + 48 And Asc(RxDataTemp) <= 9 + 48 Then
                FaceNum = Asc(RxDataTemp) - 48
                ShowData = Mid(RxData, 1, FaceSignLoc - 1)
                Call StringShow(ShowData)
                '下面四行用于显示表情
                TextLength = LenB(StrConv(Form1.rtfReceive.Text, vbFromUnicode)) 'Len(rtfReceive.Text)
                Form1.rtfReceive.SelStart = LenB(StrConv(Form1.rtfReceive.Text, vbFromUnicode))
                Form1.rtfReceive.OLEObjects.Add , , App.Path & "\Picture\表情\" + Chr(FaceNum + 48) + ".bmp"
                Form1.rtfSend.SetFocus
                '下列方法显示位置不在最后，但是显示头像时不闪烁
                'Form1.rtfReceive.SelStart = LenB(StrConv(rtfReceive.Text, vbFromUnicode))  'TextLength
                'Image2.Picture = LoadResPicture("send2", 0)
                'Clipboard.Clear
                'Clipboard.SetData Image2.Picture '((App.Path & "\Picture\Send2.bmp"), vbCFBitmap)
                'rtfReceive.Locked = False
                'rtfReceive.SetFocus
                'SendKeys "^v"
                
                RxData = Mid(RxData, FaceSignLoc + 3)
            Else
                ShowData = Mid(RxData, 1, FaceSignLoc - 1)
                RxData = Mid(RxData, FaceSignLoc + 2)
                Call StringShow(ShowData)
            End If
        Else
            WendFlag = 4
        End If
    Wend
    WendFlag = 0
    Call StringShow(RxData)
End Sub

Public Sub CheckCursUp(ObjLeft As Long, ObjTop As Long, ObjWidth As Long, ObjHeight As Long)
    Dim CursPOS As POINTAPI
    Dim CursLeft As Long, CursTop As Long
    GetCursorPos CursPOS
    CursLeft = CursPOS.x * 15 - Form1.Left
    CursTop = CursPOS.y * 15 - Form1.Top
    If CursLeft > ObjLeft And CursLeft < (ObjLeft + ObjWidth) And CursTop > ObjTop And CursTop < (ObjTop + ObjHeight) Then
        ButtonUpSign = True
    Else
        ButtonUpSign = False
    End If
End Sub