source: trunk/Packages/Common/Table.pas

Last change on this file was 102, checked in by chronos, 12 months ago
  • Modified: Lowered minimal swipe distance.
  • Modified: Show score and best score as boxes. Place them according window size.
  • Modified: Updated Common package.
File size: 14.5 KB
Line 
1unit Table;
2
3interface
4
5uses
6 Classes, SysUtils, Generics.Collections, ComCtrls, XMLRead, DOM;
7
8type
9 TTableFormat = (tfExcel, tfPlain, tfCsv, tfHtml, tfListView, tfMediaWiki,
10 tfXml, tfJson);
11 TTableFormats = set of TTableFormat;
12
13 { TRow }
14
15 TRow = class
16 Cells: TStringList;
17 procedure AddCell(Text: string);
18 constructor Create;
19 destructor Destroy; override;
20 end;
21
22 { TTable }
23
24 TTable = class
25 private
26 function QuoteString(Text: string; Quote: string): string;
27 function UnquoteString(Text: string; Quote: string): string;
28 function ReplaceXmlEntities(Text: string): string;
29 public
30 Title: string;
31 Columns: TStringList;
32 Rows: TObjectList<TRow>;
33 FirstRowIsHeader: Boolean;
34 procedure Clear;
35 function AddRow: TRow;
36 function GetOutputTabs: string;
37 function GetOutputPlain: string;
38 function GetOutputCsv: string;
39 function GetOutputXml: string;
40 function GetOutputHtml: string;
41 function GetOutputMediaWiki: string;
42 function GetOutputJson: string;
43 procedure GetOutputListView(ListView: TListView);
44 function GetOutput(OutputFormat: TTableFormat): string;
45 procedure SetInputCsv(Text: string);
46 procedure SetInputMediaWiki(Text: string);
47 procedure SetInputJson(Text: string);
48 procedure SetInputXml(Text: string);
49 procedure SetInput(OutputFormat: TTableFormat; Text: string);
50 function GetInputFormats: TTableFormats;
51 constructor Create;
52 destructor Destroy; override;
53 end;
54
55const
56 TableFormatText: array[TTableFormat] of string = ('Excel paste', 'Plain text', 'CSV',
57 'HTML', 'ListView', 'MediaWiki', 'XML', 'JSON');
58 TableFormatExt: array[TTableFormat] of string = ('.txt', '.txt', '.csv',
59 '.htm', '', '.txt', '.xml', '.json');
60
61
62implementation
63
64uses
65 Common;
66
67resourcestring
68 SUnsupportedFormat = 'Unsupported format';
69
70{ TTable }
71
72function TTable.QuoteString(Text: string; Quote: string): string;
73begin
74 if Text <> '' then Result := Quote + Text + Quote
75 else Result := Text;
76end;
77
78function TTable.UnquoteString(Text: string; Quote: string): string;
79begin
80 Text := Trim(Text);
81 if Text.StartsWith(Quote) and Text.EndsWith(Quote) then
82 Result := Copy(Text, Length(Quote) + 1, Length(Text) - 2 * Length(Quote));
83end;
84
85function TTable.ReplaceXmlEntities(Text: string): string;
86begin
87 Result := StringReplace(Text, '<', '&lt;', [rfReplaceAll]);
88 Result := StringReplace(Result, '>', '&gt;', [rfReplaceAll]);
89 Result := StringReplace(Result, '&', '&amp;', [rfReplaceAll]);
90 Result := StringReplace(Result, '''', '&apos;', [rfReplaceAll]);
91 Result := StringReplace(Result, '"', '&quot;', [rfReplaceAll]);
92end;
93
94procedure TTable.Clear;
95begin
96 Columns.Clear;
97 Rows.Clear;
98end;
99
100function TTable.AddRow: TRow;
101begin
102 Result := TRow.Create;
103 Rows.Add(Result);
104end;
105
106function TTable.GetOutputTabs: string;
107var
108 I: Integer;
109begin
110 Result := Implode(#9, Columns) + LineEnding;
111 for I := 0 to Rows.Count - 1 do
112 Result := Result + Implode(#9, Rows[I].Cells) + LineEnding;
113end;
114
115function TTable.GetOutputPlain: string;
116var
117 I: Integer;
118begin
119 Result := '';
120 for I := 0 to Rows.Count - 1 do begin
121 Result := Result + Implode(LineEnding, Rows[I].Cells) + LineEnding;
122 Result := Result + LineEnding;
123 Result := Result + '===========================' + LineEnding;
124 Result := Result + LineEnding;
125 end;
126end;
127
128function TTable.GetOutputCsv: string;
129var
130 I: Integer;
131 J: Integer;
132begin
133 Result := '';
134
135 // Show columns
136 for J := 0 to Columns.Count - 1 do begin
137 if J > 0 then Result := Result + ',';
138 if Columns[J] <> '' then
139 Result := Result + QuoteString(Columns[J], '"');
140 end;
141 Result := Result + LineEnding;
142
143 // Show data rows
144 for I := 0 to Rows.Count - 1 do
145 with Rows[I] do begin
146 for J := 0 to Cells.Count - 1 do begin
147 if J > 0 then Result := Result + ',';
148 if Cells[J] <> '' then
149 Result := Result + QuoteString(Cells[J], '"');
150 end;
151 Result := Result + LineEnding;
152 end;
153end;
154
155function TTable.GetOutputXml: string;
156var
157 I: Integer;
158 J: Integer;
159begin
160 Result := '<?xml version="1.0" encoding="UTF-8"?>' + LineEnding +
161 '<table>' + LineEnding;
162 if Title <> '' then
163 Result := Result + ' <title>' + Title + '</title>' + LineEnding;
164 Result := Result + ' <rows>' + LineEnding;
165 for I := 0 to Rows.Count - 1 do begin
166 Result := Result + ' <row>' + LineEnding;
167 for J := 0 to Rows[I].Cells.Count - 1 do
168 if Rows[I].Cells[J] <> '' then
169 Result := Result + ' <cell name="' + Columns[J] + '">' + ReplaceXmlEntities(Rows[I].Cells[J]) + '</cell>' + LineEnding;
170 Result := Result + ' </row>' + LineEnding;
171 end;
172 Result := Result + ' </rows>' + LineEnding +
173 '</table>';
174end;
175
176function TTable.GetOutputHtml: string;
177var
178 I: Integer;
179 J: Integer;
180begin
181 Result := '<html>' + LineEnding +
182 ' <head>' + LineEnding +
183 ' <title>' + Title + '</title>' + LineEnding +
184 ' </head>' + LineEnding +
185 ' <body>' + LineEnding +
186 ' <table border="1">' + LineEnding;
187 // Show header
188 Result := Result + ' <tr>' + LineEnding;
189 for J := 0 to Columns.Count - 1 do
190 Result := Result + ' <th>' + StringReplace(Columns[J], LineEnding, '<br/>', [rfReplaceAll]) + '</th>' + LineEnding;
191 Result := Result + ' </tr>' + LineEnding;
192
193 // Show data rows
194 for I := 0 to Rows.Count - 1 do begin
195 Result := Result + ' <tr>' + LineEnding;
196 for J := 0 to Rows[I].Cells.Count - 1 do
197 Result := Result + ' <td>' + StringReplace(Rows[I].Cells[J], LineEnding, '<br/>', [rfReplaceAll]) + '</td>' + LineEnding;
198 Result := Result + ' </tr>' + LineEnding;
199 end;
200 Result := Result + ' </table>' + LineEnding +
201 ' </body>' + LineEnding +
202 '</html>';
203end;
204
205function TTable.GetOutputMediaWiki: string;
206var
207 I: Integer;
208 J: Integer;
209begin
210 Result := '{| class="wikitable sortable"' + LineEnding;
211
212 // Show header
213 for J := 0 to Columns.Count - 1 do begin
214 if J = 0 then Result := Result + '! ' + Columns[J]
215 else Result := Result + ' !! ' + Columns[J];
216 end;
217 Result := Result + LineEnding + '|-' + LineEnding;
218
219 // Show data rows
220 for I := 0 to Rows.Count - 1 do begin
221 for J := 0 to Rows[I].Cells.Count - 1 do begin
222 if J = 0 then Result := Result + '| ' + Rows[I].Cells[J]
223 else Result := Result + ' || ' + Rows[I].Cells[J];
224 end;
225 if I < Rows.Count - 1 then
226 Result := Result + LineEnding + '|-' + LineEnding;
227 end;
228 Result := Result + LineEnding + '|}';
229end;
230
231function TTable.GetOutputJson: string;
232var
233 I: Integer;
234 J: Integer;
235begin
236 Result := '[' + LineEnding;
237 for I := 0 to Rows.Count - 1 do begin
238 Result := Result + ' {' + LineEnding;
239 for J := 0 to Rows[I].Cells.Count - 1 do begin
240 if Rows[I].Cells[J] <> '' then begin
241 Result := Result + ' "' + Columns[J] + '": "' + Rows[I].Cells[J] + '"';
242 if J < Rows[I].Cells.Count - 1 then Result := Result + ',';
243 Result := Result + LineEnding;
244 end;
245 end;
246 Result := Result + ' }';
247 if I < Rows.Count - 1 then Result := Result + ',';
248 Result := Result + LineEnding;
249 end;
250 Result := Result + ']' + LineEnding;
251end;
252
253procedure TTable.GetOutputListView(ListView: TListView);
254var
255 I: Integer;
256 J: Integer;
257 ListColumn: TListColumn;
258 ListItem: TListItem;
259 NewWidth: Integer;
260const
261 MinWidth = 120;
262begin
263 ListView.Columns.BeginUpdate;
264 try
265 ListView.Columns.Clear;
266 for I := 0 to Columns.Count - 1 do begin
267 ListColumn := ListView.Columns.Add;
268 ListColumn.Caption := Columns[I];
269 NewWidth := ListView.Width div Columns.Count;
270 if NewWidth < MinWidth then NewWidth := MinWidth;
271 ListColumn.Width := NewWidth;
272 end;
273 finally
274 ListView.Columns.EndUpdate;
275 end;
276
277 ListView.Items.BeginUpdate;
278 try
279 ListView.Items.Clear;
280 for I := 0 to Rows.Count - 1 do begin
281 ListItem := ListView.Items.Add;
282 for J := 0 to Rows[I].Cells.Count - 1 do begin
283 if J = 0 then ListItem.Caption := Rows[I].Cells[J]
284 else ListItem.SubItems.Add(Rows[I].Cells[J]);
285 end;
286 end;
287 finally
288 ListView.Items.EndUpdate;
289 end;
290end;
291
292function TTable.GetOutput(OutputFormat: TTableFormat): string;
293begin
294 case OutputFormat of
295 tfExcel: Result := GetOutputTabs;
296 tfPlain: Result := GetOutputPlain;
297 tfCsv: Result := GetOutputCsv;
298 tfHtml: Result := GetOutputHtml;
299 tfMediaWiki: Result := GetOutputMediaWiki;
300 tfXml: Result := GetOutputXml;
301 tfJson: Result := GetOutputJson;
302 else raise Exception.Create(SUnsupportedFormat);
303 end;
304end;
305
306procedure TTable.SetInputCsv(Text: string);
307var
308 Lines: TStringList;
309 I: Integer;
310 Row: TRow;
311begin
312 Clear;
313 Lines := TStringList.Create;
314 try
315 Lines.Text := Text;
316 for I := 0 to Lines.Count - 1 do begin
317 if I = 0 then begin
318 Columns.StrictDelimiter := True;
319 Columns.DelimitedText := Trim(Lines[I]);
320 end else begin
321 Row := TRow.Create;
322 Row.Cells.StrictDelimiter := True;
323 Row.Cells.DelimitedText := Trim(Lines[I]);
324 Rows.Add(Row);
325 end;
326 end;
327 finally
328 FreeAndNil(Lines);
329 end;
330end;
331
332procedure TTable.SetInputMediaWiki(Text: string);
333var
334 Lines: TStringList;
335 I: Integer;
336 Line: string;
337 InsideTable: Boolean;
338 Index: Integer;
339 Row: TRow;
340begin
341 Clear;
342 Lines := TStringList.Create;
343 try
344 Lines.Text := Text;
345 Row := nil;
346 InsideTable := False;
347 for I := 0 to Lines.Count - 1 do begin
348 Line := Trim(Lines[I]);
349 if not InsideTable then begin
350 if Line.StartsWith('{|') then InsideTable := True;
351 end else begin
352 if Line.StartsWith('|}') then InsideTable := False
353 else
354 if Line.StartsWith('!') then begin
355 Delete(Line, 1, 1);
356 Line := Trim(Line);
357 repeat
358 Index := Pos('!!', Line);
359 if Index > 0 then begin
360 Columns.Add(Trim(Copy(Line, 1, Index - 1)));
361 Delete(Line, 1, Index + 1);
362 end else begin
363 Columns.Add(Trim(Line));
364 Break;
365 end;
366 until False;
367 end else
368 if Line.StartsWith('|-') then begin
369 if Assigned(Row) then Rows.Add(Row);
370 Row := TRow.Create;
371 end else
372 if Line.StartsWith('|') then begin
373 if Assigned(Row) then begin
374 Delete(Line, 1, 1);
375 Line := Trim(Line);
376 repeat
377 Index := Pos('||', Line);
378 if Index > 0 then begin
379 Row.Cells.Add(Trim(Copy(Line, 1, Index - 1)));
380 Delete(Line, 1, Index + 1);
381 end else begin
382 Row.Cells.Add(Trim(Line));
383 Break;
384 end;
385 until False;
386
387 while Row.Cells.Count < Columns.Count do
388 Row.Cells.Add('');
389 end;
390 end;
391 end;
392 end;
393 if Assigned(Row) then
394 Rows.Add(Row);
395 finally
396 FreeAndNil(Lines);
397 end;
398end;
399
400procedure TTable.SetInputJson(Text: string);
401type
402 TState = (stOutside, stArray, stItem);
403var
404 Lines: TStringList;
405 I: Integer;
406 Line: string;
407 State: TState;
408 Index: Integer;
409 Row: TRow;
410 ColumnIndex: Integer;
411 ColumnName: string;
412 Value: string;
413begin
414 Clear;
415 Lines := TStringList.Create;
416 try
417 Lines.Text := Text;
418 Row := nil;
419 State := stOutside;
420 for I := 0 to Lines.Count - 1 do begin
421 Line := Trim(Lines[I]);
422 if State = stOutSide then begin
423 if Line.StartsWith('[') then begin
424 State := stArray;
425 end;
426 end else
427 if State = stArray then begin
428 if Line.StartsWith('{') then begin
429 State := stItem;
430 Row := TRow.Create;
431 Rows.Add(Row);
432 end;
433 end else
434 if State = stItem then begin
435 if Line.StartsWith('}') then begin
436 State := stArray;
437 end else begin
438 Index := Pos(':', Line);
439 if Index > 0 then begin
440 ColumnName := UnquoteString(Trim(Copy(Line, 1, Index - 1)), '"');
441 ColumnIndex := Columns.IndexOf(ColumnName);
442 if ColumnIndex < 0 then begin
443 Columns.Add(ColumnName);
444 ColumnIndex := Columns.Count - 1;
445 end;
446 while Row.Cells.Count < Columns.Count do
447 Row.Cells.Add('');
448 Value := Trim(Copy(Line, Index + 1, MaxInt));
449 if Value.EndsWith(',') then Value := Copy(Value, 1, Length(Value) - 1);
450 Row.Cells[ColumnIndex] := UnquoteString(Value, '"');
451 end;
452 end;
453 end;
454 end;
455 finally
456 FreeAndNil(Lines);
457 end;
458end;
459
460procedure TTable.SetInputXml(Text: string);
461var
462 Doc: TXMLDocument;
463 TextStream: TStringStream;
464 TableNode: TDOMNode;
465 RowsNode: TDOMNode;
466 RowNode: TDOMNode;
467 CellNode: TDOMNode;
468 NewRow: TRow;
469 CellName: string;
470 ColumnIndex: Integer;
471begin
472 Clear;
473 TextStream := TStringStream.Create(Text);
474 ReadXMLFile(Doc, TextStream);
475 TableNode := Doc.DocumentElement;
476 if Assigned(TableNode) and (TableNode.NodeName = 'table') then
477 with TableNode do begin
478 RowsNode := FindNode('rows');
479 if Assigned(RowsNode) then begin
480 RowNode := RowsNode.FirstChild;
481 while Assigned(RowNode) and (RowNode.NodeName = 'row') do begin
482 NewRow := TRow.Create;
483 CellNode := RowNode.FirstChild;
484 while Assigned(CellNode) and (CellNode.NodeName = 'cell') do begin
485 CellName := string(TDOMElement(CellNode).GetAttribute('name'));
486 ColumnIndex := Columns.IndexOf(CellName);
487 if ColumnIndex < 0 then begin
488 Columns.Add(CellName);
489 ColumnIndex := Columns.Count - 1;
490 end;
491
492 while NewRow.Cells.Count <= ColumnIndex do
493 NewRow.Cells.Add('');
494 NewRow.Cells[ColumnIndex] := string(CellNode.TextContent);
495 CellNode := CellNode.NextSibling;
496 end;
497 Rows.Add(NewRow);
498 RowNode := RowNode.NextSibling;
499 end;
500 end;
501 end;
502 FreeAndNil(TextStream);
503 FreeAndNil(Doc);
504end;
505
506procedure TTable.SetInput(OutputFormat: TTableFormat; Text: string);
507begin
508 case OutputFormat of
509 tfCsv: SetInputCsv(Text);
510 tfMediaWiki: SetInputMediaWiki(Text);
511 tfJson: SetInputJson(Text);
512 tfXml: SetInputXml(Text);
513 else raise Exception.Create(SUnsupportedFormat);
514 end;
515end;
516
517function TTable.GetInputFormats: TTableFormats;
518begin
519 Result := [tfCsv, tfJson, tfMediaWiki, tfXml];
520end;
521
522constructor TTable.Create;
523begin
524 Columns := TStringList.Create;
525 Rows := TObjectList<TRow>.Create;
526end;
527
528destructor TTable.Destroy;
529begin
530 FreeAndNil(Rows);
531 FreeAndNil(Columns);
532 inherited;
533end;
534
535procedure TRow.AddCell(Text: string);
536begin
537 Cells.Add(Text);
538end;
539
540constructor TRow.Create;
541begin
542 Cells := TStringList.Create;
543end;
544
545destructor TRow.Destroy;
546begin
547 FreeAndNil(Cells);
548 inherited;
549end;
550
551end.
552
Note: See TracBrowser for help on using the repository browser.