Конвертирование oct - hex

mobac · #1 05.04.2014, 22:17

Здравствуйте! Пожалуйста, помогите мне написать конвертер OCT-подобной системы счисления в шестнадцатеричную. Надо чтоб "A,B,C,D,E,F,G,O" конвертировались в шестнадцатеричную систему счисления. Нужно для моего проекта. Спасибо заранее.

poli-smen · #2 05.04.2014, 22:43

Цитата:

Сообщение от mobac

Пожалуйста, помогите мне написать конвертер OCT-подобной системы счисления в шестнадцатеричную. Надо чтоб "A,B,C,D,E,F,G,O" конвертировались в шестнадцатеричную систему счисления.

Когда-то писал функции для преобразования из любой системы счисления в число и из числа в любую систему счисления. С тех пор много раз их использовал - так что ошибок в них быть не должно.
Вот та которая преобразует из любой системы счисления в число:

Код:

function TryBaseXToUInt(const Value, BaseStr: String; out UInt: LongWord): Boolean;
var
  Base, i, p, k, OldUInt: LongWord;
begin
  Result := False;
  UInt := 0;
  Base := Length(BaseStr);
  if (Value <> '') and (Base > 1) then
  begin
    k := 1;
    for i := 1 to Length(Value) do
      if Value[i] = BaseStr[1] then Inc(k) else Break;
 
    for i := k to Length(Value) do
    begin
      p := pos(Value[i], BaseStr);
      if p = 0 then
      begin
        UInt := 0;
        Exit;
      end;
      OldUInt := UInt;
      UInt := UInt * Base + (p - 1);
      if UInt < OldUInt then // Переполнение
      begin
        UInt := 0;
        Exit;
      end;
    end;
    Result := True;
  end;
end;

Ну а преобразовать число в шестнадцатеричную систему счисления можно и с помощью стандартной IntToHex.
Пример использования:

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  k: LongWord;
begin
  if TryBaseXToUInt(Edit1.Text, 'ABCDEFGO', k) then
  begin
    ShowMessageFmt('%s => $%s', [Edit1.Text, IntToHex(k, 8)]);
  end else
  begin
    ShowMessage('Ошибка');
  end;
end;

Bargest · #3 05.04.2014, 22:46

В дополнение к ответу poli-smen,
Вообще-то по алфавиту ABCDEFGH. Это опечатка или так и задумано? Если опечатка - то хитрый поиск можно поменять на

Код:

1	`Value[i] -` `'A';`

mobac · #4 05.04.2014, 23:27

Так задумано, это не опечатка

mobac · #5 06.04.2014, 00:12

Цитата:

Сообщение от poli-smen

Когда-то писал функции для преобразования из любой системы счисления в число и из числа в любую систему счисления. С тех пор много раз их использовал - так что ошибок в них быть не должно.
Вот та которая преобразует из любой системы счисления в число:

Код:

function TryBaseXToUInt(const Value, BaseStr: String; out UInt: LongWord): Boolean;
var
  Base, i, p, k, OldUInt: LongWord;
begin
  Result := False;
  UInt := 0;
  Base := Length(BaseStr);
  if (Value <> '') and (Base > 1) then
  begin
    k := 1;
    for i := 1 to Length(Value) do
      if Value[i] = BaseStr[1] then Inc(k) else Break;
 
    for i := k to Length(Value) do
    begin
      p := pos(Value[i], BaseStr);
      if p = 0 then
      begin
        UInt := 0;
        Exit;
      end;
      OldUInt := UInt;
      UInt := UInt * Base + (p - 1);
      if UInt < OldUInt then // Переполнение
      begin
        UInt := 0;
        Exit;
      end;
    end;
    Result := True;
  end;
end;

Ну а преобразовать число в шестнадцатеричную систему счисления можно и с помощью стандартной IntToHex.
Пример использования:

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  k: LongWord;
begin
  if TryBaseXToUInt(Edit1.Text, 'ABCDEFGO', k) then
  begin
    ShowMessageFmt('%s => $%s', [Edit1.Text, IntToHex(k, 8)]);
  end else
  begin
    ShowMessage('Ошибка');
  end;
end;

А как мне сделать, чтоб в edit1.text заменялись например AAA AAA AAA CAA склеенные в AAAAAAAAAEAA чтоб преобразовались они в 00000080 в edit2.text? Не получается..

Bargest · #6 06.04.2014, 00:33

Цитата:

AAA AAA AAA CAA склеенные в AAAAAAAAAEAA

А по какому правилу C поменялось на E?
Если просто убрать пробелы - то StringReplace.

poli-smen · #7 06.04.2014, 00:36

Цитата:

Сообщение от mobac

А как мне сделать, чтоб в edit1.text заменялись например AAA AAA AAA CAA склеенные в AAAAAAAAAEAA чтоб преобразовались они в 00000080 в edit2.text? Не получается..

Что не получается? Пробелы убрать что ли?

