Obsługa TStringGrida

1.   Sortowanie w TStringGrid według kolumn

type   TMoveSG = class(TCustomGrid); // reveals protected MoveRow procedure {...}

procedure SortGridByCols(Grid: TStringGrid; ColOrder: array of Integer);
var i, j: Integer; Sorted: Boolean;
function Sort(Row1, Row2: Integer): Integer;
var C: Integer;
begin
C := 0;   Result := AnsiCompareStr(Grid.Cols[ColOrder[C]][Row1], Grid.Cols[ColOrder[C]][Row2]);
if Result = 0 then begin
Inc(C);   while (C < = High(ColOrder)) and (Result = 0) do begin
Result := AnsiCompareStr(Grid.Cols[ColOrder[C]][Row1],
Grid.Cols[ColOrder[C]][Row2]);   Inc(C);
end; end; end;
begin
if SizeOf(ColOrder) div SizeOf(i) < > Grid.ColCount then Exit;
for i := 0 to High(ColOrder) do
if (ColOrder[i] < 0) or (ColOrder[i] >= Grid.ColCount) then Exit;   j := 0; Sorted := False;
repeat
Inc(j);   with Grid do
for i := 0 to RowCount - 2 do   if Sort(i, i + 1) > 0 then begin
TMoveSG(Grid).MoveRow(i + 1, i);   Sorted := False;   end;
until Sorted or (j = 1000); Grid.Repaint;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
{ Sort rows based on the contents of two or more columns.
Sorts first by column 1. If there are duplicate values in column 1, the next sort column is column 2 and so on...}
SortGridByCols(StringGrid1, [1, 2, 0, 3, 4]);
end;

2.   Wstawianie / usuwanie rekordów w TStringGrid

type TForm1 = class(TForm)
StringGrid1: TStringGrid;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private {...}
public {...}
end;

type TStringGridHack = class(TStringGrid)
protected
procedure DeleteRow(ARow: Longint); reintroduce;
procedure InsertRow(ARow: Longint);
end;

var Form1: TForm1;
implementation {$R *.DFM}

procedure TStringGridHack.DeleteRow(ARow: Longint);
var GemRow: Integer;
begin
GemRow := Row; if RowCount > FixedRows + 1 then   inherited DeleteRow(ARow)
else Rows[ARow].Clear;  if GemRow < RowCount then Row := GemRow;
end;

procedure TStringGridHack.InsertRow(ARow: Longint);
var GemRow: Integer;
begin
GemRow := Row; while ARow < FixedRows do Inc(ARow);   RowCount := RowCount + 1;
MoveRow(RowCount - 1, ARow);   Row := GemRow; Rows[Row].Clear;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin   // Insert Row, Zeile hinzufügen
TStringGridHack(StringGrid1).InsertRow(1);   // Remove Row, Zeile entfernen
TStringGridHack(StringGrid1).DeleteRow(2);
end;

end.

3.   Pokazuje tekst danej celi w postaci dymka (Hinta) podpowiedzi

var   LastRow, LastCol : Integer;

//Pokaz dymka celi
procedure TForm1.ShowCellHint(X,Y:Integer);
var ACol, ARow : Integer;
begin     //ShowHint auf True setzen
If StringGrid.ShowHint = False Then   StringGrid.ShowHint := True; //Col und Row Position lesen
StringGrid.MouseToCell(X, Y, ACol, ARow);   //wenn im gültigen Bereich zeige Zelleninhalt als Hint
If (ACol < > -1) And (ARow < > -1) Then   StringGrid.Hint:=StringGrid.Cells[ACol,ARow];
If (ACol < > LastCol) or (ARow < > LastRow) Then begin
Application.CancelHint;     LastCol:=ACol;     LastRow:=ARow;
end; end;

//Przykład po przesunięciu myszy nad celę:
procedure TForm1.StringGridMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
ShowCellHint(X,Y);
end;

4. Kopiowanie /wstawianie cel TStringGrida do i ze Schowka

uses Clipbrd;

//Kopiowanie
procedure TForm1.Button1Click(Sender: TObject);
var S: string; GRect: TGridRect; C, R: Integer;
begin
GRect := StringGrid1.Selection;     S := '';
for R := GRect.Top to GRect.Bottom do begin
for C := GRect.Left to GRect.Right do begin
if C = GRect.Right then     S := S + (StringGrid1.Cells[C, R])
else S := S + StringGrid1.Cells[C, R] + #9; end;     S := S + #13#10; end;
ClipBoard.AsText := S;
end;

