Тема: Numerator

Вот, наконец более-менее дописал свой проектик.

Numerator
"Numerator" ("Вычислитель") - калькулятор, считающий в строку.
многабукавмногабукавмногабукавмногабукавмногнестандартныммногабукавмногабукавмногабукавмногабукавмногабукавмногабукавмногабука13
Т.к. записывать обыкновенные дроби, в связи с их ____видом____, довольно сложно, я решил использовать такую форму записи: для числа 123 21 форма записи такова - 123.13/21

---

Вы спросите: "А чем это лучше обычного (стандартного) калькулятора?", а я отвечу: "... ничем! Пока что."
Программа не отличается особой производительностью, графикой, удобством в использовании, зато считает обыкновенные дроби.
В следующих версиях, я надеюсь, я оптимизирую местами код, добавлю действий (остальные арифметические действия, в том числе
корень квадратный), добавлю функционал (перенаправление расчетов, память).

---

Исх. код и .exe:
[Ссылки могут видеть только зарегистрированные пользователи. ]

Код

Код freebasic:

Type thread
	handle As Any Ptr
	arrow As String Ptr
End Type
Type mousedata
	x As Integer
	y As Integer
	button As Integer
	wheel As Integer
	activity As Integer
	cursor As Integer
	trueth As Integer
End Type
 
Declare Sub sum OverLoad (x As String Ptr)
Declare Sub mti OverLoad (x As string Ptr)
Declare Function sum OverLoad (x As String, y As String) As String
Declare Function mti OverLoad (x As String, y As String) As String
Declare Function quo (x As String, y As String) As String
Declare Function com (x As String, y As String) As Integer
Declare Function eas (x As String) As String
Declare Function st0 (x As String, y As String) As String Ptr
Declare Function TCr (p As Sub Ptr, x As String, y As String) As thread
Declare Sub drb (ByRef x As String, ByRef k As Integer, ByRef d As String, ByRef d0 As String, ByRef d1 As String)
 
Declare Sub cursor_picture_set () Constructor
Declare Sub mouse_initialization () Constructor
Declare Function compute (st1 As String, st2 As String, action As Integer) As String
Declare Function editor As String
Declare Function button (x As Integer, y As Integer, b_x As Integer, b_y As Integer, st As String, tipst As String) As Integer
Declare Sub trigger (ByRef trig As Integer, x As Integer, y As Integer, b_x As Integer, b_y As Integer, st As String, tipst As String)
Declare Sub mousec OverLoad()
Declare Sub mousec OverLoad(comm As integer)
Declare Sub changescreen ()
 
Dim Shared As String buffer(1 To 8)
 
Dim Shared mouse As mousedata
Dim Shared sc_da As Integer
Dim Shared cursors(1 To 5, 1 To 50, 1 To 50) As Double 
 
Dim As String st1, st2, st3
Dim As Integer tr1
ScreenRes 1024, 768, 32, 3
Do
	'trigger(b1, 100, 300, 300, 100, IIf(b1, "on", "off"), "trigger")
	If button (50, 400, 250, 30, st1, "edit number")=2 Then st1=editor
	If button (350, 400, 250, 30, st2, "edit number")=2 Then st2=editor
	If button (650, 400, 250, 30, st3, "compute")=2 Then st3=compute (st1, st2, tr1)
	If button (700, 700, 100, 30, "exit", "exit program")=2 Then Exit Do
	trigger (tr1, 400, 500, 150, 50, IIf(tr1, "multiplication", "adding"), "operation")
	mousec()
	changescreen()
Loop
End
 
