TStringGrid functions (Delete, Insert, Sort)

Mirror

TStringGrid functions (Delete, Insert, Sort) (Views: 706)

Problem/Question/Abstract:

How to insert, delete or sort columns in StringGrids

Answer:

Solve 1:

procedure GridRemoveColumn(StrGrid: TStringGrid; DelColumn: Integer);
var
  Column: Integer;
begin
  if DelColumn <= StrGrid.ColCount then
  begin
    for Column := DelColumn to StrGrid.ColCount - 1 do
      StrGrid.Cols[Column - 1].Assign(StrGrid.Cols[Column]);
    StrGrid.ColCount := StrGrid.ColCount - 1;
  end;
end;

procedure GridAddColumn(StrGrid: TStringGrid; NewColumn: Integer);
var
  Column: Integer;
begin
  StrGrid.ColCount := StrGrid.ColCount + 1;
  for Column := StrGrid.ColCount - 1 downto NewColumn do
    StrGrid.Cols[Column].Assign(StrGrid.Cols[Column - 1]);
  StrGrid.Cols[NewColumn - 1].Text := '';
end;

procedure GridSort(StrGrid: TStringGrid; NoColumn: Integer);
var
  Line, PosActual: Integer;
  Row: TStrings;
begin
  Renglon := TStringList.Create;
  for Line := 1 to StrGrid.RowCount - 1 do
  begin
    PosActual := Line;
    Row.Assign(TStringlist(StrGrid.Rows[PosActual]));
    while True do
    begin
      if (PosActual = 0) or (StrToInt(Row.Strings[NoColumn - 1]) >=
        StrToInt(StrGrid.Cells[NoColumn - 1, PosActual - 1])) then
        Break;
      StrGrid.Rows[PosActual] := StrGrid.Rows[PosActual - 1];
      Dec(PosActual);
    end;
    if StrToInt(Row.Strings[NoColumn - 1]) < StrToInt(StrGrid.Cells[NoColumn - 1,
      PosActual]) then
      StrGrid.Rows[PosActual] := Row;
  end;
  Renglon.Free;
end;

Solve 2:

Had a few problems with range errors with the algorythms. On Delete or Add columns it is desirable to keep the widths of the columns as they are moved. Add column could also take the width of the new column (or default to DefaultColWidth if zero). I also had range errors in the Grid sort. On a large grid a Quicksort routine would be more desirable.

The Quicksort routine could take various sort modes as a parameter eg. Alpha,Double,Integer etc. (have supported only these 3 in demo, but it's easy to see how to incorporate more). The quick sort should also take "from row - to row" as parameters as we normally would not want to sort the header, or just a sub range may be required to be
sorted.

All in all though, some nice ideas for an extended stringgrid class, couple with DeleteRow, AddRow, LoadFromQuery etc.

procedure RemoveColumn(SG: TStringGrid; ColNumber: integer);
var
  Column: integer;
begin
  ColNumber := abs(ColNumber);

  if ColNumber <= SG.ColCount then
  begin
    for Column := ColNumber to SG.ColCount - 2 do
    begin
      SG.Cols[Column].Assign(SG.Cols[Column + 1]);
      SG.Colwidths[Column] := SG.Colwidths[Column + 1];
    end;
    SG.ColCount := SG.ColCount - 1;
  end;
end;

procedure AddColumn(SG: TStringGrid; AtColNumber: integer;
  ColWidth: integer = 0);
var
  Column: integer;
  Wdth: integer;
begin
  AtColNumber := abs(AtColNumber);
  SG.ColCount := SG.ColCount + 1;
  if abs(ColWidth) = 0 then
    Wdth := SG.DefaultColWidth
  else
    Wdth := ColWidth;

  if AtColNumber <= SG.ColCount then
  begin
    for Column := SG.ColCount - 1 downto AtColNumber + 1 do
    begin
      SG.Cols[Column].Assign(SG.Cols[Column - 1]);
      SG.Colwidths[Column] := SG.Colwidths[Column - 1];
    end;

    SG.Cols[AtColNumber].Text := '';
    SG.Colwidths[AtColNumber] := Wdth;
  end;
end;

Solve 3:

type
  TStringGridExSortType = (srtAlpha, srtInteger, srtDouble);

procedure GridSort(SG: TStringGrid; ByColNumber, FromRow, ToRow: integer;
  SortType: TStringGridExSortType = srtAlpha);
var
  Temp: TStringList;

  function SortStr(Line: string): string;
  var
    RetVar: string;
  begin
    case SortType of
      srtAlpha: Retvar := Line;
      srtInteger: Retvar := FormatFloat('000000000', StrToIntDef(trim(Line), 0));
      srtDouble:
        try
          Retvar := FormatFloat('000000000.000000', StrToFloat(trim(Line)));
        except
          RetVar := '0.00';
        end;
    end;

    Result := RetVar;
  end;

  // Recursive QuickSort
  procedure QuickSort(Lo, Hi: integer; CC: TStrings);

    procedure Sort(l, r: integer);
    var
      i, j: integer;
      x: string;
    begin
      i := l;
      j := r;
      x := SortStr(CC[(l + r) div 2]);
      repeat
        while SortStr(CC[i]) < x do
          inc(i);
        while x < SortStr(CC[j]) do
          dec(j);
        if i <= j then
        begin
          Temp.Assign(SG.Rows[j]); // Swap the 2 rows
          SG.Rows[j].Assign(SG.Rows[i]);
          SG.Rows[i].Assign(Temp);
          inc(i);
          dec(j);
        end;
      until i > j;
      if l < j then
        sort(l, j);
      if i < r then
        sort(i, r);
    end;

  begin {quicksort}
    Sort(Lo, Hi);
  end;

begin
  Temp := TStringList.Create;
  QuickSort(FromRow, ToRow, SG.Cols[ByColNumber]);
  Temp.Free;
end;

<< Back to main page