Composant héritant de TStringGridRésolu

Question

Bonjour,

   Je suis en train d'écrire un petit programme ayant besoin d'un tableau du genre StringGrid mais avec des fonctionnalités supplémentaires et notament une gestion de chaque cellule un peu plus précise. Pour cela j'ai créé mon propre composant en le fesant hériter de TStringGrid, puis réécrit la méthode DrawCell et créer de nouvelles propriétés pour mon nouveau composant. Pour stocker les caractéristiques de chaque cellule (couleur, font, alignement...) j'ai créer un type d'objet contenant ces caractéristiques, puis je les ai stocké dans le tableau d'objet "Objects" contenu dans le composant TStringGrid. Ca marche presque: a ma plus grande surprise certaines valeurs contenu dans mes objets contenu dans Objects sont réinitialisées. J'ai également constaté que lors du rafraichissement d'un tableau ainsi créé la méthode DrawCell était appelé plusieurs fois pour une même cellule et de surcroit avec des valeurs corrects dans mes objets aux premiers appels puis incorrect!

Si quelqu'un peut me dire pourquoi ce phénomène étrange se produit et comment palier à celui-ci je lui en serait reconnaissant,

En espérant avoir été clair, merci d'avance.

cs_Loda · Accepted Answer

oups, on s'est croisé. bon alors à la première lecture, y a quelques trucs qu'on peut amélioré: Procedure TGrille.SetCellBackColor(const Valeur: TColor ); var infCell: TInfCell; begin infCell := TInfCell.Create; //FAUX. infCell.couleur := Valeur; Objects[Col,Row] := infCell; end; --> begin infCell := Objects[Col,Row]; if not assigned(infCell) then infcell := infCell.Create; infCell.couleur := Valeur; Objects[Col,Row] := infCell; end; tu ne doit pas recrée a chaque fois un object. Il te faut modifier l'object existant ! (et le crée si inexistant). SInon tu aurra des perte de paramêtre et de mémoire. (tu l'as pourtant bien fait pour les autres prop.) -------------- if Objects[ACol,ARow] <> Nil then begin Couleur := TInfCell(Objects[ACol,ARow]).couleur; Italic := TInfCell(Objects[ACol,ARow]).Italic; Bold := TInfCell(Objects[ACol,ARow]).Bold; Alignement := TInfCell(Objects[ACol,ARow]).Alignment; end; une petite var local rendrait le code plus lisible. non? ------------------ if Italic then font.Style := [fsItalic]; if Bold then font.Style := [fsBold]; if Italic and Bold then font.Style := [fsItalic,fsBold]; cherche de la doc sur "include (procedure)" ------------- pourquoi tu remplace pas flexAlignLeftTop = 0; flexAlignLeftCenter = 1; flexAlignLeftBottom = 2; flexAlignCenterTop = 3; flexAlignCenterCenter = 4; flexAlignCenterBottom = 5; flexAlignRightTop = 6; flexAlignRightCenter = 7; flexAlignRightBottom = 8; flexAlignGeneral = 9; par un truc genre: flexAlignCenterCenter = DT_VCENTER OR DT_CENTER; puis t'en fait un usage direct. ce qui te simpliferais pas mal ton code. ----------- le deuxieme: if Objects[ACol,ARow] <> Nil then begin Couleur := TInfCell(Objects[ACol,ARow]).couleur; Italic := TInfCell(Objects[ACol,ARow]).Italic; Bold := TInfCell(Objects[ACol,ARow]).Bold; Alignement := TInfCell(Objects[ACol,ARow]).Alignment; end; ne sert a rien ----------- il te manque une implementation pour le state "selected" ----------- sinon, je ne vois rien qui expliquerait les problèmes que tu as. as tu d'autre référence au tableau d'object dans ton code? fais-tu des manipulation de colonne/ligne (deplacement, ajout, ...) ? dsl, Loda PS: le showmessage vas aussi provoqué des paint (en plus du fait que cela bloque l'applic) Se poser les bonnes questions est le premier pas pour trouver les bonnes réponses.

florenth · Answer

Salut !

Sans voir ni ta procédure DrawCell, ni la façon  avec laquelle tu stockes tes "objets persos", on ne peut pas faire grand chose...
Cela dit, il faut faire attention lorsqu'on débugge une méthode de dessin. En effet, le message WM_PAINT est envoyé à toutes les fenêtres de ton application et appelle les procédures Paint(), DrawCell() ...

Sauf que: si tu places un point d'arrêt dans une de ces méthodes, Delphi va automatiquement basculer en mode "debug" et va masquer ta fenêtre, ce qui fait qu'une fois la procédure de dessin finie, lorsque tu appuies sur F9, tu réaffiche ta fenêtre, donc tu engendre un nouveau message WM_PAINT et donc des appels qui peuvent être incorrects.

J'espère m'être bien exprimé.

N'hésites pas à poster du code, ça peut sûrement nous servir.

A+
Flo

lacaillecaille · Answer

