StringGrid: MergeSort - aber mit ColumnClickSorts

[aldicek]

Hallo, liebe Forengemeinde!

Noch immer mach ich mit StringListen rum. Es gibt, wie ich schon in meinem letzten Beitrag schrieb, ja wirklich schon viel vorgefertigte Funktionalität in TStringList, die immer wieder dazu einlädt, bequem die erprobten Routinen zu benutzen. Das tue ich auch, wo ich kann. Hier ist wieder einer der Fälle, wo Fummeln angesagt ist. Es ist ja so, dass die eingebaute Sortierung den Quicksort-Algorithmus abbildet, der nicht stabil ist. Habe ich nun also ein StringGrid mit mehreren Spalten und möchte das Grid

Code: Alles auswählen

StringGrid.Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goColMoving, goThumbTracking, goDblClickAutoSize, goSmoothScroll, goFixedRowNumbering, goHeaderHotTracking, goHeaderPushedLook, goFixedColSizing]

mittels

Code: Alles auswählen

StringGrid.ColumnClickSorts = true

einfach durch mehrfache, nacheinander durchgeführte Sortierung in eine beliebige gewünschte Reihenfolge bringen, geht das wegen der Nichtstabilität des in TCustomControl implementieren Standard-Sortierverfahrens schief, da jede Sortierung einer neuen Spalte die Reihenfolge gleicher Einträge einer vorsortierten anderen Spalte wieder zerwürfelt. Das ist schade, denn die Funktionalität Sortieren auf-/abwärts (mit eingeblendetem Glyphensymbol) per Headerklick stellt nach meinem Verständnis einen gut benutzbaren Ansatz zur Unifizierung von UIs dieser Art dar (- auch wenn die Sortierung annimmt, man wolle alles in einem StringGrid dargestellte alfabetisch sortieren. Das klappt jedoch leider spätestens bei im Grid darzustellenden Zahlen oder gar Datumsangaben nicht mehr korrekt.)
Es ist ja noch recht simpel, einen stabilen Sortieralgorithmus a la MergeSort abzuschreiben. Was aber muss ich dafür tun, dass nun der statt dem aus TCustomGrid.HeaderClick

Code: Alles auswählen

procedure TCustomGrid.HeaderClick(IsColumn: Boolean; index: Integer);
var
  ColOfs: Integer;
begin
  if IsColumn and FColumnClickSorts then begin
    // Prepare glyph images if not done already.
    if FTitleImageList = nil then
      FTitleImageList := TImageList.Create(Self);
    if FAscImgInd = -1 then begin
      FAscImgInd := TitleImageList.AddLazarusResource('sortasc');
      FDescImgInd := TitleImageList.AddLazarusResource('sortdesc');
    end;
    // Determine the sort order.
    if index = FSortColumn then begin
      case FSortOrder of        // Same column clicked again -> invert the order.
        soAscending:  FSortOrder:=soDescending;
        soDescending: FSortOrder:=soAscending;
      end;
    end
    else begin
      FSortOrder := soAscending;          // Ascending order to start with.
      // Remove glyph from previous column.
      ColOfs := FSortColumn - FFixedCols;
      if (ColOfs > -1) and (ColOfs < FColumns.Count ) then
        with FColumns[ColOfs].Title do
          ImageIndex := FOldImageIndex;
    end;
    // Show the sort glyph only if clicked column has a TGridColumn defined.
    ColOfs := index - FFixedCols;
    if (ColOfs > -1) and (ColOfs < FColumns.Count)
    and (FAscImgInd < TitleImageList.Count)
    and (FDescImgInd < TitleImageList.Count) then
      with FColumns[ColOfs].Title do begin
        // Save previous ImageIndex of the clicked column.
        if (index <> FSortColumn) then
          FOldImageIndex := ImageIndex;
        case FSortOrder of                // Show the right sort glyph.
          soAscending:  ImageIndex := FAscImgInd;
          soDescending: ImageIndex := FDescImgInd;
        end;
      end;
    FSortColumn := index;
    Sort(True, index, FFixedRows, RowCount-1); { <= Hier wäre der Punkt, eine eigene Sortiermethode einzubinden. }
  end;
end;

ausgeführt wird und gleichzeitig die Funktionalität Anzeige des Sortierglyphen erhalten bleibt?
Muss ich TCustomGrid.HeaderClick überschreiben und das Sort an der gekennzeichneten Stelle austauschen? Oder gibt es einen einfacheren Tweak, den ich nicht kenne? (Ich hoffe, ich konnte mein Anliegen deutlich genug formulieren.)

Hier mein Beispielprojekt:

Code: Alles auswählen

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  {$IFDEF UNIX}
  CLocale,
  {$ENDIF}
  Grids;
 
type
  TSpalte = (Zeichen,Zahlen,Datum);
 
  { TMainForm }
 
  TMainForm = class(TForm)
    Btn: TButton;
    Grid: TStringGrid;
    procedure BtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
    procedure AutoSizeGridCol;
    procedure FillCellsWithCrap;
    function ColIndexByTag(aTag: integer): integer;
  public
    { public declarations }
  end;
 
var
  MainForm: TMainForm;
 
implementation
 
{$R *.lfm}
 
{ TMainForm }
 
(******************************************************************************)
procedure TMainForm.FormCreate(Sender: TObject);
(******************************************************************************)
var
  i: integer;
