|
|
发表于 2005-9-7 10:13:00
|
显示全部楼层
Re:DX7下如何实现半透明？
Sub Run_FPS() '//* 这个过程是重要的
On Error Resume Next
'Static i As Integer
Static mlngTimer As Long '----}
Static mlngFrameTimer As Long ' } Used to calculate the Frames per second
Static mintFPSCounter As Integer '----}
'//* *
mlngTimer = dx.TickCount() 'DX.TickCount
If dx.TickCount() - mlngFrameTimer >= 1000 Then
mlngFrameTimer = dx.TickCount() 'DX.TickCount
FPS = mintFPSCounter
mintFPSCounter = 0
Else
mintFPSCounter = mintFPSCounter + 1
End If
If (FPS >= 81) Then gI_Dx_FPS_Revise = -2
If (FPS <= 80) And (FPS >= 61) Then gI_Dx_FPS_Revise = -1 '42
If (FPS <= 60) And (FPS >= 37) Then gI_Dx_FPS_Revise = 0 '42
If (FPS <= 36) And (FPS >= 26) Then gI_Dx_FPS_Revise = 1 '30
If (FPS <= 25) And (FPS >= 19) Then gI_Dx_FPS_Revise = 3 '25
If (FPS <= 18) And (FPS >= 16) Then gI_Dx_FPS_Revise = 5 '18
If (FPS <= 15) And (FPS >= 11) Then gI_Dx_FPS_Revise = 8 '15
If (FPS <= 10) Then gI_Dx_FPS_Revise = 11 '10
'//* -------------------------Frames per Second = FPS
Call DxDDraw.DisplayString(3, 350, 5, gE_formScreen.ScreenWidth & "x" & gE_formScreen.ScreenHeight & "x16Bit FPS " & FPS & " Timer " & Timer)
Call DxDDraw.DisplayString(1, 10, 90, "Click Screen to Exit")
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
Function ExModeActive() As Boolean '//* DX 主运行窗口是否被最小化，不在焦点
Dim TestCoopRes As Long
TestCoopRes = DD.TestCooperativeLevel
If (TestCoopRes = DD_OK) Then
ExModeActive = True
Else
ExModeActive = False
End If
End Function |
|
楼主