下埋凳面這段代碼，是我用來計(jì)算每個(gè)月存500元進(jìn)銀行，連續(xù)30年，最頌液余后連本帶利能有多少錢。這里面涉及復(fù)利計(jì)算。界面中右邊的文本框用來輸出每一次計(jì)算的結(jié)果。
在古浪等地區(qū)，都構(gòu)建了全面的區(qū)域性戰(zhàn)略布局，加強(qiáng)發(fā)展的系統(tǒng)性、市場(chǎng)前瞻性、產(chǎn)品創(chuàng)新能力，以專注、極致的服務(wù)理念，為客戶提供成都做網(wǎng)站、成都網(wǎng)站設(shè)計(jì) 網(wǎng)站設(shè)計(jì)制作按需搭建網(wǎng)站,公司網(wǎng)站建設(shè),企業(yè)網(wǎng)站建設(shè),品牌網(wǎng)站建設(shè),全網(wǎng)營銷推廣,成都外貿(mào)網(wǎng)站建設(shè),古浪網(wǎng)站建設(shè)費(fèi)用合理。
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
? Dim nianxian As Integer '年限變量
? Dim dingcun As Integer '定存變量
? Dim fuli_big As Long '大復(fù)利
? Dim fuli_small As Long '小復(fù)利
? Dim i As Integer '循環(huán)變量
? Dim DATAstring As String '數(shù)據(jù)字符串
? nianxian = Val(年限_TextBox.Text)
? dingcun = Val(定存_TextBox.Text)
野滾 ? ? DATAstring = ""
? For i = 1 To nianxian
? ? ? fuli_small = dingcun * (1 + 0.1875)
? ? ? dingcun = fuli_small
? ? ? fuli_big = fuli_big + fuli_small
? ? ? DATAstring = DATAstring + "[" + Trim(Str(i)) + "]" + Str(fuli_big) + Chr(13) + Chr(10)
? ? ? 'DATAstring = DATAstring + "[" + Trim(Str(i)) + "]" + Str(fuli_small) + Chr(13) + Chr(10)
? Next
? 'fuli_big = fuli_small
? TextBox1.Text = DATAstring
? 結(jié)果_TextBox.Text = Str(fuli_big) + "元"
End Sub
vb代碼饑祥雀如下：
Private Sub Command1_Click()
Dim a As Single, b As Single, c As Single
Dim d As Single, x1 As Single, x2 As Single
a = InputBox("請(qǐng)輸入一元二次方程的系數(shù)a")
b = InputBox("請(qǐng)輸入一元二次方程的系數(shù)b")
c = InputBox("請(qǐng)輸入一元二次方程的系數(shù)c")
If a = 0 Then
a = InputBox("因?yàn)閍≠0，你輸入的a＝爛早0，請(qǐng)重新輸入系數(shù)a")
End If
d = b * b - 4 * a * c
If d = 0 Then
x1 = (-b + Sqr(d)) / (2 * a)
x2 = (-b - Sqr(d)) / (2 * a)
Print "系數(shù)為"; a; b; c; "的一元二次方程的根分別為"; x1
Print "系數(shù)為"; a; b; c; "的一元二次方程的根分別為"; x2
Else
Print "此方程在實(shí)數(shù)范圍內(nèi)無解"
End If
End Sub
一、按鈕“求一元二次方程”的vb代碼如下：
Private Sub Command1_Click()
a = Text1.Text
b = Text2.Text
c = Text3.Text
d = b * b - 4 * a * c
If d = 0 Then
X1 = (-b + Sqr(d)) / (2 * a)
X2 = (-b - Sqr(d)) / (2 * a)
Label4.Caption = X1
Label5.Caption = X2
Else
Label4.Caption = "在實(shí)數(shù)范圍內(nèi)無解"
End If
End Sub
二、按鈕“重置”的vb代碼如下：
Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Label4.Caption = ""
Label5.Caption = ""
End Sub
三、按鈕“退出”的vb代碼如下：
Private Sub Command3_Click()
End
End Sub
特殊例子（指定系數(shù)c的值為5）：
在窗體“Form1.frm”的“Command1_click“事件中編寫代碼（請(qǐng)不要隨便更改其它代碼），使之能夠?qū)崿F(xiàn)如下功能：在Text1輸入整數(shù)a、、Text2輸入b，判斷一元二次方程ax2+bx+5=0有無實(shí)數(shù)根。并在Text3文本框中顯示判斷結(jié)果，即有實(shí)數(shù)根則在Text3文本框中輸出“有”，否則輸出“無”。
VB程序代碼如下：
Private Sub Command1_Click()
dim a as single,b as single
a = Text1.Text
b = Text2.Text
d = b * b - 4 * a * 5
If d = 0 Then
Text3.Text="有"
Else
Text3.Text="無"
End If
End Sub
如果不用dim定義變量，則上面的輸入部分語句改為下面的語句，這樣可以宴世把字符變量類型轉(zhuǎn)化為數(shù)值類型：
a =val(Text1.Text)
b =val(Text2.Text)
樓主.給你寫這么呢多你不給加點(diǎn)分嗎?= =||
解一元一次方程：
設(shè)置4個(gè)文本框，分別代表一元一次方程中的參數(shù)k,b,x,y
分別命名txtk,txtb,txtx,txty.計(jì)算按鈕命名為cmdCalc。
在代碼窗口里粘貼如下代碼:
Private Sub cmdCalc_Click()
Dim k, b As Long
k = txtk.Text
b = txtb.Text
If txtx.Text = "x" Then
MsgBox "x的值為:" (txty.Text - b) / k
ElseIf txty.Text = "y" Then
MsgBox "y的值為宴早睜:" k * txtx.Text + b
End If
End Sub
計(jì)算時(shí)求x則在txtx那里輸入一個(gè)x，
求y則在txty那里輸入一個(gè)y，
在各文本框中輸入?yún)?shù)，
然后按下按鈕，
就有提示框彈出，顯示結(jié)果。
一元二次方程：
privat sub command1_click()
dim a,b,c,x1,x2,d as sigle
a=val(textl.text)
b=val(text2.text)
c=val(text3.text)
d=b^2-4*a*c
if d0 then
x1=(-b+sqr(d))/(2*a)
x2=(-b-sqr(d))/(2*a)
else if d=0 then
x1=(-b/2*a)
x2=x1
else msgbox"方程沒有實(shí)根"
end if
text4.text="x1=" x1 "" "x2=" x2
end sub
sub min(byref a() as integer)
dim i,j as interger
for i=1 to 9
for j=i+1 to 10
if a a(i)a(j) then
t=a(j)
a(i)=a(j)
a(j)=t
end if
next
next
end sub
private sub command_(click)
dim b(1 to 10) as interger
dim a(1 to 10) as interger
randomize
for i=1 to 10
a(i)=int(rnd*90)+10
list1.additem a(i)
b(i)=int(rnd*90)+ 10
list2.additem b(i)
next
call min(a)
call min(b)
if a(1)b(1) then
m=a(1)
else
m=b(1)
end if
text1.text="A,B種的最小值：" vbcrlf m
end sub
一元三次晌歲方程：
針對(duì)方程"ax^3+bx^2+cx+d=0"的求根程序。
控件只需一個(gè)Command1，結(jié)果顯示在“立即”中。
代碼如下。（參睜皮考）
========================
Private Sub Command1_Click()
Dim x1r As Double, x1i As Double, x2r As Double, x2i As Double, x3r As Double, x3i As Double
Dim ret As String
Const eq = "ax^3+bx^2+cx+d=0"
a = InputBox("請(qǐng)輸入a", eq)
b = InputBox("請(qǐng)輸入b", eq)
c = InputBox("請(qǐng)輸入c", eq)
d = InputBox("請(qǐng)輸入d", eq)
ret = CubicEquation(a, b, c, d, x1r, x1i, x2r, x2i, x3r, x3i) '5x^3+4x^2+3x-12=0
Debug.Print "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" ret
Debug.Print x1r; " + "; x1i; " i"
Debug.Print x2r; " + "; x2i; " i"
Debug.Print x3r; " + "; x3i; " i"
End Sub
Private Function CubicEquation _
(ByVal a As Double, ByVal b As Double, ByVal c As Double, ByVal d As Double, _
x1r As Double, x1i As Double, x2r As Double, x2i As Double, x3r As Double, x3i As Double) As String
'Cubic equation(v2.2), coded by btef (please let this line remain)
Dim e As Double, f As Double, g As Double, h As Double, delta As Double
Dim r As Double, sita As Double, pi As Double, rr As Double, ri As Double
If a = 0 Then
CubicEquation = "Not a cubic equation: a = 0"
Exit Function
End If
'pi = 3.14159265358979
pi = 4 * Atn(1)
b = b / a 'simplify to a=1: x^3+bx^2+cx+d=0
c = c / a
d = d / a
e = -b ^ 2 / 3 + c 'substitute x=y-b/3: y^3+ey+f=0
f = (2 * b ^ 2 - 9 * c) * b / 27 + d
If e = 0 And f = 0 Then
x1r = -b / 3
x2r = x1r
x3r = x1r
CubicEquation = "3 same real roots:"
ElseIf e = 0 Then 'need to deal with e = 0, or it will cause z = 0 later.
r = -f 'y^3+f=0, y^3=-f
r = Cur(r)
x1r = r - b / 3 'a real root
If r 0 Then 'r never = 0 since g=f/2, f never = 0 there
sita = 2 * pi / 3
x2r = r * Cos(sita) - b / 3
x2i = r * Sin(sita)
Else
sita = pi / 3
x2r = -r * Cos(sita) - b / 3
x2i = -r * Sin(sita)
End If
x3r = x2r
x3i = -x2i
CubicEquation = "1 real root and 2 image roots:"
Else 'substitute y=z-e/3/z: (z^3)^2+fz^3-(e/3)^3=0, z^3=-g+sqr(delta)
g = f / 2 '-q-sqr(delta) is ignored
h = e / 3
delta = g ^ 2 + h ^ 3
If delta 0 Then
r = Sqr(g ^ 2 - delta)
sita = Argument(-g, Sqr(-delta)) 'z^3=r(con(sita)+isin(sita))
r = Cur(r)
rr = r - h / r
sita = sita / 3 'z1=r(cos(sita)+isin(sita))
x1r = rr * Cos(sita) - b / 3 'y1=(r-h/r)cos(sita)+i(r+h/r)sin(sita), x1=y1-b/3
sita = sita + 2 * pi / 3 'no image part since r+h/r = 0
x2r = rr * Cos(sita) - b / 3
sita = sita + 2 * pi / 3
x3r = rr * Cos(sita) - b / 3
CubicEquation = "3 real roots:"
Else 'delta = 0
r = -g + Sqr(delta)
r = Cur(r)
rr = r - h / r
ri = r + h / r
If ri = 0 Then
CubicEquation = "3 real roots:"
Else
CubicEquation = "1 real root and 2 image roots:"
End If
x1r = rr - b / 3 'a real root
If r 0 Then 'r never = 0 since g=f/2, f never = 0 there
sita = 2 * pi / 3
x2r = rr * Cos(sita) - b / 3
x2i = ri * Sin(sita)
Else 'r 0
sita = pi / 3
x2r = -rr * Cos(sita) - b / 3
x2i = -ri * Sin(sita)
End If
x3r = x2r
x3i = -x2i
End If
End If
End Function
Private Function Cur(v As Double) As Double
If v 0 Then
Cur = -(-v) ^ (1 / 3)
Else
Cur = v ^ (1 / 3)
End If
End Function
Private Function Argument(a As Double, b As Double) As Double
Dim sita As Double, pi As Double
'pi = 3.14159265358979
pi = 4 * Atn(1)
If a = 0 Then
If b = 0 Then
Argument = pi / 2
Else
Argument = -pi / 2
End If
Else
sita = Atn(Abs(b / a))
If a 0 Then
If b = 0 Then
Argument = sita
Else
Argument = -sita
End If
ElseIf a 0 Then
If b = 0 Then
Argument = pi - sita
Else
Argument = pi + sita
End If
End If
End If
End Function
二元一次方程：
Dim a, b, c As Integer
Dim x, y As Single
Dim d As Double
a = Val(InputBox("輸入二次項(xiàng)系數(shù)"))
b = Val(InputBox("輸入一次項(xiàng)系數(shù)"))
c = Val(InputBox("輸入常數(shù)項(xiàng)"))
d = b ^ 2 - 4 * a * c
If d 0 Then
MsgBox "方程無解"
ElseIf d = 0 Then
x = -b / (2 * a)
MsgBox "方程有一個(gè)解：" x
Else
x = (-b + Sqr(d)) / (2 * a)
y = (-b - Sqr(d)) / (2 * a)
MsgBox "方程有兩個(gè)解：" x "和" y
End If
三元一次方程：
方程組如下,
ax+by+cz=d
a'x+b'y+c'z=d'
a"x+b"y+c"z=d"
其中x,y,z為未知數(shù),a,a',a",b,b',b",c,c',c",d,d',d",為用戶輸入的數(shù)值
解N元一次方程，indat為N+1行、N列的數(shù)組，outdat為N個(gè)元素的數(shù)組
Public Sub 解方程(ByRef InDat() As Double, ByVal InDatCount As Long, ByRef OutDat() As Double, ByRef OutDatCount As Long)
Dim Xt() As Double
Dim Dt As Double
Dim Ss As Long
Dim OtSCount As Long
Dim XtOut() As Double
If InDatCount 1 Then
ReDim Xt(1 To InDatCount - 1, 1 To InDatCount) As Double
For j = 1 To InDatCount - 1 '行
For i = 2 To InDatCount + 1 '列
Xt(j, i - 1) = InDat(j, i) * InDat(InDatCount, 1) / InDat(1, 1) - InDat(InDatCount, i)
Next i
Next j
OtSCount = 0
解方程 Xt, InDatCount - 1, XtOut, OtSCount
Dt = 0
For i = 1 To InDatCount - 1
Dt = Dt + InDat(InDatCount, i + 1) * XtOut(i)
Next i
Dt = Dt + InDat(InDatCount, i + 1)
ReDim Preserve OutDat(1 To 1 + OtSCount) As Double
OutDat(1) = -Dt / InDat(InDatCount, 1)
For i = 2 To OtSCount + 1
OutDat(i) = XtOut(i - 1)
Next i
OutDatCount = 1 + OtSCount
Else
ReDim OutDat(1 To 1) As Double
If InDat(1, 1) 0 Then
OutDat(1) = -InDat(1, 2) / InDat(1, 1)
Else
OutDat(1) = 0
End If
OutDatCount = 1
End If
End Sub
重慶分公司
重慶分公司
