Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

CURSE / MAIN

.PAS
Скачиваний:
22
Добавлен:
22.09.2014
Размер:
16.25 Кб
Скачать
{$N+} {$R-}
uses Mouse,Graph,CRT,MousePress;
const
radian = 57.295779513;
type
GUI = object
procedure drawBackground;
end;

{****************************************}


function parseInt(my_Str:string):extended;
var myReal:extended;
myInt:word;
begin
val(my_Str,myReal,myInt);
parseInt:=myReal;
end;

function toString(my_Real:extended):string;
var result:string[100];
begin
Str(my_Real,result);
toString:=result;
end;

procedure drawButtons;
begin
setFillStyle(solidFill,9);
begin
{
1_st line
}
bar(20,90,70,140);
bar(75,90,125,140);
bar(130,90,180,140);
bar(185,90,235,140);
{
2_nd line
}
bar(20,150,70,200);
bar(75,150,125,200);
bar(130,150,180,200);
bar(185,150,235,200);
{
3_rd line
}
bar(20,210,70,260);
bar(75,210,125,260);
bar(130,210,180,260);
bar(185,210,235,260);
{
4_th line
}
bar(20,270,70,320);
bar(75,270,125,320);
bar(130,270,180,320);
bar(185,270,235,320);
{
5_th line
}
bar(20,330,70,380);
bar(75,330,125,380);
bar(130,330,180,380);
bar(185,330,235,380);
{
6_th_line
}
bar(20,390,70,440);
bar(75,390,125,440);
bar(130,390,180,440);
bar(185,390,235,440);

begin
setFillStyle(solidFill,7); {--------- MENU}
bar(260,380,630,470);

SetColor(black);
SetTextStyle(3,0,3);
setFillStyle(solidFill,9); {--------- MENU ITEMS}

bar(265,390,335,440);
outTextXY(275,400,'EXIT');

bar(345,390,395,440);
outTextXY(365,400,'.');

bar(405,390,475,440);
outTextXY(415,400,'Draw');

bar(485,390,620,440);
outTextXY(495,400,' Clear');
end;
end;


begin
SetColor(black);
SetTextStyle(3,0,3);

outTextXY(30,100,'sin');
outTextXY(85,100,'cos');
outTextXY(140,100,'tan');
outTextXY(200,100,'BS');

outTextXY(30,160,'log');
outTextXY(90,160,'ln');
outTextXY(135,160,'sqrt');
outTextXY(192,160,'sqr');

outTextXY(37,220,'7');
outTextXY(92,220,'8');
outTextXY(147,220,'9');
outTextXY(192,220,'div');

outTextXY(37,280,'4');
outTextXY(92,280,'5');
outTextXY(147,280,'6');
outTextXY(190,280,'mul');

outTextXY(37,340,'1');
outTextXY(92,340,'2');
outTextXY(147,340,'3');
outTextXY(200,340,'-');

outTextXY(37,400,'0');
outTextXY(92,400,'=');
outTextXY(135,400,'CLR');
outTextXY(200,400,'+');


end;
end;

procedure drawCells;
var i,k:byte;
begin {260,10,630,370}
setColor(blue);
setFillStyle(solidFill,black);
bar(261,11,629,369);
for i:=1 to 22 do begin
line(260,10+i*16,630,10+i*16);
for k:=1 to 24 do begin
line(260+k*16,10,260+k*16,370);
end;
end;
setColor(red);
line(260,202,630,202);
line(452,10,452,370);
end;

procedure drawSinus(cl:boolean);
var ex:extended;
begin
ex:=6*pi-0.3;
if (cl) then drawCells;
repeat
putpixel(round((ex)*20)+260,round(sin(ex)*20)+200,2);
ex:=ex-0.001;
if(ex < 0) then break;
until (ex < 0);
end;

procedure drawCosinus(cl:boolean);
var ex:extended;
begin
if(cl = true) then drawCells;
ex:=6*pi-0.3;
repeat
putpixel(round((ex)*20)+260,round(cos(ex)*20)+200,yellow);
ex:=ex-0.001;
if(ex < 0) then break;
until (ex < 0);
end;

procedure drawTangens(cl:boolean);
var ex,ts:extended;
begin
ex:=0;
if(cl = true) then drawCells;
repeat
ts:= sin(ex)/cos(ex);
if(ts <> 0) then begin
ts:=round(cos(ex)/sin(ex)*20)+200;
if(ts <= 370) and (ts >= 10)then {260,10,630,370}
putpixel(round((ex)*20)+260,round(cos(ex)/sin(ex)*20)+200,white);
end;
ex:=ex+0.001;
if(ex > 6*pi-0.3) then break;
until (ex > 6*pi-0.3);
end;


