DBR Delphi-Ecke

// Getestet mit D4 unter XP

// Ein Stringgrid wird anhand einer (oder mehrerer) bestimmten Spalte(n)
// zeilenweise sortiert, wobei eine Start- und eine Endzeile festgelegt
// werden kann, um nur einen vorgegebenen Bereich zu sortieren. Mit der
// Variablen "aufsteigend" legt man die Sortierreihenfolge fest. Die Variable
// "fix" bestimmt, ob feste Spalten (FixedCols) auch mit sortiert werden.
// Bitte beachten: Die Zählung der Zeilen und Spalten beginnt bei Null.

// 1. Einfache Variante
//   Die Prozedur ist gedacht um Wörter in den Zellen des Grids alphabetisch
//   zu sortieren, nicht aber Zahlen. Da von links nach rechts geprüft wird,
//   wäre 80 größer als 10000, denn 8 ist größer als 1.

procedure SortGrid(Grd: TStringGrid; Spalten: array of Word; BeginnZeile, 
  Endzeile: Integer; aufsteigend, fix: boolean); 
var i, j, k, h, a: integer; 
  function verglsp(s: integer): integer; 
  begin 
    result := ansistrIcomp(pchar(grd.cells[s, j]), 
      pchar(grd.cells[s, j + k])); 
  end; 
  function vergl: boolean; 
  var x, w: integer; 
    procedure v_erg; 
    begin 
      x := verglsp(Spalten[w]); 
    end; 
  begin 
    w := 0; 
    v_erg; 
    while w < h do begin 
      inc(w); 
      if x = 0 then v_erg; 
    end; 
    case aufsteigend of 
      true: result := x > 0; 
    else result := x < 0; 
    end; 
  end; 
  procedure doit; 
  var y: integer; 
    s: string; 
  begin 
    for y := a to grd.colcount - 1 do begin 
      s := grd.cells[y, j]; 
      grd.cells[y, j] := grd.cells[y, j + k]; 
      grd.cells[y, j + k] := s; 
    end; 
  end; 
begin 
  with grd do begin 
    a := ord(not fix) * fixedcols; 
    editormode := false; 
    h := High(Spalten); 
    k := EndZeile shr 1; 
    while k > 0 do begin 
      for i := BeginnZeile to EndZeile - k do begin 
        j := i; 
        while (j >= BeginnZeile) and vergl do begin 
          doit; 
          if j > k then dec(j, k) else j := BeginnZeile; 
        end; 
      end; 
      k := k shr 1; 
    end; 
  end; 
end; 
 
 
// Beispielaufruf: 
// Die Sortierung erfolgt zunächst nach Spalte 1 (z.B. Familiennamen), 
// und dann noch nach Spalte 2 (z.B. Vornamen). 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  SortGrid(Stringgrid1, [1, 2], Stringgrid1.FixedRows, 
    Stringgrid1.RowCount - 1, true, false); 
end;

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

// 2. Erweiterte Variante
// Die Variante 1 wurde erweitert, um auch eine Zahlenfolge oder ein Datum
// sortieren zu können. Mittels des Arrays "Art" wird der Funktion mitgeteilt,
// wie jeder Spalte zu sortieren ist. Sollte man jedoch versuchen, eine
// Spalte, welche Text enthält, als Zahlen zu sortieren, so kommt es
// logischerweise zu einer Fehlermeldung. Im umgekehrten Fall kann man
// natürlich Zahlen sortieren, als wären sie Strings.
// Mit der Variablen "LeerZuletzt" wird festgelegt, ob Leerzeilen nach unten
// oder nach oben sortiert werden. Allerdings gibt es hier einen Sonderfall.
// Bei Zahlenkolonnen soll manchmal eine leere Zelle als "0" gewertet werden.
// Das kann man über die Variable "Leer" einstellen. Diese wird aber nur beachtet,
// wenn eine Spalte nach Zahlen sortiert werden soll.
// Mittels "SpaltenAngabenAnpassen" legt man fest, was passiert, wenn ein Wert
// im Array "Spalten" zu klein ist, oder größer als ColCount - 1. Entweder wird
// der Wert passend gemacht, oder es erscheint eine Fehlermeldung.

type 
  SortType = (Num, Dat, Txt, Unknow);  // Zahl,  Datum/Zeit,  Text,  unbekannt 
  LeerType = (wieNull, wieLeer); 
 
procedure SortGrid(Grd: TStringGrid; Spalten: array of Word; 
  Art: array of SortType; BeginnZeile, Endzeile: Integer; 
  aufsteigend, fix, SpaltenAngabenAnpassen, LeerZuletzt: boolean; 
  Leer: Leertype); 
