Imports Microsoft.DirectX.DirectDraw
Public Class Form1
Inherits System.Windows.Forms.Form
Private Structure PointAPI
Public x As Integer
Public y As Integer
End Structure
'''API用习惯了....也就继续用吧...
Private Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As PointAPI) As Integer
Dim dev As New Device(CreateFlags.Default)
Dim PS As Surface 'primarySurface
Dim BS As Surface 'BackSurface
Dim S1 As Surface 'Surface1 用于储存图像的,想象成一个BMP就行了
Dim S2 As Surface 'Surface2 同上
'''分别对应上面的四个Surface
Dim desc1 As SurfaceDescription
Dim desc2 As SurfaceDescription
Dim desc3 As SurfaceDescription
Dim desc4 As SurfaceDescription
''分别对应上面的Surface
Dim RP As Rectangle
Dim RB As Rectangle
Dim R1 As Rectangle
Dim R2 As Rectangle
'''计时器相关
Dim tLast As TimeSpan
Dim fps As String
Dim tfp As Integer = 0
Dim mytime As Date = DateTime.Now
Dim ts As New TimeSpan
Dim qiqi As Double
'''游戏控制
Dim running As Boolean = False
Dim TT As Threading.Thread
'''鼠标位置
Dim M As PointAPI
'''需要读取的图像
Const FN1 = "d:\nerv.bmp"
Const FN2 = "d:\logo.bmp"
#Region " Windows 窗体设计器生成的代码 "
Public Sub New()
MyBase.New()
'该调用是 Windows 窗体设计器所必需的。
InitializeComponent()
'在 InitializeComponent() 调用之后添加任何初始化
End Sub
'窗体重写 dispose 以清理组件列表。
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
'Windows 窗体设计器所必需的
Private components As System.ComponentModel.IContainer
'注意: 以下过程是 Windows 窗体设计器所必需的
'可以使用 Windows 窗体设计器修改此过程。
'不要使用代码编辑器修改它。
Friend WithEvents Label1 As System.Windows.Forms.Label
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
Me.Label1 = New System.Windows.Forms.Label
Me.SuspendLayout()
'
'Label1
'
Me.Label1.Location = New System.Drawing.Point(64, 64)
Me.Label1.Name = "Label1"
Me.Label1.Size = New System.Drawing.Size(80, 24)
Me.Label1.TabIndex = 0
Me.Label1.Text = "init&&play"
'
'Form1
'
Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
Me.ClientSize = New System.Drawing.Size(292, 273)
Me.Controls.Add(Me.Label1)
Me.Name = "Form1"
Me.Text = "Form1"
Me.ResumeLayout(False)
End Sub
#End Region
Private Sub Label1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Label1.Click
initDDraw() '初始化
LoadSurfaces() '读取图像
If TT Is Nothing Then '用于绘制的线程
TT = New Threading.Thread(AddressOf mainloop)
running = True
TT.Start()
End If
End Sub
Sub initDDraw()
dev.SetCooperativeLevel(Me, CooperativeLevelFlags.FullscreenExclusiveAllowModex)
dev.SetDisplayMode(1024, 768, 16, 0, False)
'Primarybuffer的设置
desc1 = New SurfaceDescription
desc1.SurfaceCaps.VideoMemory = True
desc1.SurfaceCaps.PrimarySurface = True
desc1.SurfaceCaps.Flip = True
desc1.SurfaceCaps.Complex = True
desc1.BackBufferCount = 1
PS = New Surface(desc1, dev)
desc2 = New SurfaceDescription
desc2.SurfaceCaps.BackBuffer = True
BS = PS.GetAttachedSurface(desc2.SurfaceCaps)
BS.ForeColor = System.Drawing.Color.Blue
BS.FontTransparency = True
''OK只要把PrimaryBuffer跟BackBuffer设置好就算初始化完成,其他的图像都往上贴
End Sub
Sub LoadSurfaces()
'''读取其他图层
''' 不要把Surface想得那么神秘,就是一个BMP附加上了更多的属性而已,这样理解简单很多
desc3 = New SurfaceDescription
desc3.SurfaceCaps.OffScreenPlain = True '幕后的
desc3.Height = BS.SurfaceDescription.Height '大小
desc3.Width = BS.SurfaceDescription.Width
S1 = New Surface(FN1, desc3, dev) '读取
desc4 = New SurfaceDescription
desc4.SurfaceCaps.OffScreenPlain = True '直接读
S2 = New Surface(FN2, desc4, dev)
Dim key As ColorKey '用来设置透明的
key.ColorSpaceHighValue = 0
key.ColorSpaceLowValue = 0
S2.SetColorKey(ColorKeyFlags.SourceDraw, key) '设置透明色
'''''设置矩形位置信息
'''
RB.Width = BS.SurfaceDescription.Width
RB.Height = BS.SurfaceDescription.Height
R1.Width = S1.SurfaceDescription.Width
R1.Height = S1.SurfaceDescription.Height
R2.Width = S2.SurfaceDescription.Width
R2.Height = S2.SurfaceDescription.Height
R2.X = 100
R2.Y = 100
End Sub
Sub mainloop()
While (running = True) '''如果游戏没有结束
blt() '''主要绘制过程
tfp += 1 '''fps++
If tfp = 200 Then '''200次的时候计算时间
tfp = 0
ts = (DateTime.Now.Subtract(mytime))
mytime = DateTime.Now
If ts.TotalSeconds <> 0 Then
qiqi = 200 / (ts.TotalSeconds)
fps = qiqi.ToString("##.##") + "F c"
End If
End If
TT.Sleep(10) '''硬性规定休息一下,当然可以去掉发挥MAX速度
End While
End Sub
Sub blt()
If BS Is Nothing Then Exit Sub
GetMousePos() '得到鼠标位置
'''下面的就是利用BackSurface的方法来绘制了,随便画,呵呵
BS.DrawFast(0, 0, S1, R1, DrawFastFlags.Wait)
BS.DrawText(10, 10, "1024x768 Frames per Second " + fps, False)
BS.DrawText(10, 30, "当前位置:X=" + M.x.ToString + ",Y=" + M.y.ToString, False)
BS.DrawText(10, 50, "ESC 退出", False)
'''画出贴图
BS.DrawFast(M.x, M.y, S2, DrawFastFlags.SourceColorKey Or DrawFastFlags.Wait)
'''顺便在鼠标的位置打出它的坐标
BS.DrawText(M.x + 50, M.y, "(" + M.x.ToString + "," + M.y.ToString + ")", False)
'''关键一步,翻转,而且不要使用wait,这样可能会丢帧,但是不影响速度
PS.Flip(Nothing, FlipFlags.NoVSync)
End Sub
Private Sub Form1_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyUp
If e.KeyCode = Keys.Escape Then End 'ESC退出
End Sub
Sub GetMousePos()
GetCursorPos(M) '调用API,得到鼠标位置
End Sub
End Class
=====================================
本文地址：http://com.8s8s.com/it/it41695.htm