Salut flo, Excuse moi je te met mon source. Apres quelques surpirses en mode debug j'ai essayé de debugger en envoyant des "showmessage": résultat tout aussi surprenant. Merci d'avance. unit Grille; interface uses Grids, stdctrls,Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus, extctrls, ShellAPI; Const flexAlignLeftTop = 0; flexAlignLeftCenter = 1; flexAlignLeftBottom = 2; flexAlignCenterTop = 3; flexAlignCenterCenter = 4; flexAlignCenterBottom = 5; flexAlignRightTop = 6; flexAlignRightCenter = 7; flexAlignRightBottom = 8; flexAlignGeneral = 9; type TInfCell = class(TObject) couleur : TColor; Italic : Boolean; Bold : Boolean; Alignment : cardinal; end; TGrille = class(TStringGrid) private Procedure SetCellBackColor(const Valeur: TColor); function getCellBackColor: TColor; Procedure SetCellFontItalic(const Valeur: Boolean); function getCellFontItalic: Boolean; Procedure SetCellFontBold(const Valeur: Boolean); function getCellFontBold: Boolean; Procedure SetCellAlignment(const Valeur: cardinal); function getCellAlignment: Cardinal; protected procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override; public published Property CellBackColor:TColor read GetCellBackColor write SetCellBackColor; Property CellFontItalic:Boolean read GetCellFontItalic write SetCellFontItalic; Property CellFontBold:Boolean read GetCellFontBold write SetCellFontBold; Property CellAlignment:cardinal read GetCellAlignment write SetCellAlignment; end; procedure Register; implementation procedure Register; begin RegisterComponents('ART', [TGrille]); end; //============================================================================================= function TGrille.getCellBackColor: TColor; begin if Objects[Col,Row] <> Nil then result := TInfCell(Objects[Col,Row]).couleur else result := clWhite; end; Procedure TGrille.SetCellBackColor(const Valeur: TColor ); var infCell: TInfCell; begin infCell := TInfCell.Create; infCell.couleur := Valeur; Objects[Col,Row] := infCell; end; //============================================================================================= function TGrille.getCellFontItalic: Boolean; begin if Objects[Col,Row] <> Nil then result := TInfCell(Objects[Col,Row]).Italic else result := false; end; Procedure TGrille.SetCellFontItalic(const Valeur: Boolean); var infCell: TInfCell; begin if Objects[Col,Row] = Nil then infCell := TInfCell.Create else infCell := TInfCell(Objects[Col,Row]); infCell.Italic := Valeur; Objects[Col,Row] := infCell; end; //============================================================================================= function TGrille.getCellFontBold: Boolean; begin if Objects[Col,Row] <> Nil then result := TInfCell(Objects[Col,Row]).Bold else result := false; end; Procedure TGrille.SetCellFontBold(const Valeur: Boolean); var infCell: TInfCell; begin if Objects[Col,Row] = Nil then infCell := TInfCell.Create else infCell := TInfCell(Objects[Col,Row]); infCell.Bold := Valeur; Objects[Col,Row] := infCell; end; //============================================================================================= function TGrille.getCellAlignment: cardinal; begin if Objects[Col,Row] <> Nil then result := TInfCell(Objects[Col,Row]).Alignment else result := 0; end; Procedure TGrille.SetCellAlignment(const Valeur: cardinal); var infCell: TInfCell; begin if Objects[Col,Row] = Nil then begin infCell := TInfCell.Create; infCell.Alignment := Valeur; Objects[Col,Row] := infCell; end else begin TInfCell(Objects[Col,Row]).Alignment := valeur; end; end; //============================================================================================= procedure TGrille.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); var LeFormat : Cardinal; Couleur : TColor; Alignement : Cardinal; Italic,Bold: boolean; begin LeFormat := DT_NOPREFIX or DT_WORDBREAK; Couleur := clWhite; Alignement := 0; Italic := False; Bold := False; if Objects[ACol,ARow] <> Nil then begin Couleur := TInfCell(Objects[ACol,ARow]).couleur; Italic := TInfCell(Objects[ACol,ARow]).Italic; Bold := TInfCell(Objects[ACol,ARow]).Bold; Alignement := TInfCell(Objects[ACol,ARow]).Alignment; end; with Canvas do begin if gdFixed in AState then Brush.Color := clBtnFace else Brush.Color := Couleur; FillRect(ARect); if Italic then font.Style := [fsItalic]; if Bold then font.Style := [fsBold]; if Italic and Bold then font.Style := [fsItalic,fsBold]; if (Alignement = 0) or (Alignement = 3) or (Alignement = 6) then LeFormat := LeFormat or DT_TOP; if (Alignement = 1) or (Alignement = 4) or (Alignement = 6) then LeFormat := LeFormat or DT_VCENTER; if (Alignement = 2) or (Alignement = 5) or (Alignement = 8) then LeFormat := LeFormat or DT_BOTTOM; if (Alignement = 0) or (Alignement = 1) or (Alignement = 2) then LeFormat := LeFormat or DT_LEFT; if (Alignement = 3) or (Alignement = 4) or (Alignement = 5) then LeFormat := LeFormat or DT_CENTER; if (Alignement = 6) or (Alignement = 7) or (Alignement = 8) then LeFormat := LeFormat or DT_RIGHT; if Objects[ACol,ARow] <> Nil then begin Couleur := TInfCell(Objects[ACol,ARow]).couleur; Italic := TInfCell(Objects[ACol,ARow]).Italic; Bold := TInfCell(Objects[ACol,ARow]).Bold; Alignement := TInfCell(Objects[ACol,ARow]).Alignment; end; DrawText(Canvas.Handle, PChar(Cells[ACol,ARow]), -1, ARect ,LeFormat); end; end; end.