Код:

procedure TForm1.Edit1Change(Sender: TObject);
var
  s: String;
  k: LongWord;
begin
  s := StringReplace(Edit1.Text, ' ', '', [rfReplaceAll]);
  if TryBaseXToUInt(s, 'ABCDEFGO', k)
    then Edit2.Text := IntToHex(k, 8)
    else Edit2.Text := 'Ошибка';
end;

p.s. А почему "AAA AAA AAA CAA" после склейки преобразуется в "AAAAAAAAAEAA"?

mobac · #8 06.04.2014, 08:53

Нет, вы не так поняли, мне надо, чтоб можно было преобразовать в шестнадцатеричный код не одно число, а несколько в одной строке (через пробелы). Например: ABA BBA CAB BAA превращались в edit2.text=08 48 81 40. Спасибо за понимание. Вот это у меня не получается

Страдалецъ · #9 06.04.2014, 09:44

Ну это не сложно, можно конечно ручками распарсисть строку по пробелам, но есть проще вариант - использовать класс TStringList

Код:

Var
  SL: TStringList;
  i: Integer;
  Result: LongWord;
begin
SL := TStringList.Create;
SL.Delimiter := #32;
SL.DelimitedText := 'AAA AAA AAA CAA';
for i := 0 to SL.Count - 1
do begin
    TryBaseXToUInt(SL.Strings[i],8,Result);
    ShowMessage(IntToStr(Result));
    end;
end;

mobac · #10 06.04.2014, 11:08

Цитата:

Сообщение от Страдалецъ

Ну это не сложно, можно конечно ручками распарсисть строку по пробелам, но есть проще вариант - использовать класс TStringList

Код:

Var
  SL: TStringList;
  i: Integer;
  Result: LongWord;
begin
SL := TStringList.Create;
SL.Delimiter := #32;
SL.DelimitedText := 'AAA AAA AAA CAA';
for i := 0 to SL.Count - 1
do begin
    TryBaseXToUInt(SL.Strings[i],8,Result);
    ShowMessage(IntToStr(Result));
    end;
end;

:C Incompatible types 'String' and 'Integer'

poli-smen · #11 06.04.2014, 11:20

Цитата:

Сообщение от mobac

:C Incompatible types 'String' and 'Integer'

Код:

1	`TryBaseXToUInt(SL.Strings[i],` `'ABCDEFGO', Result);`

mobac · #12 06.04.2014, 11:27

Цитата:

Сообщение от poli-smen

Код:

1	`TryBaseXToUInt(SL.Strings[i],` `'ABCDEFGO', Result);`

Спасибо! И последний вопрос, как сделать, что не сообщение показывалось, а чтоб в edit2.text было (если AAA AAA AAA EAA) то в edit2.text текст был бы 00 00 00 100 (hex)?

poli-smen · #13 06.04.2014, 11:34

Цитата:

Сообщение от mobac

Спасибо! И последний вопрос, как сделать, что не сообщение показывалось, а чтоб в edit2.text было (если AAA AAA AAA EAA) то в edit2.text текст был бы 00 00 00 100 (hex)?

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  SL: TStringList;
  i: Integer;
  Result: LongWord;
begin
  SL := TStringList.Create;
  try
    SL.Delimiter := #32;
    SL.DelimitedText := Edit2.Text;
    for i := 0 to SL.Count - 1 do
    begin
      TryBaseXToUInt(SL.Strings[i], 'ABCDEFGO', Result);
      SL.Strings[i] := IntToHex(Result, 2);
    end;
    Edit2.Text := SL.DelimitedText;
  finally
    SL.Free;
  end;
end;

mobac · #14 06.04.2014, 12:48

А как сделать так, чтоб если у нас есть, допустим AAAAAAAAAEAA (склеенные , без пробелов), и чтоб они преобразовались в 00 00 00 100 (здесь я сам пробелы уберу)?

poli-smen · #15 06.04.2014, 13:38

Цитата:

Сообщение от mobac

А как сделать так, чтоб если у нас есть, допустим AAAAAAAAAEAA (склеенные , без пробелов), и чтоб они преобразовались в 00 00 00 100 (здесь я сам пробелы уберу)?

Код:

procedure TForm1.Button2Click(Sender: TObject);
var
  s1, s2: String;
  p: Integer;
  k: LongWord;
begin
  s1 := Edit2.Text;
  p := 1;
  while p <= Length(s1) do
  begin
    if TryBaseXToUInt(Copy(s1, p, 3), 'ABCDEFGO', k) then
    begin
      s2 := s2 + ' ' + IntToHex(k, 2);
    end;
    Inc(p, 3);
  end;
  Edit2.Text := Trim(s2);
end;

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты

Этот пользователь сказал Спасибо poli-smen за это полезное сообщение:
mobac (05.04.2014)

Этот пользователь сказал Спасибо Страдалецъ за это полезное сообщение:
mobac (06.04.2014)