VB到底能用来做什么？初学者问！

看多些时候就明的了。VB比较容易，只要有恒心就行。用VB如果你会的话想做什么就可以做什么！！！！

包括可视的OCX控件和ActiveX DLL EXE。
例如，新建一个ActiveX DLL project,在类中建立一个Public的函数，编译为DLL。（在别的机器使用需regsvr32手工注册）在别的项目里就可以引用这个对象，并使用这个方法。

Option Explicit
'=================    player1   0
'    |      |
'=================    player2   0
'    |      |
'=================       newgame
'    |      |
'=================       exit
'
'
'上面是一个游戏界面的构造图,这个游戏广东话叫<井字过三关>,下面介绍它的组件.
'用line和label控件作出左图，9个方格是label可以显示叉和圈。
'player1,player2,0,0都是label;newgame,exit 是按钮.
'
'\1\界面讲完,我们来看代码,查看代码,应该先由通用区开始.这里讲名有3个变量.
Dim bytPlayerTurn As Byte '0 = No Game, 1 = Player One, 2 = Player Two
Dim intP1Score As Integer
Dim intP2Score As IntegerPrivate Sub cmdNewGame_Click()
'\3\newgame按钮按下时触发事件过程,这里我们调用一个startgame子过程,转到子过程看看有什么东西.
StartGame
End SubPrivate Sub Form_Load()
'\2\程序入口点应从这里,这里我们知道他把3个变量清零.
'//Initialize the variables
bytPlayerTurn = 0 'No Game started
intP1Score = 0
intP2Score = 0
End SubPrivate Sub StartGame()
'//游戏的开始
Dim X As Long
'//清除之前的游戏,9个label,显示清空,注意这里9个label是1个对象数组.
For X = 0 To 8
    lblSquare(X).Caption = ""
Next X
'//轮到玩家1下棋
bytPlayerTurn = 1
End SubPrivate Sub lblSquare_Click(Index As Integer)
'//输入X或O时，先检测
If bytPlayerTurn = 0 Then
    '//没有游戏
    MsgBox "Sorry, no game is in progress at this time!"
    Exit Sub '//如果bytplayerturn=0,退出这个进程
End If'//轮到谁了?
If bytPlayerTurn = 1 Then
    '//如果轮到player1
    '//检测格子是否已经被下了棋子。
    If lblSquare(Index).Caption <> "" Then
        MsgBox "Sorry, this spot is already taken!"
        Exit Sub
    End If

    '//填入X
    lblSquare(Index).Caption = "X"

    '//检查是否已经获胜
    If CheckWin("X") = True Then
        '//CheckWin（）是个函数，最下边有定义。
        MsgBox "Player One is the winner!"
        intP1Score = intP1Score + 1
        lblP1Score.Caption = intP1Score
        bytPlayerTurn = 0 '//两个变量完成记分操作。
        Exit Sub
    End If
    '//如果没获胜，则轮到player2.
    bytPlayerTurn = 2
ElseIf bytPlayerTurn = 2 Then

    '//同样检查格子是否已经被下过棋了。
    If lblSquare(Index).Caption <> "" Then
        MsgBox "Sorry, this spot is already taken!"
        Exit Sub
    End If

    '//填入O
    lblSquare(Index).Caption = "O"

    '//查看是否已经获胜。
    If CheckWin("O") = True Then
        '//
        MsgBox "Player Two is the winner!"
        intP2Score = intP2Score + 1
        lblP2Score.Caption = intP2Score
        bytPlayerTurn = 0 '//两个变量完成记分操作。
        Exit Sub
    End If
    '//如果没有获胜，将用来轮回的变量置1.
    bytPlayerTurn = 1
End If
End SubPrivate Function CheckWin(strLetter As String) As Boolean
'//
'//第一行相同时
If lblSquare(0).Caption = strLetter And lblSquare(1).Caption = strLetter And lblSquare(2).Caption = strLetter Then
    CheckWin = True
    Exit Function
End If'//第二行相同时
If lblSquare(3).Caption = strLetter And lblSquare(4).Caption = strLetter And lblSquare(5).Caption = strLetter Then
    '//Win!!
    CheckWin = True
    Exit Function
End If'//第三行相同时
If lblSquare(6).Caption = strLetter And lblSquare(7).Caption = strLetter And lblSquare(8).Caption = strLetter Then
    '//Win!!
    CheckWin = True
    Exit Function
