liuhan.bas

游戏源码大家来看

Attribute VB_Name = "liuhan"
Option Explicit
'=======================半透明=======================
 Public Declare Function AlphaBlend _
     Lib "msimg32" ( _
     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 widthSrc As Long, _
     ByVal heightSrc As Long, _
     ByVal dreamAKA As Long) _
     As Long 'only Windows 98 or Latter
 Dim Num As Byte, nN%, nBlend&
'=======================半透明=======================

'=======================BitBlt=======================
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal animX As Long, ByVal animY 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 Const SRCCOPY = &HCC0020   'Copies the source over the destination
Public Const SRCINVERT = &H660046 'Copies and inverts the source over the destination
Public Const SRCAND = &H8800C6    'Adds the source to the destination
'=======================BitBlt=======================

'==================StretchBltVB声明==================
'说明：将一幅位图从一个设备场景复制到另一个。
'源和目标DC相互间必须兼容。
'这个函数会在设备场景中定义一个目标矩形，
'并在位图中定义一个源图象。
'源矩形会根据需要进行伸缩，以便与目标矩形的大小相符。
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
'==================StretchBltVB声明==================

Public FClose As Boolean '程式退出
Public GBegin As Boolean '游戏状态
Public SBegin As Boolean '游戏状态
Public Number As Integer '记录步数
Public Stime As Integer '记录时间
Public Etime As Integer '记录时间
Public ZiseInw As Integer
Public ZiseInh As Integer
Public ZiseOutw As Integer
Public ZiseOuth As Integer
Type Image_Data
    xin As Integer
    yin As Integer
    xnow As Integer
    ynow As Integer
End Type
Public GImage() As Image_Data

'Api播放mid声明
Public Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
'Api播放wav声明
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public Const SND_SYNC = &H0         '  play synchronously (default)
Public Const SND_ASYNC = &H1         '  play asynchronously
Public Const SND_NODEFAULT = &H2         '  silence not default, if sound not found
'声音占用内存常数
Public Const SND_MEMORY = &H4         '  lpszSoundName points to a memory file
'声音别名常数
Public Const SND_ALIAS = &H10000     '  name is a WIN.INI [sounds] entry
'声音文件名常数
Public Const SND_FILENAME = &H20000     '  name is a file name
Public Const SND_RESOURCE = &H40004     '  name is a resource name or atom
'声音别名标识常数
Public Const SND_ALIAS_ID = &H110000    '  name is a WIN.INI [sounds] entry identifier
Public Const SND_ALIAS_START = 0  '  must be > 4096 to keep strings in same section of resource file
Public Const SND_LOOP = &H8         '  loop the sound until next sndPlaySound
Public Const SND_NOSTOP = &H10        '  don't stop any currently playing sound
Public Const SND_VALID = &H1F        '  valid flags          / ;Internal /
Public Const SND_NOWAIT = &H2000      '  don't wait if the driver is busy
'声音有效标志常数
Public Const SND_VALIDFLAGS = &H17201F    '  Set of valid flag bits.  Anything outside
'声音保留常数
Public Const SND_RESERVED = &HFF000000  '  In particular these flags are reserved
Public Const SND_TYPE_MASK = &H170007

Public Sub GAlphaBlend(Num As Byte, nN%, nBlend&, hDestDC As Long, x As Long, y As Long, nWidth As Long, nHeight As Long, hSrcDC As Long, xSrc As Long, ySrc As Long, widthSrc As Long, heightSrc As Long)
        nBlend = vbBlue - CLng(Num) * (vbYellow + 1)
        AlphaBlend hDestDC, x, y, nWidth, nHeight, hSrcDC, xSrc, ySrc, widthSrc, heightSrc, nBlend
End Sub

Public Sub Print_Font(Object As Object, msg As String, x As Long, y As Long)
    Object.CurrentX = x
    Object.CurrentY = y
    Object.Print msg
    Object.CurrentX = 0
    Object.CurrentY = 0
End Sub
Public Sub Play_wav(wavFile As String)
    'ReturnValue = mciExecute("play Music.mid")
    Dim ReturnSoundValue As Long
    ReturnSoundValue = sndPlaySound(App.Path & "\wav\" & wavFile, SND_ASYNC)
    'SND_ASYNC参数播放wav文件，然后将控制立即转移到应用程序中，而不管对wav文件的播放是否结束。
End Sub

Public Sub Gdata(i As Integer, j As Integer, xnow As Integer, ynow As Integer)
    With GImage(i, j)
        .xnow = xnow
        .ynow = ynow
    End With
End Sub

Public Sub Sdata(i As Integer, j As Integer, xin As Integer, yin As Integer, xnow As Integer, ynow As Integer)
    With GImage(i, j)
        .xin = xin
        .yin = yin
        .xnow = xnow
        .ynow = ynow
    End With
End Sub