Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 13.01.2007, 00:26   #1
Хван
 
Регистрация: 13.01.2007
Сообщений: 5
Восклицание Помогите!!!плизз

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

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

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

Последний раз редактировалось Хван; 13.01.2007 в 00:28.
Хван вне форума Ответить с цитированием
Старый 13.01.2007, 00:45   #2
AVer
Андрей
Форумчанин
 
Аватар для AVer
 
Регистрация: 21.11.2006
Сообщений: 457
По умолчанию

А в другие можно? В двоичную например...
ICQ: 5311314
[SIGPIC][/SIGPIC]
AVer вне форума Ответить с цитированием
Старый 13.01.2007, 00:54   #3
Хван
 
Регистрация: 13.01.2007
Сообщений: 5
По умолчанию

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

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

Если сможешь,то напиши,что сможешь,а то я на взводе уже какой день,никто не может сделать,вообще беда!!!
Хван вне форума Ответить с цитированием
Старый 13.01.2007, 01:04   #4
AVer
Андрей
Форумчанин
 
Аватар для AVer
 
Регистрация: 21.11.2006
Сообщений: 457
По умолчанию

Вот код:
Код:
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% рабочий на Делфи. На паскале же он после слова "Ответ:" выдает последовательность различных символов, а потом все же верный ответ.
ICQ: 5311314
[SIGPIC][/SIGPIC]

Последний раз редактировалось AVer; 13.01.2007 в 04:30.
AVer вне форума Ответить с цитированием
Старый 13.01.2007, 08:04   #5
Virtson
Владимир М.
Участник клуба
 
Аватар для Virtson
 
Регистрация: 30.10.2006
Сообщений: 1,289
По умолчанию

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

2) у Хван шестнадцатеричные, у AVer восьмеричные ?
Берегите друг друга!
Virtson вне форума Ответить с цитированием
Старый 13.01.2007, 13:31   #6
Хван
 
Регистрация: 13.01.2007
Сообщений: 5
По умолчанию

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

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

Блин,AVer,ты можешь написать пояснения в проге,где ,что делается???Плизз,просто хочу понять её
Хван вне форума Ответить с цитированием
Старый 13.01.2007, 14:37   #7
Alar
Александр
Администратор
 
Аватар для Alar
 
Регистрация: 28.10.2006
Сообщений: 17,758
По умолчанию

Хван, прошу не заниматься флудом, есть кнопка редактирование. устное предупреждение.
Alar вне форума Ответить с цитированием
Старый 13.01.2007, 14:59   #8
Virtson
Владимир М.
Участник клуба
 
Аватар для Virtson
 
Регистрация: 30.10.2006
Сообщений: 1,289
Сообщение

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

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

Код:
function Rus(Text : String): String;
var
  buf: array [0..255] of Char;
begin
  CharToOem(PChar(Text), buf);
  Rus:= buf;
end;
Берегите друг друга!

Последний раз редактировалось Virtson; 13.01.2007 в 15:04.
Virtson вне форума Ответить с цитированием
Старый 13.01.2007, 15:31   #9
Хван
 
Регистрация: 13.01.2007
Сообщений: 5
По умолчанию

а можешь все сделать,полностью программу?
Хван вне форума Ответить с цитированием
Старый 13.01.2007, 16:19   #10
Virtson
Владимир М.
Участник клуба
 
Аватар для Virtson
 
Регистрация: 30.10.2006
Сообщений: 1,289
Сообщение то, что имеем на данный момент :

Код:
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;
Берегите друг друга!

Последний раз редактировалось Virtson; 13.01.2007 в 16:24.
Virtson вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
ПЛИЗЗ!!!помогите срочно сделать тест в Delphi!!! Evgen89 Фриланс 8 25.11.2015 11:04
Помогите решить задачу на Паскале плизз срочно нужно!!!! NTFS Паскаль, Turbo Pascal, PascalABC.NET 2 15.03.2008 21:28
Помогите Сделать лабу плизз! я первак! bucho Помощь студентам 5 30.09.2007 13:52
плизз! finch Помощь студентам 1 15.06.2007 22:33
Помогите плизз решить простые задачки на С++ sam21 Общие вопросы C/C++ 4 01.02.2007 11:37