// Ein Stringgrid wird nach dem ersten Vorkommen eines Strings durchsucht.
// Die Zelle, die den gesuchten String enthält wird nach links oben gescrollt
// und bei Bedarf andersfarbig dargestellt.

// Getestet mit D4 unter WinME

const 
  markiert: boolean = false; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var 
  x: integer; 
begin 
  StringGrid1.defaultdrawing := true; 
  // ------------------------ zum Testen -------------------- 
  StringGrid1.rowcount := 101; 
  for x := 1 to StringGrid1.rowcount - 1 do begin 
    StringGrid1.cells[1, x] := 'Test ' + inttostr(x); 
    StringGrid1.cells[2, x] := 'Test ' + inttostr(x + 1000); 
  end; 
  // --------------------------------------------------------- 
end; 
 
function findestring(sg: TStringgrid; s: string; vonZeile, bisZeile, vonSpalte, 
  bisSpalte: word; markieren: boolean; Stift, Papier: TColor): boolean; 
var 
  x, y: integer; 
  r: TRect; 
begin 
  if bisSpalte > sg.colcount - 1 then bisSpalte := sg.colcount - 1; 
  if bisZeile > sg.rowcount - 1 then bisZeile := sg.rowcount - 1; 
  if bisZeile < vonZeile then begin 
    x := bisZeile; 
    bisZeile := vonZeile; 
    vonZeile := x; 
  end; 
  if bisSpalte < vonSpalte then begin 
    x := bisSpalte; 
    bisSpalte := vonSpalte; 
    vonSpalte := x; 
  end; 
  for y := vonZeile to bisZeile do 
    for x := vonSpalte to bisSpalte do begin 
      if sg.cells[x, y] = s then begin 
        if y > sg.fixedrows then 
          sg.toprow := y; 
        if x > sg.fixedcols then 
          sg.leftcol := x; 
        application.processmessages; 
        if markieren then begin 
          markiert := true; 
          r := sg.cellrect(x, y); 
          inc(r.left, 2); 
          inc(r.top, 2); 
          sg.canvas.brush.color := Papier; 
          sg.canvas.font.color := Stift; 
          sg.canvas.FillRect(sg.cellrect(x, y)); 
          drawtext(sg.canvas.handle, pchar(sg.cells[x, y]), 
            length(sg.cells[x, y]), r, 0); 
        end; 
        result := true; 
        exit; 
      end; 
    end; 
  result := false; 
end; 
 
procedure TForm1.StringGrid1MouseDown(Sender: TObject; 
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
begin 
  if markiert then begin 
    StringGrid1.refresh; 
    markiert := false; 
  end; 
end; 
 
procedure TForm1.StringGrid1KeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin 
  if markiert then begin 
    StringGrid1.refresh; 
    markiert := false; 
  end; 
end; 
 
// Beispielaufruf: 
// Es werden alle Zeilen aber nur die Spalte 2 durchsucht 
procedure TForm1.Button7Click(Sender: TObject); 
begin 
  ShowScrollBar(StringGrid1.handle, SB_BOTH, true); 
  if not findestring(StringGrid1, 'Test 1096', 1, StringGrid1.RowCount - 1, 
    2, 2, true, clyellow, $3366FF) 
    then showmessage('Im angegebenen Bereich nichts gefunden'); 
end; 


 

Zugriffe seit 6.9.2001 auf Delphi-Ecke