Sub sum OverLoad (p As String Ptr)
	Dim As String x, y, s, com0
	Dim As Integer lens, i, tt, t, k=1, kk=1
	x=Left(*p, InStr(*p, " ")-1)
	y=Right(*p, Len(*p)-InStr(*p, " "))
	k=k+(Mid(x, 1, 1)="-")*2: kk=kk+(Mid(y, 1, 1)="-")*2
	If k=-1 Then x=Right(x, Len(x)-1)
	If kk=-1 Then y=Right(y, Len(y)-1)
	If k=-1 And kk=1 Then Swap k, kk: Swap x, y
	If k=-1 And kk=-1 Then com0="-": k=1: kk=1
	If kk=-1 And k=1 Then 
		If Not com(x, y) Then Swap x, y: com0="-"
	EndIf
	If Len(x)>Len(y) Then lens=Len(x)+1 Else lens=Len(y)+1
	For i=0 To lens-1
		If i<=Len(x) And i<=Len(y) Then 
			tt=Val(Mid(x, Len(x)-i, 1))*k+Val(Mid(y, Len(y)-i, 1))*kk+t
		Else 
			If i>Len(x) And i>Len(y) Then tt=t
			If i>Len(x) Then tt=Val(Mid(y, Len(y)-i, 1))*kk+t
			If i>Len(y) Then tt=Val(Mid(x, Len(x)-i, 1))*k+t
		EndIf
		t=(tt-(tt Mod 10))/10
		If tt<0 Then tt=10+tt: t=-1
		s=Str(tt Mod 10)+s
	Next
	While Mid(s, 1, 1)="0" And Len(s)>1
		s=Right(s, Len(s)-1)
	Wend
	If com0="-" And s="0" Then com0=""
	Poke String, p, com0+s
End Sub
 
Function sum OverLoad (x As String, y As String) As String
	Dim As String s, com0, d, dd, fd0, fd1, d0, d1, dd0, dd1
	Dim As Integer i, t, tt, k=1, kk=1, dp0, dp1
	Dim As thread dat (1 To 8)
	drb(x, 0, d, d0, d1)
	drb(y, 0, dd, dd0, dd1)
	dat(1)=TCr(@sum, x, y)
	ThreadWait(dat(1).handle)
	s=*dat(1).arrow
	Poke String, dat(1).arrow, ""
	If s="0" Then com0=""
	If d="" And dd="" Then Return com0+s
	If d<>"" And dd="" Then s=com0+s+"."+d0+"/"+d1: Return s
	If dd<>"" And d="" Then s=com0+s+"."+dd0+"/"+dd1: Return s
	dat(1)=TCr(@mti, d0, dd1)
	dat(2)=TCr(@mti, dd0, d1)
	dat(3)=TCr(@mti, d1, dd1)
	ThreadWait(dat(1).handle)
	ThreadWait(dat(2).handle)
	ThreadWait(dat(3).handle)
	fd0=sum(*dat(1).arrow, *dat(2).arrow): fd1=*dat(3).arrow
	sum=eas(com0+s+"."+fd0+"/"+fd1)
End Function
 
Function com (x As String, y As String) As Integer
	Dim As Integer i, k, kk, com0, t
	Dim As String d, dd, d0, dd0, d1, dd1
	drb (x, k, d, d0, d1)
	drb (y, kk, dd, dd0, dd1)
	If k And kk Then com0=-1
	If k And Not kk Then t=0: GoTo f
	If kk And Not k Then t=-1: GoTo f
	If Len(x)>Len(y) Then t=-1: GoTo f
	If Len(x)=Len(y) Then 
		For i=1 To Len(x)
			If Val(Mid(x, i, 1))>Val(Mid(y, i, 1)) Then t=-1: GoTo f
		Next
	EndIf
	If d<>"" And dd<>"" Then
		Return com(mti(d0,dd1), mti(dd0,d1))
	EndIf
	If d<>"" And dd="" Then Return -1
	If dd<>"" And d="" Then Return 0
	f:
	If com0 Then t=Not t
	com=t
End Function
 
Sub mti OverLoad (p As String Ptr)
	Dim As integer k, kk, i, j, t, tt
	Dim As String com0, x, y, s, pr
	x=Left(*p, InStr(*p, " ")-1)
	y=Right(*p, Len(*p)-InStr(*p, " "))
	drb(x, k, "", "", "")
	drb(y, kk, "", "", "")
	If k<>kk Then com0="-"
	For i=Len(y) To 1 Step -1
		pr=""
		t=0
		For j=Len(x) To 1 Step -1
			tt=Val(Mid(x, j, 1))*Val(Mid(y, i, 1))+t
			pr=Str(tt Mod 10)+pr
			t=(tt-(tt Mod 10))/10
		Next j
		pr=Str(t)+pr
		pr=pr+String(Len(y)-i, "0")
		s=sum(s, pr)
	Next i
	Poke String, p, s
