//////////////////////////////////////////////////////////////
// ExcelView v 0.1 //
// Freeware component for Delphi 2010/XE/XE2 //
// //
// Copyright (c) 2012 RILIO (http://rilio.net) //
// //
// Software distributed on an "AS IS" basis, //
// WITHOUT WARRANTY OF ANY KIND, either express or implied. //
// //
//////////////////////////////////////////////////////////////
unit ExcelView;
interface
uses
 SysUtils, Classes, DB;
type
 TExcelView = class(TComponent)
 private
 FTemplateFileName: TFileName;
 procedure SetTemplateFileName(const Value: TFileName);
 procedure ProcessSheet(Sheet: Variant);
 procedure ProcessDataSet(Sheet: Variant; Row: integer);
 procedure ProcessMultipleRecords(Sheet: Variant; Row: integer; DataSet: TDataSet);
 procedure ProcessProperty(Sheet: Variant; Row: integer; Col: integer);
 protected
 public
 procedure Show;
 published
 property TemplateFileName: TFileName read FTemplateFileName write SetTemplateFileName;
 end;
procedure ShowExcelView(Owner: TComponent; FileName: TFileName);
procedure Register;
implementation
uses Variants, ActiveX, ComObj, Rtti, TypInfo;
procedure ShowExcelView(Owner: TComponent; FileName: TFileName);
begin
 with TExcelView.Create(Owner) do begin
 TemplateFileName:=FileName;
 Show;
 Free;
 end;
end;
function IsExcelInstalled: boolean;
var
 ClassID: TCLSID;
begin
 Result := CLSIDFromProgID(PWideChar(WideString('Excel.Application')), ClassID) = S_OK;
end;
procedure Register;
begin
 RegisterComponents('RILIO', [TExcelView]);
end;
{ TExcelView }
procedure TExcelView.ProcessDataSet(Sheet: Variant; Row: integer);
var DataSetName: string;
 MultipleRecords: boolean;
 DataSet: TDataSet;
 i: integer;
 FieldName: string;
begin
 DataSetName:=Sheet.Cells[Row,1];
 MultipleRecords:=DataSetName[1]='*';
 if MultipleRecords then
 DataSetName:=Copy(DataSetName,2,length(DataSetName));
 DataSet:=TDataSet(Owner.FindComponent(DataSetName));
 if DataSet <> nil then
 if MultipleRecords and (DataSet.RecordCount > 1) then ProcessMultipleRecords(Sheet,Row,DataSet) else
 for i := 2 to Sheet.UsedRange.Columns.Count do begin
 FieldName:=string(Sheet.Cells[Row,i]);
 if DataSet.FindField(FieldName) <> nil then begin
 if DataSet.FieldByName(FieldName).DataType=ftFloat then
 Sheet.Cells[Row,i]:=DataSet.FieldByName(FieldName).AsFloat
 else Sheet.Cells[Row,i]:=DataSet.FieldByName(FieldName).AsString;
 end;
 end;
end;
procedure TExcelView.ProcessMultipleRecords(Sheet: Variant; Row: integer; DataSet: TDataSet);
var i,z,y: integer;
 ArrayData : Variant;
 FieldName: string;
 FieldList: TStringList;
 StartCol: integer;
 Cell1,Cell2,Cell3,Range,RowRange: OleVariant;
begin
 StartCol:=0;
 FieldList:=TStringList.Create;
 for i:=2 to Sheet.UsedRange.Columns.Count do begin
 FieldName:=string(Sheet.Cells[Row,i]);
 if DataSet.FindField(FieldName) <> nil then begin
 FieldList.Add(FieldName);
 if StartCol=0 then StartCol:=i;
 end else if StartCol <> 0 then FieldList.Add('');
 end;
 FieldList.Text:=Trim(FieldList.Text);
 DataSet.Last;
 DataSet.First;
 ArrayData := VarArrayCreate([1, DataSet.RecordCount, 1, FieldList.Count], varVariant);
 y := 1;
 while not DataSet.Eof do
 begin
 z := 1;
 for i := 0 to FieldList.Count-1 do begin
 if FieldList[i]='' then ArrayData[y, z] :=''
 else begin
 if DataSet.FieldByName(FieldList[i]).DataType=ftFloat then
 ArrayData[y, z] := DataSet.FieldByName(FieldList[i]).AsFloat
 else ArrayData[y, z] := DataSet.FieldByName(FieldList[i]).Value;
 end;
 inc(z);
 end;
 DataSet.Next;
 inc(y);
 end;
 for i := 1 to DataSet.RecordCount-1 do
 Sheet.Rows[Row+1].Insert;
 Cell1 := Sheet.Cells[Row, StartCol];
 Cell2 := Sheet.Cells[Row, StartCol + FieldList.Count-1];
 Cell3 := Sheet.Cells[Row + DataSet.RecordCount-1, StartCol + FieldList.Count-1];
 RowRange := Sheet.Range[Cell1, Cell2];
 Range := Sheet.Range[Cell1, Cell3];
 if DataSet.RecordCount=0 then RowRange.Value:='' else begin
 RowRange.AutoFill(Range, 3);
 Range.WrapText:= True;
 Range.VerticalAlignment := 1;
 Range.Value := ArrayData;
 end;
 FieldList.Free;
