Picturebox控件问题！！！！（你说简单，进来拿分；我说不简单，只好送分！！）

Question

直接读取picture，以access形式读取，然后将其存放到数组中传送，另一端接收后再以同样方式读出，载入到picturebox内。至于jpg直接编码编写太复杂，你找一个控件就行了。

Answer 1

TO：guiqing(鬼卿）
老兄！
有这样的控件吗？在哪里有呀！如果有，发一个给我如何！
[email protected]

Answer 2

TO：guiqing(鬼卿）
老兄！
有这样的控件吗？在哪里有呀！如果有，发一个给我如何！
[email protected]

Answer 3

Picture1.Picture = LoadPicture("\\机器名\共享目录\aaa.jpg")

Answer 4

好 不过我没用过，你试一下吧
功能：压缩位图图象并且保存到 JPG 格式
不知行不行

Answer 5

呵呵
是把你想要传送的图片进行改动，你难道没由原图片而直接放到picturebox上吗？

Answer 6

画上去的？那传送时根本就不能转化jpg，那你不如转化成二进制码，再用哈夫曼树压缩传递算了。

Answer 7

'以下程序在单机上测试通过
'先运行服务端程序，再运行客户端程序'========================================================
'服务器端
'========================================================Option ExplicitPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
   (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" _
   (ByVal hdc As Long, _
    pBitmapInfo As BITMAPINFO, _
    ByVal un As Long, _
    ByVal lplpVoid As Long, _
    ByVal handle As Long, _
    ByVal dw As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" _
   (ByVal aHDC As Long, _
    ByVal hBitmap As Long, _
    ByVal nStartScan As Long, _
    ByVal nNumScans As Long, _
    lpBits As Any, _
    lpBI As BITMAPINFO, _
    ByVal wUsage As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
   (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" _
   (ByVal hDestDC As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal hSrcDC As Long, _
    ByVal xSrc As Long, _
    ByVal ySrc As Long, _
    ByVal dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As LongPrivate Type BITMAPINFOHEADER
        biSize As Long
        biWidth As Long
        biHeight As Long
        biPlanes As Integer
        biBitCount As Integer
        biCompression As Long
        biSizeImage As Long
        biXPelsPerMeter As Long
        biYPelsPerMeter As Long
        biClrUsed As Long
        biClrImportant As Long
End TypePrivate Type RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
End TypePrivate Type BITMAPINFO
        bmiHeader As BITMAPINFOHEADER
        bmiColors As RGBQUAD
End TypePrivate Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0
Private Sub Form_Load()
    With WinSock1
        .Protocol = sckTCPProtocol
        .LocalPort = 1001
        .Bind 1001
        .Listen
    End With
End Sub
    
    
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
    If WinSock1.State <> sckClosed Then WinSock1.Close
    WinSock1.Accept requestID
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim hMemoryDC As Long
    Dim hBitmap As Long
    Dim hOldObject As Long
    Dim BI As BITMAPINFO
    Dim bBytes() As Byte
    Dim strData As String
    
    WinSock1.GetData strData
    
    If strData = "CAPTURE" Then
        With BI.bmiHeader
            .biBitCount = 24
            .biCompression = BI_RGB
            .biPlanes = 1
            .biSize = Len(BI.bmiHeader)
            .biWidth = Screen.Width \ Screen.TwipsPerPixelX
            .biHeight = Screen.Height \ Screen.TwipsPerPixelY
        End With
        
        ReDim bBytes(1 To BI.bmiHeader.biWidth * BI.bmiHeader.biHeight * 3) As Byte
        
        hMemoryDC = CreateCompatibleDC(0)
        hBitmap = CreateDIBSection(hMemoryDC, BI, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&)
        hOldObject = SelectObject(hMemoryDC, hBitmap)
        BitBlt hMemoryDC, 0, 0, BI.bmiHeader.biWidth, BI.bmiHeader.biHeight, _
               GetDC(0), 0, 0, vbSrcCopy
        GetDIBits hMemoryDC, hBitmap, 0, BI.bmiHeader.biHeight, bBytes(1), BI, DIB_RGB_COLORS
        
        WinSock1.SendData BI.bmiHeader.biWidth * &H10000 + BI.bmiHeader.biHeight
        WinSock1.SendData bBytes
        
        SelectObject hMemoryDC, hOldObject
        DeleteObject hBitmap
        DeleteObject hOldObject
        DeleteDC hMemoryDC
    End If
End Sub

Answer 8

'========================================================
'客户端
'========================================================Option ExplicitPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
   (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function SetDIBitsToDevice Lib "gdi32" _
   (ByVal hdc As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal dx As Long, _
    ByVal dy As Long, _
    ByVal SrcX As Long, _
    ByVal SrcY As Long, _
    ByVal Scan As Long, _
    ByVal nScans As Long, _
    Bits As Any, _
    BitsInfo As BITMAPINFO, _
    ByVal wUsage As Long) As LongPrivate Type BITMAPINFOHEADER
        biSize As Long
        biWidth As Long
        biHeight As Long
        biPlanes As Integer
        biBitCount As Integer
        biCompression As Long
        biSizeImage As Long
        biXPelsPerMeter As Long
        biYPelsPerMeter As Long
        biClrUsed As Long
        biClrImportant As Long
End Type
Private Type RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
End Type
Private Type BITMAPINFO
        bmiHeader As BITMAPINFOHEADER
        bmiColors As RGBQUAD
End TypePrivate Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0Private BI As BITMAPINFO
Private n As Long
Private arrGet() As Byte
Private getBI As BITMAPINFO
Private blnGetSize As BooleanPrivate Sub Form_Load()
    With WinSock1
        .Protocol = sckTCPProtocol
        .RemoteHost = "169.254.180.155"
        .RemotePort = 1001
        .Connect
    End With
    
    With BI.bmiHeader
        .biBitCount = 24
        .biCompression = BI_RGB
        .biPlanes = 1
        .biSize = Len(BI.bmiHeader)
    End With
End Sub
Private Sub Command1_Click()
    Picture1.Cls
    WinSock1.SendData "CAPTURE"
    blnGetSize = False
    n = 0
End Sub
Private Sub WinSock1_DataArrival(ByVal bytesTotal As Long)
    Dim Buff() As Byte
    ReDim Buff(1 To bytesTotal)
    Dim lngSize As Long
    Dim strHex As String
    
    If Not blnGetSize Then
        '取得图像的宽度和高度
        WinSock1.GetData lngSize
        strHex = String(8 - Len(Hex(lngSize)), "0") & Hex(lngSize)
        BI.bmiHeader.biWidth = Val("&H" & Left(strHex, 4))
        BI.bmiHeader.biHeight = Val("&H" & Right(strHex, 4))
        ReDim arrGet(1 To BI.bmiHeader.biWidth * BI.bmiHeader.biHeight * 3) As Byte
        blnGetSize = True
        Exit Sub
    End If
    
    If bytesTotal > 0 Then
        WinSock1.GetData Buff, vbByte
        CopyMemory arrGet(n + 1), Buff(0), bytesTotal
        n = n + bytesTotal
    
        If n = BI.bmiHeader.biWidth * BI.bmiHeader.biHeight * 3 Then
            '接收完毕，画出接收到的图像
            Picture1.AutoRedraw = True
            SetDIBitsToDevice Picture1.hdc, 0, 0, BI.bmiHeader.biWidth, _
                BI.bmiHeader.biHeight, 0, 0, 0, BI.bmiHeader.biHeight, _
                arrGet(1), BI, DIB_RGB_COLORS
            Picture1.Refresh
        End If
    End If
End Sub

Answer 9

http://www.tuoying.com.cn/gg.htm
http://www.tuoying.com.cn/ee.htm
讲的是远程图像传输原理。