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: TDBGrid; aWorkbookFile: string);
var w:widestring;
begin
  CopyToWorkbook(DBGrid,0);
  w := UTF8Decode(aWorkbookFile);
  FWorkbook.SaveAs(w);
end;

procedure TExcelWorkbook.OpenInExcel(DBGrid: TDBGrid);
begin
  FServer.Visible := true;
  CopyToWorkbook(DBGrid,0);
end;


end.


On 05/10/16 09:54, Dennis via Lazarus wrote:
I am having problem using the Type Library generated.
Don't know how to use it.

I tried to 'learn' from old Delphi 5 source code (the only version of Delphi I have) that worked with Excel 2000 but found that the type library are so different from the one generated by FPC.

Dennis



-- 
_______________________________________________
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Reply via email to