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
| 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 ProgressValue(const val: Integer; const word: string);
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);
TTask.Run(LoadFile);
except
on e: Exception do
ShowMessage(e.Message);
end;
end;
end;
procedure TForm2.LoadFile;
begin
try
for var i := 0 to Pred(Length(FLst)) do
begin
if (FLst[i].Length >= 6) and (FLst[i].Length <= 12) then
ProgressValue(i, '')
else
ProgressValue(i, FLst[i]);
end;
finally
EndTask;
end;
end;
procedure TForm2.ProgressValue(const val: Integer; const word: string);
begin
TThread.Queue(nil,
procedure
begin
ProgressBar1.Value := val;
if (not word.IsEmpty) then
begin
FDMemTable1.Append;
FDMemTable1.FieldByName('word').AsString := word;
FDMemTable1.Post;
end;
end);
end;
procedure TForm2.EndTask;
begin
TThread.Queue(nil,
procedure
begin
FTask := nil;
ListBox1.EndUpdate;
ShowMessage('Done');
btnLoad.Enabled := True;
end);
end;
end. |
Partager