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

Также было проведено исследование полученного программного продукта. В результате были выявлены следующие достоинства и недостатки полученного программного продукта:

Достоинства:

· Существует возможность сбрасывать результат;

· Программный продукт малотребователен к системным ресурсам компьютера.

Недостатки:

· Невозможность выполнения некоторых других математических операций;

· Невозможность сохранения операндов или результатов в памяти программы;

В целом, поставленная в начале курсового проекта цель была достигнута. В программе выполняются все необходимые функциональные требования.

Список литературы

program Calculator;

uses Functions,GrMouse,GrButton,Graph,GrOutPut,dos,crt;

const

Captions: string=' 7 8 9/< - x^y'+

' 4 5 6 * sin cos'+

' 1 2 3 - tg ktg'+

' 0 с. + = ы'+

' P R O E K T';

{$F+}

var

Buttons: array [1.35] of TGrButton;

CEbutton,QuitButton: TGrButton;

FirstEdit,SecondEdit: TGrButton;

MouseStatus: TMouseStatus;

Quit: boolean;

function GetCaption (i: byte): string;

var

x,TempPos,Count: byte;

begin

Count: =0;

TempPos: =0;

for x: =1 to Length (Captions) do

begin

if Captions [x] =' ' then inc (count);

if Count=i-2 then TempPos: =x;

if Count=i-1 then GetCaption: =copy (Captions,TempPos+2,x-TempPos-1);

end;

end;

procedure ChangeSysOfCount (SysOfCount: TSysCountStr);

var

Temp: string;

begin

case SysOfCount [1] of

'D': begin

end;

end;

case SysOfCount [1] of

'D': begin SysCount: =DEC; DisButtons: =DECindexes; end;

end;

FilterExpValue (FParam);

FilterExpValue (SParam);

SetFActive (false);

TextToOut (SParam);

SetFActive (true);

TextToOut (FParam);

end;

procedure SetGroupEnabled (SysOfCount: TSysCountStr);

begin

DisButtons: =ALLnumbers;

for i: =2 to 35 do

if i in DisButtons then

with Buttons [i] do

if not Enabled then

SetEnabled (true);

ChangeSysOFCount (SysOFCount);

for i: =2 to 35 do

if i in DisButtons then

Buttons [i]. SetEnabled (False);

Result: ='';

end;

procedure DrawingSquareOfButt (MaxTopInc,LeftOffs,TopOffs,BStartInd,BCount: word);

begin

j: =0;

while j<=MaxTopInc do

begin

for i: =BStartInd-1 to BStartInd+BCount-2 do

begin

Buttons [j+i+1]. Left: =i*50+LeftOffs;

Buttons [j+i+1]. Top: =j*7+TopOffs;

Buttons [j+i+1]. Draw;

end;

inc (j,7);

end;

end;

procedure Action;

begin

Quit: =true;

end;

procedure SetRadioClick (var ActButt,DisAct1,DisAct2: TGrButton);

begin

if ActButt. FillColor=ActButt. FillColor then

begin

ActButt. FillColor: =ActButt. PressedColor;

DisAct1. FillColor: =1;

DisAct2. FillColor: =1;

ActButt. Fill (ActButt. PressedColor);

DisAct1. Fill (DisAct1. FillColor);

DisAct2. FIll (DisAct2. FillColor);

end;

end;

procedure SetDECsys;

begin

SetRadioClick (Buttons [8],Buttons [1],Buttons [15]);

SetGroupEnabled ('DEC');

end;

procedure FstAction;

begin

if (FirstEdit. FillColor=1) then

begin

FirstEdit. FillColor: =4;

SecondEdit. FillColor: =1;

FirstEdit. Draw;

SecondEdit. Draw;

SetFActive (true);

Calculated: =false;

end;

end;

procedure SndAction;

begin

if (SecondEdit. FillColor=1) then

begin

FirstEdit. FillColor: =1;

SecondEdit. FillColor: =4;

FirstEdit. Draw;

SecondEdit. Draw;

SetFActive (false);

end;

end;

begin

InitGraphRegim;

ClearDevice;

QuitButton. Init;

CEButton. Init;

FirstEdit. Init;

SecondEdit. Init;

for i: =1 to 35 do

with Buttons [i] do

begin

Init;

Caption: =GetCaption (i+1);

end;

with QuitButton do

begin

Left: =140;

Top: =GetMaxY-50;

Height: =20;

Width: =370;

Caption: ='Quit';

Draw;

end;

with CEButton do

begin

Left: =GetMaxX-220;

Top: =80;

Height: =30;

Width: =85;

Caption: ='CE';

Draw;

end;

with FirstEdit do

begin

Left: =GetMaxX-55;

