paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-31 22:49:30 +01:00
Code Issues Packages Projects Releases Wiki Activity

fixed stringgrid sorting (issue #7397) and added StrictSort property

Browse Source 
git-svn-id: trunk@9881 -
This commit is contained in:
jesus 2006-09-13 05:53:32 +00:00
parent 557f84ff7e
commit 193b2859bf
1 changed files with 25 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
lcl/grids.pas
View File

@ -567,6 +567,7 @@ type
FGridBorderStyle: TBorderStyle; FGridBorderStyle: TBorderStyle;
FGridFlags: TGridFlags; FGridFlags: TGridFlags;
FGridPropBackup: TGridPropertyBackup; FGridPropBackup: TGridPropertyBackup;
FStrictSort: boolean;
procedure AdjustCount(IsColumn:Boolean; OldValue, NewValue:Integer); procedure AdjustCount(IsColumn:Boolean; OldValue, NewValue:Integer);
procedure CacheVisibleGrid; procedure CacheVisibleGrid;
procedure CancelSelection; procedure CancelSelection;
@ -860,6 +861,7 @@ type
property SelectedColumn: TGridColumn read GetSelectedColumn; property SelectedColumn: TGridColumn read GetSelectedColumn;
property Selection: TGridRect read GetSelection write SetSelection; property Selection: TGridRect read GetSelection write SetSelection;
property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars; property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars;
property StrictSort: boolean read FStrictSort write FStrictSort;
property TitleFont: TFont read FTitleFont write SetTitleFont; property TitleFont: TFont read FTitleFont write SetTitleFont;
property TitleStyle: TTitleStyle read FTitleStyle write SetTitleStyle; property TitleStyle: TTitleStyle read FTitleStyle write SetTitleStyle;
property TopRow: Integer read GetTopRow write SetTopRow; property TopRow: Integer read GetTopRow write SetTopRow;
@ -986,6 +988,7 @@ type
property SelectedColor; property SelectedColor;
property SelectedColumn; property SelectedColumn;
property Selection; property Selection;
property StrictSort;
//property TabStops; //property TabStops;
property TopRow; property TopRow;
property UseXORFeatures; property UseXORFeatures;
@ -2011,7 +2014,7 @@ end;
procedure TCustomGrid.Sort(ColSorting: Boolean; index, IndxFrom, IndxTo: Integer); procedure TCustomGrid.Sort(ColSorting: Boolean; index, IndxFrom, IndxTo: Integer);
procedure QuickSort(L,R: Integer); procedure QuickSort(L,R: Integer);
var var
i,j: Integer; I,J: Integer;
P{,Q}: Integer; P{,Q}: Integer;
begin begin
repeat repeat
@ -2020,20 +2023,34 @@ procedure TCustomGrid.Sort(ColSorting: Boolean; index, IndxFrom, IndxTo: Integer
P:=(L+R) div 2; P:=(L+R) div 2;
repeat repeat
if ColSorting then begin if ColSorting then begin
while DoCompareCells(index, P, index, i)>0 do I:=I+1; while DoCompareCells(index, P, index, I)>0 do I:=I+1;
while DoCompareCells(index, P, index, j)<0 do J:=J-1; while DoCompareCells(index, P, index, J)<0 do J:=J-1;
end else begin end else begin
while DoCompareCells(P, index, i, index)>0 do I:=I+1; while DoCompareCells(P, index, I, index)>0 do I:=I+1;
while DoCompareCells(P, index, j, index)<0 do J:=J-1; while DoCompareCells(P, index, J, index)<0 do J:=J-1;
end; end;
if I<=J then begin if I<=J then begin
if I<>J then if I<>J then
DoOPExchangeColRow(not ColSorting, i,j); if not FStrictSort or
(ColSorting and (DoCompareCells(index, I, index, J)<>0)) or
(not ColSorting and (DoCompareCells(I, index, J, index)<>0))
then
DoOPExchangeColRow(not ColSorting, I,J);
if P=I then
P:=J
else if P=J then
P:=I;
I:=I+1; I:=I+1;
J:=j-1; J:=J-1;
end; end;
until I>J; until I>J;
if L<J then QuickSort(L,J);
if L<J then
QuickSort(L,J);
L:=I; L:=I;
until I>=R; until I>=R;
end; end;