xlsadapter.pas

TMS Component Pack Pro v4.2

procedure TXLSFile.OpenFileOrStream(const FileName: TFileName; const aStream: TStream);
var
  WorkbookStr: widestring;
  DocIN: TOle2Storage;
  StreamIN: TOle2Stream;
  Fn: string;
begin
  WorkbookStr:=WorkbookStrS;
  FTemplate:=nil;
  FreeAndNil(FTmpTemplate);

  if (FAdapter<>nil) and (FAdapter.TemplateStore<>nil) then
  begin
    FTemplate:=FAdapter.TemplateStore.Storages[FileName];
    FWorkbook.LoadFromStream(FTemplate.Stream[WorkbookStr]);
  end
  else
  begin
    FTmpTemplate:=TXlsStorageList.Create;
    if Trim(FileName)<>'' then Fn:=SearchPathStr(FileName) else Fn:='';
    //This is to load all storages except workbook. For reading big files, makes no sense to keep workbook on memory 2 times
    DocIN:= TOle2Storage.Create(Fn, Ole2_Read, aStream);
    try
      FTmpTemplate.LoadStorage(DocIN, false);
      StreamIn:=  TOle2Stream.Create( DocIN, WorkbookStr);
      try
        FWorkbook.LoadFromStream(StreamIn);
      finally
        FreeAndNil(StreamIn);
      end; //finally
    finally
      FreeAndNil(DocIN);
    end; //finally
    FTemplate:=FTmpTemplate;

  end;
  FActiveSheet:=FWorkbook.ActiveSheet+1;
end;

procedure TXLSFile.OpenFile(const FileName: TFileName);
begin
  OpenFileOrStream(FileName, nil);
end;

procedure TXLSFile.LoadFromStream(const aStream: TStream);
begin
  OpenFileOrStream('', aStream);
end;

procedure TXLSFile.RefreshPivotTables;
begin
  //Nothing
end;



procedure TXLSFile.SaveAsXls(const FileName: string; const DataStream: TStream);
var
  WorkbookStr: widestring;

  i:integer;
  DocOUT: TOle2Storage;
  StreamOUT: TOle2Stream;
begin
  WorkbookStr:=WorkbookStrS;
  //Create output file
  DocOUT:= TOle2Storage.Create(FileName, Ole2_Write, DataStream);
  try
    for i:=0 to FTemplate.Count-1 do
      if FTemplate[i].Name<>WorkbookStr then
      begin
        FTemplate[i].SaveToDoc(DocOUT);
      end;

    StreamOUT:= TOle2Stream.Create(DocOUT, WorkbookStr);
    try
      FWorkbook.SaveToStream(StreamOUT);
    finally
      FreeAndNil(StreamOut);
    end; //finally
  finally
    FreeAndNil(DocOUT);
  end; //Finally
end;

procedure TXLSFile.SaveAsTextDelimited(const FileName: string;
  const DataStream: TStream; const Delim: char);
{$IFNDEF TMSASGx}
var
  OutStream: TFileStream;
{$ENDIF}
begin
{$IFNDEF TMSASGx}
  if DataStream=nil then
  begin
    OutStream:=TFileStream.Create(FileName, fmCreate);
    try
      SaveAsTextDelim(OutStream, Self, Delim);
    finally
      FreeAndNil(OutStream);
    end; //finally
  end
  else
    SaveAsTextDelim(DataStream, Self, Delim);
{$ENDIF}
end;


procedure TXLSFile.Save(const AutoClose: boolean; const FileName: string; const OnGetFileName: TOnGetFileNameEvent; const OnGetOutStream: TOnGetOutStreamEvent=nil; const DataStream: TStream=nil);
var
  aFileName: TFileName;
  OutStream: TStream;
  SF: TExcelSaveFormatNative;
