黄金分割法VB程序

《黄金分割法VB程序》由会员分享，可在线阅读，更多相关《黄金分割法VB程序（6页珍藏版）》请在装配图网上搜索。

1、VERSION 5.00Begin VB.Form Form1BorderStyle=4,Fixed ToolWindowCaption=Form1ClientHeight =4995ClientLeft=5550ClientTop=4260ClientWidth=5295BeginProperty FontName=宋体Size=6.75Charset=134Weight=400Underline=0 FalseItalic=0 FalseStrikethroughEndProperty=0 FalseLinkTopic=Form1MaxButton=0FalseMinButton=0Fal

2、seScaleHeight=333ScaleMode=3PixelScaleWidth=353ShowInTaskbar =0FalseStartUpPosition =1所有者中心Begin VB.TextBox Text5BeginProperty FontName=宋体Size=12Charset=134Weight=400Underline=0 FalseItalic=0 FalseStrikethrough=0 FalseEndPropertyForeColor=&H00000000&Height=1140Left=2040MultiLine=-1 TrueTabIndex=8Top

3、=3600Width=2655EndBegin VB.CommandButton Commandl求优=楷体GB2312=15=134=400=0False=0False=0False=楷体GB2312=15=134=400=0False=0False=0False=楷体GB2312=15=134=400=0False=0False=0False=480=360=7=3840=1095Text4Font=420=2040=6=0.005=2760=2655Text3FontCaption=BeginProperty FontName Size Charset Weight Underline

4、Italic StrikethroughEndPropertyHeight Left TabIndex Top Width End Begin VB.TextBoxBeginProperty Name Size Charset Weight Underline Italic StrikethroughEndPropertyHeight Left TabIndex Text Top Width End Begin VB.TextBoxBeginProperty Name Size Charset Weight Underline Italic StrikethroughEndProperty H

5、eightLeft=3000Tabindex=4Text=3Top=1920Width=615EndBegin VB.TextBoxText2BeginPropertyFontName=楷体GB2312Size=15Charset=134Weight=400Underline=0 FalseItalic=0 FalseStrikethrough=0 FalseEndPropertyHeight=420Left=2040TabIndex=3Text=-1Top=1920Width=615EndBegin VB.TextBoxText1BeginPropertyFontName=楷体GB2312S

6、ize=15Charset=134Weight=400Underline=0 FalseItalic=0 FalseStrikethrough=0 FalseEndPropertyHeight=420Left=1320TabIndex=0Text=x2-x+2Top=1080Width=3375EndBegin VB.Label Label3Caption=搜索精度：BeginProperty FontName=楷体 _GB2312Size=15Charset=134Weight=400Underline=0,FalseItalic=0,FalseStrikethrough=0,FalseEn

7、dPropertyHeight=375Left=360TabIndex=5Top=2760Width=1575EndBegin VB.Label Label2Caption=搜索区间：（，BeginPropertyFontName=楷体GB2312Size=15Charset=134Weight=400Underline=0,FalseItalic=0,FalseStrikethrough=0,FalseEndPropertyHeight=375Left=360TabIndex=2Top=1920Width=3855EndBegin VB.Label Label1Caption=f(x) =B

8、eginPropertyFontName=楷体GB2312Size=15.75Charset=134Weight=400Underline=0,FalseItalic=0,FalseStrikethrough=0,FalseEndPropertyHeight=495Left=360TabIndex=1)Top= 1080Width= 1095EndEndAttribute VB_Name = FormlAttribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = Tr

9、ue Attribute VB_Exposed = False Option 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 Boolean

10、ExecuteLine = EbExecuteLine(StrPtr(sCode), 0&, 0&, Abs(fCheckOnly) = 0 End FunctionFunction FunVal(ByVal f As String, ByVal x As Double) As Double f = Replace(f, x, ( & Str(x) & ) ExecuteLine dim f as doubleExecuteLine f= & fExecuteLine clipboard.settext f FunVal = Clipboard.GetTextEnd FunctionPriva

11、te 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 Integer fx = Textl 表达式a = Val(Text2): b = Val(Text3)搜索区间 e = Val(Text4)搜索精度 al = b - 0.618 * (b - a) a2 = a + 0.618 * (b - a) f1 = FunVal(fx, Str(a1

12、)f2 = FunVal(fx, Str(a2) While b - a eiCount = iCount + 1If f1 = f2 Thena = a1: a1 = a2: f1 = f2a2 = a + 0.618 * (b - a)f2 = FunVal(fx, a2)Elseb = a2: a2 = a1: f2 = f1a1 = b - 0.618 * (b - a)f1 = FunVal(fx, a1)End IfWendText5 = 求优结果： + vbCrLfText5 = Text5 + 函数在 x= + Format(a + b) / 2, 0.#)+ 处取得 极值，T

13、ext5 = 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 10Me.CurrentX = (Me.ScaleWidth - Me.TextWidth(sTitle) / 2 + 0.5 * iMe.CurrentY = 10 + i * 0.4Me.ForeColor = QBColor(Int(16 * Rnd()Me.Print sTitleNext iEnd SubPrivate Sub Text1_DblClick()Text1.SelStart = 0Text1.SelLength = Len(Text1)End Sub