End Sub
 
Function mti (x As String, y As String) As String
	Dim As Integer dp0, dp1, k, kk
	Dim As String d, dd, com0, s, pr, d0, d1, dd0, dd1
	Dim As thread dat (1 To 8)
	drb(x, k, d, d0, d1)
	If d1="" Then d1="1"
	drb(y, kk, dd, dd0, dd1)
	If dd1="" Then dd1="1"
	If k<>kk Then com0="-"
	If d="" And dd="" Then 
		dat(1)=TCr(@mti, x, y)
		ThreadWait(dat(1).handle)
		Return com0+*dat(1).arrow
	EndIf
	dat(1)=TCr(@mti, d1, x)
	dat(2)=TCr(@mti, dd1, y)
	dat(3)=TCr(@mti, d1, dd1)
	ThreadWait(dat(1).handle)
	ThreadWait(dat(2).handle)
	dat(1)=TCr(@sum, *dat(1).arrow, d0)
	dat(2)=TCr(@sum, *dat(2).arrow, dd0)
	ThreadWait(dat(1).handle)
	ThreadWait(dat(2).handle)
	ThreadWait(dat(3).handle)
	mti=eas(com0+"0."+mti(*dat(1).arrow, *dat(2).arrow)+"/"+*dat(3).arrow)
End Function
 
Function quo (x As String, y As String) As String
	If com (y, x) Then Return "0."+x+"/"+y
	If y="1" then Return x
	If x=y Then Return "1"
	Dim As Integer i=1, tt
	Dim As String t, r
	t=Left(x, i)
	Do While com (y, t)
		i=i+1
		t=Left(x, i)
	Loop
	Do Until Mid(x, i, 1)=""
		tt=0
		While Mid(t, 1, 1)="0" And Len(t)>1
			t=Right(t, Len(t)-1)
		Wend
		Do Until com (y, t) Or t="0"
			t=sum(t, "-"+y)
			tt=tt+1
		Loop
		r=r+Str(tt)
		i=i+1
		t=t+Mid(x, i, 1)
	Loop
	While Mid(t, 1, 1)="0" And Len(t)>1
		t=Right(t, Len(t)-1)
	Wend
	If t<>"0" Then r=r+"."+t+"/"+y
	quo=r
End Function
 
Function eas (x As String) As String
	Dim As String d, d0, d1, t, tt, i="2", ad
	Dim As Integer k
	Dim As Double STime
	drb(x, k, d, d0, d1)
	STime=Timer
	Do Until com(d1, d0)
		d0=sum(d0, "-"+d1)
		ad=sum(ad, "1")
		If Timer-STime>2 Then Exit do
	Loop
	Do Until com (i, d0) Or com (i, d1) Or d1="1" Or d0="1"
		t=quo(d0, i): tt=quo(d1, i)
		If InStr(t, ".")=0 And InStr(tt, ".")=0 Then d0=t: d1=tt Else i=sum(i, "1")
	Loop
	if d1="1" Then Return sum(x, mti(d0, d1))
	Do Until com(d1, d0)
		d0=sum(d0, "-"+d1)
		ad=sum(ad, "1")
	Loop
	x=sum(x, ad)
	If k Then x="-"+x
	If d0="0" Then	Return x
	eas=x+"."+d0+"/"+d1
End Function
 
Sub drb (ByRef x As String, ByRef k As Integer, ByRef d As String, ByRef d0 As String, ByRef d1 As String)
	Dim As Integer dp0
	k=Mid(x, 1, 1)="-"
	dp0=InStr(x, ".")
	If dp0=0 Then dp0=Len(x)+1
	d=Right(x, Len(x)-dp0)
	x=Left(x, dp0-1)
	d0=Left(d, InStr(d, "/")-1)
	d1=Right(d, Len(d)-InStr(d, "/"))