begin
  for SF:=Low(TExcelSaveFormatNative) to High(TExcelSaveFormatNative) do
    if ((FAdapter<>nil) and (SF in FAdapter.SaveFormat))or
       ((FAdapter=nil) and (SF = snXLS)) then
    begin
      aFileName:=Filename;
      OutStream:=nil;
      if Assigned(DataStream) then
      begin
        //Save to stream
        OutStream:=DataStream;
      end
      else
      if Assigned (OnGetOutStream) then
      begin
        //SaveToStream
        OnGetOutStream(Self,integer(SF),OutStream);
      end else
      begin
        //SaveToFile
        if Assigned (OnGetFileName) then OnGetFileName(Self,integer(SF),aFilename);
        if FileExists(aFileName) then raise Exception.CreateFmt(ErrCantWriteToFile, [aFileName]);  //this is to avoid a criptic ole xxxx error...
      end;

      case SF of
        snXLS: SaveAsXls(aFileName, OutStream);
        snCSVComma: SaveAsTextDelimited(aFileName, OutStream, ',');
        snCSVSemiColon: SaveAsTextDelimited(aFileName, OutStream, ';');
        snTabDelimited: SaveAsTextDelimited(aFileName, OutStream, #9);
        else raise Exception.Create(ErrInternal);
      end; //case
    end;
end;

procedure TXLSFile.SelectSheet(const SheetNo:integer);
begin
  FWorkbook.ActiveSheet:=SheetNo-1;
end;

procedure TXLSFile.SetActiveSheet(const Value: integer);
begin
  FActiveSheet:=Value;
end;

procedure TXLSFile.SetActiveSheetName(const Value: WideString);
begin
  FWorkbook.Globals.SheetName[FActiveSheet-1]:= Value;
end;

procedure TXLSFile.SetActiveSheetCodeName(const Value: WideString);
var
  i: integer;
begin
  for i:=0 to FWorkbook.Sheets.Count-1 do
  begin
    if FWorkbook.Sheets[i].CodeName= Value then raise Exception.CreateFmt(ErrDuplicatedSheetName,[Value]);
  end;

  FWorkbook.Sheets[FActiveSheet-1].CodeName:= Value;
end;

procedure TXLSFile.SetBounds(const aRangePos: integer);
begin
  FirstColumn:=FWorkbook.Globals.Names[aRangePos-1].GetC1;
  LastColumn:=FWorkbook.Globals.Names[aRangePos-1].GetC2;
end;

function TXLSFile.SheetCount: integer;
begin
  Result:=FWorkbook.Globals.SheetCount;
end;

procedure TXLSFile.AssignBlockData(const Row, Col: integer; const v: variant);
begin
  AssignCellData(Row, Col, v);
end;

procedure TXLSFile.PasteBlockData;
begin
  // Nothing
end;

procedure TXLSFile.PrepareBlockData(const R1, C1, R2, C2: integer);
begin
  // Nothing
end;

function TXLSFile.MaxRow: integer;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result:=0;exit;end;
  Result:= FWorkbook.WorkSheets[FActiveSheet-1].Cells.RowList.Count;
end;

function TXLSFile.MaxCol: integer;
var
  i: integer;
begin
  Result:=0;
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;

  with FWorkbook.WorkSheets[FActiveSheet-1].Cells.RowList do
    for i:=0 to Count-1 do
      if HasRow(i) then
        if Items[i].MaxCol> Result then Result:= Items[i].MaxCol; //MaxCol is 0 based, but references the last used col +1
end;

function TXLSFile.GetCellValue(aRow, aCol: integer): Variant;
begin
  Result:= GetCellData(aRow, aCol-FirstColumn-1);
end;

procedure TXLSFile.SetCellValue(aRow, aCol: integer; const Value: Variant);
begin
  AssignCellData(aRow, aCol-FirstColumn-1, Value);
end;

function TXLSFile.IsEmptyRow(const aRow: integer): boolean;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result:=true;exit;end;
  Result:=
    (aRow-1<0) or (aRow-1>= FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Count) or
    not FWorkbook.WorkSheets[FActiveSheet-1].Cells.RowList.HasRow(aRow-1);
end;


function TXLSFile.CanOptimizeRead: boolean;
begin
  Result:=true;
end;

procedure TXLSFile.RefreshChartRanges(const VarStr: string);
begin
  //not implemented
end;

function TXLSFile.IsWorksheet(const index: integer): boolean;
begin
  Result:= FWorkbook.Sheets[index-1] is TWorkSheet;
end;


function TXLSFile.GetColumnWidth(aCol: integer): integer;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result:=0;exit;end;
  Result:= FWorkbook.WorkSheets[FActiveSheet-1].GetColWidth(aCol-1);
end;

function TXLSFile.GetRowHeight(aRow: integer): integer;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result:=0;exit;end;
  Result:= FWorkbook.WorkSheets[FActiveSheet-1].GetRowHeight(aRow-1);
end;

procedure TXLSFile.SetColumnWidth(aCol: integer; const Value: integer);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].SetColWidth(aCol-1, Value);
end;

