Помогите!!!плизз

[Хван]

Помогите,плизз,очень нужно,очень.

1.Строка является записью числа в шестнадцатеричной системе счисления.
Реализовать операцию вычитания чисел в шестнадцатеричной системе счисления.
Перевод чисел в десятичную систему счисления не делать.

Нужна связь и сама прога

[AVer]

А в другие можно? В двоичную например...

[Хван]

можно,наверное,в это вообще не шарю

AVer,сможешь её сделать???

Если сможешь,то напиши,что сможешь,а то я на взводе уже какой день,никто не может сделать,вообще беда!!!

[AVer]

Вот код:

program OctMinus;

{$APPTYPE CONSOLE}

Var X,Y:String;
Function BinToOct(A:String):String;
Var Buf,R:String;
    I:Integer;
Begin
While Length(A) mod 3 <> 0 Do
A:='0'+A;
While A <> '' Do
Begin
Buf:=Copy(A,1,3);
Val(Buf,I,I);
Delete(A,1,3);
Case I Of
  0: R:=R+'0';
  1: R:=R+'1';
  10: R:=R+'2';
  11: R:=R+'3';
  100: R:=R+'4';
  101: R:=R+'5';
  110: R:=R+'6';
  111: R:=R+'7';
  End;
End;
While R[1] = '0' Do
Delete(R,1,1);
BinToOct:=R;
End;

Function OctToBin(A:String):String;
Var N,I:Integer;
    R:String;
Begin
For I:=1 To Length(A) Do
Begin
Val(A[I],N,N);
Case N of
  0: R:=R+'000';
  1: R:=R+'001';
  2: R:=R+'010';
  3: R:=R+'011';
  4: R:=R+'100';
  5: R:=R+'101';
  6: R:=R+'110';
  7: R:=R+'111';
  End;
End;
OctToBin:=R;
End;

Function Minus(A,B:String):String;
Label T,M,Z;
Var I,C,N,D,E:Integer;
    R:String;
Begin
R:='';
C:=0;
While Length(A) <> Length(B) Do
If Length(A) > Length(B) Then
B:='0'+B Else
A:='0'+A;
T:
For I:=D To Length(A) Do
Begin
If ((A[I] = '1') And (B[I] = '1')) Or ((A[I] = '0') And (B[I] = '0')) Then
R:=R+'0' Else
If (A[I] = '1') And (B[I] = '0') Then
R:=R+'1' Else
If (A[I] = '0') And (B[I] = '1') Then
 Begin
 R:=R+'1';
 M:
 E:=I-C-1;
 For N:=E DownTo 1 Do
 If R[N] = '0' Then
 Begin
 R[N]:='1';
 E:=N-1;
 GoTo M;
 End Else
 Begin
 R[N]:='0';
 If I = Length(A) Then GoTo Z Else
 Begin
 D:=I+1;
 GoTo T;
 End;
 End;
 End;
End;
Z:
While R[1] = '0' Do
Delete(R,1,1);
Minus:=R;
End;

Begin
WriteLn('Введите восьмиричные числа через пробел');
ReadLn(X);
Y:=Copy(X,Pos(' ',X)+1,Length(X)-Pos(' ',X));
Delete(X,Pos(' ',X),Length(X)-Pos(' ',X)+1);
WriteLn('Ответ: '+BinToOct(Minus(OctToBin(X),OctToBin(Y))));
ReadLn;
End.

Он 100% рабочий на Делфи. На паскале же он после слова "Ответ:" выдает последовательность различных символов, а потом все же верный ответ.

[Virtson]

1) (один оператор) вычитаение можно реализовать и без перевода
не проще ли будет ?

2) у Хван шестнадцатеричные, у AVer восьмеричные ?

[Хван]

Virtson,и что делать,как проще-то?

Ах да,чуть не забыл,спосибо огромное тебе,AVer!!!

Блин,AVer,ты можешь написать пояснения в проге,где ,что делается???Плизз,просто хочу понять её

[Alar]

Хван, прошу не заниматься флудом, есть кнопка редактирование. устное предупреждение.

[Virtson]

щас посмотрим ..

могу пока подсказать процедуру, чтобы русские буквы в консоли Delphi
отображались правильно, а не кроказябры ..

function Rus(Text : String): String;
var
  buf: array [0..255] of Char;
begin
  CharToOem(PChar(Text), buf);
  Rus:= buf;
end;

[Хван]

а можешь все сделать,полностью программу?

[Virtson]

uses Math;

Type
    TInteger1DArray = array of LongInt;

(*
Эти подпрограммы должен определить программист:
function CompNumbers(n : Integer;
     m : Integer;
     const a : TInteger1DArray;
     const b : TInteger1DArray):Integer;
*)

procedure SubNumbers(p : Integer;
     n : Integer;
     m : Integer;
     const a : TInteger1DArray;
     const b : TInteger1DArray;
     var s : Integer;
     var l : Integer;
     var c : TInteger1DArray);forward;

(*******************************************************
Разность двух целых положительных чисел в системе
с основанием p.
    
Процедура вычисляет разность чисел A и B в системе
счисления с основанием p. В массивах a и b содержатся
цифры представления соответственно A и B при этом
A=a[n]*p^n+a[n-1]*p^n-1+...+a[0];
B=b[m]*p^m+b[m-1]*p^m-1+...+b[0];
Результат работы C=A-B помещается в массив c,
количество разрядов в l, s - знак разности.
При работе используется функция сравнения Compare.
******************************************************)

var
    I : Integer;
    T : Integer;
begin
    if n>m then
    begin
        SetLength(c, n+1);
    end
    else
    begin
        SetLength(c, m+1);
    end;
    s := CompNumbers(n, m, a, b);
    i := 0;
    t := 0;
    if s<>0 then
    begin
        if s>0 then
        begin
            l := n;
            while i<=m do
            begin
                if a[i]>=b[i]+t then
                begin
                    c[i] := a[i]-b[i]-t;
                    t := 0;
                end
                else
                begin
                    c[i] := p+a[i]-b[i]-t;
                    t := 1;
                end;
                i := i+1;
            end;
            while i<=n do
            begin
                if a[i]>=t then
                begin
                    c[i] := a[i]-t;
                    t := 0;
                end
                else
                begin
                    c[i] := p-t;
                    t := 1;
                end;
                i := i+1;
            end;
        end
        else
        begin
            l := m;
            while i<=n do
            begin
                if b[i]>=a[i]+t then
                begin
                    c[i] := b[i]-a[i]-t;
                    t := 0;
                end
                else
                begin
                    c[i] := p+b[i]-a[i]-t;
                    t := 1;
                end;
                i := i+1;
            end;
            while i<=m do
            begin
                if b[i]>=t then
                begin
                    c[i] := b[i]-t;
                    t := 0;
                end
                else
                begin
                    c[i] := p-t;
                    t := 1;
                end;
                i := i+1;
            end;
        end;
        while l>=0 do
        begin
            if c[l]<>0 then
            begin
                Break;
            end;
            l := l-1;
        end;
    end
    else
    begin
        c[0] := 0;
        l := 0;
    end;
end;