48216 (Програма переводу з однієї системи числення у іншу), страница 2

2016-07-30СтудИзба

Описание файла

Документ из архива "Програма переводу з однієї системи числення у іншу", который расположен в категории "". Всё это находится в предмете "информатика" из 1 семестр, которые можно найти в файловом архиве . Не смотря на прямую связь этого архива с , его также можно найти и в других разделах. Архив можно найти в разделе "курсовые/домашние работы", в предмете "информатика, программирование" в общих файлах.

Онлайн просмотр документа "48216"

Текст 2 страницы из документа "48216"

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



Свежие статьи
Популярно сейчас
Зачем заказывать выполнение своего задания, если оно уже было выполнено много много раз? Его можно просто купить или даже скачать бесплатно на СтудИзбе. Найдите нужный учебный материал у нас!
Ответы на популярные вопросы
Да! Наши авторы собирают и выкладывают те работы, которые сдаются в Вашем учебном заведении ежегодно и уже проверены преподавателями.
Да! У нас любой человек может выложить любую учебную работу и зарабатывать на её продажах! Но каждый учебный материал публикуется только после тщательной проверки администрацией.
Вернём деньги! А если быть более точными, то автору даётся немного времени на исправление, а если не исправит или выйдет время, то вернём деньги в полном объёме!
Нет! Мы не выполняем работы на заказ, однако Вы можете попросить что-то выложить в наших социальных сетях.
Добавляйте материалы
и зарабатывайте!
Продажи идут автоматически
4144
Авторов
на СтудИзбе
666
Средний доход
с одного платного файла
Обучение Подробнее