Discussion :

[jjnoui]

Bonsoir,

Je souhaite manipuler les lignes d'un stringgrid comme avec Excel (ou LibreOffice Calc) pour déplacer une sélection de lignes.

1 - je fais une sélection de plusieurs lignes ;
2 - j'appuie et je maintiens appuyé le bouton gauche de la souris au-dessus de la zone sélectionnée et je déplace ma souris à l'extérieur de la zone sélectionnée puis je relâche ce bouton (Drag and Drop).

Le résultat du point 2 : en cliquant sur le bouton gauche je dé-sélectionne la zone précédemment choisie et me retrouve avec la ligne sous le curseur sélectionnée.

Une idée ?

Merci.

PS : les versions utilisées :
Lazarus 1.0.12
FPC 2.6.2

[tintinux]

Bonjour,

Je ne pense pas que la fonctionnalité attendue fasse partie de la TStringGrid de Lazarus.

Il faut la programmer soi-même, de préférence en créant un composant qui fasse cela (sur option).

Dans Gestinux il y a déjà une TGGrid avec des méthodes pour insérer et supprimer une ligne, appelées automatiquement à partir des touches de fonctions. Les déplacements c'est à peine plus compliqué.

[jjnoui]

Bonjour Tintinux et merci.

Bonne journée

[Jon Shannow]

Bonjour Tintinux et merci.

Bonne journée

Bonjour,

Si tu implémentes un truc qui fonctionne sous Windows, je serais intéressé par la méthode. Merci d'avance.
JS

[Invité]

@Jjnoui : Bonjour,

je vois résolu. En plus en 3 jours... Chapeau bas.

J'en étais resté là, malheureusement :

Les TStringGrids sont très différentes en réalité des TdbGrids... même si elles possèdent un ancêtre commun. Une dbgrid n'existe que par son DataSource et son DataSet. Le travail est partagé, coopératif. Une TStringGrid est seule... Sélectionner des lignes non contiguës par exemple est impossible avec le composant fourni par défaut. Il faut tout créer, la gestion des contrôles, utiliser un objet pour enregistrer les lignes sélectionnées, revoir l'affichage à chaque rafraichissement qui doit être rapide* si le nombre de lignes est significatif, à chaque suppression de ligne, à chaque insertion de ligne et à chaque mouvement de lignes si vous intégrez les tris... J'ai réalisé un tel objet pour mes besoins sans y intégrer la DnD. Toutes ces fonctions sont imbriquées avec d'autres sans rapport avec votre demande... et leur développement a demandé des mois...

Alors déplacer un ensemble de lignes non contiguës à la souris dans une TStringGrid avec un affichage fluide à partir du composant natif

Bien que je n'utilise plus actuellement Lazarus, intellectuellement votre solution m'intéresse vivement. Je vous propose un échange de codes à condition que le mien ne devienne pas public. J'en ferai autant pour le vôtre. Vous pouvez me contacter en message privé.

@JS : Bonjour,
En ce qui concerne le développement des StringGrids, hormis l'ellipsis des cellules (impossible à priori sous GTK2), je n'ai jamais rencontré de différence significative entre Win et Nux par exemple hormis quelques positionnements de canvas... à la marge si on peut dire .

Cordialement. Gilles

*et nécessairement "encore plus" si on utilise le DnD pour garder la fluidité de l'affichage

[jjnoui]

Désolé Selzig, c'est sûr, vu comme tu le perçois : résolu en 3 jours chapeau !
En fait le titre de cette nouvelle réponse explique tout.
Je pensais qu'il ne fallait pas laisser ouvert un problème insoluble.
Je dis insoluble car le sens de ma question était : existe-t'il nativement une solution.
S'il n'y en a pas, c'est une réponse négative à ma question, mais qui clôt le problème, d'où le résolu.
Cela ne m'empêche pas de vous remercier tous et de vous souhaiter une excellente année 2014 avec plein de codes qui fonctionnent (du premier coup?)...

PS : je pense que je vais me tourner vers une solution maison.

Pour l'instant j'arrive à la possibilité de sélectioner des zones multiples (plusieurs zones séparées par des lignes non sélectionnées) je vais maintenant essayer d'avancer sur le drag and drop.

[Invité]

Bonjour Jean-Jacques,

il n'y avait aucune malice dans mes propos... et il était (est) tout à fait envisageable que quelqu'un propose une solution à ce problème de Dnd sur une StringGrid permettant la sélection non contiguë et utilisant TStringGrid comme ancêtre.

J'aurais aimé pouvoir gérer le Dnd. Sur le principe, RAS. Mais à partir du moment où l'on utilise le multiselect non contigu, il faut faire une émulation de la sélection, la stocker quelque part et la redessiner "en temps réel". J'utilise mes Grids uniquement en lecture donc je n'ai besoin de stocker que le N° des Rows pseudo-sélectionnées. Malgré cela, sur une StringGrid importante la gestion du Dnd n'est pas fluide tout simplement parce que je n'ai pas réussi à maitriser les Begin/End-Update avec les évènements de la souris pendant les calculs nécessaires au réaffichage des lignes.

Pour le reste, non il n'y a pas de composants "tout fait" disponibles et c'est pourquoi cet IDE ne s'est pas imposé. En Delphi on trouve plein de composants tiers "améliorés" (ie élaborés). Comme en Delphi, les Grids Lazarus sont une base de développement directement exploitable très insuffisante pour couvrir les besoins usuels immédiats. Mais contrairement à Delphi, il n'y a pas de TMS components, je n'arrive pas à obtenir FastReport4 qui pourtant est annoncé par son éditeur, les composants Indy étaient (sont ?) en retard par rapport à leurs homologues VCL. En Lazarus, les tentatives développées par des petites sociétés tierces passionnées ou des individus tout aussi passionnés ont une durée de vie (et surtout de maintenance et d'évolution) limitée. Bref, il n'y a pas de modèle économique viable compte tenu de la confidentialité du produit. Le cercle n'est pas vertueux et plus le temps passe, moins il y a de chance qu'il s'amorce dans ce sens. Lazarus n'est plus jeune. Il est en stade de croisière. C'est un produit génial conceptuellement, le digne successeur de Delphi 7 et de Kylix qui rappelons-le, pour Kylix a été un échec. Mais à mon avis, il ne possèdera jamais l'aura qu'il mérite tout simplement faute de moyens.

Meilleurs vœux.
Cordialement. Gilles

[Jipété]

Yep !

Je me permets de m'immiscer, car en lisant toute votre discussion il m'est venu une idée, farfelue certes, mais pourquoi pas ?

Back to beginning :

1 - je fais une sélection de plusieurs lignes ;

Fastoche je dirais : que du code lié à l'objet, avec des (pseudo-code) if selected.row[i] then...

C'est ensuite que ça se complique, l'affichage du mouvement :

2 - j'appuie et je maintiens appuyé le bouton gauche de la souris au-dessus de la zone sélectionnée et je déplace ma souris à l'extérieur de la zone sélectionnée puis je relâche ce bouton (Drag and Drop).

L'idée, c'est : pourquoi ne pas déplacer une image ?

Une image de la zone sélectionnée affichée dans un TImage en align := alClient dans une form sans bordures ni rien,
form déplaçable par le drag et réagissant au drop (un MouseUp, quoi) pour se fermer et rendre la main à la grille,
qui saura se mettre à jour avec les données stockées à l'étape précédente.

- - -
Bon, en me relisant, je me dis que la difficulté sera de sélectionner pour la création de l'image la... zone sélectionnée, justement.
Je parle en pixels, TRect, bitmap, etc.
Existe-t-il des options de bas niveau pour avoir ces datas ?

Je ne sais pas, mais peut-être que quelqu'un a une idée ?

[Invité]

Bonjour Jipété,

Le problème m'intéresse toujours... en partie*... et aussi parce que mon environnement Lazarus "s'éclaircit". Pour développer actuellement le back-office du forum de mon lycée, j'ai besoin de 3 choses

• une TStringGrid qui affiche -affiche seulement des cells RTF- et cela, je crois que cela y est...
• des RichEdits qui fonctionnent sous Win et Nux en 32 et 64 bits. Cela est opérationnel depuis plusieurs mois... après de nombreux échecs.
• enfin un éditeur de rapports qui permette d'afficher des Rich Text Object... A priori, il y en a 2 : FortesReport que j'ai installé mais dont la dernière release date de 2011 -c'est très mauvais signe- et FastReport4, qui est payant et qui a du mal à "sortir" mais dont l'équipe travaille toujours et qui fournit Embarcadero. LazReport est à la ramasse, c'est dommage... On pourra dire qu'il a le mérite d'exister mais ce n'est qu'un portage... rarement -voire jamais mis à jour depuis (cf mes propos du message précédent).

