Discussion :

[Invité]

Bonjour,

Dans une StringGrid en goRowSelect :=True, comment assigne-t-on un TBitMap (dans l'évènement OnDrawcell) à une cellule d'une FixedCols à partir d'une condition (gdSelected = True) or (gsFocused = True) ?

Ceci fonctionne

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
procedure TForm1.FormCreate(Sender: TObject);
begin
  With StringGrid1 do begin
    FixedCols := 0; //<---------------
    if not (goRowSelect in Options) then Options:= Options + [goRowSelect];
  end;
end; 
 
procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
  aRect: TRect; aState: TGridDrawState);
var
   BitMap : TBitMap;
begin
   if (gdSelected in aState) or (gdFocused in aState) then
     if assigned(Image1.Picture.Bitmap) then begin
         Bitmap := TBitmap.Create;
         Bitmap.Assign(Image1.Picture.Bitmap);
         { Dessin du fond }
         StringGrid1.Canvas.StretchDraw(StringGrid1.CellRect(0, aRow), Bitmap);
         Bitmap.Free;
     end;
end;

Mais, si je remplace FixedCols := 0 par FixedCols :=1, le TBitmap n'est plus assigné ce qui me laisse penser que le (gdSelected =True) or (gsFocused = True) n'est plus "détecté" car le code suivant l'assigne correctement à toutes les Cells[0, aRow] :

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
procedure TForm1.FormCreate(Sender: TObject);
begin
  With StringGrid1 do begin
    FixedCols := 1;
    if not (goRowSelect in Options) then Options:= Options + [goRowSelect];
  end;
end; 

procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
  aRect: TRect; aState: TGridDrawState);
var
   BitMap : TBitMap;
begin
   //if (gdSelected in aState) or (gdFocused in aState) then
     if assigned(Image1.Picture.Bitmap) then begin
         Bitmap :=TBitmap.Create;
         Bitmap.Assign(Image1.Picture.Bitmap);
         { Dessin du fond }
         StringGrid1.Canvas.StretchDraw(StringGrid1.CellRect(0,aRow), Bitmap);
         Bitmap.Free;
     end;
end;

Donc, je suppose que je m'y prends mal. Quelle est la solution ?

Merci. Cordialement

[tourlourou]

pê en testant que la ligne a été sélectionnée sur la 1° cellule de la ligne suivant les fixes ?

Code :

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

1
2
if ( (aCol<FixedCols) and Cells[FixedCols, aRow].Selected )
or ( (gdSelected in aState) or (gdFocused in aState) )

[Invité]

Bonjour,

En Lazarus, c'est isCellSelected. Mais dans ce cas précis, cela ne fonctionne pas.

Cordialement.

[mick605]

Salut

Une cellule "fixed" ne peut ni être sélectionnée, ni avoir le focus. C'est pour cela que ton dessin n'est jamais appelé : State ne contient ni gdSelected ni gdFocused.

Une solution est :

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
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
   BitMap : TBitMap;
begin
   if (ACol<StringGrid1.FixedCols) and (ARow=StringGrid1.Selection.Top) then
     if assigned(Image1.Picture.Bitmap) then
     begin
         Bitmap := TBitmap.Create;
         Bitmap.Assign(Image1.Picture.Bitmap);
         { Dessin du fond }
         StringGrid1.Canvas.StretchDraw(StringGrid1.CellRect(0, aRow), Bitmap);
         Bitmap.Free;
     end;
end;

Un autre conseil, tu n'es pas obligé de passer par un bitmap intermédiaire. Enleve ta variable Bitmap

[tourlourou]

il semble y avoir un TitleImageList et un TitleStyle pour les cellules fixes ; je ne sais pas si ça peut servir.

[Invité]

Bonjour à tous deux,

Mick605, votre solution dessine bien en effet une image dans la ligne sélectionnée (Row), mais comment l'efface-t-on quand on passe à la ligne suivante ? J'ai essayé cette solution et créé un bRect sur le Cell[0, row -1] si elle existe et un cRect sur la Cells[0, row+1], puis j'ai tenté d'effacer ou de placer un autre dessin dans ces 2 cellules au moment où je place l'image dans le aRect SANS AUCUN SUCCES.

Je ne comprends pas "tu n'es pas obligé de passer par un bitmap intermédiaire. Enleve ta variable Bitmap "... Il faut bien assigner quelque chose quelque part...
Que je le place avant le premier if, et le libère à la fin de la procédure, c'est envisageable. Dans mon cas, le Image1.picture.Bitmap est une Fproperty puisque j'opère dans un composant.

