Discussion :

[oneDev]

Bonjour,

J'utilise Delphi 10.4.2 avec une application FMX.
Je dois charger un fichier texte contenant une liste de mot.
Tout fonctionnait bien jusqu'à ce que l'idée folle me passe par la tête d'utiliser un thread pour charger ces données car le traitement peut être très long.

Je me suis inspiré de cette page, mais je dois faire n'importe quoi , car cela ne fonctionne pas.

J'ai des erreurs mémoires lors du traitement du fichier.

Voici les composants



Voici les liaisons



et mon 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
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
unit fMain;
 
interface
 
uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, FMX.ListBox,
  FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param,
  FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf,
  System.Rtti, System.Bindings.Outputs, FMX.Bind.Editors, Data.Bind.EngExt,
  FMX.Bind.DBEngExt, Data.Bind.Components, Data.Bind.DBScope, Data.DB,
  FireDAC.Comp.DataSet, FireDAC.Comp.Client, FireDAC.Stan.StorageBin,
  System.Threading;
 
type
  TForm2 = class(TForm)
    ListBox1: TListBox;
    btnLoad: TButton;
    od1: TOpenDialog;
    ProgressBar1: TProgressBar;
    FDMemTable1: TFDMemTable;
    FDStanStorageBinLink1: TFDStanStorageBinLink;
    DataSource1: TDataSource;
    FDMemTable1word: TStringField;
    BindSourceDB1: TBindSourceDB;
    BindingsList1: TBindingsList;
    LinkListControlToField1: TLinkListControlToField;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnLoadClick(Sender: TObject);
  private
    FLst: TArray<string>;
    FTask: ITask;
    procedure LoadFile;
    procedure EndTask;
    procedure AddWord(const word: string);
    procedure ProgressValue(val: Integer);
  public
  end;
 
var
  Form2: TForm2;
 
implementation
 
{$R *.fmx}
 
uses
  System.IOUtils;
 
procedure TForm2.FormCreate(Sender: TObject);
begin
  if (FDMemTable1.Active) then
    FDMemTable1.Close;
  FDMemTable1.ResourceOptions.Persistent := True;
  FDMemTable1.ResourceOptions.PersistentFileName :=
    TPath.Combine(TPath.GetDocumentsPath, 'MyDatas.bin');
  FDMemTable1.Open;
end;
 
procedure TForm2.FormDestroy(Sender: TObject);
begin
  FDMemTable1.Close;
end;
 
procedure TForm2.btnLoadClick(Sender: TObject);
var
  task: ITask;
begin
  btnLoad.Enabled := False;
 
  if (od1.Execute) then
  begin
    try
      FLst := TFile.ReadAllLines(od1.FileName);
      ListBox1.BeginUpdate;
      ProgressBar1.Value := 0;
      ProgressBar1.Max := Length(FLst);
 
      FTask := TTask.Create(LoadFile);
      FTask.Start;
    except
      on e: Exception do
        ShowMessage(e.Message);
    end;
  end;
end;
 
procedure TForm2.LoadFile;
var
  i: Integer;
begin
  try
    for i := 0 to Pred(Length(FLst)) do
    begin
      TThread.Queue(nil,
        procedure
        begin
          ProgressValue(i);
        end);
 
      if (FLst[i].Length >= 6) and (FLst[i].Length <= 12) then
      begin
        TThread.Queue(nil,
          procedure
          begin
            AddWord(FLst[i]);
          end);
      end;
    end;
  finally
    TThread.Queue(nil, EndTask);
  end;
end;
 
procedure TForm2.ProgressValue(val: Integer);
begin
  ProgressBar1.Value := val;
end;
 
procedure TForm2.AddWord(const word: string);
begin
  FDMemTable1.Append;
  FDMemTable1.FieldByName('word').AsString := word;
  FDMemTable1.Post;
end;
 
procedure TForm2.EndTask;
begin
  FTask := nil;
  ListBox1.EndUpdate;
  ShowMessage('Done');
  btnLoad.Enabled := True;
end;
 
end.

Merci d'avance pour vos conseils.