es ist mir ja schon fast peinlich zu fragen, aber ich seh den Wald vor lauter Bäumen nicht. Zum Nachstellen ein Leeres Formular nehmen 2 Buttons 1 Stringgrid erstellen unten stehenden Code einfügen.
Drücke ich nun auf den Button1, wird mein Stringgrid befüllt.
Drücke ich auf Button2 sollte das Stringgrid nach der 1. Spalte sortiert werden, das tut es aber nicht (erst beim 2. Klick, ändert sich nichts mehr)=> meine SortColumn Routine ist fehlerhaft, nur wo..
Könnt ihr mir helfen ?
Code: Alles auswählen
Unit Unit1;
{$MODE objfpc}{$H+}
Interface
Uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Grids;
Type
{ TForm1 }
TForm1 = Class(TForm)
Button1: TButton;
Button2: TButton;
StringGrid1: TStringGrid;
Procedure Button1Click(Sender: TObject);
Procedure Button2Click(Sender: TObject);
Procedure FormCreate(Sender: TObject);
private
public
End;
Var
Form1: TForm1;
Implementation
{$R *.lfm}
Const
MainColDist = 0;
{ TForm1 }
Procedure SortColumn(Const StringGrid: TStringGrid; Const Column: integer; Const Direction: boolean);
Function Compare(v1, v2: String): Integer;
Var
v1_, v2_: integer;
Begin
If Column = MainColDist Then Begin // Spalte 2 wird natürlich der km wert als Zahl gerechnet und nicht als String ;)
If (trim(v1) = '') Or (trim(v2) = '') Then Begin
result := 0;
End
Else Begin
v1_ := trunc(strtofloat(trim(copy(v1, 1, pos('k', v1) - 1))) * 10);
v2_ := trunc(strtofloat(trim(copy(v2, 1, pos('k', v2) - 1))) * 10);
result := v1_ - v2_;
End;
End
Else Begin
result := CompareStr(lowercase(v1), lowercase(v2));
End;
If Not direction Then result := -result;
End;
Procedure Quick(li, re: integer);
Var
l, r, p, i: Integer;
h: String;
Begin
If Li < Re Then Begin
p := Trunc((li + re) / 2); // Auslesen des Pivo Elementes
l := Li;
r := re;
While l < r Do Begin
While Compare(StringGrid.cells[Column, l], StringGrid.cells[Column, p]) < 0 Do
inc(l);
While Compare(StringGrid.cells[Column, r], StringGrid.cells[Column, p]) > 0 Do
dec(r);
If L <= R Then Begin
If l < r Then Begin
For i := 0 To StringGrid.ColCount - 1 Do Begin
h := StringGrid.Cells[i, l];
StringGrid.Cells[i, l] := StringGrid.Cells[i, r];
StringGrid.Cells[i, r] := h;
End;
End;
inc(l);
dec(r);
End;
End;
quick(li, r);
quick(l, re);
End;
End;
Begin
StringGrid.BeginUpdate;
Quick(1, StringGrid.RowCount - 1);
StringGrid.EndUpdate(true);
End;
Procedure TForm1.Button1Click(Sender: TObject);
Var
s, t: String;
Begin
// Real Gemessene aber mehrdeutige Folge die den Fehler erzeugt
// s := '7,9km;9,8km;4,9km;3,4km;9,6km;9,9km;9,8km;8,8km;9,3km;9,9km;4,3km;4,0km;3,3km;9,6km;8,5km;9,7km;5,3km;7,1km;5,2km;2,1km;5,5km;';
// Konstruierte Folge die den Fehler auch erzeugt
s := '7,9km;9,8km;4,9km;3,4km;10,6km;9,9km;10,8km;8,8km;9,3km;10,9km;4,3km;4,0km;3,3km;9,6km;8,5km;9,7km;5,3km;7,1km;5,2km;2,1km;5,5km;';
StringGrid1.RowCount := 1;
While s <> '' Do Begin
t := copy(s, 1, pos(';', s) - 1);
delete(s, 1, pos(';', s));
StringGrid1.RowCount := StringGrid1.RowCount + 1;
StringGrid1.Cells[0, StringGrid1.RowCount - 1] := t;
StringGrid1.Cells[1, StringGrid1.RowCount - 1] := inttostr(StringGrid1.RowCount - 1);
StringGrid1.Cells[3, StringGrid1.RowCount - 1] := inttostr(StringGrid1.RowCount - 1);
End;
End;
Procedure TForm1.Button2Click(Sender: TObject);
Var
i: Integer;
Begin
SortColumn(StringGrid1, 0, true);
For i := 1 To StringGrid1.RowCount - 1 Do Begin
StringGrid1.Cells[3, i] := inttostr(i);
End;
End;
Procedure TForm1.FormCreate(Sender: TObject);
Begin
StringGrid1.Cells[3, 0] := 'Zeile';
StringGrid1.Cells[0, 0] := 'Distanz';
StringGrid1.Cells[1, 0] := 'Ursprünglicher Index';
Button1.Click;
End;
End.