Top: =120;

Caption: ='Fst';

FillColor: =4;

Draw;

end;

with SecondEdit do

begin

Left: =GetMaxX-55;

Top: =170;

Caption: ='Snd';

Draw;

end;

DrawingSquareOfButt (30,140,1200,1,1);

DrawingSquareOfButt (30,170,120,2,6);

Rectangle (5,5,GetMaxX-5,GetMaxY-5);

Rectangle (OutXs,OutYs,OutXf,OutYf);

{/*End of drawing*/}

CEClick;

InitMouse;

CursorShow;

Buttons [1]. PressedColor: =8;

Buttons [8]. PressedColor: =8;

Buttons [15]. PressedColor: =8;

SetGroupEnabled ('DEC');

SetRadioClick (Buttons [8],Buttons [1],Buttons [15]);

Buttons [8]. Action: =SetDECsys;

Buttons [6]. Action: =BackSpaceSymbol;

Buttons [24]. Action: =SetPlusMines;

Buttons [27]. Action: =GetResult;

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

while not Quit do

begin

for i: =1 to 35 do

with Buttons [i] do

begin

if onClick (Action,MouseStatus) then

begin

if (Length (Caption) =1) then

if (Caption [1] in SysCount) then

begin

AddToOutPut (Caption);

Calculated: =false;

end;

SetEnterMode (Caption [1]);

if Caption [1] ='с' then Calculated: =false;

end;

Key: =0;

if KeyPressed then

begin

Key: =Ord (readkey);

case Key of

48.57,46,97.103:

if UpCase (Char (Key)) in SysCount then

begin

AddToOutPut (UpCase (Char (Key)));

Calculated: =false;

end;

8: begin

BackSpaceSymbol;

Calculated: =false;

end;

42: SetEnterMode ('*'); {*}

43: SetEnterMode ('+'); {+}

45: SetEnterMode ('-'); {-}

47: SetEnterMode ('/'); {/}

27: exit;

end;

end;

end;

QuitButton. onClick (Action,MouseStatus);

CEButton. OnClick (CEClick,MouseStatus);

if FirstEdit. OnClick (FstAction,MouseStatus) or (FActive) then FstAction;

if SecondEdit. OnClick (SndAction,MouseStatus) or (SActive) then SndAction;

end;

CloseGraph;

end.

Модуль Function

unit Functions;

{$F+} {$N+}

interface

uses Graph,GrOutPut;

procedure SetEnterMode (Func: char);

procedure GetResult;

procedure FilterExpValue (var Par: StrParam);

implementation

function IntToStr (Param: word): String;

var

Temp: string;

e: word;

begin

Str (Param,Temp);

IntToStr: =Temp;

end;

procedure FilterExpValue (var Par: StrParam);

var degree,mant,NullStr: string;

IntDegree,e,DotPos,ExpPos: integer;

DelExp,minus: boolean;

i: integer;

begin

if Par [1] ='-' then minus: =true

else minus: =false;

DotPos: =Pos ('. ',Par);

ExpPos: =Pos ('E',Par);

NullStr: ='';

Degree: ='';

DelExp: =false;

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

if ExpPos=0 then exit;

degree: =Copy (Par,ExpPos+1,Length (Par) - ExpPos);

mant: =Copy (Par,DotPos-1,ExpPos-DotPos+1);

Val (Degree, IntDegree,e);

if (IntDegree>0)

then begin

for i: =1 to IntDegree

do begin

DotPos: =Pos ('. ',mant);

Delete (mant,DotPos,1);

Insert ('. ',mant,DotPos+1);

end;

end;

if (IntDegree<0)

then begin

for i: =1 to - IntDegree

do begin

Insert ('0',mant,1);

DotPos: =Pos ('. ',mant);

Delete (mant,DotPos,1);

Insert ('. ',mant,2);

end;

end;

i: =Length (mant);

while (mant [i] ='0')

do begin

Delete (mant, i,1);

i: =i-1;

end;

if mant [Length (mant)] ='. '

then Delete (mant,Length (mant),1);

if minus then insert ('-',mant,1);

Par: =mant;

end;

procedure ExcludeMines (Par: boolean);

begin

if Par then

begin

if Pos ('-',FParam) <>0 then

Delete (FParam,1,1);

if Pos ('-',SParam) <>0 then

Delete (SParam,1,1);

end else

begin

if Pos ('-',FParam) =0 then

FParam: ='-'+FParam;

if Pos ('-',SParam) =0 then

SParam: ='-'+SParam;

end;

end;

procedure Value (FPar,SPar: StrParam; var FTemp,STemp);

var

e: word;

begin

Val (FPar,Extended (FTemp),e);

Val (SPar,Extended (STemp),e);

