rscreen.frm

星子行V2.0(源码)公开星子行V3.0以上版本,都是由星子行V1.0和星子行V2.0的核心结合而开发成的! 星子行V1.0是单反接正法,星子行V2.0是多反接法,星子行V3.0以上版本都是多反

clos = clos + 1
If (clos < 10) Then
Scmnet5.Close
Scmnet5.Listen
'Timer1.Enabled = True
Else
clos = 0
Timer2.Enabled = False

Scmnet5.Close
Scmnet6.Close
Scmnet7.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 Scmnet5_Close()
Scmnet5.Close
Call Timer2_Timer
End Sub

Private Sub Scmnet5_ConnectionRequest(ByVal requestID As Long)

Scmnet5.Close
Scmnet5.Accept requestID

Dim s4 As Integer

'''''''''''''''''''''''关键
's3 = 1

If Main.Strtimer = "" Then '屏幕刷新时间

If Main.Check1.Value = 1 Then

s4 = 2

ElseIf Main.Check2.Value = 1 Then

s4 = 3

ElseIf Main.Check3.Value = 1 Then

s4 = 4

Else

s4 = 1

End If


Else '屏幕刷新时间

s4 = Main.Strtimer

End If '屏幕刷新时间

'MsgBox Color1
'''''''''''''''''''''
Select Case Color1
Case 0
se = 16
Case 1
se = 256
Case 2
se = 160
End Select

Select Case s4
Case 0
time1 = 100
Case 1
time1 = 200
Case 2
time1 = 300
Case 3
time1 = 500
Case 4
time1 = 800
Case 5
time1 = 1000
End Select



'Timer1.Enabled = True

'Timer1.Enabled = False

bool = False
Timer2.Enabled = False
clos = 0

Dim send1 As String
send1 = se & "-" & time1 & "-" & beijing & "-"
'MsgBox send1
Scmnet5.SendData send1

End Sub

Private Sub Scmnet5_DataArrival(ByVal bytesTotal As Long)
On Error GoTo er

If bool = False Then

  Dim ok As String
  Scmnet5.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
  Scmnet5.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

'Scmnet5.Close

'Scmnet5.Connect


erda = erda + 1

Main.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

Main.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 <= Rscreen.ScaleWidth And Picture1.Height <= Rscreen.ScaleHeight) Then
'VScroll1.Visible = False
'HScroll1.Visible = False

Else

VScroll1.Visible = True
HScroll1.Visible = True

HScroll1.Width = Rscreen.ScaleWidth - VScroll1.Width
VScroll1.Height = Rscreen.ScaleHeight - HScroll1.Height
HScroll1.Top = VScroll1.Height
VScroll1.Left = HScroll1.Width
HScroll1.Max = Picture1.Width - Rscreen.ScaleWidth + VScroll1.Width    ' 设置最大值.
   HScroll1.LargeChange = 300   ' 敲击 5 次后穿过.
   HScroll1.SmallChange = 150   ' 敲击 20 次后穿过.
   VScroll1.LargeChange = 300   ' 敲击 5 次后穿过.
   VScroll1.SmallChange = 150   ' 敲击 20 次后穿过.

   VScroll1.Max = Picture1.Height - Rscreen.ScaleHeight + HScroll1.Height
   
   
End If

er:
End Sub

Private Sub Scmnet5_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)
Scmnet5.Close
Call Timer2_Timer
End Sub

Public Sub Portopen()

On Error GoTo er

Scmnet6.Close
Scmnet7.Close
    
Scmnet6.RemoteHost = Scmnet5.RemoteHostIP
Scmnet6.RemotePort = udp6

Scmnet7.RemoteHost = Scmnet5.RemoteHostIP
Scmnet7.RemotePort = udp7

Exit Sub

er:

Call Portopen

End Sub

Private Sub Scmnet6_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)

Scmnet6.Close

Scmnet6.RemotePort = udp6

End Sub

Private Sub Scmnet7_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)

Scmnet7.Close

Scmnet7.RemotePort = udp7

End Sub

Private Sub Scmnet6_Close()

Scmnet6.Close

End Sub

Private Sub Scmnet7_Close()

Scmnet7.Close

End Sub