label m1,m2,m3,m4;

const poz=2;

poz1=3;

type fak=(ten_to_,_to_ten,fild1,help,exit);

fak1=(ten_to_two,ten_to_eight,ten_to_sixteen);

fak2=(two_to_ten,eight_to_ten,sixteen_to_ten);

const rab:array[fak] of string [16] =

(' ПЕРЕВЎД З 10 ',' ПЕРЕВЎД В 10 ',' ',' ДОПОМОГА ',' ВИХЎД ');

rab1:array[fak1] of string [17] =

(' В ДВЎЙКОВУ ',' В ВЎСЎМКОВУ ',' В ШЎСНАДЦЯТКОВУ ');

rab2:array[fak2] of string [18] =

(' З ДВЎЙКОВО° ',' З ВЎСЎМКОВО° ',' З ШЎСНАДЦЯТКОВО° ');

var dov:fak;

dov1:fak1;

dov2:fak2;

sim:char;

x1,x2,y1,y2:integer;

procedure ramka1;

var i:integer;

begin

TextColor(0);

gotoxy(x1,y1);write('-');

for i:=1 to x2-x1-1 do write('-');write('¬');

for i:=1 to y2-y1-1 do begin

gotoxy(x2,y1+i);write('¦');

gotoxy(x1,y1+i);write('¦');end;

gotoxy(x1,y2); write('L');

for i:=1 to x2-x1-1 do write('-');write('-');

end;

procedure Golovnemenu;

var s:fak;nom:integer;

begin

textbackground(white);textcolor(0); x1:=1;y1:=0;

for s:=ten_to_ to exit do

if s=dov then begin

textbackground(green);

gotoxy(x1,y1+1); write(rab[s]);

textcolor(2); textbackground(white);

textcolor(0); x1:=x1+16;

end

else begin

gotoxy(x1,y1+1); write(rab[s]);

x1:=x1+16;

end;

gotoxy(1,24);write(' *** Calculator Version 1.0 Copyright (c) 1997 by L.Tarasenko *** ');

end;

procedure sub_ten_to_;

var s:fak1;

n:integer;

begin

x1:=1;y1:=2;x2:=19;y2:=6;ramka1;

for s:=ten_to_two to ten_to_sixteen do

if s=dov1 then begin

n:=poz1+ord(s);

textbackground(green);

gotoxy(x1+1,n); write(rab1[s]);

textcolor(2); textbackground(white);

textcolor(0);

end

else begin

textbackground(white);textcolor(0);

n:=poz1+ord(s);

gotoxy(x1+1,n); write(rab1[s]);

end;

end;

procedure sub_to_ten;

var s:fak2;

n:integer;

begin

textbackground(white);textcolor(0);

x1:=16;y1:=2;x2:=35;y2:=6; ramka1;

for s:=two_to_ten to sixteen_to_ten do

if s=dov2 then begin

n:=poz1+ord(s);

textbackground(green); textcolor(0);

gotoxy(x1+1,n);

write(rab2[s]);

textcolor(2);

textbackground(white);

end

else begin

textbackground(white);

textcolor(0);

n:=poz1+ord(s);

gotoxy(x1+1,n);

write(rab2[s]);

end;

end;

begin

window(1,1,80,25);textbackground(0);

m2:screen;

dov:=ten_to_;

repeat{1}

golovnemenu;

repeat{2}

sim:=readkey;