End Sub
 
Function st0 (x As String, y As String) As String Ptr
	Dim As Integer i
	Dim As String Ptr pointer0
	For i=1 To 32
		If buffer(i)="" Then pointer0=@buffer(i): Exit For
	Next
	Poke String, pointer0, x+" "+y
	st0=pointer0
End Function
 
Function TCr (p As Sub Ptr, x As String, y As String) As thread
	Dim As thread temp
	temp.arrow=st0(x, y)
	temp.handle=ThreadCreate(p, temp.arrow)
	Return temp
End Function
 
Sub cursor_picture_set () Constructor
	Dim As Integer i, j
	For i=1 To 50
		For j=1 To 50
			If Abs(25-i)=3 Or Abs(25-j)=3 Then cursors(1, i, j)=RGB(150, 255, 0)
			If Abs(25-i)=3 Or Abs(25-j)=3 Then cursors(2, i, j)=RGB(255, 150, 0)
			If Abs(25-i)=3 Or Abs(25-j)=3 Then cursors(3, i, j)=RGB(255, 255, 255)
			If Abs(25-i)=5 Or Abs(25-j)=5 Then cursors(3, i, j)=RGB(255, 150, 0)
		Next j
	Next i
End Sub
 
Sub mouse_initialization () Constructor
	mousec(0)
	mouse.cursor=1
End Sub
 
Sub mousec OverLoad() 'mouse control
	Dim As Integer r, i, j
	If mouse.button=0 Then mouse.trueth=1 Else mouse.trueth=0
	r=GetMouse(mouse.x, mouse.y, mouse.wheel, mouse.button)
	If mouse.x=-1 Then
		If mouse.activity=-1 Then mousec(1): mouse.activity=0
	Else
		If mouse.activity=0 Then mousec(0): mouse.activity=-1
		For i=1 To 50
			For j=1 To 50
				If cursors(mouse.cursor, i, j) Then PSet(mouse.x-25+i, mouse.y-25+j), cursors(mouse.cursor, i, j)
			Next
		Next
	EndIf
End Sub
 
Sub mousec OverLoad(comm As integer) 'windows' cursor set
	SetMouse , , comm
End Sub
 
Sub changescreen () 'screen pages control
	ScreenSet sc_da, 1-sc_da
	sc_da=1-sc_da
	Cls
End Sub
 
Function button (x As Integer, y As Integer, b_x As Integer, b_y As Integer, st As String, tipst As String) As Integer  'button maintenance
	Dim As Integer r, tip
	Dim As Double col
	mouse.cursor=1
	If mouse.x>x And mouse.x<x+b_x And mouse.y>y And mouse.y<y+b_y Then
		Line (x, y)-(x+b_x, y+b_y), RGB(0, 255, 0), b
		r=1
		mouse.cursor=2
		If mouse.button=1 Then
			mouse.cursor=3
			Line (x, y)-(x+b_x, y+b_y), RGB(255, 0, 0), b
			Line (x-2, y-2)-(x+b_x+2, y+b_y+2), RGB(255, 0, 0), b
			r=2
		EndIf
	Else
		Line (x, y)-(x+b_x, y+b_y), RGB(0, 128, 0), b
	EndIf
	Line (x+15, y-5)-(x+23+Len(st)*8, y+5), RGB(0, 0, 0), bf
	If tipst="" Then col=RGB(0, 0, 255) Else col=RGB(255, 255, 255)
	If st<>"" Then Draw String (x+20, y-4), st, col
	If tipst<>"" And r=1 Then tip=button(mouse.x+3, mouse.y-15, 30+Len(tipst)*8.75, 12, tipst, "")
	button=r
End Function
 
