[Lazarus] Anyone has experience controlling Excel from FPC/delphi via OLE Automation?

[Tony Whyman]

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
>
>

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20161005/155a994c/attachment.html>