home *** CD-ROM | disk | FTP | other *** search
- unit OLEAdapter;
-
- interface
-
- uses
- Windows, SysUtils, Classes,UFlxMessages,
- {$IFDEF Excel97} Excel97,{$ELSE} Excel2000,{$ENDIF}
- {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} variants,{$IFEND}{$ENDIF} //Delphi 6 or above
- UExcelAdapter, OleServer, UFlxRowComments, UFlxFormats;
-
- {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14}
- {$WARN SYMBOL_PLATFORM OFF}
- {$IFEND}{$ENDIF} //Delphi 6 or above
-
- type
- //We need 2 sets, It's too big for one
- TExcelSaveFormatBasic= (
- saCSV, saCSVMSDOS, saCSVWindows, saCSVMac,
- saDBF4, saDIF,
- saCurrentPlatformText, saTextMSDOS, saTextWindows, saTextMac,
- saExcel5, saExcel7, saExcel9795,
- saWorkbookNormal, saSYLK, saTemplate
- {$IFNDEF Excel97}
- , saUnicodeText, saHtml
- {$ENDIF}
- );
-
- TExcelSaveFormatExtended= (
- saExcel2, saExcel2FarEast, saExcel3, saExcel4,
- saDBF2, saDBF3,
- saExcel4Workbook, saIntlAddIn, saIntlMacro, saTextPrinter,
- saWJ2WD1, saWK1, saWK1ALL, saWK1FMT, saWK3, saWK4, saWK3FM3, saWKS, saWorks2FarEast,
- saWQ1, saWJ3, saWJ3FJ3);
-
- TSetOfExcelSaveFormatBasic = Set Of TExcelSaveFormatBasic;
- TSetOfExcelSaveFormatExtended = Set Of TExcelSaveFormatExtended;
-
- type
- {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 15} Range=ExcelRange;{$IFEND}{$ENDIF} //Delphi 7 or above
-
-
- TOLEAdapter = class(TExcelAdapter)
- private
- FDisplayAlerts: boolean;
- FBlockSize: integer;
- FSaveFormatBasic: TSetOfExcelSaveFormatBasic;
- FSaveFormatExtended: TSetOfExcelSaveFormatExtended;
- { Private declarations }
- protected
- { Protected declarations }
- public
- constructor Create(AOwner:TComponent);override;
- function GetWorkbook: TExcelFile;override;
- { Public declarations }
- published
- property BlockSize: integer read FBlockSize write FBlockSize default 100;
- property DisplayAlerts: boolean read FDisplayAlerts write FDisplayAlerts default true;
- property SaveFormatBasic: TSetOfExcelSaveFormatBasic read FSaveFormatBasic write FSaveFormatBasic default [saExcel9795];
- property SaveFormatExtended: TSetOfExcelSaveFormatExtended read FSaveFormatExtended write FSaveFormatExtended;
- { Published declarations }
- end;
-
- TOLEFile = class(TExcelFile)
- private
- FExcelApplication : TExcelApplication;
- FExcelWorkbook : TExcelWorkbook;
- FExcelWorksheet : TExcelWorksheet;
-
- FAdapter: TOleAdapter;
- FLCID: integer;
-
- RowComments: TRowComments;
-
- FActiveSheet: integer;
-
- FirstColumn, LastColumn: integer;
- WorkRange: Range;
- OldCellData, NewCellData, BlockData: Variant;
- NewDataOffset, OldDataOffset: integer;
-
- procedure ParseComments;
- protected
- function GetCellValue(aRow, aCol: integer): Variant; override;
- procedure SetCellValue(aRow, aCol: integer; const Value: Variant); override;
- function GetCellValueX(aRow, aCol: integer): TXlsCellValue; override;
- procedure SetCellValueX(aRow, aCol: integer; const Value: TXlsCellValue); override;
-
- function GetCommentsCount(Row: integer): integer; override;
- function GetCommentText(Row, aPos: integer): widestring; override;
- function GetPictureName(Row, aPos: integer): widestring; override;
- function GetPicturesCount(Row: integer): integer; override;
-
- function GetExcelNameCount: integer; override;
- function GetRangeName(index: integer): widestring; override;
- function GetRangeR1(index: integer): integer; override;
- function GetRangeR2(index: integer): integer; override;
- function GetRangeC1(index: integer): integer; override;
- function GetRangeC2(index: integer): integer; override;
- function GetRangeSheet(index: integer): integer; override;
-
- function GetActiveSheet: integer; override;
- procedure SetActiveSheet(const Value: integer); override;
- function GetActiveSheetName: WideString; override;
- procedure SetActiveSheetName(const Value: WideString); override;
-
- function GetColumnWidth(aCol: integer): integer;override;
- function GetRowHeight(aRow: integer): integer;override;
- procedure SetColumnWidth(aCol: integer; const Value: integer);override;
- procedure SetRowHeight(aRow: integer; const Value: integer);override;
-
- function GetDefaultColWidth: integer;override;
- function GetDefaultRowHeight: integer;override;
-
- function GetAutoRowHeight(Row: integer): boolean;override;
- procedure SetAutoRowHeight(Row: integer; const Value: boolean);override;
-
- function GetColumnFormat(aColumn: integer): integer; override;
- function GetRowFormat(aRow: integer): integer;override;
- procedure SetColumnFormat(aColumn: integer; const Value: integer);override;
- procedure SetRowFormat(aRow: integer; const Value: integer);override;
-
- function GetColorPalette(Index: TColorPaletteRange): LongWord; override;
- procedure SetColorPalette(Index: TColorPaletteRange; const Value: LongWord); override;
-
- function GetFormatList(index: integer): TFlxFormat; override;
-
- function GetShowGridLines: boolean; override;
- procedure SetShowGridLines(const Value: boolean); override;
-
- function GetCellMergedBounds(aRow, aCol: integer): TXlsCellRange; override;
-
- public
- property ExcelApplication : TExcelApplication read FExcelApplication;
- property ExcelWorkbook : TExcelWorkbook read FExcelWorkbook;
- property ExcelWorksheet : TExcelWorksheet read FExcelWorksheet;
- property LCID:integer read FLCID;
-
- constructor Create(const aAdapter: TOleAdapter );
- destructor Destroy; override;
-
- procedure Connect;override;
- procedure Disconnect;override;
-
- procedure OpenFile(const FileName: TFileName);override;
- procedure CloseFile; override;
-
- procedure InsertAndCopySheets (const CopyFrom, InsertBefore, SheetCount: integer);override;
- function SheetCount: integer;override;
- procedure SelectSheet(const SheetNo:integer); override;
-
- procedure DeleteMarkedRows(const Mark: widestring);override;
- procedure MakePageBreaks(const Mark: widestring);override;
- procedure RefreshPivotTables;override;
- procedure RefreshChartRanges(const VarStr: string);override;
-
- procedure Save(const AutoClose: boolean; const FileName: string; const OnGetFileName: TOnGetFileNameEvent);override;
-
- procedure InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const OnlyFormulas: boolean);override;
- procedure DeleteRows(const aRow, aCount: integer);override;
-
- procedure BeginSheet;override;
- procedure EndSheet(const RowOffset: integer);override;
-
- function CanOptimizeRead: boolean;override;
-
- procedure AssignPicture(const Row, aPos: integer; const Pic: string; const PicType: TXlsImgTypes); override;
- procedure GetPicture(const Row, aPos: integer; const Pic: TStream; var PicType: TXlsImgTypes; var Anchor: TClientAnchor); override; //use row < 0 to return all
- procedure AssignComment(const Row, aPos: integer; const Comment: widestring); override;
-
- function CellCount(const aRow: integer): integer;override;
- function GetCellData(const aRow, aColOffset: integer): variant;override;
- function GetCellDataX(const aRow, aColOffset: integer): TXlsCellValue;override;
- procedure AssignCellData(const aRow, aColOffset: integer; const Value: variant);override;
- procedure AssignCellDataX(const aRow, aColOffset: integer; const Value: TXlsCellValue);override;
- function MaxRow: integer; override;
- function MaxCol: integer; override;
- function IsEmptyRow(const aRow: integer): boolean; override;
-
- function ColByIndex(const Row, ColIndex: integer): integer;override;
- function ColIndexCount(const Row: integer): integer; override;
- function ColIndex(const Row, Col: integer): integer;override;
-
- function FormatListCount: integer;override;
-
- procedure SetBounds(const aRangePos: integer);override;
- function GetFirstColumn: integer; override;
-
- procedure PrepareBlockData(const R1,C1,R2,C2: integer);override;
- procedure AssignBlockData(const Row,Col: integer; const v: variant);override;
- procedure PasteBlockData;override;
-
- function IsWorksheet(const index: integer): boolean; override;
-
- end;
-
- procedure Register;
-
- implementation
- {$R IOLEAdapter}
- const
- SaveFormatBasicConvert: Array[TExcelSaveFormatBasic] of integer= (
- xlCSV, xlCSVMSDOS, xlCSVWindows, xlCSVMac,
- xlDBF4, xlDIF,
- integer(xlCurrentPlatformText), xlTextMSDOS, xlTextWindows, xlTextMac,
- xlExcel5, xlExcel7, xlExcel9795,
- integer(xlWorkbookNormal), xlSYLK, xlTemplate
- {$IFNDEF Excel97}
- , xlUnicodeText, xlHtml
- {$ENDIF}
- );
-
- SaveFormatExtendedConvert: Array[TExcelSaveFormatExtended] of integer= (
- xlExcel2, xlExcel2FarEast, xlExcel3, xlExcel4,
- xlDBF2, xlDBF3,
- xlExcel4Workbook, xlIntlAddIn, xlIntlMacro, xlTextPrinter,
- xlWJ2WD1, xlWK1, xlWK1ALL, xlWK1FMT, xlWK3, xlWK4, xlWK3FM3, xlWKS, xlWorks2FarEast,
- xlWQ1, xlWJ3, xlWJ3FJ3);
-
- procedure Register;
- begin
- RegisterComponents('FlexCel', [TOLEAdapter]);
- end;
-
- { TOLEAdapter }
-
- constructor TOLEAdapter.Create(AOwner: TComponent);
- begin
- inherited;
- FDisplayAlerts:=true;
- FSaveFormatBasic:=[saExcel9795];
- FSaveFormatExtended:=[];
- FBlockSize:=100;
- end;
-
- function TOLEAdapter.GetWorkbook: TExcelFile;
- begin
- Result:= TOLEFile.Create(Self);
- end;
-
- { TOLEFile }
-
- constructor TOLEFile.Create(const aAdapter: TOleAdapter);
- begin
- inherited Create;
- FExcelApplication := TExcelApplication.Create(nil);
- FExcelWorkbook := TExcelWorkbook.Create(nil);
- FExcelWorksheet := TExcelWorksheet.Create(nil);
-
- FAdapter:= aAdapter;
-
- FLCID := LOCALE_USER_DEFAULT;
- end;
-
- destructor TOLEFile.Destroy;
- begin
- FreeAndNil(RowComments);
- FreeAndNil(FExcelApplication);
- FreeAndNil(FExcelWorkbook);
- FreeAndNil(FExcelWorksheet);
- inherited;
- end;
-
- procedure TOLEFile.Connect;
- begin
- // Try to connect to Excel and create new Worksheet
- FExcelApplication.ConnectKind := ckRunningOrNew;
- FExcelApplication.Connect;
-
- FExcelApplication.DisplayAlerts[FLCID] := FAdapter.DisplayAlerts;
- FExcelApplication.Visible[FLCID]:=false;
- FExcelApplication.ScreenUpdating[FLCID] := false;
-
- end;
-
- procedure TOLEFile.Disconnect;
- begin
- FExcelApplication.ScreenUpdating[FLCID] := true;
- FExcelApplication.Visible[FLCID]:=true;
-
- FExcelWorksheet.Disconnect;
- FExcelWorkbook.Disconnect;
- FExcelApplication.Disconnect;
- end;
-
- procedure TOLEFile.CloseFile;
- begin
- FExcelWorkbook.Close(False);
- end;
-
- procedure TOLEFile.OpenFile(const FileName: TFileName);
- begin
- FExcelWorkbook.ConnectTo(FExcelApplication.Workbooks.Add(SearchPathStr(FileName), FLCID));
- end;
-
- procedure TOLEFile.InsertAndCopySheets(const CopyFrom, InsertBefore,
- SheetCount: integer);
- var
- Ws: _Worksheet;
- WsDest: OleVariant;
- i: integer;
- begin
- Ws:=(FExcelWorkbook.Sheets[CopyFrom] as _Worksheet);
- if InsertBefore< FExcelWorkbook.Sheets.Count then
- begin
- WsDest:=(FExcelWorkbook.Sheets[InsertBefore]);
- for i:=0 to SheetCount-1 do Ws.Copy(WsDest, EmptyParam,FLCID);
- end else
- begin
- WsDest:=(FExcelWorkbook.Sheets[InsertBefore-1]);
- for i:=0 to SheetCount-1 do Ws.Copy(EmptyParam,WsDest,FLCID);
- end;
- end;
-
- function TOLEFile.SheetCount: integer;
- begin
- Result:=FExcelWorkbook.Sheets.Count;
- end;
-
- procedure TOLEFile.DeleteMarkedRows(const Mark: widestring);
- var
- r: OleVariant;
- Empty: boolean;
- begin
- repeat
- r := FExcelWorksheet.UsedRange[FLCID].Resize[EmptyParam,1];
- // We dont use early binding in 'Find' method because incompatibilities between d5 & d6 & excel97 & excel2000...
- r :=r.Find(Mark, EmptyParam, integer(xlValues), xlWhole, EmptyParam, xlNext, true, EmptyParam);
- // This is VarIsEmpty... If it just worked in D6...
- Empty:= ((TVarData(r).VType = varDispatch) or (TVarData(r).VType = varUnknown)) and (TVarData(r).VDispatch = nil);
- if not Empty then r.EntireRow.Delete(Integer(xlShiftUp));
- until Empty;
- end;
-
- procedure TOLEFile.MakePageBreaks(const Mark: widestring);
- var
- r: OleVariant;
- Empty: boolean;
- begin
- repeat
- r := FExcelWorksheet.UsedRange[FLCID].Resize[EmptyParam,1];
- // We dont use early binding in 'Find' method because incompatibilities between d5 & d6 & excel97 & excel2000...
- r :=r.Find(Mark, EmptyParam, integer(xlValues), xlWhole, EmptyParam, xlNext, true, EmptyParam);
- // This is VarIsEmpty... If it just worked in D6...
- Empty:= ((TVarData(r).VType = varDispatch) or (TVarData(r).VType = varUnknown)) and (TVarData(r).VDispatch = nil);
- if not Empty then
- begin
- try
- r.EntireRow.Clear;
- FExcelWorksheet.HPageBreaks.Add( r.EntireRow );
- except
- //nothing
- end; //Except
- end;
- until Empty;
- end;
-
- procedure TOLEFile.RefreshPivotTables;
- var
- k, l, m: integer;
- Pvts, Pvt, PvtField, PvtItem: OleVariant;
- begin
- Pvts:=FExcelWorksheet.PivotTables;
- for k:=1 to Pvts.Count do
- begin
- Pvt:= FExcelWorksheet.PivotTables(k, FLCID);
- FExcelApplication.DisplayAlerts[FLCID]:=False; //Here there is a warning we dont want...
- try
- Pvt.PivotCache.Refresh;
- except
- //Nothing, probably there are no rows
- end; //Except
- FExcelApplication.DisplayAlerts[FLCID]:=FAdapter.DisplayAlerts;
-
- for l:=1 to Pvt.PivotFields.Count do
- begin
- PvtField:= Pvt.PivotFields(l);
- for m:=PvtField.PivotItems.Count downto 1 do
- begin
- try
- PvtItem:=PvtField.PivotItems(m);
- if (PvtItem.RecordCount = 0) and not (PvtItem.IsCalculated) then PvtItem.Delete;
- except
- //Nothing
- end; //except
- end;
- end;
- end;
- end;
-
- function TOLEFile.GetActiveSheetName: WideString;
- begin
- Result:= FExcelWorksheet.Name;
- end;
-
- procedure TOLEFile.SetActiveSheetName(const Value: WideString);
- begin
- FExcelWorksheet.Name:= Value;
- end;
-
- function TOLEFile.GetActiveSheet: integer;
- begin
- if FActiveSheet=0 then FActiveSheet:=(FExcelWorkbook.ActiveSheet as _WorkSheet).Index[FLCID]; //First time
- Result:=FActiveSheet;
- end;
-
- procedure TOLEFile.SetActiveSheet(const Value: integer);
- begin
- if IsWorksheet(Value) then
- begin
- FExcelWorksheet.ConnectTo(FExcelWorkbook.Sheets[Value] as _Worksheet);
- FActiveSheet:=Value;
- end;
- end;
-
- procedure TOLEFile.SelectSheet(const SheetNo:integer);
- var
- v: variant;
- begin
- v:=(FExcelWorkbook.Sheets.Item [SheetNo]);
- v.Activate;
- ActiveSheet:= SheetNo;
- end;
-
- procedure TOLEFile.Save(const AutoClose: boolean; const FileName: string; const OnGetFileName: TOnGetFileNameEvent);
- var
- SaveFB: TExcelSaveFormatBasic;
- SaveFE: TExcelSaveFormatExtended;
- aFileName: TFileName;
- begin
- if (AutoClose) then
- begin
- for SaveFB:= Low(TExcelSaveFormatBasic) to High(TExcelSaveFormatBasic) do
- if SaveFB in FAdapter.SaveFormatBasic then
- begin
- aFileName:=Filename;
- if Assigned (OnGetFileName) then OnGetFileName(Self,SaveFormatBasicConvert[SaveFB],aFilename);
- FExcelWorkbook.SaveAs(aFileName,SaveFormatBasicConvert[SaveFB],EmptyParam,EmptyParam,EmptyParam,EmptyParam,xlExclusive,EmptyParam,EmptyParam,EmptyParam,EmptyParam,FLCID);
- end;
- for SaveFE:= Low(TExcelSaveFormatExtended) to High(TExcelSaveFormatExtended) do
- if SaveFE in FAdapter.SaveFormatExtended then
- begin
- aFileName:=Filename;
- if Assigned (OnGetFileName) then OnGetFileName(Self,SaveFormatExtendedConvert[SaveFE],aFilename);
- FExcelWorkbook.SaveAs(aFileName, SaveFormatExtendedConvert[SaveFE], EmptyParam, EmptyParam, EmptyParam, EmptyParam, xlExclusive, EmptyParam, EmptyParam, EmptyParam, EmptyParam, FLCID);
- end;
- end
-
- end;
-
- procedure TOLEFile.DeleteRows(const aRow, aCount: integer);
- var
- NewRange: Range;
- begin
- NewRange:=FExcelWorksheet.Range['A'+IntToStr(aRow), 'A'+IntToStr(aRow+aCount-1)].EntireRow;
- NewRange.Delete(Integer(xlShiftUp));
- end;
-
- procedure TOLEFile.InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const OnlyFormulas: boolean);
- var
- OldRange, NewRange: Range;
- begin
- NewRange:=FExcelWorksheet.Range['A'+IntToStr(DestRow), 'A'+IntToStr(DestRow+aCount*(LastRow-FirstRow+1)-1)].EntireRow;
- NewRange.Insert( integer(xlDown));
- NewRange := NewRange.Offset[-(aCount*(LastRow-FirstRow+1)),0];
- OldRange := FExcelWorksheet.Range['A'+IntToStr(FirstRow), 'A'+IntToStr(LastRow)].EntireRow; //We need the entire row to copy row height!
- OldRange.Copy (NewRange);
-
- end;
-
- procedure TOLEFile.AssignComment(const Row, aPos: integer;
- const Comment: Widestring);
- begin
- if Comment='' then
- begin
- FExcelWorksheet.Comments[RowComments[Row][aPos]].Delete;
- RowComments.Delete(Row,aPos);
- end else
- FExcelWorksheet.Comments[RowComments[Row][aPos]].Text(Comment, EmptyParam, EmptyParam);
- end;
-
- procedure TOLEFile.AssignPicture(const Row, aPos: integer;
- const Pic: string; const PicType: TXlsImgTypes);
- begin
- //Not implemented
- end;
-
- procedure TOLEFile.ParseComments;
- var
- i:integer;
- begin
- FreeAndNil(RowComments);
- RowComments:= TRowComments.Create;
- for i:=1 to FExcelWorksheet.Comments.Count do
- RowComments.Add(FExcelWorksheet.Comments[i].Shape.TopLeftCell.Row, i);
- end;
-
- procedure TOLEFile.BeginSheet;
- begin
- //Parse comments into corresponding rows
- ParseComments;
-
- //Prepare Matrix to handle Data Transfer
- NewCellData:=VarArrayCreate([1,FAdapter.BlockSize,FirstColumn,LastColumn],varVariant);
- WorkRange:=FExcelWorksheet.Range[
- FExcelWorksheet.Cells.Item[1, FirstColumn],
- FExcelWorksheet.Cells.Item[1+FAdapter.BlockSize-1, LastColumn]
- ];
- OldCellData:=Unassigned;
- OldDataOffset:=-1;
-
- end;
-
- procedure TOLEFile.EndSheet(const RowOffset: integer);
- var
- Size:integer;
- begin
- try
- //Flush final data
- Size:=RowOffset-1-NewDataOffset;
- if Size<0 then exit;
- WorkRange:=FExcelWorksheet.Range[
- FExcelWorksheet.Cells.Item[1, FirstColumn],
- FExcelWorksheet.Cells.Item[1+Size, LastColumn]
- ];
- WorkRange.Offset[NewDataOffset,0].FormulaLocal:=NewCellData;
- finally
- WorkRange:=nil; //This is needed so we don't keep any reference to Excel.
- end; //finally
- end;
-
- function TOLEFile.GetCommentsCount(Row: integer): integer;
- begin
- Result:=RowComments[Row].Count;
- end;
-
- function TOLEFile.GetCommentText(Row, aPos: integer): Widestring;
- begin
- Result:=FExcelWorksheet.Comments[RowComments[Row][aPos]].Text(EmptyParam, EmptyParam, EmptyParam);
- end;
-
- function TOLEFile.GetExcelNameCount: integer;
- begin
- Result:=FExcelWorkbook.Names.Count;
- end;
-
- function TOLEFile.GetPictureName(Row, aPos: integer): Widestring;
- begin
- Result:=''; //Not implemented
- end;
-
- function TOLEFile.GetPicturesCount(Row: integer): integer;
- begin
- Result:=0; //Not implemented
- end;
-
- function TOLEFile.GetRangeName(index: integer): Widestring;
- begin
- Result:=FExcelWorkbook.Names.Item(index, EmptyParam, EmptyParam).Name_;
- end;
-
- function TOLEFile.GetRangeR1(index: integer): integer;
- begin
- Result:=FExcelWorkbook.Names.Item(index, EmptyParam, EmptyParam).RefersToRange.Row;
- end;
-
- function TOLEFile.GetRangeR2(index: integer): integer;
- begin
- Result:=GetRangeR1(Index)+FExcelWorkbook.Names.Item(index, EmptyParam, EmptyParam).RefersToRange.Rows.Count-1;
- end;
-
- function TOLEFile.GetRangeC1(index: integer): integer;
- begin
- Result:=FExcelWorkbook.Names.Item(index, EmptyParam, EmptyParam).RefersToRange.Column;
- end;
-
- function TOLEFile.GetRangeC2(index: integer): integer;
- begin
- Result:=GetRangeC1(Index)+FExcelWorkbook.Names.Item(index, EmptyParam, EmptyParam).RefersToRange.Columns.Count-1;
- end;
-
- function TOLEFile.GetRangeSheet(index: integer): integer;
- var
- w:OleVariant; //Cant get to use _Worksheet
- begin
- try
- w:=FExcelWorkbook.Names.Item(index, EmptyParam, EmptyParam).RefersToRange.Worksheet;
- result:=w.Index;
- except //Err in range
- result:=-1;
- end; //Except
- end;
-
- procedure TOLEFile.AssignCellData(const aRow, aColOffset: integer; const Value: variant);
- var
- i,j:integer;
- begin
- if aRow-NewDataOffset > FAdapter.BlockSize then
- begin
- //Flush Data
- WorkRange.Offset[NewDataOffset,0].FormulaLocal:=NewCellData;
- NewDataOffset:=aRow-1;
- for i:=VarArrayLowBound(NewCellData,1) to VarArrayHighBound(NewCellData,1) do
- for j:=VarArrayLowBound(NewCellData,2) to VarArrayHighBound(NewCellData,2) do
- NewCellData[i,j]:=unassigned;
- end;
- NewCellData[aRow-NewDataOffset,aColOffset+FirstColumn]:=Value;
- end;
-
- procedure TOLEFile.AssignCellDataX(const aRow, aColOffset: integer; const Value: TXlsCellValue);
- begin
- AssignCellData(aRow, aColOffset, Value.Value);
- end;
-
- function TOLEFile.CellCount(const aRow: integer): integer;
- begin
- Result:= LastColumn-FirstColumn+1;
- end;
-
- function TOLEFile.GetCellData(const aRow, aColOffset: integer): variant;
- begin
- if (OldDataOffset<0)or (aRow-OldDataOffset>FAdapter.BlockSize) then
- begin
- OldDataOffset:=aRow-1;
- OldCellData:= WorkRange.Offset[OldDataOffset,0].FormulaLocal;
- end;
- GetCellData:=OldCellData[aRow-OldDataOffset,aColOffset+1];
- end;
-
- function TOLEFile.GetCellDataX(const aRow, aColOffset: integer): TXlsCellValue;
- begin
- Result.Value:=GetCellData(aRow,aColOffset);
- Result.Xf:=-1; //Not implemented
- Result.IsFormula:=false; //not implemented
- end;
-
- procedure TOLEFile.SetBounds(const aRangePos: integer);
- var
- CellRange: Range;
- begin
- CellRange:=FExcelWorkbook.Names.Item(aRangePos, EmptyParam, EmptyParam).RefersToRange;
- FirstColumn:=CellRange.Column;
- LastColumn:=CellRange.Column+CellRange.Columns.Count-1;
- NewDataOffset:=CellRange.Row-1;
- end;
-
- procedure TOLEFile.AssignBlockData(const Row, Col: integer; const v: variant);
- begin
- BlockData[Row,FirstColumn+Col]:=v;
- end;
-
- procedure TOLEFile.PasteBlockData;
- var
- R1, R2, C1, C2: integer;
- begin
- R1:=VarArrayLowBound(BlockData,1);
- R2:=VarArrayHighBound(BlockData,1);
- C1:=VarArrayLowBound(BlockData,2);
- C2:=VarArrayHighBound(BlockData,2);
- FExcelWorksheet.Range[
- FExcelWorksheet.Cells.Item[R1, C1],
- FExcelWorksheet.Cells.Item[R2, C2]
- ].FormulaLocal:=BlockData;
- BlockData:=unassigned;
- end;
-
- procedure TOLEFile.PrepareBlockData(const R1, C1, R2, C2: integer);
- begin
- BlockData:= VarArrayCreate([R1,R2,FirstColumn+C1,FirstColumn+C2],varVariant);
- end;
-
- function TOLEFile.MaxRow: integer;
- begin
- Result:= FExcelWorksheet.UsedRange[FLCID].Row-1 + FExcelWorksheet.UsedRange[FLCID].Rows.Count;
- end;
-
- function TOLEFile.MaxCol: integer;
- begin
- Result:= FExcelWorksheet.UsedRange[FLCID].Column-1 + FExcelWorksheet.UsedRange[FLCID].Columns.Count;
- end;
-
- function TOLEFile.GetCellValue(aRow, aCol: integer): Variant;
- begin
- Result:=FExcelWorksheet.Cells.Item[aRow, aCol].Value;
- end;
-
- procedure TOLEFile.SetCellValue(aRow, aCol: integer; const Value: Variant);
- begin
- FExcelWorksheet.Cells.Item[aRow, aCol]:= Value;
- end;
-
- function TOLEFile.IsEmptyRow(const aRow: integer): boolean;
- begin
- Result:=(aRow<1) or (aRow>MaxRow);
- end;
-
- function TOLEFile.CanOptimizeRead: boolean;
- begin
- Result:=false;
- end;
-
-
- procedure TOLEFile.RefreshChartRanges(const VarStr: string);
- var
- i, k: integer;
- s: widestring;
- R: Range;
- Charts: ChartObjects;
- xlDir: integer;
- SaveXVal: OleVariant;
- st:string;
- Local: boolean;
- begin
- Charts:=ChartObjects(FExcelWorksheet.ChartObjects);
- for i:=1 to Charts.Count do
- begin
- s:=ChartObject(Charts.Item(i)).Name;
- if copy(s,1, length(VarStr)) = VarStr then
- begin
- s:=copy(s,Length(VarStr)+1, length(s));
- st:=copy(s,pos(VarStr,s+VarStr)+Length(VarStr),Length(s));
- s:=copy(s,1,pos(VarStr,s+VarStr)-1);
-
- Local:=true;
- //First try to find it in local range.
- try
- R:=FExcelWorksheet.Names.Item(s, EmptyParam, EmptyParam).RefersToRange;
- except
- Local:=false;
- end;
-
- if not Local then R:=FExcelWorkbook.Names.Item(s,EmptyParam, EmptyParam).RefersToRange;
- if UpperCase(st)='C' then xlDir:=xlColumns else xlDir:=xlRows;
- ChartObject(Charts.Item(i)).Activate;
- SaveXVal:=unassigned;
- if (FExcelWorkbook.ActiveChart.SeriesCollection(EmptyParam, LCID) as SeriesCollection).Count>0 then
- SaveXVal:=(FExcelWorkbook.ActiveChart.SeriesCollection(1, LCID) as Series).XValues;
- FExcelWorkbook.ActiveChart.SetSourceData(R, xlDir);
- if not varIsEmpty(SaveXVal) then
- for k:= 1 to (FExcelWorkbook.ActiveChart.SeriesCollection(EmptyParam, LCID) as SeriesCollection).Count do
- try
- (FExcelWorkbook.ActiveChart.SeriesCollection(k, LCID) as Series).XValues:= SaveXVal;
- except
- //nothing
- end; //except
- end;
- end;
- end;
-
- function TOLEFile.IsWorksheet(const index: integer): boolean;
- var
- Dummy: _Worksheet;
- begin
- Result:=Supports(FExcelWorkbook.Sheets[index],_Worksheet, dummy);
- end;
-
- function TOLEFile.GetColumnWidth(aCol: integer): integer;
- begin
- Result:=FExcelWorksheet.Cells.Item[1, aCol].ColumnWidth*256;
- end;
-
- function TOLEFile.GetRowHeight(aRow: integer): integer;
- begin
- Result:=FExcelWorksheet.Cells.Item[aRow, 1].RowHeight*20;
- end;
-
- procedure TOLEFile.SetColumnWidth(aCol: integer; const Value: integer);
- begin
- FExcelWorksheet.Cells.Item[EmptyParam, aCol].ColumnWidth:=Value/256;
- end;
-
- procedure TOLEFile.SetRowHeight(aRow: integer; const Value: integer);
- begin
- FExcelWorksheet.Rows.Item[aRow, EmptyParam].RowHeight:=Value/20;
- end;
-
- function TOLEFile.GetFirstColumn: integer;
- begin
- Result:=FirstColumn;
- end;
-
- function TOLEFile.GetCellValueX(aRow, aCol: integer): TXlsCellValue;
- begin
- Result.Value:=GetCellValue(aRow,aCol);
- Result.Xf:=-1; //Not implemented
- Result.IsFormula:=false; //not implemented
- end;
-
- procedure TOLEFile.SetCellValueX(aRow, aCol: integer;
- const Value: TXlsCellValue);
- begin
- SetCellValue(aRow, aCol, Value.Value);
- end;
-
- function TOLEFile.GetAutoRowHeight(Row: integer): boolean;
- begin
- Result:=true; //not implemented
- end;
-
- procedure TOLEFile.SetAutoRowHeight(Row: integer; const Value: boolean);
- begin
- FExcelWorksheet.Rows.Item[Row, EmptyParam].AutoFit;
-
- end;
-
- function TOLEFile.GetColorPalette(Index: TColorPaletteRange): LongWord;
- begin
- Result:=FExcelWorkbook.Colors[Index,LCID];
- end;
-
- procedure TOLEFile.SetColorPalette(Index: TColorPaletteRange;
- const Value: LongWord);
- begin
- FExcelWorkbook.Colors[Index,LCID]:=LongInt(Value);
- end;
-
- function TOLEFile.GetColumnFormat(aColumn: integer): integer;
- begin
- Result:=0; //not implemented
- end;
-
- function TOLEFile.GetRowFormat(aRow: integer): integer;
- begin
- Result:=0; //Not implemented
- end;
-
- procedure TOLEFile.SetColumnFormat(aColumn: integer; const Value: integer);
- begin
- //Not implemented
- end;
-
- procedure TOLEFile.SetRowFormat(aRow: integer; const Value: integer);
- begin
- //Not Implemented
- end;
-
- function TOLEFile.FormatListCount: integer;
- begin
- Result:=1; //Not Implemented
- end;
-
- function TOLEFile.GetFormatList(index: integer): TFlxFormat;
- begin
- //Not implemented
- end;
-
- function TOLEFile.GetShowGridLines: boolean;
- begin
- Result:=true;
- //Not implemented
- end;
-
- procedure TOLEFile.SetShowGridLines(const Value: boolean);
- begin
- //Not implemented
- end;
-
- function TOLEFile.GetDefaultColWidth: integer;
- begin
- Result:=Round(FExcelWorksheet.StandardWidth[LCID]);
- end;
-
- function TOLEFile.GetDefaultRowHeight: integer;
- begin
- Result:=Round(FExcelWorksheet.StandardHeight[LCID]);
- end;
-
- function TOLEFile.ColByIndex(const Row, ColIndex: integer): integer;
- begin
- Result:=0; //Not implemented
- end;
-
- function TOLEFile.ColIndex(const Row, Col: integer): integer;
- begin
- Result:=0; //Not implemented
- end;
-
- function TOLEFile.ColIndexCount(const Row: integer): integer;
- begin
- Result:=0; //Not implemented
- end;
-
- procedure TOLEFile.GetPicture(const Row, aPos: integer; const Pic: TStream;
- var PicType: TXlsImgTypes; var Anchor: TClientAnchor);
- begin
- //Not implemented
- end;
-
- function TOLEFile.GetCellMergedBounds(aRow, aCol: integer): TXlsCellRange;
- var
- R: Range;
- begin
- R:=FExcelWorksheet.Range[FExcelWorksheet.Cells.Item[aRow, aCol],FExcelWorksheet.Cells.Item[aRow, aCol]].MergeArea;
- Result.Left:= R.Column;
- Result.Top:= R.Row;
- Result.Right:= Result.Left + R.Columns.Count-1;
- Result.Bottom:= Result.Top + R.Rows.Count;
- end;
-
- end.
-