end;

function Operation: string;

var

FTemp,STemp,Res: extended;

St,Answer: StrParam;

RetHex,RetBin,Ex: boolean;

e: word;

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

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

begin

RetBin: =false;

RetHEX: =false;

Value (FParam,SParam,FTemp,STemp);

Ex: =false; {*used for exit after odnomest function*}

case CurrentFunc of

'+': Res: =FTemp+STemp;

'-': Res: =FTemp-STemp;

'*': Res: =FTemp*STemp;

'/': if SParam<>'0'then Res: =FTemp/STemp;

's': Res: =sin (ftemp);

'c': Res: =cos (ftemp);

't': Res: = (sin (ftemp) /cos (ftemp));

'k': Res: = (cos (ftemp) /sin (ftemp));

'v': Res: =sqrt (Ftemp);

'x': Res: =exp (ln (Ftemp) *stemp);

end;

Str (Res,St);

if Ex then exit;

FilterExpValue (st);

CheckOutPut (SParam);

CheckOutPut (FParam);

Operation: =St;

Result: =st;

CurrentFunc: =#0;

CheckOutPut (Result);

ResultToScreen;

end;

procedure SetEnterMode (Func: char);

begin

if (Func in AllOper) then

begin

if (Length (FParam) =0) or (FParam='0') then

begin

SetFActive (true);

end else

begin

if Func in ['n','p'] then

begin

CurrentFunc: =Func;

Operation;

exit;

end;

SetFActive (False);

if CurrentFunc=#0 then

begin

CurrentFunc: =Func;

CurrentFuncToScr;

end

else

if Calculated then

begin

Result: =Operation;

end;

if Calculated then

begin

FParam: =Result;

ClearOutPut;

SetFActive (true);

TextToOut (FParam);

SetFActive (false);

CalCulated: =false;

SParam: ='';

Result: ='';

end else

if (Length (SParam) >0) and (SParam<>'0') then

begin

CheckOutPut (FParam);

CheckOutPut (SParam);

Result: =Operation;

end;

end;

end;

end;

procedure GetResult;

begin

if not Calculated then

if CurrentFunc<>#0 then

Result: =Operation;

end;

end.

Модуль Groutput

unit GrOutPut;

{$N+}

interface

uses Graph;

Type

StrParam=string [64];

TProc=Procedure;

TMem=record

sys: char;

Mem: StrParam;

end;

TPosition=record

x1,y1,x2,y2: word;

end;

const

{Output controls}

OutXs=30;

OutYs=20;

OutXf=600;

OutYf=60;

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

{All ordinal operations}

AllOper= ['+','-','*','/','c','s','t','k','v','x'];

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

DEC= ['0'. '9','. '];

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

ALLnumbers= [2,3,4,9,10,11,16,17,18,23,30.35];

DECindexes= [30.35];

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

FParamOfs=13;

SParamOfs=36;

procedure CheckOutPut (var Out: StrParam);

procedure ClearOutPut;

procedure ClrResOut;

procedure SetFActive (param: boolean);

procedure TextToOut (Out: StrParam);

procedure AddToOutPut (Param: string);

procedure SetPlusMines;

procedure ResultToScreen;

procedure BackSpaceSymbol;

procedure CEClick;

procedure CurrentFuncToScr;

procedure ClearCurrentFunc;

Var

Result,FParam,SParam: StrParam;

Memory: TMem;

SysCount: set of char;

DisButtons: set of byte;

CurrentFunc: char;

MantisaPos,Operation, i,j,Middle,Key: word;

FActive,SActive,Calculated: boolean;

implementation

procedure CheckOutPut (var Out: StrParam);

var

MinesState: boolean;

begin

i: =1;

MinesState: =false;

if Pos ('-',Out) <>0 then

begin

Delete (Out,1,1);

MinesState: =true;

end;

while Pos (' ',Out) <>0 do delete (Out,Pos (' ',Out),1);

while i<=Length (Out) do

begin

if Out [i] ='. ' then

if i<>Pos ('. ',Out) then

begin

delete (Out, i,1);

i: =i-1;

end;

inc (i);

end;

if Out [2] <>'. ' then

while (Out [1] ='0') or (Out [1] ='. ') do

if Length (Out) >1 then Delete (Out,1,1) else

break;

if Out [1] ='. ' then Out: ='0'+Out;

if Out [Length (Out)] ='. ' then Out: =Out+'0';

if Length (Out) =0 then Out: ='0';

if MinesState then

if Pos ('-',Out) =0 then

Out: ='-'+Out;

end;

procedure SetFActive (param: boolean);

begin

FActive: =Param;

SActive: =not Param;

end;

procedure BackSpaceSymbol;

begin

