Reply to thread

Message

<blockquote data-quote="madurax86" data-source="post: 5582209" data-attributes="member: 1293">ඕන්න කට්ටියට ඕන නම් ගන්න මේක Scientific Cal එකක් Delphi වලින් ලිව්වෙ මට VB6 වල string functions පුරුදුවෙලා නිසා මේකෙ ඒවත් අලුතෙන් හදලා&nbsp; තමා පටන් ගත්තෙ.සම්පූර්ණ project එක(exe සමඟ)<a href="http://madurax86.2kmegs.com/Calc.zip" target="_blank">http://madurax86.2kmegs.com/Calc.zip</a>[code]//--Info// * Originally written by Madura Anushanga Shelton// * Last updated: 16/09/09// * Please give credit where credit is due, if you are planning to use this code//&nbsp;&nbsp; or its ideas :D//--program Project1;{$APPTYPE CONSOLE}uses SysUtils;var&nbsp; s:string;&nbsp;&nbsp; iWidth:integer;&nbsp; sTmp:string;//--main cal functionsfunction add(sVal1,sVal2:string):string;var r1,r2:real;begin&nbsp; val(sval1,r1,iWidth);&nbsp; val(sval2,r2,iWidth);&nbsp; result:=formatfloat('',r2+r1) ;end;function subtract(sVal1,sVal2:string):string;var r1,r2:real;begin&nbsp; val(sval1,r1,iWidth);&nbsp; val(sval2,r2,iWidth);&nbsp; result:=formatfloat('',r1-r2) ;end;function divide(sVal1,sVal2:string):string;var r1,r2:real;begin&nbsp; val(sval1,r1,iWidth);&nbsp; val(sval2,r2,iWidth);&nbsp; result:=formatfloat('',r1/r2) ;end;function multiply(sVal1,sVal2:string):string;var r1,r2:real;begin&nbsp; val(sval1,r1,iWidth);&nbsp; val(sval2,r2,iWidth);&nbsp; result:=formatfloat('',r1*r2) ;end;//--//--string manipulation and convertionfunction Rev(sMain:string):string;var s:string;i:integer;begin&nbsp; s:=smain;&nbsp; for i := 1 to length(sMain) do&nbsp; begin&nbsp; &nbsp;&nbsp; s[length(sMain)-i+1]:=sMain[i];&nbsp; end;&nbsp; rev:= s;end;function Mid(const strMain:string;const iStart,iLen:Integer):string;var i,j:integer;var strOut:string;begin&nbsp; j:=iLen;&nbsp; if iLen = 0 then&nbsp; begin&nbsp; &nbsp; j:=length(strMain)-iStart;&nbsp; end;&nbsp; for i := 1 to j do&nbsp; &nbsp; begin&nbsp; &nbsp; &nbsp; strOut := strOut + strMain[i+iStart];&nbsp; &nbsp; end;&nbsp; result:=strout;end;function Replace(const strMain,strSearch,strReplace:string):string;var i:integer;strOut:string;t:integer;begin&nbsp; //go through the string&nbsp; i:=-1;&nbsp; t:=1;&nbsp; while (t=1) do&nbsp; &nbsp; begin&nbsp; &nbsp; &nbsp; i:=i+1;&nbsp; &nbsp; &nbsp; if strSearch = mid(strMain,i,length(strSearch)) then&nbsp; &nbsp; &nbsp; &nbsp; begin&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; strOut:=strOut+strReplace;&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;&nbsp; //replace if found&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; i:= i+length(strSearch)-1;&nbsp; &nbsp; &nbsp; &nbsp; end&nbsp; &nbsp; &nbsp; else&nbsp; &nbsp; &nbsp; &nbsp; begin&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; strOut:=strOut+mid(strMain,i,1);&nbsp; &nbsp; &nbsp; &nbsp; //if not found amend&nbsp; &nbsp; &nbsp; &nbsp; end;&nbsp; &nbsp; &nbsp; if i= length(strMain) then t:=0;&nbsp; &nbsp; end;&nbsp; result:=strOut;end;function InStr(const strMain,strSearch:string; iStart:integer=0):integer;var i,j:integer;begin&nbsp; j:=-1;&nbsp; for i := iStart to length(strMain) - length(strSearch) do&nbsp; begin&nbsp; &nbsp; if strSearch=mid(strMain,i,length(strSearch)) then&nbsp; &nbsp; begin&nbsp; &nbsp; &nbsp; j:=i;&nbsp; &nbsp; &nbsp; break;&nbsp; &nbsp; end;&nbsp; end;&nbsp; InStr:=j;end;function c_sr(sNum:string):real;var r1:real;begin&nbsp; val(snum,r1,iWidth);&nbsp; c_sr:=r1;end;function c_rs(rNum:real):string;begin&nbsp; c_rs:=formatfloat('',rNum);end;procedure GetNumbers(const strMain,strChk:string;var iL,iR:real;var strRep:string);var&nbsp;&nbsp; i,j:integer;k,l:string; label 2;begin&nbsp; j:=instr(strmain,strChk,1);&nbsp; for i := j+2 to length(strmain) do&nbsp; &nbsp; begin&nbsp; &nbsp; &nbsp; if ((strmain[i]='/') or (strmain[i]='*') or (strmain[i]='+')&nbsp; or (strmain[i]='-') )And not (j+2=i )then&nbsp; &nbsp; &nbsp; &nbsp; begin&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; //if&nbsp; (strmain[i]='+')&nbsp; or (strmain[i]='-') then&nbsp; k:=k+strmain[i];&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; break;&nbsp; &nbsp; &nbsp; &nbsp; end&nbsp; &nbsp; &nbsp; else&nbsp; &nbsp; &nbsp; &nbsp; begin&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; k:=k+strmain[i];&nbsp; &nbsp; &nbsp; &nbsp; end;&nbsp; &nbsp; end;&nbsp; &nbsp; for i := j downto 1 do&nbsp; &nbsp; begin&nbsp; &nbsp; &nbsp; if (strmain[i]='/') or (strmain[i]='*') or (strmain[i]='+')&nbsp; or (strmain[i]='-') then&nbsp; &nbsp; &nbsp; &nbsp; begin&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; if&nbsp; (strmain[i]='+')&nbsp; or (strmain[i]='-') then&nbsp; l:=l+strmain[i];&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; break;&nbsp; &nbsp; &nbsp; &nbsp; end&nbsp; &nbsp; &nbsp; else&nbsp; &nbsp; &nbsp; &nbsp; begin&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; l:=l+strmain[i];&nbsp; &nbsp; &nbsp; &nbsp; end;&nbsp; &nbsp; end;&nbsp; &nbsp; l:=rev(l);&nbsp; &nbsp; iL:=c_sr(l);&nbsp; &nbsp; iR:=c_sr(k);&nbsp; &nbsp; strRep:=l+strchk+k;end;//--//--recursivefunction Division(const strMain:string;var strRes:string):string;var sOut,sRep:string;r1,r2:real;begin&nbsp; if not (instr(strmain,'/') = -1) then&nbsp; begin&nbsp; &nbsp; getnumbers(strmain,'/',r1,r2,sRep);&nbsp; &nbsp; sout:=replace(strmain,srep,c_rs(r1/r2));&nbsp; &nbsp; if instr(sout,'/') = -1 then&nbsp; &nbsp; &nbsp; strRes := sout&nbsp; &nbsp; else&nbsp; &nbsp; &nbsp; Division(sout,strRes);&nbsp; end&nbsp; else strres:=strmain;end;function Multiplication(const strMain:string;var strRes:string):string;var sOut,sRep:string;r1,r2:real;begin&nbsp; if not (instr(strmain,'*') = -1) then&nbsp; begin&nbsp; &nbsp; getnumbers(strmain,'*',r1,r2,sRep);&nbsp; &nbsp; sout:=replace(strmain,srep,c_rs(r1*r2));&nbsp; &nbsp; if instr(sout,'*') = -1 then&nbsp; &nbsp; &nbsp; strRes := sout&nbsp; &nbsp; else&nbsp; &nbsp; &nbsp; Multiplication(sout,strRes);&nbsp; end&nbsp; else strres:=strmain;end;function Addition(const strMain:string;var strRes:string):string;var sOut,sRep:string;r1,r2:real;begin&nbsp; if not (instr(strmain,'+',1) = -1) then&nbsp; begin&nbsp; &nbsp; getnumbers(strmain,'+',r1,r2,sRep);&nbsp; &nbsp; sout:=replace(strmain,srep,c_rs(r1+r2));&nbsp; &nbsp; if instr(sout,'+') = -1 then&nbsp; &nbsp; &nbsp; strRes := sout&nbsp; &nbsp; else&nbsp; &nbsp; &nbsp; Addition(sout,strRes);&nbsp; end&nbsp; else strres:=strmain;end;function Subtraction(const strMain:string;var strRes:string):string;var sOut,sRep:string;r1,r2:real;begin&nbsp; if not (instr(strmain,'-',1) = -1) then&nbsp; begin&nbsp; &nbsp; getnumbers(strmain,'-',r1,r2,sRep);&nbsp; &nbsp; sout:=replace(strmain,srep,c_rs(r1-r2));&nbsp; &nbsp; if (instr(sout,'-') = -1) then&nbsp; &nbsp; &nbsp; strRes := sout&nbsp; &nbsp; else&nbsp; &nbsp; &nbsp; Subtraction(sout,strRes);&nbsp; end&nbsp; else strres:=strmain;end;//--//--Execution--no parenthesis levelfunction Execute(const str:string):string;var i:integer; label 1;begin&nbsp; //BODMAS&nbsp; if (trim(str)='') then begin stmp:=str; goto 1; end;&nbsp; division(str,stmp);&nbsp; multiplication(stmp,stmp);&nbsp; addition(stmp,stmp);&nbsp; subtraction(stmp,stmp);&nbsp;&nbsp; 1: Execute:=stmp;end;//--//--Calculator-mainprocedure CutParenthesis(strIn:string);var i,j,k:integer; a:string;begin&nbsp; k:=0;&nbsp; for i := 0 to length(strIn) do if strIn[i] = '('&nbsp; then j:=i; //get last '('&nbsp; for i := j to length(strIn) do if (strIn[i] = ')') and (k=0) then k:=i&nbsp; ; //first ')'&nbsp; a:=mid(strIn,j,k-j-1);&nbsp; &nbsp; //execute a, a will not include '(',')'&nbsp; strIn:=replace(strIn,'('+a+')',trim(Execute(a)));&nbsp; if instr(strIn,'(')=-1 then&nbsp; &nbsp; begin&nbsp; &nbsp; &nbsp; strIn:=Execute(strIn);&nbsp; &nbsp; &nbsp; writeln(' = '+strIn);&nbsp; &nbsp; &nbsp; writeln('');&nbsp; &nbsp; end&nbsp; else&nbsp; &nbsp; cutparenthesis(strIn);end;procedure Calc();&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; //main loop of the whole calculatorvar s:string;begin&nbsp; stmp:='';&nbsp; iWidth:=3;&nbsp; s:='';&nbsp; readln(s);&nbsp; if not (instr(s,'{') = -1)&nbsp; then&nbsp; s:=replace(s,'{','(');&nbsp; if not (instr(s,'[') = -1)&nbsp; then&nbsp; s:=replace(s,'[','(');&nbsp; if not (instr(s,']') = -1)&nbsp; then&nbsp; s:=replace(s,']',')');&nbsp; if not (instr(s,'}') = -1)&nbsp; then&nbsp; s:=replace(s,'}',')');&nbsp; CutParenthesis(s);end;//--//--Some DOS graphics :Pprocedure PrintHeader();var j:integer;begin&nbsp; for j := 1 to 80 do write('=');&nbsp; writeln('');&nbsp; writeln(' A Simple Scientific Calculator - Written by Madura Anushanga Shelton in Delphi');&nbsp; writeln(' * Do NOT enter wrong expressions, it''ll not throw an error for wrong input.');&nbsp; writeln('');&nbsp; for j := 1 to 80 do write('=');&nbsp; writeln('');end;//--var i:integer;begin&nbsp; PrintHeader;&nbsp; i:=0;&nbsp; while i=0 do calc;end.[/code]</blockquote>