Sub trigger (ByRef trig As Integer, x As Integer, y As Integer, b_x As Integer, b_y As Integer, st As String, tipst As String)
	Dim As Integer t
	Dim As Double col
	col=IIf(trig, RGB(64, 16, 16), RGB(16, 64, 16))
	Line (x+10, y+10)-(x+b_x-10, y+b_y-10), col, bf
	t=button (x, y, b_x, b_y, st, tipst)
	If t=2 And mouse.trueth Then trig=-(1+trig)
End Sub
 
Function editor As String
	Dim As String st="                                [Enter]", st_
	ScreenSet 1-sc_da, 1-sc_da
	Line (300, 340)-(720, 390), RGB(0, 32, 0), bf
	SetMouse mouse.x, mouse.y, 1
	button (312, 356, 400, 20, st, " ")
	Locate 45, 43
	Input "", st_
	SetMouse mouse.x, mouse.y, 0
	editor=st_
End Function
 
Function compute (st1 As String, st2 As String, action As Integer) As String
	Dim As String t
	ScreenSet 1-sc_da, 1-sc_da
	Line (370, 340)-(654, 390), RGB(0, 32, 0), bf
	button (387, 356, 250, 20,"computing... please, wait"," ")
	If action=0 Then t=sum (st1, st2) Else t=mti(st1, st2)
	Sleep 500
	compute=t
End Function

---

Для примера можно попробовать 0.1/2 и 0.1/2 при сложении (не проверял, как работает программа, при разных формах записи, проверки на правильность написания пока нет).

калькулятор делается просто !

Код vb:

select case '<оператор сложения вычитание умножение и тд>
case xxx : 'высчитывается строка с оператором 
case < ( > : 'вызов этой же функции рекурсивно до < ) >

Вы о чем?

не знаю есть там такое на FB.. но должно быть

например я ввожу гдето (2 + 2)*3 -(9 / 2 )

моя рекурсивная функция под названием result проходится по всем выражениям
поймало скобку, вызывает себя заново, и проходиться по выражению в скобке ...
как только клон программы выходит из рекурсии, то выражение в скобке подменяется переменной
тоесть сама функция возвращает эту переменную
теперь программа уже в первом своём исполнении продожает считать 4 * 3 ..- (9 / 2)

разбивая на отдельные операторы .. конечным оператором по умолчанию будет =

итак: 4 * 3
пробегаем по каждому ..
если число то запоминаем, если оператор
то в зависимости от того какой оператор вычисляем result= result * newNum
или если оператор был минусом тогда result= result - newNum
если опять будет скобка, то опять функция вызывает себя пока все скобки не закроются

я какнибудь сделаю.., на байсике, если не лень мне будет
все кнопки будут самозарождаться, так-же там будет несколько скинов
цифры, обязательно скобки, корни и тд, и кнопка дополнительно для ввода
тригонометрической функции .. это сделать не трудно, дольше скины придеться рисовать

но я хочу сделать чтоб можно было числа считать с любой разрядностью
там числа у меня будут представляться динамическим массивом
и внутринние операции будут производиться в 2^31-чной системе столбиком
тоесть для сложения нижние элементы массивов будут пересчитываться
а перенос перекидывать в верхние элементы

Мне очень тяжело работать над кодом, когда везде попадаются комментарии; не знаю, куда их можно записывать. Если не
секрет, поделитесь, куда Вы их пишете ?

Перед процедуркой, префикс комментария дальше 2-5 пробелов и сам комментарий, это комментарий блока.
Спарва от любых операций префикс коммента, 2-3 пробела и сам комментарий, это комментарий действия\операции.
Для визуального отделения бывает юзаю псевдографику, либо просто перед строкой с комментарием и после неё
делаю пустые комментарии.
Вообще стилистически Good.Morning ты всё зашибись делаешь, если б ещё полное соответствие QB IDE-шке было
то вообще верх читабельности.

Вы имеете в виду классы, свойства, методы?

На FB ООП? Вы меня убиваете... Монинг пиши без ООП, всех порвёшь... Я уже в твоей проге ничего не рублю,
когда начал конструкторы оверлоды добавлять. Так ли оно надо тут? Впрочем чё я пристал, каждому своё.