var 
  i, j, k, h, a: integer; 
  dm: TDateTime; 
  em: extended; 
  tm: string; 
  function verglsp(s, o: integer): integer; 
  var 
    d1, d2: TDateTime; 
    e1, e2: extended; 
    s1, s2: string; 
  begin 
    case Art[o] of 
      Num: begin 
          try 
            if grd.cells[s, j] = '' then e1 := em else 
              e1 := strtofloat(stringreplace(grd.cells[s, j], 
                '.', '', [rfreplaceall])); 
            if grd.cells[s, j + k] = '' then e2 := em else 
              e2 := strtofloat(stringreplace(grd.cells[s, j + k], 
                '.', '', [rfreplaceall])); 
          except 
            raise exception.create('Werte entsprechen nicht dem Typ Zahl'); 
          end; 
          result := ord(e1 = e2) + ord(e1 > e2) shl 1 - 1; 
        end; 
      Dat: begin 
          try 
            if grd.cells[s, j] = '' then d1 := dm else 
              d1 := strtodatetime(grd.cells[s, j]); 
            if grd.cells[s, j + k] = '' then d2 := dm else 
              d2 := strtodatetime(grd.cells[s, j + k]); 
          except 
            raise exception.create('Werte entsprechen nicht dem Typ Datum/Zeit'); 
          end; 
          result := ord(d1 = d2) + ord(d1 > d2) shl 1 - 1; 
        end; 
    else begin 
        if grd.cells[s, j] = '' then s1 := tm else 
          s1 := grd.cells[s, j]; 
        if grd.cells[s, j + k] = '' then s2 := tm else 
          s2 := grd.cells[s, j + k]; 
        result := ansistrIcomp(pchar(s1), pchar(s2)); 
      end; 
    end; 
  end; 
  function vergl: boolean; 
  var 
    x, w: integer; 
    procedure v_erg; 
    begin 
      x := verglsp(Spalten[w], w); 
    end; 
  begin 
    w := 0; 
    v_erg; 
    while w < h do begin 
      inc(w); 
      if x = 0 then v_erg; 
    end; 
    case aufsteigend of 
      true: result := x > 0; 
    else result := x < 0; 
    end; 
  end; 
  procedure doit; 
  var 
    y: integer; 
    s: string; 
  begin 
    for y := a to grd.colcount - 1 do begin 
      s := grd.cells[y, j]; 
      grd.cells[y, j] := grd.cells[y, j + k]; 
      grd.cells[y, j + k] := s; 
    end; 
  end; 
begin 
  if aufsteigend = LeerZuletzt 
    then begin 
    if leer = wieNull then em := 0 else 
      em := 1.1E+4932; 
    dm := strtodatetime('31.12.9999 23:59'); 
    tm := stringofchar('Z', 255); 
  end else begin 
    if leer = wieNull then em := 0 else 
      em := 3.4E-4932; 
    dm := strtodatetime('01.01.0001'); 
    tm := ''; 
  end; 
  with grd do begin 
    if (Endzeile > rowcount - 1) or (Endzeile < BeginnZeile) 
      or (BeginnZeile < 0) then 
      raise exception.create('Falsche Zeilenangabe'); 
    a := ord(not fix) * fixedcols; 
    h := High(Spalten); 
    if h <> High(Art) then 
      raise exception.create('Falsche Anzahl bei Sortiertyp'); 
    if SpaltenAngabenAnpassen then begin 
      for k := 0 to h do 
        if (Spalten[k] > colcount - 1) then Spalten[k] := colcount - 1 
        else if (Spalten[k] < a) then Spalten[k] := a; 
    end else 
      for k := 0 to h do 
        if (Spalten[k] > colcount - 1) 
          or (Spalten[k] < a) then 
          raise exception.create('Falsche Spaltenangabe'); 
    editormode := false; 
    k := EndZeile shr 1; 
    while k > 0 do begin 
      for i := BeginnZeile to EndZeile - k do begin 
        j := i; 
        while (j >= BeginnZeile) and vergl do begin 
          doit; 
          if j > k then dec(j, k) else j := BeginnZeile; 
        end; 
      end; 
      k := k shr 1; 
    end; 
  end; 
end; 
 

 
// -------- Beispielaufrufe -------- 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
// --- zum Testen --- 
  with stringgrid1 do begin 
    ColCount := 5; 
    RowCount := 8; 
    FixedCols := 1; 
    FixedRows := 1; 
 
    cells[1, 1] := 'Voigt'; 
    cells[1, 2] := 'Müller'; 
    cells[1, 3] := 'Müller'; 
    cells[1, 4] := 'Müller'; 
    cells[1, 5] := 'Müller'; 
    cells[1, 6] := 'Müller'; 
 
    cells[2, 1] := 'Susanne'; 
    cells[2, 2] := 'Arnold'; 
    cells[2, 3] := 'Xaver'; 
    cells[2, 4] := ''; 
    cells[2, 5] := 'Dieter'; 
    cells[2, 6] := 'Dieter'; 
 
    cells[3, 1] := '30.01.1950'; 
    cells[3, 2] := '30.01.1950'; 
    cells[3, 3] := '10.03.1966'; 
    cells[3, 4] := '10.02.1947'; 
    cells[3, 5] := '19.12.1947'; 
    cells[3, 6] := '19.12.1940'; 
 
    cells[4, 1] := '1.777,1'; 
    cells[4, 2] := '9.978'; 
    cells[4, 3] := ''; 
    cells[4, 4] := '-111,704'; 
    cells[4, 5] := '123'; 
    cells[4, 6] := '0,00'; 
  end; 
end; 
 
 
 
// Es wird nach Name, Vorname und Geburtstag sortiert 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  SortGrid(Stringgrid1, [1, 2, 3], [Txt, Txt, Dat], 
    Stringgrid1.FixedRows, Stringgrid1.RowCount - 1, 
    true, false, false, false, wieLeer); 
end;

// -----------------------------------------------------------------------
 
// Beim Klick auf den Spaltenkopf wird die 
// jeweilige (einzelne) Spalte sortiert 
 
const 
  aost: array[0..4] of SortType = // Grid hat 5 Spalten; Spalte 0 = Fixed 
  (Unknow, Txt, Txt, Dat, Num); 
 
procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
var 
  arow, acol: integer; 
begin 
  StringGrid1.MouseToCell(X, Y, acol, arow); 
  if arow = 0 then 
    SortGrid(Stringgrid1, [acol], [aost[acol]], 
      Stringgrid1.FixedRows, Stringgrid1.RowCount - 1, 
      true, true, true, true, wieNull); 
end;