*en partie parce que je ne dispose plus de postes Linux dans mon établissement scolaire mais par contre j'ai récupéré à la place des OS X 64 bits et dans cet OS, Lazarus est très en retard...

Donc on reprend...

Le multiselect n'est pas implanté dans les TStrinGrids... On peut définir un rectangle de sélection sur un groupe de cellule (et un seul rectangle) et procéder de la même façon pour un groupe de lignes. Dans la mesure où il n'y a qu'un rectangle, la sélection est forcément contiguë. De plus, c'est une sélection purement graphique. Il n'y a rien "en dessous". C'est un canvas sélectionné, point final. Ce n'est pas comme une dbGrid où le select est précisé dans le Datasource->Dataset associés.

Donc en réalité, il y a une donc une partie purement affichage et une partie de stockage des informations à gérer.

Voici le point de départ [exe win32 -vue ci-dessus] que j'ai utilisé. Si on considère ce premier point comme incontournable, il faut stocker les Rows ou les Cells sélectionnées dans un objet. Il n'utilise pas un composant et pas non plus les TObject des Cells mais il m'a permis de tester diverses approches.

Est-ce qu'on est d'accord sur ce point de départ ? L'idéal serait non !

J'ai réinstallé mon hg sur un autre poste et désarchivé mes codes. Cela a l'air d'être complet. Et cela peut me permettre d'en diffuser des étapes sans fournir le produit fini avec les tris, la modification des entêtes, les fonds des lignes avec images... J'accepte si cela intéresse certains d'entre vous de les "ouvrir" mais donnant-donnant. Les améliorations sont nécessaires notamment en effet le DnD : l'idée serait par exemple de faire un CR genre l'excellent travail par épisodes produit par dimanche2013... Si cela tente quelqu'un... Seul je n'ai pas le temps car je continue à étudier Qt5 après avoir fait un petit tour pendant les vacances par XE5. Pour info, actuellement le back-office du forum est réalisé en Windev18 (IDE que je trouve excellent)... mais ne fonctionne évidemment qu'en Windows.

Cordialement. Gilles

[jjnoui]

Bonjour à tous et tous mes voeux

Ca y est, Gilles (SelZig) m'a donné envie d'essayer.

J'ai un petit programme de test en cours.

Pour l'instant je viens de désactiver la sélection multiple car je suis en phase d'écriture pour le déplacement de zones multiples; en ce qui concerne le déplacement d'un seul bloc de lignes sélectionnées : il fonctionne.
MAIS... je n'ai fait des tests que sur un stringgrid de 10 lignes, et je n'ai donc absolument pas abordé le côté performances.

Je vais donc maintenant pour le fun tenter les blocs multiples en drag and drop )

Ensuite, le côté performances