End If'//。
If lblSquare(0).Caption = strLetter And lblSquare(3).Caption = strLetter And lblSquare(6).Caption = strLetter Then
    '//Win!!
    CheckWin = True
    Exit Function
End If'//。
If lblSquare(1).Caption = strLetter And lblSquare(4).Caption = strLetter And lblSquare(7).Caption = strLetter Then
    '//Win!!
    CheckWin = True
    Exit Function
End If'//。
If lblSquare(2).Caption = strLetter And lblSquare(5).Caption = strLetter And lblSquare(8).Caption = strLetter Then
    '//Win!!
    CheckWin = True
    Exit Function
End If'//。。
If lblSquare(0).Caption = strLetter And lblSquare(4).Caption = strLetter And lblSquare(8).Caption = strLetter Then
    '//Win!!
    CheckWin = True
    Exit Function
End If'//。。
If lblSquare(2).Caption = strLetter And lblSquare(4).Caption = strLetter And lblSquare(6).Caption = strLetter Then
    '//Win!!
    CheckWin = True
    Exit Function
End If'//。
CheckWin = False
End Function
'//其实除了可以定义一个2唯数组，即A[n*n]矩阵，同行，同列，对角线就能获胜。

visual basic游戏编程
说明
这里我们接触到笨厚的win32 api，不难注意继续往下读。开始实践
这里我做了一个太空飞机的例子，游戏虽小，可是我做了3个小时。
原代码附有注释，注意查看。一、BitBlt
什么是BitBlt?
BitBlt是win32 GDI图形复制绘出函数,类似的还有StretchBlt，但是我门这里不需要它。下面我地分析泥个函数。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 LonghDestDC - （图片来自的）目的设备，例如：frmMain.hdc/picGame.hdcX,Y - 图片左上角逻辑坐标定位。不是绝对坐标，因此叫逻辑****nWidth,nHeight - 绘出图片的尺寸hSrcDC -源设备xSrc,ySrc -(被复制的图片）原来的逻辑坐标，同样是左上角那点来确定。
dwRop - 这个叫什么我不太清楚，具体功能是复制图片后，稍微作修改的选项，原文叫复制模式（copy mode),这里我自己族个试左下SRCCOPY:复制所有东西.SRCAND:复制所有东西，除了白色。SRCPAINT:除了黑色。SRCINVERT:变换颜色。贴士
我们应该注意到，BitBlt是个函数，它会有返回值的，这里如果返回值《=0的话，则函数操作失败。写代码时注意这个可能性。[Code Start]Dim RetVal as long RetVal = BitBlt(frmMain.hdc,0,0,640,480,picLogo.hdc,0,0,SRCCOPY) If RetVal = 0 Then             MsgBox “BitBlt has failed!”            Exit Sub/FunctionEnd If[Code Stop]特别的技巧
有时我地需要复制图片的背景，然后改变背景颜色。我地知道一般图片的背景都是白色的，用SRCAND巧妙的选中了白色，逻辑坐标都不改变，因为我地要改变这些背景的颜色。用SRCINVERT换色。
[Code Start]BitBlt frmMain.hdc,0,0,640,480,picLogo.hdc,0,0,SRCANDBitBlt frmMain.hdc,0,0,640,480,picLogoMask.hdc,0,0,SRCINVERT[Code Stop]二、GetASyncKeyState
这个函数很更加简单，这里我地不用Form_keyPress/KeyDown/KeyUp事件，而用这个函数更容易地完成按键捕获。
函数原形：
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
vKey - 检测你输入一个按键[Code Start]
Dim btnDown as BooleanbtnDown = GetAsyncKeyState(vbKeyDown)If btnDown = True Then ‘//如果这个键被按下            ‘//符合这个条件的代码Else            ‘//符合这个条件的代码End If
[Code Stop]三、SndPlaySound
这个函数也非常简单，不过有一个小问题，系标识常量（flags)使用到。好，我地衣家来体下泥个函数。
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As LongLpszSoundName = wave文件名 UFlags - 标识常量    SND_ASYNC - &H1 播放新的音乐，然后中断其他    SND_LOOP - &H8 循环播放    SND_NODEFAULT - &H2 如果改文件不存在，就不做任何事    SND_SYNC - &H0 程序不控制直到播完    SND_NOSTOP - &H10 如果已经有个文件正在播放，则不播放（术语叫不中断）[Code Start]sndPlaySound App.Path & “\Audio\Sound.wav”, SND_ASYNC or SND_NODEFAULT[Code Stop]四、IntersectRect
什么是IntersectRect,MSDN是这么解释的：这个函数在lpDestRect里载入一个矩形，它是lpSrc1Rect与lpSrc2Rect两个矩形的交集。说得那么复杂，我举个例子吧，玩家的飞机和电脑的敌机相遇时即相交时，玩家的飞机就坠毁,明白了吗？
废话少讲，我们来了解这个函数原形：Public Declare Function IntersectRect Lib "user32" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT) As LonglpDestRect - 目的集合，Rect你可以当作它是一个矩形、集合，后面再讲
lpSrc1Rect - 集合1
lpSrc3Rect - 集合2[Code Start]
‘//建立临时集合、玩家集合、电脑集合；几个尺寸坐标变量
Dim tmpRECT as RECT
Dim PlayerX as Integer, PlayerY As Integer
Dim CompX As Integer, CompY as Integer
Dim PlayerRect as RECT, CompRect As RECT
‘//我地假设尺寸  玩家50x50 电脑50x50‘//createrect 是我写的一个帮助函数用来建立Rects.PlayerRect = CreateRect(PlayerX, PlayerY, PlayerX +50, PlayerY + 50)CompRect = CreateRect(CompX,CompY,CompX + 50, CompY + 50) If IntersectRect(tmpRECT,PlayerRect,CompRect) = True Then ‘//如果两个集合相交            ‘//符合条件则。。代码。。
End If
[Code Stop]五、其他API函数使用。
如果你对API感兴趣的话，可以下载电子版的API书籍看看，最好有实例的那种，记得有本叫〈常用API函数应用实例〉的电子书，以前在嬴政天下论坛到非常偶然地下到的。六、结束语
通过上边的技巧，你可以建立一个2D的游戏，当然比我这个要好，说实话我VB的实力实在比较烂，30文买了本烂书回来，3天看完了，发现会了语法之外，什么事情都不会做。结果看到我朋友的<VB实例教程〉120￥之后，就发现他妈的，真是一分钱一分货，可是借阅5天后被回收了。《太空战士》原码，虽然抄了书上不少代码，还是花3个小时才做了出了。汗流了一把

