gamestuf.bas

采用VB6编制的小小程序

Attribute VB_Name = "GAMESTUF"
Option Explicit
'--------------------------------------------------
' Global variables, constants and declaration.
'--------------------------------------------------

'Area Data type
Type tArea
    hdc As Long
    left As Integer
    top As Integer
    Width As Integer
    Height As Integer
End Type


' Sprite data type look at LadyB_init for meanings
Type tSprite
    Active As Integer
    doing As Integer
    ident As Integer
    left As Integer
    top As Integer
    Width As Integer
    Height As Integer
    Sprx As Integer
    Spry As Integer
    mapx As Integer
    mapy As Integer
    XSpeed As Integer
    YSpeed As Integer
    XDir As Integer
    Ydir As Integer
    src As tArea
    bkg As tArea
    mask As tArea
    End Type


' Color Constants
Global Const DARK_GRAY = &H808080
Global Const WHITE = &HFFFFFF
Global Const BLACK = &H0

' KeyCode constants
Global Const KEY_LEFT = 37
Global Const KEY_RIGHT = 39
Global Const KEY_UP = 38
Global Const KEY_DOWN = 40
Global Const KEY_SPACE = 32


' Windows GDI Bitmap API constants and functions
Global Const SRCCOPY = &HCC0020
Global Const SRCINVERT = &H660046
Global Const SRCPAINT = &HEE0086
Global Const SRCAND = &H8800C6
Public Const SRCERASE = &H440328

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 Integer
Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

'Keyboard Functions and constants
Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Const SPI_GETKEYBOARDDELAY = 22
Public Const SPI_GETKEYBOARDSPEED = 10
Public Const SPI_SETKEYBOARDDELAY = 23
Public Const SPI_SETKEYBOARDSPEED = 11

Dim OldKeySpeed As Long
Dim OldKeyDelay As Long
Sub SetFastKeyboard()
Dim Retcode As Long
Dim FastKeySpeed As Long
Dim FastKeyDelay As Long
FastKeySpeed = 31
FastKeyDelay = 0
Retcode = SystemParametersInfo(SPI_GETKEYBOARDSPEED, 0, OldKeySpeed, 0)
Retcode = SystemParametersInfo(SPI_GETKEYBOARDDELAY, 0, OldKeyDelay, 0)
Retcode = SystemParametersInfo(SPI_SETKEYBOARDSPEED, 0, FastKeySpeed, 0)
Retcode = SystemParametersInfo(SPI_SETKEYBOARDDELAY, 0, FastKeyDelay, 0)
End Sub
Sub RestoreKeyboard()
Dim Retcode As Long
Retcode = SystemParametersInfo(SPI_SETKEYBOARDSPEED, 0, OldKeySpeed, 0)
Retcode = SystemParametersInfo(SPI_SETKEYBOARDDELAY, 0, OldKeyDelay, 0)
End Sub