Et enfin, le plus dur : un exemple propre (pour les commentaires ça va, c'est plutôt pour le style de programmation )

PS: je fais tous mes tests sous Ubuntu car j'envisage d'abandonner celui qui abandonne Windows XP (merci Bilou )

[Jipété]

Bonsoir,

Donc on reprend...

Le multiselect n'est pas implanté dans les TStrinGrids... On peut définir un rectangle de sélection sur un groupe de cellule (et un seul rectangle) et procéder de la même façon pour un groupe de lignes. Dans la mesure où il n'y a qu'un rectangle, la sélection est forcément contiguë. De plus, c'est une sélection purement graphique. Il n'y a rien "en dessous". C'est un canvas sélectionné, point final. Ce n'est pas comme une dbGrid où le select est précisé dans le Datasource->Dataset associés.

Donc en réalité, il y a une donc une partie purement affichage et une partie de stockage des informations à gérer. (...)

On est bien d'accord.

Ce qui me plait bien, c'est ce p'tit bout : C'est un canvas sélectionné, point final.
Un canvas, on ne peut pas le copier dans (ou l'assigner à) un TImage ?

En tout cas, ton image est bluffante ! Moi je dis chapeau , car j'ai à peine joué avec une TStringGrid et j'ai vite senti la misère

(...) Voici le point de départ [exe win32 -vue ci-dessus] que j'ai utilisé. Si on considère ce premier point comme incontournable, il faut stocker les Rows ou les Cells sélectionnées dans un objet. Il n'utilise pas un composant et pas non plus les TObject des Cells mais il m'a permis de tester diverses approches.

Est-ce qu'on est d'accord sur ce point de départ ? L'idéal serait non !

Je ne comprends pas la question, surtout en regard avec ton idéal
Dit autrement : il vaudrait mieux ne pas être d'accord avec l'idée de stocker les Rows ou les Cells sélectionnées dans un objet.
Je ne vois pas trop comment faire autrement, pour cette partie "datas", d'où mon interrogation...
C'est la partie de stockage des informations dont tu parlais précédemment.


Ce que j'ai du mal à piger par contre, et en dehors de ce qui précède, c'est comment appréhender le début d'un drag après une sélection ?
Est-ce détecté par la mise en activité du système DnD au niveau des propriétés de la stringgrid ?

[Invité]

Bonjour,

Et bien apparemment, c'est là le point faible au final... même si je pense que le problème est plus profond et mérite un petit développement supplémentaire (voir ci-après si vous aimez la lecture).

Pour stocker les informations, il faut un autre objet. Mais je prends toute autre méthode géniale : Est-il possible graphiquement de sélectionner plusieurs régions de la SG et d'utiliser la ou les variables qui enregistrent cette sélection ? Je ne suis pas très fort en gestion des graphismes et d'une manière générale du graphisme. Et donc de prime abord, dès le début, j'ai éliminé cette approche en m'accrochant à la gestion des évènements du clavier et de la souris. Que se passe-t-il quand avec la souris on sélectionne un rectangle dans une Grid ? Est-il envisageable de faire perdurer cette sélection et avec un "nouveau" Ctrl +MouseDown d'ajouter une zone de sélection graphique ? C'est "anti-naturel" du fonctionnement usuel... mais peut-être envisageable ?

De mon côté, j'ai utilisé 2 approches différentes.

• Un objet externe un tableau [array]... C'est compliqué, il faut gérer la suppression, l'ajout, l'insertion et les échanges... Et contrairement à ce que l'on croit c'est lent au fonctionnement avec les méthodes développées en Lazarus pour la gestion des tableaux... Il faudrait s'appuyer sur une techno "pointeur" pour voir.
• Les objects internes aux cells. C'est plus facile.
  

  Code :

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

  1
  2
  3
  4
  5
  6
  7
  8
  9
  type
    TClassAddOn = class(TObject)
     private
       Selected : Boolean;
     public
     ID       : string[20];
     StrBlob  : string;
     constructor Create(AOwner: TComponent); virtual;
    end;

  et des
  

  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
   
  procedure TlzStringGrid.Click();
  var
   P: TPoint;
   i, iCol, iRow: Longint;
  var
   iLoc : integer;
  begin
   inherited;
   if not GlyphDisplay then begin
    BeginUpdate;
    {Effacer toutes les sélections}
    for iLoc:= FixedRows to RowCount -1 do
    TClassAddOn(Objects[0,iLoc]).Selected := False;
    EndUpdate(False);
    exit;
   end;
   
   if FMultiSelect then begin
    if bMouseIniInFixedZone then
     bMouseIniInFixedZone:= False else
    begin
    BeginUpdate;

  Mais l'usage des TObjects dans la même SG devient plus difficile pour un autre programmeur. Autrement dit, on diminue les capacités de programmation de l'utilisateur. Dans la mesure où les objects internes ne me servaient pas à autre chose d'autre, c'est la solution que j'ai retenue.

Mais là encore, si quelqu'un "trouve" (ie envisage) un autre moyen, je suis preneur pour l'étudier.

En plus, rapidement, je me suis confronté à un autre manque des StringGrids : on ne peut fixer que des colonnes et des lignes respectivement à gauche et en haut (FixedCols, FixedRows)... J'en avais besoin à droite et en bas...

Voici mon premier démonstrateur.

En réalité, ce composant en contient 5 : la SG de base, une SG latérale, une SG à droite et 2 scrollbars... Je n'ai pas trouvé mieux. Sur le démonstrateur, la synchro des Scrollbars est correcte, pas celle des flèches haut et bas du clavier... Quand il a fallu croiser les codes avec le MultiSelect, c'est devenu un peu délicat... D'où mon choix pour le premier (ie la simplicité). Ci-joint l'exe win-32 du démonstrateur.

Mais, dans un premier temps, j'avais commencé par modifier le code même de la TstringGrid et de ses ancêtres, celui de Lazarus. C'est un reproche que je formulais régulièrement. Maintenant cela ne me concerne plus vraiment. Sans ce forum -auquel je me suis attaché (le lazarusien)- je n'aurais jamais rebranché un Lazarus. On peut faire beaucoup mieux de base mais les Lazariens sont totalement "hostiles" à toute modification sérieuse du code "Fondamental" (le vieux Delphi 7)... et à toute remise à plat. C'est un rustinage permanent. Enfin, que cela soit Java, Qt et C++, ils savent "déposer" d'anciennes méthodes, modifier profondément les codes et bousculer les habitudes de leurs utilisateurs pour en imposer de nouvelles souvent incompatibles avec les anciennes. Ces communautés privilégient le présent et l'avenir. Les Lazarusiers privilégient le présent et le passé. Ce sont les derniers gardiens du temple Delphi. Pour avoir travaillé sur FMX pendant 10 jours, on voit bien que les repreneurs de Delphi ne gardent plus le temple. Cela avance. Cela dérange. Je ne vois pas bien où cela va encore... dans le cadre de mes besoins. Toujours est-il que dans ces conditions, compte tenu des mises à jour quotidiennes de Lazarus, intervenir [I]soi-même pour soi /I] sur le code source est intenable. De plus, pour en terminer avec la "nudité" des TStringGrids natifs, l'étude (ie le développement) des grids a été dès le départ orientée dbGrids... et le TStringGrid est de ce fait peu évolué et peu propice à évoluer. Là , il faut voir du côté de Borland avec sa révolution de l'époque, les chaînes Connecteur-DataSet-DataSource-DbGrid, son BDE et son dbExpress posés directement sur les Forms. Schématiquement, la solution viable, c'est la démarche de kGrid en "jetant" les ancêtres. Et ce n'est pas pour un programmeur isolé et comme je l'ai écrit, il est peu probable que des sociétés tierces investissent car le modèle économique purement lazarusien est inexistant, peut-être épisodiquement un bundle Lazarus/Delphi -avec lazarus en "remorque"- comme FastReport. Enfin attendons de voir le produit pour Lazarus... Sinon, il reste la "bidouille à mon niveau" en dérivant (et/ou assemblant) les TCustomNatifs, bidouille qui montre quand même vite ses limites : on ne peut pas faire un Invalidate toutes les 2 lignes !

Si vraiment j'avais à m'investir, avant la StringGrid, il y a un énorme problème à résoudre : c'est les wrappers avec les widgets natifs des OS et "l'insécurité "de Lazarus à ce niveau qui freine énormément sa réelle portabilité. C'est là qu'il faut mettre le paquet. Cela explique pourquoi les RichEdit "foiraient" en 64 bits. J'ai passé beaucoup d'heures là-dedans. A mon avis, c'est aussi catastrophique que les StringGrids. Le code initial pousse à la bidouille, tout simplement parce qu'au départ, il a été construit sur la plate-forme Delphi7/Win32. En Win 64, Microsoft a changé quelques méthodes (ou même simplement leur nom) mais plus souvent les data types, et certains composants Lazarusiens "dérapent". Comment mettre la panique dans la gestion lazarusienne des widgets natifs en Win64 ?

A new set of data types is also defined in Win64 to write cleaner code. In the Win32 API, data types long and pointers were of the same size, so data types such as DWORD and pointers could be used interchangeably and could also be used to typecast from one to another. The same code in Win64 would lead to errors because in the Win64 API, long is 32 bits while pointer is 64 bits.

Soucre http://technet.microsoft.com/en-us/l.../bb496995.aspx

Il faut apprécier le "to write cleaner code".
Cela explique pourquoi les Lazarusiens ne veulent pas entendre parler des successeurs de Windows 8 car ils craignent qu'à terme, ils vireront Win32 et Win64. Dans les faits, OS X 64 est totalement négligé. On en reste au bon vieux OS X 32 avec sa plateforme graphiquement abandonnée au profit d'une nouvelle 64. Et actuellement en Nux, ils se demandent s'ils vont passer à Gtk3. Comme si la question pouvait se poser ! Bref, avec Qt ces problèmes de wrappers sont globalement bien pris en charge et on peut s'occuper de son code et j'ai envie de produire des fois

Ceci dit, comme ce n'est pas ma profession de programmer mais une simple passion, intellectuellement Lazarus est passionnant.... aussi bien pour son code d'ailleurs que pour sa gouvernance, ses choix (ou non choix) technologiques, son isolement et/ou son originalité.... j'en connais un autre d'ailleurs du même genre -je parle de l'originalité- que j'ai testé pendant mes vacances... Enfin pour moi, Lazarus devient et est devenu un objet universitaire exclusivement ou presque. Objet plaisant d'ailleurs... et vraiment intéressant qui devrait permettre le support d'excellentes thèses.

Donc je maintiens ma proposition pour bricoler à partir de l'ancêtre SG... faute de mieux.
A bientôt. Cordialement.
Gilles

[jjnoui]

Bonjour à tous.
Je suis affolé par le bas niveau de mes connaissances en delphi (ou free pascal).

En lisant Gilles (Selzig) je suis largué par l'ampleur du sujet.

En lisant Jipété je suis largué dans l'utlisation de Canvas pour gérer des sélections.

Attention ceci n'a rien de négatif, c'est moi qui suit resté très simple

Mon approche est donc bien différente :

En ce qui concerne la sélection des zones, pour éviter de me trimbaler une liste ou un objet supplémentaire; je me contente d'ajouter une colonne au stringgrid en dynamique, de la mettre en caché et d'y stocker l'information 'sélectionné ou pas'.

Ensuite, pour les sélections j'utilise les évènements liés aux clicks de souris et à l'état des touches du clavier : Shift/Maj et Ctrl, de même que pour la gestion du drag and drop.


Maintenant, j'ai intérêt à ce que cela marche sinon mes oreilles vont siffler!

Au plaisir de vous lire.

Jean-Jacques.

[Invité]

Je suis affolé par le bas niveau de mes connaissances en delphi [...]

J'ai ressenti cela pendant 10 jours avec FireMokey, son LiveBindings et ses styles

Mais on n'a pas à s'affoler. En y réfléchissant, ces IDE, ils sont fait pour leurs utilisateurs...
Alors, une nouvelle approche sans documentation adaptée pour apprendre ou des TStringGrids sans les fonctions élémentaires usuelles implantées, c'est cela qui est affolant !

Bonne fin de WE. Cordialement. Gilles

[jjnoui]

Bonsoir,
Comme espéré, la mécanique de drag and drop d'une ou plusieurs zones fonctionne correctement (en tout cas tant qu'un bug n'a pas été trouvé )

Il me reste:

tester encore un petit peu
- voir les perfs
- faire le ménage dans le code
- définir les contraintes d'utilisation :

pas d'ajout de colonne en dynamique par exemple
ni d'utilisation de ColsCount (sauf si on n'oublie pas de tenir compte de la colonne ajoutée par mes soins)

Tout cela pour dire que ce n'est pas encore demain que je vous livrerai l'exemple

Bonne soirée à tous

Jean-Jacques

[jjnoui]