原码：
主要包括主窗口和选择飞机的窗口，3个小模块。
主窗口：
Option Explicit
'//ALL STAR FIELD STUFF
'//for our starfield
Private Type udtStar
    X As Integer
    Y As Integer
    Z As Single '//distance from us(aka drawwidth AND how fast it goes past us)
    Taken As Boolean
End Type'//constants
Private Const NUM_MAX_STARS = 50
Private Stars(NUM_MAX_STARS - 1) As udtStar 'starfield'//FPS
Private FrameCounter As Integer
Private FPSTimer As Long
Private FPS As IntegerPrivate Sub GetFPS()
If GetTickCount >= (FPSTimer + 1000) Then
    FPS = FrameCounter
    FrameCounter = 0
    FPSTimer = GetTickCount
Else
    FrameCounter = FrameCounter + 1
End IffrmMain.Caption = "Asteroids running at " & FPS & " frames per second"
End SubPrivate Sub InitStars()
Dim X As LongFor X = 0 To NUM_MAX_STARS - 1
    Stars(X).Taken = True
    Stars(X).X = Int(Rnd * picGame.Width)
    Stars(X).Y = Int(Rnd * picGame.Width)
    Stars(X).Z = Int(Rnd * 5) + 1
Next X
End SubPrivate Sub DoStars()
Dim X As LongFor X = 0 To NUM_MAX_STARS - 1
    If Stars(X).Taken = False Then
        Stars(X).Taken = True
        Stars(X).X = Int(Rnd * picGame.Width)
        Stars(X).Y = 0
        Stars(X).Z = Int(Rnd * 5) + 1
    Else
        DrawWidth = 1
        Stars(X).Y = Stars(X).Y + Stars(X).Z
        picGame.PSet (Stars(X).X, Stars(X).Y), vbWhite
        If Stars(X).Y > picGame.Height Then
            Stars(X).Taken = False
        End If
    End If
