FAQ DelphiConsultez toutes les FAQ

1
2
3
4
5
6
7
8
procedure RemoveLine(AStringGrid: TStringGrid; ALine: Integer); 
var 
  i: Integer; 
begin 
  for i := ALine to AStringGrid.RowCount - 2 do 
    AStringGrid.Rows[i] := AStringGrid.Rows[i + 1]; 
  AStringGrid.RowCount := AStringGrid.RowCount - 1; 
end;

RemoveLine(MaStringGrid,2);

1
2
3
4
5
6
7
8
9
10
type TPublicStringGrid = class(TCustomGrid);  
...  
procedure TForm1.Button1Click(Sender: TObject);  
begin  
  //supprime la ligne n°2 (donc la troisième ligne, la première étant la ligne n°0) :  
  TPublicStringGrid(StringGrid1).DeleteRow(2);  
  
  //Supprime la deuxième colonne (colonne n°1) :  
  TPublicStringGrid(StringGrid1).DeleteColumn(1);  
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; 
  Rect: TRect; State: TGridDrawState); 
begin 
  With Sender As TStringGrid Do With Canvas Do 
  Begin 
    { Sélection de la couleur de fond } 
    If gdFixed in State 
      Then Brush.Color := clBtnFace 
      Else If gdSelected In State 
Then Brush.Color := clNavy 
Else Brush.Color := clWhite; 
  
    { Dessin du fond } 
    FillRect(Rect); 
  
    { Sélection de la couleur de texte } 
    If gdSelected In State Then 
      SetTextColor(Canvas.Handle,clWhite) 
    Else SetTextColor(Canvas.Handle,clBlack); 
  
    { Dessin du texte en utilisant la fonction API } 
    DrawText(Canvas.Handle, PChar(Cells[ACol,ARow]), -1, Rect , 
      DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE  ); 
  End; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; 
  Rect: TRect; State: TGridDrawState); 
begin 
  With Sender As TStringGrid Do With Canvas Do 
  Begin 
    { Sélection de la couleur de fond } 
    If gdFixed in State Then 
      Brush.Color := clBtnFace 
    Else If gdSelected In State Then 
    Brush.Color := clNavy 
  Else Brush.Color := clWhite; 
  
    { Dessin du fond } 
    FillRect(Rect); 
  
    { Sélection de la couleur de texte } 
    If gdSelected In State Then 
      SetTextColor(Canvas.Handle,clWhite) 
    Else SetTextColor(Canvas.Handle,clBlack); 
  
    { Dessin du texte en utilisant la fonction API } 
    DrawText(Canvas.Handle, PChar(Cells[ACol,ARow]), -1, Rect , 
      DT_CENTER or DT_NOPREFIX or DT_WORDBREAK ); 
  End; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; 
  Rect: TRect; State: TGridDrawState); 
begin 
  With Sender As TStringGrid Do With Canvas Do 
  Begin 
    { sélection de la couleur de fond } 
    If gdFixed in State 
      Then Brush.Color := clBtnFace 
      Else If gdSelected In State 
Then Brush.Color := clNavy 
Else If Odd(ARow) 
  Then Brush.Color := $FFE0FF 
  Else Brush.Color := $FFFFE0; 
    { Dessin du fond } 
    FillRect(Rect); 
    { Sélection de la couleur d'écriture } 
    If gdSelected In State 
      Then Font.Color:=clWhite 
      Else Font.Color:=clBlack; 
    { Dessin du texte } 
    TextOut(Rect.Left,Rect.Top,Cells[ACol,ARow]); 
  End; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; 
  Rect: TRect; State: TGridDrawState); 
Var i,j,x,y:Integer; 
  R:TRect; 