cs_Loda · Answer

salut,

pour faire du debug de methode type Draw, utilise "outputdebugstring" + format ou la proprieté "log message" des break point (après avoir désactivé l'arrêt)

essaie aussi d'afficher dans un memo (ou autre) le contenu de tes object de format. juste histoire de voir l'ensemble en un coup d'oeil.

sinon, c'est vrai que la methode drawcell est parfois appelée sans raison très apparent. 
Fait bien attention à tester tout les paramêtres de drawcell: rect / state, ... Une autre erreur courant est l'inversion de x-y dans les indices (ça arrive à tout le monde)

"certaines valeurs contenu dans mes objets contenu dans Objects sont réinitialisées"
J'ai jamais eut ce type de probleme. Est-tu bien sur que tu ne modifie pas tes objects?

sinon, il nous faudrait le code pour de donner des conseilles plus précis... :-)

Loda
 Se poser les bonnes questions est le premier pas pour trouver les bonnes réponses.

lacaillecaille · Answer

Salut Loda,
   Je n'ai pas mis le contenu des mes objets dans un memo mais je me suis concentré sur la cellule [0,1] et j'ai envoyé des showmessages des que cette cellule etait concerné et constaté qu'elle était correctement alimenté pour mes setters et qu'elle était parfois correctement renseigné arrivé dans DrawCell.
Quand je dit que "certaines valeurs contenu dans mes objets contenu dans Objects sont réinitialisées" c'est que lors d'un refresh de ma grille la methode est appelé plusieurs fois sans autre retour dans mon code (il me semble) et des valeurs contenu dans mes objets passe  à zéro (j'en suis le premier surpris!).

Exemple d'utlisation:
var
   GInter : TGrille;
...

   for i := 0  toGInter.ColCount - 1  do
   begin
      for j := 0  to GInter.RowCount - 1  do
      begin
         GInter.col := i;
         GInter.Row := j;
         GInter.CellAlignment := flexAlignCenterCenter;
          if (i = 5) then GInter.CellAlignment := flexAlignLeftCenter;
      end;
   end;

Au résultat l'alignement pour toute mes cellules est à gauche en haut (corespondant à CellAlignment = 0)

lacaillecaille · Answer

Re salut Loda,
Oups effectivement on s'est croisé. Toute tes remarques sont pertinentes et tu as trouvé la cause de mon problème: c'est la premiere remarque concernant mon setter SetCellBackColor qui effectivement va occasionnellement détruire les informations déjà renseignées. Je ne regardait plus du tout ce bout de code car je ne pensais pas qu'il pouvait etre executé lors d'un refresh! J'ai refait des tests c'est pourtant bien le cas.

Merci beaucoup
@+

cs_Loda · Answer

resalut,

essai de faire un effort tout particulier pour reduire le code des draw/paint. parceque ces methode sont appelé triès souvent et par consequent peuvent enormenent ralentir ton programme.

normalement, tu ne devrat pas modifier (appeler les settre) tes objects dans le paint. Et je ne voit pas ce qui provoque cette appel.

sinon, je te recommande très vivement les outputdebugstring plustot que les showmessage.

bon code!

Loda
 Se poser les bonnes questions est le premier pas pour trouver les bonnes réponses.

lacaillecaille · Answer

Salut Loda,

Encore merci pour tes conseils je vais revoir mon code en concequence ,

@+

bubu4242 · Answer

Bonjour,

Petit à petit j'essaie de faire le tour du site (je suis nouveau) et je suis tombé sur ton message. J'avais trouvé un composant descendant du TStringGrid, créé par A. Horstermeir. A l'époque il était fait pour Delphi 1, mais il existe une version 2.1 pour monter jusqu'à D6. Si ça peut t'intéresser et t'aider, je te joins le lien. C'est ici.

Amicalement
Bubu

lacaillecaille · Answer

Salut Bubu,

   Merci pour ton rensignement. Avant de me décider à écrire mon petit composant j'ai voulu utiliser TStringAlignGrid V2.1 mais je suis en Delphi 7 et la mise à niveau semble etre consequente. De plus ce composant semble ne plus etre maintenu....

Encore merci
@+

bubu4242 · Answer

Exact ! 
Une bonne partie des liens vers le composant ne marchent pas -ou du moins pointent vers autre chose. Cela dit, je ne suis pas arrivé à l'installer sous D6 et quand j'en ai vraiment besoin, pour de petites applications, je reste en D1 (eh oui !)
Bonne chance pour ton code.
Amicalement

Composant héritant de TStringGrid

11 réponses

Votre réponse

Discussions similaires