Sinon, j'ai une autre solution à partir des autres événements que je suis obligé de surcharger, OnMouseWheelxx ou OnMouseUp... Elle est basée sur le parcours (le croisement) d'un array de Boolean et de Row qui simule dans mon composant la pseudo-sélection (pour gérer le Multiselect sur des zones non-contiguës).

Or j'ai différencié 2 cas, soit FMultiSelect = True, et dans ce cas, je fais appel à mon tableau, soit FMultiselect = False et dans ce cas là, j'utilise les fonctions "naturelles".

Dans ce dernier cas, il a fallu que l'équipe Lazarus corrige un bug avec MouseWheelxx (incomplètement pour l'instant). J'ai interdit ensuite la possibilité de réaliser des zones de sélection (puisque monoselect) et... je veux gérer dans FixedCols, mon icône de placement qui signale la ligne qui a le focus ou qui est sélectionnée. Cela me paraît normal, puisque dans l'autre cas, les icônes des lignes pseudo-sélectionnées apparaissent. Par homogénéïté du comportement...

Je crois que les TStringGrids sont très mal foutues parce qu'elles dérivent initialement d'un ancêtre commun avec les TdbGrids, ancêtre qui a été conçu avec pour arrière plan l'aboutissement des TdbGrids dont une partie des évènement est gérée par le DataSource, voire le DataSet... Ceci explique pourquoi les colonnes, le MultiSelect non contiguë sont correctement gérés par le dbGrid (et l'apport de ses composants liés) et pourquoi, il a fallu créer des Tcolumns (complètement foireuses jusqu'à la 0.9.28 incluse) alors qu'on dispose des Cols[x] qui ne permettent pas grand chose, un Drawcell "monstrueux" (sa "fréquence" de balayage est délirante)... et l'absence de MultiSelect non contiguë... Il faudrait pour les StringGrids, un module supplémentaire équivalent à l'assistance fonctionnelle que procure un datasource/dataset dans la gestion des Grids un peu comme je fais très modestement avec mon tableau d'array (et qui reste limité à mon utilisation usuelle de mes StringGrids)... ou mieux couper couper les ponts avec l'ancêtre commun. Je crois qu'un développeur Delphi à réaliser cela dans un autre composant "StringGrid". Avant-hier, Delphi XE2 Trial était installé sur mon poste. J'ai vérifié. En Win32, les TStringgrids ne semblent pas non plus gérer le MultiSelect non contiguë. Je ne me suis pas appesanti sur le dit composant. Pour en revenir à Lazarus, je me demande "Comment est-ce possible [I]encore après plus de 10 ans d'existence ?" A moins que je ne sois passé à côté d'un pan complet d'un fonctionnement "usuel" ?... Pourtant j'ai bien regardé avant de m'embarquer dans cette histoire...

Un problème simple : Je génère par exemple 100 "mots" de 8 lettres aléatoires dans ma StringGrid. Je veux sélectionner ceux qui "sonnent" bien... "Sonne bien", ce n'est pas traduisible par une condition logique... et les mots qui sonnent bien (et qui relèvent donc d'une sélection par Clic, ou Left+Move, ou Ctrl+Clic éventuellement ctrl+shift+Clic...), je veux les déplacer dans une autre StringGrid... S'il y en a 15, il n'y aucune raison qu'ils forment une zone contiguë...


Pour Toulourou, pas le TTitleStyle.... Pour l'autre, j'ai un peu de mal à suivre la doc "Draw a rubberband around the provided cellrect Segunda linea de texto"... J'ai déjà du mal en anglais... Mais alors si on commence à croiser les langues... mais sérieusement, je ne crois pas que cela soit une solution... Le problème n'est pas l'affichage mais le déclenchement de celui-ci... et son refresh après coup (quand Row a changé). L'explication de Mick605 est à mon avis la bonne... C'est un problème structurel, conceptuel.

Merci à tous deux pour votre aide. Je crois que je vais "contourner" le cas "naturel" et le traiter à ma sauce.
Cordialement. Gilles

[Invité]

Bon,

J'ai pas mal avancé. En mode "monoselect", j'arrive au résultat escompté.

Mais c'est du bricolage. Il suffit pour s'en convaincre, au lieu d'effacer les Cells[0,aRow] avec aRow <> Row de placer une image dans le canvas... Pas de problème si on reste aRow <= VisibleRowCount. Mais dès que cette limite est atteinte... l'image est correctement assignée puis immédiatement effacée... De plus je suis obligé d'utiliser d'autres évènements que OnDrawcell... On dira "mal" résolu...

Cordialement. Gilles

[mick605]

Je ne comprends pas "tu n'es pas obligé de passer par un bitmap intermédiaire. Enleve ta variable Bitmap "... Il faut bien assigner quelque chose quelque part...

Code :

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

