DBR Delphi-Ecke

// Es wird gezeigt, wie man bei einem TStringGrid komplette Spalten
// und/oder Zeilen ein- und ausblenden bzw. löschen und einfügen kann.

// Getestet mit D4 unter XP

// 1. Spalten ein- und ausblenden:
// Ist eine Spalte sichtbar, wird sie ausgeblendet. Ist sie bereits
// ausgeblendet, dann wird sie (in Standard-Breite) wieder eingeblendet.

procedure SpalteBlenden(sg: TStringgrid; Spalte: integer); 
begin 
  if (spalte < sg.colcount) and (spalte >= 0) 
    then begin 
    if sg.colwidths[Spalte] <= abs(sg.GridlineWidth) then 
      sg.colwidths[Spalte] := sg.DefaultColWidth 
    else sg.colwidths[Spalte] := -sg.GridlineWidth; 
  end; 
end; 


// Beispielaufruf 
procedure TForm1.Button15Click(Sender: TObject); 
begin 
  SpalteBlenden(StringGrid1, 2); 
end;

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

// 2. Zeilen ein- und ausblenden:
//    (Etwas aufwendiger als bei Spalten)
//    Ist eine Zeile sichtbar, wird sie ausgeblendet. Ist sie bereits
//    ausgeblendet, dann wird sie (in Standard-Höhe) wieder eingeblendet.

procedure ZeileBlenden(sg: TStringgrid; Zeile: integer); 
begin 
  if (Zeile < sg.rowcount) and (Zeile >= 0) 
    then begin 
    if sg.rowheights[Zeile] <= abs(sg.GridlineWidth) then 
      sg.rowheights[Zeile] := sg.DefaultRowHeight 
    else sg.rowheights[Zeile] := -sg.GridlineWidth; 
  end; 
end; 
 
// (Doppelklick im Objektinspektor)
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; 
  Rect: TRect; State: TGridDrawState); 
var diff: integer; 
begin 
  with TStringGrid(Sender) do begin 
    if (GridlineWidth > 0) and (ARow > 0) and 
      (RowHeights[ARow - 1] <= GridlineWidth) 
      then begin 
      diff := (GridlineWidth + 1) div 2; 
      if ACol < FixedCols then 
        canvas.pen.color := clblack else 
        canvas.pen.color := clsilver; 
      canvas.pen.width := GridlineWidth; 
      canvas.moveto(rect.left, rect.top - diff); 
      canvas.lineto(rect.right, rect.top - diff); 
    end; 
  end; 
end; 
 
 
// Beispielaufruf 
procedure TForm1.Button16Click(Sender: TObject); 
begin 
  ZeileBlenden(StringGrid1, 3); 
end;

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

// 3. Spalten löschen:

procedure SpalteWeg(sg: TStringgrid; Spalte: integer); 
var 
  x, y: integer; 
begin 
  if (spalte < sg.colcount) and (spalte >= 0) 
    then begin 
    for y := 0 to sg.rowcount - 1 do 
      for x := Spalte to sg.colcount - 2 do 
        sg.cells[x, y] := sg.cells[x + 1, y]; 
    sg.colcount := sg.colcount - 1; 
  end; 
end; 
 
 
// Beispielaufruf 
procedure TForm1.Button15Click(Sender: TObject); 
begin 
  SpalteWeg(StringGrid1, 1); 
end;

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

// 3. Spalten einfügen:

procedure LeereSpalte(sg: TStringgrid; Spalte: integer); 
var 
  x, y: integer; 
begin 
  if (spalte <= sg.colcount) and (spalte >= 0) 
    then begin 
    sg.colcount := sg.colcount + 1; 
    for y := 0 to sg.rowcount - 1 do 
      for x := sg.colcount - 1 downto Spalte + 1 do 
        sg.cells[x, y] := sg.cells[x - 1, y]; 
    sg.cols[Spalte].text := ''; 
  end; 
end; 
 
 
// Beispielaufruf 
procedure TForm1.Button15Click(Sender: TObject); 
begin 
  leereSpalte(StringGrid1, 1); 
end;

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

// 4. Zeilen löschen:

procedure ZeileWeg(sg: TStringgrid; Zeile: integer); 
var 
  x, y: integer; 
begin 
  if (Zeile < sg.rowcount) and (Zeile >= 0) 
    then begin 
    for x := 0 to sg.colcount - 1 do 
      for y := Zeile to sg.rowcount - 2 do 
        sg.cells[x, y] := sg.cells[x, y + 1]; 
    sg.rowcount := sg.rowcount - 1; 
  end; 
end; 
 
 
// Beispielaufruf 
procedure TForm1.Button15Click(Sender: TObject); 
begin 
  ZeileWeg(StringGrid1, 4); 
end;

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

// 4. Zeilen einfügen:

procedure LeereZeile(sg: TStringgrid; Zeile: integer); 
var 
  x, y: integer; 
begin 
  if (Zeile <= sg.rowcount) and (Zeile >= 0) 
    then begin 
    sg.rowcount := sg.rowcount + 1; 
    for x := 0 to sg.colcount - 1 do 
      for y := sg.rowcount - 1 downto Zeile + 1 do 
        sg.cells[x, y] := sg.cells[x, y - 1]; 
    sg.rows[Zeile].text := ''; 
  end; 
end; 
  
 
// Beispielaufruf
procedure TForm1.Button15Click(Sender: TObject); 
begin 
  LeereZeile(StringGrid1, 3); 
end;