Bonjour à tous.
Après divers déboires (disque hs après sauvegarde d'un mois, remplacement et réorganisation des disques, sauvegardes, récupération sur un dump en binaire du disque physique hs du maximum de données)
me voilà de nouveau opérationnel pour mes tests.

Voici donc 3 fichiers :

le source en pascal (28K)

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
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
 
unit UTstGrid;
{$Define Chrono}             // mise en oeuvre du calcul de temps CPU
{$Define ChronoVerbose}      // affichage détaillé des opérations (génère la définition de Chrono)
{$Define StringGridTest}     // remplissage automatique des cellules
 
 
{$IfDef ChronoVerbose}
// par sécurité, si Chrono n'est pas défini (mise en commentaire de la ligne de définition par exemple), on le définit ici
  {$IfnDef Chrono}
    {$Define Chrono}
  {$EndIf}
{$EndIf}
 
{
La form contient :
 
un stringgrid nommé : StringGrid1,
 
  les options de StringGrid1 :
 
      GoRangeSelect = True
      GoRowSelect = True
      GoThumbTracking = True
 
 
  les évènements attachés à StringGrid1 :
 
    OnDrawCell  traité avec la procédure  : StringGrid1DrawCell
    OnKeyDown   traité avec la procédure  : StringGrid1KeyDown
    OnKeyUp     traité avec la procédure  : StringGrid1KeyUp
    OnMouseDown traité avec la procédure  : StringGrid1MouseDown
    OnMouseUp   traité avec la procédure  : StringGrid1MouseUp
 
 
un menu principal nommé : MainMenu1, le sous-menu de MainMenu1 :
 
    MnuEdit qui est décomposé en sous-menus :
 
      MnuSelectAll    qui traite l'évènement OnClick avec la procédure : MnuSelectAllClick
      MnuUnSelect     qui traite l'évènement OnClick avec la procédure : MnuUnselectAllClick
      MnuInvertSelect qui traite l'évènement OnClick avec la procédure : MnuInvertSelectClick
 
 
 
 
// plus d'infos sur Grids : http://wiki.lazarus.freepascal.org/Grids_Reference_Page
}
{$mode objfpc}{$H+}
 
interface
 
uses
  Math, lclintf,  StrUtils,
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids,
  StdCtrls, Menus;
 
type
{$IfDef Chrono}
  EPiDException = class(Exception);
{$EndIf}
 
  { TForm1 }
 
  TForm1 = class(TForm)
    BtnTester: TButton;
    BtnClearButton3: TButton;
    MainMenu1: TMainMenu;
    Memo1: TMemo;
    MnuUnSelect: TMenuItem;
    MnuInvertSelect: TMenuItem;
    MnuselectAll: TMenuItem;
    MnuEdit: TMenuItem;
    StringGrid1: TStringGrid;
    procedure BtnClearButton3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure BtnTesterClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MnuSelectAllClick(Sender: TObject);
    procedure MnuInvertSelectClick(Sender: TObject);
    procedure MnuUnSelectClick(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
      aRect: TRect; aState: TGridDrawState);
    procedure StringGrid1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure StringGrid1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { private declarations }
    procedure RowSelect;
    procedure DragnDrop;
    procedure DragnDropSimple;
    procedure DragnDropMultiple;
  public
    { public declarations }
//  type
  end;
 
{$IfDef Chrono}
  type
    TaCPU = array [1..4] of longint;
{$EndIf}
 
var
  Form1: TForm1;
 
implementation
var
{$IfDef Chrono}
  sPId : string;
  aCPU : TaCPU;
  CPUFile : TextFile;
  ZCPUFile : string;
  CPU : float;
{$EndIf}
 
  FirstRow : longint;                    // nombre de lignes de titre dans le stringgrid
  mIsRowSelected : integer;              // numéro de la colonne ajoutée  dans le stringgrid pour y inscrire un '*' si la ligne est sélectionnée
 
  MultiSelect,                           // témoin de sélection de plusieurs zone dans le stringgrid
  KeyShiftFlag,                          // témoin de la touche Shift/Maj, reste à true tant que la touche est pressée
  KeyControlFlag : boolean;              // témoin de la touche Control/Ctrl, reste à true tant que la touche est pressée
 
  CurrentColumn, CurrentRow,             // pointe sur la cellule qui vient d'être 'cliquée'
 
  SelectedRowFirst,                      // première ligne sélectionnée dans le stringgrid (*)
  SelectedRowLast,                       // dernière ligne sélectionnée dans le stringgrid (*)
                                         // (*) ATTENTION il peut y avoir plus d'un bloc dans la plage SelectedRowFirst <---> SelectedRowLast
 
  SelectedRowPrevious,                   // ligne sélectionnée au traitement précédent (sert pour la sélection de lignes)
  SelectedRowsCount : longint;           // nombre de lignes sélectionnées dans le stringgrid
  ZRowCount,
  ZColCount : longint;
  ZTarget : longint;
 
{$R *.lfm}
 
{ TForm1 }
 
 
{$IfDef Chrono}
procedure GetPId;
begin
  sPId := '/proc/' + InttoStr(GetProcessID) + '/stat';
  if not (FileExists(sPId)) then begin
    raise EPIdException.Create('le fichier ' + sPId + ' n''existe pas');
    Halt(1);
  end;
end;
 
function GetCPU(const aOldCPU : TaCPU; Delta : boolean) : TaCPU;
var
  aDeltaCPU : TaCPU;
  i : integer;
begin
  try
    AssignFile(CPUFile, sPId);
    Reset(CPUFile);
    ReadLn(CPUFile, ZCPUFile);
    if (Delta) then
      for i := 1 to 4 do
        aDeltaCPU := aOldCPU
      else
        for i := 1 to 4 do
          aDeltaCPU[i] := 0;
    for i := 1 to 4 do
      Result[i] := StrtoInt(ExtractWord(13 + i,ZCPUFile,  [' '])) - aDeltaCPU[i];
  finally
    CloseFile(CPUFile);
  end;
end;
 
{$EndIf}
 
procedure TForm1.BtnTesterClick(Sender: TObject);
var
  fTstGridIni : TextFile;
  ZCmdFile,
  wCmdFile : string;
  iPos : integer;
  aSelect : array of record
    BeginSel,
    EndSel : longint;
  end;
 
procedure CmdError(Msg : string);
begin
  ShowMessage(Msg);
  Halt(1);
end;
 
procedure GetCmd;
var
  Cmd : string;
begin
  iPos := pos(':', wCmdFile);
  if (iPos = 0) then
    CmdError('Il manque le '':''' + chr(13) + 'dans ''' + ZCmdFile +'''' + chr(13) + 'abandon du traitement');
  Cmd := Copy(wCmdFile, 1, iPos - 1);
  Delete(wCmdFile, 1 , iPos);
  wCmdFile := trim(wCmdFile);
end;
 
procedure StringGridProceed;
var
  i, j : integer;
begin
{$IfDef Chrono}
    aCPU := GetCpu(aCPU, false);
  {$IfDef ChronoVerbose}
  memo1.lines.add('----------------------------------------------------------------');
  {$EndIf}  // ChronoVerbose
{$EndIf} // Chrono
// creation du stringgrid selon les consignes du fichier ini
  StringGrid1.free;
  StringGrid1 := TStringGrid.Create(Form1);
  with StringGrid1 do begin
    Parent := Form1;
    Left := 728;
    Height := 808;
    Top := 48;
    Width := 264;
    ColCount := 14;
    FixedCols := 0;
    Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSelect, goThumbTracking, goSmoothScroll];
    RowCount := 3;
    TabOrder := 0;
    OnDrawCell := @StringGrid1DrawCell;
    OnKeyDown := @StringGrid1KeyDown;
    OnKeyUp := @StringGrid1KeyUp;
    OnMouseDown := @StringGrid1MouseDown;
    OnMouseUp := @StringGrid1MouseUp;
    for i := 1 to ZColCount do
      Columns.Add;
    StringGrid1.RowCount := ZRowCount + 1;
    visible := false;
  end;
  FirstRow := StringGrid1.FixedRows;      // nombre de ligne(s) de titre
 
// ajout de la colonne d'indicateur de sélection
  StringGrid1.Columns.Add;
  mIsRowSelected := StringGrid1.ColCount - 1;
  StringGrid1.Columns[mIsRowSelected].Width := 26;
  {$IfDef StringGridTest}  // pour tester le mécanisme on présente différement le stringgrid
// remplissage des titres
  if (FirstRow > 0) then
    for i := 0 to StringGrid1.colcount - 2 do begin
      StringGrid1.Cells[i , 0] := 'titre ' + inttostr(i);
    end;
 
// remplissage des cellules pour mieux voir le traitement ensuite
  for i := FirstRow to StringGrid1.rowcount - 1 do   // remplissage des cellules pour mieux voir le traitement ensuite
    for j := 0 to StringGrid1.colcount - 2 do begin
      StringGrid1.Cells[j , i] := ' * ' + inttostr(i) + ' * ' + inttostr(j);
    end;
  StringGrid1.Cells[mIsRowSelected , 0] := '- * -';
  {$Else}
  StringGrid1.Columns[mIsRowSelected].Visible := false;  //  on cache la colonne ajoutée
  {$EndIf}
 
  // initalisation des témoins
  MultiSelect      := false;
  KeyControlFlag   := false;
  KeyShiftFlag     := false;
  SelectedRowFirst := FirstRow;
  SelectedRowLast  := StringGrid1.rowcount - 1;
{$IfDef Chrono}
    aCPU := GetCpu(aCPU, true);
  {$IfDef ChronoVerbose}
  CPU := (aCPU[1] + aCPU[2] + aCPU[3] + aCPU[4]) / 100;
  memo1.lines.add(format('Création d''un tableau de %D lignes par %D colonnes (utiles), soit %D cellules en %.2F seconde(s) soit une moyenne de %.0F Cellules par seconde',
                   [ZRowCount,
                    ZColCount,
                    ZRowCount * ZColCount,
                    CPU,
                    ZRowCount * ZColCount / CPU]));
  memo1.lines.add('----------------------------------------------------------------');
  {$EndIf}  // ChronoVerbose
  aCPU := GetCpu(aCPU, false);
{$EndIf}   //  Chrono
// sélection des lignes
  for i := 0 to Length(aSelect) - 1 do begin
{$IfDef ChronoVerbose}
    memo1.lines.add('selection de(s) ligne(s) ' + inttostr(aSelect[i].BeginSel) + ' à ' + inttostr(aSelect[i].EndSel));
{$EndIf}  // ChronoVerbose
    for j := aSelect[i].BeginSel to aSelect[i].EndSel do
      StringGrid1.Cells[mIsRowSelected , j] := '*';
  end;
{$IfDef Chrono}
    aCPU := GetCpu(aCPU, true);
  {$IfDef ChronoVerbose}
  memo1.lines.add('----------------------------------------------------------------');
  memo1.lines.add('Sélection des lignes en ' +
                   format('%F seconde(s)', [(aCPU[1] + aCPU[2] + aCPU[3] + aCPU[4]) / 100]));
  memo1.lines.add('----------------------------------------------------------------');
  {$EndIf}  // ChronoVerbose
{$EndIf}    // Chrono
// preparation et appel au drag and drop
  if (length(aSelect) < 2) then
    MultiSelect := false
  else
    MultiSelect := true;
  CurrentRow := ZTarget;
  SelectedRowsCount := 0;
  SelectedRowFirst := StringGrid1.rowcount;
  SelectedRowLast := 1;
  for i := 0 to length(aSelect) - 1 do begin
    SelectedRowFirst := min(SelectedRowFirst, aSelect[i].BeginSel);
    SelectedRowLast := max(SelectedRowLast, aSelect[i].EndSel);
    SelectedRowsCount := SelectedRowsCount + aSelect[i].EndSel - aSelect[i].BeginSel + 1;
  end;
{$IfDef ChronoVerbose}
 
  memo1.lines.add('----------------------------------------------------------------');
  memo1.lines.add(format('Déplacement en %D de %D ligne(s) sélectionnée(s); 1ère ligne : %D, dernière ligne : %D',
                         [CurrentRow,
                          SelectedRowsCount,
                          SelectedRowFirst,
                          SelectedRowLast]));
  memo1.lines.add('----------------------------------------------------------------');
{$EndIf}  // ChronoVerbose
  DragnDrop;
end;
 
begin
// lecture du fichier ini
//  memo1.Clear;
  ZRowCount := 0;
  if not (FileExists('TstGrid.ini')) then
    CmdError('le fichier TstGrid.ini n''existe pas');
  AssignFile(fTstGridIni, 'TstGrid.ini');
  Reset(fTstGridIni);
{$IfDef ChronoVerbose}
  memo1.lines.add('----------------------------------------------------------------');
{$EndIf} //  ChronoVerbose
  While not (Eof(fTstGridIni)) do begin
    ReadLn(fTstGridIni, ZCmdFile);
    ZCmdFile := trim(ZCmdFile);
    if ((pos('#', ZCmdFile) = 1) or (ZCmdFile = '')) then begin  // ligne de commentaires
{$IfDef ChronoVerbose}
      memo1.lines.add(ZcmdFile);
{$EndIf} //  ChronoVerbose
      continue;
    end;
    wCmdFile := ZcmdFile + '#';
{$IfDef ChronoVerbose}
    memo1.lines.add(ZcmdFile);
{$EndIf} //  ChronoVerbose
    wCmdFile :=  UpperCase(Trim(wCmdFile));
    if (copy(wCmdFile, 1, 2) = 'EX') then begin  // commande execute
      if (ZRowcount = 0) then
        CmdError('Les dimensions du tableau ne sont pas correctement définies, abandon');
      if (Length(aSelect) = 0) then
        CmdError('Aucune ligne sélectionnée, abandon');
      StringGridProceed;
      SetLength(aSelect, 0);
    end
    else begin
    if (copy(wCmdFile, 1, 2) = 'SE') then begin  // commande select
      GetCmd;
      SetLength(aSelect, Length(aSelect) + 1);
      iPos := pos(',',wCmdFile);          // extraction de la 1ère valeur (ici ligne début de zone sélectionnée)
      if not (TryStrtoint(Trim(Copy(wCmdFile, 1, iPos - 1)), aSelect[Length(aSelect) - 1].BeginSel)) then
        CmdError('Dans ' + ZCmdFile +', la valeur ''' + Copy(wCmdFile, 1, iPos - 1) + ''' n''est pas une valeur numérique, abandon');
      Delete(wCmdFile, 1 , iPos);
      iPos := pos('#',wCmdFile);          // extraction de la 2ème valeur (ici ligne fin de zone sélectionnée)
      if (iPos = 0) then
        iPos := length(wCmdFile);
      if not (TryStrtoint(Trim(Copy(wCmdFile, 1, iPos - 1)), aSelect[Length(aSelect) - 1].EndSel)) then
        CmdError('Dans ' + ZCmdFile +', la valeur ''' + Copy(wCmdFile, 1, iPos - 1) + ''' n''est pas une valeur numérique, abandon');
      if (aSelect[Length(aSelect) - 1].EndSel > ZRowCount) then
        CmdError('Dans ''' + ZCmdFile + '''' + chr(13) + 'la dernière ligne à sélectionner' + chr(13) + '''' +
                  Copy(wCmdFile, 1, iPos - 1) + ''' dépasse la taille du stringgrid (' +
                  inttostr(ZRowCount) + '), abandon');
    end
    else
      if (copy(wCmdFile, 1, 2) = 'DR') then begin  // commande drang and drop
        GetCmd;
        iPos := pos('#',wCmdFile);          // extraction de la 1ère valeur (ici la ligne où déplacer les zones sélectionnées)
        if not (TryStrtoint(Trim(Copy(wCmdFile, 1, iPos - 1)), ZTarget)) then
          CmdError('Dans ' + ZCmdFile +', la valeur ''' + Copy(wCmdFile, 1, iPos - 1) + ''' n''est pas une valeur numérique, abandon');
    end
    else
      if (copy(wCmdFile, 1, 2) = 'ST') then begin  // commande stringgrid
        GetCmd;
        iPos := pos(',',wCmdFile);          // extraction de la 1ère valeur (ici RowCount)
        if not (TryStrtoint(Trim(Copy(wCmdFile, 1, iPos - 1)), ZRowCount)) then
          CmdError('Dans ' + ZCmdFile +', la valeur ''' + Copy(wCmdFile, 1, iPos - 1) + ''' n''est pas une valeur numérique, abandon');
        Delete(wCmdFile, 1 , iPos);
        iPos := pos('#',wCmdFile);          // extraction de la 2ème valeur (ici ColCount)
        if (iPos = 0) then
          iPos := length(wCmdFile);
        if not (TryStrtoint(Trim(Copy(wCmdFile, 1, iPos - 1)), ZColCount)) then
          CmdError('Dans ' + ZCmdFile +', la valeur ''' + Copy(wCmdFile, 1, iPos - 1) + ''' n''est pas une valeur numérique, abandon');
    end
    else
      if (copy(wCmdFile, 1, 2) = 'EN') then begin  // commande end
        break;
      end;
    end;
  end;
  CloseFile(fTstGridIni);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
{$IfDef Chrono}
  GetPId;
  aCPU := GetCpu(aCPU, false);
  {$IfnDef ChronoVerbose}
  memo1.lines.add('lignes;colonnes;lignes déplacées;cellules déplacées;Cellules/seconde;cpu');
  {$EndIf} // ChronoVerbose
{$EndIf} //  Chrono
end;
 
procedure TForm1.BtnClearButton3Click(Sender: TObject);
begin
  Memo1.Clear;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
 
end;
 
procedure TForm1.MnuSelectAllClick(Sender: TObject);
var
  i : integer;
begin
  SelectedRowFirst := FirstRow;
  SelectedRowLast := StringGrid1.rowcount - 1;
  for i := SelectedRowFirst to SelectedRowLast do
    StringGrid1.Cells[mIsRowSelected , i] := '*';
  SelectedRowsCount := StringGrid1.rowcount -1;
  StringGrid1.Invalidate; // Rafraichissement de l'affichage du stringgrid
end;
 
procedure TForm1.MnuInvertSelectClick(Sender: TObject);
var
  i : integer;
begin
  SelectedRowFirst := FirstRow;
  SelectedRowLast := StringGrid1.rowcount - 1;
  for i := SelectedRowFirst to SelectedRowLast do
    if (StringGrid1.Cells[mIsRowSelected , i] = '*') then begin
      StringGrid1.Cells[mIsRowSelected , i] := ' ';
      dec(SelectedRowsCount);
    end
    else begin
      StringGrid1.Cells[mIsRowSelected , i] := '*';
      inc(SelectedRowsCount);
    end;
  StringGrid1.Invalidate; // Rafraichissement de l'affichage du stringgrid
end;
 
procedure TForm1.MnuUnSelectClick(Sender: TObject);
var
  i : integer;
begin
  SelectedRowFirst := FirstRow;
  SelectedRowLast := StringGrid1.rowcount - 1;
  for i := SelectedRowFirst to SelectedRowLast do // on désélectionne tout
    StringGrid1.Cells[mIsRowSelected , i] := ' ';
  SelectedRowsCount := 0;
  StringGrid1.Invalidate; // Rafraichissement de l'affichage du stringgrid
end;
 
procedure TForm1.DragnDropSimple;
var
  i : integer;
begin
  if (SelectedRowLast < CurrentRow) then begin
    for i:= SelectedRowFirst to SelectedRowLast do begin      // la zone sélectionnée est en aval de la ligne destinataire
      StringGrid1.Cells[mIsRowSelected , SelectedRowFirst] := ' ';
      StringGrid1.MoveColRow(false, SelectedRowFirst, CurrentRow - 1);
    end;
  end
  else begin
    for i:= SelectedRowFirst to SelectedRowLast do begin     // la zone sélectionnée est en amont de la ligne destinataire
      StringGrid1.Cells[mIsRowSelected , SelectedRowLast] := ' ';
      StringGrid1.MoveColRow(false, SelectedRowLast, CurrentRow);
    end;
  end;
end;
 
procedure TForm1.DragnDropMultiple;
// kaf var
// kaf i : integer;
begin
  if (SelectedRowFirst > CurrentRow) then begin  // l'ensemble des zones sélectionnées se situe en aval de la ligne destinataire
    while not (SelectedRowLast < SelectedRowFirst) do begin // boucle sur l'ensemble des zones sélectionnées
      if (StringGrid1.Cells[mIsRowSelected , SelectedRowLast] = '*') then begin
        StringGrid1.Cells[mIsRowSelected , SelectedRowLast] := ' ';
        StringGrid1.MoveColRow(false, SelectedRowLast, CurrentRow);
      end
      else
      dec(SelectedRowLast);
    end;
  end
  else begin
    if (SelectedRowLast < CurrentRow) then begin  // l'ensemble des zones sélectionnées se situe en amont de la ligne destinataire
      while not (SelectedRowFirst = SelectedRowLast) do begin // boucle sur l'ensemble des zones sélectionnées
        if (StringGrid1.Cells[mIsRowSelected , SelectedRowFirst] = '*') then begin
          StringGrid1.Cells[mIsRowSelected , SelectedRowFirst] := ' ';
          StringGrid1.MoveColRow(false, SelectedRowFirst, CurrentRow -1);
        end
        else
          inc(SelectedRowFirst);
        end;
    end
    else begin // l'ensemble des zones sélectionnées se situe de part et d'autre de la zone destinataire
           // on traite d'abord les lignes situées en aval de la ligne destinataire
      while not (SelectedRowLast < CurrentRow) do begin // boucle sur l'ensemble des zones sélectionnées
        if (StringGrid1.Cells[mIsRowSelected , SelectedRowLast] = '*') then begin
          StringGrid1.Cells[mIsRowSelected , SelectedRowLast] := ' ';
          StringGrid1.MoveColRow(false, SelectedRowLast, CurrentRow);
        end
        else
        dec(SelectedRowLast);
      end;
           // puis on traite les lignes situées en amont de la ligne destinataire
      while (SelectedRowFirst < CurrentRow) do begin // boucle sur les zones sélectionnées en amont de la ligne destinataire
        if (StringGrid1.Cells[mIsRowSelected , SelectedRowFirst] = '*') then begin
          StringGrid1.Cells[mIsRowSelected , SelectedRowFirst] := ' ';
          StringGrid1.MoveColRow(false, SelectedRowFirst, CurrentRow - 1);
        end
        else
          inc(SelectedRowFirst);
      end;
    end;
  end
end;
 
procedure TForm1.DragnDrop;
// kaf var
// kaf i : integer;
begin
  StringGrid1.BeginUpdate;
{$IfDef Chrono}
  aCPU := GetCpu(aCPU, false);
{$EndIf}
  if MultiSelect then
    DragnDropMultiple                // multiples zones sélectionnées il faut balayer de la 1ère ligne sélectionnée à la dernière
  else
    DragnDropSimple;                 // une seule zone sélectionnée, on ne traite que du début à la fin de celle-ci
{$IfDef Chrono}
  aCPU := GetCpu(aCPU, true);
  CPU := (aCPU[1] + aCPU[2] + aCPU[3] + aCPU[4]) / 100;
  {$IfDef ChronoVerbose}
  memo1.lines.add('Drag and drop de ' + format('%D cellules en ', [SelectedRowsCount * ZColCount]) +
                   format('%.2F seconde(s) soit une moyenne de ', [CPU]) +
                   format('%.0F Cellules par seconde', [SelectedRowsCount * ZColCount / CPU]));
  memo1.lines.add('----------------------------------------------------------------');
  {$Else}
//  lignes;colonnes;lignes déplacées;cellules déplacées;Cellules/seconde;cpu
 
  memo1.lines.add(
                  format('%D;', [ZRowCount]) +  // Lignes;
                  format('%D;', [ZColCount]) +  // Colonnes;
                  format('%D;', [SelectedRowsCount]) +  // Lignes déplacées;
                  format('%D;', [SelectedRowsCount * ZColCount]) +  // cellules déplacées;
                  format('%.0F;', [SelectedRowsCount * ZColCount / CPU]) + // Cellules/seconde;
                  format('%.2F;', [CPU]));                         // CPU
  {$EndIf} // ChronoVerbose
{$EndIf} // Chrono
  SelectedRowsCount := 0;
  MultiSelect := false;
  StringGrid1.visible := true;
  StringGrid1.EndUpdate;
end;
 
procedure TForm1.RowSelect;
var
  i : integer;
begin
  for i := FirstRow to StringGrid1.RowCount-1 do // désélectionne tout
    StringGrid1.Cells[mIsRowSelected , i] := ' ';
  StringGrid1.Cells[mIsRowSelected , CurrentRow] := '*';  // puis on sélectionne la ligne courante
  SelectedRowFirst := CurrentRow;
  SelectedRowLast   := CurrentRow;
  SelectedRowsCount := 1;
  MultiSelect := false;
end;
 
procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Stringgrid1.MouseToCell(X, Y, CurrentColumn, CurrentRow);  // Memorise la ligne sélectionnée, la colonne n'est pas exploitée ici
  if (CurrentRow < FirstRow) then             // pas de traitement sur les lignes de titre
    exit;
  if (KeyShiftFlag) then                      // Click gauche + touche Maj/Shift déjà traité dans OnMouseDown
    exit;
  if (KeyControlFlag) then                    // Click gauche + touche Control/Ctrl déjà traité dans OnMouseDown
    exit;
  if (SelectedRowPrevious = CurrentRow) then  // il n'y a pas eu de déplacement de la souris pendant appui sur le bouton, il s'agit donc d'une nouvelle sélection
     RowSelect
  else
    DragnDrop;
  StringGrid1.Invalidate; // Rafraichissement de l'affichage du stringgrid
end;
 
procedure TForm1.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i : integer;
begin
//--------------------------------------------------------------------------------------------------------------------------------------------------------*
// toutes les actions de sélection et désélection de ligne(s) se font ici sauf pour le Drag and drop qui comprend une partie de traitement dans OnMouseUp *
//--------------------------------------------------------------------------------------------------------------------------------------------------------*
 
 
  Stringgrid1.MouseToCell(X, Y, CurrentColumn, CurrentRow);  // Memorise la ligne sélectionnée, la colonne n'est pas exploitée ici
 
// ------------- début Maj/Shift + click --------------------------------------------------
  if (KeyShiftFlag) then begin     // Click gauche + touche Maj/Shift pour indiquer la fin d'un bloc à sélectionner
    if (SelectedRowPrevious = -1) then // pas de début de bloc défini
      // do nothing
    else begin
      for i:= min(CurrentRow, SelectedRowPrevious) to max(CurrentRow, SelectedRowPrevious) do begin // sélection des lignes du bloc
        if not (StringGrid1.Cells[mIsRowSelected , i] = '*') then begin
          StringGrid1.Cells[mIsRowSelected , i] := '*';
          inc(SelectedRowsCount);
        end;
        SelectedRowFirst := min(i, SelectedRowFirst);
        SelectedRowLast  := max(i, SelectedRowLast);
      end;
    end;
    MultiSelect := false;
  end
// ------------- fin Maj/Shift + click ----------------------------------------------------
 
  else begin
 
// ------------- début Control + click ----------------------------------------------------
    if (KeyControlFlag) then begin                                 // Click gauche + touche Control/Ctrl pour inverser la sélection de la ligne courante
      if (StringGrid1.Cells[mIsRowSelected , CurrentRow] = '*') then begin  // inversion de la sélection de la ligne courante
        StringGrid1.Cells[mIsRowSelected , CurrentRow] := ' ';
        dec(SelectedRowsCount);
      end
      else begin
        StringGrid1.Cells[mIsRowSelected , CurrentRow] := '*';
        inc(SelectedRowsCount);
      end;
     if (StringGrid1.Cells[mIsRowSelected , CurrentRow] = '*') then begin  // ligne sélectionnée
        SelectedRowFirst := min(CurrentRow, SelectedRowFirst);
        SelectedRowLast  := max(CurrentRow, SelectedRowLast);
      end
      else begin  // ligne déselectionnée  // mise à jour de SelectedRowFirst
        if (SelectedRowsCount > 0) then begin
          if (CurrentRow = SelectedRowFirst) then begin
            for i:= CurrentRow to SelectedRowLast do begin
              if (StringGrid1.Cells[mIsRowSelected , i] = '*') then begin
                SelectedRowFirst := i;
                break;
              end;
            end;
          end;
          if (CurrentRow = SelectedRowLast) then begin   // mise à jour de SelectedRowLast
            for i:= CurrentRow downto SelectedRowFirst do begin
              if (StringGrid1.Cells[mIsRowSelected , i] = '*') then begin
                SelectedRowLast := i;
                break;
              end;
            end;
          end;
        end;
      end;
      if (SelectedRowsCount > 1) then                    // plusieurs blocs de ligne sélectionnés
        MultiSelect := true
      else
        MultiSelect := false;
    end
// ------------- fin Control + click ------------------------------------------------------
 
    else begin
 
// ------------- début click --------------------------------------------------------------
      SelectedRowPrevious := CurrentRow;
    end;
  end;
// ------------- fin click ----------------------------------------------------------------
  StringGrid1.Invalidate; // Rafraichissement de l'affichage du stringgrid
end;
 
procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
  aRect: TRect; aState: TGridDrawState);
begin
  with Sender as TStringGrid do
    with Canvas do begin
     if (Cells[mIsRowSelected, aRow] = '*') then begin  // on colorie en rouge les lignes sélectionnées
        Brush.Color := clRed;
        Font.Color := clWhite;
      end
      else begin
        Brush.Color := clWindow;
        Font.Color :=  ClBlack;
      end;
      { Dessin du fond }
      FillRect(aRect);
      { Dessin du texte }
      TextOut(aRect.Left,aRect.Top,Cells[aCol,aRow]);
    end;
end;
 
procedure TForm1.StringGrid1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  KeyShiftFlag   := (key = 16);      // on  positionne KeyShiftFlag à l'appui sur la touche Maj
  KeyControlFlag := (key = 17);      // on  positionne KeyControlFlag à l'appui sur la touche Control
end;
 
procedure TForm1.StringGrid1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = 16 then KeyShiftFlag := false;    // on ne positionne KeyShiftFlag que tant que la touche Maj est appuyée
  if key = 17 then KeyControlFlag := false;  // on ne positionne KeyControlFlag que tant que la touche Control est appuyée
end;
 
end.

le fichier lfm associé (2k)

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
 
object Form1: TForm1
  Left = 891
  Height = 868
  Top = 277
  Width = 1022
  Caption = 'Form1'
  ClientHeight = 868
  ClientWidth = 1022
  Menu = MainMenu1
  OnCreate = FormCreate
  LCLVersion = '1.0.12.0'
  object StringGrid1: TStringGrid
    Left = 728
    Height = 808
    Top = 48
    Width = 264
    ColCount = 3
    Columns = <    
      item
        Title.Caption = 'Title 0'
      end    
      item
        Title.Caption = 'Title 1'
      end    
      item
        Title.Caption = 'Title 2'
      end>
    FixedCols = 0
    Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSelect, goThumbTracking, goSmoothScroll]
    RowCount = 10
    TabOrder = 0
    OnDrawCell = StringGrid1DrawCell
    OnKeyDown = StringGrid1KeyDown
    OnKeyUp = StringGrid1KeyUp
    OnMouseDown = StringGrid1MouseDown
    OnMouseUp = StringGrid1MouseUp
  end
  object Memo1: TMemo
    Left = 8
    Height = 808
    Top = 48
    Width = 704
    ScrollBars = ssAutoBoth
    TabOrder = 1
  end
  object BtnTester: TButton
    Left = 144
    Height = 25
    Top = 8
    Width = 75
    Caption = 'Tester'
    OnClick = BtnTesterClick
    TabOrder = 2
  end
  object BtnClearButton3: TButton
    Left = 240
    Height = 25
    Top = 8
    Width = 75
    Caption = 'Clear'
    OnClick = BtnClearButton3Click
    TabOrder = 3
  end
  object MainMenu1: TMainMenu
    left = 340
    top = 57
    object MnuEdit: TMenuItem
      Caption = '&Edition'
      object MnuSelectAll: TMenuItem
        Caption = '&Sélectionner tout   CTL + A'
        OnClick = MnuSelectAllClick
      end
      object MnuUnSelect: TMenuItem
        Caption = '&Désélectionner tout'
        OnClick = MnuUnSelectClick
      end
      object MnuInvertSelect: TMenuItem
        Caption = '&Inverser la sélection'
        OnClick = MnuInvertSelectClick
      end
    end
  end
end

le fichier ini (1k) qui gère les tests

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
 
    # tout ligne commençant par '#' est considérée comme un commentaire
toute ligne vide 
ou commençant par une commande inconnue est considérée comme un commentaire
#
# le traitement est insensible aux majuscules/minuscules
#
# les espaces sont supprimés avant traitement
#
# chaque commande est reconnue uniquement par ses 2 premiers caractères, le reste .....!
#
# toutes les commandes qui ont un ou des paramètres sont séparées de celui/ceux ci par ':'
#
# les paramètres sont séparés entre eux par ','
#
#
#                                format des commandes :
#
#   stringrid :       xxx,  yyy   création d''un nouveau stringgrid avec en paramètres
#                     xxx = nombre de lignes  
#                     yyy = nombre de colonnes 
#
#   Select :          xxx,  yyy   Sélection d''une ou plusieurs lignes contigues avec en paramètres
#                     xxx = rang de la 1ère ligne  
#                     yyy = rang de la dernière ligne (pour une seule ligne xxx et yyy sont égaux) 
#
#   Drag and drop :   xxx   indication de l'emplacement d'insertion avec en paramètre
#                     xxx = inserer les lignes sélectionnées devant la ligne xxx 
#
#   execute :         traitement des commandes précédentes
#
#
#              EN ROUTE !
stringgrid : 10,100  
Select : 1, 8  
Drag and drop : 10   
Execute 
#
stringgrid : 100,10  
Select : 1, 98  
Drag and drop : 100   
Execute 
#
stringgrid :100,100  
Select : 1, 98  
Drag and drop : 100   
Execute 
#
stringgrid : 1000,10  
Select : 1, 998  
Drag and drop : 1000   
Execute 
#
stringgrid : 1000,100  
Select : 1, 998  
Drag and drop : 1000   
Execute 
#
stringgrid : 10000,10  
Select : 1, 9998  
Drag and drop : 10000   
Execute 
#
stringgrid : 10000,100 
Select : 1, 9998  
Drag and drop : 10000   
Execute 
#
stringgrid : 100000,10  
Select : 1, 99998  
Drag and drop : 100000   
Execute 
End

La contrainte unique me semble-t'il pour mettre en oeuvre dans un programme réel est de ne pas utiliser les propriétés qui font référence au nombre de colonnes puisqu'il y en a une d'ajoutée.

Voici le résultat de quelques essais avec un Athlon X64 3800+, Ubuntu 12.04, aucune modification des options de Lazarus (il faudra que j'apprenne à gérer ses options).

La mesure du cpu se base sur le contenu en dynamique du fichier /proc/stat (tout est dans le source).


Création d'un tableau de 10 lignes par 100 colonnes (utiles), soit 1000 cellules
Drag and drop de 800 cellules en 0.00 seconde(s) soit une moyenne non quantifiable
----------------------------------------------------------------
Création d'un tableau de 100 lignes par 10 colonnes (utiles), soit 1000 cellules
Drag and drop de 980 cellules en 0.00 seconde(s) soit une moyenne non quantifiable
----------------------------------------------------------------
Création d'un tableau de 100 lignes par 100 colonnes (utiles), soit 10000 cellules
Drag and drop de 9800 cellules en 0.00 seconde(s) soit une moyenne non quantifiable
----------------------------------------------------------------
Création d'un tableau de 1000 lignes par 10 colonnes (utiles), soit 10000 cellules
Drag and drop de 9980 cellules en 0.03 seconde(s) soit une moyenne de 332667 Cellules par seconde
----------------------------------------------------------------
Création d'un tableau de 1000 lignes par 100 colonnes (utiles), soit 100000 cellules
Drag and drop de 99800 cellules en 0.68 seconde(s) soit une moyenne de 146765 Cellules par seconde
----------------------------------------------------------------
Création d'un tableau de 10000 lignes par 10 colonnes (utiles), soit 100000 cellules
Drag and drop de 99980 cellules en 8.03 seconde(s) soit une moyenne de 12451 Cellules par seconde
----------------------------------------------------------------
Création d'un tableau de 10000 lignes par 100 colonnes (utiles), soit 1000000 cellules
Drag and drop de 999800 cellules en 65.24 seconde(s) soit une moyenne de 15325 Cellules par seconde
----------------------------------------------------------------
Création d'un tableau de 100000 lignes par 10 colonnes (utiles), soit 1000000 cellules
Drag and drop de 999980 cellules en 768.14 seconde(s) soit une moyenne de 1302 Cellules par seconde
----------------------------------------------------------------


J'attends vos remarques, même positives

Jean-Jacques

[Jipété]

Yep !

C'est ça qu'il te faut ? :

Création d'un tableau de 10 lignes par 100 colonnes (utiles), soit 1000 cellules en 0.01 seconde(s) soit une moyenne de 100000 Cellules par seconde
Drag and drop de 800 cellules en 0.00 seconde(s) soit une moyenne de +Inf Cellules par seconde
----------------------------------------------------------------

Création d'un tableau de 100 lignes par 10 colonnes (utiles), soit 1000 cellules en 0.00 seconde(s) soit une moyenne de +Inf Cellules par seconde
Drag and drop de 980 cellules en 0.00 seconde(s) soit une moyenne de +Inf Cellules par seconde
----------------------------------------------------------------

Création d'un tableau de 100 lignes par 100 colonnes (utiles), soit 10000 cellules en 0.01 seconde(s) soit une moyenne de 1000000 Cellules par seconde
Drag and drop de 9800 cellules en 0.00 seconde(s) soit une moyenne de +Inf Cellules par seconde
----------------------------------------------------------------

Création d'un tableau de 1000 lignes par 10 colonnes (utiles), soit 10000 cellules en 0.01 seconde(s) soit une moyenne de 1000000 Cellules par seconde
Drag and drop de 9980 cellules en 0.01 seconde(s) soit une moyenne de 998000 Cellules par seconde
----------------------------------------------------------------

Création d'un tableau de 1000 lignes par 100 colonnes (utiles), soit 100000 cellules en 0.06 seconde(s) soit une moyenne de 1666667 Cellules par seconde
Drag and drop de 99800 cellules en 0.06 seconde(s) soit une moyenne de 1663333 Cellules par seconde
----------------------------------------------------------------

Création d'un tableau de 10000 lignes par 10 colonnes (utiles), soit 100000 cellules en 0.07 seconde(s) soit une moyenne de 1428571 Cellules par seconde
Drag and drop de 99980 cellules en 0.72 seconde(s) soit une moyenne de 138861 Cellules par seconde
----------------------------------------------------------------

Création d'un tableau de 10000 lignes par 100 colonnes (utiles), soit 1000000 cellules en 0.64 seconde(s) soit une moyenne de 1562500 Cellules par seconde
Drag and drop de 999800 cellules en 5.09 seconde(s) soit une moyenne de 196424 Cellules par seconde
----------------------------------------------------------------

On notera que la 8e étape n'est pas exécutée, en effet sur ma machine j'ai tué le prog après 12 minutes sans rien voir venir alors que les 7 étapes précédentes se sont déroulées plus rapidement que pour toi.

Les linuxiens feront bien de compléter le chemin du .ini, vers la ligne 330 :

Code :

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

1
2
3
4
5
6
// lecture du fichier ini
//  memo1.Clear;
  ZRowCount := 0;
  if not FileExists(ExtractFilePath(Application.ExeName)+'TstGrid.ini') then
    CmdError('le fichier TstGrid.ini n''existe pas');
  AssignFile(fTstGridIni, ExtractFilePath(Application.ExeName)+'TstGrid.ini');

et 8 lignes + bas j'ai rajouté une "respiration" sinon c'était l'horreur (surtout au tout début )

Code :

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

1
2
3
4
5
6
7
{$IfDef ChronoVerbose}
      memo1.lines.add(ZcmdFile);
{$EndIf} //  ChronoVerbose
Application.ProcessMessages; // respirons !
      continue;
    end;
    wCmdFile := ZcmdFile + '#';

[jjnoui]

Bonjour Jipété,

Tout ä fait d'accord avec toi : pour le dernier test j'aurais dû avertir, plus de 700 secondes cpu chez moi (donc entre 15 et 20 minutes de délai!).
J'ai fait ce dernier test juste pour info.

Merci pour tes suggestions, je n'ai pas mis de 'respiration' car il s'agissait d'une tentative de mesure et que je ne voulais pas interférer avec le traitement; bien sûr dans le cadre d'un traitement réel ce serait stupide de ne pas mettre cette 'respiration', mais ce serai peut-être irréel de faire des drag and drop de cette taille sur un tableau aussi grand non?

Pour les performances, c'était juste pour donner un ordre de grandeur avant de se lancer soi-même dans les tests.

Merci donc pour tes remarques et bon dimanche.
Jean-J acques

[Jipété]

Yop !

Tout à fait d'accord avec toi : pour le dernier test j'aurais dû avertir, plus de 700 secondes cpu chez moi (donc entre 15 et 20 minutes de délai!).
J'ai fait ce dernier test juste pour info.

Oui, j'avais bien noté que ton dernier test se déroulait en presque 800 secondes, mais comme le précédent ne prenait que 65 secondes quand chez moi il s'exécutait en seulement 5, je me suis dit que le dernier devrait obligatoirement faire (beaucoup ?) moins que tes presque 800, ce qui ne fut pas le cas

[EDIT]
Je viens de faire le dernier test :
Création d'un tableau de 100000 lignes par 10 colonnes (utiles), soit 1000000 cellules en 0.80 seconde(s) soit une moyenne de 1250000 Cellules par seconde
Drag and drop de 999980 cellules en 1180.06 seconde(s) soit une moyenne de 847 Cellules par seconde
----------------------------------------------------------------
1200 secondes ! 20 minutes ! ! !

Comme quoi, hein, à la louche 10 fois plus vite pour les 7 premiers tests, 2 fois plus lentement pour le dernier
[/EDIT]

Merci pour tes suggestions, je n'ai pas mis de 'respiration' car il s'agissait d'une tentative de mesure et que je ne voulais pas interférer avec le traitement;

Bah, me suis dit qu'une seule respiration à la fin de chaque test n'impacterait pas trop le résultat final et améliorerait "l'expérience utilisateur", comme on dit maintenant

Bon dimanche aussi,

[jjnoui]

A Jipété :
Après Yep, Yop; le prochain c'est quoi

1200 secondes me paraissent beaucoup.
Y avait-il autre chose qui tournait en arrière plan genre mise à jour ou autre ?

Peux-tu, juste pour le fun retenter 2 ou 3 fois de faire transpirer ton cpu en relançant le test ?

A plus

Jean-Jacques