Discussion :

[CharleLéo]

Bonjour à tous,

Je me suis inspiré du post http://www.developpez.net/forums/d32...ellules-fixes/

Le problème est lorsque je fais un scroll dans le StringGrid, les cellules fusionnées, ne le sont plus.

Mon idée est que lorsque le scroll est terminé, il faudrait redessinner le stringGrid. Comment ?

Qu'en pensez vous.

A+

[BuzzLeclaire]

Tu as essayer de gere depuis les evenement de ton StringGrid

Code :

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

1
2
3
4
5
procedure TFormPrincipal.StringGridSMouseWheelDown(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  invalidate;
end;

Code :

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

1
2
3
4
5
procedure TFormPrincipal.StringGridSemaineMouseWheelUp(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
   Invalidate;
end;

ou mieux créer ton composant :

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
 
// Créer par AndNotOr (forum Develloppez.com
// Ici modifier...
 
uses
  SysUtils, Classes, Controls, Grids, Messages, Windows;
 
type
 
  TStringGridx = class(TStringGrid)
  private
    { Déclarations privées }
  protected
    { Déclarations protégées }
     procedure WMVSCROLL(var Message :TMessage); message WM_VSCROLL;
     procedure WMMOUSEWHEEL(var Message :TMessage); message WM_MOUSEWHEEL;
  public
    { Déclarations publiques }
  published
    { Déclarations publiées }
  end;
 
procedure Register;
 
implementation
 
 
procedure  TStringGridx.WMVSCROLL(var Message :TMessage);
begin
  inherited;
  Invalidate;
end;
 
procedure TStringGridx.WMMOUSEWHEEL(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;
 
procedure Register;
begin
  RegisterComponents('Compoperso', [TStringGridx]);
end;
end.

[ero-sennin]

Salut,

A tous hasard, as-tu regarder l'entrée dans la FAQ ?

A+

[CharleLéo]

Re,

J'étais absent cette aprés midi. J'ai essauyé avec les évènements de la souris : idem.

Dans la FAQ RAS.

Par contre, je vais essayer de mettre une condition dans le DrawCell, du style :
if acol>1 then ...

Je reviendrai pour vous dire
A+

[CharleLéo]

je pense qu'il faut tester le leftcol su stringgrid au moment de l'évènement TopLeftChanged(Sender: TObject)

Qu'en pensez vous?
Quelqu'un a t'il une piste?

A+

[anapurna]

salut

en derivant simplement les evenement de la stringGrid tu devrais pouvoir t'en sortir

voici un exemple qui me parait fonctionner si tu trouve une erreur dit le moi

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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
 
unit UTestEdit;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Grids;
 
type
 
  TStringGrid = Class(Grids.TStringGrid)
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
  end;
 
  TForm1 = class(TForm)
    StrGrid: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure StrGridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
  private
    { Déclarations privées }
  public
    Poscur : Cardinal;
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
uses ExtCtrls;
 
{$R *.dfm}
 
procedure TStringGrid.WMSize(var Msg: TWMSize);
begin
 DefaultHandler(Msg);
 Invalidate;
end;
procedure TStringGrid.WMHScroll(var Msg: TWMHScroll);
begin
 DefaultHandler(Msg);
 Invalidate;
end;
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 
  StrGrid.ColWidths[0] := 22;
  StrGrid.Cells[1,0] := 'Entités';
  StrGrid.Cells[2,0] := 'Données évaluées';
  StrGrid.Cells[3,0] := '';
  StrGrid.Cells[4,0] := 'Erreurs évaluées';
  StrGrid.Cells[5,0] := '';
  StrGrid.Cells[2,1] := 'Valeur';
  StrGrid.Cells[3,1] := 'Pertinence';
  StrGrid.Cells[4,1] := 'Valeur';
  StrGrid.Cells[5,1] := 'Pertinence'
end;
 
const
  TXT_MARG: TPoint = (x: 4; y: 2);
 
    Procedure  DrawButton(Grid : TStringGrid;rect : TRect;Fin : boolean);
    var
      OldBrushStyle : TBrushStyle ;
      OldPenStyle   : TPenStyle;
    begin
      OldBrushStyle :=  Grid.Canvas.Brush.Style ;
      OldPenStyle   :=   Grid.Canvas.Pen.Style ;
      Grid.Canvas.Brush.Style := bsClear;
      Grid.Canvas.FillRect(rect);
      Frame3D(Grid.Canvas,Rect,clWhite,clBtnShadow,1);
      Grid.Canvas.Brush.Style := OldBrushStyle;
      Grid.Canvas.Pen.Style   := OldPenStyle ;
    end;
 
    Procedure  OwnerDrawText(Grid : TStringGrid;rect : Trect;Texte : String;UFormat : Cardinal );
    var
      OldBrushStyle : TBrushStyle ;
      OldPenStyle   : TPenStyle;
    begin
      Rect.Left := Rect.left + TXT_MARG.x;
      OldBrushStyle :=  Grid.Canvas.Brush.Style ;
      OldPenStyle   :=  Grid.Canvas.Pen.Style ;
      Grid.Canvas.Brush.Style := bsClear;
      Grid.Canvas.Pen.Style := psClear;
      DrawText(Grid.Canvas.Handle,PChar(Texte), -1, Rect ,UFormat);
      Grid.Canvas.Brush.Style := OldBrushStyle;
      Grid.Canvas.Pen.Style := OldPenStyle ;
    end;
 
    Function MergingCell(Sender: TObject;Rect: TRect;Coldeb,RowDeb,ColFin,RowFin : integer;aCol,ARow : Integer;State: TGridDrawState) : boolean;
    var
      txtRect: TRect;
      str : String;
      Grid : TStringGrid;
      OldBrushStyle : TBrushStyle ;
      OldPenStyle   : TPenStyle;
      OldRect : Trect;
    begin
      Grid := (Sender as TStringGrid);
      Result  := False;
      OldRect := Rect;
 
      if Coldeb < 0 then Coldeb := 0;
      if ColFin > pred(Grid.ColCount) then ColFin := pred(Grid.ColCount);
      if RowDeb < 0 then RowDeb := 0;
      if RowFin > pred(Grid.RowCount) then RowFin := pred(Grid.RowCount);
 
     If     (ARow in [RowDeb..RowFin])
      and  (aCol in [Coldeb..ColFin]) Then
      begin
 
        Grid.Canvas.FillRect(Rect);
        Rect.Left   := Grid.CellRect(ColDeb,RowDeb).Left;
        Rect.Top    := Grid.CellRect(ColDeb,RowDeb).Top;
        Rect.Right  := Grid.CellRect(ColFin,RowFin).Right;
        Rect.Bottom := Grid.CellRect(ColFin,RowFin).Bottom;
 
        str := Grid.Cells[ColDeb, RowDeb];
        if Grid.VisibleColCount < colFin Then
        begin
          if Grid.Canvas.TextWidth(str) > (Rect.Right-Rect.Left) Then
          begin
            str := Grid.Cells[ACol,ARow];
            Rect := OldRect;
          end;
        end;
        DrawButton(Grid,Rect,aCol = Grid.ColCount);
 
        txtRect := Rect;
        str := Grid.Cells[ColDeb, RowDeb];
        if Grid.VisibleColCount < colFin Then
        begin
          if Grid.Canvas.TextWidth(str) > (Rect.Right-Rect.Left) Then
          begin
            str := Grid.Cells[ACol,ARow];
            txtRect := OldRect;
          end;
        end;
        OwnerDrawText(Grid,txtRect,str,DT_SINGLELINE or DT_CENTER or DT_VCENTER or DT_EDITCONTROL);
        Result := true;
      end;
   end;
 
 
 
 
procedure TForm1.StrGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  OldBrushStyle : TBrushStyle ;
  OldPenStyle   : TPenStyle;
  Grid : TStringGrid;
begin
   Grid := (sender as TStringGrid);
   if not MergingCell(Grid ,Rect,2,0,3,0,ACol,ARow,State)then
     if not MergingCell(Grid ,Rect,4,0,5,0,ACol,ARow,State)then
      if not MergingCell(Grid ,Rect,5,1,6,1,ACol,ARow,State) then
   begin
      Grid.Canvas.FillRect(rect);
      DrawButton(Grid,rect,aCol = Grid.ColCount);
      OwnerDrawText(Grid ,rect,Grid.Cells[ACol,ARow], DT_SINGLELINE  or DT_CENTER or DT_VCENTER or DT_EDITCONTROL);
    end;
 
  if Grid.VisibleColCount < Grid.ColCount Then
    ShowScrollBar(Grid.Handle,SB_HORZ,true);
end;
 
end.

[CharleLéo]

Salut,

Anapurna, j'ai essayé ton code, le scroll ne fonctionne pas. Ce qui se passe :

L'édition de la cellule la plus à droite dans la ligne, équivaut à un scroll vers la droite (impec). Par contre, impossible de faire un scroll vers la gauche.
le stringgrid reste figé.

J'ai recopié tel quel ton code, sans essayer de le comprendre.
A au fait, j'ai mis la propriété defautdrawing du stringgrid à false.

Donc je vais maintenant y jeter un oeil.



A+

[anapurna]

salut

effectivement je n'est pas tester le scrolling est
... il marche pas

faut que je comprenne ce qui ce passe ?
sinon le reste te convient ?

moi je lai tester avec le defaultdrawing à true
mais dans les option j'ai viré gofixedvertline ...goHorzline

une petite erreur c'est intercalé
dans la methode DrawCell
il faut remplacer ce code

Code :

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

1
2
if Grid.VisibleColCount < Grid.ColCount Then
    ShowScrollBar(Grid.Handle,SB_HORZ,true);

par

Code :

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

1
2
3
4
if Grid.VisibleColCount < pred(Grid.ColCount) Then
    ShowScrollBar(Grid.Handle,SB_HORZ,true)
  else
    ShowScrollBar(Grid.Handle,SB_HORZ,False)

@+ Phil

PS : reste que l'histoire du scrolling

[EDIT] j'ai trouver remplace dans les message

Code :

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

DefaultHandler

par

Code :

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

inherited ;

@+ Phil

[CharleLéo]

j'ai essayé de poster mon code, mais j n'arrive pas à le tabuler correctement pour qu'il soit lisible.

En attendant que je trouve comment, je joint les copies d'écran.

A+

PS : le scroll horizontal c'est ok, pas le vertical, il semble que "VAC 1" soit à nouveau écrit!