[10.2] CSV vers TSTringGrid

Invité · 01/08/2018, 12h05

Bonjour,

Je teste actuellement Delphi Community Edition 10.2

Je cherche à charger une TStringGrid à partir d'un fichier CSV.
J'avais déjà fais cela en lazarus de la manière suivante :

Code :

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

sg1.LoadFromCSVFile(edtFichier.Text, ';');

Cela ne semble pas fonctionner avec Delphi.
Quelle est la meilleure manière de procéder ?

Merci d'avance de vos commentaires.

**ALWEBER** · 01/08/2018, 13h22

En fonction de ta demande je peux te donner des exemples

**ShaiLeTroll** · 01/08/2018, 13h57

En même temps, tu as le code source de TCustomStringGrid.LoadFromCSVFile et lcsvutils.LoadFromCSVStream

Suffit de le récupérer et le traduire en Class Helper

Sinon, pour un CSV sans retour-charriot dans les données, une TStringList pour charger les lignes puis une boucle pour charger chaque Rows[]

Voici un vieux code que j'ai retrouvé datant au moins de 2007 et conçu pour Delphi 7

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
procedure TFrmTestFichier.BtnReadFichierCSVClick(Sender: TObject);
var
  I, iRow: Integer;
  FichierCSV: TextFile;
  LineCSV: string;
  ArrayCSV: Types.TStringDynArray;
  StartTick, EndTick, TickPerSec: Int64;
begin
  QueryPerformanceCounter(StartTick);
 
  iRow := 0;
  AssignFile(FichierCSV, EdPathFileCSV.Text);
 
  Reset(FichierCSV);
  try
     while not Eof(FichierCSV) do
     begin
        Inc(iRow);
        Readln(FichierCSV);
     end;
  finally
     CloseFile(FichierCSV);
  end;
  ProgressBarCSV.Max := iRow div 255;
  ProgressBarCSV.Position := 0;
  ProgressBarCSV.Step := 1;
 
  try
    Reset(FichierCSV);
    StringGridCSV.ColCount := 0;
    StringGridCSV.RowCount := iRow;
 
    iRow := 0;
    while not EOF(FichierCSV) do
    begin
 
      Readln(FichierCSV, LineCSV);
      Explode(LineCSV, ArrayCSV, ';', False, '"');
      if StringGridCSV.ColCount < Length(ArrayCSV) then
        StringGridCSV.ColCount :=  Length(ArrayCSV);
 
      with StringGridCSV.Rows[iRow] do
      begin
        BeginUpdate();
        for I := Low(ArrayCSV) to High(ArrayCSV) do
          Strings[I] := ArrayCSV[I];
        EndUpdate();
        if not ByteBool(iRow) then
          ProgressBarCSV.StepIt();
      end;
      Inc(iRow);
    end;
 
  finally
     CloseFile(FichierCSV);
  end;
 
  QueryPerformanceCounter(EndTick);
  QueryPerformanceFrequency(TickPerSec);
  lblReadCSVTime.Caption := IntToStr(Round((EndTick - StartTick) / TickPerSec * 1000)) + ' ms';
end;

**ShaiLeTroll** · 01/08/2018, 14h47

Le code de lazarus, que j'ai chopé n'est pas simple mais le voici traduit pour XE2
Le Char->AnsiChar, nested proc qui n'existe pas et nécessite pas mal d'adaptation

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
 
 
 
type
  TStringGridCSVHelper = class helper for TStringGrid
  private
    procedure NewRecord(Fields:TStringlist; UseTitles: Boolean; FromLine: Integer; SkipEmptyLines: Boolean);
    function RowOffset(UseTitles: Boolean = True): Integer;
  public
    procedure LoadFromCSVFile(const AFilename: string; ADelimiter: AnsiChar = ','; UseTitles: Boolean = True; FromLine: Integer = 0; SkipEmptyLines: Boolean = True);
    procedure LoadFromCSVStream(AStream: TStream; ADelimiter: AnsiChar = ','; UseTitles: Boolean = True; FromLine: Integer = 0; SkipEmptyLines: Boolean = True);
  end;
 
