Курсовая работа: Система учёта бракованной продукции (MSAccess, Delphi, ER-Win)

Приложение3. Исходный код компонента, реализующего обмен с MS EXCEL для создания отчётности

unit lipExcel;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Controls,

 Dialogs, ComCtrls, ComObj;

type

 TlipExcel = class(TComponent)

 private

 { Private declarations }

 protected

 { Protected declarations }

 public

 { Public declarations }

 Function Excel_open(Filename:string; List:integer):integer;

 procedure Excel_Prn;

 procedure Excel_Set(x,y:integer;Val:variant);

 procedure Excel_Out(Filename:string;Fileformat:integer);

 function Excel_Get(x,y:integer):variant;

 procedure Excel_List(List:integer);

 procedure Excel_Link(x,Adres:variant);

 procedure Excel_Save(Filename:string;Fileformat:integer);

 procedure Excel_ADD(y:integer);

 procedure Excel_Color(x,y:integer;color:integer);

 procedure Excel_Show(visible:boolean);

 published

 { Published declarations }

 end;

var

 XL, WB, WS: Variant;

 Was: boolean;

 c: integer;

procedure Register;

implementation

procedure Register;

begin

 RegisterComponents('Lipka13', [TlipExcel]);

end;

Function TlipExcel.Excel_open(Filename:string; List:integer):integer;

var

f:file;

begin

if not fileexists(Filename) then

if filename='' then filename:='Default' else exit;

 try

 // Excel уже запущен?

 XL:=GetActiveOleObject('Excel.Application');

 Was:= true;

 except

 // Hет, еще нет...

 try

 XL:=CreateOleObject('Excel.Application');

 Was:= false;

 except

 ShowMessage('Не удалось запустить Excel');

 Abort;

 end;

 end;

 if filename='Default' then XL.Workbooks.add else XL.Workbooks.open(Filename);

 c:= XL.Workbooks.Count;

 WB:= XL.Workbooks[c];

 WS:= WB.Worksheets[list];

 result:=WB.Worksheets.Count;

end;

procedure TlipExcel.Excel_List(List:integer);

begin

 WS:= WB.Worksheets[list];

end;

procedure TlipExcel.Excel_Show(visible:boolean);

begin

 XL.visible:=visible;

end ;

procedure TlipExcel.Excel_Prn;

begin

 WS.printout;

end;

procedure TlipExcel.Excel_ADD(y:integer);

begin

 WS.Rows[y].Copy;

 WS.Rows[y].Insert(1);

 //WS.Range['A'+IntToStr(y),CHR(64 + 4 )+ IntToStr(y)].Insert(1);

end;

procedure TlipExcel.Excel_Set(x,y:integer;Val:variant);

begin

WS.Cells[y, x].Value:=val;

end;

procedure TlipExcel.Excel_Color(x,y:integer;color:integer);

begin

WS.Cells[y, x].Interior.ColorIndex:=color;

end;

procedure TlipExcel.Excel_Link(x,Adres:variant);

begin

 ws.Hyperlinks.Add(ws.Range[x, EmptyParam],Adres,EmptyParam)

end;

function TlipExcel.Excel_Get(x,y:integer):variant;

begin

Result:=WS.Cells[y, x].Value;

end;

procedure TlipExcel.Excel_Out(Filename:string;Fileformat:integer);

begin

xl.DisplayAlerts := False;

try

 if filename<>'' then wb.saveas(Filename,Fileformat);

wb.saveas(ExtractFilePath(Application.exename)+'reportsxls\'+savedate(form2.DateTimePicker1.Date)+'.xls', 1);

 finally

 WB.Close;

 xl.DisplayAlerts := True;

 if not Was then XL.Quit;

 WS := null;

 WB := null;

 xl := null;

 end;

end;

procedure TlipExcel.Excel_Save(Filename:string;Fileformat:integer);

begin

xl.DisplayAlerts := False;

try

 wb.saveas(Filename,Fileformat);

wb.saveas(ExtractFilePath(Application.exename)+'reportsxls\'+savedate(form2.DateTimePicker1.Date)+'.xls', 1);

 finally

 xl.DisplayAlerts := True;

 end;

end;

end.