type 
  aoaob = array of array of boolean; 
 
const 
  selBrush = clBlue; 
  selFont = clWhite; 
  normBrush = clWhite; 
  normFont = clNavy; 
 
var 
  cellArray: aoaob; 
 
procedure leer(sg: TStringgrid; arr: aoaob); 
var 
  x, y: integer; 
begin 
  with sg do 
    for x := 0 to Colcount - 1 do 
      for y := 0 to Rowcount - 1 do 
        arr[x, y] := false; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  with Stringgrid1 do begin 
    setlength(cellArray, Colcount, Rowcount); 
    Options := Options - [goRowselect]; 
  end; 
  leer(Stringgrid1, cellArray); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  cellArray := nil; 
end; 
 
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; 
  Rect: TRect; State: TGridDrawState); 
begin 
  with TStringGrid(Sender), canvas do 
    if (aCol >= Fixedcols) and (aRow >= Fixedrows) then begin 
      if cellArray[aCol, aRow] then begin 
        brush.color := selBrush; 
        font.color := selFont; 
      end else begin 
        brush.color := normBrush; 
        font.color := normFont; 
      end; 
      fillrect(Rect); 
      TextRect(Rect, Rect.left + 2, Rect.top + 2, Cells[aCol, aRow]); 
    end; 
end; 
 
procedure TForm1.StringGrid1MouseDown(Sender: TObject; 
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
var i, j: integer; 
  b: boolean; 
begin 
  with TStringGrid(Sender) do begin 
    mousetocell(x, y, x, y); 
    if Shift = [ssCtrl, ssLeft] then begin 
      Editormode := false; 
      cellArray[x, y] := not cellArray[x, y]; 
      Refresh; 
    end else if Shift = [ssShift, ssLeft] then begin 
      CellArray[x, y] := true; 
      b := false; 
      for i := x - 1 downto 0 do 
        if CellArray[i, y] then begin 
          for j := i + 1 to x - 1 do 
            CellArray[j, y] := true; 
          b := true; 
          break; 
        end; 
      if not b then begin 
        for i := x + 1 to colcount - 1 do 
          if CellArray[i, y] then begin 
            for j := i - 1 downto x + 1 do 
              CellArray[j, y] := true; 
            break; 
          end; 
      end; 
      b := false; 
      for i := y + 1 to rowcount - 1 do 
        if CellArray[x, i] then begin 
          for j := i - 1 downto y + 1 do 
            CellArray[x, j] := true; 
          b := true; 
          break; 
        end; 
      if not b then begin 
        for i := y - 1 downto 0 do 
          if CellArray[x, i] then begin 
            for j := i + 1 to y - 1 do 
              CellArray[x, j] := true; 
            break; 
          end; 
      end; 
      Refresh; 
    end; 
  end; 
end; 
 
 
// alle Markierungen löschen: 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  leer(Stringgrid1, cellArray); 
  Stringgrid1.refresh; 
end;