end;
procedure TExcelView.ProcessProperty(Sheet: Variant; Row, Col: integer);
var st, PropName, PropValue: string;
 i1, i2, dotpos: integer;
 cmp: TComponent;
 c : TRttiContext;
 t : TRttiType;
 p : TRttiProperty;
 IsNumeric: boolean;
begin
 st:=string(Sheet.Cells[Row, Col]);
 i1:=Pos('[',st);
 i2:=Pos(']',st);
 PropName:=Copy(st,i1+1,i2-i1-1);
 dotpos:=Pos('.',PropName);
 if dotpos <> 0 then begin
 cmp:=Owner.FindComponent(Copy(PropName,1,dotpos-1));
 PropName:=Copy(PropName,dotpos+1,length(PropName));
 end else cmp:=Owner;
 if cmp <> nil then begin
 c := TRttiContext.Create;
 t:=c.GetType(cmp.ClassInfo);
 p:=t.GetProperty(PropName);
 if p <> nil then begin
 IsNumeric:=false;
 if p.PropertyType.ToString = 'TStrings' then PropValue:=p.GetValue(cmp).AsType<TStrings>.Text
 else if p.PropertyType.ToString = 'Boolean' then PropValue:=BoolToStr(p.GetValue(cmp).AsBoolean,true)
 else
 case p.PropertyType.TypeKind of
 tkInteger,
 tkInt64 : begin
 PropValue := IntToStr(p.GetValue(cmp).AsInteger);
 IsNumeric:=true;
 end;
 tkString,
 tkUString,
 tkLString : PropValue := p.GetValue(cmp).AsString;
 tkFloat : begin
 PropValue := FloatToStr(p.GetValue(cmp).AsExtended);
 IsNumeric:=true;
 end;
 else PropValue := '';
 end;
 if IsNumeric and (Trim(Copy(st,1,i1-1))='') and (Trim(Copy(st,i2+1,length(st)))='') then
 Sheet.Cells[Row, Col]:=StrToFloat(PropValue)
 else Sheet.Cells[Row, Col]:=Copy(st,1,i1-1)+PropValue+Copy(st,i2+1,length(st));
 end;
 c.Free;
 end;
end;
procedure TExcelView.ProcessSheet(Sheet: Variant);
var
 i,j,Cols,Rows: integer;
begin
 Sheet.Activate;
 Rows:=Sheet.UsedRange.Rows.Count;
 Cols:=Sheet.UsedRange.Columns.Count;
 for i := 1 to Rows+1 do begin
 for j := 1 to Cols+1 do
 if Pos('[',string(Sheet.Cells[i,j])) <> 0 then
 ProcessProperty(Sheet,i,j);
 end;
 for i := 1 to Rows+1 do begin
 if string(Sheet.Cells[i,1]) <> '' then
 ProcessDataSet(Sheet,i);
 end;
 Sheet.Columns[1].Hidden:=true;
end;
procedure TExcelView.SetTemplateFileName(const Value: TFileName);
begin
 FTemplateFileName := Value;
end;
procedure TExcelView.Show;
var
 Excel, Book, Sheet, ArrayData : Variant;
 i: integer;
 ClassID: TCLSID;
begin
 if not FileExists(TemplateFileName) then raise Exception.Create('Template file "'+TemplateFileName+'" not found');
 if CLSIDFromProgID(PWideChar(WideString('Excel.Application')), ClassID) <> S_OK then raise Exception.Create('MS Excel application not found');
 try
 Excel := CreateOleObject('Excel.Application');
 Excel.EnableEvents := False;
 Excel.Visible:=false;
 Book := Excel.Workbooks.Add(TemplateFileName);
 for i := 1 to Book.Sheets.Count do
 ProcessSheet(Book.Sheets.Item[i]);
 Book.Sheets.Item[1].Activate;
 finally
 Excel.EnableEvents := true;
 Excel.Visible:=true;
 Excel.Visible:=false;
 Excel.Visible:=true;
 end;
end;
end.