sm16.bas

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

Attribute VB_Name = "Sm16"

Option Explicit


Private houdc As Long        '设备场景的句柄
Private bm As BITMAP
Private bi As BitMapInfo16
Private hdc As Long, hDIB As Long, OldObj As Long
Private buffer() As Byte


Public Sub M16x(port1 As Long, port2 As Long)


Dim bmpwidth As Long   '设备场景的宽
Dim bmpheight As Long  '设备场景的高



houdc = GetDC(0&)

bmpwidth = GetDeviceCaps(houdc, HORZRES)  '根据指定设备场景代表的设备的功能返回信息
bmpheight = GetDeviceCaps(houdc, VERTRES)

Dim bmp2 As Long

bmp2 = CreateCompatibleBitmap(houdc, bmpwidth, bmpheight) '创建一幅与设备有关位图，它与指定的设备场景兼容

Dim SizeOfArray As Long, fp As Long
Dim bf As BITMAPFILEHEADER
Dim I As Long, r As Integer, g As Integer, b As Integer
    '
    Call GetObject(bmp2, Len(bm), bm)
    SizeOfArray = (((bm.bmWidth / 2 + 3) \ 4) * 4) * bm.bmHeight
    '
    With bf
        .bfType = "BM"
        .bfSize = Len(bf) + Len(bi) + SizeOfArray
        .bfReserved1 = 0
        .bfReserved2 = 0
        .bfOffBits = Len(bf) + Len(bi)
    End With
    With bi
        With .bmiHeader
        .biSize = Len(bi.bmiHeader)
        .biWidth = bm.bmWidth
        .biHeight = bm.bmHeight
        .biPlanes = 1
        .biBitCount = 4
        .biCompression = 0
        .biSizeImage = SizeOfArray
        End With
        For I = 0 To 15
            .bmiColors(I) = QBColor(I)
        Next I
    End With
    ReDim buffer(bi.bmiHeader.biSizeImage - 1) As Byte
    hdc = CreateCompatibleDC(0&)
    hDIB = CreateDIBSection16(hdc, bi, DIB_RGB_COLORS, I, 0&, 0&)
    OldObj = SelectObject(hdc, hDIB)
    'Call BitBlt(hDC, 0&, 0&, bm.bmWidth, bm.bmHeight, houdc, 0&, 0&, vbSrcCopy)
    'Call GetDIBits16(hDC, hDIB, 0, (bm.bmHeight), buffer(0), bi, 0)
    
    
    '清理操作----------------------------------
   
    DeleteObject bmp2
    
    
  ''   Call Form3.m16a(buffer(), bm.bmWidth, _
''bm.bmHeight, bm.bmWidthBytes, bm.bmPlanes, bm.bmBitsPixel, bm.bmBits)

  
    Dim su(6) As Long
     su(0) = bi.bmiHeader.biSizeImage - 1
     su(1) = bm.bmWidth
     su(2) = bm.bmHeight
     su(3) = port1
     su(4) = port2
     Dim ok As String
    
     ok = su(0) & "-" & su(1) & "-" & su(2) & "-" & su(3) & "-" & su(4) & "-" & "0" & "-" & "0" & "-" & "0"
    
     main1.Winsock2.SendData ok
     se = 16
     main1.Timer3.Enabled = True
End Sub
Public Sub m16y()

 Call BitBlt(hdc, 0&, 0&, bm.bmWidth, bm.bmHeight, houdc, 0&, 0&, vbSrcCopy)
 Call GetDIBits16(hdc, hDIB, 0, (bm.bmHeight), buffer(0), bi, 0)
Call one(buffer(), bi.bmiHeader.biSizeImage - 1)

End Sub

Public Sub m16z()
    SelectObject hdc, OldObj
    DeleteDC hdc
    DeleteObject hDIB
   
End Sub