⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 screen2.frm

📁 星子行主机控制系统用于主机管理,方便远程操作,通信等功能.更 方便用于局域网,管理速度快,连接简单方便.注意:星子行连接可用 于带路由主机与带路由主机之间连接,非路由与非路由之间连接.带
💻 FRM
📖 第 1 页 / 共 2 页
字号:

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 + -