1
2
3
4
5
6
7
8
9
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
   if (ACol<StringGrid1.FixedCols) and (ARow in [StringGrid1.Selection.Top..StringGrid1.Selection.Bottom]) then
     if assigned(Image1.Picture.Bitmap) then
     begin
         StringGrid1.Canvas.StretchDraw(StringGrid1.CellRect(0, aRow), Image1.Picture.Bitmap);
     end;
end;

Ce code fonctionne chez moi. (J'ai légerement modifié le code pour qu'il fonctionne pour plusieurs lignes a la fois).

Sinon, le fait que l'image ne s'efface pas lors d'un changement de selection est parce que l'evenement de dessin n'est pas rappelé. Lors d'un changement de selection, il faut rappeler Invalidate. Donc, dans l'evenement OnSelectCell, tu fais :

Code :

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

1
2
3
4
5
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
  StringGrid1.Invalidate;
end;

(Dans le cas de plusieurs lignes selectionnées en même temps a la souris, il faut rafraichir a nouveau la grille, bug ?)

Bonne chance

[Invité]

Bonsoir,

Cela fonctionne enfin.

Pour le Tbitmap "intermédiaire", j'utilse en réalité

Canvas.Draw(aRect.Left+((aRect.Right-aRect.Left-gBitmap.Width) div 2),
aRect.Top+((aRect.Bottom-aRect.Top-gBitmap.Height) div 2), gBitmap);

(StretchDraw : c'était pour simplifier l'écriture).

gBitmat est un TBitMap pour l'instant public dans le composant...

Je regarde comment sortir le code du composant pour l'utiliser sur un TStringGrid standard et le place sur le forum... J'utilise OnDrawcell, OnBeforeSelection (mais le Invalidate va le court-circuiter) et le OnPrepareCanvas.

Encore merci pour votre aide.
Cordialement. Gilles

[Invité]

Voici le code final pour une TStringGrid standard

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
88
89
90
91
unit Unit1; 
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, Grids;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
      aRect: TRect; aState: TGridDrawState);
    procedure StringGrid1PrepareCanvas(sender: TObject; aCol, aRow: Integer;
      aState: TGridDrawState);
    procedure StringGrid1SelectCell(Sender: TObject; aCol, aRow: Integer;
      var CanSelect: Boolean);
  private
    { private declarations }
  public
    { public declarations }
  end; 
 
var
  Form1: TForm1; 
  gBitmap : TBitmap;
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 gBitMap := TBitmap.Create;
 with StringGrid1 do begin
  if not (goRowSelect in Options) then Options := Options + [goRowSelect];
   RowCount  := 20;
   FixedCols := 1;   
   ColWidths[0] := 24;
 end;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
 gBitMap.Free;
end;
 
procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
  aRect: TRect; aState: TGridDrawState);
begin
 with Sender as TStringGrid do
  if (aCol = 0) and (aRow >= FixedRows) then
   Canvas.Draw(aRect.Left+((aRect.Right-aRect.Left-gBitmap.Width) div 2),
    aRect.Top+((aRect.Bottom-aRect.Top-gBitmap.Height) div 2),gBitmap);
end;
 
procedure TForm1.StringGrid1PrepareCanvas(sender: TObject; aCol,
  aRow: Integer; aState: TGridDrawState);
begin
 {Ici on associe les BitMaps aux conditions}
 if aCol = 0 then
  with Sender as TStringGrid do
   if aRow = Row then
    gBitmap.assign(Form1.Image1.Picture.Bitmap)
   else
    if aRow mod 4 = 1 then
     gBitmap.assign(Form1.Image2.Picture.Bitmap)
    else
     gBitmap.assign(Form1.Image3.Picture.Bitmap);
end;
 
procedure TForm1.StringGrid1SelectCell(Sender: TObject; aCol, aRow: Integer;
  var CanSelect: Boolean);
begin
 {Le fameux invalidate : que de temps gagné !}
 with Sender as TStringGrid do
  Invalidate;
end;
 
end.

et la vidéo du résultat.

Cette fois-ci, le problème est correctement résolu.

(Dans le cas de plusieurs lignes selectionnées en même temps a la souris, il faut rafraichir a nouveau la grille, bug ?)

Pour empêcher la sélection "multiple" :

Code :

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

1
2
3
4
5
6
7
8
9
10
procedure TForm1.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 {uses math}
 if  (ssLeft in Shift)
 {and : pour permettre le redimensionnement des lignes ou des colonnes}
  and ((Y >= CellRect(max(0, FixedRows -1), 0).Bottom)
  or   (X <= CellRect(0, max(0, FixedCols -1)).Right))
  then abort;
end;

RQ: Testé sous Win 7 et Ubuntu 32 bits - Lazarus SVN du jour - FPC 2.4.x
Cordialement. Gilles