var
  MaxCols: Integer;
  MaxRows: Integer;
  LineCounter: Integer;
 
procedure TStringGridCSVHelper.LoadFromCSVFile(const AFilename: string; ADelimiter: AnsiChar = ','; UseTitles: Boolean = True; FromLine: Integer = 0; SkipEmptyLines: Boolean = True);
var
  TheStream: TFileStream;
begin
  TheStream:= TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
  try
    LoadFromCSVStream(TheStream, ADelimiter, UseTitles, FromLine, SkipEmptyLines);
  finally
    TheStream.Free;
  end;
end;
 
procedure TStringGridCSVHelper.LoadFromCSVStream(AStream: TStream; ADelimiter: AnsiChar = ','; UseTitles: Boolean = True; FromLine: Integer = 0; SkipEmptyLines: Boolean = True);
const
  BUFSIZE=1024;
  MAXGROW = 1 shl 29;
type
  TCSVRecordProc = procedure(Fields: TStringList; UseTitles: Boolean; FromLine: Integer; SkipEmptyLines: Boolean) of object;
  TCSVEncoding = (ceAuto, ceUTF8, ceUTF16, ceUTF16be);
  TSoc = set of AnsiChar;
 
  procedure _LoadFromCSVStream(AStream: TStream; AProc: TCSVRecordProc; ADelimiter:AnsiChar; CSVEncoding: TCSVEncoding=ceAuto);
  var
    Buffer, curWord: ansistring;
    BytesRead, BufLen, I, BufDelta: Longint;
    leadPtr, tailPtr, wordPtr, X:PAnsiChar;
    Line: TStringList;
 
    function SkipSet(const aSet: TSoc): boolean;
    begin
      while (leadPtr<tailPtr) and (leadPtr^ in aSet) do Inc(leadPtr);
      result := leadPtr<tailPtr;
    end;
 
    function FindSet(const aSet: TSoc): boolean;
    begin
      while (leadPtr<tailPtr) and (not (leadPtr^ in ASet)) do Inc(leadPtr);
      result := leadPtr<tailPtr;
    end;
 
    procedure NotifyLine;
    begin
      if (Line<>nil) and (Line.Count>0) then begin
        AProc(Line, UseTitles, FromLine, SkipEmptyLines);
        Line.Clear;
      end;
    end;
 
    procedure StorePart;
    var
      Len, AddLen: Integer;
    begin
      Len := Length(curWord);
      AddLen := leadPtr-wordPtr;
      if AddLen > 0 then begin
        SetLength(curWord, Len+AddLen);
        Move(wordPtr^, curWord[Len+1], AddLen);
      end;
      if leadPtr<tailPtr then
        Inc(leadPtr);
      wordPtr := leadPtr;
    end;
 
    procedure StoreWord;
    begin
      StorePart;
      if Line=nil then
        Line := TStringList.Create;
      Line.Add(curWord);
      curWord := '';
    end;
 
    procedure StoreLine;
    begin
      StoreWord;
      NotifyLine;
    end;
 
    procedure ProcessEndline;
    var
      le: PAnsiChar;
    begin
      le := leadPtr;
      StoreLine;
      if leadPtr>=tailPtr then
        exit;
      if (le^=#13) and (leadPtr^=#10) then
        Inc(leadPtr);
      wordPtr := leadPtr;
    end;
 
    procedure ProcessQuote;
    var
      endQuote,endField: PAnsiChar;
      isDelimiter: boolean;
    begin
      // got a valid opening quote
      Inc(leadPtr);
      wordPtr := leadPtr;
      // look for valid ending quote
      while leadPtr<tailPtr do begin
        if FindSet(['"']) then begin
          // is this an encoded quote?
          if (leadPtr+1)^='"' then begin
            // yes, store part and keep looking
            inc(leadPtr);           // points to second quote
            StorePart;              // add to current word including the first "
          end else begin
            // try to match: "\s*(,|$|EOF)
            endQuote := leadPtr;    // points to valid closing quote (if found later)
            Inc(leadPtr);           // points to \s if exists
            SkipSet([' ']);         // skip \s if exists
            endField := leadPtr;    // points to field terminator
            if (leadPtr>=tailPtr) or (leadPtr^ in [ADelimiter, #10, #13]) then begin
              isDelimiter := (leadPtr<tailPtr) and (leadPtr^=ADelimiter);
              if leadPtr<tailPtr then begin
                if (leadPtr^=#13) and (leadPtr[1]=#10) then
                  Inc(endField);    // point to second byte of line ending
                Inc(endField);      // skip last byte of line ending or delimiter
              end;
              leadPtr := endQuote;  // leadPtr points to closing quote
              if isDelimiter then
                StoreWord
              else
                StoreLine;
              leadPtr := endField;  // restore next position
              wordPtr := leadPtr;
              break;
            end;
          end;
        end;
      end;
      if leadPtr<>wordPtr then begin
        StoreLine;
        wordPtr := leadPtr;
      end;
    end;
 
    procedure ConvertToUTF16;
    var
      n: Integer;
      u: PAnsiChar;
      ch: AnsiChar;
    begin
      n := (tailPtr-leadPtr) div 2;
      u := leadPtr;
      while n>0 do begin
        ch := u^;
        u^ := (u+1)^;
        (u+1)^ := ch;
        inc(u, 2);
        dec(n);
      end;
    end;
 
    procedure ConvertEncoding;
    var
      W: WideString;
    begin
      if (CSVEncoding=ceAuto) and (BufLen>1) then begin
        if (leadPtr[0]=#$FF) and (leadPtr[1]=#$FE) then begin
          inc(leadPtr,2); // skip little endian UTF-16 BOM
          CSVEncoding := ceUTF16;
        end else
        if (leadPtr[0]=#$FE) and (leadPtr[1]=#$FF) then begin
          inc(leadPtr,2); // skip big endian UTF-16 BOM
          CSVEncoding := ceUTF16be;
        end else
        if (leadPtr[0]<>#$00) and (leadPtr[1]=#$00) then    // quick guess
          CSVEncoding := ceUTF16
        else
        if (leadPtr[0]=#$00) and (leadPtr[1]<>#$00) then    // quick guess
          CSVEncoding := ceUTF16be
      end;
      if (CSVEncoding=ceAuto) and (BufLen>2) then begin
        if (leadPtr[0]=#$EF) and (leadPtr[1]=#$BB) and (leadPtr[2]=#$BF) then
          inc(leadPtr,3); // skip UTF-8 BOM
      end;
      if CSVEncoding=ceAuto then
        CSVEncoding := ceUTF8;
 
      case CSVEncoding of
        ceUTF16, ceUTF16be:
          begin
            if CSVEncoding=ceUTF16be then
              ConvertToUTF16;
            SetLength(W,(tailPtr-leadPtr) div 2);
            System.Move(leadPtr^,W[1],length(W)*2);
            Buffer := UTF8Encode(W);
            leadPtr := @Buffer[1];
            tailPtr := leadPtr+length(Buffer);
          end;
      end;
    end;
 
  begin
    Line := nil;
    if not Assigned(AProc) then
      exit;
 
    // read buffer ala fpc tstrings
    Buffer:='';
    BufLen:=0;
    I:=1;
    repeat
      BufDelta:=BUFSIZE*I;
      SetLength(Buffer,BufLen+BufDelta);
      BytesRead:=AStream.Read(Buffer[BufLen+1],BufDelta);
      inc(BufLen,BufDelta);
      If I<MAXGROW then
        I:=I shl 1;
    until BytesRead<>BufDelta;
    BufLen := BufLen-BufDelta+BytesRead;
    SetLength(Buffer, BufLen);
    if BufLen=0 then
      exit;
 
    curWord := '';
    leadPtr := @Buffer[1];
    tailPtr := leadPtr + BufLen;
 
    ConvertEncoding;
    // Note: BufLen now invalid and leadPtr points into Buffer, not neccesarily at Buffer[1]
 
    try
      wordPtr := leadPtr;                    // wordPtr always points to starting word or part
      while leadPtr<tailPtr do begin
        // skip initial spaces
        SkipSet([' ']);
        X := leadPtr;
        // find next marker
        if not FindSet([ADelimiter, '"', #10, #13]) then
          break;
        case leadPtr^ of
          '"':
            begin
              // is the first char?
              if leadPtr=X then
                ProcessQuote
              else begin
                // got an invalid open quote, sync until next delimiter, $ or EOB
                FindSet([ADelimiter, #10, #13]);
                if leadPtr^=ADelimiter then
                  StoreWord
                else
                  ProcessEndline;
              end;
            end;
          #10, #13:
              ProcessEndline;
          else
            if leadPtr^=ADelimiter then
              StoreWord
        end;
      end;
      if wordPtr<>leadPtr then
        StoreWord;
      NotifyLine;
    finally
      Line.Free;
      SetLength(Buffer,0);
    end;
  end;
 
 
begin
  MaxCols := 0;
  MaxRows := 0;
  LineCounter := -1;
 
  _LoadFromCSVStream(AStream, NewRecord, ADelimiter);
 
  // last row offset + 1 (offset is 0 based)
  RowCount := RowOffset(UseTitles) + 1;
 
  ColCount := MaxCols;
end;
 
function TStringGridCSVHelper.RowOffset(UseTitles: Boolean = True): Integer;
begin
  // return row offset of current CSV record (MaxRows) which is 1 based
  if UseTitles then
    result := Max(0, FixedRows-1) + Max(MaxRows-1, 0)
  else
    result := FixedRows + Max(MaxRows-1, 0);
end;
 
procedure TStringGridCSVHelper.NewRecord(Fields:TStringlist; UseTitles: Boolean; FromLine: Integer; SkipEmptyLines: Boolean);
var
  i, aRow, aIndex: Integer;
begin
  inc(LineCounter);
  if (LineCounter < FromLine) then
    exit;
 
  if Fields.Count=0 then
    exit;
 
  if SkipEmptyLines and (Fields.Count=1) and (Fields[0]='') then
    exit;
 
  // make sure we have enough columns
  if MaxCols<Fields.Count then
    MaxCols := Fields.Count;
  if ColCount<MaxCols then
    ColCount := MaxCols;
 
  // setup columns captions if enabled by UseTitles
  if (MaxRows = 0) and UseTitles then begin
    for i:= 0 to Fields.Count-1 do
      Cells[i, 0] := Fields[i];
 
    inc(MaxRows);
    exit;
  end;
 
  // Make sure we have enough rows
  Inc(MaxRows);
  aRow := RowOffset;
  if aRow>RowCount-1 then
    RowCount := aRow + 20;
 
  // Copy line data to cells
  for i:=0 to Fields.Count-1 do
    Cells[i, aRow] := Fields[i];
end;
 
procedure TZooThomVCLControlExperimentForm.StringGrid1DblClick(Sender: TObject);
begin
  StringGrid1.LoadFromCSVFile('C:\Users\sprevot\Desktop\Copie de NOUVEAUTES aout 2018 (2)_RESULTAT.CSV', ';');
end;

Invité · 02/08/2018, 09h32

Merci beaucoup de vos réponses, je vais tester tout ça

**SergioMaster** · 02/08/2018, 10h47

Bonjour,

Il n'a toujours pas été répondu à propos de VCL ou FMX

S'il s'agit de FMX, même si ce n'est avec un TStringGrid ce tutoriel indique comment utiliser un CSV, comme il s'agit de Livebindings et de grille cette future publication

Invité · 08/08/2018, 08h49

Je n'avais pas répondu, car la réponse de ShaiLeTroll m'a permis de me débrouiller.
Il s'agit d'un projet FMX.

merci de vos réponses.

[10.2] CSV vers TSTringGrid

Langage Delphi

Discussions similaires

Partager

Partager