当前位置: 源码素材网 » VB教程 » 详情页

从一个VB游戏中整理的后台缓冲对象示例代码

  •   时间:2020-02-11
  • 概述:缓冲 游戏代码

后台缓冲对象,根据一个舞台的大小,在内存中创建一个,和舞台一样大小的区域,可获的内存设备场景,0就是获取失败,这个过程将缓冲区的内容恢复到所依赖绑定的舞台,缓冲区对象有两个过程,重置及刷新保存,还有创建缓冲区的函数:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "buffer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'--这是后台缓冲对象。
'--根据一个舞台的大小,在内存中创建一个
'--和舞台一样大小的区域。
Option Explicit
Private isValid As Boolean '--缓冲是否有效
Private refStage As PictureBox '--引用的舞台,这里规定为PB类型
Private oldBmp As Long '--老位图句柄
Private newBmp As Long '--新位图句柄
Private memDC As Long '--一个内存设备场景
Private stageref As PictureBox  '--舞台引用
'可获的内存设备场景,0就是获取失败
Public Property Get Buf() As Long
    If isValid = True Then
        Buf = memDC
    Else
        Buf = 0 '--无效的设备场景
    End If
End Property
Private Sub Class_Initialize()
    isValid = False '--置无效
End Sub
'--这个过程将缓冲区的内容恢复到所依赖绑定的舞台
Public Sub FlushBindStage()
    If isValid Then
        BitBlt stageref.hdc, 0, 0, stageref.ScaleWidth, stageref.ScaleHeight, memDC, 0, 0, SRCCOPY
    End If
End Sub
Public Sub FlushBuf()   '--这个过程将会把舞台保存到缓冲内存中。
    If isValid Then
        BitBlt memDC, 0, 0, stageref.ScaleWidth, stageref.ScaleHeight, stageref.hdc, 0, 0, SRCCOPY
    End If
End Sub
'--缓冲区对象有两个过程,重置及刷新保存
Public Sub ResetBuf(newstage As PictureBox)
    '--根据新的舞台重构缓冲对象
    '--如果舞台对象为空,则只是重构GDI位图对象
    If isValid Then
        If newstage Is Nothing Then
            '--仅重构位图对象。
            Call SelectObject(memDC, oldBmp) '--选出位图对象
            DeleteObject newBmp '--删除
            '--创建新的对象
            newBmp = CreateCompatibleBitmap(stageref.hdc, stageref.ScaleWidth, stageref.ScaleHeight)
            SelectObject memDC, newBmp  '--将新的位图对象选如设备场景中
        Else
            SelectObject memDC, oldBmp
            DeleteObject newBmp '--删除GDI位图对象
            DeleteDC memDC  '--删除内存设备场景
            newstage.ScaleMode = vbPixels
            memDC = CreateCompatibleDC(newstage)
            newBmp = CreateCompatibleBitmap(newstage.hdc, newstage.ScaleWidth, newstage.ScaleHeight)
            oldBmp = SelectObject(memDC, newBmp)
            If memDC = 0 Or newBmp = 0 Then
                MsgBox "在重置缓冲区的过程中遇到了错误!重置失败,且缓冲对象不可用", vbInformation
                isValid = False
            Else
                Set stageref = newstage
            End If
        End If
    End If
End Sub
'--这里是创建缓冲区的函数
Public Function CreateBuffer(stage As PictureBox) As Boolean
    If stage Is Nothing Then
        CreateBuffer = False
    Else
        stage.ScaleMode = vbPixels
        newBmp = CreateCompatibleBitmap(stage.hdc, stage.ScaleWidth, stage.ScaleHeight)
        memDC = CreateCompatibleDC(stage.hdc) '--创建兼容的位图,设备场景,选入位图GDI对象
        oldBmp = SelectObject(memDC, newBmp)
        If newBmp = 0 Or memDC = 0 Then
            MsgBox "缓冲区创建失败!", vbInformation
            CreateBuffer = False
        Else
            Set stageref = stage
            isValid = True
            CreateBuffer = True
        End If
    End If
End Function
Private Sub Class_Terminate()
    If isValid Then
        SelectObject memDC, oldBmp
        DeleteObject newBmp '--删除GDI位图对象
        DeleteDC memDC  '--删除内存设备场景
    End If
End Sub

    相关声明:

      若“从一个VB游戏中整理的后台缓冲对象示例代码”有损您的权益,请告之我们删除内容。
      部分文章来源于网络,版权归原作者所有。