1764.
Влад
(24.05.2009 14:13)
0  
Написал программу перевода, только она работает только с целыми числами - помогите исправить на вещественные хотя бы
Program kursach;
var
n:integer;
allst, gotst,st1,st2:string;
cl:boolean;
result, data:text;
{Функция положительной степени числа}
function stepen(x,n:integer):longint;
var
k:longint;
i:integer;
begin
k:=1;
for i:=1 to n do k:=k*x;
stepen:=k;
end;
{Функчия перевода Rсс числа в 10сс}
function _Rto10(s:string;R:word):longint;
var
m,n,i,zn:integer;
z:longint;
begin
m:;
if s[1]=''-'' then
begin
delete(s,1,1);
zn:=-1;
end
else
zn:=1;
for i:=1 to length(s) do
begin
val(s[i],n,z);
if z<>0 then n:=10+ord(UpCase(s[i]))-ord(''A'');
m:=m+stepen(R,length(s)-i)*n;
end;
_Rto10:=m*zn;
end;{####### Функция _Rto10 закончилась #####}
{####### Функция замены символа ##########}
function Convd(x:integer):char;
begin
if (x<10) then Convd:=chr(x+ord(''0''))
else
if (x<16)
then
Convd:=Chr(x-10+ord(''A''))
else
Convd:=''0'';
end;
{####### Функция перевода 10 в R начало #}
function _10toR(N,R:integer):string;
var s:string;
begin
s:='''';
repeat
s:=convd(N mod R)+S;
N:=N div R
until N;
_10toR:=s;
end;
{######## Функция перевода 10в R закончилась ##}
Function _16to2(st:string):string;
var
i,j,k:integer;
zn:char;
temp,tmp:string;
begin
tmp:='''';
temp:='''';
if st[1]=''-''
then
begin
zn:=''-'';
delete(st,1,1);
end
else
zn:=''+'';
for i:=1 to length(st) do
begin
temp:='''';
temp:=_10toR(_Rto10(st[i],16),2);
if length(temp)<4
then
for j:=1 to 4-length(temp) do
temp:=''0''+temp;
tmp:=tmp+temp;
end;
_16to2:=zn+tmp;
end;
{Функция перевода 16 ту 2 закончилась}
{Начинаем функция 2 ту 16}
Function _2to16(st1:string):string;
var
i,j,num:integer;
_4cifri,tmp,temp,st:string;
zn:char;
begin
st:=st1;
tmp:='''';
zn:='' '';
temp:='''';
_4cifri:='''';
if st[1]=''+''
then delete (st,1,1);
if st[1]=''-''
then
begin
delete(st,1,1);
zn:=''-'';
end;
if (length(st)mod(4))<>0
then
num:length(st) div 4)+1
else
num:=length(st) div 4;
for i:=num downto 1 do
begin
_4cifri:='''';
if length(st)>4
then
begin
_4cifri:=copy(st,length(st)-3,4);
delete(st,length(st)-3,4);
end
else
begin
_4cifri:=copy(st,1,length(st));
delete(st,1,length(st));
end;
tmp:=_10toR(_Rto10(_4cifri,2),16)+tmp;
end;
{Убираем лишние нули в начале}
for i:=1 to length(tmp) do
if (tmp[1]=''0'')and(tmp[2]<>''.'') then delete(tmp,1,1);
{Дописываем минус, если он есть}
if zn=''-''
then
_2to16:=zn+tmp
else
_2to16:=tmp;
end;
{Функция 2 ту 16}
Function CharToInt(a:char):integer;
begin
if a=''1'' then CharToInt:=1;
if a=''0'' then CharToInt:;
end;
{Процедура сложения 2х чисел}
Procedure adding(a,b:string; var rez:string);
var
i,j,k:integer;
temp:array [1..100] of char;
begin
a:=_16to2(a);
b:=_16to2(;
delete(a,1,1);
delete(b,1,1);
rez:='''';
for i:=1 to 100 do
temp[i]:='' '';
{ WriteLn(''a='',a);
WriteLn(''b='',;}
if length(a)>length(
then
for i:=1 to length(a)-length( do
b:=''0''+b
else
if length(a)<length(
then
for i:=1 to length(-length(a) do
a:=''0''+a;
k:;
for i:=length(a) downto 1 do
if (CharToInt(a[i])+CharToInt(b[i])+k)>1
then
begin
temp[i]:=Convd(CharToInt(a[i])+CharToInt(b[i])-2+k);
k:=1;
end
else
begin
temp[i]:=Convd(CharToInt(a[i])+CharToInt(b[i])+k);
k:;
end;
for i:=1 to length(a) do
begin
if (i=1)and(k=1)
then
rez:=''1''+rez;
rez:=rez+temp[i];
end;
end;
Procedure minusing(a,b:string; var c:string);
var
i,j,k:integer;
temp:array [1..100] of char;
begin
a:=_16to2(a);
b:=_16to2(;
delete(a,1,1);
delete(b,1,1);
for i:=1 to 100 do
temp[i]:='' '';
i:;
j:;
k:;
c:='''';
if length(a)>length(
then
for i:=1 to length(a)-length( do
b:=''0''+b
else
if length(a)<length(
then
for i:=1 to length(-length(a) do
a:=''0''+a;
k:;
{ WriteLn(''a='',a);
WriteLn(''b='',;}
for i:=length(a) downto 1 do
if (_Rto10(a[i],2)-_Rto10(b[i],2)-k)<0
then
begin
temp[i]:=Convd(_Rto10(a[i],2)-_Rto10(b[i],2)+2-k);
k:=1;
end
else
begin
temp[i]:=Convd(_Rto10(a[i],2)-_Rto10(b[i],2)-k);
k:;
end;
for i:=1 to length(a) do
begin
if (i=1)and(temp[1]=''0'')
then
j:=111
else
c:=c+temp[i];
end;
end;
Procedure StProc(allst:string; var gotst:string);
var
i, zn1, zn2:integer;
mainzn:char;
st1, st2, st1_1,st2_2, rez, dec:string;
begin{Начала сомой процедуры обработки строк}
{разбиваем выражение на аргументы}
st1:='''';
st2:='''';
rez:='''';
dec:='''';
for i:=1 to length(allst) do
if ((allst[i]=''-'')or(allst[i]=''+''))and(i<>1)and(allst[i-1]<>''('')
then
begin
st2:=copy(allst,i+1,length(allst)-i);{Создаем переменную со 2 аргументом}
st1:=copy(allst,1,i-1);{Создаем переменную с 1 аргументом}
mainzn:=allst[i];
end;
if mainzn=''''
then
begin
st1:=''0'';
st2:=''0'';
WriteLn(''Введите корректное выражение'');
end;
{Смотрим, небыло ли скобок у второго аргумента, и удаляем их}
for i:=1 to length(st2) do
if (st2[i]=''('')or(st
2[i]='')'')
then
delete(st2,i,1);
st1_1:=st1;
st2_2:=st2;
if st1_1[1]=''-'' then delete(st1_1,1,1);
if st2_2[1]=''-'' then delete(st2_2,1,1);
if (st1[1]<>''-'')and(st2[1]<>''-'')and(mainzn=''+'')or((st1[1]<>''-'')and(st2[1]=''-'')and(mainzn=''-''))
then
begin
Adding(st1 ,st2,gotst);
WriteLn(''(Складываем)'');
end
{1} else
if (st1[1]=''-'')and(st2[1]<>''-'')and(mainzn=''-'')or((st1[1]=''-'')and(st2[1]=''-'')and(mainzn=''+''))
then
begin
Adding(st1 ,st2,gotst);
gotst:=''-''+gotst;
WriteLn(''(Складываем, но приписываем минус)'');
end
{2} else
if (st1[1]=''-'')and(st2[1]=''-'')and(mainzn=''-'')or((st1[1]=''-'')and(st2[1]<>''-'')and(mainzn=''+''))
then
if (_Rto10(st1_1,16)<_Rto10(st2_2,16))
then
begin
minusing(st2,st1,gotst);
WriteLn(''(Вычитаем из 2 1)'');
end
else
begin
minusing(st1,st2,gotst);
gotst:=''-''+gotst;
WriteLn(''(вычитаем из 2 1, и приписываем минус)'');
end
{3} else
if (st1[1]<>''-'')and(st2[1]<>''-'')and(mainzn=''-'')or((st1[1]<>''-'')and(st2[1]=''-'')and(mainzn=''+''))
then
if (_Rto10(st1_1,16)>_Rto10(st2_2,16))
then
begin
minusing(st1,st2,gotst);
WriteLn(''(Вычитаем из 1 2)'');
end
else
begin
minusing(st2,st1,gotst);
gotst:=''-''+gotst;
WriteLn(''(вычитаем из 1 2, и приписываем минус)'');
end;
{ if (st1[1]<>''-'')and(st2[1]<>''-'')and(mainzn=''+'')or((st2[1]=''-'')and(mainzn=''-'')and(st1[1]<>''-''))
then
begin
Adding(st1 ,st2,gotst);
WriteLn(''(Складываем)'');
end
else
begin
if ((not(st1[1]=st2[1]))and(mainzn=''+'')or(st1[1]<>''-'')and(st2[1]<>''-'')and(mainzn=''-''))
then
if (_Rto10(st1_1,16)>_Rto10(st2_2,16))
then
minusing(st1,st2,gotst)
else
begin
minusing(st2,st1,gotst);
if mainzn=''-'' then
gotst:=''-''+gotst
end;
if ((st1[1]=st2[1])and(st1[1]=''-'')and(mainzn=''+''))
then
begin
Adding(st1,st2,gotst);
gotst:=''-''+gotst;
end;
end; }
WriteLn(allst,''='',_2to16(gotst));
WriteLn;
WriteLn(''А в десятичной системе счисления:'');
WriteLn(_Rto10(st1,16),mainzn,_Rto10(st2,16),''='',_Rto10(gotst,2));
end;
{######## Процедура записи данных в файл #######}
Procedure resultPr (allst, gotst:string);
begin
gotst:=allst+''=''+gotst;
Assign(result,''otveti.txt'');
ReWrite(result);
Write(result,_2to
16(gotst));
Close(result);
WriteLn(''Данные успешно записаны в файл otveti.txt'');
end;
{####### Процедура считывания переменной из файла}
Procedure dataPr (var allst:string);
begin
Assign(data,''data.txt'');
Reset(data);
readLn(data,allst);
Close(data);
end;
begin {Начало программы}
cl:=false;
While not(cl) do
begin
WriteLn(''╔════╦═══════════════════════════════════════════════╗'');
WriteLn(''║ ║ ║'');
WriteLn(''║ ║ Выберите действие. ║'');
WriteLn(''║ 1 ║ Ввести выражение с клавиатуры ║'');
WriteLn(''║ 2 ║ Прочитать выражение из файла data.txt ║'');
WriteLn(''║ 3 ║ Записать выражение в файл otveti.txt ║'');
WriteLn(''║ 4 ║ Выйти из программы ║'');
WriteLn(''║ ║ ║'');
WriteLn(''╚════╩═══════════════════════════════════════════════╝'');
WriteLn;
readLn(n);
case n of
1 :
begin
WriteLn(''Введите выдажение вида <Число1><+,-><Число2>'');
WriteLn(''Например: -F+5F'');
readLn(allst);
StProc(allst, gotst);
readLn;
end;
2:
begin
dataPr(allst);
StProc(allst, gotst);
end;
3: resultPr(allst, gotst);
4: cl:=true;
end;
WriteLn;WriteLn;WriteLn;WriteLn;WriteLn;WriteLn;WriteLn;
end;
end.
|
