VERSION 5.00 Begin VB.Form Form1 BackColor = &H00E0E0E0& Caption = "FunctionAnalisys" ClientHeight = 8295 ClientLeft = 165 ClientTop = 450 ClientWidth = 7395 ControlBox = 0 'False Icon = "Form1.frx":0000 LinkTopic = "Form1" ScaleHeight = 8295 ScaleWidth = 7395 StartUpPosition = 3 'Windows ‚ÌŠù’è’l Begin VB.TextBox Text4 Height = 495 Left = 4080 TabIndex = 16 Text = "Text4" Top = 3240 Visible = 0 'False Width = 1215 End Begin VB.TextBox ResultAnalysisTXT BeginProperty Font Name = "‚l‚r ‚oƒSƒVƒbƒN" Size = 21.75 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 660 Left = 0 TabIndex = 15 Text = "Result of Analysis" Top = 4560 Width = 7335 End Begin VB.TextBox Text2 Height = 495 Left = 3120 TabIndex = 14 Text = "Text2" Top = 2400 Visible = 0 'False Width = 1215 End Begin VB.TextBox Text1 Height = 495 Left = 3480 TabIndex = 13 Text = "Text1" Top = 3840 Visible = 0 'False Width = 1215 End Begin VB.TextBox Inputundertxt BeginProperty Font Name = "‚l‚r ƒSƒVƒbƒN" Size = 21.75 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 660 Left = 0 TabIndex = 0 Top = 5280 Width = 7335 End Begin VB.CheckBox NoMSGChk Caption = "NoMSGChk(&M)" Height = 495 Left = 5520 TabIndex = 11 Top = 7800 Value = 1 'Áª¯¸ Width = 1815 End Begin VB.CommandButton CallGraphicBtn Caption = "Call Graphic(&G)" Enabled = 0 'False Height = 495 Left = 5520 TabIndex = 2 Top = 7200 Width = 1815 End Begin VB.TextBox XinputTxt Alignment = 1 '‰E‘µ‚¦ BeginProperty Font Name = "‚l‚r ‚oƒSƒVƒbƒN" Size = 20.25 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 3480 TabIndex = 3 Text = "1" Top = 6600 Width = 1935 End Begin VB.CommandButton CalcBtn Caption = "CalcStart(&C)" Height = 495 Left = 3480 TabIndex = 4 Top = 6000 Width = 1935 End Begin VB.TextBox calcouttxt BeginProperty Font Name = "‚l‚r ‚oƒSƒVƒbƒN" Size = 20.25 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 540 Left = 3480 MultiLine = -1 'True TabIndex = 5 Text = "Form1.frx":030A Top = 7080 Width = 1935 End Begin VB.TextBox BraLogicExTxt BeginProperty Font Name = "‚l‚r ‚oƒSƒVƒbƒN" Size = 20.25 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 2415 Left = 0 MultiLine = -1 'True ScrollBars = 3 '—¼•û TabIndex = 10 Text = "Form1.frx":0317 Top = 6000 Width = 3375 End Begin VB.TextBox trans2txt BeginProperty Font Name = "‚l‚r ‚oƒSƒVƒbƒN" Size = 20.25 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 0 TabIndex = 9 Text = "SecondAnalysis" Top = 1200 Width = 7335 End Begin VB.CommandButton ExitBtn Caption = "Exit(&X)" Height = 495 Left = 3480 TabIndex = 6 Top = 7800 Width = 1935 End Begin VB.CommandButton gobtn Caption = "FuncAnalisys(&A)" Height = 1215 Left = 5520 TabIndex = 1 Top = 6000 Width = 1815 End Begin VB.TextBox trans1txt BeginProperty Font Name = "‚l‚r ‚oƒSƒVƒbƒN" Size = 20.25 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 0 TabIndex = 8 Text = "FirstAnalysis" Top = 600 Width = 7335 End Begin VB.PictureBox Picture1 BackColor = &H00C0FFC0& Height = 2655 Left = 0 ScaleHeight = 2595 ScaleWidth = 7395 TabIndex = 12 Top = 1800 Width = 7455 End Begin VB.TextBox InputTxt BeginProperty Font Name = "‚l‚r ƒSƒVƒbƒN" Size = 21.75 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 495 Left = 0 TabIndex = 7 Top = 0 Width = 7335 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Rem ======================================================================== Rem Multi Function Analizer Rem Ver 0.99 2002 Nov 01-DEC 18th. Rem Ver 0.9993 -Jan18th. 2003. Rem Ver 0.9995 Jan19th.- 2003. Rem http://kimijima.tripod.co.jp kaz_kimijima@livedoor.com Rem Rem ======================================================================== Option Explicit Dim fb(50) As funcbra Dim numstr(50) As String Public Sub form_load() '1/8 End Sub Public Sub exitbtn_click() '2/8 Unload Form3 Unload Me End Sub Public Sub nomsgchk_click() If NoMSGChk.Value = 0 Then CallGraphicBtn.Enabled = False Else CallGraphicBtn.Enabled = True End If End Sub Public Sub callgraphicbtn_click() NoMSGChk.Value = 1 Load Form3 Form3.Visible = True Form3.SetFocus End Sub Public Sub inputundertxt_change() InputTxt.Text = Inputundertxt.Text End Sub Public Sub inputtxt_change() '3/8 Dim inputstr As String Dim outputstr As String Dim tmpCHR As String Dim lenSTR As Integer Dim i As Integer CallGraphicBtn.Enabled = False inputstr = InputTxt.Text outputstr = "" lenSTR = Len(inputstr) For i = 1 To lenSTR tmpCHR = Mid(inputstr, i, 1) tmpCHR = IlligalCHKTmpChr(tmpCHR) If NumCHRCheck(tmpCHR) = True Then If i = 1 Then tmpCHR = "(" + tmpCHR End If If i = lenSTR Then tmpCHR = tmpCHR + ")" End If End If outputstr = outputstr + tmpCHR Next i Inputundertxt.Text = outputstr InputTxt.Text = outputstr Rem inputtxt.SelStart = Len(outputstr) End Sub Public Function reminputtxt_keydown(keycord As Integer, shift As Integer) Select Case keycord Case vbKeyAdd Call calcmsg Case vbKeySubtract Call calcmsg Case vbKeyMultiply Call calcmsg Case vbKeyDivide Call calcmsg Rem Case vbkeyflex Rem Call calcmsg End Select End Function Public Sub calcmsg() MsgBox ("This Program can not recognize * ^ kinds priority on time to calccalccalc. Please use Bracket Logical Segment or Use regular sequencese as example :^>*>/>+>-."), 48 End Sub Public Function aaaaaa() End Function Public Function NumCHRCheck(numstr As String) As Boolean 'numchrcheck(numstr As String) As Boolean Dim i As Integer If numstr = "." Then NumCHRCheck = True Else For i = 1 To 9 If numstr = chr(48 + i) Then NumCHRCheck = True GoTo escape End If Next i NumCHRCheck = False End If escape: End Function Public Function IlligalCHKTmpChr(tmpCHR As String) As String '4/8'illigalchktmpchr(tmpchr As String) As String '4/8 Rem ()0-9 or +-*/^ sin cos tan e log ln Rem If tmpchr = "" Or tmpchr = Chr() Then goto escape Rem if tmpchr="" then goto escape Dim i As Integer Dim j As Integer If tmpCHR = "(" Then GoTo escape If tmpCHR = ")" Then GoTo escape For i = 0 To 9 Step 1 If chr(48 + i) = tmpCHR Then GoTo escape Next i If tmpCHR = "+" Then GoTo escape If tmpCHR = "-" Then GoTo escape If tmpCHR = "*" Then GoTo escape If tmpCHR = "/" Then GoTo escape If tmpCHR = "^" Then GoTo escape If tmpCHR = "s" Then GoTo escape If tmpCHR = "i" Then GoTo escape If tmpCHR = "n" Then GoTo escape If tmpCHR = "c" Then GoTo escape If tmpCHR = "o" Then GoTo escape If tmpCHR = "s" Then GoTo escape If tmpCHR = "t" Then GoTo escape If tmpCHR = "a" Then GoTo escape If tmpCHR = "n" Then GoTo escape Rem --hyper boric sin cosine.----- If tmpCHR = "h" Then GoTo escape Rem --exp and log.----- If tmpCHR = "e" Then GoTo escape If tmpCHR = "l" Then GoTo escape Rem if tmpchr="o" then goto escape If tmpCHR = "g" Then GoTo escape Rem if tmpchr="l" then goto escape Rem --x for input direct parameter.------ If tmpCHR = "x" Then GoTo escape Rem --Number CHR check logic.------- For j = 1 To 9 If tmpCHR = chr(48 + j) Then GoTo escape Next j If tmpCHR = "." Then GoTo escape Rem if tmpchr="" then goto escape Rem if tmpchr="" then goto escape Rem if tmpchr="" then goto escape Rem --Not ANY hit.------ tmpCHR = "" escape: If tmpCHR = "" Then MsgBox ("not enough str!!"), vbExclamation IlligalCHKTmpChr = tmpCHR End Function Public Sub gobtn_click() '5/8 Dim innerstr As String innerstr = InputTxt.Text innerstr = ExNum(innerstr) Rem innerstr=transstr(innerstr,"","" ) innerstr = TransSTR(innerstr, "hsin", "$") innerstr = TransSTR(innerstr, "hcos", "&") Rem first sin dealing,always erreof logical.I canoot understand for this fenominam. ; innerstr = TransSTR(innerstr, "cos", "c") Rem innerstr=transstr(innerstr,"tan","t" ) innerstr = TransSTR(innerstr, "tan", "t") innerstr = TransSTR(innerstr, "e", "e") Rem innerstr=transstr(innerstr,"log","l" ) innerstr = TransSTR(innerstr, "log", "l") innerstr = TransSTR(innerstr, "x", "x()") Rem innerstr=transstr(innerstr,"","" ) Rem innerstr=transstr(innerstr,"","" ) innerstr = TransSTR(innerstr, "sin", "s") trans1txt.Text = innerstr Call InputBracketLogic Call ExpressEquationResultAnalysis CallGraphicBtn.Enabled = True End Sub Public Function ExNum(ms As String) As String Dim index As Integer Dim i As Integer Dim j As Integer Dim NumCHRNowDiscover As Boolean Dim continue As Boolean Dim K As Integer Dim ADDone As String Dim output As String Dim lenSTR As Integer Dim tmpCHR As String Dim DoublePeriodErrorCHK As Boolean Rem ----- For K = 0 To 50 numstr(K) = "" Next K lenSTR = Len(ms) continue = False index = 1 DoublePeriodErrorCHK = False For i = 1 To lenSTR NumCHRNowDiscover = False tmpCHR = Mid(ms, i, 1) If tmpCHR = "." Then NumCHRNowDiscover = True If DoublePeriodErrorCHK = True Then MsgBox ("Over 2times of periods existing on number claster!! "), vbExclamation tmpCHR = "" Rem Stop Else DoublePeriodErrorCHK = True Rem NumCHRNowDiscover = True End If Else If tmpCHR = ")" Then DoublePeriodErrorCHK = False Else For j = 0 To 9 If tmpCHR = chr(48 + j) Then NumCHRNowDiscover = True GoTo escape End If Next j Rem --No NumCHR hit------ NumCHRNowDiscover = False End If escape: End If Rem ----- If NumCHRNowDiscover = True Then continue = True numstr(index) = numstr(index) + tmpCHR MsgBox ("number charactor now translating....."), vbInformation Else ADDone = "" If continue = True Then ADDone = "n()" index = index + 1 continue = False End If output = output + ADDone + tmpCHR End If Next i ExNum = (output) End Function Public Function TransSTR(ms As String, ts As String, newtransstr As String) As String '6/ Dim i As Integer Dim j As Integer Rem Dim ms As String 'motherstring Rem Dim ts As String 'targetstring Dim tmpmschr As String Dim tmptschr As String Dim lenms As Integer Dim lents As Integer Dim backstakebuffer As String Dim saltedbuffer As String Dim strcalclated As String strcalclated = "" saltedbuffer = "" i = 1 j = 1 lenms = Len(ms) lents = Len(ts) For i = 1 To lenms tmpmschr = Mid(ms, i, 1) tmptschr = Mid(ts, j, 1) If tmpmschr = tmptschr Then Rem event occured. If j = 1 Then saltedbuffer = strcalclated If j = lents Then strcalclated = saltedbuffer + newtransstr saltedbuffer = "" backstakebuffer = "" j = 1 Else backstakebuffer = backstakebuffer + tmpmschr j = j + 1 End If Else 'not chr is equal. Rem not before last of target. Rem lents +1 =< No Existences in Logic Basicall at all. If 1 < j Then strcalclated = saltedbuffer + backstakebuffer + tmpmschr j = 1 Else strcalclated = strcalclated + tmpmschr End If End If Next i TransSTR = strcalclated End Function Public Sub InputBracketLogic() 'inputbracketlogic() '7/8 Dim i As Integer Dim index As Integer Dim Waterfloat As Integer Dim inTEXTstr As String Dim lenSTR As Integer Dim tmpCHR As String Dim funcIndex As Integer Dim NumSTRarrREFcounter As Integer ' numstrarrrefcounter As Integer Dim tmpcalckindstr As String Dim tmpfunckindstr As String inTEXTstr = trans1txt.Text inTEXTstr = NormalFormatCheck(inTEXTstr) Rem ----- For index = 0 To 50 Step 1 With fb(index) Rem ----- .CalcKind = "" .FuncKind = "v" .SubConst = 0 .Open = True .Discovered = False End With Next index Rem ----- With fb(0) .CalcKind = "+" .FuncKind = "v" .SubConst = 0 .Open = True .Discovered = False .Depth = 0 End With lenSTR = Len(inTEXTstr) Waterfloat = 0 funcIndex = 0 NumSTRarrREFcounter = 1 For i = 1 To lenSTR tmpCHR = Mid(inTEXTstr, i, 1) Rem tmpcalckindstr = "+" Rem tmpfunckindstr = "v" If Enzan(tmpCHR) = True Then tmpcalckindstr = tmpCHR Rem rem stop If FuncCHK(tmpCHR) = True Then tmpfunckindstr = tmpCHR If tmpCHR = "(" Then funcIndex = funcIndex + 1 With fb(funcIndex) Waterfloat = Waterfloat + 1 .Depth = Waterfloat Rem .BufferOpened = True .Discovered = True .CalcKind = tmpcalckindstr .FuncKind = tmpfunckindstr .SubConst = 0 If tmpfunckindstr = "n" Then .SubConst = Val(numstr(NumSTRarrREFcounter)) NumSTRarrREFcounter = NumSTRarrREFcounter + 1 End If End With End If If tmpCHR = ")" Then Waterfloat = Waterfloat - 1 End If Next i Call DrowDepthLogical(funcIndex) Rem x End Sub Public Function NormalFormatCheck(inputstr As String) As String 'normalformatcheck(inputstr As String) As String Rem (+m()+m()+m()) Rem (+m(+m(+m()))) Rem after (, +-*/ and pmsctel or )bracket. Rem Rem front ) bracket is nessary )bracket. Rem reigai (pmsctel( ha (+pmsctel( rem Rem x ha mushiru. Dim forchkstring As String Dim tmpCHR As String Dim aaaaa As String Dim lenSTR As Integer Dim i As Integer Dim ADDone As String Dim subone As String Dim output As String Dim frontbrainteger As Integer Dim jbbackbra As Boolean Dim jbfrontbra As Boolean Dim chkbraindex As Integer Dim bracketpaircounter As Integer lenSTR = Len(inputstr) chkbraindex = 0 jbbackbra = False jbfrontbra = True bracketpaircounter = 0 For i = 1 To lenSTR ADDone = "" subone = "" tmpCHR = Mid(inputstr, i, 1) Rem If tmpchr = "x" Then Rem subone = "()" Rem chkbraindex = i Rem chkbraindex=i Rem jbfrontbra = False Rem jbbackbra = True Rem End If If tmpCHR = ")" Then bracketpaircounter = bracketpaircounter - 1 If jbfrontbra = True And chkbraindex = i - 1 Then If 0 < i - 2 Then If Not Mid(inputstr, i - 2, 1) = "n" Then Rem addone = "+x()" End If End If End If jbbackbra = True jbfrontbra = False chkbraindex = i Else If tmpCHR = "(" Then bracketpaircounter = bracketpaircounter + 1 If chkbraindex = i - 2 Then If Enzan(Mid(inputstr, i - 1, 1)) = True Then ADDone = "v" End If End If If chkbraindex = i - 1 Then If jbfrontbra = True Then ADDone = "+v" End If If jbbackbra = True Then ADDone = "*v" End If jbfrontbra = True jbbackbra = False End If jbfrontbra = True jbbackbra = False chkbraindex = i Rem arienai...... Rem addone="*v" Else Select Case chkbraindex Case i - 1 If Enzan(tmpCHR) = False Or FuncCHK(tmpCHR) = True Then If jbfrontbra = True Then ADDone = "+" If jbbackbra = True Then ADDone = "*" Rem chkbraindex = chkbraindex + 1 End If Case i - 2 If FuncCHK(tmpCHR) = False Or tmpCHR = "(" Then ADDone = "v" Rem chkbraindex = chkbraindex + 1 End If Case i - 3 If Not tmpCHR = "(" Then ADDone = "(" chkbraindex = 0 End Select End If End If output = output + ADDone + tmpCHR + subone Next i If bracketpaircounter = 0 Then trans2txt.Text = output Else MsgBox ("Bracket Pair, Miss Match!!!"), vbExclamation End If GoTo jump errorescape: MsgBox ("error!" + Str(i)), vbExclamation jump: NormalFormatCheck = output End Function Public Function Enzan(chr As String) As Boolean Dim b As Boolean b = False Select Case chr Case Is = "+" b = True Case Is = "-" b = True Case Is = "*" b = True Case Is = "/" b = True Case Is = "^" b = True End Select Enzan = b End Function Public Function FuncCHK(chr As String) As Boolean 'funcchk(chr As String) As Boolean Dim b As Boolean b = False Select Case chr Case Is = "s" b = True Case Is = "c" b = True Case Is = "t" b = True Rem ----- Case Is = "$" b = True Case Is = "&" b = True Rem ----- Case Is = "e" b = True Case Is = "l" b = True Case Is = "x" b = True Case Is = "n" b = True Rem Case Is = "" Rem b = True Case Is = "v" b = True End Select FuncCHK = b End Function Public Sub ExpressEquationResultAnalysis() Dim i As Integer Dim outstr As String Dim nextdepth As Integer Dim XNumDepthTune As Integer Dim backbrastep As Integer Dim frontbrastr As String Dim backbrastr As String Rem ----- outstr = "" For i = 1 To 50 - 1 Step 1 With fb(i) If .Discovered = True Then With fb(i + 1) If .Discovered = False Then nextdepth = 1 Else nextdepth = .Depth End If End With Rem --xnumstrfront and backtune If .FuncKind = "n" Or _ .FuncKind = "x" Then XNumDepthTune = 0 ''' -1 frontbrastr = "" Else XNumDepthTune = 0 frontbrastr = "(" End If Rem --backbra realtune------ backbrastep = .Depth _ - nextdepth + XNumDepthTune If 0 < backbrastep Then backbrastr = ADDbackbra(backbrastep) Else backbrastr = "" End If Rem -----each stake outstr = outstr + .CalcKind _ + MakeFuncKindStr(i) + frontbrastr _ + backbrastr End If End With Next i ResultAnalysisTXT.Text = outstr End Sub Public Function bbbbbb() End Function Public Function MakeFuncKindStr(i As Integer) Dim tmpstr As String If i < 0 Or 50 < i Then MsgBox ("i is illegal."), 48 Stop Else With fb(i) tmpstr = .FuncKind Select Case .FuncKind Case "n" tmpstr = Val(.SubConst) Case "x" Rem do nothing. Case "v" tmpstr = "" Rem Case "" Rem tmpstr = "" Case "s" tmpstr = "sin" Case "c" tmpstr = "cos" Rem Case "t" Rem tmpstr = "tan" Case "t" tmpstr = "tan" Rem ------ Case "$" tmpstr = "hsin" Case "&" tmpstr = "hcos" Rem ------ Case "e" tmpstr = "e" Case "l" tmpstr = "log e" Rem Case "" Rem tmpstr = "" Rem Case "" Rem tmpstr = "" End Select End With End If MakeFuncKindStr = tmpstr End Function Public Function ADDbackbra(i As Integer) As String Dim tmpstr As String If i < 1 Then Rem do nothing. Else tmpstr = "" For i = 1 To i tmpstr = tmpstr + ")" Next i End If ADDbackbra = tmpstr End Function Public Sub calcbtn_click() calcouttxt.Text = FuncComplex(Val(XinputTxt.Text)) End Sub Public Function FuncComplex(x As Double) 'funccomplex(x As Double) Dim index As Integer Dim uli As Integer 'Until Limitindex Dim bi As Integer 'before bracketindex Dim ni As Integer 'next bracketindex. Dim j As Integer Dim K As Integer Rem ----- Rem lastindex = 50 For j = 0 To 50 Step 1 With fb(j) .Open = True .OnceMothered = False .Buf = 0 End With Next j Rem ----- index = 1 again: With fb(index) If NoMSGChk.Value = 0 Then MsgBox (Str(index) + Str(.Depth) + .CalcKind + .FuncKind + Str(.Buf) + vbCrLf) End With If index = 0 Then FuncComplex = fb(index).Buf Else bi = DiscoverBACKOpenIndex(index) ni = DiscoverNEXTOpenIndex(index) If bi < -1 Then MsgBox ("BI error" + Str(bi)), vbCritical: Stop If ni < -1 Then MsgBox ("NI error" + Str(ni)), vbCritical: Stop Rem ----- If fb(index).Open = True Then If ni = -1 Then fb(index).Open = False Call SubInsert(bi, index, x) Rem stop index = bi Else If fb(index).Depth < fb(ni).Depth Then Rem do nothing..... Rem stop index = ni Else fb(index).Open = False Call SubInsert(bi, index, x) If fb(index).Depth = fb(ni).Depth Then Rem stop index = ni End If If fb(index).Depth > fb(ni).Depth Then Rem stop index = bi End If End If End If Else Rem fb(index).open=false pahse..... Rem stop index = ni End If GoTo again End If End Function Public Function DiscoverBACKOpenIndex(i As Integer) Dim K As Integer If i < 0 Or 50 < i Then K = -3 Else If i = 0 Then K = -2 Else For K = i - 1 To 0 Step -1 If K = -1 Then ' fb(k).Discovered = False Then K = -1 GoTo escape Else 'discovered=true..... If fb(K).Open = True Then 'First Open bracket..... GoTo escape End If End If Next K escape: End If End If DiscoverBACKOpenIndex = K End Function Public Function DiscoverNEXTOpenIndex(i As Integer) Dim K As Integer If i < 0 Or 50 < i Then K = -3 Else If 50 = i Then K = -2 Else For K = i + 1 To 50 Step 1 If fb(K).Discovered = False Then K = -1 GoTo escape Else 'discovered=true..... If fb(K).Open = True Then 'First Open bracket..... GoTo escape End If End If Next K escape: End If End If DiscoverNEXTOpenIndex = K End Function Public Sub SubInsert(mother As Integer, d As Integer, x As Double) Rem -------------------------------------------------------------------------------------------- Rem The parameter .OnceMathered is important. Rem it is only for the function n and x. Rem Rem n and x are also only act on one times on those equation and as calcration. Rem Those parameter :the OnceMathered has role to proof those over one times doing as looking. Rem -------------------------------------------------------------------------------------------- Dim tmpbuf As Double Rem If fb(d).OnceMothered = False Then Rem tmpbuf = x Rem Else tmpbuf = fb(d).Buf Rem End If Select Case fb(d).FuncKind Rem case "" Rem tmpbuf=(tmpbuf ) Case "s" tmpbuf = Sin(tmpbuf) Case "c" tmpbuf = Cos(tmpbuf) Rem case "t" Rem tmpbuf=tan(tmpbuf) Case "t" tmpbuf = Tan(tmpbuf) Rem --hsin code.------ Case "$" If 700 < tmpbuf Then tmpbuf = 700 Rem --Proof Overflow style--- tmpbuf = (Exp(x) / 2 - Exp(-x) / 2) Rem --hcos code.------ Case "&" If 700 < tmpbuf Then tmpbuf = 700 Rem --Proof Overflow style--- tmpbuf = (Exp(x) / 2 + Exp(-x) / 2) Rem --exp and log.----- Case "e" If 700 < tmpbuf Then tmpbuf = 700 tmpbuf = Exp(tmpbuf) Case "l" If tmpbuf = 0 Then tmpbuf = 1 If tmpbuf < 0 Then tmpbuf = -tmpbuf tmpbuf = Log(tmpbuf) Rem --Vacant bracket and Number Constant and Simple x to input.----- - Case "v" tmpbuf = tmpbuf Rem ----- Rem constan n function is a especial caese..... Case "n" If fb(d).OnceMothered = True Then tmpbuf = 0 Else tmpbuf = tmpbuf + fb(d).SubConst End If Case "x" If fb(d).OnceMothered = True Then tmpbuf = 0 Else tmpbuf = x End If Rem --recognizing logicends.----- End Select Select Case fb(d).CalcKind Rem case "" Rem tmpbuf=fb(mother).buf tmpbuf Case "+" tmpbuf = fb(mother).Buf + tmpbuf Case "*" tmpbuf = fb(mother).Buf * tmpbuf Case "-" tmpbuf = fb(mother).Buf - tmpbuf Case "/" If tmpbuf = 0 Then tmpbuf = 1 Else tmpbuf = fb(mother).Buf / tmpbuf End If Case "^" '----------------------------------------------- If fb(mother).Buf <= 0 And Not tmpbuf = Int(tmpbuf) Then tmpbuf = 0 Else tmpbuf = fb(mother).Buf ^ tmpbuf End If Rem ----------------------------------------------------- Rem case "" Rem tmpbuf=fb(mother ).buf tmpbuf End Select Rem stop fb(mother).Buf = tmpbuf fb(mother).OnceMothered = True End Sub Public Sub DrowDepthLogical(index As Integer) '8/8 Dim i As Integer Dim tmpCHR As String Dim tmpstr As String Dim indexstepwidth As Integer Dim mostdeep As Integer Dim j As Integer Dim K As Integer Dim depthstepheight As Integer indexstepwidth = Int(Picture1.Width / (index + 1)) mostdeep = 0 For j = 0 To index If j = 0 Then K = 0 Else K = j - 1 End If If fb(j).Depth > fb(K).Depth Then mostdeep = fb(j).Depth Next j depthstepheight = Int(Picture1.Height / (mostdeep + 1)) Picture1.Cls For i = 0 To index With fb(i) Picture1.Circle (indexstepwidth * i, depthstepheight * .Depth), 100 tmpstr = tmpstr + Str(i) + .CalcKind + .FuncKind + Str(.SubConst) + vbCrLf End With Next i BraLogicExTxt.Text = tmpstr End Sub Public Sub tsttmpcalcbtn_click() Call DrowGraphicTest End Sub Public Sub DrowGraphicTest() 'drowgraphictest() Dim x As Double Dim y As Double Dim aaaaa As String Dim tmpstr As String Picture1.Cls tmpstr = "" For x = -1 To 1 Step 0.1 Rem y = Sin(x)'test y = FuncComplex(x) tmpstr = tmpstr + Str(x) + Str(y) + vbCrLf With Picture1 Picture1.Circle (x * .Width / 2 + .Width / 2, -y * .Height / 2 + .Height / 2), 100 End With Next x calcouttxt.Text = tmpstr Rem text10.Text = tmpstr End Sub Rem ======================================================================== Rem Files 'end. Rem Rem ========================================================================