这么长时间没人回答，只好再次提问！！！

Question

同意Zyl910的意见，用GetBitmapBits函数保存为数组，传输过去后再用SetBitmapBits还原。
--------------------------------------------------------------------
Made by Thirdapple's Studio(http://3rdapple.51.net/)

Answer 1

to:thirdapple
能给可实现的实例吗？

Answer 2

to:thirdapple
能给出可以实现的源码吗？

Answer 3

帮帮我吧!!!!!!!!!!!!!!!!!!!!
[email protected]

Answer 4

这样应该可以吧，用winsock传送图像文件，
到b处，保存成文件，再显示
祝你好运

Answer 5

进来的朋友请帮忙UP，UP者有分····！！！！！

Answer 6

进来的朋友请帮忙UP，UP者有分····！！！！！

Answer 7

耗费了一中午的时间，写好了，没有远程调试，你自己调试吧！
--------------------------------------------------------------------
将下面的内容保存为“网络图象传输.vbp”
Type=Exe
Form=MainForm.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\SYSTEM\stdole2.tlb#OLE Automation
Object={248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0; MSWINSCK.OCX
IconForm="MainForm"
Startup="MainForm"
ExeName32="网络图象传输.exe"
Command32=""
Name="网络图象传输"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
--------------------------------------------------------------------
将下面的内容保存为“MainForm.frm”
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form MainForm 
   BackColor       =   &H80000018&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "网络图象传输"
   ClientHeight    =   5190
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5070
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   346
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   338
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox PicScreen 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   375
      Left            =   4680
      ScaleHeight     =   25
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   25
      TabIndex        =   7
      Top             =   3720
      Visible         =   0   'False
      Width           =   375
   End
   Begin VB.Timer TimerSend 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   1800
      Top             =   4560
   End
   Begin MSWinsockLib.Winsock SockLink 
      Left            =   1800
      Top             =   3840
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      RemotePort      =   1024
      LocalPort       =   1024
   End
   Begin VB.CheckBox CheckLink 
      Caption         =   "连接..."
      Height          =   375
      Left            =   240
      Style           =   1  'Graphical
      TabIndex        =   6
      Top             =   4680
      Width           =   1335
   End
   Begin VB.TextBox TxtDuanKou 
      Alignment       =   2  'Center
      Height          =   375
      Left            =   3000
      TabIndex        =   4
      Text            =   "1024"
      Top             =   4680
      Width           =   1815
   End
   Begin VB.TextBox TxtIP 
      Alignment       =   2  'Center
      Height          =   375
      Left            =   3000
      TabIndex        =   2
      Text            =   "127.0.0.1"
      Top             =   4080
      Width           =   1815
   End
   Begin VB.CheckBox CheckListen 
      Caption         =   "服务器"
      Height          =   375
      Left            =   240
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   4080
      Value           =   1  'Checked
      Width           =   1335
   End
   Begin VB.PictureBox PicMain 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00008080&
      BorderStyle     =   0  'None
      Height          =   3600
      Left            =   120
      ScaleHeight     =   240
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   320
      TabIndex        =   0
      Top             =   120
      Width           =   4800
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "端口号："
      Height          =   255
      Left            =   2280
      TabIndex        =   5
      Top             =   4755
      Width           =   735
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "IP地址："
      Height          =   300
      Left            =   2280
      TabIndex        =   3
      Top             =   4125
      Width           =   735
   End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Answer 8

Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC 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 SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject 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 Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Type BITMAPINFOHEADER '40 bytes
        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 Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0
Private Const IMAGE_BITMAP As Long = 0
Private Const LR_LOADFROMFILE As Long = &H10
Private Const LR_CREATEDIBSECTION As Long = &H2000
Private Const LR_DEFAULTCOLOR As Long = &H0
Private Const LR_COLOR As Long = &H2
Private Const SRCAND = &H8800C6
Private Const SRCCOPY = &HCC0020
Private Const SRCERASE = &H440328
Private Const SRCPAINT = &HEE0086
Private Const SRCINVERT = &H660046Private 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 TypeDim ByteArray(0 To ((320 * 3 + 3) And &HFFFFFFFC) * 240) As Byte
Private Sub CheckLink_Click() '连接
If CheckLink.Value = 1 Then
  If CheckListen.Value = 0 Then
    If SockLink.State = 0 Then SockLink.Connect
  Else
    SockLink.Listen
  End If
Else
  SockLink.Close
End If
End Sub
Private Sub CheckListen_Click()
If CheckListen.Value = 0 Then
  TimerSend.Enabled = True
  If CheckLink.Value = 0 Then SockLink.RemotePort = Val(TxtDuanKou.Text)
Else
  TimerSend.Enabled = False
  If CheckLink.Value = 0 Then SockLink.LocalPort = Val(TxtDuanKou.Text)
End If
End Sub
Private Sub Form_Load()
TxtIP.Text = SockLink.LocalIP
End Sub
Private Sub SockLink_ConnectionRequest(ByVal requestID As Long)
If SockLink.State <> 0 Then SockLink.Close
SockLink.Accept requestID
End Sub
Private Sub SockLink_DataArrival(ByVal bytesTotal As Long)
Dim strData As String, S As String, i As Long
  SockLink.GetData strData
  For i = 0 To ((320 * 3 + 3) And &HFFFFFFFC) * 240
    S = Mid$(strData, i * 3, 3)
    ByteArray(i) = S
  Next i
  SetBitmap PicMain.hDC, ByteArray '信息接受完后，显示
  PicMain.Refresh
End Sub
Private Sub TimerSend_Timer()
Dim i As Long
Dim strData As String
If CheckLink.Value = 1 Then
  PicScreen.Height = Screen.Height / Screen.TwipsPerPixelY
  PicScreen.Width = Screen.Width / Screen.TwipsPerPixelX
  BitBlt PicScreen.hDC, 0, 0, PicScreen.Width, PicScreen.Height, GetDC(0), 0, 0, vbSrcCopy
  PicScreen.Refresh
  PicMain.PaintPicture PicScreen.Image, 0, 0, PicMain.Width, PicMain.Height, 0, 0, PicScreen.Width, PicScreen.Height
  PicMain.Refresh
  CreateBitmap PicMain.hDC, ByteArray
  If SockLink.State = 7 Then
    For i = 0 To ((320 * 3 + 3) And &HFFFFFFFC) * 240
      strData = strData + ByteArray(i)
    Next i
      SockLink.SendData strData '将图片信息发送出去
  End If
End If
End Sub
Private Sub TxtDuanKou_Change() '设置端口号
If CheckListen.Value = 1 Then
  SockLink.LocalPort = Val(TxtDuanKou.Text)
  SockLink.RemoteHost = TxtIP.Text
Else
  SockLink.RemotePort = Val(TxtDuanKou.Text)
End If
End Sub
Function CreateBitmap(hDC As Long, ByteArray() As Byte) '将位图图象保存到一个一维数组中
Dim bitWidth As Long
Dim hOldMap As Long
Dim iBitmap As Long, iDC As Long
Dim bi24BitInfo As BITMAPINFO
With bi24BitInfo.bmiHeader
    .biBitCount = 24
    .biCompression = BI_RGB
    .biPlanes = 1
    .biSize = Len(bi24BitInfo.bmiHeader)
    .biWidth = 320
    .biHeight = 240
    .biSizeImage = ((.biWidth * 3 + 3) And &HFFFFFFFC) * .biHeight
End With
iDC = CreateCompatibleDC(0)
iBitmap = CreateDIBSection(iDC, bi24BitInfo, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&)
If iBitmap Then
  hOldMap = SelectObject(iDC, iBitmap)
Else
  DeleteObject iDC
  Exit Function
End If
BitBlt iDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, hDC, 0, 0, vbSrcCopy
bitWidth = (bi24BitInfo.bmiHeader.biWidth * 3 + 3) And &HFFFFFFFC
GetBitmapBits iBitmap, bi24BitInfo.bmiHeader.biSizeImage, ByteArray(0)
End Function
Function SetBitmap(hDC As Long, ByteArray() As Byte) '将一维数组中的图象还原
Dim iBitmap As Long, iDC As Long
Dim bi24BitInfo As BITMAPINFO
With bi24BitInfo.bmiHeader
    .biBitCount = 24
    .biCompression = BI_RGB
    .biPlanes = 1
    .biSize = Len(bi24BitInfo.bmiHeader)
    .biWidth = 320
    .biHeight = 240
    .biSizeImage = ((.biWidth * 3 + 3) And &HFFFFFFFC) * .biHeight
End With
iDC = CreateCompatibleDC(0)
iBitmap = CreateDIBSection(iDC, bi24BitInfo, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&)
If iBitmap Then
  hOldMap = SelectObject(iDC, iBitmap)
Else
  DeleteObject iDC
  Exit Function
End If
SetBitmapBits iBitmap, bi24BitInfo.bmiHeader.biSizeImage, ByteArray(0)
BitBlt hDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, iDC, 0, 0, vbSrcCopy
If hOldMap Then DeleteObject SelectObject(iDC, hOldMap)
DeleteObject iDC
End Function
Private Sub TxtIP_Change()
SockLink.RemoteHost = Trim(TxtIP.Text)
End Sub
--------------------------------------------------------------------
Made by Thirdapple's Studio(http://3rdapple.51.net/)

Answer 9

http://www.csdn.net/expert/topic/799/799167.xml?temp=2.715701E-02

Answer 10

对不起，我没有调试过，应该是
Dim S As String
S = ByteArray(i)
StrData = StrData + S
或者
StrData = StrData + CStr(ByteArray(i))
--------------------------------------------------------------------
另，如果需要速度，只有两种办法，图象压缩和把图象变小两种方法。图象压缩你可以尝试将彩色图象转换为灰度图象，或者更复杂的（坦率说，更复杂的方法我也不大清楚算法）
--------------------------------------------------------------------
Made by Thirdapple's Studio(http://3rdapple.51.net/)

Answer 11

如果是想做一个类似于XP里的远程帮助的功能，用传图象的方法似乎效率很低，如果只是做一个类似于NetMeeting中电子白板的功能的话，建议不要传图象，而是传操作码。两边是同样的白板环境，将在白板上的操作用编码传递到对方，对方根据操作码重现这个动作。这样的数据传输量应该会很小，同步效果相应也会比较好。

Answer 12

我不会用winsock控件
但我看了上面的代码后觉得有点儿奇怪
为什么一定要把数据转化为字符串再发送呢
用For循环连接字符串可是很慢的

Answer 13

我也做过这样的东西，如果不采用图像压缩或其它的特殊处理方法，远程传输的确是非常非常的慢，好在我只在局域网中用它，也就凑合了。有两份代码，分为客户端和服务器端，不过无法解决速度问题，图片数组太大了，要不你把它存为JPG或GIF格式试试。

Answer 14

： ddww() 大哥，能够发一份你所说的代码给我吗？我是初学者，觉得这个功能有点不可思议呢！
[email protected]

Answer 15

那个程序呀，我试过多次了如果要速度的话只有一个办法，不存盘！在内存里完成这样一个事：
压缩成JPG，就像当年用CCD摄像机视频信号数据采集系统那样，先读取图像数据缩小一定比例->压缩->发送
然后:接收->放大->显示
这样就完成了。

Answer 16

我的一个USB摄像头采集系统就这样完成这个程序的，别人在别台机子上看到我这台上的动态视频，不过每秒6频慢了点但已经是非常不容易了。