DBR Delphi-Ecke

// Getestet mit D4 unter XP

// Es bestand die Aufgabe, Ansistrings in Listen nach einem bestimmten System
// einzuordnen. Dabei sollten Umlaute vor ihren Stammlauten eingeordnet werden,
// kleine Buchstaben vor ihrer großgeschriebenen Entsprechung aber vor anderen
// kleinen Buchstaben stehen, Buchstaben mit Betonungszeichen (Gravis, Akut,
// Zirkumflex) gleichwertig zu ihren Stammlauten sein, Zahlen nach Buchstaben
// und Zeichen nach Zahlen folgen. Also beispielsweise so:

// ä
// Ä
// a
// A
// b
// B
// ...
// e
// é
// E
// ...
// s
// S
// ß
// ...
// ü
// Ü
// u
// ...
// 1
// 2
// 3
// ...
// +
// ...

// Es war ziemlich schnell klar, das dies am besten über eine Tabelle realisiert
// werden könnte (welche später auch nach anderen Kriterien angeordnet werden kann).
// Also wurde nach folgendem Prinzip eine Tabelle aufgebaut:

  var
  tabelle: array[0..255] of byte;

  ...
  tabelle[30] := 30; 
  tabelle[31] := 31; 
  tabelle[32] := 32;   // Leerzeichen 1
  tabelle[160] := 32;  // Leerzeichen 2
  tabelle[ord('ä')] := 33; 
  tabelle[ord('Ä')] := 34; 
  tabelle[ord('a')] := 35; 
  tabelle[ord('à')] := 35; 
  tabelle[ord('á')] := 35; 
  tabelle[ord('â')] := 35; 
  tabelle[ord('ã')] := 35; 
  tabelle[ord('å')] := 35; 
  tabelle[ord('A')] := 36; 
  tabelle[ord('À')] := 36; 
  tabelle[ord('Á')] := 36; 
  tabelle[ord('Â')] := 36; 
  tabelle[ord('Ã')] := 36; 
  tabelle[ord('Å')] := 36; 
  tabelle[ord('b')] := 37; 
  tabelle[ord('B')] := 38;
  ...

// Diese Tabelle wurde folgendermaßen in eine Textdatei gespeichert, um sie
// in beliebige Programme einbauen zu können:

  ...
  sl := Tstringlist.create; 
  sl.add('var'); 
  sl.add('tabelle: array[0..255] of byte = ('); 
  for y := 0 to 15 do begin 
    s := ''; 
    for x := 0 to 15 do begin 
      s := s + '$' + (inttohex(tabelle[x + y * 16], 2)); 
      if x + 16 * y < 255 then s := s + ', ' 
      else s := s + ');'; 
    end; 
    sl.add(s); 
  end; 
  sl.savetofile('c:\tabelle.txt'); 
  sl.free; 
  ...

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

// Das fertige Konstrukt sieht nun so aus:

const 
  tabelle: array[0..255] of byte = ( 
    $00, $01, $02, $03, $04, $05, $06, $07, $08, $09, $0A, $0B, $0C, $0D, $0E, $0F, 
    $10, $11, $12, $13, $14, $15, $16, $17, $18, $19, $1A, $1B, $1C, $1D, $1E, $1F, 
    $20, $66, $67, $68, $69, $6A, $6B, $6C, $6D, $6E, $6F, $70, $71, $72, $73, $74, 
    $5C, $5D, $5E, $5F, $60, $61, $62, $63, $64, $65, $75, $76, $77, $78, $79, $7A, 
    $7B, $24, $26, $28, $2A, $2C, $2E, $30, $32, $34, $36, $38, $3A, $3C, $3E, $42, 
    $44, $46, $48, $4A, $4D, $51, $53, $55, $57, $59, $5B, $7C, $7D, $7E, $7F, $80, 
    $81, $23, $25, $27, $29, $2B, $2D, $2F, $31, $33, $35, $37, $39, $3B, $3D, $41, 
    $43, $45, $47, $49, $4C, $50, $52, $54, $56, $58, $5A, $82, $83, $84, $85, $86, 
    $87, $88, $89, $8A, $8B, $8C, $8D, $8E, $8F, $90, $91, $92, $93, $94, $95, $96, 
    $97, $98, $99, $9A, $9B, $9C, $9D, $9E, $9F, $A0, $A1, $A2, $A3, $A4, $A5, $A6, 
    $20, $A7, $A8, $A9, $AA, $AB, $AC, $AD, $AE, $AF, $B0, $B1, $B2, $B3, $B4, $B5, 
    $B6, $B7, $B8, $B9, $BA, $BB, $BC, $BD, $BE, $BF, $C0, $C1, $C2, $C3, $C4, $C5, 
    $24, $24, $24, $24, $22, $24, $22, $28, $2C, $2C, $2C, $2C, $34, $34, $34, $34, 
    $2A, $3E, $42, $42, $42, $42, $40, $C6, $C7, $51, $51, $51, $4F, $59, $C8, $4B, 
    $23, $23, $23, $23, $21, $23, $21, $27, $2B, $2B, $2B, $2B, $33, $33, $33, $33, 
    $29, $3D, $41, $41, $41, $41, $3F, $C9, $CA, $50, $50, $50, $4E, $58, $CB, $58); 
 
function wandeln(s: string): string; 
var 
  p: ^byte; 
begin 
  result := s; 
  if s = '' then exit;
  p := @result[1]; 
  while p^ > 0 do begin 
    p^ := tabelle[p^]; 
    inc(p); 
  end; 
end; 
 
procedure InsertEx(s: string; sl: TStrings); 
var 
  i: integer; 
begin 
  for i := 0 to sl.count do 
    if i = sl.count then sl.add(s) else 
      if (StrComp(pchar(wandeln(s)), pchar(wandeln(sl[i]))) <= 0) 
        then begin 
        sl.insert(i, s); 
        break; 
      end; 
end; 
 
 
// Beispielaufruf 
 
procedure TForm1.Button12Click(Sender: TObject); 
begin 
  Memo1.Lines.clear; 
  InsertEx('René', Memo1.Lines); 
  InsertEx('Übel', Memo1.Lines); 
  InsertEx('daß', Memo1.Lines); 
  InsertEx('über', Memo1.Lines); 
  InsertEx('ähnlich', Memo1.Lines); 
  InsertEx('Ast', Memo1.Lines); 
  InsertEx('Rene', Memo1.Lines); 
  InsertEx('Ärger', Memo1.Lines); 
  InsertEx('das', Memo1.Lines); 
  InsertEx('au', Memo1.Lines); 
  InsertEx('RENO', Memo1.Lines);
  InsertEx('René', Memo1.Lines); 
end;

// Ergebnis:

ähnlich
Ärger
au
Ast
das
daß
René
Rene
René
RENO
über
Übel