DBR Delphi-Ecke

// Die meist verwendeten Zahlensysteme (neben dem Dezimalsystem) im
// Computerbereich basieren auf den Zahlen 2 (Dualsystem), 8 (Oktalsystem)
// und 16 (Hexadezimalsystem). Trotzdem benötigt man manchmal ein anderes
// Zahlensystem. Der nachfolgende Code erlaubt das Konvertieren von
// Integerzahlen aus dem Dezimalsystem in Zahlenstrings, welche auf den
// Zahlensystemen 2 bis 36 basieren, wobei alle Buchstaben als Zahlensymbole
// eingesetzt werden (H steht beispielsweise für 17). Eine besondere Bedeutung
// haben hierbei negative Werte. Da beispielsweise Hex-Werte intern ohne Minus-
// zeichen dargestellt werden, kann man mittels der Variablen "Minus" selbst
// bestimmen, wie das Ergebnis aussehen soll. So ergibt der Aufruf
// IntTo2_36(-123, 16, false, aString) das Ergebnis FFFFFF85 aber
// IntTo2_36(-123, 16, true, aString) ergibt -7B
// Im Gegenzug kann man sich die Rückwandlung der beiden Hex-Werte anschauen:
// showmessage(inttostr(-$7B)); ----> ergibt -123
// showmessage(inttostr(integer($FFFFFF85))); --> ergibt -123
// Querverweis: Integer- und Hex-Werte umwandeln
// oder auch: Integer-Werte in Binärform umsetzen

// Getestet mit D4 unter WinME

function IntTo2_36  
  (Zahl: integer; Basis: Byte; Minus: Boolean; var s: string): boolean;  
var hlp: int64;  
  function zeichen(i: integer): char;  
  begin  
    case i of  
      0..9: result := chr(48 + i);  
    else result := chr(55 + i);  
    end;  
  end;  
begin  
  if Basis in [2..36] then begin  
    result := true;  
    if Zahl = 0 then s := '0' else begin  
      if Minus then hlp := abs(Zahl) else  
        if Zahl < 0 then hlp := $100000000 + Zahl  
        else hlp := Zahl;  
      s := '';  
      while hlp > 0 do begin  
        s := zeichen(hlp mod Basis) + s;  
        hlp := hlp div Basis;  
      end;  
    end;  
    if Minus and (Zahl < 0) then s := '-' + s;  
  end else result := false  
end;  
  

// Beispielaufruf  
procedure TFormx.Button4Click(Sender: TObject);  
var s: string;  
begin  
  if not IntTo2_36(60350, 16, true, s) then  
    showmessage('Zahlensystem ist nicht in 2..36')  
  else showmessage(s);  
end;

// --------------------------------------------------------------

// Zahlenstrings kann man auch wieder in dezimale Integerwerte wandeln, wenn
// bekannt ist, aus welchem Zahlensystem (2..36) sie stammen (1011 muss ja
// nicht zwangsläufig Dualsystem sein). Allerdings ist der Aufwand ein klein
// wenig größer, da beispielsweise der String zu lang sein könnte, falsche
// Zahlen enthalten könnte (z.B. eine 3 beim Dualsystem), oder auch doppelte
// Minuszeichen vorhanden sein könnten (der Code ist kein Parser!!). Übrigens
// kann das Minuszeichen auch am Ende des Strings stehen.

 
function StrToDec(s: string; Basis: byte; var z: integer): boolean;  
var  
  minus: boolean;  
  x, lg: integer;  
  bt: byte;  
  hlp: int64;  
  function bytes(c: char; var b: byte): boolean;  
  begin  
    case c of  
      '0'..'9': b := ord(c) - 48;  
      'A'..'Z': b := ord(c) - 55;  
    else b := 255;  
    end;  
    result := (b < basis);  
  end;  
  function rechnen: int64;  
  var j: integer;  
  begin  
    result := 1;  
    for j := 1 to lg - x do  
      result := result * basis;  
  end;  
  function zeichenfehler: boolean;  
  const z = '-+';  
  var i, p: integer;  
  begin  
    result := true;  
    lg := length(s);  
    for i := 1 to 2 do begin  
      p := pos(z[i], s);  
      if (p > 0) and  
        ((lastdelimiter(z[i], s) <> p) or (p > 1) and (p <> lg))  
        then exit;  
    end;  
    result := false;  
  end;  
  procedure vornullweg;  
  var y: integer;  
  begin  
    y := 1;  
    s := stringreplace(s, '-', '', []);  
    s := stringreplace(s, '+', '', []);  
    lg := length(s);  
    while y < lg do begin  
      if s[y] <> '0' then break;  
      inc(y);  
    end;  
    s := copy(s, y, lg);  
  end;  
begin  
  result := false;  
  s := uppercase(trim(stringreplace(s, #32, '', [rfreplaceall])));  
  if basis in [2..36] then begin  
    if zeichenfehler then exit;  
    minus := pos('-', s) > 0;  
    vornullweg;  
    if s = '' then exit;  
    lg := length(s);  
    hlp := 0;  
    for x := lg downto 1 do begin  
      if not bytes(s[x], bt) then exit;  
      try  
        hlp := hlp + bt * rechnen;  
      except exit;  
      end;  
    end;  
    if hlp > maxint then hlp := hlp - $100000000;  
    if minus then hlp := -hlp;  
    if (hlp > maxint) or (hlp < low(integer)) then exit;  
    z := hlp;  
    result := true;  
  end;  
end;  
 

// Beispielaufruf  
procedure TFormx.Button4Click(Sender: TObject);  
var i: integer;  
begin  
  if not StrToDec('-6AHH', 21, i) then showmessage('Fehler')  
  else showmessage(inttostr(i));  
end;