frmdatacallback.frm

vb编写机器人遥控程序

VERSION 5.00
Begin VB.Form frmDataCallBack 
   Caption         =   "数据克隆"
   ClientHeight    =   3690
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4755
   FillColor       =   &H008080FF&
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   ScaleHeight     =   3690
   ScaleWidth      =   4755
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer Timer1 
      Interval        =   40
      Left            =   240
      Top             =   2400
   End
End
Attribute VB_Name = "frmDataCallBack"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim hmemDC As Long
Dim m_cbRgb As Long
Dim pbuf() As Byte
Dim distext As String
Dim SRCCOPY As Long '0X00cc0020
Dim BmpInfo As BITMAPINFO
Dim bitMap  As BITMAPFILEHEADER
Dim hfntOld As Long
Dim hFont As Long
Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0 '  color table in RGBs
Private Const BITMAPTYPE = &H4D42
Private Const INVALID_HANDLE_VALUE = (-1)
Private Const GENERIC_WRITE = &H40000000
Private Const CREATE_ALWAYS = 2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Declare Function StretchDIBits Lib "gdi32" (ByVal hdc As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal nDestWidth As Long, ByVal nDestHeight As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, lpBits As Any, lpBitsInfo As Any, ByVal wUsage As Long, ByVal dwRop As Long) As Long
Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, ByVal nStretchMode As Long) 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, lplpVoid As Long, ByVal handle As Long, ByVal dw 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 SelectObject Lib "gdi32" (ByVal hdc As Long, 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 CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crcolor As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, _
    ByVal W As Long, ByVal i As Long, ByVal U As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, _
    ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
Private Sub Form_Load()
   ReDim pbuf(0 To (CLng(m_Width) * CLng(m_Height) * CLng(3) - 1))
     SRCCOPY = 13369376
     hFont = CreateFont(20, 0, 0, 0, 0, 0, 0, 0, 106, 0, 16, 0, 0, "黑体")
     m_cbRgb = CLng(m_Width) * CLng(m_Height) * CLng(3) - 1
     isDataCopy = True
End Sub

Private Sub Timer1_Timer()
    Dim i, j As Integer
    devwdm_GetImageBuffer pbuf(0)
    devwdm_GetBmpInfo BmpInfo
'    BmpInfo.bmiHeader.biSize = 40
'    BmpInfo.bmiHeader.biBitCount = 24
'    BmpInfo.bmiHeader.biPlanes = 1
'    BmpInfo.bmiHeader.biCompression = 0
'    BmpInfo.bmiHeader.biSizeImage = 0 ' m_Height * (((m_Width * BmpInfo.bmiHeader.biBitCount + 31) And &HFFFFFFE0) \ 8)
'    BmpInfo.bmiHeader.biXPelsPerMeter = 0
'    BmpInfo.bmiHeader.biYPelsPerMeter = 0
'    BmpInfo.bmiHeader.biClrUsed = 0
'    BmpInfo.bmiHeader.biClrImportant = 0
'    BmpInfo.bmiHeader.biWidth = m_Width
'    BmpInfo.bmiHeader.biHeight = m_Height
    hmemDC = GetDC(Me.hwnd)
    distext = Now()
    distext = Format(distext, "yyyy-mm-dd hh:mm:ss")
    hfntOld = SelectObject(Me.hdc, hFont)
    m_disDate = distext
    Call SetStretchBltMode(0, 3)
'    For i = 0 To m_Height - 1
'       For j = 0 To 50
'            'pbuf((i * m_Width + j) * 3) = 255 'pbuf((i * m_Width + j) * 3) * 0.11 + pbuf((i * m_Width + j) * 3 + 1) * 0.59 + pbuf((i * m_Width + j) * 3 + 2) * 0.3
'            pbuf((i * m_Width + j) * 3 + 1) = 255
'            pbuf((i * m_Width + j) * 3 + 2) = 255
'       Next j
'    Next i
   If (m_Width = 768 And m_Height = 576) Then
       Call StretchDIBits(hmemDC, 0, -100, m_Width, m_Height, 0, 0, m_Width, m_Height, pbuf(0), BmpInfo, DIB_RGB_COLORS, SRCCOPY)
   Else
       Call StretchDIBits(hmemDC, 0, 0, m_Width, m_Height, 0, 0, m_Width, m_Height, pbuf(0), BmpInfo, DIB_RGB_COLORS, SRCCOPY)
   End If
    SetTextColor Me.hdc, &H8080FF
     TextOut Me.hdc, 10, 10, distext, Len(distext)
     distext = "Microvision"
     TextOut Me.hdc, 10, 50, "Microvision", Len("Microvision") '汉字的话乘仪2
     SelectObject Me.hdc, hfntOld
    Call ReleaseDC(Me.hwnd, hmemDC)
   
End Sub