begin 
  With Sender As TStringGrid Do With Canvas Do 
  Begin 
    If gdFixed in State Then 
    Begin 
      { Les cellules fixes sont toujours dessinées en gris } 
      Brush.Color := clBtnFace; 
      Brush.Style := bsSolid; 
      FillRect(Rect); 
    End 
    Else 
    Begin 
      If gdSelected In State Then 
      Begin 
{ Les cellules sélectionnées sont en bleue } 
Brush.Color := clNavy; 
Brush.Style := bsSolid; 
FillRect(Rect); 
      End 
      Else 
      Begin 
{ Recherche de la zone image à copier pour tenir compte des décalages } 
{ de la grille en fonction des barres de défilement. } 
X:=0; For i:=FixedCols+1 To ACol Do Inc(x,ColWidths [i]); 
Y:=0; For i:=FixedRows+1 To ARow Do Inc(Y,RowHeights[i]); 
R.Left   :=X; 
R.Right  :=X+Rect.Right-Rect.Left; 
R.Top    :=Y; 
R.Bottom :=Y+Rect.Bottom-Rect.Top; 
{ Dessin d'une partie de l'image } 
CopyRect(Rect,MonBitmap.Canvas,R); 
Brush.Style := bsClear; 
      End; 
    End; 
  
    { Sélection de la couleur de texte } 
    If gdSelected In State Then 
      SetTextColor(Canvas.Handle,clWhite) 
    Else SetTextColor(Canvas.Handle,clBlack); 
  
    { Dessin du texte en utilisant la fonction API } 
    DrawText(Canvas.Handle, PChar(Cells[ACol,ARow]), -1, Rect ,DT_NOPREFIX ); 
  End; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
procedure XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word; 
  const AValue: string); 
var 
  L: Word; 
const 
  {$J+} 
  CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0); 
  {$J-}  
begin 
  L := Length(AValue); 
  CXlsLabel[1] := 8 + L; 
  CXlsLabel[2] := ARow; 
  CXlsLabel[3] := ACol; 
  CXlsLabel[5] := L; 
  XlsStream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel)); 
  XlsStream.WriteBuffer(Pointer(AValue)^, L); 
end; 
  
  
function SaveAsExcelFile(AGrid: TStringGrid; AFileName: string): Boolean; 
const 
  {$J+} CXlsBof: array[0..5] of Word = ($809, 8, 00, $10, 0, 0); {$J-} 
  CXlsEof: array[0..1] of Word = ($0A, 00); 
var 
  FStream: TFileStream; 
  I, J: Integer; 
begin 
  FStream := TFileStream.Create(PChar(AFileName), fmCreate or fmOpenWrite); 
  try  
    CXlsBof[4] := 0; 
    FStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof)); 
    for i := 0 to AGrid.ColCount - 1 do 
      for j := 0 to AGrid.RowCount - 1 do  
        XlsWriteCellLabel(FStream, I, J, AGrid.cells[i, j]); 
    FStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));  
    Result := True; 
  finally 
    FStream.Free; 
  end; 
end;

SaveAsExcelFile(StringGrid1,'c:\testxls.xls');

1
2
3
4
5
6
procedure TForm1.StringGrid1KeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin 
  if Key = VK_RETURN then 
    StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row] := StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row] + sLineBreak; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; 
  Rect: TRect; State: TGridDrawState); 
begin 
  with Sender as TStringGrid do with Canvas do 
  begin 
    { Sélection de la couleur de fond } 
    if gdFixed in State then 
      Brush.Color := clBtnFace 
    else if gdSelected in State then 
            Brush.Color := clNavy 
          else Brush.Color := clWhite; 
  
    { Dessin du fond } 
    FillRect(Rect); 
  
    { Sélection de la couleur de texte } 
    if gdSelected in State then 
      SetTextColor(Canvas.Handle,clWhite) 
    else SetTextColor(Canvas.Handle,clBlack); 
  
    { Dessin du texte en utilisant la fonction API } 
    DrawText(Canvas.Handle, PChar(Cells[ACol,ARow]), -1, Rect ,DT_NOPREFIX or DT_WORDBREAK ); 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
procedure TForm1.Button1Click(Sender: TObject);  
  
  //On parcours les contrôles enfants de la grille à la recherche du TInplaceEdit  
  function GetInPlaceEdit(ACustomGrid: TCustomGrid): TInplaceEdit;  
  var  
    i: integer;  
  begin  
    for i:=0 to ACustomGrid.ControlCount-1 do  
      if ACustomGrid.Controls[i] is TInplaceEdit then  
      begin  
        result:= TInplaceEdit(ACustomGrid.Controls[i]);  
        exit;  
      end;  
    result:= nil;  
  end;  
  
