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

[starmyllove]

我看这方面的书有一些时候了，但是我还是不明白它是什么的，我也看了好多贴子，
但是我看不太懂，请帮我一下，给一个简单一点的程序，发到16081385@163。com里，想学，非常想，谢谢，，加QQ16081385，非常感谢您的指导。

[ksmark]

1、快速开发数据库发面的软件。
2、串口编程（eg.做考勤打卡...)
3、网络通讯
....

[hcj2002]

不要问能做什么，应该问你学会了没有?

[ksmark]

上手很简单，但是学精可要花一番功夫哦！
友情提醒！

[chen9771]

能想到就能做到

[realmayer7903]

不应该问能做什么
而应该问 不能做什么

vb除了不能直接做与硬件相关的操作外，什么都可以

[starmyllove]

能不能具体到一个简单一点的程序,然后解释一下啊!

[viena]

VB的优势在做Com组件

[viena]

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

[flyingZFX]

继续，继续，大家继续....

[starmyllove]

我是初学者,就想简单的,,但有用的!好吧!

[starmyllove]

能不能做一个,我自己的浏览器,我要怎么做!

[dknight2]

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 Integer

Private Sub cmdNewGame_Click()
'\3\newgame按钮按下时触发事件过程,这里我们调用一个startgame子过程,转到子过程看看有什么东西.
StartGame
End Sub

Private Sub Form_Load()
'\2\程序入口点应从这里,这里我们知道他把3个变量清零.
'//Initialize the variables
bytPlayerTurn = 0 'No Game started
intP1Score = 0
intP2Score = 0
End Sub

Private 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 Sub

Private 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 Sub

Private 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]矩阵，同行，同列，对角线就能获胜。

[dknight2]

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 Long

hDestDC - （图片来自的）目的设备，例如：frmMain.hdc/picGame.hdc

X,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/Function

End If

[Code Stop]

特别的技巧
有时我地需要复制图片的背景，然后改变背景颜色。我地知道一般图片的背景都是白色的，用SRCAND巧妙的选中了白色，逻辑坐标都不改变，因为我地要改变这些背景的颜色。用SRCINVERT换色。
[Code Start]

BitBlt frmMain.hdc,0,0,640,480,picLogo.hdc,0,0,SRCAND

BitBlt 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 Boolean

btnDown = 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 Long

LpszSoundName = 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 Long

lpDestRect - 目的集合，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个小时才做了出了。汗流了一把

[dknight2]

原码：
主要包括主窗口和选择飞机的窗口，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 Integer

Private Sub GetFPS()
If GetTickCount >= (FPSTimer + 1000) Then
FPS = FrameCounter
FrameCounter = 0
FPSTimer = GetTickCount
Else
FrameCounter = FrameCounter + 1
End If

frmMain.Caption = "Asteroids running at " & FPS & " frames per second"
End Sub

Private Sub InitStars()
Dim X As Long

For 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 Sub

Private Sub DoStars()
Dim X As Long

For 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 Sub

Public 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
Loop

End Sub

Private Sub Form_Load()
'//global variable for picGame.HDC, easier use
ScreenHDC = picGame.hdc
mpMIDI.FileName = App.Path & "\Audio\Theme1.mid"
mpMIDI.Play
End Sub

Private Sub Form_Unload(Cancel As Integer)
'//clear memory of all Device Contexts created
modEngine.DestroyHdcs
End Sub

Private Sub lblHealth_Click()
Pilot.PilotHealth = Pilot.PilotHealth + 1000
End Sub

Private 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 Sub

Private Sub mnuTheme1_Click()
mpMIDI.Stop
mpMIDI.FileName = App.Path & "\Audio\Theme1.mid"
mpMIDI.Play
End Sub

Private Sub mnuTheme2_Click()
mpMIDI.Stop
mpMIDI.FileName = App.Path & "\Audio\Theme2.mid"
mpMIDI.Play
End Sub

Private 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 Explicit

Private 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

[射天狼]

什么都能做,不能做的东西只是我们不会用而已!!

[etcom007]

UP

[bjskyhorse]

很多了，数据库，界面，甚至有通讯，还有图形处理。

[ljfwarrior]

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

[hhyttppd]

只有想不到,没有做不到.

[starmyllove]

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