[mobac]

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

[poli-smen]

Сообщение от 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]

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

Код:

Value[i] - 'A';

[mobac]

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

[mobac]

Сообщение от 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]

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

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

[poli-smen]

Сообщение от 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]

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

[Страдалецъ]

Ну это не сложно, можно конечно ручками распарсисть строку по пробелам, но есть проще вариант - использовать класс 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]

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

Ну это не сложно, можно конечно ручками распарсисть строку по пробелам, но есть проще вариант - использовать класс 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]

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

:C Incompatible types 'String' and 'Integer'

Код:

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

[mobac]

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

Код:

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

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

[poli-smen]

Сообщение от 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]

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

[poli-smen]

Сообщение от 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;