Composant héritant de TStringGrid [Résolu]

lacaillecaille 6 Messages postés vendredi 9 mars 2007Date d'inscription 26 juillet 2007 Dernière intervention - 23 juil. 2007 à 14:10 - Dernière réponse : bubu4242 3 Messages postés mardi 26 décembre 2006Date d'inscription 26 juillet 2007 Dernière intervention
- 26 juil. 2007 à 16:08
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.  
Afficher la suite 

Votre réponse

11 réponses

Meilleure réponse
cs_Loda 900 Messages postés vendredi 3 novembre 2000Date d'inscription 30 juillet 2009 Dernière intervention - 23 juil. 2007 à 15:12
3
Merci
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.

Merci cs_Loda 3

codes-sources a aidé 82 internautes ce mois-ci

Commenter la réponse de cs_Loda
florenth 1105 Messages postés dimanche 1 août 2004Date d'inscription 17 août 2008 Dernière intervention - 23 juil. 2007 à 14:29
0
Merci
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
Commenter la réponse de florenth
lacaillecaille 6 Messages postés vendredi 9 mars 2007Date d'inscription 26 juillet 2007 Dernière intervention - 23 juil. 2007 à 14:46
0
Merci
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.
Commenter la réponse de lacaillecaille
cs_Loda 900 Messages postés vendredi 3 novembre 2000Date d'inscription 30 juillet 2009 Dernière intervention - 23 juil. 2007 à 14:51
0
Merci
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.
Commenter la réponse de cs_Loda
lacaillecaille 6 Messages postés vendredi 9 mars 2007Date d'inscription 26 juillet 2007 Dernière intervention - 23 juil. 2007 à 15:23
0
Merci
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)
Commenter la réponse de lacaillecaille
lacaillecaille 6 Messages postés vendredi 9 mars 2007Date d'inscription 26 juillet 2007 Dernière intervention - 23 juil. 2007 à 15:46
0
Merci
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
@+
Commenter la réponse de lacaillecaille
cs_Loda 900 Messages postés vendredi 3 novembre 2000Date d'inscription 30 juillet 2009 Dernière intervention - 24 juil. 2007 à 08:48
0
Merci
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.
Commenter la réponse de cs_Loda
lacaillecaille 6 Messages postés vendredi 9 mars 2007Date d'inscription 26 juillet 2007 Dernière intervention - 24 juil. 2007 à 09:56
0
Merci
Salut Loda,

Encore merci pour tes conseils je vais revoir mon code en concequence ,

@+
Commenter la réponse de lacaillecaille
bubu4242 3 Messages postés mardi 26 décembre 2006Date d'inscription 26 juillet 2007 Dernière intervention - 26 juil. 2007 à 13:24
0
Merci
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
Commenter la réponse de bubu4242
lacaillecaille 6 Messages postés vendredi 9 mars 2007Date d'inscription 26 juillet 2007 Dernière intervention - 26 juil. 2007 à 15:43
0
Merci
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
@+
Commenter la réponse de lacaillecaille
bubu4242 3 Messages postés mardi 26 décembre 2006Date d'inscription 26 juillet 2007 Dernière intervention - 26 juil. 2007 à 16:08
0
Merci
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
Commenter la réponse de bubu4242

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.