DBR Delphi-Ecke

// Es bestand die Aufgabe von mehreren hundert überlangen Strings
// (welche Ziffern enthalten), die jeweilige nichtalternierende (einfache)
// Quersumme zu ermitteln. Außerdem sollte festgestellt werden, ob
// ein String fälschlicherweise leer ist oder Zeichen unterhalb von
// "0" bzw. oberhalb von "9" enthält. Das ganze sollte so schnell
// wie möglich von statten gehen.
// Die schnellste Methode, die ich ausgeknobelt habe, ist folgende:

// Getestet mit D2010 unter W7

function QuerSumme(s: PWideChar): integer; 
asm 
  test eax, eax 
  jz @leer 
  mov edx, eax 
  xor eax, eax 
  xor ecx, ecx 
 @loop: 
  mov cl, [edx] 
  jecxz @raus 
  cmp cl, 48 
  jl @zuklein 
  cmp cl, 57 
  jg @zugross 
  add eax, ecx 
  sub eax, 48 
  add edx, 2    // inc edx falls "s" kein WideChar
  jmp @loop 
 @leer: 
  mov eax, -1 
  jmp @raus 
 @zuklein: 
  mov eax, -2 
  jmp @raus 
 @zugross: 
  mov eax, -3 
 @raus: 
  mov @result, eax     
end; 
 
// Beispielaufruf (zugegebenermaßen mit einem kurzen String) 
 
procedure TForm1.Button11Click(Sender: TObject); 
var 
  i: integer; 
  s: string; 
begin 
  s := '13634092364834527633130104834523263746107343928251190912'; 
  i := QuerSumme(PWideChar(s)); 
  case i of 
    -1: raise exception.create('String ist leer'); 
    -2: raise exception.create('Zeichen unterhalb von "0"'); 
    -3: raise exception.create('Zeichen oberhalb von "9"'); 
  else showmessage('Quersumme: ' + inttostr(i));              // 211
  end; 
end;

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

// Hier noch eine Möglichkeit die alternierende Quersumme zu ermitteln:

function aQuerSumme(const s: string): integer; 
var x, y, i: integer; 
begin 
  if s = '' then result := -maxint else begin 
    result := 0; 
    y := 1; 
    for x := length(s) downto 1 do begin 
      i := ord(s[x]) - 48; 
      if i < 0 then begin 
        result := 1 - maxint; 
        exit; 
      end; 
      if i > 9 then begin 
        result := 2 - maxint; 
        exit; 
      end; 
      if odd(y) then 
        result := i mod 10 + result else 
        result := result - i; 
      inc(y); 
    end; 
  end; 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  i: integer; 
  s: string; 
begin 
  s := '13634092364834527633130104834523263746107343928251190192'; 
  i := aQuerSumme(s); 
  case i of 
    -maxint: raise exception.create('String ist leer'); 
    1 - maxint: raise exception.create('Zeichen unterhalb von "0"'); 
    2 - maxint: raise exception.create('Zeichen oberhalb von "9"'); 
  else showmessage('Alternierende Quersumme: ' + inttostr(i));        // -15 
  end; 
end;

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

// Und hier noch eine Möglichkeit, wie man aus der nichtalternierenden
// (einfachen) Quersumme die einstellige Quersumme bilden kann. Dafür
// wird die Funktion "QuerSumme" aus dem ersten Beispiel benutzt.

function eQuerSumme(const s: string): integer; 
var 
  i: integer; 
begin 
  result := QuerSumme(s); 
  if result > 0 then 
    while result > 9 do 
      result := QuerSumme(inttostr(result)); 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button11Click(Sender: TObject); 
var 
  i: integer; 
  s: string; 
begin 
  s := '13634092364834527633130104834523263746107343928251190912'; 
  i := eQuerSumme(s); 
  case i of 
    -1: raise exception.create('String ist leer'); 
    -2: raise exception.create('Zeichen unterhalb von "0"'); 
    -3: raise exception.create('Zeichen oberhalb von "9"'); 
  else showmessage('Einstellige Quersumme: ' + inttostr(i));         // 4
  end; 
end;

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

// Um das ganze abzurunden, hier noch die Quersummenbildung aus Zahlen:

function EinfacheQuersumme(zahl: cardinal): word; 
begin 
  result := 0; 
  while zahl > 0 do begin 
    result := result + zahl mod 10; 
    zahl := zahl div 10; 
  end; 
end; 
 
function IterierteQuersumme(zahl: cardinal): word; 
begin 
  while zahl >= 10 do begin 
    result := 0; 
    while zahl > 0 do begin 
      result := result + zahl mod 10; 
      zahl := zahl div 10; 
    end; 
    zahl := result; 
  end; 
  result := zahl; 
end; 
 
function AlternierendeQuerSumme(zahl: integer): integer; 
var x: integer; 
begin 
  result := 0; 
  x := 1; 
  while zahl > 0 do begin 
    if odd(x) then 
      result := zahl mod 10 + result else 
      result := result - zahl mod 10; 
    zahl := zahl div 10; 
    x := x xor 1; 
  end; 
end; 
 
 
// Beispielaufruf 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  i, s: integer; 
begin 
  s := 9791; 
  i := AlternierendeQuerSumme(s); 
  showmessage(inttostr(i));                // -10 
end;