Shape sur Stringgrid spécifique (probleme de calcul du visible)

Bonjour à toutes 8-) et à tous

Suite à cette discution :

http://www.developpez.net/forums/d63...ent-composant/

Voici mon problème.

Je pose dynamiquement des Shapes sur un stringgrid, la taille de ces Shapes peuvent varier.
Si mon StringGrid fait par exemple 200 colonnes et que je scroll horizontalement, au fur et à mesure que j'avance mes Shapes disparaissent (normal) mais sur des Shapes de grand taille (aussi grand que 6 colonnes par exemple) ils disparaissent automatiquement du fait du traitement spécifique que j'impose, mais je n'arrive pas à résoudre ce problème faire en sorte qu'ils disparaissent progressivement.

Voilà mon StringGrid spécifique

Code:

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
type
 
  TStringGridRu = class(TStringGrid)
  private
    { Déclarations privées }
  protected
    { Déclarations protégées }
     procedure WMVSCROLL(var Message :TMessage); message WM_VSCROLL;
     procedure WMHSCROLL(var Message :TMessage); message WM_HSCROLL;
     procedure WMMOUSEWHEEL(var Message :TMessage); message WM_MOUSEWHEEL;
     procedure WMKEYDOWN(var Message :TMessage); message WM_KEYDOWN;
  public
    { Déclarations publiques }
      procedure CheckInBounds;
  published
    { Déclarations publiées }
    property Option : Byte read foption write foption;
  end;
 
procedure Register;
 
implementation
 
procedure  TStringGridRu.WMHSCROLL(var Message :TMessage);
begin
  inherited;
  CheckInBounds;
  Invalidate;
end;
 
procedure  TStringGridRu.WMVSCROLL(var Message :TMessage);
begin
  inherited;
  CheckInBounds;
  Invalidate;
end;
 
procedure TStringGridRu.WMMOUSEWHEEL(var Message: TMessage);
begin
  inherited;
  CheckInBounds;
  Invalidate;
end;
 
procedure TStringGridRu.WMKEYDOWN(var Message: TMessage);
begin
  inherited;
  case Message.WParam of
    33,34,35,36,37,38,39,40:
    begin
      CheckInBounds;
      Invalidate;
    end;
  end;
end;
 
 
procedure TStringGridRu.CheckInBounds;
var
  i,j   :Integer;
  RowDebut :integer;
  RowFin   :integer;
  NbLigneinvisible :integer;
 
  Row :integer;
  Col :integer;
 
begin
 
// inventer par AndNotOr, retouché par Buzz
 
     //Liste des Shapes
      for i := 0 to ControlCount -1 do
      begin
        Col := HiWord(Controls[i].Tag);
        Row := LoWord(Controls[i].Tag);
 
      //Liste des Shapes
//Cache le Shape si la ligne est masquée ou le positionne
        Controls[i].Visible := CellRect(Col,Row).Top > 0;
        Controls[i].Left    := CellRect(Col,Row).Left;
        Controls[i].Top     := CellRect(Col,Row).Top;
 
      end;
 
end;
 
procedure Register;
begin
  RegisterComponents('RuCompos', [TStringGridRu]);
end;

Donc admettons que mon Stringgrid face 200 colonnes et que je créé dessus dynamiquement des shapes:

Code:

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
// ...
        while not Eof do
        Begin
          Shape1 := TShapeRu.Create(StringGridSynthese);
          With Shape1 do
          Begin
            ParentFont        := False;
 
            Caption           := '';
 
            Height := StringGridSynthese.DefaultRowHeight;
            Width  := FieldByName('Taille').AsInteger;
 
            Tag               := MakeLong
              (
              CalculRow(FieldByName('CodeWhere').AsString),
              (DaysBetween(xDateDebutPlusTot,FieldByName('DateDebut').AsDateTime)+1)
              );
 
            ParentShowHint    := False;
            ParentCustomHint  := True;
            ShowHint          := True;
 
            Hint := Hint + 'Double-clique pour plus de détail.';
 
            OnMouseDown       := Self.ShapeSyntheseMouseDown;
            OnMouseUp         := Self.ShapeSyntheseMouseUp;
            OnMouseMove       := Self.ShapeSyntheseMouseMove;
            OnMouseLeave      := Self.ShapeSalarieMouseLeave;
 
            Parent            := StringGridSynthese;
          End;
          next;
        End;
        StringGridSynthese.CheckInBounds;
      End;
// ...
end;

Ici la taille (le Width) peut varier de ColWidthdefaut * 1 à *6
Le tag quand à lui retourne la colonne (de début) et la ligne où se trouvera le shape apres l'evenement Checkinbounds.

Donc lorsque je scroll en horizontal, le shape ou les shape se déplacent normalement, ensuite si les colonnes disparaissent au fur et à mesure ou je me déplace les shapes également disparaissent lorsque leur début de colonne est <= 0 mais si le shape est sur 5 colonnes il disparait tout de suite au lieu d'avoir quelquechose de progressif.

J'ai réussi à le faire dans le Scroll Vertical comme ceci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
      for i := 0 to ControlCount -1 do
      begin
        RowDebut := Controls[i].Tag;
        RowFin   := (Controls[i].Height div DefaultRowHeight) + RowDebut;
 
        nbligneinvisible := 0;
        for j := RowDebut to RowFin  do
        begin
          if CellRect(0,j).bottom = 0
          then nbLigneinvisible := nbligneinvisible + 1
          else break;
        end;
 
        if nbligneinvisible > 0
        then Controls[i].Top := -(DefaultRowHeight * nbligneinvisible)
        else Controls[i].Top := CellRect(0, RowDebut).Top;
 
      end;

Mais en horizontal, c'est le délire...

Merci pour vos lumières.