Next X
End SubPublic Sub MainLoop()
'//tmp time
Dim tmpTime As Long'//Initialize Game Data and graphics
InitStars 'Star field
InitSurfaces 'graphics
Pilot.X = (picGame.Width / 2) - (bbsShips(Pilot.PilotShip).Width / 2)
Pilot.Y = picGame.Height - bbsShips(Pilot.PilotShip).Height
Pilot.BulletDelay = 100
tmrLevel.Enabled = True
ReDim Asteroids((Pilot.PilotLevel * 5) - 1)
Do While GameRunning = 1 Or GameRunning = 2
    tmpTime = timeGetTime()

    If GameRunning = 1 Then
        '//clear the screen
        BitBlt bbsBackbuffer.hdc, 0, 0, picGame.Width, picGame.Height, bbsBackbuffer2.hdc, 0, 0, SRCCOPY

        DoStars '//update all the stars
        DoPilot '//update our pilot
        DoAsteroids '//update our asteroids
        DoBullets 'update our bullets
        '//blt backbuffer to main hdc
        BitBlt ScreenHDC, 0, 0, picGame.Width, picGame.Height, bbsBackbuffer.hdc, 0, 0, SRCCOPY

        '//check for deaths
        If Pilot.PilotHealth <= 0 Then
            '//any live left?
            If Pilot.PilotLevel > 0 Then
                Pilot.PilotLevel = Pilot.PilotLevel - 1
            End If
            GameRunning = 0
            lblLose.Visible = True
        End If
        '//set form data
        lblHealth.Caption = Pilot.PilotHealth
        lblScore.Caption = Pilot.PilotScore
        lblLives.Caption = Pilot.PilotLives
        lblLevel.Caption = Pilot.PilotLevel
        GetFPS
    End If
    '//frame cap limiter
    Do Until timeGetTime >= tmpTime + 30
    Loop
    DoEvents
LoopEnd SubPrivate Sub Form_Load()
'//global variable for picGame.HDC, easier use
ScreenHDC = picGame.hdc
mpMIDI.FileName = App.Path & "\Audio\Theme1.mid"
mpMIDI.Play
End SubPrivate Sub Form_Unload(Cancel As Integer)
'//clear memory of all Device Contexts created
modEngine.DestroyHdcs
End SubPrivate Sub lblHealth_Click()
Pilot.PilotHealth = Pilot.PilotHealth + 1000
End SubPrivate Sub mnuNew_Click()
lblLose.Visible = False
Pilot.PilotName = InputBox("What is your Pilot's Name?", "Asteroids!")
If Pilot.PilotName <> "" Then
    frmShipChoose.Show
End If
End SubPrivate Sub mnuTheme1_Click()
mpMIDI.Stop
mpMIDI.FileName = App.Path & "\Audio\Theme1.mid"
mpMIDI.Play
End SubPrivate Sub mnuTheme2_Click()
mpMIDI.Stop
mpMIDI.FileName = App.Path & "\Audio\Theme2.mid"
mpMIDI.Play
End SubPrivate Sub tmrLevel_Timer()
Randomize Timer
Pilot.PilotLevel = Pilot.PilotLevel + 1
ReDim Preserve Asteroids((Pilot.PilotLevel * 5) - 1)
Me.BackColor = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
End Sub选择飞机的窗口：
Option ExplicitPrivate Sub imgShip_Click(Index As Integer)
If MsgBox("Are you sure you want this ship?", vbYesNo) = vbYes Then
    Pilot.PilotShip = Index
    Pilot.PilotHealth = 100
    Pilot.PilotLives = 3
    Pilot.PilotLevel = 1
    Pilot.PilotScore = 0
    Pilot.Strength = Val(lblStr(Index).Caption)
    Pilot.Defense = Val(lblDef(Index).Caption)
    Pilot.Speed = Val(lblSpeed(Index).Caption)
    Pilot.ShipHeight = Val(lblHeight(Index).Caption)
    Pilot.ShipWidth = Val(lblWidth(Index).Caption)
    frmMain.Enabled = True
    Me.Hide
    GameRunning = 1
    frmMain.MainLoop
End If
End Sub

啊，这么长啊，谢谢!!!!!我在看，，，，还有么，GO ON

调试易

VB到底能用来做什么？初学者问！

解决方案 »