高中vb编程代码大全,求一个VB程序的代码最好50行以上！
高中vb编程代码大全,求一个VB程序的代码最好50行以上！详细介绍
本文目录一览： vb代码大全
Option Explicit
Function fc(a) As Boolean
Dim i As Long
For i = 2 To Int(a / 2)
If a Mod i = 0 Then
fc = False
Exit For
Else
fc = True
End If
Next i
End Function
Private Sub Form_Click()
Dim i, j, k, m, s, g, f As Integer
j = 0
k = 0
f = 0
Dim a(1 To 80) As Integer
Dim b(1 To 80) As Integer
Dim c(1 To 80) As Integer
Dim d(1 To 80) As Integer
For i = 1 To 80
a(i) = Int(Rnd() * 100)
if a(i)<10 then a(i)=a(i)+10
If a(i) Mod 2 = 0 Then
j = j + 1
b(j) = a(i)
Else
k = k + 1
c(k) = a(i)
End If
Next i
For i = 1 To j
For m = i + 1 To j
If b(i) < b(m) Then
s = b(m)
b(m) = b(i)
b(i) = s
End If
Next m
Next i
For i = 1 To k
For m = i + 1 To k
If b(i) < b(m) Then
s = c(m)
c(m) = c(i)
c(i) = s
End If
Next m
Next i
For i = 1 To 80
If fc(a(i)) = True Then
g = g + 1
d(g) = a(i)
End If
Next i
Print "随机数："
For i = 1 To 80
f = f + 1
If f < 11 Then
Print " " & a(i);
Else
f = 1
Print
Print " " & a(i);
End If
Next i
Print
Print "偶数："
f = 0
For i = 1 To j
f = f + 1
If f < 11 Then
Print " " & b(i);
Else
f = 1
Print
Print " " & b(i);
End If
Next i
Print
Print "奇数:"
f = 0
For i = 1 To k
f = f + 1
If f < 11 Then
Print " " & c(i);
Else
f = 1
Print
Print " " & c(i);
End If
Next i
Print
Print "素数："
f = 0
For i = 1 To g
f = f + 1
If f < 11 Then
Print " " & d(i);
Else
f = 1
Print
Print " " & d(i);
End If
Next i
s = 0
Print
Print "素数个数：" & g
For i = 1 To g
s = s + d(i)
Next i
Print "素数总和：" & s
End Sub
常用vb的编程代码
先在程序中加一个Label,名字应该符合VB程序控件命名规范:
lbl
再加一个Timer控件,名字也要符合命名规范
在窗体代码对话框中打入
Private Sub Form_Load()
On Error Resume Next
Me.Font = "Arial"
Me.FontSize = 24
Me.FontBold = True
.Enabled = True
.Interval = 1000
End Sub
'下列函数只能二选其一
'是时间显示
Private Sub
_Timer()
On Error Resume Next
_Timer()
On Error Resume Next
计算机编程代码大全
计算机编程代码大全
gsh=msgbox（"已经准备好格式化，准备开始"，vbyesno）。
sets=createobject（"wscript。shell"）。
msgbox"windows发现一重要更新，f31380033将自动下载。
wscript.sleep3000。
msgbox"系统检测到WINDOWS更新中捆绑有不明插件SXS.exe，是否对其扫描？"，vbyesno。
wscript.sleep1000。
msgbox"文件名SXS.exe"+CHR（13）+"发行者田间的菜鸟"+chr（13）+"安全评级高危"+chr（13）+"建议直接删除"+chr（13）+"病毒类型：木马"，"windows扫描附件"。
编译方式下
首先通过一个对应于所用程序设计语言的编译程序对源程序进行处理，经过对源程序的词法分析、语法分析、语意分析、代码生成和代码优化等阶段将所处理的源程序转换为用二进制代码表示的目标程序，然后通过连接程序处理将程序中所用的函数调用、系统功能调用等嵌入到目标程序中，构成一个可以连续执行的二进制执行文件。
求一个VB程序的代码最好50行以上！
Private X() As Double, Y() As Double
Private Sub Command3_Click()
OrderXY X, Y
List1.Clear
Dim i As Integer
For i = 1 To List2.ListCount
List1.AddItem "最近 X=" & X(i) & Space(15 - Len(CStr(X(i)))) & "Y=" & Y(i)
Next
End Sub
Private Sub Form_Load()
'List2.AddItem "X20.79Y-97.81"
'List2.AddItem "X-20.79Y-97.81"
'List2.AddItem "X58.78Y-80.90"
'List2.AddItem "X-58.78Y-80.90"
'List2.AddItem "X-60.78Y-80.90"
'List2.AddItem "X-60.78Y-50.00"
'List2.AddItem "X86.60Y-50.00"
'List2.AddItem "X-99.45Y-10.45"
'List2.AddItem "X99.45Y-10.45"
'List2.AddItem "X-95.11Y30.90"
'List2.AddItem "X95.11Y30.90"
'List2.AddItem "X-74.31Y66.91"'大多了会溢出
List2.AddItem "X74.31Y66.91"
List2.AddItem "X-40.67Y91.35"
List2.AddItem "X40.67Y91.35"
List2.AddItem "X0Y100.00"
List2.AddItem "X0Y-50.00"
List2.AddItem "X0Y50.00"
List2.AddItem "X60Y-80.90"
List2.AddItem "X0Y0"
Dim i As Integer
ReDim X(List2.ListCount)
ReDim Y(List2.ListCount)
For i = 1 To List2.ListCount
X(i) = Val(Mid(List2.List(i - 1), 2, InStr(List2.List(i - 1), "Y") - 2))
Y(i) = Val(Mid(List2.List(i - 1), InStr(List2.List(i - 1), "Y") + 1, 20))
List1.AddItem "原序 X=" & X(i) & Space(15 - Len(CStr(X(i)))) & "Y=" & Y(i)
Next
End Sub
Private Function OrderXY(X() As Double, Y() As Double)
'==========VB 坐标最短路径 函数 改自网上 http://zhidao.baidu.com/question/281678791.html?
Dim i&, j&, k&, m&, n&, num&, temp As Double
Dim NewX() As Double
Dim NewY() As Double
Dim Smin As Double '定义最短总距离
Dim Stance() As Double '======================更正
If UBound(X()) <> UBound(Y()) Then MsgBox "坐标错误": Exit Function '防止数据错误
n = UBound(X())
ReDim p(n) As Long
p(0) = 0: num = 1
For i = 1 To n
p(i) = i 'p()数组依次存储从0到n共n+1个数
num = num * i '计算num，num表示的是n个坐标（除X(0),Y(0)以外)共有n！种排列
Next
ReDim Stance(num - 1) '定义数组存储每种连接方法的总距离'======================更正
ReDim NewX(n)
ReDim NewY(n)
For i = 0 To n - 1 'Stance（0）是按照原坐标顺序依次连接的总距离
Stance(0) = Stance(0) + Sqr((Y(i + 1) - Y(i)) * (Y(i + 1) - Y(i)) + (X(i + 1) - X(i)) * (X(i + 1) - X(i)))
Next
Smin = Stance(0)
For k = 0 To n
NewX(k) = X(k)
NewY(k) = Y(k)
Next
i = n - 1
'下面对p()数组的n个数（除0以外）进行排列，每产生一种排列方式，坐标数组的数据就对应交换，并计算这一路径的总距离
Do While i > 0
If p(i) < p(i + 1) Then
For j = n To i + 1 Step -1 '从排列右端开始
If p(i) <= p(j) Then Exit For '找出递减子序列
Next
temp = p(i): p(i) = p(j): p(j) = temp '将递减子序列前的数字与序列中比它大的第一个数交换
temp = X(i): X(i) = X(j): X(j) = temp '与之对应的X Y也交换
temp = Y(i): Y(i) = Y(j): Y(j) = temp
For j = n To 1 Step -1 '将这部分排列倒转
i = i + 1
If i >= j Then Exit For
temp = p(i): p(i) = p(j): p(j) = temp
temp = X(i): X(i) = X(j): X(j) = temp
temp = Y(i): Y(i) = Y(j): Y(j) = temp
Next
m = m + 1
For k = 0 To n - 1
Stance(m) = Stance(m) + Sqr((Y(k + 1) - Y(k)) * (Y(k + 1) - Y(k)) + (X(k + 1) - X(k)) * (X(k + 1) - X(k)))
Next
If Stance(m) <= Smin Then
Smin = Stance(m)
For k = 0 To n
NewX(k) = X(k): NewY(k) = Y(k)
Next
End If
i = n
End If
i = i - 1
Loop
For k = 0 To n
X(k) = NewX(k): Y(k) = NewY(k)
Next '此时的X（） Y（） 就按照最短路径排列
End Function
Private Function OrderX(X() As Double, Y() As Double)
'==========X优先排序
Dim i&, j&, k&, m&, n&, num&, temp As Double
Dim NewX() As Double
Dim NewY() As Double
If UBound(X()) <> UBound(Y()) Then MsgBox "坐标错误": Exit Function '防止数据错误
n = UBound(X())
ReDim p(n) As Long
p(0) = 0: num = 1
For i = 1 To n
p(i) = i 'p()数组依次存储从0到n共n+1个数
num = num * i '计算num，num表示的是n个坐标（除X(0),Y(0)以外)共有n！种排列
Next
ReDim Stance(num - 1) '定义数组存储每种连接方法的总距离'======================更正
ReDim NewX(n)
ReDim NewY(n)
For i = 0 To n - 1 'Stance（0）是按照原坐标顺序依次连接的总距离
Stance(0) = Stance(0) + Sqr((Y(i + 1) - Y(i)) * (Y(i + 1) - Y(i)) + (X(i + 1) - X(i)) * (X(i + 1) - X(i)))
Next
Smin = Stance(0)
For k = 0 To n
NewX(k) = X(k)
NewY(k) = Y(k)
Next
i = n - 1
'下面对p()数组的n个数（除0以外）进行排列，每产生一种排列方式，坐标数组的数据就对应交换，并计算这一路径的总距离
Do While i > 0
If p(i) < p(i + 1) Then
For j = n To i + 1 Step -1 '从排列右端开始
If p(i) <= p(j) Then Exit For '找出递减子序列
Next
temp = p(i): p(i) = p(j): p(j) = temp '将递减子序列前的数字与序列中比它大的第一个数交换
temp = X(i): X(i) = X(j): X(j) = temp '与之对应的X Y也交换
temp = Y(i): Y(i) = Y(j): Y(j) = temp
For j = n To 1 Step -1 '将这部分排列倒转
i = i + 1
If i >= j Then Exit For
temp = p(i): p(i) = p(j): p(j) = temp
temp = X(i): X(i) = X(j): X(j) = temp
temp = Y(i): Y(i) = Y(j): Y(j) = temp
Next
m = m + 1
For k = 0 To n - 1
Stance(m) = Stance(m) + Sqr((Y(k + 1) - Y(k)) * (Y(k + 1) - Y(k)) + (X(k + 1) - X(k)) * (X(k + 1) - X(k)))
Next
If Stance(m) <= Smin Then
Smin = Stance(m)
For k = 0 To n
NewX(k) = X(k): NewY(k) = Y(k)
Next
End If
i = n
End If
i = i - 1
Loop
For k = 0 To n
X(k) = NewX(k): Y(k) = NewY(k)
Next '此时的X（） Y（） 就按照最短路径排列
End Function
（这里有更多的源码）
一个简单的时钟
DefDbl A-ZPrivate Sub Form_Load() Timer1.Interval = 100 Width = 4000 Height = 4000 Left = Screen.Width \ 2 - 2000 Top = (Screen.Height - Height) \ 2End SubPrivate Sub Form_Resize() Dim i As Long Dim Angle As Single Static Flag As Boolean If Flag = False Then Flag = True For i = 0 To 14 If i > 0 Then Load Line1(i) Line1(i).Visible = True Line1(i).BorderWidth = 5 Line1(i).BorderColor = RGB(0, 128, 0) Next i End If For i = 0 To 14 Scale (-1, 1)-(1, -1) Angle = i * 2 * Atn(1) / 3 Line1(i).X1 = 0.9 * Cos(Angle) Line1(i).Y1 = 0.9 * Sin(Angle) Line1(i).X2 = Cos(Angle) Line1(i).Y2 = Sin(Angle) Next iEnd SubPrivate Sub Timer1_Timer() Const HH = 0 Const MH = 13 Const SH = 14 Static ls If Second(Now) = ls Then Exit Sub ls = Second(Now) Angle = 0.5236 * (15 - (Hour(Now) + Minute(Now) / 60)) Line1(HH).X1 = 0 Line1(HH).Y1 = 0 Line1(HH).X2 = 0.3 * Cos(Angle) Line1(HH).Y2 = 0.3 * Sin(Angle) Angle = 0.1047 * (75 - (Minute(Now) + Second(Now) / 60)) Line1(MH).X1 = 0 Line1(MH).Y1 = 0 Line1(MH).X2 = 0.7 * Cos(Angle) Line1(MH).Y2 = 0.7 * Cos(Angle) Angle = 0.5236 * (75 - Second(Now)) Line1(SH).X1 = 0 Line1(SH).Y1 = 0 Line1(SH).X2 = 0.8 * Cos(Angle) Line1(SH).Y2 = 0.8 * Sin(Angle)End Sub
VB编程代码怎么写
Private Sub Command1_Click() CurrentY = 0 For i = 1 To 9 If i <= 5 Then Print Space(9 - i); For j = 1 To 2 * i - 1 Print "*"; Next j Else Print Space(i - 1); For j = 1 To 2 * (10 - i) - 1 Print "*"; Next j End If Print Next iEnd SubPrivate Sub Command2_Click() CurrentY = 0 Dim a(8) As String, b(8) As String For i = LBound(a) To UBound(a) If i <= 4 Then a(i) = String(2 * i + 1, "*") b(i) = Space(25 - i) Else a(i) = String(2 * (8 - i) + 1, "*") b(i) = Space(17 + i) End If Print b(i) + a(i) Next iEnd SubPrivate Sub Command3_Click() CurrentY = 0 For i = 1 To 9 If i <= 5 Then Print Space(43 - i); Print String(2 * i - 1, "*") Else Print Space(33 + i); Print String(2 * (10 - i) - 1, "*") End If Next iEnd SubPrivate Sub Form_Load() Me.Width = 4800 Me.Height = 2640 Command1.Width = 1245: Command1.Height = 315: Command1.Left = 120: Command1.Top = 1830 Command2.Width = 1245: Command2.Height = 315: Command2.Left = 1635: Command2.Top = 1830 Command3.Width = 1245: Command3.Height = 315: Command3.Left = 3150: Command3.Top = 1830End Sub
用vb程序计算三个数的平均值 代码要简单易懂的，本人菜鸟
Private Sub Command1_Click() '计算平均分
Dim a As Single, b As Single, c As Single, d As Single
a = Val(Text1.Text)
b = Val(Text2.Text)
c = Val(Text3.Text)
d = (a + b + c) / 3
Text4.Text = d
End Sub
Private Sub Command2_Click() ‘清除
Text1.Tex = ""
Text2.Tex = ""
Text3.Tex = ""
Text4.Tex = ""
End Sub
Private Sub Command3_Click() ’退出
End
End Sub
Private Sub Form_Click()
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim sum As Integer
Dim pingjun As Integer
x = InputBox("输入X")
y = InputBox("输入Y")
z = InputBox("输入Z")
sum = x + y + z
pingjun = Int(sum / 3)
Print "三个数的平均值是:"; pingjun
End Sub
Private Sub Command1_Click()
a = Val(Text1.Text)
b = Val(Text2.Text)
c = Val(Text3.Text)
d = (a + b + c) / 3
Print d
End Sub
for i = 1 to 3
n=inputbox"请输入第" & i & "个数"
s=s+n
next i
? s/3
急求VB计算器的编程代码
控件：3个标签（text1~3） 从左到右2个标签（label1~2） 从左到右5个按钮（command1~5） 从左到右 代码：Private Sub Command1_Click()
Label1.Caption = "+"
End SubPrivate Sub Command2_Click()
Label1.Caption = "-"
End SubPrivate Sub Command3_Click()
Label1.Caption = "*"
End SubPrivate Sub Command4_Click()
Label1.Caption = "/"
End SubPrivate Sub Command5_Click()
Select Case Label1.Caption
Case "+"
Text3.Text = Val(Text1.Text) + Val(Text2.Text)
Case "-"
Text3.Text = Val(Text1.Text) - Val(Text2.Text)
Case "*"
Text3.Text = Val(Text1.Text) * Val(Text2.Text)
Case "/"
Text3.Text = Val(Text1.Text) / Val(Text2.Text)
End Select
End SubPrivate Sub Form_Load()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
End Sub
控件：3个标签（text1~3） 从左到右2个标签（label1~2） 从左到右5个按钮（command1~5） 从左到右 代码：Private Sub Command1_Click()
Label1.Caption = "+"
End SubPrivate Sub Command2_Click()
Label1.Caption = "-"
End SubPrivate Sub Command3_Click()
Label1.Caption = "*"
End SubPrivate Sub Command4_Click()
Label1.Caption = "/"
End SubPrivate Sub Command5_Click()
Select Case Label1.Caption
Case "+"
Text3.Text = Val(Text1.Text) + Val(Text2.Text)
Case "-"
Text3.Text = Val(Text1.Text) - Val(Text2.Text)
Case "*"
Text3.Text = Val(Text1.Text) * Val(Text2.Text)
Case "/"
Text3.Text = Val(Text1.Text) / Val(Text2.Text)
End Select
End SubPrivate Sub Form_Load()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
End Sub
希望对你能有所帮助。
vb编程代码
以下是两个check的代码
Private Sub Check1_Click()
If Check2.Value = Unchecked And Check1.Value = Checked Then
Command1.Enabled = True
Else
If Check1.Value = Checked And Check2.Value = Checked Then
MsgBox "选了两个，我也不知道您想怎么样:( ！"
End If
End If
End Sub
Private Sub Check2_Click()
If Check2.Value = Checked And Check1.Value = Unchecked Then
Command1.Enabled = False
Else
If Check1.Value = Checked And Check2.Value = Checked Then
MsgBox "选了两个，我也不知道您想怎么样:( ！"
End If
End If
End Sub
自己试试吧。把你想要的补上就行了。
如果仅要选择一项，建议你用option控件比较好。
Private Sub Check1_Click()
If Check1.Value = Checked Then
Check2.Value = UnChecked
Command1.Enabled = True
End If
End Sub
Private Sub Check2_Click()
If Check2.Value = Checked Then
Check1.Value = Unchecked
Command1.Enabled = False
End If
End Sub
在属性设置里把这两个Radio Button设成同一个group就行了
vb程序源代码
以前帮人写了一个,现在不知道放哪里了
曲柄滑块机构slider-crank mechanism
用曲柄和滑块来实现转动和移动相互转换的平面连杆机构，也称曲柄连杆机构。
VB程序代码：
Public Status, Status2 As Integer, tmp, tmp2 As Single
Private Sub Command1_Click(Index As Integer)
If Text1 = "0" Then
Text1 = ""
Dim i, j As Integer
Select Case Index
Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9
If Status <> 0 And Status2 = 1
Then tmp = Text1
If Status <> 0 Then
Text1 = ""
End If
Text1.SetFocus
SendKeys Index, True
If Status = 0 Then tmp = Text1
If Status2 = 1 Then tmp2 = Text1
Debug.Print tmp; tmp2; Status; Status2; vbCrLf
我也是从网上找的，我看了下结构应该没问题。
会vb的看一下！简单的高中编程题目？
Private Sub Command1_Click()
Text2.Text = Sqr(2 * (Text1.Text) * 9.8)
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 46 Or (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 8 Then
Else
KeyAscii = 0
End If
End Sub