var  
  myRect: TGridRect;  
  ed: TInplaceEdit;  
begin  
  // Sélection de la cellule  
  myRect.Left := 1;  
  myRect.Top := 2;  
  myRect.Right := 1;  
  myRect.Bottom := 2;  
  sg.Selection := myRect;  
  
  // Donner le focus à la grille  
  ActiveControl:= sg;  
  
  // Passer la grille en mode édition  
  sg.EditorMode:= true;  
  
  // Récupérer l'éditeur  
  ed:= GetInPlaceEdit(sg);  
  // Et en faire quelque chose  
  // dans ce cas sélectionner le texte contenu dans la cellule  
  if ed <> nil then  
  begin  
    ed.SelStart:= 0;  
    ed.SelLength:= ed.GetTextLen;  
  end;  
end;

1
2
3
4
5
6
7
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,  
  ARow: Integer; var CanSelect: Boolean);  
begin  
  if (ARow=1)   //Condition à remplir pour interdire l'édition de la cellule  
  then StringGrid1.Options:=StringGrid1.Options-[goEditing] //désactive l'édition  
  else StringGrid1.Options:=StringGrid1.Options+[goEditing]; //active l'édition  
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
(* Sauver un TStringGrid dans un fichier *) 
procedure SaveStringGrid(StringGrid: TStringGrid; const FileName: TFileName); 
var f:    TextFile; 
    i, k: Integer; 
begin 
  AssignFile(f, FileName); 
  Rewrite(f); 
  with StringGrid do 
  begin 
    // Ecrire le nombre de Colonnes/lignes 
    Writeln(f, ColCount); 
    Writeln(f, RowCount); 
    // Boucler sur les cellules 
    for i := 0 to ColCount - 1 do 
      for k := 0 to RowCount - 1 do 
        Writeln(F, Cells[i, k]); 
  end; 
  CloseFile(F); 
end; 
  
// Charger un TStringGrid depuis un fichier 
// Attention, il faut tester l'existence du fichier avant d'utiliser cette procédure 
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 
    // Obtenir le nombre de colonnes 
    Readln(f, iTmp); 
    ColCount := iTmp; 
    // et de lignes 
    Readln(f, iTmp); 
    RowCount := iTmp; 
    // remplir les cellules 
    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;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
//écrire une chaîne de caractères depuis le flux 
procedure WriteStreamString(Stream : TStream; UneChaine : string); 
var LongueurChaine : integer; 
begin 
  //obtenir la longueur de la chaîne de caractères 
  LongueurChaine := Length(UneChaine); 
  //écrire cette longueur dans le flux 
  Stream.Write(LongueurChaine,SizeOf(integer)); 
  //écrire les caractères 
  Stream.Write(UneChaine[1], LongueurChaine); 
end; 
  
//retourne une chaîne de caractères depuis le flux 
function ReadStreamString(Stream : TStream) : string; 
var LongueurChaine : integer; 
begin 
  //obtenir la longueur de la chaîne de caractères 
  Stream.Read(LongueurChaine,SizeOf(integer)); 
  //Redimensionner la chaine pour allouer la mémoire nécessaire 
  SetLength(Result, LongueurChaine); 
  //Lire les caractères 
  Stream.Read(Result[1], LongueurChaine); 
end; 
  
// Sauver un TStringGrid dans un fichier 
procedure SaveStringGrid(StringGrid: TStringGrid; const FileName: TFileName); 
var f:TFileStream; 
    i, k ,cc, rr: Integer; 
begin 
  if FileExists(FileName) 
  then f:=TFileStream.Create(FileName,fmOpenWrite) 
  else f:=TFileStream.Create(FileName,fmCreate); 
  try 
    with StringGrid do 
    begin 
      cc:=ColCount; 
      rr:=RowCount; 
      // Ecrire le nombre de Colonnes/lignes 
      f.Write(cc,SizeOf(integer)); 
      f.Write(rr,SizeOf(integer)); 
      // Boucler sur les cellules 
      for i := 0 to ColCount - 1 do 
        for k := 0 to RowCount - 1 do 
          WriteStreamString(F,Cells[i, k]); 
    end; 
  finally 
     F.Free; 
  end; 
end; 
  
// Charger un TStringGrid depuis un fichier 
function LoadStringGrid(StringGrid: TStringGrid; const FileName: TFileName):boolean; 
var f:TFileStream; 
    iTmp, i, k, cc, rr: Integer; 
begin 
  result:=FileExists(FileName); 
  if not result then Exit; 
  f:=TFileStream.Create(FileName,fmOpenRead); 
  try 
    with StringGrid do 
    begin 
      // Obtenir le nombre de colonnes 
      f.Read(iTmp,SizeOf(integer)); 
      ColCount := iTmp; 
      // et de lignes 
      f.Read(iTmp,SizeOf(integer)); 
      RowCount := iTmp; 
      // remplir les cellules 
      for i := 0 to ColCount - 1 do 
        for k := 0 to RowCount - 1 do 
          Cells[i, k] := ReadStreamString(f); 
    end; 
  finally 
     F.Free; 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
type TPublicStringGrid = class(TCustomGrid);  
...  
procedure TForm1.Button1Click(Sender: TObject);  
begin  
  //Déplace la première ligne (Row=0) vers la seconde (Row=1) : 
  TPublicStringGrid(StringGrid1).MoveRow(0,1);  
  
  //Déplace la première colonne (Col=0) vers la seconde (Col=1) : 
  TPublicStringGrid(StringGrid1).MoveColumn(0,1); 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
function MergedCells(AStringGrid:TStringGrid; CurrentCol,CurrentRow,Col1,Row1,Col2,Row2:Integer; 
                    CurrentState: TGridDrawState):Boolean; 
var x1,y1,x2,y2:Integer; 
    ARect:TRect; 
begin 
  // Initialisations diverses 
  ARect:=Bounds(0,0,0,0); 
  x1:=Col1; 
  y1:=Row1; 
  x2:=Col2; 
  y2:=Row2; 
  result:=False; 
  
  // On vérifie que la zone fusionnée est valide 
  if x1 < 0 then x1:=0; 
  if x2 > AStringGrid.ColCount-1 then x2:=AStringGrid.ColCount-1; 
  if y1 < 0 then y1:=0; 
  if y2 > AStringGrid.RowCount-1 then y2:=AStringGrid.RowCount-1; 
  if (x1 > x2) or (y1 > y2) then 
  begin 
    result:=False; 
    Exit; 
  end; 
  
  // Si la cellule courante est la dernière de la zone de fusion, on dessine dans la fusion le texte de la cellule en haut à gauche 
  if ((CurrentCol=Col2) and (CurrentRow=Row2)) 
  then begin 
        ARect.Left:=AStringGrid.CellRect(Col1,Row1).Left; 
        ARect.Top:=AStringGrid.CellRect(Col1,Row1).Top; 
        ARect.Right:=AStringGrid.CellRect(Col2,Row2).Right; 
        ARect.bottom:=AStringGrid.CellRect(Col2,Row2).Bottom; 
        AStringGrid.Canvas.TextRect(ARect, ARect.Left+2, ARect.Top+2, AStringGrid.Cells[Col1,Row1]); 
       end; 
  // Si la cellule courante est dans la zone de fusion, on dit qu'on la dessiné (même si ce n'est pas vrai :) ) 
  if ((CurrentCol>=Col1) and (CurrentRow>=Row1) and (CurrentCol<=Col2) and (CurrentRow<=Row2)) 
  then result:=True; 
end;

1
2
MergedCells(AStringGrid:TStringGrid;CurrentCol,CurrentRow,Col1,Row1,Col2,Row2:Integer; 
                                          CurrentState: TGridDrawState):Boolean;

1
2
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; 
  Rect: TRect; State: TGridDrawState);

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
unit Unit1; 
  
interface 
  
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, Grids; 
  
type 
  TForm1 = class(TForm) 
    StringGrid1: TStringGrid; 
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; 
      Rect: TRect; State: TGridDrawState); 
    procedure FormCreate(Sender: TObject); 
  private 
    { Déclarations privées } 
  public 
    { Déclarations publiques } 
  end; 
  
var 
  Form1: TForm1; 
  
implementation 
  
{$R *.dfm} 
  
function MergedCells(AStringGrid:TStringGrid;CurrentCol,CurrentRow,Col1,Row1,Col2,Row2:Integer;CurrentState: TGridDrawState):Boolean; 
var x1,y1,x2,y2:Integer; 
    ARect:TRect; 
begin 
  // Initialisations diverses 
  ARect:=Bounds(0,0,0,0); 
  x1:=Col1; 
  y1:=Row1; 
  x2:=Col2; 
  y2:=Row2; 
  result:=False; 
  
  // On vérifie que la zone fusionnée est valide 
  if x1 < 0 then x1:=0; 
  if x2 > AStringGrid.ColCount-1 then x2:=AStringGrid.ColCount-1; 
  if y1 < 0 then y1:=0; 
  if y2 > AStringGrid.RowCount-1 then y2:=AStringGrid.RowCount-1; 
  if (x1 > x2) or (y1 > y2) then 
  begin 
    result:=False; 
    Exit; 
  end; 
  
   // Si la cellule courante est la dernière de la zone de fusion, on dessine dans la fusion le texte de la cellule en haut à gauche 
  if ((CurrentCol=Col2) and (CurrentRow=Row2)) 
  then begin 
        ARect.Left:=AStringGrid.CellRect(Col1,Row1).Left; 
        ARect.Top:=AStringGrid.CellRect(Col1,Row1).Top; 
        ARect.Right:=AStringGrid.CellRect(Col2,Row2).Right; 
        ARect.bottom:=AStringGrid.CellRect(Col2,Row2).Bottom; 
        AStringGrid.Canvas.TextRect(ARect, ARect.Left+2, ARect.Top+2, AStringGrid.Cells[Col1,Row1]); 
       end; 
  // Si la cellule courante est dans la zone de fusion, on dit qu'on la dessiné (même si ce n'est pas vrai :) ) 
  if ((CurrentCol>=Col1) and (CurrentRow>=Row1) and (CurrentCol<=Col2) and (CurrentRow<=Row2)) 
  then result:=True; 
end; 
  
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; 
  Rect: TRect; State: TGridDrawState); 
begin 
     //On dessine la(les) cellule(s) 
     //d'abord on teste et on s'occupe des fusions de cellules 
    if not MergedCells(StringGrid1,ACol,ARow,2,2,2,3,State)then 
    if not MergedCells(StringGrid1,ACol,ARow,3,3,4,3,State)then 
     //puis si on a pas une cellule fusionnée on la dessine normalement 
    StringGrid1.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2, StringGrid1.Cells[ACol,ARow]); 
end; 
  
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Stringgrid1.Cells[1,1]:='Coucou'; 
  Stringgrid1.Cells[2,2]:='Salut'; 
  Stringgrid1.Cells[3,3]:='Bonjour à tout le monde'; 
end; 
  
end.

procedure TForm1.FormCreate(Sender: TObject);

1
2
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; 
  Rect: TRect; State: TGridDrawState);

1
2
3
4
5
6
7
8
9
10
11
12
13
//dans le formcreate  
  MaStringGrid.DoubleBuffered := True; 
  MaStringGrid.ControlStyle := StringGrid2.ControlStyle + [csClickEvents]; 
  
... 
  
// dans le ondrawcell du stringGrid 
// la condition peut etre un numero de colonne ou de ligne  
   if  maCondition Then 
     if (csClicked in (sender as TstringGrid).ControlState) Then 
       DrawFrameControl((sender as TstringGrid).Canvas.Handle, Rect,DFC_BUTTON, DFCS_BUTTONPUSH or DFCS_PUSHED ) 
     else 
       DrawFrameControl((sender as TstringGrid).Canvas.Handle, Rect, FC_BUTTON, DFCS_BUTTONPUSH )