vb編程作業
1. VB編程作業，請指導下怎麼寫
1. 打開VB軟體
2. 拖按鈕和圖片控制項到頁面上
3. 點顯示按鈕寫代碼，Image1.Visble=True(先要在圖片屬性那裡設置成False)，然後Command1.Enable=False
4. 隱藏按鈕與上面代碼相反即可
5. 注意圖片控制項和按鈕的默認值即可
2. VB作業 編程
一
Private Sub form_Click()
Dim b, c, d, sxh As Integer
For i = 100 To 999
b = i \ 100
c = (i - b * 100) \ 10
d = i - b * 100 - c * 10
sxh = b ^ 3 + c ^ 3 + d ^ 3
If sxh = i Then
Print sxh;
End If
Next i
End Sub
二、不知道你要求的是什麼的值！
三
Private Sub form_Click()
Dim n, s As Long
n = 1: s = 0
For i = 1 To 10
n = n * i
s = s + n
Next i
Print s
End Sub
3. 求教VB高手！！！一個VB程序的編寫作業！！！
'界面不用設計的
直接復制以下代碼點擊一下窗體就可以運行了
示例代碼如下：
Private
Sub
Form_Click()
Dim
a(1
To
60)
As
Integer
Randomize
Timer
Print
"隨機產生的數據是："
For
i
=
1
To
60
a(i)
=
Int(Rnd
*
101
+
100)
Print
a(i);
"
";
If
i
Mod
10
=
0
Then
Print
Next
i
Print
For
i
=
1
To
59
For
j
=
i
+
1
To
60
If
a(i)
>
a(j)
Then
c
=
a(i)
a(i)
=
a(j)
a(j)
=
c
End
If
Next
j
Next
i
Print
"排好序的奇數數據是："
For
i
=
1
To
60
If
a(i)
Mod
2
<>
0
Then
Print
a(i);
"
";
b
=
b
+
1
If
b
Mod
10
=
0
Then
Print
End
If
Next
i
End
Sub
4. vb作業編程，急！！
'以前寫的一個，連質數處理也給你，什麼都有了
Private Sub Command1_Click()
Dim j%, k%, m%, n%, mArr(1 To 80), OArr(), EArr(), ZArr(), Q%, E%, tmP%, Z%, mSum%
Q = 1
E = 1
Z = 1
Print "80個隨機整數："
For j = 1 To 80
Randomize
mArr(j) = Int(90 * Rnd + 10)
Print CStr(mArr(j)); Spc(2);
If j Mod 10 = 0 Then Print
Next j
Print
For m = 1 To 79 '排序
For n = 80 To m + 1 Step -1
If mArr(n) < mArr(n - 1) Then tmP = mArr(n): mArr(n) = mArr(n - 1): mArr(n - 1) = tmP
Next n
Next m
For m = 1 To 80 '奇偶分組
If mArr(m) Mod 2 = 1 Then
ReDim Preserve OArr(1 To Q)
OArr(Q) = mArr(m)
Q = Q + 1
Else
ReDim Preserve EArr(1 To E)
EArr(E) = mArr(m)
E = E + 1
End If
If zs(CInt(mArr(m))) = True Then '素數分組
ReDim Preserve ZArr(1 To Z)
ZArr(Z) = mArr(m)
mSum = mSum + ZArr(Z)
Z = Z + 1
End If
Next m
Print
Print "偶數：" '在窗體輸出
For m = 1 To UBound(EArr)
Print CStr(EArr(m)); Spc(2);
If m Mod 10 = 0 Then Print
Next m
Print
Print
Print "奇數："
For m = 1 To UBound(OArr)
Print CStr(OArr(m)); Spc(2);
If m Mod 10 = 0 Then Print
Next m
Print
Print
Print "素數："
For m = 1 To UBound(ZArr)
Print CStr(ZArr(m)); Spc(2);
If m Mod 10 = 0 Then Print
Next m
Print
Print "素數個數："; UBound(ZArr)
Print "素數之和："; mSum
End Sub
Private Function zs(x As Integer) As Boolean '素數判斷子過程
Dim d%
If x = 2 Then zs = True: Exit Function
For d = 2 To Int(Sqr(x))
If x Mod d = 0 Then Exit For: zs = False
If d = Int(Sqr(x)) Then zs = True
Next
End Function
5. vb編程作業
首先要說明一下，按要求能得到的數不一定能有10個。如首個隨機數等於500，則後面的數一個也不能得到了。
Private Sub Command1_Click()
Dim a(10) As Integer
n = 0
While n < 10 And a(n) < 500
n = n + 1
While a(n) <= a(n - 1)
a(n) = Int(401 * Rnd) + 100
Wend
Wend
Print "得到的數有"; n; "個，它們是："
For i = 1 To n
Print a(i);
Next i
End Sub
6. VB編程作業
ImportsSystem.IO
PublicClassForm1
DimneedSaveAsBoolean=False
DimcurrentFileNameAsString
PrivateSubTMenuItemFont_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemFont.Click
DimfdAsNewFontDialog
fd.Font=RTexEide.Font
If(fd.ShowDialog()=Windows.Forms.DialogResult.OK)Then
RTexEide.SelectionFont=fd.Font
EndIf
fd.Dispose()
EndSub
PrivateSubTMenuItemColor_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemColor.Click
DimcdAsNewColorDialog
cd.AllowFullOpen=True
cd.Color=RTexEide.ForeColor
If(cd.ShowDialog()=Windows.Forms.DialogResult.OK)Then
RTexEide.SelectionColor=cd.Color
EndIf
cd.Dispose()
EndSub
PrivateSubTMenuItemBackColor_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemBackColor.Click
DimcdAsNewColorDialog
cd.AllowFullOpen=True
cd.Color=RTexEide.ForeColor
If(cd.ShowDialog()=Windows.Forms.DialogResult.OK)Then
RTexEide.BackColor=cd.Color
EndIf
cd.Dispose()
EndSub
PrivateSubTMenuItemTime_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemTime.Click
RTexEide.Text=RTexEide.Text+DateTime.Now
EndSub
PrivateSubRTexEide_TextChanged(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesRTexEide.TextChanged
RTexEide.SelectionStart=RTexEide.Text.Length
RTexEide.ScrollToCaret()
needSave=True
EndSub
PrivateSubTMenuItemNew_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemNew.Click
IfneedSave=TrueThen
DimresultAsDialogResult=MessageBox.Show("文本內容已經改變,需要保存嗎?","保存文件",MessageBoxButtons.YesNoCancel)
Ifresult=Windows.Forms.DialogResult.YesThen
TMenuItemSave_Click(sender,e)
RTexEide.Clear()
Me.Text="文本編輯--新建文本"
needSave=False
EndIf
Ifresult=Windows.Forms.DialogResult.NoThen
RTexEide.Clear()
Me.Text="文本編輯--新建文本"
needSave=False
EndIf
Else
RTexEide.Clear()
Me.Text="文本編輯新建文本"
EndIf
EndSub
PrivateSubTMenuItemOpen_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemOpen.Click
IfneedSave=TrueThen
DimresltAsDialogResult=MessageBox.Show("文本內容已經改變,需要保存嗎?","保存文件",MessageBoxButtons.YesNoCancel)
Ifreslt=Windows.Forms.DialogResult.YesThen
TMenuItemSave_Click(sender,e)
needSave=False
EndIf
EndIf
DimfileNameAsString=GetOpenFile()
IffileName<>""Then
currentFileName=fileName
OpenFile()
EndIf
EndSub
PrivateSubOpenFile()
Try
DimfAsNewFileInfo(currentFileName)
DimreaderAsStreamReader=f.OpenText()
RTexEide.Text=reader.ReadToEnd()
reader.Close()
Me.Text="文本編輯——"+f.Name
CatchexAsException
MessageBox.Show(ex.Message)
EndTry
EndSub
PrivateFunctionGetOpenFile()AsString
openFile.Title="打開文本文件"
openFile.InitialDirectory=Environment.SpecialFolder.Desktop
openFile.CheckFileExists=True
openFile.CheckPathExists=True
openFile.AddExtension=True
openFile.Multiselect=False
openFile.Filter="文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
If(openFile.ShowDialog()=DialogResult.OK)Then
ReturnopenFile.FileName
Else
ReturnNothing
EndIf
EndFunction
PrivateSubTMenuItemSave_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemSave.Click
IfcurrentFileName=""Then
TMenuItemSaveA_Click(sender,e)
Else
SaveFile(RTexEide.Text)
EndIf
needSave=False
EndSub
PrivateSubSaveFile(ByValstrAsString)
Try
DimwriteAsNewStreamWriter(currentFileName)
write.Write(str)
write.Close()
CatchexAsException
MessageBox.Show(ex.Message)
EndTry
EndSub
PrivateSubTMenuItemSaveA_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemSaveA.Click
DimfileAsString=GetSavefile()
Iffile<>""Then
currentFileName=file
SaveFile(RTexEide.Text)
DimfAsNewFileInfo(currentFileName)
Me.Text="文本編輯--"+f.Name
needSave=False
EndIf
EndSub
PrivateFunctionGetSavefile()
saveFile.Title="保存文本文件"
saveFile.InitialDirectory=Environment.SpecialFolder.Desktop
saveFile.OverwritePrompt=True
saveFile.CreatePrompt=True
saveFile.AddExtension=True
saveFile.Filter="文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
IfsaveFile.ShowDialog()=DialogResult.OKThen
ReturnsaveFile.FileName
Else
ReturnNothing
EndIf
EndFunction
PrivateSubTMenuItemPageset_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemPageset.Click
pageset.Document=PrintDocument1
pageset.ShowDialog()
EndSub
PrivateSubTMenuItemPrint_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemPrint.Click
DimprDialogAsNewPrintDialog
prDialog.Document=PrintDocument1
IfprDialog.ShowDialog()=Windows.Forms.DialogResult.OKThen
Try
PrintDocument1.Print()
CatchexAsException
MessageBox.Show(ex.Message)
EndTry
EndIf
EndSub
PrivateSubTMenuItemExit_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemExit.Click
Me.Close()
EndSub
PrivateSubTMenuItemUndo_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemUndo.Click
IfRTexEide.CanUndo=TrueThen
RTexEide.Undo()
EndIf
EndSub
PrivateSubTMenuItemCut_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemCut.Click
IfRTexEide.SelectedText<>""Then
RTexEide.Cut()
EndIf
EndSub
PrivateSubTMenuItemCopy_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemCopy.Click
IfRTexEide.SelectionLength>0Then
RTexEide.Copy()
EndIf
EndSub
PrivateSubTMenuItemPast_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemPast.Click
IfClipboard.GetDataObject().GetDataPresent(DataFormats.Text)Then
IfRTexEide.SelectionLength>0Then
DimresultAsDialogResult=MessageBox.Show("你想覆蓋掉選擇的文本嗎?","覆蓋確認",MessageBoxButtons.YesNo)
If(result=Windows.Forms.DialogResult.No)Then
RTexEide.SelectionStart=RTexEide.SelectionStart+RTexEide.SelectionLength
EndIf
EndIf
RTexEide.Paste()
EndIf
EndSub
PrivateSubTMenuItemDelete_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemDelete.Click
RTexEide.SelectedText.Remove(0,RTexEide.SelectionLength)
RTexEide.SelectedText=""
EndSub
PrivateSubTMenuItemSellall_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemSellall.Click
RTexEide.SelectAll()
EndSub
PrivateSubTMenuItemEdit_DropDownOpened(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemEdit.DropDownOpened
IfClipboard.GetDataObject().GetDataPresent(DataFormats.Text)Then
TMenuItemPast.Enabled=True
Else
TMenuItemPast.Enabled=False
EndIf
IfRTexEide.SelectionLength>0Then
TMenuItemCopy.Enabled=True
TMenuItemCut.Enabled=True
TMenuItemDelete.Enabled=True
Else
TMenuItemCopy.Enabled=False
TMenuItemCut.Enabled=False
TMenuItemDelete.Enabled=False
EndIf
If(RTexEide.CanUndo=True)Then
TMenuItemUndo.Enabled=True
Else
TMenuItemUndo.Enabled=False
EndIf
EndSub
PrivateSubPrintDocument1_PrintPage(ByValsenderAsSystem.Object,ByValeAsSystem.Drawing.Printing.PrintPageEventArgs)HandlesPrintDocument1.PrintPage
DimlinesPerPageAsSingle=0
DimyPosAsSingle=0
DimcountAsInteger
DimleftMarginAsSingle=e.MarginBounds.Left
DimtopMarginAsSingle=e.MarginBounds.Top
DimlineAsString=""
(currentFileName)
DimbrushAsNewSolidBrush(RTexEide.ForeColor)
linesPerPage=e.MarginBounds.Height/RTexEide.Font.GetHeight(e.Graphics)
Whilecount<linesPerPageAnd((line=streamToPrint.ReadLine())<>"")
yPos=topMargin+(count*RTexEide.Font.GetHeight(e.Graphics))
e.Graphics.DrawString(line,RTexEide.Font,brush,leftMargin,yPos,NewStringFormat())
count+=0
EndWhile
If(line<>"")Then
e.HasMorePages=True
Else
e.HasMorePages=False
EndIf
EndSub
PrivateSubForm1_FormClosing(ByValsenderAsSystem.Object,ByValeAsSystem.Windows.Forms.FormClosingEventArgs)HandlesMyBase.FormClosing
IfneedSave=TrueThen
DimresultAsDialogResult=MessageBox.Show("文本內容已經改變,需要保存嗎?","保存文件",MessageBoxButtons.YesNoCancel)
Ifresult=DialogResult.CancelThen
e.Cancel=True
EndIf
Ifresult=DialogResult.YesThen
TMenuItemSave_Click(sender,e)
e.Cancel=False
EndIf
EndIf
EndSub
PrivateSubTMenuItemWord_CheckedChanged(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesTMenuItemWord.CheckedChanged
IfTMenuItemWord.Checked=TrueThen
RTexEide.WordWrap=True
Else
RTexEide.WordWrap=False
EndIf
EndSub
PrivateSubForm1_Load(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesMyBase.Load
Me.StartPosition=FormStartPosition.CenterScreen
EndSub
EndClass
7. VB的編程作業~~~急用~~~
第一題答案：
'直到第50項程序如下:
Dim n As Integer
Dim i As Integer
Dim j As Integer
Dim answerE50 As Double
Dim answerE10E_6 As Double
Dim temp As Double
n = 50
answerE50 = 1
For i = 1 To n
temp = 1
For j = 1 To i
temp = temp * j
Next j
answerE50 = answerE50 + 1 / temp
Next
'直到最後一項小於10的-6次，程序如下：
answerE10E_6 = 1
i = 1
Do
temp = 1
For j = 1 To i
temp = temp * j
Next j
answerE10E_6 = answerE10E_6 + 1 / temp
i = i + 1
Loop Until 1 / temp < 0.000001
MsgBox("加和50項答案是:" & answerE50 & vbCrLf & "直到最後一項小於10的-6次，答案是：" & answerE10E_6)
第二題答案：
Dim i As Integer
Dim iMin As Integer
Dim iMax As Integer
Dim answerStr As String
answerStr = ""
iMin = Sqrt(1000)
iMax = Sqrt(10000)
For i = iMin To iMax
answerStr = answerStr & "、" & i * i
Next
MsgBox(answerStr)
8. 大學VB編程作業
Private Sub Command1_Click()
Dim i As Integer
Dim j As Integer
Dim s As String
Dim a() As String
TEXTTOARRAY a
For i = 0 To Text1.Text - 2
For j = i + 1 To Text1.Text - 1
If Val(a(i)) > Val(a(j)) Then
s = a(i)
a(i) = a(j)
a(j) = s
End If
Next
Next
ARRAYTOTEXT a
End Sub
Private Sub Form_Load()
Text1.Text = 5
Text2.Text = "3 4 20 7 2"
Text3.Text = ""
End Sub
Private Sub TEXTTOARRAY(a() As String)
a = Split(Text2.Text, " ")
End Sub
Private Sub ARRAYTOTEXT(a() As String)
Text3.Text = Join(a, " ")
End Sub
9. VB編程與應用作業
1,load
2，hide
3，read
4，output
5，change
6，drive
7，eof
8，_
9，菜單項的索引號必須從1開始
10，drag方法
11，public
12，byval
13，paramarra
14，1個sub過程必須有1個end sub語句。
15，index
16，6
17，autosize
18，column
19，1
20，load
10. VB6.0編程作業
Private Sub Command1_Click() '1！+（1！+3！）+（1！+3！+5！）+......+(1!+3!+......+n！） Dim n, jc, sum1, sum n = Val(InputBox("n=")) jc = 1 If n Mod 2 = 1 Then For i = 1 To n Step 2 jc = 1 sum1 = jc For j = 3 To i Step 2 jc = jc * (j - 1) * j sum1 = sum1 + jc Next j sum = sum + sum1 Next i MsgBox sum Else MsgBox "n不是奇數" End If End Sub