VBʵÏÖÔ¶³Ì¹²ÏíÏÔʾ¼°ÉùÒô

' µ±¼ôÌù°åÉÏÓÐÊý¾Ýʱ
ImgEdit1.ClearDisplay
ImgEdit1.DisplayBlankImage Screen.Width / _
Screen.TwipsPerPixelX, Screen.Height / _
Screen.TwipsPerPixelY, , , 6
ImgEdit1.ClipboardPaste ' ´Ó¼ôÌù°åÕ³ÌùͼÏñ
ImgEdit1.BurnInAnnotations 0, 2
ImgEdit1.SaveAs FileName, 1, 6, 6, 256 ' Áí´æͼÏñ¡£²ÎÊý˵Ã÷ÈçÏ£º
' ¡°FileName¡±£ºÎļþÃû
' ²ÎÊý¡°1¡±£ºTIFF ÐÍÎļþ£»
' µÚÒ»¸ö¡°6¡±£ºRGB24ÀàÐÍ£»
' µÚ¶þ¸ö¡°6¡±£ºJPEGѹËõÀàÐÍ
' ²ÎÊý¡°256¡±£º×î´óѹËõ±È
Clipboard.Clear
tcpServer.SendData "PS" ' ·¢ËÍ¡°Í¼ÏñÎļþ¾ÍÐ÷¡±ÐÅÏ¢
End If
Case "Get Picture"
If Dir$(FileName) <> "" Then
FileID = FreeFile
Open FileName For Binary As #FileID ' ´ò¿ªÎļþ²¢·¢Ë͵ÚÒ»¿éÊý¾Ý
FileLen = LOF(FileID)
ReDim Buf(1 To BlockSize) As Byte
Get #FileID, , Buf
tcpServer.SendData Buf
Cur_Pos = BlockSize
End If
Case "Next Block"
If Cur_Pos = FileLen Then
tcpServer.SendData "EF" ' Îļþ´«ËÍÍê±Ïºó£¬·¢ËÍ¡°Íê³É¡±ÐÅÏ¢
Close FileID
Exit Sub
End If
j = Cur_Pos + BlockSize
If j > FileLen Then
j = FileLen - Cur_Pos
Else
j = BlockSize
End If
ReDim Buf(1 To j) As Byte ' ¶¯Ì¬È·¶¨Êý×é´óС
Get #FileID, , Buf
tcpServer.SendData Buf ' ·¢ËͺóÐø°ü
Cur_Pos = Cur_Pos + j
End Select
End Sub

¡¡¡¡2. ¿Í»§¶Ë³ÌÐò£¨frmClient.frm£©
¡¡¡¡ÔÚ´°ÌåÉϽ¨Áù¸ö¿Ø¼þ£ºÒ»¸öÃûΪ tcpClientµÄ Winsock¿Ø¼þÓÃÓÚͨѶ£»Ò»¸öÃûΪtxtIP µÄ TextBox¿Ø¼þÓÃÓÚÌîд·þÎñÆ÷µÄIPµØÖ·£»Ò»¸öÃûΪImgEdit1µÄ ImgEdit¿Ø¼þÓÃÓÚÏÔʾ·þÎñÆ÷´«À´µÄͼÏñ£»Èý¸öCommandButton¿Ø¼þ£¨ cmdConnect¡¢cmdGet_PicºÍcmdDisconnect£© ·Ö±ðÓÃÓÚÖ´ÐÐÁ¬½Ó¡¢È¡»ØͼÏñºÍ¶Ï¿ªÁ¬½Ó£¨¼ûͼ¶þ£©¡£

¡¡¡¡¿Í»§¶ËÔ´´úÂëÈçÏ£º

' frmClient.frm
Option Explicit
Const FileName = "C:\sys1.tmp"
Private Sub cmdConnect_Click()
If tcpClient.State <> sckClosed Then tcpClient.Close
tcpClient.RemoteHost = txtIP.Text
tcpClient.RemotePort = 1001
tcpClient.Connect ' ½øÐÐÁ¬½Ó
End Sub
¤o
Private Sub cmdDisconnect_Click()
tcpClient.SendData "Close" ' ¶Ï¿ªÁ¬½Ó
cmdConnect.Enabled = True
cmdGet_Pic.Enabled = False
cmdDisconnect.Enabled = False
End Sub
¤o
Private Sub cmdGet_Pic_Click()
tcpClient.SendData "Save Picture" ' ÇëÇóͼÏñ·µ»Ø
frmClient.MousePointer = 11
End Sub
¤o
Private Sub Form_Resize() ' ʹ ImgEdit1 µÄ´óСËæ´°ÌåµÄ±ä»¯¶ø±ä»¯
ImgEdit1.Height = frmClient.Height - 825
ImgEdit1.Width = frmClient.Width - 225
End Sub
¤o
Private Sub tcpClient_DataArrival(ByVal bytesTotal As Long)
Static FileID As Integer, FileLen As Long
Dim Buf() As Byte
Dim j As Integer
ReDim Buf(bytesTotal) As Byte ' ¸ù¾Ýµ½´ïÊý¾ÝµÄ×Ö½ÚÊýÈ·¶¨½ÓÊÕÊý×éµÄ´óС
tcpClient.GetData Buf
' ÊÕµ½Á¬½ÓÍê³ÉµÄ¡°ÎÕÊÖ¡±ÐÅÏ¢
If bytesTotal = 2 And Chr(Buf(0)) = "S" And Chr(Buf(1)) = "H" Then
cmdConnect.Enabled = False
cmdGet_Pic.Enabled = True
cmdDisconnect.Enabled = True
Exit Sub
End If
' ÊÕµ½Í¼Ïñ¾ÍÐ÷µÄÐÅÏ¢
If bytesTotal = 2 And Chr(Buf(0)) = "P" And Chr(Buf(1)) = "S" Then
If Dir$(FileName) <> "" Then Kill FileName
FileID = FreeFile
Open FileName For Binary As #FileID ' ´ò¿ªÎļþ£¬×¼±¸´æ´¢Í¼Ïñ
FileLen = 0
tcpClient.SendData "Get Picture"
Exit Sub
End If
' ÊÕµ½Í¼Ïñ·¢ËÍÍê±ÏµÄÐÅÏ¢
If bytesTotal = 2 And Chr(Buf(0)) = "E" And Chr(Buf(1)) = "F" Then
Close #FileID ' ¹Ø±ÕÎļþ
j = DoEvents()
vbÉçÇø

ÉÏÒ»Ò³  [1] [2] [3]  ÏÂÒ»Ò³