189 8069 5689
下埋凳面这段代码，是我用来计算每个月存500元进银行，连续30年，最颂液余后连本带利能有多少钱。这里面涉及复利计算。界面中右边的文本框用来输出每一次计算的结果。
在古浪等地区，都构建了全面的区域性战略布局，加强发展的系统性、市场前瞻性、产品创新能力，以专注、极致的服务理念，为客户提供成都做网站、成都网站设计 网站设计制作按需搭建网站,公司网站建设,企业网站建设,品牌网站建设,全网营销推广,成都外贸网站建设,古浪网站建设费用合理。
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 '大复利
Dim fuli_small As Long '小复利
Dim i As Integer '循环变量
Dim DATAstring As String '数据字符串
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
结果_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("请输入一元二次方程的系数a")
b = InputBox("请输入一元二次方程的系数b")
c = InputBox("请输入一元二次方程的系数c")
If a = 0 Then
a = InputBox("因为a≠0，你输入的a＝烂早0，请重新输入系数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 "系数为"; a; b; c; "的一元二次方程的根分别为"; x1
Print "系数为"; a; b; c; "的一元二次方程的根分别为"; x2
Else
Print "此方程在实数范围内无解"
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 = "在实数范围内无解"
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
特殊例子（指定系数c的值为5）：
在窗体“Form1.frm”的“Command1_click“事件中编写代码（请不要随便更改其它代码），使之能够实现如下功能：在Text1输入整数a、、Text2输入b，判断一元二次方程ax2+bx+5=0有无实数根。并在Text3文本框中显示判断结果，即有实数根则在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定义变量，则上面的输入部分语句改为下面的语句，这样可以宴世把字符变量类型转化为数值类型：
a =val(Text1.Text)
b =val(Text2.Text)
楼主.给你写这么呢多你不给加点分吗?= =||
解一元一次方程：
设置4个文本框，分别代表一元一次方程中的参数k,b,x,y
分别命名txtk,txtb,txtx,txty.计算按钮命名为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
计算时求x则在txtx那里输入一个x，
求y则在txty那里输入一个y，
在各文本框中输入参数，
然后按下按钮，
就有提示框弹出，显示结果。
一元二次方程：
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"方程没有实根"
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
一元三次晌岁方程：
针对方程"ax^3+bx^2+cx+d=0"的求根程序。
控件只需一个Command1，结果显示在“立即”中。
代码如下。（参睁皮考）
========================
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("请输入a", eq)
b = InputBox("请输入b", eq)
c = InputBox("请输入c", eq)
d = InputBox("请输入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("输入二次项系数"))
b = Val(InputBox("输入一次项系数"))
c = Val(InputBox("输入常数项"))
d = b ^ 2 - 4 * a * c
If d 0 Then
MsgBox "方程无解"
ElseIf d = 0 Then
x = -b / (2 * a)
MsgBox "方程有一个解：" x
Else
x = (-b + Sqr(d)) / (2 * a)
y = (-b - Sqr(d)) / (2 * a)
MsgBox "方程有两个解：" 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为未知数,a,a',a",b,b',b",c,c',c",d,d',d",为用户输入的数值
解N元一次方程，indat为N+1行、N列的数组，outdat为N个元素的数组
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