// Wstawianie
procedure TForm1.Button2Click(Sender: TObject);
var Grect: TGridRect; S, CS, F: string; L, R, C: Byte;
begin
GRect := StringGrid1.Selection;     L := GRect.Left;     R := GRect.Top;     S := ClipBoard.AsText;     R := R - 1;
while Pos(#13, S) > 0 do begin
R := R + 1;     C := L - 1;     CS := Copy(S, 1,Pos(#13, S));
while Pos(#9, CS) > 0 do begin C := C + 1;
if (C < = StringGrid1.ColCount - 1) and (R < = StringGrid1.RowCount - 1) then
StringGrid1.Cells[C, R] := Copy(CS, 1,Pos(#9, CS) - 1);     F := Copy(CS, 1,Pos(#9, CS) - 1);
Delete(CS, 1,Pos(#9, CS)); end;
if (C < = StringGrid1.ColCount - 1) and (R < = StringGrid1.RowCount - 1) then
StringGrid1.Cells[C + 1,R] := Copy(CS, 1,Pos(#13, CS) - 1);     Delete(S, 1,Pos(#13, S));
if Copy(S, 1,1) = #10 then     Delete(S, 1,1);
end; end;

5. Zmiana koloru wybranej celi w TStringGridzie

W selektorze właściwości wybrać (klik) opcję OnDrawCell, która po uzupełnieniu powinna mieć taką postać:

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
const SelectedColor = Clblue;
begin
if (state = [gdSelected]) then     with TStringGrid(Sender), Canvas do begin
Brush.Color := SelectedColor;     FillRect(Rect);
TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Cells[aCol, aRow]);
end; end;

6. Czyszczenie wszystkich cel StringGrida z danych

{ 1. wersja }
procedure TForm1.Button1Click(Sender: TObject);
var i, k: Integer;
begin
with StringGrid1 do     for i := 0 to ColCount - 1 do     for k := 0 to RowCount - 1 do     Cells[i, k] := '';
end;

{ 2. wersja - szybsza w działaniu }
procedure TForm1.Button2Click(Sender: TObject);
var I: Integer;
begin
for I := 0 to StringGrid1.RowCount - 1 do     StringGrid1.Rows[I].Clear();
end;

7. Niszczenie kolumny w TStringGridzie

type TStringGridHack = class(TStringGrid)
public
procedure DeleteCol(ACol: Longint);
end;

var Form1: TForm1;

implementation

procedure TStringGridHack.DeleteCol(ACol: Longint);
begin
if ACol = FixedCols then if ACol = (ColCount - 1) then begin     Cols[ACol].Clear;
if ColCount(FixedCols + 1) then     ColCount := (ColCount - 1);
end else begin     Cols[ACol] := Cols[ACol + 1];     DeleteCol(ACol + 1);
end; end;

8. Zapis / Ładowanie TStringGrida do / z pliku

Zapis TStringGrid do pliku
procedure SaveStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var f: TextFile; i, k: Integer;
begin
AssignFile(f, FileName); Rewrite(f);     with StringGrid do begin     // Write number of Columns/Rows
Writeln(f, ColCount);     Writeln(f, RowCount);     // loop through cells
for i := 0 to ColCount - 1 do     for k := 0 to RowCount - 1 do     Writeln(F, Cells[i, k]);
end;     CloseFile(F);
end;

// Ładowanie TStringGrid z pliku
procedure LoadStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var f: TextFile; iTmp, i, k: Integer; strTemp: String;
begin
AssignFile(f, FileName); Reset(f);     with StringGrid do begin     // Get number of columns
Readln(f, iTmp);     ColCount := iTmp;     // Get number of rows
Readln(f, iTmp);     RowCount := iTmp;     // loop through cells i fill in values
for i := 0 to ColCount - 1 do     for k := 0 to RowCount - 1 do begin
Readln(f, strTemp);     Cells[i, k] := strTemp;
end; end;     CloseFile(f);
end;

// Zapis StringGrid1 do pliku 'c:\temp.txt':
procedure TForm1.Button1Click(Sender: TObject);
begin
SaveStringGrid(StringGrid1, 'c:\temp.txt');
end;

// Ładowanie StringGrid1 z 'c:\temp.txt':
procedure TForm1.Button2Click(Sender: TObject);
begin
LoadStringGrid(StringGrid1, 'c:\temp.txt');
end;

9. Cele StringGrida w wybranych kolorach

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var dx: Integer;
begin
with (Sender as TStringGrid) do begin     // Don't change color for first Column, first row
if (ACol = 0) or (ARow = 0) then     Canvas.Brush.Color := clBtnFace
else begin     case ACol of
1: Canvas.Font.Color := clBlack;     2: Canvas.Font.Color := clBlue; end;     // Draw the Band
if ARow mod 2 = 0 then     Canvas.Brush.Color := $00E1FFF9
else     Canvas.Brush.Color := $00FFEBDF;
Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, cells[acol, arow]);     Canvas.FrameRect(Rect);
end; end; end;

10 . Sortowanie w StringGridzie wariant z TStringsList

procedure SortStringGrid(var GenStrGrid: TStringGrid; ThatCol: Integer);
const TheSeparator = '@';     // okreslenie separatora
var CountItem, I, J, K, ThePosition: integer;     MyList: TStringList;     MyString, TempString: string;
begin     // Give the number of rows in the StringGrid
CountItem := GenStrGrid.RowCount;     //Create the List
MyList := TStringList.Create;     MyList.Sorted := False;
try begin for I := 1 to (CountItem - 1) do
MyList.Add(GenStrGrid.Rows[I].Strings[ThatCol] + TheSeparator + GenStrGrid.Rows[I].Text);
Mylist.Sort;     //Sort the List
for K := 1 to Mylist.Count do begin     //Take the String of the line (K – 1)
MyString := MyList.Strings[(K - 1)];     //Find the position of the Separator in the String
ThePosition := Pos(TheSeparator, MyString);     TempString := '';
{Eliminate the Text of the column on which we have sorted the StringGrid}
TempString := Copy(MyString, (ThePosition + 1), Length(MyString));
MyList.Strings[(K - 1)] := '';     MyList.Strings[(K - 1)] := TempString;
end;

// przeładowanie StringGrida danymi po sortowaniu
for J := 1 to (CountItem - 1) do
GenStrGrid.Rows[J].Text := MyList.Strings[(J - 1)];
end; finally     //Free the List
MyList.Free;
end; end;

procedure TForm1.Button1Click(Sender: TObject);
begin
// Sortowanie według kolumny 2 (1 bo pierwsza to 0)
SortStringGrid(StringGrid1, 1);
end;

11. Niszczenie rekordu w TStringGrid -wer. 2

procedure GridDeleteRow(RowNumber: Integer; Grid: TstringGrid);
var i: Integer;
begin
Grid.Row := RowNumber; if (Grid.Row = Grid.RowCount - 1) then { On the last row}
Grid.RowCount := Grid.RowCount - 1
else begin { Not the last row}
for i := RowNumber to Grid.RowCount - 1 do
Grid.Rows[i] := Grid.Rows[i + 1]; Grid.RowCount := Grid.RowCount - 1;
end; end;

procedure TForm1.Button1Click(Sender: TObject);
begin
GridDeleteRow(3, stringGrid1);
end;

12. Drukowanie TStringgrida

uses printers;

//StringGrid Inhalt ausdrucken
procedure PrintStringGrid(Grid: TStringGrid; Title: string; Orientation: TPrinterOrientation);
var P, I, J, YPos, XPos, HorzSize, VertSize: Integer; AnzSeiten, Seite, Zeilen, HeaderSize, FooterSize, ZeilenSize, FontHeight: Integer; mmx, mmy: Extended; Footer: string;
begin
//Kopfzeile, Fußzeile, Zeilenabstand, Schriftgröße festlegen
HeaderSize := 100; FooterSize := 200; ZeilenSize := 36; FontHeight := 36;   //Printer initializieren
Printer.Orientation := Orientation;   Printer.Title := Title;   Printer.BeginDoc;
//Druck auf mm einstellen
mmx := GetDeviceCaps(Printer.Canvas.Handle, PHYSICALWIDTH) /
GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSX) * 25.4;
mmy := GetDeviceCaps(Printer.Canvas.Handle, PHYSICALHEIGHT) /
GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY) * 25.4;

VertSize := Trunc(mmy) * 10; HorzSize := Trunc(mmx) * 10;
SetMapMode(Printer.Canvas.Handle, MM_LOMETRIC);

//Zeilenanzahl festlegen
Zeilen := (VertSize - HeaderSize - FooterSize) div ZeilenSize; //Seitenanzahl ermitteln
if Grid.RowCount mod Zeilen < > 0 then   AnzSeiten := Grid.RowCount div Zeilen + 1
else AnzSeiten := Grid.RowCount div Zeilen;
Seite := 1; //Grid Drucken
for P := 1 to AnzSeiten do begin   //Kopfzeile
Printer.Canvas.Font.Height := 48;
Printer.Canvas.TextOut((HorzSize div 2 - (Printer.Canvas.TextWidth(Title) div 2)), - 20,Title);
Printer.Canvas.Pen.Width := 5; Printer.Canvas.MoveTo(0, - HeaderSize);
Printer.Canvas.LineTo(HorzSize, - HeaderSize);   //Fußzeile
Printer.Canvas.MoveTo(0, - VertSize + FooterSize);
Printer.Canvas.LineTo(HorzSize, - VertSize + FooterSize);
Printer.Canvas.Font.Height := 36;
Footer := 'Seite: ' + IntToStr(Seite) + ' von ' + IntToStr(AnzSeiten);
Printer.Canvas.TextOut((HorzSize div 2 - (Printer.Canvas.TextWidth(Footer) div 2)), - VertSize + 150,Footer); //Zeilen drucken
Printer.Canvas.Font.Height := FontHeight;   YPos := HeaderSize + 10;
for I := 1 to Zeilen do begin
if Grid.RowCount >= I + (Seite - 1) * Zeilen then begin   XPos := 0;
for J := 0 to Grid.ColCount - 1 do begin
Printer.Canvas.TextOut(XPos, - YPos, Grid.Cells[J, I + (Seite - 1) * Zeilen - 1]); XPos := XPos + Grid.ColWidths[J] * 3; end;
YPos := YPos + ZeilenSize;   end; end;   //Seite hinzufügen
Inc(Seite);   if Seite < = AnzSeiten then Printer.NewPage; end;   Printer.EndDoc;
end;

//Przykład:
procedure TForm1.Button1Click(Sender: TObject);
begin //Drucken im Querformat
PrintStringGrid(Grid, 'StringGrid Print Landscape', poLandscape);   //Drucken im Hochformat
PrintStringGrid(Grid, 'StringGrid Print Portrait', poPortrait);
end;

13. Czy cela w Stringgridzie jest zaznaczona?

function IsCellSelected(StringGrid: TStringGrid; X, Y: Longint): Boolean;
begin
Result := False;
try     if (X > = StringGrid.Selection.Left) and (X < = StringGrid.Selection.Right) and
(Y > = StringGrid.Selection.Top) and (Y < = StringGrid.Selection.Bottom) then     Result := True;
except     end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if IsCellSelected(stringgrid1, 2, 2) then     ShowMessage('Cela (2,2) jest zaznaczona.');
end;

14. Autodopasowanie rozmiaru kolumn do tekstu

procedura tak dopasowuje szerokość kolumn aby tekst (i tylko tekst) w nich był widoczy w całości. W przykładzie ograniczono ilość rekordów do 10

type TGridHack = class(TCustomGrid);

procedure ResizeStringGrid(_Grid: TCustomGrid);
var Col, Row: integer; Grid: TGridHack; MaxWidth: integer; ColWidth: integer;
ColText: string; MaxRow: integer; ColWidths: array of integer;
begin
Grid := TGridHack(_Grid);     SetLength(ColWidths, Grid.ColCount);     MaxRow := 10;
if MaxRow > Grid.RowCount then     MaxRow := Grid.RowCount;
for Col := 0 to Grid.ColCount - 1 do begin
MaxWidth := 0;     for Row := 0 to MaxRow - 1 do begin
ColText := Grid.GetEditText(Col, Row);     ColWidth := Grid.Canvas.TextWidth(ColText);
if ColWidth > MaxWidth then     MaxWidth := ColWidth;
end;
if goVertLine in Grid.Options then     Inc(MaxWidth, Grid.GridLineWidth);
ColWidths[Col] := MaxWidth + 4;     Grid.ColWidths[Col] := ColWidths[Col];
end;     end;

15. Autodopasowanie tekstu w wybranej kolumnie StringGrida

{1. wersja}

procedure SetGridColumnWidths(Grid: TStringGrid;
const Columns: array of Integer);
{autodopasowanie - autosize podczas dwukrotnego kliku myszą na nagłówku kolumny}

procedure AutoSizeGridColumn(Grid: TStringGrid; column, min, max: Integer);
{ Set for max and min some minimal/maximial Values}
var i: Integer; temp: Integer; tempmax: Integer;
begin
tempmax := 0;     for i := 0 to (Grid.RowCount - 1) do begin
temp := Grid.Canvas.TextWidth(Grid.cells[column, i]);
if temp > tempmax then     tempmax := temp;
if tempmax > max then begin     tempmax := max;     break; end;
end; if tempmax < min then tempmax := min;     Grid.ColWidths[column] := tempmax + Grid.GridLineWidth + 3;
end;

procedure TForm1.StringGrid1DblClick(Sender: TObject);
var P: TPoint; iColumn, iRow: Longint;
begin
GetCursorPos(P);     with StringGrid1 do begin
P := ScreenToClient(P);     MouseToCell(P.X, P.Y, iColumn, iRow);
if P.Y < DefaultRowHeight then     AutoSizeGridColumn(StringGrid1, iColumn, 40, 100);
end; end;

{2. wersja }
procedure TForm1.Button1Click(Sender: TObject);
const DEFBORDER = 8;
var max, temp, i, n: Integer;
begin
with Grid do begin     Canvas.Font := Font;
for n := Low(Columns) to High(Columns) do begin
max := 0;     for i := 0 to RowCount - 1 do begin
temp := Canvas.TextWidth(Cells[Columns[n], i]) + DEFBORDER;
if temp > max then     max := temp;     end; { For }
if max > 0 then     ColWidths[Columns[n]] := max;
end;     { For }
end;     { With }
end;     {SetGridColumnWidths }

16.     Rotacja tekstu w celach StringGrida o 90°

type TForm1 = class(TForm)
StringGrid1: TStringGrid;
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
end; {...}

implementation

// wyświetla tekst pionowo w celach
procedure StringGridRotateTextOut(Grid: TStringGrid; ARow, ACol: Integer; Rect: TRect; Schriftart: string; Size: Integer; Color: TColor; Alignment: TAlignment);
var lf: TLogFont; tf: TFont;
begin     // jak są fonty za duże to autodopasowanie
if (Size > Grid.ColWidths[ACol] div 2) then     Size := Grid.ColWidths[ACol] div 2;
with Grid.Canvas do begin     // to wymieni fonty
Font.Name := Schriftart;     Font.Size := Size; Font.Color := Color; tf := TFont.Create;
try tf.Assign(Font);     GetObject(tf.Handle, SizeOf(lf), @lf);
lf.lfEscapement := 900;     lf.lfOrientation := 0; tf.Handle := CreateFontIndirect(lf);
Font.Assign(tf);
finally     tf.Free;     end; // wypełni prostokąt
FillRect(Rect); // tekstem
if Alignment = taLeftJustify then
TextRect(Rect, Rect.Left + 2, Rect.Bottom - 2, Grid.Cells[ACol, ARow]);
if Alignment = taCenter then
TextRect(Rect, Rect.Left + Grid.ColWidths[ACol] div 2 - Size + Size div 3, Rect.Bottom - 2, Grid.Cells[ACol, ARow]);
if Alignment = taRightJustify then
TextRect(Rect, Rect.Right - Size - Size div 2 - 2, Rect.Bottom - 2, Grid.Cells[ACol, ARow]);
end; end;

// 2. wariant
procedure StringGridRotateTextOut2(Grid:TStringGrid;ARow,ACol:Integer;Rect:TRect;
Schriftart:String;Size:Integer;Color:TColor;Alignment:TAlignment);
var NewFont, OldFont : Integer; FontStyle, FontItalic, FontUnderline, FontStrikeout: Integer;
begin     // if the font is to big, resize it
If (Size > Grid.ColWidths[ACol] DIV 2) Then Size := Grid.ColWidths[ACol] DIV 2;
with Grid.Canvas do begin     // Set font
If (fsBold IN Font.Style) Then FontStyle := FW_BOLD
Else FontStyle := FW_NORMAL;
If (fsItalic IN Font.Style) Then     FontItalic := 1 Else FontItalic := 0;
If (fsUnderline IN Font.Style) Then FontUnderline := 1 Else FontUnderline := 0;
If (fsStrikeOut IN Font.Style) Then FontStrikeout:=1 Else FontStrikeout:=0;
Font.Color := Color;

NewFont := CreateFont(Size, 0, 900, 0, FontStyle, FontItalic,
FontUnderline, FontStrikeout, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
DEFAULT_PITCH, PChar(Schriftart));

OldFont := SelectObject(Handle, NewFont);     // fill the rectangle
FillRect(Rect);     // Write text depending on the alignment
If Alignment = taLeftJustify Then     TextRect(Rect,Rect.Left+2,Rect.Bottom-2,Grid.Cells[ACol,ARow]);
If Alignment = taCenter Then     TextRect(Rect,Rect.Left+Grid.ColWidths[ACol] DIV 2 - Size + Size DIV 3, Rect.Bottom-2,Grid.Cells[ACol,ARow]);
If Alignment = taRightJustify Then     TextRect(Rect,Rect.Right-Size - Size DIV 2 - Rect.Bottom-2, Grid.Cells[ACol,ARow]);     // Recreate reference to the old font
SelectObject(Handle, OldFont);     // Recreate reference to the new font
DeleteObject(NewFont);
end; end;

// W metodzie OnDrawCell wpisać
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
// In the second column: Rotate Text by 90° and left align the text
if ACol = 1 then StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12,clRed, taLeftJustify); // In the third column: Center the text
if ACol = 2 then StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12, clBlue, taCenter); // In all other columns third row: right align the text
if ACol > 2 then StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12,clGreen, taRightJustify);
end;

end.

17. Jak załadować składnik ComboBox w StringGrid

//Dołączyć do formularza składnik ComboBox i StringGrid komponentu.

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
ComboBox1: TComboBox;
procedure FormCreate(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure ComboBox1Exit(Sender: TObject);
procedure StringGrid1SelectCell (Sender: TObject; Col, Row: Integer; var CanSelect: Boolean);
private { Private declarations }
public { Public declarations }
end;

varForm1: TForm1;

implementation
{$R *.DFM}

//zdarzenie OnCreate w Form
procedure TForm1.FormCreate(Sender: TObject);
begin
{Regulacja wysokości ComboBox do wysokości wiersza StringGrid}
StringGrid1.DefaultRowHeight := ComboBox1.Height;
ComboBox1.Visible := False;   { Ukrywa ComboBox}
end;

// zdarzenie OnChange ComboBox
procedure TForm1.ComboBox1Change (Sender: TObject);
begin
StringGrid1.Cells[StringGrid1.Col,StringGrid1.Row] := ComboBox1.Items[ComboBox1.ItemIndex];
ComboBox1.Visible := False;
StringGrid1.SetFocus;
end;

// to zdarzenie w OnExit ComboBox
procedure TForm1.ComboBox1Exit (Sender: TObject);
begin
StringGrid1.Cells[StringGrid1.Col,StringGrid1.Row] := ComboBox1.Items[ComboBox1.ItemIndex];
ComboBox1.Visible := False; StringGrid1.SetFocus;
end;

// zdarzenie OnSelectCell stringgrida
procedure TForm1.StringGrid1SelectCell(Sender: TObject; Col, Row: Integer; var CanSelect: Boolean);
var R: TRect;
begin
if ((Col = 3) AND (Row < > 0)) then begin
R := StringGrid1.CellRect(Col, Row);
R.Left := R.Left + StringGrid1.Left;   R.Right := R.Right + StringGrid1.Left;
R.Top := R.Top + StringGrid1.Top;   R.Bottom := R.Bottom + StringGrid1.Top;
ComboBox1.Left := R.Left + 1;   ComboBox1.Top := R.Top + 1;
ComboBox1.Width := (R.Right + 1) - R.Left;   ComboBox1.Height := (R.Bottom + 1) - R.Top;
ComboBox1.Visible := True;   ComboBox1.SetFocus;
end; CanSelect := True;
end;

18. Ustaw linie o różnej wysokości w StringGrid

procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.RowHeights[0] := 15;   StringGrid1.RowHeights[1] := 20;
StringGrid1.RowHeights[2] := 50;   StringGrid1.RowHeights[3] := 35;
end;

// Uważaj, aby nie podać nieistniejący rząd

19. Wydruk komponentu TStringGrid z tabelami.

uses printers;

procedure printgrid(sgrid: tstringgrid; stitle: string);
var   x1, x2: integer; y1, y2: integer; tmpi: integer; f: integer; tr: trect;
begin
printer.title := stitle;   printer.begindoc;
//Te ustawienia mogą być zmieniane
printer.canvas.pen.color := 0;   printer.canvas.font.name := 'times new roman';
printer.canvas.font.size := 12;   printer.canvas.font.style := [fsbold, fsunderline];
printer.canvas.textout(0, 100, printer.title);
for f := 1 to sgrid.colcount - 1 do
begin
x1 := 0;   for tmpi := 1 to (f - 1) do
x1 := x1 + 5 * (sgrid.colwidths[tmpi]);   y1 := 300;   x2 := 0;
for tmpi := 1 to f do
x2 := x2 + 5 * (sgrid.colwidths[tmpi]);   y2 := 450;   tr := rect(x1, y1, x2 - 30, y2);
printer.canvas.font.style := [fsbold];   printer.canvas.font.size := 7;
printer.canvas.textrect(tr, x1 + 50, 350, sgrid.cells[f, 0]);
printer.canvas.font.style := [];
for tmpi := 1 to sgrid.rowcount - 1 do
begin
y1 := 150 * tmpi + 300;   y2 := 150 * (tmpi + 1) + 300;
tr := rect(x1, y1, x2 - 30, y2);
printer.canvas.textrect(tr, x1 + 50, y1 + 50, sgrid.cells[f, tmpi]);
end;   end;   printer.enddoc;
end;

20. Kombinacja TMEMO i komórek TSTRINGGRID.

unit maingrid;

interface

uses windows, messages, sysutils, variants, classes, graphics, controls, forms,
dialogs, grids, extctrls, stdctrls;

type
pgridtexte = ^tgridtexte;
tgridtexte = record
msg: string;
zeit: ttime;
zeitstr: string;
end;
tstringgrid = class(grids.tstringgrid)
private
procedure wmsetcursor(var msg: twmsetcursor); message wm_setcursor;
procedure gridtextedestroy;
procedure fmemosetze;
procedure fmemoonenter(sender: tobject);
procedure fmemoonexit(sender: tobject);
procedure frownull;
function newgridtexte(t: ttime): pgridtexte;
public
fmemo: tmemo;
ftextlist: tlist;
frow, fcol: integer;
constructor create(aowner: tcomponent); override;
destructor destroy; override;
procedure gridtextecreate(max: integer);
end;

tmain = class(tform)
panelzeitbox: tpanel;
stringgrid: tstringgrid;
memo1: tmemo;
procedure formcreate(sender: tobject);
procedure stringgriddrawcell(sender: tobject; acol, arow: integer;
rect: trect; state: tgriddrawstate);
procedure formshow(sender: tobject);
private
public { public-deklarationen }
end;

var main: tmain;

implementation

uses dateutils;
{$r *.dfm}
{$i maingrid.inc}

procedure tmain.formcreate(sender: tobject);
begin
panelzeitbox.align := alright;  panelzeitbox.width := 300;
with stringgrid do
begin
parent := panelzeitbox;  defaultrowheight := panelzeitbox.height div 12;
height := panelzeitbox.height;  defaultcolwidth := 60;  rowcount := 24 * 4;
colwidths[1] := panelzeitbox.width - defaultcolwidth - 18;
gridtextecreate(rowcount);  fmemosetze;
end;  end;

procedure tmain.formshow(sender: tobject);
begin
stringgrid.fmemo.setfocus;
end;

procedure tmain.stringgriddrawcell(sender: tobject; acol, arow: integer;
rect: trect; state: tgriddrawstate);
var  s: string;  i: integer;  hour, min, sec, msec: word;
begin
with stringgrid, canvas do
begin
frownull;  if acol > 0 then
begin
s := pgridtexte(ftextlist[arow])^.msg;
drawtext(canvas.handle, pchar(s), length(s), rect, dt_wordbreak);
end else   begin
s := pgridtexte(ftextlist[arow])^.zeitstr;
decodetime(pgridtexte(ftextlist[arow])^.zeit, hour, min, sec, msec);
if min = 0 then font.style := [fsbold]
else
font.style := [];  rect.right := rect.right - 5;  rect.top := rect.top + textheight(s);
drawtext(canvas.handle, pchar(s), length(s), rect, dt_right);
end;  end;
end;

{tstringgrid-public***}
procedure tstringgrid.wmsetcursor(var msg: twmsetcursor);
begin
inherited;
fmemo.visible := true;  if fmemo.focused then exit;
fcol := col;  frow := row;  fmemosetze;  fmemo.setfocus;
end;

constructor tstringgrid.create(aowner: tcomponent);
begin
inherited create(aowner);
ftextlist := tlist.create;  fmemo := tmemo.create(self);
with fmemo do
begin
parent := self;  borderstyle := bsnone;
maxlength := 100; //sollten nur max 2 zeilen werden
color := tcolor($00c8d6dd);  onenter := fmemoonenter;  onexit := fmemoonexit
end;
fixedcols := 1;  fixedrows := 0;  fixedcolor := $00bbccd5;  color := $00bbccd5;
scrollbars := ssvertical;  borderstyle := bsnone;  options := [gohorzline];
fcol := 1;  frow := 0;  colcount := 2;
end;

destructor tstringgrid.destroy;
begin
fmemo.free;  gridtextedestroy;  inherited destroy;
end;

procedure tstringgrid.gridtextecreate(max: integer);
var  i: integer;  t: ttime;
begin
t := 0;  for i := 0 to max do
begin
ftextlist.add(newgridtexte(t));  t := incminute(t, 15); //dateutils
end;  end;

//private********
procedure tstringgrid.gridtextedestroy;
var  i: integer;
begin
for i := 0 to ftextlist.count - 1 do dispose(pgridtexte(ftextlist[i]));
ftextlist.free;
end;

procedure tstringgrid.fmemosetze;
var  r: trect;
begin
frownull;
if (fcol = 1) and (frow < rowcount) then
begin
r := cellrect(fcol, frow);  r.left := r.left + left;  r.right := r.right + left;
r.top := r.top + top;  r.bottom := r.bottom + top;
with fmemo do
begin
left := r.left - 1;  top := r.top - 1;
width := r.right - r.left;  height := r.bottom - r.top;
visible := true;  text := pgridtexte(ftextlist[frow])^.msg;
end; end;  end;

procedure tstringgrid.fmemoonenter(sender: tobject);
const  noselection: tgridrect = (left: - 1; top: - 1; right: - 1; bottom: - 1);
begin
repaint;  frownull;
fmemo.text := pgridtexte(ftextlist[frow])^.msg;
selection := noselection;
end;

procedure tstringgrid.fmemoonexit(sender: tobject);
begin
frownull;  pgridtexte(ftextlist[frow])^.msg := fmemo.text;
end;

procedure tstringgrid.frownull;
begin
if (frow < 0) or (frow > ftextlist.count - 1) then frow := 0;
end;

function tstringgrid.newgridtexte(t: ttime): pgridtexte;
begin
result := new(pgridtexte);
with result^ do
begin
msg := '';  zeit := t;  zeitstr := timetostr(t);
end;  end;

21. Przypisywanie kolorów dla każdego wiersza StringGrid, komórki wyjścia w wielu wierszach.

procedure tformhistory.listhistorydrawcell(sender: tobject; col, row: integer; rect: trect;
state: tgriddrawstate);
var   s : string;   drawrect : trect;   currentcolor : tcolor;
begin
if (sender as tstringgrid).cells[column_incoming , row ] = '1'
then currentcolor:=clblue   else currentcolor:=clmaroon;
if (sender as tstringgrid).row = row
then currentcolor := clhighlighttext ;
(sender as tstringgrid).canvas.font.color := currentcolor;
s:= (sender as tstringgrid).cells[ col, row ];
if (col = column_message ) and (row < > row_header)
then begin
if length(s) > 0 then
begin
drawrect:=rect;
drawtext((sender as tstringgrid).canvas.handle, pchar(s), length(s),
drawrect, dt_calcrect or dt_wordbreak or dt_left );
if (drawrect.bottom - drawrect.top) > (sender as tstringgrid).rowheights[row] then
(sender as tstringgrid).rowheights[row] :=(drawrect.bottom - drawrect.top)
else begin
drawrect.right:=rect.right;   (sender as tstringgrid).canvas.fillrect( drawrect );
drawtext((sender as tstringgrid).canvas.handle, pchar(s), length(s), drawrect,
dt_wordbreak or dt_left);
end;   end; end else
if row < > row_header
then (sender as tstringgrid).canvas.textout(rect.left+3, rect.top+3 , s );
end;

22. Pobranie danych przez StringGrid z pliku tekstowego.

Jest to plik tekstowy z tej treści:
data 210 372 czas 13,00
data 220 345 czas 14,50
A tak należy wykorzystać stringgird aby pobrać ten plik.

var  ... f:text; ...

procedure tform1.button1click(sender: tobject);
var s:string;  s1:string[6];  i:integer;
begin
stringgrid.cells[1,0]:='data';  stringgrid.cells[2,0]:='czas';
i:=0;  assignfile(f,'inform.txt');  reset(f);
repeat
inc(i);  readln(f,s);  delete(s,1,5);  s1:=s;
stringgrid.cells[1,i]:=s1;  delete(s,1,13);
stringgrid.cells[2,i]:=s;  stringgrid.cells[0,i]:=inttostr(i);
until eof(f);  closefile(f);
end;

const  dt = 'data';  tm = 'czas';
var  f: textfile;  s, s1: string;  i, j: integer;
begin
if fileexists('test.txt') then
begin
assignfile(f, 'test.txt');  reset(f);  j:=1;
while not eof(f) do
begin
readln(f, s);  s:=s+' ';  i:=pos(dt, s);
if i = 0 then begin closefile(f); exit end;  // nieprawidłowy ciąg
delete(s, 1, i+length(dt)); while s[1] = ' ' do delete(s,1,1);  i:=pos(tm, s);  stringgrid1.cells[1, j]:=copy(s, 1, i-1);
i:=pos(tm, s);  delete(s, 1, i+length(tm));
while s[1]=' ' do
delete(s, 1, 1);  stringgrid1.cells[2, j]:=s;  inc(j)
end;  closefile(f)
end;

23. Zmiana czcionki dla poszczególnych komórek StringGrid.

w zdarzeniu ondrawcell stringgrida, który tu ma nazwę mygrid.
Oto przykład zmiany czcionki w drugiej kolumnie w Courier New.

procedure tform1.mygriddrawcell(sender: tobject; acol, arow: integer;
rect: trect; state: tgriddrawstate);
var  oldname: string;
begin
oldname:=mygrid.canvas.font.name;
if (acol=2) then
mygrid.canvas.font.name:='courier new';
mygrid.canvas.textrect(rect, rect.left+2, rect.top+2, mygrid.cells[acol, arow]);
mygrid.canvas.font.name:=oldname;
end;

24. StringGrid w stylu Exel (bez obcinania tekstu, jeśli nie mieszczą się w celi)

procedure tform1.stringgrid1drawcell(sender: tobject; acol, arow: integer;
rect: trect; state: tgriddrawstate);
var   i, x, y: integer;
begin
if gdfixed in state then exit;
if arow > 1 then exit;   {rysuj 1 wiersz z celą 1,1 obejmujący cały tekst}
with sender as tstringgrid do
begin {rozszerz siatkę w prawo o ile nie jest cela ostatnią w wierszu}
if acol < pred(colcount) then
rect.right := rect.right + gridlinewidth;
{gdzie tekst pierwszej celi w stosunku do cel aktualnego prostokąta}
y := rect.top + 2;  x := rect.left + 2;
for i:= 1 to acol - 1 do
x := x - colwidths[i] - gridlinewidth;  {cela koloru żółtego}
canvas.brush.color := $7fffff;  canvas.brush.style := bssolid;
canvas.fillrect( rect ); {wypełnienie tekstem celi 1,1}
canvas.textrect( rect, x, y, cells[1, 1] );
end;  end;

procedure tform1.formcreate(sender: tobject);
var   i, k: integer;
begin
with stringgrid1 do
begin
cells[1, 1] := 'przykładowy, dość długi wiersz, który sięga poza celę';
for i:= 1 to colcount-1 do
for k:= 2 to rowcount -1 do
cells[i,k] := format( 'cell[%d, %d]', [i, k]);
end;  end;

25. Kilka przykładów komponentu TStringGrid i TDrawGrid.

25_1. Stringgrid bez zaznaczonej komórki! Autor: Jeff Fisher

Trzeba utworzyć zdarzenie ondrawcell. Oto kod:
procedure tform.sgrdrawcells(sender: tobject; col, row: longint; rect: trect; state: tgriddrawstate);
var  acol: longint absolute col;  arow: longint absolute row;  buf: array[byte] of char;
begin
if state = gdfixed then  exit;
with sgrgrid do
begin
canvas.font := font;  canvas.font.color := clwindowtext;  canvas.brush.color := clwindow;
canvas.fillrect(rect);  strpcopy(buf, cells[acol, arow]);
drawtext(canvas.handle, buf, -1, rect, dt_singleline or dt_vcenter or dt_noclip or dt_left);
end;  end;

25_2. Stringgrid jak dbgrid

table.first;
row := 0;
grid.rowcount := table.recordcount;
while not table.eof do
begin
for i := 0 to table.fieldcount-1 do
grid.cells[i,row] := table.fields[i].asstring;
inc (row);  table.next;
end;

Poniżej kod, ładuje dane z tabeli. Działa bardzo szybko, nawet jeśli z pliku pobrano setki kolumn.

procedure tformlookupdb.fillcells;
var  row, i: integer;  w: integer;  grid: tstringgrid;
begin
dogrid.rowcount := 0;  if not assigned(fdb) then  exit;
row := 0;
for i := low(fcolwidths) to high(fcolwidths) do
fcolwidths[i] := 100
/ / poniżej tymczasowy grid służy do ochrony przed dużym naborem danych w ramach procesu
application.processmessages,
/ / dane wprowadzane do grida w inny sposób powodują migotanie tego obiektu
/ / Potem dopiero następuje ładowanie, poczynając od góry, do obiektu Dogrid.
grid := tstringgrid.create(self);  grid.visible := false;
with fdb do
try
grid.colcount := ffields.count;  disablecontrols;
//Filtr został ustawiony za pomocą właściwości self.filter
first;
while not eof do
try
grid.rowcount := row + 1;  for i := 0 to grid.colcount - 1 do
begin
grid.cells[i, row] :=fieldbyname(ffields.strings[i]).asstring
w := dogrid.canvas.textwidth(grid.cells[i, row]);
if fcolwidths[i] < w then  fcolwidths[i] := w;
end  inc(row);
finally  next;  end
finally  dogrid.rowcount := grid.rowcount;  dogrid.colcount := grid.colcount;
for i := 0 to grid.colcount - 1 do
begin
dogrid.cols[i] := grid.cols[i];  dogrid.colwidths[i] := fcolwidths[i] + 4
end
grid.free;  enablecontrols  end
end;

25_3. Zmiana ENTEREM kolumny stringgrida.

Kod poniżej przeprowadza kursor do następnej kolumny. Przy kolumnie ostatniej kursor przechodzi do następnego wiersza. Kiedy dojdziesz do końca grida to zostaniesz przeniesiony do jego początku. Oczywiście, można zmienić to zachowanie, i ustanowić inny tryb.

procedure tform1.stringgrid1keypress(sender: tobject; var key: char);
begin
if key = #13 then
with stringgrid1 do
if col < colcount - 1 then   {aktualna kolumna!}
col := col + 1  else if row < rowcount - 1 then
begin   {następna kolumna!}
row := row + 1;  col := 1;  end
else begin   {koniec siatki więc na początek!}
row := 1;  col := 1;
{lub.... tu można przekazać sterowanie do innego elementu}
end; end;

25_4. TStringgrid i strumienie TFilestream.

Taki zapis jest najlepszy, szczególnie przy dużych TStringgridach.

var: mystream: tfilestream;
begin
mystream1 := tfilestream.create('grid1.sav', fmcreate);
mystream1.writecomponent(stringgrid1);
mystream1.destroy;
end;

A dla odczytu:
mystream := tfilestream.create('grid1.sav', fmopenread);
stringgrid1 := mystream1.readcomponent(stringgrid1) as tstringgrid;

25_5. TStringgrid z fokusem (ondrawcell)

procedure tform1.drawcell(sender: tobject; col: longint; row: longint; rect: trect; state: tgriddrawstate);
var  lrow, lcol: longint;  s: string;
begin
lrow := row;  lcol := col;
with sender as tstringgrid, canvas do
begin
if (gdselected in state) then
begin
brush.color := clhighlight; { *** }
end else
if (lrow < fixedrows) or (lcol > fixedcols) then
begin
brush.color := fixedcolor;
end else begin
brush.color := color;
end;
fillrect(rect);  setbkmode(handle, transparent);
textout(rect.left + 2, rect.top + 2, cells[lcol, lrow]);
end; end;

Łańcuch z komentarzem {***} w tym kontekście jest sprawą kluczową. On "mówi", że jeśli my edytujemy celę, która ma focus to następuje zmiana podświetlenia. Wtedy może być problem z widocznością liter; trzeba dobrać zawczasu odpowiedni ich kolor albo własciwość tstringgrid defaultdrawing ustawić na True.

26. AutoSize kolumn dla TStringgrid - autor neil j.rubenking

Ten problem należy rozwiązać programowo. Robić to należy po pobraniu danych lub jeżeli pobiera dane w kolumnach, załadować je w pętli poniżej:

var   i, j, temp, max: integer;
begin
for i := 0 to grid.colcount - 1 do begin
max := 0;
for j := 0 to grid.rowcount - 1 do begin
temp := grid.canvas.textwidth(grid.cells[i, j]);
if temp > max then  max := temp;
end;
grid.colwidths[i] := max + grid.gridlinewidth + 1;
end; end;

27. AutoSize szerokości kolumn tstringgrid z marginesem.

Aby cały tekst w kolumnie był widoczny i nie dotykał do ramki (z zapasem).

procedure tform1.stringgrid1selectcell(sender: tobject; vcol, vrow: longint; var canselect: boolean);
var  wid: integer;
begin
with sender as tstringgrid do
begin
wid := canvas.textwidth(cells[col, row] + ' ');
if wid > colwidths[col] then  colwidths[col] := wid;
end; end;

procedure tform1.stringgrid1keypress(sender: tobject; var key: char);
var  wid: integer;
begin
if key = #13 then
with sender as tstringgrid do
begin
wid := canvas.textwidth(cells[col, row] + ' ');
if wid > colwidths[col] then  colwidths[col] := wid;
end; end;

Należy pamiętać, aby w zdarzeniu onselectcell parametry col i row przemianować np na vcol i vrow, aby uniknąć nieporozumień z właściwości stringgrid, o tej samej nazwie.

28. AutoSize w stringgrid z dopasowaniem szerokości kolumny do najdłuższej linii tekstu.

Stringgrid domyślnie ustawia wszystkie kolumny tej samej szerokości - w niektórych tekst komórki zostanie obcięty. Aby tego uniknąć, po wypełnieniu stringgrida potrzeba dla każdej kolumny tekstu znaleźć odpowiednią szerokość kolumny.

var   x, y, w: integer;   s: string;   maxwidth: integer;
begin
with stringgrid1 do  clientheight := defaultrowheight * rowcount + 5;
with stringgrid1 do begin
for x := 0 to colcount - 1 do begin  maxwidth := 0;
for y := 0 to rowcount - 1 do begin  w := canvas.textwidth(cells[x,y]);
if w > maxwidth then  maxwidth := w;
end;  colwidths[x] := maxwidth + 5;
end; end; end;

29. Wstawianie i usuwanie wierszy w stringgrid - autor: Dennis Passmore.

Przy usuwaniu wierszy i kolumn sprawdzać i usuwać tylko obiekty uprzednio zaznaczone.

unit gridfunc;

interface

uses sysutils, winprocs, grids;

procedure insertrow(sender: tstringgrid; toindex: longint);
procedure deleterow(sender: tstringgrid; fromindex: longint);
procedure insertcolumn(sender: tstringgrid; toindex: longint);
procedure deletecolumn(sender: tstringgrid; fromindex: longint);

implementation

type
tcsgrid = class(tstringgrid)
private
public
procedure moverow(fromindex, toindex: longint);
procedure movecolumn(fromindex, toindex: longint);
end;

procedure tcsgrid.moverow(fromindex, toindex: longint);
begin
rowmoved(fromindex, toindex);   { usuwa od wiersza do wiersza }
end;

procedure tcsgrid.movecolumn(fromindex, toindex: longint);
begin
columnmoved(fromindex, toindex);   { przenosi kolumny od do.. }
end;

procedure insertrow(sender: tstringgrid; toindex: longint);
var  xx, yy: integer;
begin
if toindex >= 0 then  with tcsgrid(sender) do
if (toindex < = rowcount) then begin
rowcount := rowcount + 1;  xx := rowcount - 1;
for yy := 0 to colcount - 1 do
begin
cells[yy, xx] := ' ';  objects[yy, xx] := nil;
end;
if toindex < rowcount - 1 then  moverow(rowcount - 1, toindex);
end else
messagebeep(0)
else
messagebeep(0);
end;

procedure deleterow(sender: tstringgrid; fromindex: longint);
begin
if fromindex > = 0 then  with tcsgrid(sender) do
if (rowcount > 0) and (fromindex < rowcount) then
begin
if (fromindex < rowcount - 1) then  moverow(fromindex, rowcount - 1);
rows[rowcount - 1].clear;  rowcount := rowcount - 1;
end else
messagebeep(0)
else
messagebeep(0);
end;
procedure insertcolumn(sender: tstringgrid; toindex: longint);
var  xx, yy: integer;
begin
if toindex >= 0 then  with tcsgrid(sender) do
if (toindex <= colcount) then
begin
colcount := colcount + 1;  xx := colcount - 1;  cols[xx].beginupdate;
for yy := 0 to rowcount - 1 do
begin
cells[xx, yy] := ' ';  objects[xx, yy] := nil;  end;  cols[xx].endupdate;
if toindex < colcount - 1 then  movecolumn(colcount - 1, toindex);
end else
messagebeep(0)
else
messagebeep(0);
end;

procedure deletecolumn(sender: tstringgrid; fromindex: longint);
begin
if fromindex >= 0 then
with tcsgrid(sender) do
if (colcount > 0) and (fromindex < colcount) then
begin
if (fromindex < colcount - 1) then  movecolumn(fromindex, colcount - 1);
cols[colcount - 1].clear;  colcount := colcount - 1; end else
messagebeep(0)
else
messagebeep(0);
end;

end.

30. Wyrównanie kolumn stringgrid

Z wykorzystaniem zdarzenia ondrawcell stringgrida:

procedure tform1.stringgrid1drawcell(sender: tobject; col, row: longint;
rect: trect; state: tgriddrawstate);
var  txt: array[0..255] of char;
begin
strpcopy(txt, stringgrid1.cells[col, row]);  settextalign(stringgrid1.canvas.handle,
gettextalign(stringgrid1.canvas.handle)  and not (ta_left or ta_center) or ta_right);
exttextout(stringgrid1.canvas.handle, rect.right - 2, rect.top + 2,
eto_clipped or eto_opaque, @rect, txt, strlen(txt), nil);
end;


Wersja 2 - Wyrównanie kolumn stringgrida do prawej strony

procedure tform1.stringgrid1drawcell(sender: tobject; col, row: longint; rect: trect; state: tgriddrawstate);
var  lrow, lcol: longint;
begin
lrow := row;  lcol := col;
with sender as tstringgrid, canvas do
begin
if (gdselected in state) then begin  brush.color := clhighlight;
end else
if (gdfixed in state) then begin
brush.color := fixedcolor;
end else begin
brush.color := color;
end;
fillrect(rect);  setbkmode(handle, transparent);
settextalign(handle, ta_right);
textout(rect.right - 2, rect.top + 2, cells[lcol, lrow]);
end; end;


Wersja 3- wyrównanie kolumn stringgrida

procedure writetext(acanvas: tcanvas; const arect: trect; dx, dy: integer;
const text: string; format: word);
var  s: array[0..255] of char;  b, r: trect;
begin
with acanvas, arect do begin
case format of
dt_left: exttextout(handle, left + dx, top + dy, eto_opaque or
eto_clipped, @arect, strpcopy(s, text), length(text), nil);

dt_right: exttextout(handle, right - textwidth(text) - 3, top + dy, eto_opaque or
eto_clipped, @arect, strpcopy(s, text), length(text), nil);

dt_center: exttextout(handle, left + (right - left - textwidth(text)) div 2, top + dy, eto_opaque or
eto_clipped, @arect, strpcopy(s, text), length(text), nil);
end; end;
end;

procedure tbefstringgrid.drawcell(col, row: longint; rect: trect; state: tgriddrawstate);
var
procedure display(const s: string; alignment: talignment);
const  formats: array[talignment] of word = (dt_left, dt_right, dt_center);
begin
writetext(canvas, rect, 2, 2, s, formats[alignment]);
end;
begin
{ tutaj wybór wierszy i kolumn oraz formatowanie }
case row of
0: { tu centrowanie nagłówków kolumn }
if (col < colcount) then  display(cells[col, row], tacenter)
else    { reszta ...do prawego }
display(cells[col, row], taright);
end; end;


Wersja 4 - wyrównywanie kolumn stringgrida

Poniżej stworzona własna metoda drawcell:

procedure tsearchfrm.grid1drawcell(sender: tobject; col, row: longint; rect: trect; state: tgriddrawstate);
var  l_oldalign: word;
begin
if (row = 0) or (col < 2) then  {nagłówek będzie pogrubiony}
grid1.canvas.font.style := grid1.canvas.font.style + [fsbold];
if col < > 1 then
begin
l_oldalign := settextalign(grid1.canvas.handle, ta_right);
{tekst rysuj po prawej stronie}
grid1.canvas.textrect(rect, rect.right - 2, rect.top + 2, grid1.cells[col, row]);
settextalign(grid1.canvas.handle, l_oldalign);
end else begin
grid1.canvas.textrect(rect, rect.left + 2, rect.top + 2, grid1.cells[col, row]);
end;
grid1.canvas.font.style := grid1.canvas.font.style - [fsbold];
end;

31. Jak usunąć wybraną pozycję z tstringgrid

procedure tform1.button3click(sender: tobject);
var  i,j: integer;
begin
j:=sg1.row;  // według wybranego wiersza
sg1.rows[j].clear;
for i:=j to sg1.rowcount-2 do
sg1.rows[i].assign(sg1.rows[i+1]);  sg1.rowcount:=sg1.rowcount-1;
end;

32. Komponent TWrapgrid, wykonujący zawijanie tekstu w celach TStringgrid.

Podczas używania nie zapomnij o rowheights (lub defaultrowheight), bowiem tekst zajmie nawet wiele wierszy. Do używania zapisać go pod nazwą "wrapgrid.pas" i zainstaluj go w Delphi by potem używać go zamiast standardowego TStringgrid. Autor luis j. de la Rosa.

unit wrapgrid;

interface

uses sysutils, wintypes, winprocs, messages, classes, graphics, controls, forms, dialogs, grids;

type
twrapgrid = class(tstringgrid)
private { private declarations }
protected { protected declarations }
{ Procedura drawcell wykonuje zawijanie tekstu w celi }
procedure drawcell(acol, arow: longint; arect: trect; astate: tgriddrawstate); override;
public { public declarations }
constructor create(aowner: tcomponent); override;
published { published declarations }
end;

procedure register;

implementation

constructor twrapgrid.create(aowner: tcomponent);
begin
{ tworzymy tstringgrid }
inherited create(aowner);
defaultdrawing := false;
end;

{ procedura drawcell wykonuje zawijanie tekstu w celi }
procedure twrapgrid.drawcell(acol, arow: longint; arect: trect; astate: tgriddrawstate);
var
sentence, { wyprowadzany tekst }
curword: string; { bieżące słowo }
spacepos, { pozycja pierwszego miejsca }
curx, { współrzędna X kursora }
cury: integer; { współrzędna Y kursora }
endofsentence: boolean; { początek wypełniania cel }
begin
{ inicjacja czcionki }
canvas.font := font;
with canvas do begin
{ jeżeli to cela fixed to taki kolot tła i pena }
if gdfixed in astate then begin
pen.color := fixedcolor;
brush.color := fixedcolor;
end else begin   { w przeciwnym razie takie kolory }
pen.color := color;  brush.color := color;
end;
rectangle(arect.left, arect.top, arect.right, arect.bottom); { kolor tła celi }
end;
curx := arect.left;  cury := arect.top; { rozpoczynamy rysowanie od lewej, górnej }
sentence := cells[acol, arow]; { tu jest zawartość celi }
endofsentence := false; { dla każdego słowa celi }
while (not endofsentence) do
begin
spacepos := pos(' ', sentence); { szukaj takie słowo}
if spacepos > 0 then
begin
curword := copy(sentence, 0, spacepos); { otrzymujemy aktualne słowo plus spacja }
{ niżej otrzymujemy pozostałą część zdania }
sentence := copy(sentence, spacepos + 1, length(sentence) - spacepos);
end else begin
{ to ostatnie słowo w zdaniu }
endofsentence := true;  curword := sentence;
end;

with canvas do
begin
{ jeżeli tekst wychodzi poza granicę celi }
if (textwidth(curword) + curx) > arect.right then
begin
{ przenosimy go na następną linię }
cury := cury + textheight(curword);  curx := arect.left;
end;

{ wyprowadzamy słowo }
textout(curx, cury, curword);
{ zwiększamy x-koordynaty kursora }
curx := curx + textwidth(curword);
end; end; end;

procedure register;
begin
{ można go instalować gdzie indziej w delphi }
registercomponents('samples', [twrapgrid]);
end;

end.

33. Manipulacja słowami w tstringgrid

procedure tform1.stringgrid1keypress(sender: tobject; var key: char);
var   s: string;  c: byte;
begin
with stringgrid1 do
s := cells[col, row];  if length(s) = 0 then
begin
if key in ['a'..'z'] then begin
c := ord(key) - 32;  key := chr(c);  end;  exit;
end;
if s[length(s)] = ' ' then
if key in ['a'..'z'] then begin
c := ord(key) - 32;  key := chr(c);
end; end;

// W zakresie obsługi zdarzenia onkeypress wpisz:
if length(field.text) = 0 then key := upcase (key);

34. Tekst w celi stringgrid jeśli nie mieści się w następnej celi.

Najpierw trzeba użyc do obsługi zdarzenia ondrawcell TStringgrida:

procedure tform1.stringgrid1drawcell(sender: tobject; acol, arow: integer;
rect: trect; state: tgriddrawstate);
var  i, x, y: integer;
begin
if gdfixed in state then  exit;
if arow > 1 then  exit;
{draw row 1 with text from cell 1,1 spanning all cells in the row}
with sender as tstringgrid do
begin
if acol < pred(colcount) then
rect.right := rect.right + gridlinewidth;
{figure out where the text of the first cell would start relative to the current cells rect}
y := rect.top + 2;  x := rect.left + 2;
for i:= 1 to acol - 1 do
x := x - colwidths[i] - gridlinewidth;  {paint cell pale yellow}
canvas.brush.color := $7fffff;  canvas.brush.style := bssolid;
canvas.fillrect( rect );  {paint text of cell 1,1 clipped to current cell}
canvas.textrect( rect, x, y, cells[1, 1] );
end; end;

// tworzymy okno z długim tekstem
procedure tform1.formcreate(sender: tobject);
var  i, k: integer;
begin
with stringgrid1 do
begin
cells[1, 1] := 'dość długi wiersz, który będzie łączyć cele';
for i:= 1 to colcount-1 do  for k:= 2 to rowcount -1 do
cells[i,k] := format( 'cell[%d, %d]', [i, k]);
end; end;

35. Focus celi TStringgrida.

procedure setgridfocus(sgrid: tstringgrid; r, c: integer);
var  srect: tgridrect;
begin
with sgrid do begin
setfocus;  {nadajemy focus siatce}
row := r;   {ustawiamy row/col}
col := c;
srect.top := r; {określamy wybrany obszar}
srect.left := c;  srect.bottom := r;  srect.right := c;
selection := srect; {ustanawiamy wybór}
end; end;

Dla wywołania procedury wpisz: setgridfocus(stringgrid1, 10, 2);

36. Kolor nieaktywnych komórek stringgrida.

Po kliknięciu na dowolną celę stringgrida, poprzednio zaznaczona cela przyjmuje kolor niebieski ...

procedure tform1.stringgrid3drawcell(sender: tobject; vcol, vrow: longint;
rect: trect; state: tgriddrawstate);
begin
if sender = activecontrol then  exit;
if not (gdselected in state) then exit;
with sender as tstringgrid do begin
canvas.brush.color := color;  canvas.font.color := font.color;
canvas.textrect(rect, rect.left + 2, rect.top + 2, cells[vcol, vrow]);
end; end;

Należy pamiętać, by w obsłudze zdarzeń w ondrawcell przemianować parametr col i row na vcol i vrow, aby uniknąć konfliktu z właściwościami stringgrida.