Discussion :

[Bruno13]

Bonjour à tous,

je ne comprends une chose qui se passe avec mon VirtualDrawTree, en fait voici mon OnDrawNode ci-dessous mais hélas cela ne fonctionne pas correctement dans le sens où il faut que je passe au dessus des lignes du TreeView pour que les checkbox s'affiche ?!

Avez vous une idée ?
Je l'utilise dans d'autres programmes et cela fonctionne parfaitement !??

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
procedure TSelectKeyword.vtKeywordsDrawNode(Sender: TBaseVirtualTree;
  const PaintInfo: TVTPaintInfo);
var
  KR: TKeywordClass;
  R: TRect;
begin
  with PaintInfo do
  begin
    R:=ContentRect;
    if Sender.Selected[Node] then
      Canvas.Font.Color:=clWhite
    else
      Canvas.Font.Color:=clBlack;
 
    Canvas.Brush.Style:=bsClear;
 
    KR:=GetPointerFromTree(Sender, Node);
    Node.CheckType := ctCheckBox;
 
 
    case Column of
      0: ; // C'est le Checkbox
      1: DrawText(Canvas, ContentRect, taLeftJustify, tlCenter, KR.Name);
      2: DrawText(Canvas, ContentRect, taCenter, tlCenter, KR.Lang);
      3: DrawText(Canvas, ContentRect, taRightJustify, tlCenter, inttostr(KR.Freq));
      4: DrawText(Canvas, ContentRect, taRightJustify, tlCenter, inttostr(KR.Occur));
    end;
  end;
end; {* proc .vtKeywordDrawNode *}

[Pascal Jankowski]

Bonjour,

J'ai déjà rencontré ce type de problème avec par contre, un autre composant (tacQueryBuilder). Dès que celui-ci était créé à la vollée dans un TFrame. Une des checkBox et en particulier la première du composant ne s'affichait pas. Il fallait la survoller pour que celle-ci apparaisse.

J'avais alors résolu ce petit problème en plaçant, pour le composant en question, sa propriété Ctl3D à false.

Je ne sais pas si cette solution règlera ton problème, mais vu la similitude de l'erreur rencontrée on ne sait jamais.

Cordialement

[Bruno13]

Bonjour Pascal,

Hélas pour moi cela n'a pas eu de résultat.
Merci quand même pour ta réponse.

Une autre idée ?

[MedGIR]

Je pense que la reponse à ton probleme est celle-ci:

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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, VirtualTrees;
 
type
  TKeywordClass = class
   Name : string;
   Lang : string;
   Freq : Integer;
   Occur : Integer;
  end;
 
type
  TForm1 = class(TForm)
    VirtualStringTree1: TVirtualDrawTree;
    procedure FormCreate(Sender: TObject);
    procedure VirtualStringTree1DrawNode(Sender: TBaseVirtualTree;
      const PaintInfo: TVTPaintInfo);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
var
  newKeyword : TKeywordClass;
  newNode : PVirtualNode;
  i:Integer;
begin
     VirtualStringTree1.NodeDataSize:= Sizeof(TObject);
     VirtualStringTree1.TreeOptions.MiscOptions :=  VirtualStringTree1.TreeOptions.MiscOptions + [toCheckSupport];
     VirtualStringTree1.CheckImageKind := ckXP;
     for i:=0 to 100 do
     begin
          newKeyword := TKeywordClass.Create;
          newKeyword.Name := 'Name' + IntToStr(i);
          newKeyword.Lang := 'Lang'+ IntToStr(i);
          newKeyword.Freq := i;
          newKeyword.Occur := 10;
          newNode :=  VirtualStringTree1.AddChild(nil,newKeyword);
          newNode.CheckType := ctCheckBox;
          newNode.CheckState := csCheckedNormal;
     end;
end;
 
procedure TForm1.VirtualStringTree1DrawNode(Sender: TBaseVirtualTree;
  const PaintInfo: TVTPaintInfo);
