摄像头VB源程序
'实现USB摄像头视频图像的监控、截图、录像
'本程序是“摄像头视频监控”的改进，仅用四个按钮实现对摄像头视频的监控、截图、录像，可以分别保存为图片文件和视频文件。保存的视频文件可以用媒体播放机（Windows Media Player）、暴风影音等软件进行播放，轻松实现家庭录像制作。
'利用电脑配备的 USB 摄像头进行视频控制，要用到两个 API 函数：capCreateCaptureWindow 和SendMessage。'capCreateCaptureWindow 的作用是创建一个视频窗口，摄像头捕捉到的视频图像在此窗口内显示，函数返回值就是代表此窗口的句柄。
'此函数的 VB 声明：
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal nID As Long) As Long
Dim ctCapWin As Long
各参数意义如下:
lpszWindowName 视频窗口的窗口标题
dwStyle 窗口模式，设置值可用下面数值，也可组合使用：
WS_Child：视频窗口是子窗口，位于应用程序主窗口内。否则是独立的窗口。
WS_Visible: 视频窗口可见
WS_Caption: 视频窗口有标题栏
WS_ThickFrame: 视频窗口有边框
X 视频窗口位置x坐标
Y 视频窗口位置y坐标
nWidth 视频窗口宽度
nHeight 视频窗口高度
hwndParent 创建视频窗口的主窗口，设置为：Me.hWnd
nID 视频ID
视频窗口创建后，剩下的事情就是用 SendMessage 向该窗口发送各种消息，实现对摄像头的控制。
' '以下是完整代码，在 VB6 和 WindowsXP 下调试通过：
'在窗体放置4个控件：Command1、Command2、Command3、Command4
'程序调试时要注意：终止程序要用运行中的 Form1 窗口关闭。不要使用 VB 主窗口的菜单命令或 VB 工具栏上的关闭按钮，这样无法关闭打开的视频窗口，导致 VB 无响应。如果 VB 无响应，只有用系统任务管理器才能终止 VB 进程，调试过程中所做的修改将丢失。
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal nID As Long) As Long
Dim ctCapWin As Long, ctAviPath As String, ctPicPath As String, ctConnect As Boolean
'视频窗口控制消息常数
Const WS_Child = &H40000000: Const WS_Visible = &H10000000
Const WS_Caption = &HC00000: Const WS_ThickFrame = &H40000
Const WM_User = &H400 '用户消息开始号
Const WM_CAP_Connect = WM_User + 10 '连接一个摄像头
Const WM_CAP_DisConnect = WM_User + 11 '断开一个摄像头的连接
Const WM_CAP_Set_PreView = WM_User + 50 '使预览模式有效或者失效
Const WM_CAP_Set_Overlay = WM_User + 51 '使窗口处于叠加模式，也会自动地使预览模式失效。
Const WM_CAP_Set_PreViewRate = WM_User + 52 '设置在预览模式下帧的显示频率
Const WM_CAP_Edit_Copy = WM_User + 30 '将当前图像复制到剪贴板
Const WM_CAP_Sequence = WM_User + 62 '开始录像，录像未结束前不会返回。
Const WM_Cap_File_Set_File = WM_User + 20 '设置当前的视频捕捉文件
Const WM_Cap_File_Get_File = WM_User + 21 '得到当前的视频捕捉文件
Private Sub Form_Load()
'设置按钮及位置，实际可以在控件设计期间完成
Dim H1 As Long
Me.Caption = "摄像头控制"
Command1.Caption = "连接": Command1.ToolTipText = "连接摄像头"
Command2.Caption = "断开": Command2.ToolTipText = "断开与摄像头的连接"
Command3.Caption = "截图": Command3.ToolTipText = "将当前图像保存为图片文件"
Command4.Caption = "录像": Command4.ToolTipText = "开始录像，保存为视频文件"
H1 = Me.TextHeight("A")
Command1.Move H1 * 0.5, H1 * 0.5, H1 * 4, H1 * 2
Command2.Move H1 * 5, H1 * 0.5, H1 * 4, H1 * 2
Command3.Move H1 * 10, H1 * 0.5, H1 * 4, H1 * 2
Command4.Move H1 * 15, H1 * 0.5, H1 * 4, H1 * 2
'读出用户设置
Call ReadSaveSet
KjEnabled True
End Sub
Private Sub Command1_Click()
'创建视频窗口和连接摄像头
Dim nStyle As Long, T As Long
If ctCapWin = 0 Then '创建一个视频窗口，大小：640*480
T = Me.ScaleY(Command1.Top + Command1.Height * 1.1, Me.ScaleMode, 3) '视频窗口垂直位置：像素
'nStyle = WS_Child + WS_Visible + WS_Caption + WS_ThickFrame '子窗口(在Form1内)+可见+标题栏+边框
nStyle = WS_Child + WS_Visible '视频窗口无标题栏和边框
'nStyle = WS_Visible '视频窗口为独立窗口，关闭主窗口视频窗口也会自动关闭
ctCapWin = capCreateCaptureWindow("我创建的视频窗口", nStyle, 0, T, 640, 480, Me.hWnd, 0)
End If
'将视频窗口连接到摄像头，如无后面两条语句视频窗口画面不会变化
SendMessage ctCapWin, WM_CAP_Connect, 0, 0 '连接摄像头
SendMessage ctCapWin, WM_CAP_Set_PreView, 1, 0 '第三个参数：1-预览模式有效,0-预览模式无效
SendMessage ctCapWin, WM_CAP_Set_PreViewRate, 30, 0 '第三个参数：设置预览显示频率为每秒 30 帧
ctConnect = True: KjEnabled True
'"请检检查摄像头连接，并确定没有其他用户和程序使用。"
End Sub
Private Sub Command2_Click()
SendMessage ctCapWin, WM_CAP_DisConnect, 0, 0 '断开摄像头连接
ctConnect = False: KjEnabled True
End Sub
Private Sub Command3_Click()
'截图,保存为图片文件
Dim F As String, S As Long, nPath As String, nStr As String
nPath = Trim(ctPicPath)
If nPath = "" Then nPath = App.Path & "\MyPic"
If Right(nPath, 1) <> "\" Then nPath = nPath & "\"
On Error Resume Next
Do
S = S + 1
F = nPath & "MyPic-" & S & ".bmp"
If Dir(F, 23) = "" Then Exit Do
Loop
On Error GoTo 0
nStr = Trim(InputBox("设置图片保存的文件名:", "保存图片", F))
If nStr = "" Then Exit Sub
Call CutPathFile(nStr, nPath, F) '分解出文件和目录
If Not MakePath(nPath) Then
MsgBox "在指定的位置无法建立目录：" & vbCrLf & nPath, vbInformation, "保存图片文件"
Exit Sub
End If
ctPicPath = nPath: F = nPath & F
If Dir(F, 23) <> "" Then
If vbCancel = MsgBox("文件已存在，覆盖此文件吗？" & vbCrLf & F, vbInformation + vbOKCancel, "截图 - 文件覆盖") Then Exit Sub
On Error GoTo Cuo
SetAttr F, 0
Kill F
On Error GoTo 0
End If
Clipboard.Clear: SendMessage ctCapWin, WM_CAP_Edit_Copy, 0, 0 '将当前图像复制到剪贴板
SavePicture Clipboard.GetData, F '保存为 Bmp 图像，要保存为 jpg 格式，参见：将图片保存或转变为JPG格式
Exit Sub
Cuo:
MsgBox "无法写文件：" & vbCrLf & F, vbInformation, "保存文件"
End Sub
Private Sub Command4_Click()
'用摄像头录像，并保存为视频文件
'如果不设置文件路径和名称，或路径不存在，视频窗口会使用默认文件名 C:\CAPTURE.AVI
Dim F As String, S As Long, nPath As String, nStr As String
nPath = Trim(ctAviPath)
If nPath = "" Then nPath = App.Path & "\MyVideo"
If Right(nPath, 1) <> "\" Then nPath = nPath & "\"
On Error Resume Next
Do
S = S + 1
F = nPath & "MyVideo-" & S & ".avi"
If Dir(F, 23) = "" Then Exit Do
Loop
On Error GoTo 0
nStr = Trim(InputBox("设置录像保存的文件名:", "录像保存的文件名", F))
If nStr = "" Then Exit Sub
Call CutPathFile(nStr, nPath, F) '分解出文件和目录
If Not MakePath(nPath) Then
MsgBox "在指定的位置无法建立目录：" & vbCrLf & nPath, vbInformation, "保存文件" Exit Sub
End If
ctAviPath = nPath: F = nPath & F
If Dir(F, 23) <> "" Then
If vbCancel = MsgBox("文件已存在，覆盖此文件吗？" & vbCrLf & F, vbInformation + vbOKCancel, "视频 - 文件覆盖") Then Exit Sub
On Error GoTo Cuo
SetAttr F, 0
Kill F
On Error GoTo 0
End If
Me.Caption = "摄像头控制 - 正在录像（任意位置单击鼠标停止）": KjEnabled False: DoEvents
SendMessage ctCapWin, WM_Cap_File_Set_File, 0, ByVal F '设置录像保存的文件
SendMessage ctCapWin, WM_CAP_Sequence, 0, 0 '开始录像。录像未结束前不会返回
Me.Caption = "摄像头控制": KjEnabled True
Exit Sub
Cuo:
MsgBox "无法写文件：" & vbCrLf & F, vbInformation, "保存文件"
Private Function CutPathFile(nStr As String, nPath As String, nFile As String) '分解出文件和目录
Dim I As Long, S As Long
For I = 1 To Len(nStr)
If Mid(nStr, I, 1) = "\" Then S = I '查找最后一个目录分隔符
Next
If S > 0 Then
nPath = Left(nStr, S): nFile = Mid(nStr, S + 1)
Else
nPath = "": nFile = nStr
End If
End Function
Private Function MakePath(ByVal nPath As String) As Boolean
'逐级建立目录,成功返回 T
Dim I As Long, Path1 As String, IsPath As Boolean
nPath = Trim(nPath)
If Right(nPath, 1) <> "\" Then nPath = nPath & "\"
On Error GoTo Exit1
For I = 1 To Len(nPath)
If Mid(nPath, I, 1) = "\" Then
Path1 = Left(nPath, I - 1)
If Dir(Path1, 23) = "" Then
MkDir Path1
Else
IsPath = GetAttr(Path1) And 16
If Not IsPath Then Exit Function '有一个同名的文件
End If
End If
Next
MakePath = True: Exit Function
Exit1:
End Function
Private Sub Form_Unload(Cancel As Integer)
Call ReadSaveSet(True) '保存用户设置
End Sub
Private Sub KjEnabled(nEnabled As Boolean)
If nEnabled Then
Command1.Enabled = Not ctConnect: Command2.Enabled = ctConnect
Command3.Enabled = ctConnect: Command4.Enabled = ctConnect
Else
Command1.Enabled = nEnabled: Command2.Enabled = nEnabled
Command3.Enabled = nEnabled: Command4.Enabled = nEnabled
End If
Private Sub ReadSaveSet(Optional IsSave As Boolean)
'保存或读出用户设置的图片和视频默认保存目录
Dim nKey As String, nSub As String
nKey = "摄像头控制程序": nSub = "UserOpt"
If IsSave Then
SaveSetting nKey, nSub, "AviPath", ctAviPath
SaveSetting nKey, nSub, "PicPath", ctPicPath
Else
ctAviPath = GetSetting(nKey, nSub, "AviPath", "") ctPicPath = GetSetting(nKey, nSub, "PicPath", "") End If
End Sub
VB常用算法
常用算法 1.判断素数 素数是指只能被1与自己整除的数是素数,最小的素数是2,如3，5，7等都是素数判断方法一: Private Function Prime(N As Integer)As Boolean Dim i As Integer For i=2 To N-1(或sqr(N)或N\2) If N Mod i=0 Then Exit For Next i (或N/i=Int(N/i)) If i=N Then Prime=True End Function 判断方法二: Private Function Prime(N As Integer)As Boolean Dim i As Integer For i=2 To N-1 If N Mod i=0 Then Exit Function Next i Prime=True End Function (2)求最大公约数(欧几里德算法,辗转相除法) 最大公约数是指两个数最大的公约数 Private Function Gcd(byval m As Integer,ByVal n As Integer)As Integer Dim r As Integer r=m Mod n Do while r<>0 m=n n=r r=m Mod n Loop Gcd=n End Function 利用递归实现判断最大公约数 Private Function Gcd(ByVal m As Integer,ByVal n As Integer)As Integer Dim r As Integer r=m Mod n If r=0 Then Gcd=n ELse M=n n=r Gcd=Gcd(m,n) End If
VB6.0的小程序计算器
VB6.0的小程序计算器 对于刚入门学习VB6的朋友来说肯定会做些小程序吧，这里就是给大家演示个简单的计算器程序，仅供参考啦。 界面上加减乘除四个按钮分别是cmdAdd、cmdPlus、cmdMultiple、cmdDevide，小数点按钮是cmdDot，负号按钮是cmdMinuse，数字0～9为了偷懒，用了控件数组cmdNumber(0)~ cmdNumber(9)，上面txtShow是显示数字和结果用的，txtOperate是显示中间步骤的。 思路大致是这样，点加减乘除这类操作符的时候，把当前txtShow的值保存在模块变量mstrParam1里，同时把操作符保存到mstrOperate里，按等于号时把先把当前txtShow的值保存在模块变量mstrParam2里，然后对mstrParam1和mstrParam2进行运算，当然要记得设法把String转换成数值进行运算。 转换的过程要注意，这里是用的Variant数据类型，vParam1和vParam2都是Variant 类型，保存的是mstrParam1和mstrParam2的数值。之所以不用integer、long、double 这些标准类型，是因为这些类型都有大小限制，做出来用着不方便，VB最大的整型long才到 2147483647，这意味着计算器的计算结果只能限制在9位到10位。而Variant类型可以支持非常大的数，具体多大不清楚，但起码几十位是能够支持的。另外，最后算完的结果也要做格式化，因为如果数值非常大的话，VB会自动转成科学计数法，所以要用Format函数进行调整。 如果需要源代码的话在我百度空间里留言。https://www.wendangku.net/doc/e112234867.html,/zhaozhigang517
VB程序设计的常用算法填空题
VB程序设计的常用算法 例：用随机函数产生100个[0，99]范围内的随机整数，统计个位上的数字分别为1，2，3，4，5，6，7，8，9，0的数的个数并打印出来。 将程序编写在一个GetTJput过程中，代码如下： Public Sub GetTJput() Dim a(1 To 100) As Integer Dim x(1 To 10) As Integer Dim i As Integer, p As Integer '产生100个[0，99]范围内的随机整数，每行10个打印出来 For i = 1 To If a(i) < 10 Then Form1.Print Space(2); a(i); Else Form1.Print Space(1); a(i); End If If Then Next i '统计个位上的数字分别为1，2，3，4，5，6，7，8，9，0的数的个数，并将统计结果保存在数组x(1),x(2),...,x(10)中，将统计结果打印出来For i = 1 To 100 p = a(i) Mod 10 ' 求个位上的数字 If p = 0 Then p = 10 Next i Form1.Print "统计结果" For i = 1 To 10 p = i If i = 10 Then p = 0 Form1.Print "个位数为" + Str(p) + "共" + Str(x(i)) + "个" Next i End Sub 二、求两个整数的最大公约数、最小公倍数 m=inputBox("m=") n=inputBox("n=") nm=n*m If m < n Then r=m mod n Do While m=n n=r
VB常用算法介绍
常用算法介绍 VB 算法（Algorithm）：计算机解题的基本思想方法和步骤。算法的描述：是对要解决一个问题或要完成一项任务所采取的方法和步骤的描述，包括需要什么数据（输入什么数据、输出什么结果）、采用什么结构、使用什么语句以及如何安排这些语句等。通常使用自然语言、结构化流程图、伪代码等来描述算法。 一、计数、求和、求阶乘等简单算法 此类问题都要使用循环，要注意根据问题确定循环变量的初值、终值或结束条件，更要注意用来表示计数、和、阶乘的变量的初值。 例：用随机函数产生100个[0，99]围的随机整数，统计个位上的数字分别为1，2，3，4，5，6，7，8，9，0的数的个数并打印出来。 本题使用数组来处理，用数组a(1 to 100)存放产生的确100个随机整数，数组x(1 to 10)来存放个位上的数字分别为1，2，3，4，5，6，7，8，9，0的数的个数。即个位是1的个数存放在x(1)中，个位是2的个数存放在x(2)中，……个位是0的个数存放在x(10)。 将程序编写在一个GetTJput过程中，代码如下： Public Sub GetTJput() Dim a(1 To 100) As Integer Dim x(1 To 10) As Integer
Dim i As Integer, p As Integer '产生100个[0，99]围的随机整数，每行10个打印出来 For i = 1 To 100 a(i) = Int(Rnd * 100) If a(i) < 10 Then Form1.Print Space(2); a(i); Else Form1.Print Space(1); a(i); End If If i Mod 10 = 0 Then Form1.Print Next i '统计个位上的数字分别为1，2，3，4，5，6，7，8，9，0的数的个数，并将统计结果保存在数组x(1),x(2),...,x(10)中，将统计结果打印出来 For i = 1 To 100 p = a(i) Mod 10 ' 求个位上的数字 If p = 0 Then p = 10 x(p) = x(p) + 1 Next i Form1.Print "统计结果" For i = 1 To 10
计算器vb源代码
计算器v b源代码 IMB standardization office【IMB 5AB- IMBK 08- IMB 2C】
计算器vb源代码.txt性格本身没有好坏，乐观和悲观对这个世界都有贡献，前者发明了飞机，后者发明了降落伞。完全版的前后台代码... '请把下面的保存为 VERSION Begin Calculator BorderStyle = 1 'Fixed Single Caption = "计算器" ClientHeight = 2970 ClientLeft = 2580 ClientTop = 1485 ClientWidth = 3270 ClipControls = 0 'False BeginProperty Font Name = "System" Size = Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Icon = "":0000 LinkMode = 1 'Source LinkTopic = "Form1" MaxButton = 0 'False PaletteMode = 1 'UseZOrder ScaleHeight = 2970 ScaleWidth = 3270 WhatsThisHelp = -1 'True Begin Number Caption = "7" Height = 480 Index = 7 Left = 120 TabIndex = 7 Top = 600 Width = 480 End
VB练习题
判断题： 1、VB中，每一种对象有着不同的属性设置，每一种对象能识别的事件也不同。（对） 2、Val(“123hello”) 和Val(“hello123”)返回值一样。（错） 3、赋值语句X=123+”123”和X=”123”+123中，X的值一样。（对） 4、赋值语句X=”123”+”123”和X=”123”+123中，X的值一样。（错） 5、执行Print 5*8 和Print “5*8 ”语句运行结果一样。（错） 6、标签框和文本框内容的最大区别就是在程序运行过程中标签框的内容不可编辑，而文本框的内容可编辑。（对） 7、用vb编写程序时，标签控件能代替文本框控件使用. （错） 8、VB程序代码中，Label1.Caption=””的作用是该标签框中得内容清除。（对） 9、变量名的长度最长可达1024个字符。（错）225个 10、sum和int.sum都可以作为VB的变量名。（错） 11、下列程序的运行结果是15 （对） Dim s as Double Dim i as Integer S=0 I=1 Do While i<=5 I=i+2 S=s+i Loop Label1.Caption=s 12、对于熟练的程序员，可以省略程序的调试过程。（错） 13、在VB中，使用if语句就可以根据条件改变程序的执行路径。（对） 14、VB编程的一般步骤应该是：分析问题——设计界面——编写代码——调试与运行程序。（对） 单项选择题 1、小明想用VB设计一个加法器程序，做了如下规划，下列说法错误的是。（D） A、程序运行时标题栏显示加法器 B、前两个标签框显示的内容分别为“+”和“=” C、Command1用来计算出结果 D、使用了三个命令按钮、两个标签框和三个文本框 2、从下面的对象属性可以看出，该对象的标题为（A）
VB计算器源代码
Dim sum As Double Dim flag1 As Integer Dim flag2 As Integer Public wen As Double Private Sub Command19_Click() Command24_Click Operator = Index NewEntry = True End Sub Private Sub Command1_Click(Index As Integer) Select Case Index Case 0 wen = 0 Label1.Caption = "" Case 1 Text1.Text = Str(wen) Case 2 If Text1.Text = "" Then wen = 0 Label1.Caption = "" Else wen = Val(Text1.Text) Label1.Caption = "M" End If Text1.Text = "" Case 3 wen = Val(Text1.Text) + wen Label1.Caption = "M" End Select End Sub Private Sub Command12_Click() If Text1.Text <> "" Then
Text1.Text = Text1.Text * -1 Else MsgBox "输入不能为空！", vbOKOnly, "警告" Text1.SetFocus End If End Sub Private Sub Command16_Click() If InStr(Text1.Text, ".") = 0 Then Text1.Text = Text1.Text & "." Else Exit Sub End If End Sub Private Sub Command21_Click() Text1.Text = Str(Sqr(Val(Text1.Text))) End Sub Private Sub Command22_Click() sum = Text1.Text flag1 = 5 flag2 = 1 End Sub Private Sub Command23_Click() Text1.Text = Str(Val(Text1.Text / 1)) flag2 = 0 End Sub Private Sub Command24_Click() Select Case (flag1) Case 1 Text1.Text = sum + Text1.Text Case 2 Text1.Text = sum - Text1.Text Case 3 Text1.Text = sum * Text1.Text Case 4 If Text1.Text = 0 Then df = MsgBox("除数不能为零!请重新输入.", vbOKOnly + vbInformation, "警告") Text1.Text = "" Text1.SetFocus Exit Sub
VB程序设计的常用算法教案.doc
VB程序设计的常用算法教案 算法（algorithm）：计算机解题的基本思想方法和步骤。算法的描述：是对要解决一个问题或要完成一项任务所采取的方法和步骤的描述，包括需要什么数据（输入什么数据、输出什么结果）、采用什么结构、使用什么语句以及如何安排这些语句等。通常使用自然语言、结构化流程图、伪代码等来描述算法。 一、计数、求和、求阶乘等简单算法 此类问题都要使用循环，要注意根据问题确定循环变量的初值、终值或结束条件，更要注意用来表示计数、和、阶乘的变量的初值。 例：用随机函数产生100个[0，99]范围内的随机整数，统计个位上的数字分别为1，2，3，4，5，6，7，8，9，0的数的个数并打印出来。 本题使用数组来处理，用数组a(1 to 100)存放产生的确100个随机整数，数组x(1 to 10)来存放个位上的数字分别为1，2，3，4，5，6，7，8，9，0的数的个数。即个位是1的个数存放在x(1)中，个位是2的个数存放在x(2)中，......个位是0的个数存放在x(10)。 将程序编写在一个gettjput过程中，代码如下： public sub gettjput() dim a(1 to 100) as integer
dim x(1 to 10) as integer dim i as integer, p as integer '产生100个[0，99]范围内的随机整数，每行10个打印出来 for i = 1 to 100 a(i) = int(rnd * 100) if a(i) < 10 then form1.print space(2); a(i); else form1.print space(1); a(i); end if if i mod 10 = 0 then form1.print next i '统计个位上的数字分别为1，2，3，4，5，6，7，8，9，0的数的个数，并将统计结果保存在数组x(1),x(2),...,x(10)中，将统计结果打印出来 for i = 1 to 100 p = a(i) mod 10 ' 求个位上的数字 if p = 0 then p = 10 x(p) = x(p) + 1 next i form1.print "统计结果"
用VB编写一个简单计算器
用VB编写一个简单计算器 一、功能：实现简单的加减乘除功能，C归零，CE取消输入，%计算并显示第一个操作数的百分比。 二、控件：1个label，20个commandbutton。 三、计算器运行界面： 四、详细代码： Option Explicit Dim Op1, Op2 '前面输入的操作数 Dim DecimalFlag As Integer '小数点仍然存在吗？ Dim NumOps As Integer '操作数个数 Dim LastInput '指示上一次按键事件的类型 Dim OpFlag '指示未完成的操作 Dim TempReadout ' C (取消) 按钮的Click 事件过程 ' 重新设置显示并初始化变量 Private Sub Cancel_Click() Readout = Format(0, "0.") Op1 = 0 Op2 = 0 Form_Load End Sub ' CE (取消输入) 按钮的Click 事件过程
Private Sub CancelEntry_Click() Readout = Format(0, "0.") DecimalFlag = False LastInput = "CE" End Sub ' 小数点(.) 按钮的Click 事件过程 ' 如果上一次按键为运算符，初始化readout 为"0."； ' 否则显示时追加一个小数点 Private Sub Decimal_Click() If LastInput = "NEG" Then Readout = Format(0, "-0.") ElseIf LastInput <> "NUMS" Then Readout = Format(0, "0.") End If DecimalFlag = True LastInput = "NUMS" End Sub ' 窗体的初始化过程 ' 设置所有变量为其初始值 Private Sub Form_Load() DecimalFlag = False NumOps = 0 LastInput = "NONE" OpFlag = " " Readout = Format(0, "0.") 'Decimal.Caption = Format(0, ".") End Sub ' 数字键(0-9) 的Click 事件过程 ' 向显示中的数追加新数 Private Sub Number_Click(Index As Integer) If LastInput <> "NUMS" Then Readout = Format(0, ".") DecimalFlag = False End If If DecimalFlag Then Readout = Readout + Number(Index).Caption Else Readout = Left(Readout, InStr(Readout, Format(0, ".")) - 1) + Number(Index).Caption + Format(0, ".") End If If LastInput = "NEG" Then Readout = "-" & Readout
VB简单计算器编程代码(附图)
课程设计说明书正文 一、题目：计算器的创作和相应程序的编写 二、本题的主要功能：通过计算器的创作熟悉各控件的属性和练习程序的编写。 三、程序截图： 四、源程序清单： Begin VB.Form Form1 Caption = "计算器" ClientHeight = 3765 ClientLeft = 165 ClientTop = 855 ClientWidth = 5355 Icon = "Form1.frx":0000 LinkTopic = "Form1" LockControls = -1 'True ScaleHeight = 3765 ScaleWidth = 5355 StartUpPosition = 3 '窗口缺省 Begin https://www.wendangku.net/doc/e112234867.html,mandButton Command4 Caption = "=" Height = 495 Left = 4470 TabIndex = 28 Top = 3060
Width = 735 End Begin https://www.wendangku.net/doc/e112234867.html,mandButton Command3 Caption = "1/x" Height = 495 Left = 4470 TabIndex = 27 Top = 2520 Width = 735 End Begin https://www.wendangku.net/doc/e112234867.html,mandButton Command2 Caption = "%" Height = 495 Left = 4470 TabIndex = 26 Top = 1980 Width = 735 End Begin https://www.wendangku.net/doc/e112234867.html,mandButton Command1 Caption = "sqrt" Height = 495 Left = 4470 TabIndex = 25 Top = 1440 Width = 735 End Begin https://www.wendangku.net/doc/e112234867.html,mandButton cmbDOT Caption = "." Height = 495 Left = 2910 TabIndex = 24 Top = 3060 Width = 735 End
VB程序设计的常用算法4
VB程序设计的常用算法4 十、数制转换 将一个十进制整数m转换成→r(2－16)进制字符串。 方法：将m不断除r 取余数，直到商为零，以反序得到结果。下面写出一转换函数，参数idec为十进制数，ibase为要转换成数的基（如二进制的基是2，八进制的基是8等），函数输出结果是字符串。 Private Function TrDec(idec As Integer, ibase As Integer) As String Dim strDecR$, iDecR% strDecR = "" Do While idec <> 0 iDecR = idec Mod ibase If iDecR >= 10 Then strDecR = Chr$(65 + iDecR - 10) & strDecR Else strDecR = iDecR & strDecR End If idec = idec \ ibase Loop TrDec = strDecR End Function 十一、字符串的一般处理1．简单加密和解密 加密的思想是：将每个字母C加（或减）一序数K，即用它后的第K个字母代替，变换式公式：c=chr(Asc(c)+k) 例如序数k为5，这时"A"→"F"，"a""f"，"B""G"…当加序数后的字母超过"Z"或"z"则c=Chr(Asc(c)+k -26) 例如：You are good→ Dtz fwj ltti 解密为加密的逆过程 将每个字母C减（或加）一序数K，即c=chr(Asc(c)-k), 例如序数k为5，这时"Z"→"U"，"z"→"u"，"Y"→"T"…当加序数后的字母小于"A"或"a"则c=Chr(Asc(c)-k +26) 下段程序是加密处理： i = 1: strp = "" nL = Len(RTrim(strI)) Do While (i <= nL) strT = Mid$(strI, i, 1) '取第i个字符 If (strT >= "A" And strT <= "Z") Then iA = Asc(strT) + 5 If iA > Asc("Z") Then iA = iA - 26 strp = strp + Chr$(iA) ElseIf (strT >= "a" And strT <= "z") Then iA = Asc(strT) + 5 If iA > Asc("z") Then iA = iA - 26 strp = strp + Chr$(iA) Else strp = strp + strT End If i = i + 1 Loop Print strp
VB程序设计的常用算法
VB程序设计的常用算法 算法（Algorithm）：计算机解题的基本思想方法和步骤。算法的描述：是对要解决一个问题或要完成一项任务所采取的方法和步骤的描述，包括需要什么数据（输入什么数据、输出什么结果）、采用什么结构、使用什么语句以及如何安排这些语句等。通常使用自然语言、结构化流程图、伪代码等来描述算法。 一、计数、求和、求阶乘等简单算法 此类问题都要使用循环，要注意根据问题确定循环变量的初值、终值或结束条件，更要注意用来表示计数、和、阶乘的变量的初值。 例：用随机函数产生100个[0，99]范围内的随机整数，统计个位上的数字分别为1，2，3，4，5，6，7，8，9，0的数的个数并打印出来。 本题使用数组来处理，用数组a(1 to 100)存放产生的确100个随机整数，数组x(1 to 10)来存放个位上的数字分别为1，2，3，4，5，6，7，8，9，0的数的个数。即个位是1的个数存放在x(1)中，个位是2的个数存放在x(2)中，……个位是0的个数存放在x(10)。 将程序编写在一个GetTJput过程中，代码如下： Public Sub GetTJput() Dim a(1 To 100) As Integer Dim x(1 To 10) As Integer Dim i As Integer, p As Integer '产生100个[0，99]范围内的随机整数，每行10个打印出来 For i = 1 To 100 a(i) = Int(Rnd * 100) If a(i) < 10 Then Form1.Print Space(2); a(i); Else Form1.Print Space(1); a(i); End If If i Mod 10 = 0 Then Form1.Print Next i '统计个位上的数字分别为1，2，3，4，5，6，7，8，9，0的数的个数，并将统计结果保存在数组x(1),x(2),...,x(10)中，将统计结果打印出来 For i = 1 To 100 p = a(i) Mod 10 ' 求个位上的数字 If p = 0 Then p = 10 x(p) = x(p) + 1 Next i Form1.Print "统计结果" For i = 1 To 10 p = i If i = 10 Then p = 0 Form1.Print "个位数为" + Str(p) + "共" + Str(x(i)) + "个" Next i End Sub 二、求两个整数的最大公约数、最小公倍数 分析：求最大公约数的算法思想：(最小公倍数=两个整数之积/最大公约数) (1) 对于已知两数m，n，使得m>n； (2) m除以n得余数r； (3) 若r=0，则n为求得的最大公约数，算法结束；否则执行(4)； (4) m←n，n←r，再重复执行(2)。 例如:求m=14 ,n=6的最大公约数. m n r
vb编写的计算器代码
Option Explicit Const CC1 = 1E+28, CC2 = 0.000000000000001, CC3 = 100000000000000# Dim Op1, Op2 ' 预先输入操作数。 Dim DecFlag% ' 小数点存在吗？ Dim Klast ' 指示上一次按键事件的类型。 Dim OpFlag ' 指示未完成的操作。 Dim Kedt% ' 指示键入状态，0-未操作，1-算过，2-改过Dim MemNum ' 存储器 Dim Temp2 ' Function sqr28(a As V ariant) As V ariant Dim c As Double c = Sqr(a) If c > CC3 Or c < CC2 Then sqr28 = c Else sqr28 = CDec(Sqr(a)) sqr28 = sqr28 - (sqr28 * sqr28 - a) / sqr28 * 0.5 End If End Function Function cur28(a As V ariant) As V ariant Dim t As V ariant, c As Double c = Abs(a) ^ (1 / 3) If c > 1000000000# Or c < 0.000000001 Then cur28 = c * Sgn(a) Else cur28 = CDec(c) * Sgn(a) t = cur28 * cur28 cur28 = cur28 - (cur28 * t - a) / t / 3 End If End Function ' 存入存储器 Private Sub BtMS_Click() If Kedt = 2 Then GetOp1 MemNum = Op1 LabMem.Visible = MemNum <> 0 Kedt = 1 End Sub ' 取出存储器数据 Private Sub BtMr_Click() CancelEntry_Click Op1 = MemNum
VB常用算法——排序
VB常考算法（八）排序： 1、算法 1）选择法排序 算法说明：根据上例中求最小值的思路，我们可以使用如下方法进行从小到大排序：第一轮，以第一个元素逐个跟后面的所有元素比较，如果比后面的元素大就进行交换，经过一轮比较，第一个元素被确定为最小；同样的方法，下一轮以第二个元素跟剩下的所有元素进行比较确定下次小的元素；以此类推… 下面我们以图形的形式体现对5个数进行选择排序的过程： 第一轮：第二轮： 第三轮： 从上图可以发现对5个元素进行排序，总共经过了5-1=4轮，而每一轮中比较的次数也不相同，第一轮2、3、4、5号元素参与跟1号元素的比较，共4次，第二轮3、4、5号元素参与跟2号元素的比较，共3次，以次类推，比较次数逐步减少。经过四轮的比较，利用逐步求最小值的方法将5个数从小到大排好序。对于这样一个排序的过程，我们可以使用两个循环分别控制比较的轮数和每一轮的次数。 程序代码： Private Sub Command1_Click() Dim n As Integer n = InputBox("请输入数组元素的个数：") Dim a() As Integer, i As Integer, j As Integer Print "排序前：" ReDim a(n) For i = 1 To n a(i) = Int(Rnd * (99 - 10 + 1) + 10) Print a(i); 最小值 次小值
Next i For i = 1 To n - 1 For j = i To n If a(i) > a(j) Then temp = a(i) '交换元素 a(i) = a(j) a(j) = temp End If Next j Next i Print Print "排序后:" For i = 1 To n Print a(i); Next i End Sub 2）冒泡法排序 算法说明：相邻的元素进行比较，如果前面的元素比后面的元素大，则将它们进行交换，具体思路：设在数组a 中存放n 个元素，第一轮，将a(1)和a(2)进行比较，若a(1)>a(2),则交换这两个元素的值，然后继续用a(2)和a(3)比较，若a(1)>a(2)，则交换这两个元素的值，以此类推，直到a(n-1)和a(n)进行比较处理后，a(n)中就存放了n 个数中最大的值；第二轮，用a(1)与a(2),a(2)与a(3),…,a(n-2)与a(n-1)进行比较，处理方法相同，这一轮下来，a(n-1)中存放n 个数中第二大的值；…；第n-1轮，a(1)与a(2)进行比较处理，确保最小值在a(1)中。经过n-1轮比较处理，n 个数已经按从小到大的顺序排列好。 下面我们以图形的形式体现对5个数进行冒泡排序的过程： 第一轮： 第三轮： 第四轮： 最大值
VB计算器代码
第 3 章计算器第3 章计算器 3.1 开发任务 在本任务中，我们要分别实现基本算术运算、累加和计算、阶乘计算、三角函数计算、排列组合计算和对数计算等多个子任务。 3.1.1 计算器的实验版本 1. 程序界面设计 （1）新建工程 打开VB开发环境，在工程浏览器窗口中（见图3-1左），将工程名称改为“计算器”（如图3-1中）；再将窗体名称改为“frmCalculator”如图3-1右）。 图3-1 改变工程和窗体名称 将窗体文件保存为“frmCalculator.frm”，工程文件保存为“prjCalculator”。 （2）添加控件 在本工程中，我们需要用到下列控件：1个文本框用于输入运算数和输出结果；16个按钮构成计算器键盘，其中10个用于输入10个数字字符，1个用于输入小数点，一个用于触发计算的等号，另外4个用于选择加、减、乘、除运算符。 首先在窗体上部添加一个文本框，默认名称是Text1，调整好大小和位置（如图3-2），并将属性Text的值清空，再将对齐方式Alignment 改成“1 -
Right Justify”右对齐； 图3-2 添加文本框控件 再来制作键盘，第1步，添加第1个按钮。在文本框下方添加一个按钮Command1，将它调整为一个按键般大小，并把Caption属性改成“1”。 第2步，添加第2个按钮。添加外形类似的按钮，用复制的方法即可。不过要注意，在粘贴时VB会询问“已经有一个控件为"Command1 "。创建一个控件数组吗？”（见图3-3），一定要回答“否”。将复制好的按钮Command2的Caption改成2，并移动到Command1的右边。 图3-3 创建控件数组询问对话框 第3步，重复进行粘贴操作，依次制作其它按钮，按图3-4的布局排列。前9个按钮的Caption改成与它们的顺序号相同，Command10的Caption改为“0”，Command11的Caption改为“.”，ommand12的Caption改为“=”，Command13～Command16的Caption依次改为“+”、“-”、“*”、“/”。 图3-4键盘制作 2. 程序代码编写 （1）数字按钮的处理
VB程序设计的常用算法
VB 程序设计的常用算法 算法( Algorithm )：计算机解题的基本思想方法和步骤。算法的描述：是对要解决一个问题或要完成一项任务所采取的方法和步骤的描述，包括需要什么数据(输入什么数据、输出什么结果)、采用什么结构、使用什么语句以及如何安排这些语句等。通常使用自然语言、结构化流程图、伪代码等来描述算法。 一、计数、求和、求阶乘等简单算法 此类问题都要使用循环，要注意根据问题确定循环变量的初值、终值或结束条件，更要注意用来表示计数、和、阶乘的变量的初值。 例：用随机函数产生100 个［0，99］范围内的随机整数，统计个位上的数字分别为1，2，3，4，5，6，7，8，9，0 的数的个数并打印出来。 本题使用数组来处理，用数组a(1 to 100)存放产生的确100个随机整数，数组x(1 to 10)来存放个位上的数字分别为1，2，3，4，5，6，7，8，9，0 的数的个数。即个位是1 的个数存放在x(1) 中，个位是2 的个数存放在x(2)中，...................... 个位是0的个数存放在x(10)。 将程序编写在一个GetTJput过程中，代码如下： Public Sub GetTJput() Dim a(1 To 100) As Integer Dim x(1 To 10) As Integer Dim i As Integer, p As Integer '产生100 个［0，99］范围内的随机整数，每行 1 0个打印出来 For i = 1 To 100 a(i) = Int(Rnd * 100) If a(i) < 10 Then Form1.Print Space(2); a(i);
VB编写简易计算器(附图)
用VB6.0编写简易计算器 效果图： 废话不多说，直接上步骤 一、创建控件组 1、创建控件组的方法 首先创建一个命令按钮，调整其大小（觉得合适就行），名称为Command1，Caption 属 性为数字 0 ；然后进行“复制”和“粘贴”，当选择“粘贴”时，出现对话框提示已有一个同名控件，询问是否创建控件组，选择“是”后，即创建了一个名为“Command”的控件组。这时，第一个按钮的Index属性值默认为“0”，第二个的Index属性值自动设为“1”，并 且大小与第一个按钮相同，只需修改其 Caption 属性为数字“1”并将其拖至合适位置即可。此后继续使用“粘贴”的方法建立其他控件组中其余按钮，共20个按钮，每建立一个，就将它拖到合适处，并修改相应的Caption属性值。
2、各控件组其属性设置如下： 设置效果如下图所示：
二、编写代码 Dim s1 As Single, s2 As Single, ysf As String '定义两个单精度数变量用与存放参与运算的数,一个字符型存放运算符 Private Sub Command1_Click(Index As Integer) Text1.Text = Text1.Text & Command1(Index).Caption '将command1的单击事件与文本框显示的内容连接 End Sub Private Sub Command2_Click() Text1.Text = Text1.Text + "." If (InStr(Text1.Text, ".") = 1) Then'第一位不能为小数 Text1.Text = "" End If If InStr(Text1.Text, ".") < Len(Text1.Text) Then '防止出现两个小数点 Text1.Text = Left(Text1.Text, Len(Text1.Text) - 1) End If End Sub Private Sub Command3_Click() s2 = Val(Text1.Text) '开始加减乘除运算 Select Case ysf Case "+" Text1.Text = s1 + s2 Case "-" Text1.Text = s1 - s2 Case "*" Text1.Text = s1 * s2 Case "/" If s2 = 0 Then MsgBox "分母不能为零!" Text1.Text = "" Else Text1.Text = s1 / s2 End If End Select Text1 = IIf(Left(Text1.Text, 1) = ".", 0 & Text1.Text, Text1.Text) '这个很关键，如果没有这个的话，得出小于1的小数前面没有0 End Sub Private Sub Command4_Click() If Text1.Text = "" Then '文本为空就结束 Exit Sub End If
VB编写简单计算器程序
Option Explicit Dim LastInput As String * 3 '记录上次按下的按键 Dim Num1 As Double '第一个操作数 Dim Num2 As Double '第二个操作数 Dim OptType As Integer '按下哪一个操作符 Dim Result As Double '表示运算结果 Dim shuzhi As Integer '表示当前采用的shuzhi Dim FirstNum As Boolean '是否是第一个操作数 Sub keyp(keynum As Integer) Dim CHAR As String * 1 CHAR = Chr(keynum) If CHAR = "+" Or keynum = 43 Then Command5(0).Value = True If CHAR = "-" Or keynum = 45 Then Command5(1).Value = True If CHAR = "*" Or keynum = 42 Then Command5(2).Value = True If CHAR = "/" Or keynum = 47 Then Command5(3).Value = True If shuzhi = 2 And CHAR >= "2" And CHAR <= "9" Then keynum = 0 Exit Sub End If If keynum >= 48 And keynum <= 57 Then Command1(keynum - 48).Value = True If keynum = 46 Then Command2.Value = True If UCase(CHAR) = "C" Then Command3.Value = True If keynum = 27 Then Command4.Value = True If keynum = 61 Then Command6.Value = True keynum = 0 End Sub Function angle(ByVal j1 As Integer) As Single angle = j1 If Option1.Value Then angle = j1 * 3.14 / 180 End Function Function ArcSin(ByVal Num As Single) As Single If Num = 1 Then ArcSin = 3.1415926 / 2 ElseIf Num = -1 Then ArcSin = 3.1415926 * 3 / 2 Else ArcSin = Atn(Num / Sqr(-Num * Num + 1)) End If If Option1.Value Then ArcSin = ArcSin * 180 / 3.1415926 End Function Function ArcCos(ByVal Num As Single) As Single If Num = 1 Then ArcCos = 0 ElseIf Num = -1 Then ArcCos = 3.1415926 Else ArcCos = Atn(-Num / Sqr(-Num * Num + 1)) + 2 * Atn(1)