📄 screen2.frm
字号:
Private Sub HScroll1_KeyUp(KeyCode As Integer, Shift As Integer)
Call keyone(KeyCode, Shift)
End Sub
Private Sub Picture1_DblClick()
On Error Resume Next
Winsock2.SendData "dblclick"
End Sub
Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)
Call keytwo(KeyCode, Shift)
End Sub
Private Sub Picture1_KeyUp(KeyCode As Integer, Shift As Integer)
Call keyone(KeyCode, Shift)
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Select Case Button
Case 1
Winsock2.SendData "down1"
Case 2
Winsock2.SendData "down2"
Case 4
Winsock2.SendData "down4"
End Select
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Dim point1 As POINTAPI
Dim point2 As POINTAPI
GetDCOrgEx formhdc, point1
GetCursorPos point2
Dim pi As String
pi = point2.X - point1.X & "," & point2.Y - point1.Y
Winsock2.SendData pi
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Select Case Button
Case 1
Winsock2.SendData "up1"
Case 2
Winsock2.SendData "up2"
Case 4
Winsock2.SendData "up4"
End Select
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
Winsock1.Connect
If Winsock1.State = sckError Then
Winsock1.Close
Else
End If
End Sub
Private Sub Timer2_Timer()
clos = clos + 1
If (clos < 10) Then
Winsock1.Close
Winsock1.Connect
'Timer1.Enabled = True
Else
clos = 0
Timer2.Enabled = False
Winsock1.Close
Winsock2.Close
Winsock3.Close
MsgBox "连接意外断开,请查看网络连接情况!", 64, "提示"
Unload Me
End If
End Sub
Private Sub VScroll1_KeyDown(KeyCode As Integer, Shift As Integer)
Call keytwo(KeyCode, Shift)
End Sub
Private Sub VScroll1_KeyUp(KeyCode As Integer, Shift As Integer)
Call keyone(KeyCode, Shift)
End Sub
Private Sub Winsock1_Close()
Winsock1.Close
Call Timer2_Timer
End Sub
Private Sub Winsock1_Connect()
Timer1.Enabled = False
bool = False
Timer2.Enabled = False
clos = 0
Dim send1 As String
send1 = se & "-" & time1 & "-" & beijing & "-"
'MsgBox send1
Winsock1.SendData send1
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
On Error GoTo er
If bool = False Then
Dim ok As String
Winsock1.GetData ok
Dim p(6) As Integer
p(0) = InStr(1, ok, "-")
p(1) = InStr(p(0) + 1, ok, "-")
p(2) = InStr(p(1) + 1, ok, "-")
p(3) = InStr(p(2) + 1, ok, "-")
p(4) = InStr(p(3) + 1, ok, "-")
p(5) = InStr(p(4) + 1, ok, "-")
p(6) = InStr(p(5) + 1, ok, "-")
date3(0) = Left(ok, p(0) - 1)
date3(1) = Mid(ok, p(0) + 1, p(1) - p(0) - 1)
date3(2) = Mid(ok, p(1) + 1, p(2) - p(1) - 1)
date3(3) = Mid(ok, p(2) + 1, p(3) - p(2) - 1)
date3(4) = Mid(ok, p(3) + 1, p(4) - p(3) - 1)
date3(5) = Mid(ok, p(4) + 1, p(5) - p(4) - 1)
date3(6) = Mid(ok, p(5) + 1, p(6) - p(5) - 1)
Dim ix As Integer
'date2 = date3(0)
If (se = 256) Then
Call m256a(date3(1), date3(2))
ReDim date1(date3(0) + 4) '786431
End If
If (se = 16) Then
Call m16a(date3(1), date3(2))
ReDim date1(date3(0) + 4) '393216
End If
If (se = 160) Then
Call m16xa(date3(1), date3(2), date3(5), date3(6))
ReDim date1(date3(0) + 4) '1572864
End If
'Call port(date3(3), date3(4)) '传递远程计算机的 UPD 端口 给本地控件
' ReDim date1(date2)
bool = True
Else
''''''''''''''''''''''''''接收位图数据
Dim f1() As Byte
Winsock1.GetData f1()
Dim wei As Long
wei = UBound(f1())
Dim e As Long
'If (se = 160) Then
'16位色处理方法
' Do While e <= wei
' date1(date2) = f1(e)
' date2 = date2 + 1
' e = e + 1
' If (date2 = date3(0) + 1) Then
' Call m16xb
' date2 = 0
'End If
' Loop
'Else
'16或 256处理方法
If (wei <= 4) Then
Call one
date2 = 0
End If
If (f1(wei - 1) = 0 And f1(wei - 2) = 0 And f1(wei - 3) = 0 And f1(wei) = 0) Then
Do While e <= wei
date1(date2) = f1(e)
e = e + 1
date2 = date2 + 1
Loop
Call one
date2 = 0
Else
Do While e <= wei
date1(date2) = f1(e)
e = e + 1
date2 = date2 + 1
Loop
End If
End If
'End If
Exit Sub
er:
'MsgBox "接收数据出错,程序要重新连接!", vbOKOnly, "出错"
'On Error Resume Next
'Winsock1.Close
'Winsock1.Connect
erda = erda + 1
main1.Label19.Caption = "错误帧:" & erda
End Sub
Private Sub one()
''还原算法________________________________________________________
On Error GoTo Oneerr
Dim msu() As Byte '还原后要放入的数组
Dim mi As Long '记录还原时读出的指针
Dim mx As Long '重复的个数的递增
Dim ma As Long '记录写入的指针
mi = 0
mx = 0
ma = 0
ReDim msu(UBound(date1()))
Do While mi < date2 - 4
Do While mx <= date1(mi + 1)
msu(ma) = date1(mi)
mx = mx + 1
ma = ma + 1
Loop
mx = 0
mi = mi + 2
Loop
'MsgBox UBound(msu())
Select Case se
Case 256
Call M256b(msu())
Case 16
Call m16b(msu())
Case 160
Dim bmp16x() As Byte
ReDim bmp16x(ma - 1)
Dim X As Long
Dim Y As Long
Dim z As Long
z = ((ma - 1) \ 2)
'MsgBox ma
'MsgBox z
For X = 0 To z - 1 Step 1
bmp16x(Y) = msu(X)
bmp16x(Y + 1) = msu(z)
z = z + 1
Y = Y + 2
Next
Call m16xb(bmp16x())
End Select
Exit Sub
Oneerr:
loda = loda + 1
main1.Label18.Caption = "丢失帧:" & loda
End Sub
Private Sub HScroll1_Change()
Picture1.Left = -HScroll1.Value
End Sub
Private Sub VScroll1_Change()
Picture1.Top = -VScroll1.Value
End Sub
Public Sub vs()
On Error GoTo er
Picture1.Move 0, 0
If (Picture1.Width <= Form2.ScaleWidth And Picture1.Height <= Form2.ScaleHeight) Then
'VScroll1.Visible = False
'HScroll1.Visible = False
Else
VScroll1.Visible = True
HScroll1.Visible = True
HScroll1.Width = Form2.ScaleWidth - VScroll1.Width
VScroll1.Height = Form2.ScaleHeight - HScroll1.Height
HScroll1.Top = VScroll1.Height
VScroll1.Left = HScroll1.Width
HScroll1.Max = Picture1.Width - Form2.ScaleWidth + VScroll1.Width ' 设置最大值.
HScroll1.LargeChange = 300 ' 敲击 5 次后穿过.
HScroll1.SmallChange = 150 ' 敲击 20 次后穿过.
VScroll1.LargeChange = 300 ' 敲击 5 次后穿过.
VScroll1.SmallChange = 150 ' 敲击 20 次后穿过.
VScroll1.Max = Picture1.Height - Form2.ScaleHeight + HScroll1.Height
End If
er:
End Sub
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Winsock1.Close
Call Timer2_Timer
End Sub
Public Sub Portopen()
'udp2 = "8821"
'udp3 = "8822"
Winsock2.RemoteHost = IP1
Winsock2.RemotePort = udp2
Winsock3.RemoteHost = IP1
Winsock3.RemotePort = udp3
End Sub
Private Sub Winsock2_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Winsock2.Close
Winsock2.RemotePort = udp2
End Sub
Private Sub Winsock3_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Winsock3.Close
Winsock3.RemotePort = udp3
End Sub
Private Sub Winsock2_Close()
Winsock2.Close
End Sub
Private Sub Winsock3_Close()
Winsock3.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -