[D5] TStringGrid écrire les titres verticalement

**MelkInarian** · 07/04/2007, 11h17

Bonjour,
Quelqu'un connait-il une méthode pour écrire certains titres de colonnes verticalement (comme dans excel) pour gagner de la place en largeur lorsque de nombreuses colonnes ne doivent contenir qu'un ou deux caractères.
Merci.

**Graffito** · 07/04/2007, 12h48

Bonjour,

On peut choisir la hauteur de chaque ligne individuellement.
Pour écrire en vertical, le faire "à la mano" via le OnDrawCell.

**MelkInarian** · 07/04/2007, 14h37

Envoyé par Graffito

Bonjour,On peut choisir la hauteur de chaque ligne individuellement.
Pour écrire en vertical, le faire "à la mano" via le OnDrawCell.

Pour la hauteur j'ai trouvé, OnDrawCell je sais le lancer, mais ce qu'il faut écrire dedans c'est là que ça coince.
Je ne sais comment faire redessiner verticalement le texte.
Merci de bien vouloir m'aiguiller

**anapurna** · 07/04/2007, 22h42

salut

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
  if ((ARow > 0) and (ACol =0)) Then
  begin
    R := SG.CellRect(ACol,ARow);
    P.X := R.Left;
    P.Y := R.Top;   // P := TDrawGrid(Sender).ClientToScreen(P);
    SG.canvas.TextOut(P.X,P.Y,Libel[ARow]);
 end;

@+ Phil

**Graffito** · 07/04/2007, 23h38

Code trouvé sur le net :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
procedure AngleTextOut(CV: TCanvas; const sText: String; x, y, angle:integer); 
// angle en degré
var
  LogFont: TLogFont;
  SaveFont: TFont;
begin
  SaveFont := TFont.Create;
  SaveFont.Assign(CV.Font);
  GetObject(SaveFont.Handle, sizeof(TLogFont), @LogFont);
  with LogFont do
  begin;
    // valeur d'inclinaison en dixième de degré : lfEscapement := angle *10de 0 à 3600
    lfPitchAndFamily := FIXED_PITCH or FF_DONTCARE;
  end; {with}
  CV.Font.Handle := CreateFontIndirect(LogFont);
  SetBkMode(CV.Handle, TRANSPARENT);
  CV.TextOut(x, y, sText);
  CV.Font.Assign(SaveFont);
  SaveFont.Free;
end;

**anapurna** · 08/04/2007, 08h19

salut

j'avai pas tout compris

voila ce qu'il faut faire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
procedure TForm1.DrawRotatedText(angle,X_,Y_:integer;Text_:string;Canvas_:TCanvas);
var
  lf : TLogFont;
  tf : TFont;
begin
  with Canvas_ do
  begin
    tf := TFont.Create;
    try
      tf.Assign(Font);
      GetObject(tf.Handle, sizeof(lf), @lf);
      lf.lfEscapement := angle*10;
      lf.lfOrientation := angle*10;
      tf.Handle := CreateFontIndirect(lf);
      Font.Assign(tf);
      TextOut(X_, Y_, Text_);
      lf.lfEscapement := 0;
      lf.lfOrientation := 0;
      tf.Handle := CreateFontIndirect(lf);
      Font.Assign(tf);
    finally
      tf.free;
    end;
  end;
end;
procedure TForm1.SGDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  P: tpoint;
  R: TRect;
begin
  if ((ARow > 0) and (ACol =0)) Then
  begin
    (sender as TStringGrid).Canvas.Font.Name := 'Arial';
    (sender as TStringGrid).Canvas.Font.Size := 8;
    (sender as TStringGrid).Canvas.Font.Style := [fsbold];
    (sender as TStringGrid).Canvas.FillRect(Rect);
    (sender as TStringGrid).Font.Color := clBlue;
    R := SG.CellRect(ACol,ARow);
    P.X := R.Left+Trunc((R.Right-R.left)/2);;
    P.Y := R.Top+Trunc((R.Top-R.Bottom)/2);  
    DrawRotatedText(270,P.X+10,P.Y,Libel[ARow],(sender as TStringGrid).Canvas) ;
  end;
end;

@+ Phil

**MelkInarian** · 08/04/2007, 11h27

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
84
85
86
87
procedure Form1.SGDrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
  Var
  R : TRect;
  P : TPoint;
  H, L : Byte;    // Hauteur et Longueur du texte
begin   
 
  if ((ARow = 0) and (ACol >0)) Then
  begin
    H := 8; // Hauteur du texte
    L := (Length(SG.Cells[ACol,ARow])*3) ; // Longueur approximative du texte en pixels
    (sender as TStringGrid).Canvas.Font.Name := 'Courier New';
    (sender as TStringGrid).Canvas.Font.Size := H;
    (sender as TStringGrid).Canvas.Font.Style := [fsbold];
    (sender as TStringGrid).Canvas.FillRect(Rect);
    (sender as TStringGrid).Font.Color := clBlue;
    R := SG.CellRect(ACol,ARow);
    P.X := (R.Left+Trunc((R.Right-R.left)/2))-H;
    P.Y := (R.Top+Trunc((R.Bottom-R.Top)/2))+L;
    DrawRotatedText(90,P.X,P.Y,SG.Cells[ACol,ARow],(sender as TStringGrid).Canvas) ;
  end
  else
  CentreStringGrid(SG, ACol, ARow, Rect, State);
end;
 
procedure DrawRotatedText(angle,X_,Y_:integer;Text_:string;Canvas_:TCanvas);
var
  lf : TLogFont;
  tf : TFont;
begin  // Cette procédure sert à dessiner les textes verticalements (Auteur : anapurna Sur Développez.net le 08/04/2007)
  with Canvas_ do
  begin
    tf := TFont.Create;
    try
      tf.Assign(Font);
      GetObject(tf.Handle, sizeof(lf), @lf);
      lf.lfEscapement := angle*10;
      lf.lfOrientation := angle*10;
      tf.Handle := CreateFontIndirect(lf);
      Font.Assign(tf);
      TextOut(X_, Y_, Text_);
      lf.lfEscapement := 0;
      lf.lfOrientation := 0;
      tf.Handle := CreateFontIndirect(lf);
      Font.Assign(tf);
    finally
      tf.free;
    end;
  end;
end;
 
 
procedure CentreStringGrid(Sender: TStringGrid; ACol, ARow: Integer;
          Rect: TRect; State: TGridDrawState);
{ Les paramètres ACol et ARow donnent l'indice de la colonne et de la ligne de la cellule à dessiner.
// Cette procédure sert à centrer les textes(Auteur : Nono40 sur Développez.com)
Le paramètre Rect indique la délimitation de la cellule en coordonnées du canevas.
 
Le paramètre State indique si la cellule a la focalisation et si la cellule est
une cellule fixe de la partie immobile de la grille.
TGridDrawState = set of (gdSelected, gdFocused, gdFixed);
TGridDrawState représente l'information d'état de la cellule d'une grille
qui est en cours de restitution. Il s'agit d'un ensemble comprenant 0 ou plus de :
gdSelected	La cellule est actuellement sélectionnée.
gdFocused	La cellule détient la focalisation de saisie.
gdFixed	        La cellule est dans une région fixe de la grille.  }
Begin  // Cette procédure sert à centrer les textes(Auteur : Nono40 sur Développez.com)
  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;

Grand Merci anapurna le dernier code était le bon et je l'ai intégré tel quel, à quelques modifications mineures près (Hauteur de caractère et longueur de chaîne).
J'ai posté ci-dessus ton code (ainsi qu'une procédure écrite par Nono40 pour centrer les textes) car j'ai tellement cherché que je pense que çà peut intéresser du monde.
Si l'un des responsables du site passe par là, je crois que le code d’anapurna mérite pleinement sa place dans la FAQ.

[D5] TStringGrid écrire les titres verticalement

Delphi

Discussions similaires

Partager

Partager