求几道VB题答案

三角形面积：
Private Sub Command1_Click()
Dim errmessage As String
On Error GoTo 20
Dim a As Integer, b As Integer, c As Integer
Dim s As Single, area As Single
10 Picture1.Cls
a = InputBox("a=", "输入第一个边长")
b = InputBox("b=", "输入第二个边长")
c = InputBox("c=", "输入第三个边长")
If a + b > c And a + c > b And b + c > a Then
Picture1.Print "三边长为："
Picture1.Print "a="; a
Picture1.Print "b="; b
Picture1.Print "c="; c
s = (a + b + c) / 2
area = Sqr(s * (s - a) * (s - b) * (s - c))
Picture1.Print "三角形面积="; Format(area, "#.##")
Exit Sub
Else
20 errmessage = Err.Description & ",边长不匹配，请重输!"
MsgBox errmessage, vbExclamation + vbOKOnly
Resume 10
End If
End Sub
第二题：
Option Explicit
Dim book As books
Dim currentrec As Integer
Dim lastrec As Integer
Dim filenum As Integer
Private Sub Command1_Click(index As Integer)
Dim i As Integer
Select Case index
Case 0
If currentrec > 1 Then
currentrec = currentrec - 1
Picture1.Cls
Picture1.Print currentrec
Get #filenum, currentrec, book
Text1(0) = book.number
Text1(1) = book.bookname
Text1(2) = book.author
Text1(3) = book.price
Else
MsgBox "现为第一条记录,不能上移", vbInformation, "提示"
End If
Case 1
If currentrec < lastrec Then
currentrec = currentrec + 1
Picture1.Cls
Picture1.Print currentrec
Get #filenum, currentrec, book
Text1(0) = book.number
Text1(1) = book.bookname
Text1(2) = book.author
Text1(3) = book.price
Else
MsgBox "现为最后一条记录,不能下移", vbInformation, "提示"
End If
Case 2
For i = 0 To 3
Text1(i) = ""
Next i
Text1(0).SetFocus
Case 3
book.number = Text1(0)
book.bookname = Text1(1)
book.author = Text1(2)
book.price = Val(Text1(3))
lastrec = lastrec + 1
currentrec = lastrec
Put #filenum, lastrec, book
Picture1.Cls
Picture1.Print currentrec
End Select
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Form_Activate()
Picture1.Cls
Picture1.Print currentrec
End Sub

Private Sub Form_Load()
Dim i As Integer
filenum = FreeFile()
Open "c:\book.dat" For Random As #filenum Len = Len(book)
lastrec = LOF(filenum) / Len(book)
If lastrec = 0 Then
For i = 0 To 3
Text1(i) = ""
Next i
currentrec = 0
MsgBox "文件空，无记录，请添加数据", vbInformation, "提示"
Else
currentrec = 1
Get #filenum, currentrec, book
Text1(0) = book.number
Text1(1) = book.bookname
Text1(2) = book.author
Text1(3) = book.price
End If
End Sub
第三题：
Dim person As recordtype, filenum As Integer
Dim reclength As Long, recnum As Long
Private Sub Command1_Click()
Reset
filenum = FreeFile
reclength = Len(person)
Open "c:\address" For Random As filenum Len = reclength
End Sub

Private Sub Command2_Click()
Dim choice As Integer
recnum = Str(InputBox("输入记录号"))
Seek #filenum, recnum
Do While Not EOF(filenum)
Text4.Text = Str(recnum)
Get #filenum, recnum, person
Text1.Text = person.name
Text2.Text = person.tel_number
Text3.Text = person.post_code
choice = MsgBox("继续查看？", vbYesNo)
If choice = vbNo Then
Exit Do
End If
recnum = recnum + 1
Loop
End Sub

Private Sub Command3_Click()
Close #filenum
End
End Sub
第四题：
Private Sub Command1_Click()
Call objarg(Label1)
End Sub

Private Sub objarg(lad As Control)
lad.BackColor = &HFF0000
lad.ForeColor = &HFFFF&
lad.Font = 14
lad.FontItalic = ture
lad.Caption = "对象参数的传递"
End Sub

Private Sub Command2_Click()
Call frmarg(Form2)
End Sub

Private Sub Form_Load()
Form1.Left = 2000
Form1.Top = 1500

End Sub

Private Sub frmarg(f As Form)
f.Left = (Screen.Width - f.Width) / 2
f.Top = (Screen.Height - f.Height) / 2
Form1.Hide
f.Show
End Sub
第五题：
Private Sub Command1_Click()
Dim inta As Integer, st As String
inta = Text1.Text
Call factor(inta, st)
Text2.Text = st
End Sub

Private Sub factor(ByVal n As Integer, s As String)
Dim i As Integer
For i = 1 To n - 1
If n Mod i = 0 Then s = s & Str(i)
Next i
End Sub
第六题：
Option Explicit
Dim a(5) As Integer, b(5) As Integer, c() As Integer
Private Sub Command1_Click()
Dim i As Integer
For i = 1 To 5
a(i) = InputBox("输入数组a(" + Str(i) + ")")
Next i
Print "数组a:"
Call output(a)
For i = 1 To 5
b(i) = InputBox("输入数组b(" + Str(i) + ")")
Next i
Print "数组b:"
Call output(b)
End Sub

Private Sub Command2_Click()
Dim p As Integer, q As Integer, r As Integer
Dim i As Integer
p = 1: q = 1: r = 1
Do Until p > 5 Or q > 5
ReDim Preserve c(r)
If a(p) > b(q) Then
c(r) = b(q)
r = r + 1
q = q + 1
ElseIf a(p) < b(q) Then
c(r) = a(p)
r = r + 1
p = p + 1
Else
c(r) = a(p)
r = r + 1
q = q + 1
p = p + 1
End If
Loop
If p = 6 Then
Do While q < 6
ReDim Preserve c(r)
c(r) = b(q)
r = r + 1
q = q + 1
Loop
ElseIf q = 6 Then
Do While p < 6
ReDim Preserve c(r)
c(r) = a(p)
r = r + 1
p = p + 1
Loop
End If
Call output(c)
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub output(d() As Integer)
Dim i As Integer, a As Integer
a = UBound(d): i = 1
Do While i <= a
Print d(i);
i = i + 1
Loop
Print
End Sub

Private Sub Form_Load()

End Sub
希望我的答案对你有帮助

您可能感兴趣问答

Collapsible

热门标签

热点问答