|
|
发表于 2004-9-16 09:44:00
|
显示全部楼层
Re: 在DirectDraw全屏模式下如何输入中文??
Sub SetBackBufferSurface() '//* ''产生主要的缓冲 'Get the backbuffer
Dim caps As DDSCAPS2
Dim DEnum As Direct3DEnumDevices
Dim GUID As String
On Local Error GoTo Err_OutBuffer
caps.lCaps = DDSCAPS_BACKBUFFER Or DDSCAPS_3DDEVICE '新程式
Set BackBuffer = Primary.GetAttachedSurface(caps)
' BackBuffer.GetSurfaceDesc DDSD1
'//* -----------------------------------
Set D3d = DD.GetDirect3D
Set DEnum = D3d.GetDevicesEnum
GUID = DEnum.GetGuid(DEnum.GetCount)
Set Dev = D3d.CreateDevice(GUID, BackBuffer) 'Set Dev = D3D.CreateDevice("IID_IDirect3DHALDevice", BackBuffer)
'//* 安装那描绘选择项 双线性的材质过滤 - 变得比较好.....
'//* 进行这些目前的设定允许 blendind 工作好像它是 lightmap 。。。
'//* you can change D3DBLEND_ONE, check the DX7 SDK for other values
' Dev.SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTFG_LINEAR '//* 这两行是边缘柔化
' Dev.SetTextureStageState 0, D3DTSS_MINFILTER, D3DTFN_LINEAR '//* 这两行是边缘柔化
Dev.SetRenderState D3DRENDERSTATE_DESTBLEND, D3DBLEND_ONE 'D3DBLEND_SRCCOLOR
Dev.SetRenderState D3DRENDERSTATE_SRCBLEND, D3DBLEND_ONE
Call Err_Msg_Log.AppendToLog("CreateBackBufferSurface ... Ok", True, True) '//* 调试用过程
Exit Sub
Err_OutBuffer:
Call Err_Msg_Log.AT_Error_Run("SetBackBufferSurface 设置错误：" & Err.Number, Err.Number)
Exit Sub
End Sub
'//---------------------------------------------------------------------------------------
'//* ********************************************************************************
'//* * (第一个调用) *
'//* * 创建主表面和后备表面； *
'//* * 三缓冲(Triple Buffering) *
'//* * 在某些情况下,那就是,当显示适配器拥有足够的内存,那么, *
'//* * 你就可以使用三缓冲区(Triple Buffering)来加速你的应用程序的显示速度. *
'//* * 三缓冲区使用一个主页面(primary surface)和两个后台缓存(back buffers) *
'//* * .DDSD1.lBackBufferCount = 1 <--- 2时 为三缓冲 *
'//* * *
'//* ********************************************************************************
Sub SetPrimarySurface() '//* 也拿表面给荧屏并且产生一个后面的缓冲 (第一个调用)
Dim ddsd As DDSURFACEDESC2 '//* 最初的表面 (荧屏)
On Local Error GoTo Err_OutPri
'//* Flags 在 ddsd 中 那一个成员被用做有效 书第 116 页
ddsd.lFlags = DDSD_BACKBUFFERCOUNT Or DDSD_CAPS 'DDSD1.lFlags = DDSD_CAPS
ddsd.ddsCaps.lCaps = DDSCAPS_COMPLEX Or DDSCAPS_FLIP Or DDSCAPS_3DDEVICE Or DDSCAPS_PRIMARYSURFACE
'DDSD.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX Or DDSCAPS_3DDEVICE ' Or DDSCAPS_VIDEOMEMORY
'DDSD.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE ' Or DDSCAPS_VIDEOMEMORY
ddsd.lBackBufferCount = 2 '//* 书第 116 页 有关于用 内存还是显存的方法
Set Primary = DD.CreateSurface(ddsd)
Call Err_Msg_Log.AppendToLog("CreatePrimarySurface ... Ok", True, True) '//* 调试用过程
Exit Sub
Err_OutPri:
Call Err_Msg_Log.AT_Error_Run("SetPrimarySurface 设置错误：" & Err.Number, Err.Number)
Exit Sub
End Sub
'//------------------------------------------------------------------------------------------
Sub SetClipAndTransparency(Optional hWnd As Long = 0) '//* 裁剪器 过程
If hWnd = 0 Then hWnd = gL_mFromHwnd
' Dim rBack As RECT
'On Local Error GoTo Err_OutClip
Set ClipperObj = DD.CreateClipper(0)
'Set ClipperObj0 = DD.CreateClipper(0) '//* 这个是多的（有错）
ClipperObj.SetHWnd hWnd
'//* <DirectDraw原理与API参考 P101页
Primary.SetClipper ClipperObj
'BackBuffer.SetClipper ClipperObj'//* 这个是多的（有错）
'' Call Dx.GetWindowRect(hWnd, destRect)
' rBack.Bottom = 600:rBack.Right = 800
' Primary.BltFast 0, 0, Primary, rBack, DDBLTFAST_WAIT
Call Err_Msg_Log.AppendToLog("设置裁剪器 始发... Ok", True, True) '//* 调试用过程
Exit Sub
Err_OutClip:
Call Err_Msg_Log.AT_Error_Run("裁剪器 设置错误：" & Err.Number, Err.Number)
Exit Sub
End Sub
'//------------------------------------------------------------------------------------------
'------------------------------------------------------
Sub InitDirectDraw(Optional hWnd As Long = 0, Optional iWidth As Integer = 640, _
Optional iHeight As Integer = 480, Optional BPP As Byte = 16) '//* 等于 Init()
Call Err_Msg_Log.AppendToLog("初始化 DX.DirectDraw", True, False) '//* 调试用过程
On Local Error GoTo ErrOut
Set DD = dx.DirectDrawCreate("")
Call Err_Msg_Log.CheckComputer(False) '//* 调试用过程系统性能
If hWnd = 0 Then hWnd = gL_mFromHwnd
'//* ' 产生 DirectDraw, 放置独家的 coopeerative 水平而且设定电视的模态。
'//* '指出我们 dont 需要改变展览深度 'indicate that we dont need to change display depth
'' DD.SetCooperativeLevel frmMain.hWnd, DDSCL_NORMAL Or DDSCL_NOWINDOWCHANGES
Call DD.SetCooperativeLevel(hWnd, DDSCL_FULLSCREEN Or DDSCL_ALLOWMODEX Or DDSCL_EXCLUSIVE)
Call DD.SetDisplayMode(iWidth, iHeight, BPP, 0, DDSDM_DEFAULT) '设分辨率 800 X 600
Call Err_Msg_Log.AppendToLog("设分辨率 宽：" & iWidth & " 高：" & iHeight & " 色：" & BPP, True, True) '//* 调试用过程
EmptyRect.Top = 0
EmptyRect.Bottom = EmptyRect.Top + iHeight
EmptyRect.Left = 0
EmptyRect.Right = EmptyRect.Left + iWidth
Exit Sub
ErrOut:
Call Err_Msg_Log.AT_Error_Run("无法对DirectDraw进行初始化", Err.Number)
'//* DDSCL_FULLSCREEN 使用全?幕?必?和DDSCL_EXCLUSIVE一起用?
'//* DDSCL_ALLOWMODEX 使用Modex模式
'//* DDSCL_EXCLUSIVE 使用??啄Ｊ
'//* DDSCL_NORMAL 使用Windows的程式?窗
'//* DDSCL_NOWINDOWCHANGES 禁止改??窗大小
End Sub
'//-----------------------------------------------------------------------------------
Sub FlipBlt(Optional hWnd As Long = 0) '//* 翻面操作过程
On Local Error GoTo errOutC
If hWnd = 0 Then hWnd = gL_mFromHwnd
'//* 等待前一次翻面操作完成. <<DirectDraw原理与API参考 P45页>>
dx.GetWindowRect hWnd, rBack '//* 这个是一组的 <1>
' Primary.Flip Nothing, DDFLIP_WAIT
'' Primary.Blt rBack, BackBuffer, rBack, DDBLT_WAIT '//* 这个是一组的 <2>
Primary.Blt rBack, BackBuffer, rBack, DDBLT_DONOTWAIT
' BackBuffer.BltFast 0, 0, BackBuffer, rBack, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT
' Primary.Flip Nothing, DDFLIP_WAIT
Exit Sub
errOutC:
' If Not (DD Is Nothing) Then
Call Err_Msg_Log.AT_Error_Run("无法对 Primary.Flip 过程 FlipBlt", Err.Number)
End Sub
'//---------------------------------------------------------------------------------
'//* ************************************************************************
'//* * (iWidthZoom)只管缩放宽,(iHeightZoom)只管缩放高) , False, *
'//* * 32,(显示一部分) 64,裁减 X 坐标 ,裁减 Y 坐标, (iWidthZoom)缩放宽, *
'//* * nLeft 相当于 X nTop 相当于 Y *
'//* * 在用放大时 要 把 iSrcWidth - 1,iSrcHeight - 1 *
'//* * iSrcWidth 精灵图显示的宽度，iSrcHeight 精灵图显示的高度 *
'//* * nAngle 为旋转角度 *
'//* * nOffsetX 左右偏移值 ,nOffsetY 上下偏移值 *
'//* ************************************************************************
Sub 显示表面原型DisplaySurface4(DDSurface As My_Surface, _
Optional ByVal nLeft As Single, Optional ByVal nTop As Single, _
Optional ByVal iSrcWidth As Integer, Optional ByVal iSrcHeight As Integer, _
Optional ByVal nOffsetX As Single, Optional ByVal nOffsetY As Single, _
Optional ByVal iWidthZoom As Integer, Optional ByVal iHeightZoom As Integer, _
Optional ByVal tABOne As Boolean, Optional ByVal nAlpha As Single = 1, _
Optional ByVal nRed As Single = 1, Optional ByVal nGreen As Single = 1, Optional ByVal nBlue As Single = 1, _
Optional ByVal nAngle As Single = 0) 'Angle 角度
'//* ************************************************************
If DDSurface.iWidth + nLeft <= 4 Then Exit Sub '//* 大了不调用 (应该是<=0)
If nLeft >= gE_formScreen.ScreenWidth Then Exit Sub
If (nTop >= gE_formScreen.DisplayHeight) Then
''If (DDSurface.iBGround = False) Then Exit Sub
Exit Sub
End If
'If Top >= gE_formScreen.DisplayHeight Then Exit Sub
If DDSurface.iHeight + nTop <= 4 Then Exit Sub '//* (应该是<=0)
On Error GoTo ErrOut3
'//* No scaling info. is given, so assume source and dest. sizes are equal
If iSrcWidth = 0 Then iSrcWidth = DDSurface.iWidth
If iSrcHeight = 0 Then iSrcHeight = DDSurface.iHeight
If iWidthZoom = 0 Then iWidthZoom = iSrcWidth
If iHeightZoom = 0 Then iHeightZoom = iSrcHeight
Dim srcRect As RECT
'//* If this is a D3D surface (These surfaces need to be square, power of 2 sized)
If DDSurface.D3d = True Then
Dim destRect As RECT
Dim TempVerts(3) As D3DTLVERTEX
'//* 建立目的站长方形
' If HeightZoom > SrcHeight Then SrcHeight = SrcHeight - 1
' If WidthZoom > SrcWidth Then SrcWidth = SrcWidth - 1
With srcRect
.Left = nOffsetX
.Top = nOffsetY
.Right = nOffsetX + iSrcWidth '
.Bottom = nOffsetY + iSrcHeight '//* 原来的
End With
'//* 建立源长方形
With destRect
.Left = nLeft
.Top = nTop
.Bottom = nTop + iHeightZoom '
.Right = nLeft + iWidthZoom '
End With
'Set up the TempVerts(3) vertices
SetUpGeom TempVerts, DDSurface, srcRect, destRect, nRed, nGreen, nBlue, nAlpha, nAngle
Dev.SetRenderState D3DRENDERSTATE_ALPHABLENDENABLE, True 'Enable alpha-blending
'//* Enable color-keying (ColorKey is drawn transparent)
Dev.SetRenderState D3DRENDERSTATE_COLORKEYENABLE, True
'//* 不明什么意思
'Dev.SetRenderState D3DRENDERSTATE_COLORKEYBLENDENABLE, True
If tABOne = True Then 'Use Alpha Blend One alpha blending
Dev.SetRenderState D3DRENDERSTATE_SRCBLEND, D3DBLEND_ONE
Dev.SetRenderState D3DRENDERSTATE_DESTBLEND, D3DBLEND_ONE
Else 'Alpha blend to a certain fade value (0 - 1)
Dev.SetRenderState D3DRENDERSTATE_SRCBLEND, D3DBLEND_SRCALPHA
Dev.SetRenderState D3DRENDERSTATE_DESTBLEND, D3DBLEND_INVSRCALPHA
Dev.SetRenderState D3DRENDERSTATE_TEXTUREFACTOR, dx.CreateColorRGBA(1, 1, 1, nAlpha)
Dev.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_MODULATE 'D3DTA_TFACTOR
End If 'Set the texture on the D3D device
Dev.SetTexture 0, DDSurface.DDSface7
' Dev.SetTextureStageState 0, D3D_TEXTURESTAGE_STATETYPE, 3 '//* D3DTSS_MIPFILTER '//* 基于 DrawPrimitive 的渲染功能
Dev.DrawPrimitive D3DPT_TRIANGLESTRIP, D3DFVF_TLVERTEX, TempVerts(0), 4, D3DDP_DEFAULT Or D3DDP_WAIT
Dev.SetRenderState D3DRENDERSTATE_ALPHABLENDENABLE, False
Dev.SetTexture 0, Nothing
Else '//* 不是 Ｄ３Ｄ 的精灵
If nTop > 0 Then
srcRect.Top = nOffsetY: srcRect.Bottom = iSrcHeight
If (iSrcHeight + nTop > gE_formScreen.DisplayHeight) Then
If (DDSurface.D3d = False) Then '//*原为是否是地面，因编译改为 D3d
srcRect.Bottom = iSrcHeight - (iSrcHeight - (gE_formScreen.DisplayHeight - nTop))
Else
If (nTop + iSrcHeight) > gE_formScreen.ScreenHeight Then srcRect.Bottom = (gE_formScreen.ScreenHeight - nTop) 'SrcHeight - ((SrcHeight + Top) - ScreenHeight)
End If
End If
ElseIf nTop < 0 Then
srcRect.Top = Abs(nTop): srcRect.Bottom = iSrcHeight ' - Abs(Top) '(SrcHeight - (DisplayHeight - Top))
nTop = 0
ElseIf nTop = 0 Then
srcRect.Top = nOffsetY: srcRect.Bottom = iSrcHeight
If iSrcHeight + nTop > gE_formScreen.DisplayHeight Then
If (DDSurface.D3d = False) Then
srcRect.Bottom = iSrcHeight - (iSrcHeight - (gE_formScreen.DisplayHeight - nTop))
Else
If iSrcHeight + nTop > gE_formScreen.ScreenHeight Then srcRect.Bottom = gE_formScreen.ScreenHeight - nTop
End If
End If
End If
If nLeft > 0 Then
srcRect.Left = nOffsetX '//* 管偏移地址
If iSrcWidth + nLeft > gE_formScreen.ScreenWidth Then
srcRect.Right = iSrcWidth - (iSrcWidth - (gE_formScreen.ScreenWidth - nLeft))
Else
srcRect.Right = iSrcWidth
End If
ElseIf nLeft < 0 Then
srcRect.Left = Abs(nLeft)
srcRect.Right = iSrcWidth: nLeft = 0
Else
srcRect.Left = nOffsetX
srcRect.Right = iSrcWidth '//* 管 宽度 裁去 右边多少
End If
'Blt the surface normally, without D3D features (these surfaces can be any size)
'BackBuffer.Blt DestRect, DDSurface.iSurface, SrcRect, DDBLT_KEYSRC Or DDBLT_WAIT
If DDSurface.BitMask = True Then '//* 透明使用
BackBuffer.BltFast nLeft, nTop, DDSurface.DDSface7, srcRect, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_DONOTWAIT 'DDBLTFAST_WAIT
Else
BackBuffer.BltFast nLeft, nTop, DDSurface.DDSface7, srcRect, DDBLTFAST_DONOTWAIT ' DDBLTFAST_WAIT
'BackBuffer.Blt RecB, DDSurface.iSurface, RecB, DDBLT_WAIT '//* 效果可能一样
End If
End If
Exit Sub
ErrOut3:
Call Err_Msg_Log.AT_Error_Run("DisplaySurface 调用错误：" & Err.Number, Err.Number)
Exit Sub
End Sub
'//-----------------------------------------------------------------------------------------
' 这是始使用的头目
'//----------------------------------------------------------------------------------------
Sub GameRun()
'On Local Error GoTo Err_Out
On Error Resume Next
'//* 初始化 D3D
Call DxDDraw.InitDirectDraw(frmMain.hWnd, 640, 480) '//* 调用ＤＸＤＲＡＷ过程
'//If GetInputState() Then DoEvents
Call DxDDraw.SetPrimarySurface '//* 也拿表面给荧屏并且产生一个后面的缓冲
Call DxDDraw.SetClipAndTransparency(frmMain.hWnd)
Call DxDDraw.SetBackBufferSurface '//* 产生主要的缓冲
'Call DInput.Initialize '//* 调用 DX ＩＮＰＵＴ过程
Call Err_Msg_Log.GetHardware '//* 测试硬件
gT_Dx_Start_Ok = True
'//* ------------------ << 这里开始是主刷屏过程 >> ----------------------
Call Load_Surfaces '//* 加载 图片资源
ReDim Object_Sprite_Data(2)
Object_Sprite_Data(1).O_Place.Y = 150
Call MainiLoop '//* 主程式
Exit Sub
Err_Out:
'Call Err_Msg_Log.AT_Error_Run("无法 GameRun 进行 也许显示卡自爆了", Err.num)
Call Err_Msg_Log.AT_Error_Run("无法 GameRun 进行 也许显示卡自爆了", 123)
End Sub
|
|
楼主