黄金分割法VB程序.doc

VERSION 5.00Begin VB.Form Form1 BorderStyle = 4 Fixed ToolWindow Caption = Form1 ClientHeight = 4995 ClientLeft = 5550 ClientTop = 4260 ClientWidth = 5295 BeginProperty Font Name = 宋体 Size = 6.75 Charset = 134 Weight = 400 Underline = 0 False Italic = 0 False Strikethrough = 0 False EndProperty LinkTopic = Form1 MaxButton = 0 False MinButton = 0 False ScaleHeight = 333 ScaleMode = 3 Pixel ScaleWidth = 353 ShowInTaskbar = 0 False StartUpPosition = 1 所有者中心 Begin VB.TextBox Text5 BeginProperty Font Name = 宋体 Size = 12 Charset = 134 Weight = 400 Underline = 0 False Italic = 0 False Strikethrough = 0 False EndProperty ForeColor = &H00000000& Height = 1140 Left = 2040 MultiLine = -1 True TabIndex = 8 Top = 3600 Width = 2655 End Begin VB.CommandButton Command1 Caption = 求优 BeginProperty Font Name = 楷体_GB2312 Size = 15 Charset = 134 Weight = 400 Underline = 0 False Italic = 0 False Strikethrough = 0 False EndProperty Height = 480 Left = 360 TabIndex = 7 Top = 3840 Width = 1095 End Begin VB.TextBox Text4 BeginProperty Font Name = 楷体_GB2312 Size = 15 Charset = 134 Weight = 400 Underline = 0 False Italic = 0 False Strikethrough = 0 False EndProperty Height = 420 Left = 2040 TabIndex = 6 Text = 0.005 Top = 2760 Width = 2655 End Begin VB.TextBox Text3 BeginProperty Font Name = 楷体_GB2312 Size = 15 Charset = 134 Weight = 400 Underline = 0 False Italic = 0 False Strikethrough = 0 False EndProperty Height = 420 Left = 3000 TabIndex = 4 Text = 3 Top = 1920 Width = 615 End Begin VB.TextBox Text2 BeginProperty Font Name = 楷体_GB2312 Size = 15 Charset = 134 Weight = 400 Underline = 0 False Italic = 0 False Strikethrough = 0 False EndProperty Height = 420 Left = 2040 TabIndex = 3 Text = -1 Top = 1920 Width = 615 End Begin VB.TextBox Text1 BeginProperty Font Name = 楷体_GB2312 Size = 15 Charset = 134 Weight = 400 Underline = 0 False Italic = 0 False Strikethrough = 0 False EndProperty Height = 420 Left = 1320 TabIndex = 0 Text = x2-x+2 Top = 1080 Width = 3375 End Begin VB.Label Label3 Caption = 搜索精度： BeginProperty Font Name = 楷体_GB2312 Size = 15 Charset = 134 Weight = 400 Underline = 0 False Italic = 0 False Strikethrough = 0 False EndProperty Height = 375 Left = 360 TabIndex = 5 Top = 2760 Width = 1575 End Begin VB.Label Label2 Caption = 搜索区间：( ， ) BeginProperty Font Name = 楷体_GB2312 Size = 15 Charset = 134 Weight = 400 Underline = 0 False Italic = 0 False Strikethrough = 0 False EndProperty Height = 375 Left = 360 TabIndex = 2 Top = 1920 Width = 3855 End Begin VB.Label Label1 Caption = f(x)= BeginProperty Font Name = 楷体_GB2312 Size = 15.75 Charset = 134 Weight = 400 Underline = 0 False Italic = 0 False Strikethrough = 0 False EndProperty Height = 495 Left = 360 TabIndex = 1 Top = 1080 Width = 1095 EndEndAttribute VB_Name = Form1Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseOption ExplicitPrivate Declare Function EbExecuteLine Lib vba6.dll (ByVal pStringToExec As Long, ByVal Unknownn1 As Long, ByVal Unknownn2 As Long, ByVal fCheckOnly As Long) As LongPrivate Function ExecuteLine(sCode As String, Optional fCheckOnly As Boolean) As BooleanExecuteLine = EbExecuteLine(StrPtr(sCode), 0&, 0&, Abs(fCheckOnly) = 0End FunctionFunction FunVal(ByVal f As String, ByVal x As Double) As Doublef = Replace(f, x, ( & Str(x) & )ExecuteLine dim f as doubleExecuteLine f= & fExecuteLine clipboard.settext fFunVal = Clipboard.GetTextEnd FunctionPrivate Sub Command1_Click()Dim a As Double, b As Double, e As DoubleDim a1 As Double, a2 As DoubleDim f1 As Double, f2 As DoubleDim fx As String, iCount As Integerfx = Text1 表达式a = Val(Text2): b = Val(Text3) 搜索区间e = Val(Text4) 搜索精度a1 = b - 0.618 * (b - a)a2 = a + 0.618 * (b - a)f1 = FunVal(fx, Str(a1)f2 = FunVal(fx, Str(a2)While b - a e iCount = iCount + 1 If f1 = f2 Then a = a1: a1 = a2: f1 = f2 a2 = a + 0.618 * (b - a) f2 = FunVal(fx, a2) Else b = a2: a2 = a1: f2 = f1 a1 = b - 0.618 * (b - a) f1 = FunVal(fx, a1) End IfWendText5 = 求优结果： + vbCrLfText5 = Text5 + 函数在x= + Format(a + b) / 2, 0.#) + 处取得极值，Text5 = Text5 + 极值为： + Format(FunVal(fx, (a + b) / 2), 0.#) + vbCrLfText5 = Text5 + 叠代次数： + Str(iCount)End SubPrivate Sub Form_Load()Dim sTitle As String, i As IntegerShowsTitle = 0.618法一维求优Me.Font.Size = 24Me.Font.Name = 楷体_GB2312RandomizeFor i = 1 To 10 Me.CurrentX =