Bonjour à touteset à 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
Donc admettons que mon Stringgrid face 200 colonnes et que je créé dessus dynamiquement des shapes:
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 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;
Ici la taille (le Width) peut varier de ColWidthdefaut * 1 à *6
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 // ... 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;
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 :
Mais en horizontal, c'est le délire...
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 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;
Merci pour vos lumières.
Partager