Problème de tri d'un worksheet dans l'environnement Ubuntu

**jjnoui** · 25/04/2022, 00h14

Bonsoir à tous.

Je bute sur un problème de tri avec une clé comportant des espaces.

Pour faire court je joint un source le plus expurgé possible.

la définition de la Form :

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
 
object Fsortdemo: TFsortdemo
  Left = 708
  Height = 302
  Top = 273
  Width = 383
  Caption = 'sortdemo'
  ClientHeight = 302
  ClientWidth = 383
  LCLVersion = '2.2.0.4'
  object BtnLoad: TButton
    Left = 0
    Height = 25
    Top = 0
    Width = 75
    Caption = 'Load'
    OnClick = BtnLoadClick
    TabOrder = 1
  end
  object BtnSort: TButton
    Left = 8
    Height = 25
    Top = 32
    Width = 75
    Caption = 'Sort'
    OnClick = BtnSortClick
    TabOrder = 0
  end
  object ws: TsWorksheetGrid
    Left = 120
    Height = 240
    Top = 16
    Width = 200
    FrozenCols = 0
    FrozenRows = 0
    PageBreakPen.Color = clBlue
    PageBreakPen.Style = psDash
    ReadFormulas = False
    WorkbookSource = wb
    AutoAdvance = aaDown
    DefaultColWidth = 64
    DefaultRowHeight = 24
    TabOrder = 2
  end
  object wb: TsWorkbookSource
    AutoDetectFormat = False
    FileFormat = sfUser
    Options = []
    Left = 24
    Top = 88
  end
end

le code

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
 
unit usortdemo;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics,
  ExtCtrls, Menus, ComCtrls, StdCtrls,
  fpspreadsheetctrls,
  fpsTypes,
  fpsutils,
  fpspreadsheet,
  fpspreadsheetgrid;
 
type
  { TFsortdemo }
  TFsortdemo = class(TForm)
    BtnLoad: TButton;
    BtnSort: TButton;
    ws: TsWorksheetGrid;
    wb: TsWorkbookSource;
  procedure BtnLoadClick(Sender: TObject);
  procedure BtnSortClick(Sender: TObject);
 
  private
  public
end;
 
var
  Fsortdemo: TFsortdemo;
 
implementation
 
{$R *.lfm}
{ TFsortdemo }
 
var
  sortParams: TsSortParams;
 
procedure TFsortdemo.BtnLoadClick(Sender: TObject);
var
  str1, str2, str3, str4, str5, str6 : string;
 
begin
  str1 := 'A Huit';
  str2 := 'ACinq';
  str3 := 'ANeuf';
  str4 := 'xA Huit';
  str5 := 'xACinq';
  str6 := 'xANeuf';
 
  // chargement manuel du Worksheet
  wb.Worksheet.Clear;
  wb.Worksheet.WriteText(0, 0, UTF8toANSI(str1)); // str1 := 'A Huit';
  wb.Worksheet.WriteText(1, 0, UTF8toANSI(str2)); // str2 := 'ACinq';
  wb.Worksheet.WriteText(2, 0, UTF8toANSI(str3)); // str3 := 'ANeuf';
  wb.Worksheet.WriteText(3, 0, str4);             // str4 := 'xA Huit';
  wb.Worksheet.WriteText(4, 0, str5);             // str5 := 'xACinq';
  wb.Worksheet.WriteText(5, 0, str6);             // str6 := 'xANeuf';
end;
 
procedure TFsortdemo.BtnSortClick(Sender: TObject);
begin
  sortParams := InitSortParams(true, 1);              // Col sort, Number of sort (cols or rows)
  sortParams.Keys[0].ColRowIndex := 0;                // ColRowIndex    Index of the sorted column or row
  sortParams.Keys[0].Options := []; //     TsSortOption = (ssoDescending, ssoCaseInsensitive, ssoAlphaBeforeNum)
  wb.Worksheet.Sort(sortParams, 0, 0, wb.worksheet.GetLastRowIndex, wb.worksheet.GetLastColIndex);
end;
 
end.

Image après le chargement des données

Nom : Avant le tri.jpg
Affichages : 530
Taille : 18,9 Ko

Image après le tri

Nom : Après le tri.jpg
Affichages : 518
Taille : 19,8 Ko

Pour moi la chaîne A Huit est inférieure à la chaîne ACinq à cause de l'espace en 2ème position qui est inférieur au C de ACinq

J'ai dû rater quelque chose mais quoi ?
Merci de m'aider.

**BeanzMaster** · 25/04/2022, 08h30

