求vb题不会怎么找答案目解答


三角形面积:Private Sub Command1_Click()Dim errmessage As StringOn Error GoTo 20Dim a As Integer, b As Integer, c As IntegerDim s As Single, area As Single10 Picture1.Clsa = InputBox("a=", "输入第一个边长")b = InputBox("b=", "输入第二个边长")c = InputBox("c=", "输入第三个边长")If a + b > c And a + c > b And b + c > a ThenPicture1.Print "三边长为:"Picture1.Print "a="; aPicture1.Print "b="; bPicture1.Print "c="; cs = (a + b + c) / 2area = Sqr(s * (s - a) * (s - b) * (s - c))Picture1.Print "三角形面积="; Format(area, "#.##")Exit SubElse20 errmessage = Err.Description & ",边长不匹配,请重输!"MsgBox errmessage, vbExclamation + vbOKOnlyResume 10End IfEnd Sub第二题:Option ExplicitDim book As booksDim currentrec As IntegerDim lastrec As IntegerDim filenum As IntegerPrivate Sub Command1_Click(index As Integer)Dim i As IntegerSelect Case indexCase 0If currentrec > 1 Thencurrentrec = currentrec - 1Picture1.ClsPicture1.Print currentrecGet #filenum, currentrec, bookText1(0) = book.numberText1(1) = book.booknameText1(2) = book.authorText1(3) = book.priceElseMsgBox "现为第一条记录,不能上移", vbInformation, "提示"End IfCase 1If currentrec < lastrec Thencurrentrec = currentrec + 1Picture1.ClsPicture1.Print currentrecGet #filenum, currentrec, bookText1(0) = book.numberText1(1) = book.booknameText1(2) = book.authorText1(3) = book.priceElseMsgBox "现为最后一条记录,不能下移", vbInformation, "提示"End IfCase 2For i = 0 To 3Text1(i) = ""Next iText1(0).SetFocusCase 3book.number = Text1(0)book.bookname = Text1(1)book.author = Text1(2)book.price = Val(Text1(3))lastrec = lastrec + 1currentrec = lastrecPut #filenum, lastrec, bookPicture1.ClsPicture1.Print currentrecEnd SelectEnd SubPrivate Sub Command2_Click()EndEnd SubPrivate Sub Form_Activate()Picture1.ClsPicture1.Print currentrecEnd SubPrivate Sub Form_Load()Dim i As Integerfilenum = FreeFile()Open "c:\book.dat" For Random As #filenum Len = Len(book)lastrec = LOF(filenum) / Len(book)If lastrec = 0 ThenFor i = 0 To 3Text1(i) = ""Next icurrentrec = 0MsgBox "文件空,无记录,请添加数据", vbInformation, "提示"Elsecurrentrec = 1Get #filenum, currentrec, bookText1(0) = book.numberText1(1) = book.booknameText1(2) = book.authorText1(3) = book.priceEnd IfEnd Sub第三题:Dim person As recordtype, filenum As IntegerDim reclength As Long, recnum As LongPrivate Sub Command1_Click()Resetfilenum = FreeFilereclength = Len(person)Open "c:\address" For Random As filenum Len = reclengthEnd SubPrivate Sub Command2_Click()Dim choice As Integerrecnum = Str(InputBox("输入记录号"))Seek #filenum, recnumDo While Not EOF(filenum)Text4.Text = Str(recnum)Get #filenum, recnum, personText1.Text = person.nameText2.Text = person.tel_numberText3.Text = person.post_codechoice = MsgBox("继续查看?", vbYesNo)If choice = vbNo ThenExit DoEnd Ifrecnum = recnum + 1LoopEnd SubPrivate Sub Command3_Click()Close #filenumEndEnd Sub第四题:Private Sub Command1_Click()Call objarg(Label1)End SubPrivate Sub objarg(lad As Control)lad.BackColor = &HFF0000lad.ForeColor = &HFFFF&lad.Font = 14lad.FontItalic = turelad.Caption = "对象参数的传递"End SubPrivate Sub Command2_Click()Call frmarg(Form2)End SubPrivate Sub Form_Load()Form1.Left = 2000Form1.Top = 1500End SubPrivate Sub frmarg(f As Form)f.Left = (Screen.Width - f.Width) / 2f.Top = (Screen.Height - f.Height) / 2Form1.Hidef.ShowEnd Sub第五题:Private Sub Command1_Click()Dim inta As Integer, st As Stringinta = Text1.TextCall factor(inta, st)Text2.Text = stEnd SubPrivate Sub factor(ByVal n As Integer, s As String)Dim i As IntegerFor i = 1 To n - 1If n Mod i = 0 Then s = s & Str(i)Next iEnd Sub第六题:Option ExplicitDim a(5) As Integer, b(5) As Integer, c() As IntegerPrivate Sub Command1_Click()Dim i As IntegerFor i = 1 To 5a(i) = InputBox("输入数组a(" + Str(i) + ")")Next iPrint "数组a:"Call output(a)For i = 1 To 5b(i) = InputBox("输入数组b(" + Str(i) + ")")Next iPrint "数组b:"Call output(b)End SubPrivate Sub Command2_Click()Dim p As Integer, q As Integer, r As IntegerDim i As Integerp = 1: q = 1: r = 1Do Until p > 5 Or q > 5ReDim Preserve c(r)If a(p) > b(q) Thenc(r) = b(q)r = r + 1q = q + 1ElseIf a(p) < b(q) Thenc(r) = a(p)r = r + 1p = p + 1Elsec(r) = a(p)r = r + 1q = q + 1p = p + 1End IfLoopIf p = 6 ThenDo While q < 6ReDim Preserve c(r)c(r) = b(q)r = r + 1q = q + 1LoopElseIf q = 6 ThenDo While p < 6ReDim Preserve c(r)c(r) = a(p)r = r + 1p = p + 1LoopEnd IfCall output(c)End SubPrivate Sub Command3_Click()EndEnd SubPrivate Sub output(d() As Integer)Dim i As Integer, a As Integera = UBound(d): i = 1Do While i <= aPrint d(i);i = i + 1LoopPrintEnd SubPrivate Sub Form_Load()End Sub希望我的答案对你有帮助

我要回帖

更多关于 vb题不会怎么找答案 的文章

 

随机推荐