{--------------------------}
procedure GUI.drawBackground;
var i,k:byte;
begin

setFillStyle(solidFill,black);
bar(0,0,640,480);

setFillStyle(solidFill,white);
bar(10,10,250,470);
setColor(black);
line(10,30,249,30);
setFillStyle(solidFill,7);
bar(11,69,249,469);
setColor(white);
Rectangle(260,10,630,370);
drawCells;
end;
{--------------------------}

{--------------------------}



{****************************************}

procedure graphInit;
var grDriver,grMode,errCode:integer;
begin
grDriver:=Detect;
InitGraph(grDriver,grMode,'C:\');
errCode := GraphResult;
if(ErrCode <> grOk) then
begin
writeln('ERROR OOPS:(');
halt;
delay(500);
end;
end;


procedure mouseHover(x1,y1,x2,y2:word;inbox:boolean);
begin
if inbox = true then begin
setColor(White);
rectangle(x1,y1,x2,y2);
end else begin
setColor(9);
rectangle(x1,y1,x2,y2);
end;
end;


function sinus(arg_1:string):string;
var tmp,arg_2:extended;
begin
arg_2:=parseInt(arg_1);
tmp:= arg_2 / radian;
drawSinus(true);
tmp:=sin(tmp);
sinus:=toString(tmp);
end;


function cosinus(arg_1:string):string;
var tmp,arg_2:extended;
begin
arg_2:=parseInt(arg_1);
tmp:= arg_2 / radian;
tmp:=cos(tmp);
cosinus:=toString(tmp);
drawCosinus(true);
end;


function myLog(arg_1:string):string;
var tmp:extended;
begin
tmp:=parseInt(arg_1);
tmp:=ln(tmp);
myLog:=toString(tmp);
end;

function myLn(arg_1:string):string;
var tmp:extended;
begin
tmp:=parseInt(arg_1);
tmp:=ln(tmp)/ln(10);
myLn:=toString(tmp);
end;


function mySqr(arg_1:string):string;
var tmp:extended;
begin
tmp:=parseInt(arg_1);
tmp:=sqr(tmp);
mySqr:=toString(tmp);
end;

function mySqrt(arg_1:string):string;
var tmp:extended;
begin
tmp:=parseInt(arg_1);
tmp:=sqrt(tmp);
mySqrt:=toString(tmp);
end;

function tangens(arg_1:string):string;
var tmp,arg_2:extended;
begin
arg_2:=parseInt(arg_1);
tmp:= arg_2 / radian;
if(cos(tmp)<>0) then
tmp:=sin(tmp)/cos(tmp)
else
tmp:=999999999;

tangens:=toString(tmp);
drawTangens(true);
end;

procedure Hover;
begin
if(MouseIn(265,390,335,440)) then begin {pressed EXIT}
mouseHover(265,390,335,440,true);
end else mouseHover(265,390,335,440,false);

if(MouseIn(345,390,395,440)) then begin
mouseHover(345,390,395,440,true);
end else mouseHover(345,390,395,440,false);

if(MouseIn(405,390,475,440)) then begin
mouseHover(405,390,475,440,true);
end else mouseHover(405,390,475,440,false);

if(MouseIn(485,390,620,440)) then begin
mouseHover(485,390,620,440,true);
end else mouseHover(485,390,620,440,false);


if(MouseIn(20,90,70,140)) then begin
mouseHover(20,90,70,140,true);
end else mouseHover(20,90,70,140,false);

if(MouseIn(75,90,125,140)) then begin
mouseHover(75,90,125,140,true);
end else mouseHover(75,90,125,140,false);

if(MouseIn(130,90,180,140)) then begin
mouseHover(130,90,180,140,true);
end else mouseHover(130,90,180,140,false);

if(MouseIn(185,90,235,140)) then begin
mouseHover(185,90,235,140,true);
end else mouseHover(185,90,235,140,false);


if(MouseIn(20,150,70,200)) then begin
mouseHover(20,150,70,200,true);
end else mouseHover(20,150,70,200,false);

if(MouseIn(75,150,125,200)) then begin
mouseHover(75,150,125,200,true);
end else mouseHover(75,150,125,200,false);

if(MouseIn(130,150,180,200)) then begin
mouseHover(130,150,180,200,true);
end else mouseHover(130,150,180,200,false);

if(MouseIn(185,150,235,200)) then begin
mouseHover(185,150,235,200,true);
end else mouseHover(185,150,235,200,false);

if(MouseIn(20,210,70,260)) then begin
mouseHover(20,210,70,260,true);
end else mouseHover(20,210,70,260,false);

if(MouseIn(75,210,125,260)) then begin
mouseHover(75,210,125,260,true);
end else mouseHover(75,210,125,260,false);

if(MouseIn(130,210,180,260)) then begin
mouseHover(130,210,180,260,true);
end else mouseHover(130,210,180,260,false);

if(MouseIn(185,210,235,260)) then begin
mouseHover(185,210,235,260,true);
end else mouseHover(185,210,235,260,false);

if(MouseIn(20,270,70,320)) then begin
mouseHover(20,270,70,320,true);
end else mouseHover(20,270,70,320,false);

if(MouseIn(75,270,125,320)) then begin
mouseHover(75,270,125,320,true);
end else mouseHover(75,270,125,320,false);


if(MouseIn(130,270,180,320)) then begin
mouseHover(130,270,180,320,true);
end else mouseHover(130,270,180,320,false);

if(MouseIn(185,270,235,320)) then begin
mouseHover(185,270,235,320,true);
end else mouseHover(185,270,235,320,false);


if(MouseIn(20,330,70,380)) then begin
mouseHover(20,330,70,380,true);
end else mouseHover(20,330,70,380,false);

if(MouseIn(75,330,125,380)) then begin
mouseHover(75,330,125,380,true);
end else mouseHover(75,330,125,380,false);

if(MouseIn(130,330,180,380)) then begin
mouseHover(130,330,180,380,true);
end else mouseHover(130,330,180,380,false);

if(MouseIn(185,330,235,380)) then begin
mouseHover(185,330,235,380,true);
end else mouseHover(185,330,235,380,false);


if(MouseIn(20,390,70,440)) then begin
mouseHover(20,390,70,440,true);
end else mouseHover(20,390,70,440,false);

if(MouseIn(75,390,125,440)) then begin
mouseHover(75,390,125,440,true);
end else mouseHover(75,390,125,440,false);

if(MouseIn(130,390,180,440)) then begin
mouseHover(130,390,180,440,true);
end else mouseHover(130,390,180,440,false);

if(MouseIn(185,390,235,440)) then begin
mouseHover(185,390,235,440,true);
end else mouseHover(185,390,235,440,false);
end;

function makeArg_1(tmp_id:byte;tmp_str:string):string; {Передаю id и string в ответ получаю конкатинированную строку по id}
begin
case tmp_id of
21:tmp_str:=tmp_str+'0';
17:tmp_str:=tmp_str+'1';
18:tmp_str:=tmp_str+'2';
19:tmp_str:=tmp_str+'3';
13:tmp_str:=tmp_str+'4';
14:tmp_str:=tmp_str+'5';
15:tmp_str:=tmp_str+'6';
9 :tmp_str:=tmp_str+'7';
10:tmp_str:=tmp_str+'8';
11:tmp_str:=tmp_str+'9';
25:tmp_str:=tmp_str+'.';
else tmp_str:=tmp_str;
end;
makeArg_1:=tmp_str;
end;

function returnId:byte;
var id:byte;
begin
id:=0;
delay(100); { if mouse works roughly open mousepress.pas insert delay(100) procedure into pressmouse function }
hover;
if(PressMouse(265,390,335,440)) then begin {pressed EXIT}
halt;
end;
if(PressMouse(345,390,395,440)) then begin
id:=25; {.}
end;
if(PressMouse(405,390,475,440)) then begin
id:=26; {draw}
end;
if(PressMouse(485,390,620,440)) then begin
id:=27; {Reference}
end;


if(PressMouse(20,90,70,140)) then begin
id:=1; {sinus}
end;if(PressMouse(75,90,125,140)) then begin
id:=2; {cosinus}
end;if(PressMouse(130,90,180,140)) then begin
id:=3; {tangens}
end;if(PressMouse(185,90,235,140)) then begin
id:=4; {BS}
end;

if(PressMouse(20,150,70,200)) then begin
id:=5; {log}
end;if(PressMouse(75,150,125,200)) then begin
id:=6; {ln}
end;if(PressMouse(130,150,180,200)) then begin
id:=7; {sqrt}
end;if(PressMouse(185,150,235,200)) then begin
id:=8; {sqr}
end;

if(PressMouse(20,210,70,260)) then begin
id:=9; {7}
end;if(PressMouse(75,210,125,260)) then begin
id:=10; {8}
end;if(PressMouse(130,210,180,260)) then begin
id:=11; {9}
end;if(PressMouse(185,210,235,260)) then begin
id:=12; {div}
end;

if(PressMouse(20,270,70,320)) then begin
id:=13; {4}
end;if(PressMouse(75,270,125,320)) then begin
id:=14; {5}
end;if(PressMouse(130,270,180,320)) then begin
id:=15; {6}
end;if(PressMouse(185,270,235,320)) then begin
id:=16; {mul}
end;

if(PressMouse(20,330,70,380)) then begin
id:=17; {1}
end;if(PressMouse(75,330,125,380)) then begin
id:=18; {2}
end;if(PressMouse(130,330,180,380)) then begin
id:=19; {3}
end;if(PressMouse(185,330,235,380)) then begin
id:=20; {-}
end;


if(PressMouse(20,390,70,440)) then begin
id:=21; {0}
end;if(PressMouse(75,390,125,440)) then begin
id:=22; {=}
end;if(PressMouse(130,390,180,440)) then begin
id:=23; {clr}
end;if(PressMouse(185,390,235,440)) then begin
id:=24; {+}
end;
returnId:=id;
end;

procedure clearScreen;
begin
setFillStyle(solidFill,white);
bar(10,10,249,29);
bar(10,31,249,47);
bar(10,48,249,69);
end;

procedure drawArgument1(numStr:string);
var number,exponenta:extended;
begin
setFillStyle(solidFill,white);
bar(10,10,249,29);
number:=parseInt(numStr);
setColor(black);
SetTextStyle(6,0,1);
outTextXY(10,10,numStr);
end;


procedure drawArgument2(numStr:string);
var number:extended;
begin
setFillStyle(solidFill,white);
bar(10,49,249,69);
number:=parseInt(numStr);
setColor(black);
SetTextStyle(6,0,1);
outTextXY(10,50,numStr);
end;

procedure operandBuffer(op:string);
begin
SetTextStyle(6,0,1);
outTextXY(200,30,op);
end;


function doResult(first,second:string;oper:byte):string;
var arg1,arg2,result:extended;
begin
arg1:=parseInt(first);
arg2:=parseInt(second);
case oper of
1: begin
result:=arg1+arg2;
end;
2: begin
result:=arg1-arg2;
end;
3: begin
result:=arg1*arg2;
end;
4: begin
if(arg2 <> 0) then
result:=arg1/arg2
else doResult:='Error';
end;
end;
doResult:=toString(result);
end;

procedure eventListener(arg_1:string);
var id:byte;
str1,str2,result:string[100];
operand:byte;
firstArg:boolean;
begin
str1:='';
str2:='';
firstArg:=false;
operand:=0;
clearScreen;
drawArgument2(arg_1);

repeat
id:=returnId;

if(id = 23) then begin
str1:='';
str2:='';
operand:=0;
firstArg:=false;
clearScreen;
end;

if(firstArg = false) then begin
if(length(str1)<>17) then
str1:=makeArg_1(id,str1);
if(id = 4) then delete(str1,length(str1),1);
if(id<>0) then
if(id<>22) then drawArgument2('');
drawArgument1(str1);
if(length(str1)<>0) then begin
case id of
24: begin
operand:=1; firstArg:=true; {'+'}
operandBuffer('+');
end;
20: begin
operand:=2; firstArg:=true; {'-'}
operandBuffer('-');
end;
16: begin
operand:=3; firstArg:=true; {'*'}
operandBuffer('*');
end;
12: begin
operand:=4; firstArg:=true; {'/'}
operandBuffer('/');
end;
1: begin
drawArgument2(sinus(str1));
end;
2: begin
drawArgument2(cosinus(str1));
end;
3: begin
drawArgument2(tangens(str1));
end;
5: begin
drawArgument2(myLn(str1));
end;
6: begin
drawArgument2(myLog(str1));
end;
7: begin
drawArgument2(mySqrt(str1));
end;
8: begin
drawArgument2(mySqr(str1));
end;
end;
end;
end
else begin
if(length(str2)<>17) then
str2:=makeArg_1(id,str2);
if(id = 4) then delete(str2,length(str2),1);
if(id <> 0) then
drawArgument2(str2);

if(length(str2)<>0) then begin
if(id = 22) then begin {если id = '=' то ,Arg1 operand Arg3 = Result}
if(str2 = '0') then drawArgument2('Division by Zero')
else begin
result:= doResult(str1,str2,operand);
drawArgument2(result);
eventListener(result);
end;
end;
end;

end;
if(id = 26) then begin
drawSinus(false);
drawTangens(false);
drawCosinus(false);
end;

if(id = 27) then drawCells;

until false;
end;

var
screen:GUI;
begin
graphInit;
screen.drawBackground;
drawButtons;
showMouse;
SetMouseYRange(480,0);
eventListener('');
readkey;
halt;
end.
Соседние файлы в папке CURSE