Hello que donnes ton test si toutes les entrées comportent un espace après la première lettre ? Et effectivement tu as raison "A Huit/xA Huit" devraient être avant les "**?Cinq".
Et sous Windows ton "test Lazarus" fonctionne comme il se doit ?
As tu essayé avec l'option ssoCaseInsensitive ?
As tu essayé avec UTF8ToAnsi partout ? (même si je ne pense pas que le problème vienne de là)
As tu essayé avec un stringGrid pour comparer ?

**BeanzMaster** · 25/04/2022, 09h11

Etant curieux j'ai fait une petite recherche et j'ai regardé la fonction compare de FPSpreadSheet. C'est bizarre car le FPSpreadSheet supporte l'UTF8 et utilise UTF8CompareText/UTF8CompareStr et utilise l'algo QuickSort (mais, "non stable")

Essayes d'assigner l'évènement onCompareCells avec un truc du genre :

Code :

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

1
2
3
4
5
6
7
8
9
10
function TMyApp.onCompareCells(Acol, ARow, Bcol, BRow: integer): integer;
var
  A, B: string;
 
begin
    A := TsWorksheet(Sender).ReadAsUTF8Text(ARow - HeaderCount, ACol - HeaderCount);
    B := TsWorksheet(Sender).ReadAsUTF8Text(BRow - HeaderCount, BCol - HeaderCount);
    Result := UTF8CompareText(A, B);
    if (soDescending in TsWorksheet(Sender).options) then Result := -Result;
end;

Cela devrait peut-être corriger le tri, mais pas persuadé.

A+
Jérôme

**jjnoui** · 25/04/2022, 17h56

@BeanzMaster

Attention, c'est chaud!

Bonjour Jérome et bon courage pour la lecture.

Ouh la la je vais avoir une semaine chargée :

- Installer et faire fonctionner Lazarus sous WIndows

- porter le test sur celui-ci.

J'ai fait les tests avec et sans ssoCaseInsensitive et les résultats sont identiques.

Quelque chose me titille dans le code inclus entre les lignes 3450 à 3464 de fpSpreadSheet.pas :

On voit ici les comparaisons AnsiComparexxx mais avec le format UTF8 des cellules (ACellx^.UTF8StringValue)

Je ne comprends pas cette manip.....

Les tests avec pour chaque valeur un espace après le 1er caractères donnent de bons résultats;

Une hypothèse farfelue (enfin pas temps que ça, voir plus bas) serait que les espaces soient considérés comme des caractères de plus fort poids,
cela donnerait alors 'A Huit' devient 'A' suivi d'une valeur de rang plus élevé que le caractère 'z' (comme par exemple x'FF'), suivi de 'Huit' et donc comparé à 'ACINQ' le 2ème caractère 'C' serait inférieur.

Pour étayer ma thèse farfelue au premier abord voir les commentaires (dans les lignes 3428 à 3430) de la fonction :

Code :

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