[QUOTE="madurax86, post: 5582209, member: 1293"] ඕන්න කට්ටියට ඕන නම් ගන්න මේක Scientific Cal එකක් Delphi වලින් ලිව්වෙ මට VB6 වල string functions පුරුදුවෙලා නිසා මේකෙ ඒවත් අලුතෙන් හදලා තමා පටන් ගත්තෙ. සම්පූර්ණ project එක(exe සමඟ) [url]http://madurax86.2kmegs.com/Calc.zip[/url] [code] //--Info // * Originally written by Madura Anushanga Shelton // * Last updated: 16/09/09 // * Please give credit where credit is due, if you are planning to use this code // or its ideas :D //-- program Project1; {$APPTYPE CONSOLE} uses SysUtils; var s:string; iWidth:integer; sTmp:string; //--main cal functions function add(sVal1,sVal2:string):string; var r1,r2:real; begin val(sval1,r1,iWidth); val(sval2,r2,iWidth); result:=formatfloat('',r2+r1) ; end; function subtract(sVal1,sVal2:string):string; var r1,r2:real; begin val(sval1,r1,iWidth); val(sval2,r2,iWidth); result:=formatfloat('',r1-r2) ; end; function divide(sVal1,sVal2:string):string; var r1,r2:real; begin val(sval1,r1,iWidth); val(sval2,r2,iWidth); result:=formatfloat('',r1/r2) ; end; function multiply(sVal1,sVal2:string):string; var r1,r2:real; begin val(sval1,r1,iWidth); val(sval2,r2,iWidth); result:=formatfloat('',r1*r2) ; end; //-- //--string manipulation and convertion function Rev(sMain:string):string; var s:string;i:integer; begin s:=smain; for i := 1 to length(sMain) do begin s[length(sMain)-i+1]:=sMain[i]; end; rev:= s; end; function Mid(const strMain:string;const iStart,iLen:Integer):string; var i,j:integer;var strOut:string; begin j:=iLen; if iLen = 0 then begin j:=length(strMain)-iStart; end; for i := 1 to j do begin strOut := strOut + strMain[i+iStart]; end; result:=strout; end; function Replace(const strMain,strSearch,strReplace:string):string; var i:integer;strOut:string;t:integer; begin //go through the string i:=-1; t:=1; while (t=1) do begin i:=i+1; if strSearch = mid(strMain,i,length(strSearch)) then begin strOut:=strOut+strReplace; //replace if found i:= i+length(strSearch)-1; end else begin strOut:=strOut+mid(strMain,i,1); //if not found amend end; if i= length(strMain) then t:=0; end; result:=strOut; end; function InStr(const strMain,strSearch:string; iStart:integer=0):integer; var i,j:integer; begin j:=-1; for i := iStart to length(strMain) - length(strSearch) do begin if strSearch=mid(strMain,i,length(strSearch)) then begin j:=i; break; end; end; InStr:=j; end; function c_sr(sNum:string):real; var r1:real; begin val(snum,r1,iWidth); c_sr:=r1; end; function c_rs(rNum:real):string; begin c_rs:=formatfloat('',rNum); end; procedure GetNumbers(const strMain,strChk:string;var iL,iR:real;var strRep:string); var i,j:integer;k,l:string; label 2; begin j:=instr(strmain,strChk,1); for i := j+2 to length(strmain) do begin if ((strmain[i]='/') or (strmain[i]='*') or (strmain[i]='+') or (strmain[i]='-') )And not (j+2=i )then begin //if (strmain[i]='+') or (strmain[i]='-') then k:=k+strmain[i]; break; end else begin k:=k+strmain[i]; end; end; for i := j downto 1 do begin if (strmain[i]='/') or (strmain[i]='*') or (strmain[i]='+') or (strmain[i]='-') then begin if (strmain[i]='+') or (strmain[i]='-') then l:=l+strmain[i]; break; end else begin l:=l+strmain[i]; end; end; l:=rev(l); iL:=c_sr(l); iR:=c_sr(k); strRep:=l+strchk+k; end; //-- //--recursive function Division(const strMain:string;var strRes:string):string; var sOut,sRep:string;r1,r2:real; begin if not (instr(strmain,'/') = -1) then begin getnumbers(strmain,'/',r1,r2,sRep); sout:=replace(strmain,srep,c_rs(r1/r2)); if instr(sout,'/') = -1 then strRes := sout else Division(sout,strRes); end else strres:=strmain; end; function Multiplication(const strMain:string;var strRes:string):string; var sOut,sRep:string;r1,r2:real; begin if not (instr(strmain,'*') = -1) then begin getnumbers(strmain,'*',r1,r2,sRep); sout:=replace(strmain,srep,c_rs(r1*r2)); if instr(sout,'*') = -1 then strRes := sout else Multiplication(sout,strRes); end else strres:=strmain; end; function Addition(const strMain:string;var strRes:string):string; var sOut,sRep:string;r1,r2:real; begin if not (instr(strmain,'+',1) = -1) then begin getnumbers(strmain,'+',r1,r2,sRep); sout:=replace(strmain,srep,c_rs(r1+r2)); if instr(sout,'+') = -1 then strRes := sout else Addition(sout,strRes); end else strres:=strmain; end; function Subtraction(const strMain:string;var strRes:string):string; var sOut,sRep:string;r1,r2:real; begin if not (instr(strmain,'-',1) = -1) then begin getnumbers(strmain,'-',r1,r2,sRep); sout:=replace(strmain,srep,c_rs(r1-r2)); if (instr(sout,'-') = -1) then strRes := sout else Subtraction(sout,strRes); end else strres:=strmain; end; //-- //--Execution--no parenthesis level function Execute(const str:string):string; var i:integer; label 1; begin //BODMAS if (trim(str)='') then begin stmp:=str; goto 1; end; division(str,stmp); multiplication(stmp,stmp); addition(stmp,stmp); subtraction(stmp,stmp); 1: Execute:=stmp; end; //-- //--Calculator-main procedure CutParenthesis(strIn:string); var i,j,k:integer; a:string; begin k:=0; for i := 0 to length(strIn) do if strIn[i] = '(' then j:=i; //get last '(' for i := j to length(strIn) do if (strIn[i] = ')') and (k=0) then k:=i ; //first ')' a:=mid(strIn,j,k-j-1); //execute a, a will not include '(',')' strIn:=replace(strIn,'('+a+')',trim(Execute(a))); if instr(strIn,'(')=-1 then begin strIn:=Execute(strIn); writeln(' = '+strIn); writeln(''); end else cutparenthesis(strIn); end; procedure Calc(); //main loop of the whole calculator var s:string; begin stmp:=''; iWidth:=3; s:=''; readln(s); if not (instr(s,'{') = -1) then s:=replace(s,'{','('); if not (instr(s,'[') = -1) then s:=replace(s,'[','('); if not (instr(s,']') = -1) then s:=replace(s,']',')'); if not (instr(s,'}') = -1) then s:=replace(s,'}',')'); CutParenthesis(s); end; //-- //--Some DOS graphics :P procedure PrintHeader(); var j:integer; begin for j := 1 to 80 do write('='); writeln(''); writeln(' A Simple Scientific Calculator - Written by Madura Anushanga Shelton in Delphi'); writeln(' * Do NOT enter wrong expressions, it''ll not throw an error for wrong input.'); writeln(''); for j := 1 to 80 do write('='); writeln(''); end; //-- var i:integer; begin PrintHeader; i:=0; while i=0 do calc; end. [/code] [/QUOTE]

Verification

Hathara warak wissa keeyada? (Hathara wadi karanna 20)

Latest ads

Reply to thread