begin
  { Property Tag in Grid.Columns mit primären Index von Grid.Columns füllen, um
  später die Funktion ColIndexByTag zum Wiederfinden umgeordneter Spalten nutzen
  zu können. }
  for i := 0 to Pred(Grid.ColCount - Grid.FixedCols) do
    Grid.Columns[i].Tag := i;
 
  // Zellen mit zufälligem Inhalt in diversen Formaten füllen
  BtnClick(Sender);
 
  // Per Header-Klick sortierbar machen
  Grid.ColumnClickSorts := true;
end;
 
(******************************************************************************)
procedure TMainForm.BtnClick(Sender: TObject);
(******************************************************************************)
begin
  // Zellen mit zufälligem Inhalt in diversen Formaten füllen
  FillCellsWithCrap;
  // Grid in Größe anpassen
  AutoSizeGridCol;
end;
 
(******************************************************************************)
procedure TMainForm.AutoSizeGridCol;
(******************************************************************************)
var
  i: integer;
begin
  i := 0;
  // Passe die Spaltengröße einer fixen Spalte mit Autonummerierung an
  if (goFixedRowNumbering in Grid.Options) then
  begin
    Grid.ColWidths[0] := Grid.Canvas.TextWidth(IntToStr(Grid.RowCount - 1)) + 2
    * constCellPadding + 2;
    Inc(i);
  end;
  // Passe die Spaltengröße der übrigen Spalten an
  while i < Grid.ColCount do
  begin
    Grid.AutoSizeColumn(i);
    Inc(i);
  end;
end;
 
(******************************************************************************)
procedure TMainForm.FillCellsWithCrap;
(******************************************************************************)
var
  i: integer;
 
  (****************************************************************************)
  function CreateString: string;
  (****************************************************************************)
  var
    i: integer;
  begin
    i := Round(Random(30));
    Result := '';
    while i > 0 do
    begin
      Result := Result + Chr(Random(26) + Ord('A'));
      Dec(i)
    end;
  end;
 
begin
  Randomize;
  // Alle nicht-fixen Zellen mit zufälligen Inhalten des entspr. Typs füllen
  for i := Grid.FixedRows to Pred(Grid.RowCount) do
    with Grid do begin
      { Warum Grid.Cells[ColIndexByTag(Ord(Zeichen)) + Grid.FixedCols?
      Damit lässt sich sicherstellen, dass auch nach einem Umordnen der
      Spalten der richtige Inhalt in der richtigen Spalte landet. }
      Cells[ColIndexByTag(Ord(Zeichen)) + FixedCols, i] := CreateString;
      Cells[ColIndexByTag(Ord(Zahlen)) + FixedCols, i] :=
      Format('%.0n', [Random(10000) / 1]);
      Cells[ColIndexByTag(Ord(Datum)) + FixedCols, i] :=
      DateTimeToStr(Random(50000));
    end;
end;
 
// Übergib Index von Grid.Columns, wenn dessen Tag = aTag ist. Ansonsten -1.
(******************************************************************************)
function TMainForm.ColIndexByTag(aTag: integer): integer;
(******************************************************************************)
var
  i: integer;
begin
  Result := -1;
  for i := 0 to Pred(Grid.ColCount - Grid.FixedCols) do
    if Grid.Columns[i].Tag = aTag then
    begin
      Result := i;
      Break;
    end;
end;
 
end.

und das Formular dazu:

Code: Alles auswählen

object MainForm: TMainForm
  Left = 481
  Height = 650
  Top = 314
  Width = 761
  Caption = 'MainForm'
  ClientHeight = 650
  ClientWidth = 761
  OnCreate = FormCreate
  LCLVersion = '1.0.8.0'
  object Grid: TStringGrid
    Left = 0
    Height = 625
    Top = 25
    Width = 761
    Align = alClient
    ColCount = 4
    Columns = <    
      item
        Title.Caption = 'Zeichen'
      end    
      item
        Alignment = taRightJustify
        Title.Alignment = taRightJustify
        Title.Caption = 'Zahlen'
      end    
      item
        Title.Caption = 'Datum'
      end>
    Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goColMoving, goRowSelect, goThumbTracking, goDblClickAutoSize, goSmoothScroll, goFixedRowNumbering, goHeaderHotTracking, goHeaderPushedLook, goFixedColSizing]
    RowCount = 51
    TabOrder = 0
  end
  object Btn: TButton
    Left = 0
    Height = 25
    Top = 0
    Width = 761
    Align = alTop
    Caption = 'Neu füllen'
    OnClick = BtnClick
    TabOrder = 1
  end
end

Bereits im Voraus besten Dank für zweckdienliche Hinweise
Aldicek

[Socke]

Was aber muss ich dafür tun, dass nun der statt dem aus TCustomGrid.HeaderClick

Du kannst eine eine eigene Klasse von TStringGrid ableiten und die Methode Sort überschreiben.

[aldicek]

Du kannst eine eine eigene Klasse von TStringGrid ableiten und die Methode Sort überschreiben.

Hallo Socke!

Danke für deine Antwort, habe ich mittlerweile auch so gedacht. Wird nicht ganz einfach werden, ist aber letztlich nur Fleißarbeit, gottlob haben die Autoren der LCL ja in einigen Fällen MergeSort schon implementiert. Wenn ich soweit bin, was aus Zeitgründen nicht ganz einfach wird, hänge ich es einfach mal hier an.

Grüße
Aldicek