if(sim=#0) and keypressed then sim:=readkey;

case sim of

#77:begin

if dov <> exit then dov:=succ(dov)

else dov:=ten_to_;

if dov=fild1 then dov:=help;

end;

#75:begin

if dov<> ten_to_ then dov:=pred(dov)

else dov:=exit;

if dov=fild1 then dov:=_to_ten;

end;

#27:begin;clrscr;halt;end;

end;

golovnemenu;

until sim=#13;

case dov of

ten_to_:begin

repeat{1}

sub_ten_to_;

repeat{2}

sim:=readkey;

if(sim=#0) and keypressed then sim:=readkey;

case sim of

#80:if dov1 <> ten_to_sixteen then dov1:=succ(dov1)

else dov1:=ten_to_two;

#72:if dov1<> ten_to_two then dov1:=pred(dov1)

else dov1:=ten_to_sixteen;

#27:begin screen;goto m1;end;

#75:begin

if dov<> ten_to_ then dov:=pred(dov)

else dov:=exit;screen;goto m1;

end;

#77:begin

if dov <> exit then dov:=succ(dov)

else dov:=ten_to_;screen;goto m1;

end;

end;

sub_ten_to_;

until sim=#13;

case dov1 of

ten_to_two:begin ten_to(2);screen;

golovnemenu;goto m4;end;

ten_to_eight:begin ten_to(8);screen;

golovnemenu;goto m4;end;

ten_to_sixteen:begin ten_to(16);screen;

golovnemenu;goto m4;end;

end;

m4:until false;

end;

_to_ten:begin

repeat{1}

sub_to_ten;

repeat{2}

sim:=readkey;

if(sim=#0) and keypressed then sim:=readkey;

case sim of

#80:if dov2 <> sixteen_to_ten then dov2:=succ(dov2)

else dov2:=two_to_ten;

#72:if dov2<> two_to_ten then dov2:=pred(dov2)

else dov2:=sixteen_to_ten;

#27:begin screen;goto m1;end;

#75:begin

if dov<> ten_to_ then dov:=pred(dov)

else dov:=exit;screen;goto m1;

end;

#77:begin

if dov <> exit then begin

dov:=succ(dov);dov:=succ(dov);end

else dov:=ten_to_;screen;goto m1;

end;

end;

sub_to_ten;

until sim=#13;

case dov2 of

two_to_ten:begin convert_to_10(2);screen;

golovnemenu;goto m3;end;

eight_to_ten:begin convert_to_10(8);screen;

golovnemenu;goto m3;end;

sixteen_to_ten:begin convert_to_10(16);screen;

golovnemenu;goto m3;end;

end;

m3:until false;

end;

help:begin;inf;screen;end;

exit:begin;clrscr;halt;end;

end;

m1:screen;

until false;

end.

unit calc;

interface

procedure inf;

procedure screen;

procedure hide_cursor;

procedure max_cursor;

procedure standart_cursor;

procedure convert_to_10(system:integer);

procedure ten_to(system:integer);

implementation

uses crt,strings,dos,time;

procedure set_cursor(begline,endline:byte);

var regs:registers;

begin

with regs do

begin

ah:=$01;

ch:=begline;

cl:=endline;

end;

intr($10,regs);

end;

procedure hide_cursor;

var begline,endline:byte;

begin

begline:=$20;

endline:=$00;

set_cursor(begline,endline);

end;

procedure max_cursor;

var begline,endline:byte;

begin

begline:=$00;

if lastmode=mono then endline:=$0c

else endline:=$07;

set_cursor(begline,endline);

end;

procedure standart_cursor;

var begline,endline:byte;

begin

if lastmode=mono then begin

begline:=$0b;

endline:=$0c;

end else

begin

begline:=$06;

endline:=$07;

end;

set_cursor(begline,endline);

end;

procedure ramka(x1,y1,x2,y2:integer);

var i:integer;

begin

textbackground(white);textcolor(0);

gotoxy(x1,y1);write('-');

for i:=1 to x2-x1-1 do write('-');write('¬');

for i:=1 to y2-y1-1 do begin

gotoxy(x2,y1+i);write('¦');

gotoxy(x1,y1+i);write('¦');

end;

gotoxy(x1,y2);write('L');

for i:=1 to x2-x1-1 do write('-');write('-');

end;

procedure screen;

var i: integer;

begin

clrscr;

textbackground(0);

TextColor(Blue);

for i:=2 to 25 do begin

write('--------------------------------------------------------------------------------');

end;

end;

procedure init;

begin

screen; ramka(1,3,80,24);

get_date(3,3); gotoxy(1,2);

textbackground(0); textcolor(green);

write(' " К У Р С О В А " ');

gotoxy(1,25);write(' *** Версўя 1.0 (с) 2002 Л.Тарасенко *** ');

end;

procedure inf;

begin

init;

gotoxy(24,8);write('г=============================¬');

gotoxy(24,9);write('¦ Програма переводу ¦ ');

gotoxy(24,10);write('¦ чисел з однўї• системи ¦ ');

gotoxy(24,11);write('¦ числення в ўншу ¦ ');

gotoxy(24,12);write('¦ Версўя 1.0 ¦ ');

gotoxy(24,13);write('¦ 17.09.2002 ¦ ');

gotoxy(24,14);write('¦ Автор : Л.Тарасенко ¦ ');

gotoxy(24,15);write('¦ ¦ ');

gotoxy(24,16);write('L=============================- ');

gotoxy(25,17);write(' ');

readkey;

end;

procedure check(system:integer;num:string);

var i,error:integer;

label e,ok,m2;

begin

for i:=1 to length(num) do begin

num[i]:=upcase(num[i]);

if length(num) >= 20 then begin

gotoxy(24,12);write(' ');

gotoxy(35,15);

write('Переповнення');goto ok;

end;

if system=2 then if (num[i]<>'1') and (num[i]<>'0') then goto e;

if system=16 then

if (num[i]<>'A') and (num[i]<>'B') and

(num[i]<>'C') and (num[i]<>'D') and

(num[i]<>'E') and (num[i]<>'F') and

(num[i]>'9') then goto e;

if system=8 then if (num[i]>'9') then goto e;

if system=10 then if (num[i]>'9') then goto e;

end;goto ok;

e:begin gotoxy(24,13);write(' ');

gotoxy(35,16);

textcolor(red);

write('Недопустиме число ');

end;

ok:end;

procedure convert_to_10(system:integer);

var num_out,num:string;

val_num,i,count:longint;

sum:real;

code,y:integer;

ch:char;

label m1;

begin

repeat

init;y:=6;

max_cursor;

textcolor(white);textbackground(0);

for i:=1 to 14 do begin

gotoxy(22,y);inc(y);write(' ');

end;

ramka(21,5,55,18);

textcolor(0);textbackground(green);

gotoxy(24,7);write('Введўть число в ',system,'-ўй системў:');

gotoxy(24,11);write(' Число в 10-ўй системў рўвне:');

gotoxy(24,16);write(' Помилка:');

textcolor(white);textbackground(white);

gotoxy(24,9);write(' ');

gotoxy(24,13);write(' ');

gotoxy(34,16);write(' ');

gotoxy(25,9);textcolor(0);textbackground(white);

readln(num);

num_out:='';

sum:=0;

count:=length(num);

for i:=0 to length(num) do begin

num[i]:=upcase(num[i]);

if num[i]='A' then sum:=sum+10*exp(count*ln(system));

if num[i]='B' then sum:=sum+11*exp(count*ln(system));

if num[i]='C' then sum:=sum+12*exp(count*ln(system));

if num[i]='D' then sum:=sum+13*exp(count*ln(system));

if num[i]='E' then sum:=sum+14*exp(count*ln(system));

if num[i]='F' then sum:=sum+15*exp(count*ln(system));

val(num[i],val_num,code);

if val_num<10 then sum:=sum+val_num*exp(count*ln(system));

count:=count-1;

end;

textcolor(0);textbackground(white);

gotoxy(25,13);write(sum:0:0);

check(system,num);

textbackground(0);

hide_cursor;

textcolor(green);

gotoxy(32,18);write(' ESC - ВИХЎД ');

ch:=readkey;

until ch=#27;

end;

procedure ten_to(system:integer);

const n=30;sys=10;

var a,f,x,y:longint;

b,d:real;

c:array[1..n] of byte;

code,i:integer;

num:real;

number:string;

ch:char;

begin

repeat

init;y:=6;

max_cursor;

for i:=0 to n do c[i]:=0;

for i:=1 to 14 do begin

gotoxy(22,y);inc(y);write(' ');

end;

ramka(21,5,55,18);

textbackground(green);textcolor(0);

gotoxy(24,7);write('Введўть число в 10-ўй системў:');

gotoxy(24,11);write(' Число в ',system,'-ўй системў рўвне: ');

gotoxy(24,16);write(' Помилка:');

textcolor(white);textbackground(white);

gotoxy(24,9);write(' ');

gotoxy(24,13);write(' ');

gotoxy(34,16);write(' ');

gotoxy(25,9);textcolor(0);textbackground(white);

readln(number);

i:=0;

val(number,num,code);

a:=trunc(num);

repeat

inc(i);

f:=trunc(a/system);

c[i]:=a-f*system;

a:=f;

until a

inc(i);c[i]:=f;

gotoxy(25,13);

textcolor(0);textbackground(white);

repeat

if c[i]=10 then write('A');

if c[i]=11 then write('B');

if c[i]=12 then write('C');

if c[i]=13 then write('D');

if c[i]=14 then write('E');

if c[i]=15 then write('F');

if c[i]<10 then write(c[i]);

dec(i);

until i<1;

check(sys,number);

textbackground(0);

hide_cursor;

textcolor(green);

gotoxy(32,18);write(' ESC - ВИХЎД ');

ch:=readkey;

until ch=#27;

end;

begin

end.

Додаток В. Тест програми

Тест проводився на робочій станції з наступною конфігурацією:

• Pentium 166

• 32 Mb RAM

• SyncMaster 17Glsi

• S3 Trio64V+

• Windows 95

У результаті тестів були отримані наступні результати:

М алюнок 1

М алюнок 2

М алюнок 3

7