1
2
3
4
5
function TsWorksheet.DefaultCompareCells(ACell1, ACell2: PCell;
 
 // Sort priority in Excel:
// numbers < alpha < blank (ascending)
// alpha < numbers < blank (descending)

Ces lignes me semblent aberrantes, je n'ai jamais vu cette règle dans Excel.

Les valeurs en hexa des différents caractères :

espace = x'20'
0 a 9 = x'30' à x'39'
A à Z = x'41' à x'5A'
a à z = x'61' à x'7A'

je fais l'impasse sur les autres signes.

Je viens de faire le test avec les mêmes valeurs en Excel et il est OK

J'ai tenté de faire un showmessage avec les contenus en hexa des 2 champs, mais j'ai vu alors une proposition de recompiler fpSpreadSheet.pas;
j'ai pris peur et abandonné cette idée.

Je viens de tenter d'exploiter (ouh le vilain mot!) ta fonction OnCompareCells mais je me ramasse une floppée de messages d'erreur du compilateur.
Je pense qu'une partie de ceux-ci sont dût à ma façon d'insérer ce code

Un peu de précision pour le nunuche

que je suis me serait d'une grande aide.

Comment intégrer cette fonction ?

- dans mon code source
à quel endroit
faut-il déclarer un prototype de cette fonction?

- dans fpSpreadSheet.pas ?
à quel endroit

J'ai tenté de lister ici les erreurs mais je pense qu'on pourrait en réduire le nombre en mettant au bon endroit les déclarations.

Merci.

Jean-Jacques

**BeanzMaster** · 25/04/2022, 20h52

Helle Jean-Jacques

Envoyé par jjnoui

- Installer et faire fonctionner Lazarus sous WIndows

- porter le test sur celui-ci.

C'est très simple encore plus que sous Linux

Envoyé par jjnoui

Quelque chose me titille dans le code inclus entre les lignes 3450 à 3464 de fpSpreadSheet.pas :

On voit ici les comparaisons AnsiComparexxx mais avec le format UTF8 des cellules (ACellx^.UTF8StringValue)

Je ne comprends pas cette manip.....

Moi ce qui me titille c'est que dans la dernière version AnsiComparexxx n'est pas utilisé !

https://github.com/tcs-ulli/fpspread...preadsheet.pas . A moins que je ne sois pas sur le bon dépôt

Qu'elle est ta version de Lazarus ?
Comment as tu installé FPSpreadSheet ? L'as tu installer depuis le gestionnaire de paquets en ligne (menu paquet) ?

Envoyé par jjnoui

Comment intégrer cette fonction ?

- dans mon code source
à quel endroit
faut-il déclarer un prototype de cette fonction?

- dans fpSpreadSheet.pas ?
à quel endroit

J'ai tenté de lister ici les erreurs mais je pense qu'on pourrait en réduire le nombre en mettant au bon endroit les déclarations.

Merci.

Jean-Jacques

Dans ton composant, dans l'ide dans l'inspecteur de propriété sous l'onglet evènement tu devrais avoir le onCompareCells, double click et insère le code

A+
Jérôme

**BeanzMaster** · 25/04/2022, 22h19

J'ai testé sous Windows,

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
unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  fpspreadsheetgrid, fpspreadsheetctrls,
  fpsTypes,
  fpsutils,
  fpspreadsheet;
 
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    wg: TsWorksheetGrid;
    wb: TsWorkbookSource;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure DoCompareCells (Sender: TObject; ACell1, ACell2: PCell; ASortKey: TsSortKey; var AResult: Integer);
  public
 
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}   
uses LazUTF8;
var
  sortParams: TsSortParams;
 
{ TForm1 }
 
procedure TForm1.DoCompareCells(Sender: TObject; ACell1, ACell2: PCell; ASortKey: TsSortKey; var AResult: Integer);
var
  A, B: string;
 
begin
    A := TsWorksheet(Sender).ReadAsText(ACell1^.row, ACell1^.col);
    B := TsWorksheet(Sender).ReadAsText(ACell2^.row, ACell2^.col);
    AResult := UTF8CompareText(A, B);
    if (ssoDescending in ASortKey.options) then AResult := -AResult;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  str1, str2, str3, str4, str5, str6 : string;
 
begin
  str1 := 'ANeuf';
  str2 := 'ACinq';
  str3 := 'A Huit';
  str4 := 'xA Huit';
  str5 := 'xACinq';
  str6 := 'xANeuf';
 
  // chargement manuel du Worksheet
  wb.Worksheet.Clear;
  wb.Worksheet.WriteText(0, 0,str1); // str1 := 'A Huit';
  wb.Worksheet.WriteText(1, 0, str2); // str2 := 'ACinq';
  wb.Worksheet.WriteText(2, 0, str3); // str3 := 'ANeuf';
  wb.Worksheet.WriteText(3, 0, str4);             // str4 := 'xA Huit';
  wb.Worksheet.WriteText(4, 0, str5);             // str5 := 'xACinq';
  wb.Worksheet.WriteText(5, 0, str6);             // str6 := 'xANeuf';
 
  wb.Worksheet.OnFullCompareCells := @DoCompareCells;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  sortParams := InitSortParams(true, 1);              // Col sort, Number of sort (cols or rows)
  sortParams.Keys[0].ColRowIndex := 0;                // ColRowIndex    Index of the sorted column or row
  sortParams.Keys[0].Options := []; //     TsSortOption = (ssoDescending, ssoCaseInsensitive, ssoAlphaBeforeNum)
  wb.Worksheet.Sort(sortParams, 0, 0, wb.worksheet.GetLastRowIndex, wb.worksheet.GetLastColIndex);
end;  
 
end.

Avec ou sans la procedure onCompareCells, cela fonctionne
Nom : 2022-04-25_222203.jpg
Affichages : 459
Taille : 19,5 Ko

Mets à jour Lazarus mais surtout les paquets FPSpreadSheet, ton problème semble venir de là.

Problème de tri d'un worksheet dans l'environnement Ubuntu [Lazarus]

Lazarus Pascal

Vue hybride

Discussions similaires

Partager

Partager