Calculated: =false;

case FActive of

true:

if FParam<>'0' then

begin

delete (FParam,Length (FParam),1);

TextToOut (FParam);

end;

false:

if SParam<>'0' then

begin

delete (SParam,Length (SParam),1);

TextToOut (SParam);

end;

end;

end;

procedure ClrResOut;

begin

SetViewPort (OutXs+1,OutYs+FParamOfs+8,OutXf-1,OutYf-3,true);

ClearViewPort;

SetViewPort (0,0,GetMaxX,GetMaxY,true);

end;

procedure TextToOut (Out: StrParam);

begin

case FActive of

true: SetViewPort (OutXs+1,OutYs+3,OutXf-1,OutYs+FParamOfs-1,true);

false: SetViewPort (OutXs+1,OutYs+FParamOfs,OutXf-1,OutYf-3,true);

end;

ClearViewPort;

CheckOutPut (Out);

CurrentFuncToScr;

case FActive of

true: begin OutTextXY (OutXf-40-TextWidth (Out) div 2,4,Out); ClrResOut; end;

false: OutTextXY (OutXf-40-TextWidth (Out) div 2,4,Out);

end;

SetViewPort (0,0,GetMaxX,GetMaxY,true);

end;

procedure ResultToScreen;

begin

SetViewPort (OutXs+1,OutYs+23,OutXf-1,OutYf-1,true);

ClearViewPort;

line (OutXf-40-TextWidth (Result),2,OutXf-40,2);

OutTextXY (OutXf-40-TextWidth (Result) div 2,9,Result);

Calculated: =true;

SetViewPort (0,0,GetMaxX,GetMaxY,true);

end;

procedure CEClick;

begin

MantisaPos: =0;

ClearOutPut;

Calculated: =false;

case FActive of

true: begin FParam: ='0'; TextToOut ('0');

SetFActive (false); TextToOut (SParam);

SetFActive (true); end;

false: begin SParam: ='0'; TextToOut ('0');

SetFActive (true); TextToOut (FParam);

SetFActive (false); end;

end;

TextToOut ('0');

SetFActive (true);

end;

procedure AddToOutPut (Param: string);

var

Out: string;

begin

ClearCurrentFunc;

case FActive of

true: begin

if SysCount=Dec then

if Pos ('E',FParam) <>0 then FParam: ='0';

FParam: =FParam+Param;

TextToOut (FParam);

end;

false: begin

if SysCount=Dec then

if Pos ('E',SParam) <>0 then SParam: ='0';

SParam: =SParam+Param;

TextToOut (SParam);

end;

end;

CurrentFuncToScr;

end;

procedure AddDelMines (var Param: StrParam);

begin

if (Length (Param) >=1) and

(Param<>'0') and (Param<>'0.0') then

if Pos ('-',Param) =0 then

begin

Param: ='-'+Param;

CheckOutPut (Param);

TextToOut (Param);

end else

begin

delete (Param,1,1);

CheckOutPut (Param);

TextToOut (Param);

end;

end;

procedure SetPlusMines;

begin

case FActive of

true: AddDelMines (FParam);

false: AddDelMines (SParam);

end;

end;

procedure ClearCurrentFunc;

var

ViewPort: ViewPortType;

begin

GetViewSettings (ViewPort);

SetViewPort (OutXs+1,OutYs+6,OutXf-20-Middle,OutYs+14,true);

ClearViewPort;

with ViewPort do

SetViewPort (x1,y1,x2,y2,Clip);

end;

procedure CurrentFuncToScr;

var

ViewPort: ViewPortType;

begin

{if CurrentFunc=#0 then exit; }

GetViewSettings (ViewPort);

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

if TextWidth (FParam) >TextWidth (SParam) then

Middle: =TextWidth (FParam)

else Middle: =TextWidth (SParam);

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

SetViewPort (OutXs+1,OutYs+6,OutXf-30-Middle,OutYs+14,true);

ClearViewPort;

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

OutTextXY (OutXf-OutXs-40-Middle,5,CurrentFunc);

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

with ViewPort do

SetViewPort (x1,y1,x2,y2,Clip);

end;

procedure ClearOutPut;

begin

SetViewPort (OutXs+1,OutYs+1,OutXf-1,OutYf-1,true);

ClearViewPort;

SetViewPort (0,0,GetMaxX,GetMaxY,true);

end;

begin

FActive: =true;

SActive: =false;

CurrentFunc: =#0;

SysCount: =DEC;

Calculated: =false;

FParam: ='0';

SParam: ='0';

Result: ='';

enПриложение 2

Графический интерфейс программы

Рис.1. Графический интерфейс программы

Рис.2. Программа во время работы

Размещено на Allbest.ru