form5.frm

来自「用vb编的网络聊天程序」· FRM 代码 · 共 171 行

VERSION 5.00
Begin VB.Form Form5 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Whiteboard"
   ClientHeight    =   3135
   ClientLeft      =   5880
   ClientTop       =   1785
   ClientWidth     =   5415
   Icon            =   "Form5.frx":0000
   LinkTopic       =   "Form5"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3135
   ScaleWidth      =   5415
   ShowInTaskbar   =   0   'False
   Begin VB.PictureBox Picture1 
      BackColor       =   &H80000005&
      Height          =   2748
      Left            =   72
      ScaleHeight     =   2685
      ScaleWidth      =   5175
      TabIndex        =   0
      Top             =   108
      Width           =   5232
   End
End
Attribute VB_Name = "Form5"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'local drawing position
Private lX As Long
Private lY As Long

'remote drawing position
Private lX1 As Long
Private lY1 As Long

Private Sub Form_Load()
    On Error GoTo ErrorHandle
    Picture1.ScaleMode = vbPixels
    Picture1.AutoRedraw = True
    
    'reset flags
    lX = -1
    lX1 = -1
    Exit Sub
    
ErrorHandle:
    ShowErr
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error GoTo ErrorHandle
    If Button Then
        lX = X
        lY = Y
        
        'left button for drawing, right button for erasing
        Picture1.MousePointer = IIf(Button = vbLeftButton, 2, 15)
        
        Picture1.DrawWidth = IIf(Button = vbLeftButton, 3, 3 * 5)
        Picture1.ForeColor = IIf(Button = vbLeftButton, 0, Picture1.BackColor)
        
        'tell remote we need start
        Form1.SendMessage -1, -1, TM_WHITEBEGIN, , Picture1.DrawWidth & " " & Picture1.ForeColor & " " & X & " " & Y
    End If
    Exit Sub
    
ErrorHandle:
    ShowErr
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error GoTo ErrorHandle
    If lX >= 0 Then
    
        'draw it
        Picture1.Line (X, Y)-(lX, lY)
        lX = X
        lY = Y
    
        'tell remote our new position
        Form1.SendMessage -1, -1, TM_WHITEDATA, X, Y
    End If
    Exit Sub
    
ErrorHandle:
    ShowErr
End Sub

Private Sub StopDraw()
    
    'reset flags
    lX = -1
    
    Picture1.MousePointer = vbDefault
    
    'tell remote we need stop
    Form1.SendMessage -1, -1, TM_WHITEEND

End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error GoTo ErrorHandle
    StopDraw
    Exit Sub
    
ErrorHandle:
    ShowErr
End Sub


Friend Sub OnMessage(ByVal Address As Long, ByVal Port As Integer, ByVal Handle As Long, ByVal Param As Long, Data As Variant)
    Select Case Handle
    Case TM_WHITEBEGIN
    
        'if remote drawing already start, ignore this message
        If lX1 >= 0 Then Exit Sub
        
        'split params from string
        Dim l As Long
        l = InStr(Data, " ")
        Picture1.DrawWidth = Left$(Data, l - 1)
        Data = Mid$(Data, l + 1)
        
        l = InStr(Data, " ")
        Picture1.ForeColor = Left$(Data, l - 1)
        Data = Mid$(Data, l + 1)
        
        l = InStr(Data, " ")
        lX1 = Left$(Data, l - 1)
        lY1 = Mid$(Data, l + 1)
    
        'show me
        If Not Visible Then Show vbModeless, Form1
        
    Case TM_WHITEDATA
        If lX1 < 0 Then Exit Sub
        
        'draw on new position
        Picture1.Line (Param, Data)-(lX1, lY1)
        lX1 = Param
        lY1 = Data
        
    Case TM_WHITEEND
    
        'reset flag
        lX1 = -1
    End Select
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    On Error GoTo ErrorHandle

    If lX >= 0 Then StopDraw
    
    If UnloadMode <> vbFormCode Then
        Hide
        Cancel = True
    End If
    Exit Sub
    
ErrorHandle:
    ShowErr
End Sub