procedure TXLSFile.SetRowHeight(aRow: integer; const Value: integer);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].SetRowHeight(aRow-1, Value);
end;

function TXLSFile.GetColumnHidden(const aCol: integer): boolean;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result:=false;exit;end;
  if (aCol<1)or (aCol>Max_Columns+1) then begin; result:=false;exit;end;
  Result:= FWorkbook.WorkSheets[FActiveSheet-1].GetColHidden(aCol-1);
end;

function TXLSFile.GetRowHidden(const aRow: integer): boolean;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result:=false;exit;end;
  Result:= FWorkbook.WorkSheets[FActiveSheet-1].GetRowHidden(aRow-1);
end;

procedure TXLSFile.SetColumnHidden(const aCol: integer; const Value: boolean);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  if (aCol<1)or (aCol>Max_Columns+1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].SetColHidden(aCol-1, Value);
end;

procedure TXLSFile.SetRowHidden(const aRow: integer; const Value: boolean);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].SetRowHidden(aRow-1, Value);
end;

function TXLSFile.GetFirstColumn: integer;
begin
  Result:=FirstColumn+1;
end;

function TXLSFile.GetCellValueX(aRow, aCol: integer): TXlsCellValue;
begin
  Result:= GetCellDataX(aRow, aCol-FirstColumn-1);
end;

procedure TXLSFile.SetCellValueX(aRow, aCol: integer;
  const Value: TXlsCellValue);
begin
  AssignCellDataX(aRow, aCol-FirstColumn-1, Value);
end;

function TXLSFile.GetAutoRowHeight(Row: integer): boolean;
begin
  Result:=true;
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].Cells.RowList.IsAutoRowHeight(Row-1);
end;

procedure TXLSFile.SetAutoRowHeight(Row: integer; const Value: boolean);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].Cells.RowList.AutoRowHeight(Row-1, Value);
end;

function TXLSFile.GetColorPalette(Index: TColorPaletteRange): LongWord;
begin
  Result:=FWorkbook.Globals.ColorPalette[Index-1];
end;

function TXlsFile.GetUsedPaletteColors: BooleanArray;
begin
  Result := FWorkbook.Globals.XF.GetUsedColors(56 + 1, FWorkbook.Globals.Fonts);
end;

procedure TXLSFile.SetColorPalette(Index: TColorPaletteRange;
  const Value: LongWord);
begin
  FWorkbook.Globals.ColorPalette[Index-1]:=Value;
end;

function TXLSFile.GetColumnFormat(aColumn: integer): integer;
begin
  Result:=-1;
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].GetColFormat(aColumn-1);
end;

function TXLSFile.GetRowFormat(aRow: integer): integer;
begin
  Result:=0;
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].GetRowFormat(aRow-1);
end;

procedure TXLSFile.SetColumnFormat(aColumn: integer; const Value: integer);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].SetColFormat(aColumn-1, Value);
end;

procedure TXLSFile.SetRowFormat(aRow: integer; const Value: integer);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].SetRowFormat(aRow-1, Value);
end;

function TXLSFile.FormatListCount: integer;
begin
  Result:=FWorkbook.Globals.XF.Count;
end;

function TXLSFile.GetFormatList(index: integer): TFlxFormat;
begin
  if (Index<0) or (Index>=FWorkbook.Globals.XF.Count) then Index:=0;
  Result:=FWorkbook.Globals.XF[index].FlxFormat(FWorkbook.Globals.Fonts, FWorkbook.Globals.Formats);
end;

procedure TXLSFile.SetFormatList(index: integer; Value: TFlxFormat);
begin
  if (Index<0) or (Index>=FWorkbook.Globals.XF.Count) then Index:=0;