by KICO » 2005年12月03日(土) 23:36
初めまして 関数男様、KICOと申します。
今後共、宜しくお願いします。
数学関数とは、言いがたいですが算数式程度なら出来そうです。
括弧有りの計算は出来ませんが・・・。
[ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]
エディトボックス3個 と ボタン1個 を貼り付けて下さい。
[例]
EditBox1:式 Y=4X+2
EditBox2:パラメータ X=2
EditBox3:答え Y=10
Button1 :計算実行
使用できる算術演算子は、"+ - * / \ ^ SIN COS TAN"です。
入力文字は、全てANK(半角)文字で。
コード: 全て選択
Sub MainWnd_CommandButton1_Click()
Dim str As String
Dim buf[50] As Byte
Dim pra[50] As Byte
Dim ans[50] As Double
Dim operand[50] As String
Dim operator[30] As String
Dim odc As Byte
Dim orc As Byte
Dim orn As Byte
Dim ac As Byte
Dim f1 As Byte
Dim f2 As Byte
Dim f3 As Byte
Dim i As Byte
Dim p As Byte
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As String
Dim e As String
GetDlgItemText(hMainWnd, EditBox1, buf, 50)
' If CHK_Parenthesis() Then Exit Sub 'Syntax Error
i=InStr(1, buf, "="): str=Left$(buf, i)
While buf
p=i
a=InStr(1, "SinsinCoscosTantan", Chr$(buf)+Chr$(buf[i+1])+Chr$(buf[i+2]))
If a Then
i=i+3
p=i
While InStr(1, "0123456789.", Chr$(buf)): i=i+1: f1=odc+1: WEnd
If f1=0 Then Exit Sub 'Syntax Error
operand[odc]=Mid$(buf, p+1, i-p)
d=operand[f1-1]
Select Case a\6
Case 0
ans[ac]=Sin(Val(d))
Case 1
ans[ac]=Cos(Val(d))
Case 2
ans[ac]=Tan(Val(d))
End Select
ans[ac]=Sin(Val(d))
ac=ac+1: odc=odc+1
Else
p=i
While InStr(1, "0123456789.", Chr$(buf)): i=i+1: f1=odc+1: WEnd
If f1 Then operand[odc]=Mid$(buf, p+1, i-p): odc=odc+1
p=i
While ((buf>&H40 And buf<&H5b) Or (buf>&H60 And buf<&H7b)): i=i+1: f2=1: WEnd
If f2 Then
While InStr(1, "0123456789", Chr$(buf)): i=i+1: WEnd
operand[odc]=Mid$(buf, p+1, i-p)
GetDlgItemText(hMainWnd, EditBox2, pra, 50)
lstrcat(pra, Ex"\r\n")
a=1: b=0: c=0
While InStr(a, pra, "=")
b=InStr(a, pra, "="): a=InStr(b, pra, Ex"\r\n")
If lstrcmp(Mid$(pra, c+1, b-c-1), operand[odc])=0 Then operand[odc]=Mid$(pra, b+1, a-b-1)
c=a+1
WEnd
If b=0 Then Beep 'Error
d=operand[f1-1]: e=operand[odc]
If f1>0 Then ans[ac]=Val(d)*Val(e) Else ans[ac]=Val(e)
ac=ac+1
odc=odc+1
Else
If f1 Then d=operand[f1-1]: ans[ac]=Val(d): ac=ac+1
End If
End If
Select Case orn
Case 1
ans[orc]=ans[orc-1] + ans[orc]
Case 2
ans[orc]=ans[orc-1] - ans[orc]
Case 3
ans[orc]=ans[orc-1] * ans[orc]
Case 4
ans[orc]=ans[orc-1] / ans[orc]
Case 5
ans[orc]=ans[orc-1] \ ans[orc]
Case 6
ans[orc]=ans[orc-1] ^ ans[orc]
End Select
orn=0
p=i
orn=InStr(1, "+-*/\^", Chr$(buf))
If orn Then
f3=1: i=i+1
operator[orc]=Mid$(buf, p+1, i-p): orc=orc+1
End If
If f1 Or f2 Or f3 Then f1=0: f2=0: f3=0 Else i=i+1
WEnd
SetDlgItemText(hMainWnd, EditBox3, str+Str$(ans[orc]))
End Sub
初めまして 関数男様、KICOと申します。
今後共、宜しくお願いします。
数学関数とは、言いがたいですが算数式程度なら出来そうです。
括弧有りの計算は出来ませんが・・・。
[hide]
エディトボックス3個 と ボタン1個 を貼り付けて下さい。
[例]
EditBox1:式 Y=4X+2
EditBox2:パラメータ X=2
EditBox3:答え Y=10
Button1 :計算実行
使用できる算術演算子は、"+ - * / \ ^ SIN COS TAN"です。
入力文字は、全てANK(半角)文字で。
[code]
Sub MainWnd_CommandButton1_Click()
Dim str As String
Dim buf[50] As Byte
Dim pra[50] As Byte
Dim ans[50] As Double
Dim operand[50] As String
Dim operator[30] As String
Dim odc As Byte
Dim orc As Byte
Dim orn As Byte
Dim ac As Byte
Dim f1 As Byte
Dim f2 As Byte
Dim f3 As Byte
Dim i As Byte
Dim p As Byte
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As String
Dim e As String
GetDlgItemText(hMainWnd, EditBox1, buf, 50)
' If CHK_Parenthesis() Then Exit Sub 'Syntax Error
i=InStr(1, buf, "="): str=Left$(buf, i)
While buf[i]
p=i
a=InStr(1, "SinsinCoscosTantan", Chr$(buf[i])+Chr$(buf[i+1])+Chr$(buf[i+2]))
If a Then
i=i+3
p=i
While InStr(1, "0123456789.", Chr$(buf[i])): i=i+1: f1=odc+1: WEnd
If f1=0 Then Exit Sub 'Syntax Error
operand[odc]=Mid$(buf, p+1, i-p)
d=operand[f1-1]
Select Case a\6
Case 0
ans[ac]=Sin(Val(d))
Case 1
ans[ac]=Cos(Val(d))
Case 2
ans[ac]=Tan(Val(d))
End Select
ans[ac]=Sin(Val(d))
ac=ac+1: odc=odc+1
Else
p=i
While InStr(1, "0123456789.", Chr$(buf[i])): i=i+1: f1=odc+1: WEnd
If f1 Then operand[odc]=Mid$(buf, p+1, i-p): odc=odc+1
p=i
While ((buf[i]>&H40 And buf[i]<&H5b) Or (buf[i]>&H60 And buf[i]<&H7b)): i=i+1: f2=1: WEnd
If f2 Then
While InStr(1, "0123456789", Chr$(buf[i])): i=i+1: WEnd
operand[odc]=Mid$(buf, p+1, i-p)
GetDlgItemText(hMainWnd, EditBox2, pra, 50)
lstrcat(pra, Ex"\r\n")
a=1: b=0: c=0
While InStr(a, pra, "=")
b=InStr(a, pra, "="): a=InStr(b, pra, Ex"\r\n")
If lstrcmp(Mid$(pra, c+1, b-c-1), operand[odc])=0 Then operand[odc]=Mid$(pra, b+1, a-b-1)
c=a+1
WEnd
If b=0 Then Beep 'Error
d=operand[f1-1]: e=operand[odc]
If f1>0 Then ans[ac]=Val(d)*Val(e) Else ans[ac]=Val(e)
ac=ac+1
odc=odc+1
Else
If f1 Then d=operand[f1-1]: ans[ac]=Val(d): ac=ac+1
End If
End If
Select Case orn
Case 1
ans[orc]=ans[orc-1] + ans[orc]
Case 2
ans[orc]=ans[orc-1] - ans[orc]
Case 3
ans[orc]=ans[orc-1] * ans[orc]
Case 4
ans[orc]=ans[orc-1] / ans[orc]
Case 5
ans[orc]=ans[orc-1] \ ans[orc]
Case 6
ans[orc]=ans[orc-1] ^ ans[orc]
End Select
orn=0
p=i
orn=InStr(1, "+-*/\^", Chr$(buf[i]))
If orn Then
f3=1: i=i+1
operator[orc]=Mid$(buf, p+1, i-p): orc=orc+1
End If
If f1 Or f2 Or f3 Then f1=0: f2=0: f3=0 Else i=i+1
WEnd
SetDlgItemText(hMainWnd, EditBox3, str+Str$(ans[orc]))
End Sub
[/code]
[/hide]