var
  KeyWord : ^TKeywordClass;
begin
  KeyWord := Sender.GetNodeData(PaintInfo.node);
  if Sender.Selected[PaintInfo.Node] then
      PaintInfo.Canvas.Font.Color:=clWhite
  else
      PaintInfo.Canvas.Font.Color:=clBlack;
 
    PaintInfo.Canvas.Brush.Style:=bsClear;
 
  case PaintInfo.Column of
       1: PaintInfo.Canvas.TextOut(PaintInfo.CellRect.Left ,PaintInfo.CellRect.Top ,KeyWord.Name);
       2: PaintInfo.Canvas.TextOut(PaintInfo.CellRect.Left ,PaintInfo.CellRect.Top ,KeyWord.Lang );
       3: PaintInfo.Canvas.TextOut(PaintInfo.CellRect.Left ,PaintInfo.CellRect.Top ,IntToStr(KeyWord.Freq ));
       4: PaintInfo.Canvas.TextOut(PaintInfo.CellRect.Left ,PaintInfo.CellRect.Top ,IntToStr(KeyWord.Occur ));
 
  end;
end;
 
end.

VtDrawNode.zip

[Bruno13]

Salut MedGir,

Parfait ! ça marche, il semble que cela soit en fait ceci qui posait problème :

Code :

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

1
2
          for i:=0 to lKW.Count-1 do
            vtKeywords.AddChild(nil, lKW[i]);

que j'ai remplacé par ceci :

Code :

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

1
2
3
4
5
6
          for i:=0 to lKW.Count-1 do
          Begin
            N:=vtKeywords.AddChild(nil, lKW[i]);
            N.CheckType := ctCheckBox;
            N.CheckState := csCheckedNormal;
          End;

Je peux donc ajouter grâce à toi le Tag Résolu dans mon post !

[MedGIR]

De rien, ca sert à cela un forum.

Je suis content d'avoir pu t'aider.

Bon code...

[Gilbert Geyer]

Salut Bruno,

Au fait, cela t'intéresse-t-il toujours l'optimisation d'indexOf ?
Si oui, j'ai un code amélioré, rest juste un petit pb :
- Si Sorted:=false les chaines peuvent être ou ne pas être formées de caractères accentés et le temps d'exécution est nettement amélioré,
- Mais si Sorted:=true les temps d'exécution sont également améliorés mais ça ne marche correctement quen l'absence de caractères accentués.
... si ça t'intéresse quand-même fais moi le savoir et je te l'enverrai.

[Bruno13]

Salut Gilbert,

je veux bien essayer ton algo pour indexof.
C'est avec plaisir

Amitiés,
Bruno

[Gilbert Geyer]

Salut Bruno,

je veux bien essayer ton algo pour indexof.

... le voici :

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
 
function IndexOfSL3(SL : TStringList; const S: string): Integer;
// Si SL.Sorted=False la présence de caractères accentués ne fausse pas le résultat.
// Dans le cas inverse n'utiliser cette fonction que pour des chaînes non accentuées.
// sinon remplacer le calcul de C par C := CompareStr() qui est plus lent
var      L, H, I, C: Integer; ok : boolean;
begin    with SL do
         begin Result := -1;
               // Cas SL non triée : Parcours depuis début de liste vers fin :
               if Not Sorted then
               begin I:=-1;
                     repeat inc(I);
                     until  (SL[I] = S) or (I = Count-1);
                     if SL[I] = S then Result:= I;
                     EXIT;
               end;
               // Cas SL triée : Parcours depuis la médiane de la liste
               // vers le début ou la fin en fonction du signe de C :
               L := 0;
               H := Count - 1;
               ok:=false;
               while L <= H do
               begin I := (L + H) shr 1;
                     if SL[i] < S then C:=-1 else
                     if SL[i] > S then C:=+1 else C:=0;
                     if C < 0 then L := I + 1 else
                     begin H := I - 1;
                           if (C = 0) then
                           begin ok:=true;
                                 if Duplicates <> dupAccept then L := I;
                           end;
                     end;
               end;
               if ok then Result:= L;
         end; 
