用BitBlt贴图,源图片框没有显示时就贴不出来,怎么办?

Question

楼上的，我真的服了你了，动动脑筋啊！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 LongPrivate Sub Command1_Click()
    Picture1.AutoRedraw = True
    Picture2.AutoRedraw = True
    BitBlt Picture1.hDC, 0, 0, 100, 100, Picture2.hDC, 0, 0, vbSrcCopy
    Picture1.Refresh
End Sub

Answer 1

能不能调用时，先Blt到内存。不用图片框，看看例程'form1窗体
Option Explicit
Dim xx As Integer
Dim yy As IntegerDim a As Integer
Dim I As Integer
Dim J As Integer
Dim m As Integer
Dim bm As BITMAP                    '定义位图结构
Dim pic As Picture                  '定义图片对象
Dim hBmpPaint As Long               '定义位图句柄
Dim hDCMem As Long                  '定义存储器DC
Dim hMemDCTemp As Long              '定义临时缓冲
Dim hMemDCTemp2 As Long              '定义临时缓冲
Dim hDCMemScreen As Long
Dim Check As StringPrivate Sub Form_Load()
ScaleMode = vbPixels                '使用像素
Set pic = LoadPicture(App.Path & "\" & "a.bmp")     '读取图片
GetObject pic.Handle, LenB(bm), bm  '得到图片的数据结构'临时缓冲
hMemDCTemp = CreateCompatibleDC(Me.hdc)
SelectObject hMemDCTemp, pic.HandleSet pic = LoadPicture(App.Path & "\" & "a.bmp")     '读取图片
GetObject pic.Handle, LenB(bm), bm  '得到图片的数据结构
'临时缓冲2
hMemDCTemp2 = CreateCompatibleDC(Me.hdc)
SelectObject hMemDCTemp2, pic.Handle'第一缓冲
hDCMem = CreateCompatibleDC(Me.hdc)
hBmpPaint = CreateCompatibleBitmap(Me.hdc, Me.ScaleWidth, Me.ScaleHeight)
SelectObject hDCMem, hBmpPaint'屏幕缓冲
hDCMemScreen = CreateCompatibleDC(Me.hdc)
hBmpPaint = CreateCompatibleBitmap(Me.hdc, Me.ScaleWidth, Me.ScaleHeight)
SelectObject hDCMemScreen, hBmpPaintEnd Sub'模块
Dim hMemDc As Long'定义位图结构
Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type'图像的转移API
Public 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
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Answer 2

再有一个例子:
Option ExplicitPrivate Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As LongPrivate Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As LongPrivate Declare Function SelectObject Lib "gdi32" ( _
        ByVal hdc As Long, _
        ByVal hObject As Long) As LongPrivate Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Declare Function CreateCompatibleBitmap Lib "gdi32" ( _
        ByVal hdc As Long, _
        ByVal nWidth As Long, _
        ByVal nHeight As Long) As LongPrivate Declare Function StretchBlt Lib "gdi32" ( _
        ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, _
        ByVal dwRop As Long) As Long
        
Private Const SRCCOPY = &HCC0020Private Sub DrawBitmap(TheForm As Form, _
                       ByVal DstWidth As Long, ByVal DstHeight As Long, _
                       ByVal FileName As String)
    Dim SrcWidth As Long, SrcHeight As Long
    Dim Pic As New StdPicture
    Dim hBitmap As Long, hOldObject As Long
    Dim hMemDC As Long
    
    TheForm.AutoRedraw = True
    Set Pic = LoadPicture(FileName)
    hMemDC = CreateCompatibleDC(0)
    hOldObject = SelectObject(hMemDC, Pic.Handle)
    
    SrcHeight = TheForm.ScaleY(Pic.Height, vbHimetric, vbPixels)
    SrcWidth = TheForm.ScaleX(Pic.Width, vbHimetric, vbPixels)
    
    Call StretchBlt(TheForm.hdc, 0, 0, DstWidth, DstHeight, _
                    hMemDC, 0, 0, SrcWidth, SrcHeight, SRCCOPY)
    TheForm.Refresh
    
    Call SelectObject(hMemDC, hOldObject)
    Call DeleteObject(hBitmap)
    Call DeleteObject(hOldObject)
    Call DeleteDC(hMemDC)
End Sub
Private Sub Command1_Click()
    '在Form上画一个200*200相素的位图
    DrawBitmap Me, 200, 200, "c:\test.bmp"
End Sub

Answer 3

同意junwhj()的作法，绝对可行。如果是用LoadImage函数的话显得太烦琐了，用BitBlt函数完全可以将源图片框的图片贴出来，即使是设置为不可见，关键一步是要将源图片框的AutoReDraw属性设置为True，请看下面两个我完全用BitBlt函数编写的游戏“坦克大决战”和“超级玛莉”中就多次用到了设置为不可见的源图片框的BitBlt贴图：
http://www.csdn.net/cnshare/soft/12/12207.shtm
http://www.csdn.net/cnshare/soft/12/12208.shtm
--------------------------------------------------------------------
Made by Thirdapple's Studio