|
|
发表于 2007-3-13 20:43:00
|
显示全部楼层
Re:有没有直接基于GDI或GDI+的游戏引擎啊 ？
很久以前发过的，再帖出来一遍。
（还称不上“引擎”吧，源代码只供参考）
支持图像绘制，缩放，Alpha混合，只是非常简单的小东西，做大项目的话就算了。
VB和VC的都有，这是VB的：
--------------------------------------------------------------------------
将我的GDI演示里的代码简化整理之后做成的，我想一般小游戏够用了。
没有专门封装成DLL，而是提供一个标准模块(mdl)文件，也就是源代码：
先将代码贴在这里吧，将它整个复制到一个Mdl文件中即可
'================================GDI Engine Lite=============================================
Option Base 1 '约定默认下标下界为1
'GDI 常数声明---------------------------
Public Const WS_EX_LAYERED = &H80000
Public Const CLR_INVALID = &HFFFF
Public Const AC_SRC_OVER = &H0
Public Const AC_SRC_ALPHA = &H1
Public Const AC_SRC_NO_PREMULT_ALPHA = &H1
Public Const AC_SRC_NO_ALPHA = &H2
Public Const AC_DST_NO_PREMULT_ALPHA = &H10
Public Const AC_DST_NO_ALPHA = &H20
Public Const LWA_COLORKEY = &H1
Public Const LWA_ALPHA = &H2
Public Const ULW_COLORKEY = &H1
Public Const ULW_ALPHA = &H2
Public Const ULW_OPAQUE = &H4
'---------------------------------------
Public Const cst_PI = 3.1415926
Public Type Rect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'GDI类型声明------------------------
Public Type t_BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
Public Type POINTAPI
x As Long
y As Long
End Type
'-----------------------------------
Public Type t_FxDraw
UseAlphaChannel1 As Boolean
AlphaByte As Byte
UseScale1 As Boolean
ScaleW1 As Long
ScaleH1 As Long
dwRop1 As Long
UseColorKey1 As Boolean
ColorKey1 As Long
End Type
Public Type t_Sprite1
Active1 As Boolean
X1 As Single
Y1 As Single
Xp1 As Single
Yp1 As Single
SrcRc1 As Rect
ResIdx1 As Long
nowFrame1 As Long
End Type
'//------------GDI声明-------------------
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 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
Public Declare Function AlphaBlend Lib "msimg32" (ByVal hDestDC As Long, _
ByVal xDest As Long, _
ByVal yDest As Long, _
ByVal nWidthDest As Long, _
ByVal nHeightDest As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal nWidthSrc As Long, _
ByVal nHeightSRC As Long, _
ByVal BLENDFUNCTION As Long) As Long
Public Declare Function TransparentBlt Lib "msimg32" (ByVal hDestDC As Long, _
ByVal xDest As Long, _
ByVal yDest As Long, _
ByVal nWidthDest As Long, _
ByVal nHeightDest As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal nWidthSrc As Long, _
ByVal nHeightSRC As Long, _
ByVal crTransparent As Long) As Long
Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor 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 DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
'==========================================================================================
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function timeGetTime Lib "winmm.dll" () As Long
Public ResPic1() As StdPicture
Public ResPicDC1() As Long
Public ResPicCount1 As Long
Public TargetSurf1 As PictureBox
Function LoadBitmap1(ByVal Idx1 As Long, File1 As String)
Set ResPic1(Idx1) = LoadPicture(File1)
ResPicDC1(Idx1) = CreateCompatibleDC(ByVal 0&)
SelectObject ResPicDC1(Idx1), ResPic1(Idx1).Handle
End Function
'------------标准绘图----------------------------------
Function GDI_Draw1(ByVal X1 As Long, ByVal Y1 As Long, ByVal ResIdx1 As Long, SrcRc1 As Rect, Optional dwRop1 As Long = vbSrcCopy)
Dim back1 As Long
back1 = BitBlt(TargetSurf1.hdc, X1, Y1, SrcRc1.Right - SrcRc1.Left, SrcRc1.Bottom - SrcRc1.Top, _
ResPicDC1(ResIdx1), SrcRc1.Left, SrcRc1.Top, dwRop1)
If back1 = 0 Then MsgBox "GDI Draw Failed" & Chr(13) & "Err Code: " & Err.LastDllError, , "Error"
End Function
'-----------增强型绘图---------------------------------
Function GDI_DrawFx1(ByVal X1 As Long, ByVal Y1 As Long, _
ByVal ResIdx1 As Long, SrcRc1 As Rect, _
DrawInfo1 As t_FxDraw)
Dim back1 As Long, sWidth1 As Long, sHeight1 As Long, BltF1 As t_BLENDFUNCTION, BltP1 As Long
sWidth1 = SrcRc1.Right - SrcRc1.Left
sHeight1 = SrcRc1.Bottom - SrcRc1.Top
With DrawInfo1
If (.UseAlphaChannel1) Or (.AlphaByte <> 255) Then
BltF1.BlendOp = AC_SRC_OVER
BltF1.BlendFlags = 0
BltF1.SourceConstantAlpha = .AlphaByte
If .UseAlphaChannel1 Then BltF1.AlphaFormat = AC_SRC_ALPHA Else BltF1.AlphaFormat = 0
CopyMemory BltP1, BltF1, 4
back1 = AlphaBlend(TargetSurf1.hdc, X1, Y1, sWidth1, sHeight1, ResPicDC1(ResIdx1), SrcRc1.Left, SrcRc1.Top, sWidth1, sHeight1, BltP1)
ElseIf .UseScale1 Then
If .UseColorKey1 Then
back1 = TransparentBlt(TargetSurf1.hdc, X1, Y1, .ScaleW1, .ScaleH1, _
ResPicDC1(ResIdx1), SrcRc1.Left, SrcRc1.Top, sWidth1, sHeight1, .ColorKey1)
Else
back1 = StretchBlt(TargetSurf1.hdc, X1, Y1, .ScaleW1, .ScaleH1, _
ResPicDC1(ResIdx1), SrcRc1.Left, SrcRc1.Top, sWidth1, sHeight1, .dwRop1)
End If
ElseIf .UseColorKey1 Then
back1 = TransparentBlt(TargetSurf1.hdc, X1, Y1, sWidth1, sHeight1, _
ResPicDC1(ResIdx1), SrcRc1.Left, SrcRc1.Top, sWidth1, sHeight1, .ColorKey1)
Else
GDI_Draw1 X1, Y1, ResIdx1, SrcRc1, .dwRop1
End If
End With
If back1 = 0 Then MsgBox "GDI Draw Failed" & Chr(13) & "Err Code: " & Err.LastDllError, , "Error"
End Function
Function DeleteResPic1(Optional ByVal Idx1 As Long = -5)
If Idx1 = -5 Then
Dim s1 As Long
For s1 = 1 To ResPicCount1
DeleteDC ResPicDC1(s1)
Next
Else
DeleteDC ResPicDC1(Idx1)
End If
End Function
Function RefreshTargetSurf1()
TargetSurf1.Refresh
End Function
Function ClearTargetSurf1()
TargetSurf1.Cls
End Function
Function DrawSprite1(tSprite1 As t_Sprite1, Optional dwRop1 As Long = vbSrcCopy)
GDI_Draw1 Int(tSprite1.X1), Int(tSprite1.Y1), tSprite1.ResIdx1, tSprite1.SrcRc1, dwRop1
End Function
Function DrawSpriteFX1(tSprite1 As t_Sprite1, DrawInfo1 As t_FxDraw)
GDI_DrawFx1 Int(tSprite1.X1), Int(tSprite1.Y1), tSprite1.ResIdx1, tSprite1.SrcRc1, DrawInfo1
End Function
Function GetSpriteSrcRect1(Sprite1 As t_Sprite1, ByVal XCount1 As Long, ByVal YCount1 As Long)
Dim Rc1 As Rect, X1 As Integer, Y1 As Integer, W1 As Long, H1 As Long
X1 = Sprite1.nowFrame1 Mod XCount1
Y1 = Sprite1.nowFrame1 \ XCount1 + 1
W1 = Sprite1.SrcRc1.Right - Sprite1.SrcRc1.Left
H1 = Sprite1.SrcRc1.Bottom - Sprite1.SrcRc1.Top
If X1 = 0 Then
X1 = XCount1
Y1 = Y1 - 1
End If
Sprite1.SrcRc1.Left = W1 * (X1 - 1)
Sprite1.SrcRc1.Top = H1 * (Y1 - 1)
Sprite1.SrcRc1.Right = Sprite1.SrcRc1.Left + W1
Sprite1.SrcRc1.Bottom = Sprite1.SrcRc1.Top + H1
End Function
|
|
oadBitmap1 (long Idx1,LPCTSTR File1)
electResPic1 (long Idx1)
楼主