pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: cosmetic clean up of database virtual mode demo

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3429 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
bigchimp
2014-08-05 13:46:42 +00:00
parent 0027c7e2f0
commit 99569c1114
1 changed files with 30 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

48
components/fpspreadsheet/examples/db_import_export/main.pas
View File

@@ -38,6 +38,7 @@ type
FWorkbook: TsWorkbook; FWorkbook: TsWorkbook;
FHeaderTemplateCell: PCell; FHeaderTemplateCell: PCell;
FDateTemplateCell: PCell; FDateTemplateCell: PCell;
// All data for the cells is generated here (out of the .dbf file)
procedure WriteCellDataHandler(Sender: TObject; ARow, ACol: Cardinal; procedure WriteCellDataHandler(Sender: TObject; ARow, ACol: Cardinal;
var AValue: variant; var AStyleCell: PCell); var AValue: variant; var AStyleCell: PCell);
public public
@@ -64,6 +65,8 @@ const
CITIES: array[0..NUM_CITIES-1] of string = ( CITIES: array[0..NUM_CITIES-1] of string = (
'New York', 'Los Angeles', 'San Francisco', 'Chicago', 'Miami', 'New York', 'Los Angeles', 'San Francisco', 'Chicago', 'Miami',
'New Orleans', 'Washington', 'Boston', 'Seattle', 'Las Vegas'); 'New Orleans', 'Washington', 'Boston', 'Seattle', 'Las Vegas');
TABLENAME = 'people.dbf'; //name for the dbf table
DATADIR = 'data'; //subdirectory where .dbf is stored
{ TForm1 } { TForm1 }
@@ -78,12 +81,13 @@ begin
if FDataset <> nil then if FDataset <> nil then
FDataset.Free; FDataset.Free;
ForceDirectories('data'); ForceDirectories(DATADIR);
startDate := EncodeDate(2010, 8, 1); startDate := EncodeDate(2010, 8, 1);
FDataset := TDbf.Create(self); FDataset := TDbf.Create(self);
FDataset.FilePathFull := 'data' + DirectorySeparator; FDataset.FilePathFull := DATADIR + DirectorySeparator;
FDataset.TableName := 'people.dbf'; FDataset.TableName := TABLENAME;
FDataset.TableLevel := 4; //DBase IV; most widely used.
FDataset.FieldDefs.Add('Last name', ftString); FDataset.FieldDefs.Add('Last name', ftString);
FDataset.FieldDefs.Add('First name', ftString); FDataset.FieldDefs.Add('First name', ftString);
FDataset.FieldDefs.Add('City', ftString); FDataset.FieldDefs.Add('City', ftString);
@@ -93,7 +97,8 @@ begin
FDataset.Open; FDataset.Open;
for i:=1 to StrToInt(EdRecordCount.Text) do begin for i:=1 to StrToInt(EdRecordCount.Text) do begin
if (i mod 25) = 0 then begin if (i mod 25) = 0 then
begin
InfoLabel1.Caption := Format('Adding record %d...', [i]); InfoLabel1.Caption := Format('Adding record %d...', [i]);
Application.ProcessMessages; Application.ProcessMessages;
end; end;
@@ -121,22 +126,24 @@ const
EXT: array[0..4] of string = ( EXT: array[0..4] of string = (
'_excel2.xls', '_excel5.xls', '.xls', '.xlsx', '.ods'); '_excel2.xls', '_excel5.xls', '.xls', '.xlsx', '.ods');
var var
fn: String; DataFileName: String;
worksheet: TsWorksheet; worksheet: TsWorksheet;
begin begin
InfoLabel2.Caption := ''; InfoLabel2.Caption := '';
Application.ProcessMessages; Application.ProcessMessages;
if FDataset = nil then begin if FDataset = nil then
begin
FDataset := TDbf.Create(self); FDataset := TDbf.Create(self);
FDataset.FilePathFull := 'data' + DirectorySeparator; FDataset.FilePathFull := DATADIR + DirectorySeparator;
FDataset.TableName := 'people.dbf'; FDataset.TableName := TABLENAME;
end; end;
fn := FDataset.FilePathFull + FDataset.TableName; DataFileName := FDataset.FilePathFull + FDataset.TableName;
if not FileExists(fn) then begin if not FileExists(DataFileName) then
begin
MessageDlg(Format('Database file "%s" not found. Please run "Create database" first.', MessageDlg(Format('Database file "%s" not found. Please run "Create database" first.',
[fn]), mtError, [mbOK], 0); [DataFileName]), mtError, [mbOK], 0);
exit; exit;
end; end;
@@ -165,7 +172,7 @@ begin
worksheet.WriteColWidth(1, 20); worksheet.WriteColWidth(1, 20);
worksheet.WriteColWidth(2, 20); worksheet.WriteColWidth(2, 20);
// Setup virtual mode // Setup virtual mode to save memory
// FWorkbook.Options := FWorkbook.Options + [boVirtualMode, boBufStream]; // FWorkbook.Options := FWorkbook.Options + [boVirtualMode, boBufStream];
FWorkbook.Options := FWorkbook.Options + [boVirtualMode]; FWorkbook.Options := FWorkbook.Options + [boVirtualMode];
FWorkbook.OnWriteCellData := @WriteCellDataHandler; FWorkbook.OnWriteCellData := @WriteCellDataHandler;
@@ -173,8 +180,8 @@ begin
FWorkbook.VirtualColCount := FDataset.FieldCount; FWorkbook.VirtualColCount := FDataset.FieldCount;
// Write // Write
fn := ChangeFileExt(fn, EXT[RgFileFormat.ItemIndex]); DataFileName := ChangeFileExt(DataFileName, EXT[RgFileFormat.ItemIndex]);
FWorkbook.WriteToFile(fn, FILE_FORMATS[RgFileFormat.ItemIndex], true); FWorkbook.WriteToFile(DataFileName, FILE_FORMATS[RgFileFormat.ItemIndex], true);
finally finally
FreeAndNil(FWorkbook); FreeAndNil(FWorkbook);
end; end;
@@ -194,17 +201,22 @@ procedure TForm1.WriteCellDataHandler(Sender: TObject; ARow, ACol: Cardinal;
var AValue: variant; var AStyleCell: PCell); var AValue: variant; var AStyleCell: PCell);
begin begin
// Header line: we want to show the field names here. // Header line: we want to show the field names here.
if ARow = 0 then begin if ARow = 0 then
begin
AValue := FDataset.Fields[ACol].FieldName; AValue := FDataset.Fields[ACol].FieldName;
AStyleCell := FHeaderTemplateCell; AStyleCell := FHeaderTemplateCell;
FDataset.First; FDataset.First;
end else begin end
else
begin
AValue := FDataset.Fields[ACol].Value; AValue := FDataset.Fields[ACol].Value;
if FDataset.Fields[ACol].DataType = ftDate then if FDataset.Fields[ACol].DataType = ftDate then
AStyleCell := FDateTemplateCell; AStyleCell := FDateTemplateCell;
if ACol = FWorkbook.VirtualColCount-1 then begin if ACol = FWorkbook.VirtualColCount-1 then
begin
FDataset.Next; FDataset.Next;
if (ARow-1) mod 25 = 0 then begin if (ARow-1) mod 25 = 0 then
begin
InfoLabel1.Caption := Format('Writing record %d...', [ARow-1]); InfoLabel1.Caption := Format('Writing record %d...', [ARow-1]);
Application.ProcessMessages; Application.ProcessMessages;
end; end;