end;
 
// Utilisation :
 
procedure TForm1.bIndexOf3Click(Sender: TObject);
var       i,index : integer; Chrono : oChrono; 
begin     Chrono.Top;
            for i:=0 to SLTexte.count-1
          do index:=IndexOfSL3(SLTexte,SLTexte[i]);
          if index>=0
          then label9.caption:=intToStr(index)+' index'
          else label9.caption:='*';
          labChrono.caption:='Mis : '+FloatToStrf(Chrono.Mis,ffFixed,10,2)+' ms';
          end;

... A titre indicatif les temps d'exécution comparatifs avec la version standard d'IndexOf, et une liste SLTexte comportant 2000 mots non accentués du dictionnaire la boucle (for i:=0 to SLTexte.count-1 do index:=IndexOfSL3(SLTexte,SLTexte[i]) ) où l'on recherche à tour de rôle l'index de chacun des 2000 mots de la liste ont été (Pentium III à 1,13 MHz) :
- Version standard d'IndexOf : 332 ms pour Sorted=False, et 13 ms pour Sorted=True.
- Version IndexOfSL3 : 79 ms pour Sorted=False, et 6 ms pour Sorted=True.
A+
P.S : Est-ce que tu as une fonction performante qui convertirait des chaînes accentuées en chaînes non accentuées pour cas de besoin de conversion préalable (préalable au sens d'une conversion des textes le plus en amont possible dans ton scénario d'exploitation des textes, cela éviterait de reconvertir 36 fois des mots qui l'ont déjà été) ?

[Bruno13]

Salut Gilbert,

Tout d'abord merci pour ton IndexOfSL3 mais hélas chez moi je commence à croire que ce n'est pas spécialement lui qui prend du temps dans mon traitement.
Ma liste n'est pas triée donc j'ai même pu simplifier celle-ci pour mon cas :

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
function TKeywordList.IndexOfSL3(Item : TKeywordClass): Integer;
var      I: Integer;
begin
               Result := -1;
               I:=FItems.Count-1;
               While I>=0 do
               Begin
                  if Items[i].Name = Item.Name then
                  Begin
                     Result:= I;
                     EXIT;
                  End;
                  Dec(i);
               End;
end;

Bref, je cherche.

En ce qui concerne les accents j'utilise ceci trouvé sur ce forum :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
function EnleveAccents(AText : String) : string;
const 
  Char_Accents      = 'ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÇçÌÍÎÏìíîïÙÚÛÜùúûüÿÑñ';
  Char_Sans_Accents = 'AAAAAAaaaaaaOOOOOOooooooEEEEeeeeCcIIIIiiiiUUUUuuuuyNn';
var
  I : Integer;
  sTemp : String;
begin
  sTemp := AText;
  For i := 1 to Length(Char_Accents) do
    //sTemp := FastReplace(sTemp, Char_Accents[i], Char_Sans_Accents[i]);
    sTemp := StringReplace(sTemp,Char_Accents[i],Char_Sans_Accents[i],[rfReplaceAll]);
  Result := sTemp;
end;

PS : tiens je vais essayer de lancer un post sur ce sujet !

Amicalement,
Bruno

[Gilbert Geyer]

Salut Bruno,

IndexOfSL3... mais hélas chez moi je commence à croire que ce n'est pas spécialement lui qui prend du temps dans mon traitement.

... ça vaudrait le coup d'identifier au chronomètre la ou les étapes qui prennent le plus de temps du temps

function EnleveAccents(AText : String) : string : tiens je vais la tester à l'occasion pour voir ce qu'elle vaut en rapidité.

Comme t'as lancé un autre post sur ce sujet, donc suite sur l'autre post.

Amicalement et à+