Denis,
Answer is yes - and only yesterday was I working on such a program.
Years ago I did the same from Delphi and used the type libraries. With
FPC, the key is to use variants. As an example, I've attached a neat
little unit for exporting a DBGrid to an Excel spreadsheet.
Regards
Tony Whyman
MWA
unit ExcelWorkbook;
{$MODE Delphi}
interface
uses
Classes, SysUtils, variants, DBGrids, DB, Forms;
type
{ TExcelWorkbook }
TExcelWorkbook = class
private
FWorksheet: variant;
FWorkbook: variant;
FServer: variant;
procedure CopyToWorkbook(DBGrid: TDBGrid; aFieldCount: integer);
overload;
procedure CopyToWorkbook(ds: TDataSet; aFieldCount: integer); overload;
procedure SetCell(Row,Col: integer; aText: string);
procedure WriteFieldList(Fields: TFields; FieldCount: integer);
procedure WriteRecord(DataSet: TDataSet; row, aFieldCount: integer);
public
constructor Create;
destructor Destroy; override;
procedure SaveAs(DBGrid: TDBGrid; aWorkbookFile: string);
procedure OpenInExcel(DBGrid: TDBGrid);
end;
implementation
uses ComObj, CSVGridUnit, memds;
const
ServerName = 'Excel.Application';
resourcestring
sUnknownField = 'Unknown Field Type';
sBadGraphic = 'Unable to generate CSV data for a Graphic Field';
sBadParadox = 'Unable to generate CSV data for a Paradox OLE Field';
sBadDBase = 'Unable to generate CSV data for a DBase OLE Field';
sBadBinary= 'Unable to generate CSV data for a Binary Field';
sBadCursor= 'Unable to generate CSV data for a Cursor Field';
{ TExcelWorkbook }
procedure TExcelWorkbook.CopyToWorkbook(DBGrid: TDBGrid; aFieldCount:
integer);
var ds: TMemDataset;
i: integer;
begin
if (DBGrid.DataSource = nil) or (DBGrid.DataSource.DataSet = nil) then
raise Exception.Create('Create Excel Workbook: A Dataset must be
assigned');
ds := TMemDataset.Create(Application);
try
ds.Clear(True);
AddFileDefs(ds,DBGrid.Columns);
ds.CreateTable;
ds.Active := true;
CopyData(ds,DBGrid.DataSource.DataSet);
SetColumnHeadings(ds,DBGrid.Columns);
for i := 1 to DBGrid.Columns.Count do
FWorksheet.Cells.Item(1,i).ColumnWidth :=
DBGrid.Columns[i-1].Width div 5;
CopyToWorkbook(ds,aFieldCount);
finally
ds.Free;
end;
end;
procedure TExcelWorkbook.CopyToWorkbook(ds: TDataSet; aFieldCount: integer);
var
{$IF FPC_FULLVERSION >= 20700 }
bk: TBookmark;
{$ELSE}
bk: TBookmarkStr;
{$ENDIF}
row: integer;
begin
row := 2;
with ds do
begin
bk := Bookmark;
DisableControls;
try
if aFieldCount = 0 then
aFieldCount := FieldCount;
Last;
WriteFieldList(Fields,aFieldCount);
First;
while not EOF do
begin
WriteRecord(ds,row,aFieldCount);
Next;
Inc(row);
end;
finally
Bookmark := bk;
EnableControls;
end;
end
end;
procedure TExcelWorkbook.SetCell(Row, Col: integer; aText: string);
var w: WideString;
begin
w := UTF8Decode(aText);
FWorksheet.Cells.Item(Row,Col).Value := w;
end;
procedure TExcelWorkbook.WriteFieldList(Fields: TFields; FieldCount:
integer);
var I: integer;
begin
for I := 0 to FieldCount - 1 do
SetCell(1,I+1,Fields[I].FieldName);
end;
procedure TExcelWorkbook.WriteRecord(DataSet: TDataSet; row,
aFieldCount: integer);
var I: integer;
begin
with DataSet do
begin
for I := 0 to aFieldCount - 1 do
begin
case Fields[I].DataType of
ftUnknown: raise Exception.Create(sUnknownField);
ftString: SetCell(row,I+1,Fields[I].AsString);
ftSmallint,
ftInteger,
ftWord,
ftLargeInt,
ftBoolean: SetCell(row,I+1,Fields[I].DisplayText);
ftFloat,
ftCurrency,
ftFmtBCD,
ftBCD: SetCell(row,I+1,Fields[I].AsString);
ftDate,
ftTime: SetCell(row,I+1,DateTimeToStr(Fields[I].AsDateTime));
ftDateTime: SetCell(row,I+1,Fields[I].AsString);
ftBytes,
ftVarBytes,
ftBlob,
ftAutoInc: SetCell(row,I+1,Fields[I].AsString);
ftMemo: SetCell(row,I+1,Fields[I].AsString);
ftGraphic: raise Exception.Create(sBadGraphic);
ftFmtMemo: SetCell(row,I+1,Fields[I].AsString);
ftParadoxOle: raise Exception.Create(sBadParadox);
ftDBaseOle: raise Exception.Create(sBadDBase);
ftTypedBinary:raise Exception.Create(sBadBinary);
ftCursor:raise Exception.Create(sBadCursor);
end
end;
end;
end;
constructor TExcelWorkbook.Create;
begin
try
FServer := CreateOleObject(ServerName);
except
raise Exception.Create('Unable to start Excel.');
end;
FWorkbook := FServer.Workbooks.Add;
FWorksheet := FWorkbook.Worksheets.Add;
end;
destructor TExcelWorkbook.Destroy;
begin
if not FServer.Visible then
begin
if not VarIsEmpty(FWorkbook) then
FWorkbook.Close(0); {Do not save Changes}
FServer.Quit;
end;
inherited Destroy;
end;
procedure TExcelWorkbook.SaveAs(DBGrid: TD
