tmsxlsadapter.pas

Create modern-looking & feature-rich Windows applications faster with over 300 components in one mon

    Result:=0;
end;

function TXLSFile.GetCommentText(Row, aPos: integer): UTF16String;
begin
  if FWorkbook.IsWorkSheet(ActiveSheet-1)
    and (Row-1<FWorkbook.WorkSheets[ActiveSheet-1].Notes.Count) then
      Result:=FWorkbook.WorkSheets[ActiveSheet-1].Notes[Row-1][aPos].Text
    else
      Result:='';
end;

function TXLSFile.GetExcelNameCount: integer;
begin
  Result:=FWorkbook.Globals.Names.Count;
end;

function TXLSFile.GetPictureName(Row, aPos: integer): UTF16String;
var
  MyPos: integer;
begin
  if Row>0 then MyPos:=RowPictures[Row][aPos] else MyPos:=aPos;
  Result:= '';
  if not FWorkbook.IsWorksheet(FActiveSheet-1) then exit;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].DrawingName[MyPos];
end;

function TXLSFile.GetPicturesCount(Row: integer): integer;
begin
  Result:=0;
  if not FWorkbook.IsWorksheet(FActiveSheet-1) then exit;
  if Row>0 then Result:=RowPictures[Row].Count else
    Result:= FWorkbook.WorkSheets[ActiveSheet-1].DrawingCount;
end;

function TXLSFile.GetRangeName(index: integer): UTF16String;
begin
  Result:= FWorkbook.Globals.Names[index-1].Name;
end;

function TXLSFile.GetRangeR1(index: integer): integer;
begin
  Result:= FWorkbook.Globals.Names[index-1].GetR1+1;
end;

function TXLSFile.GetRangeR2(index: integer): integer;
begin
  Result:= FWorkbook.Globals.Names[index-1].GetR2+1;
end;

function TXLSFile.GetRangeC1(index: integer): integer;
begin
  Result:= FWorkbook.Globals.Names[index-1].GetC1+1;
end;

function TXLSFile.GetRangeC2(index: integer): integer;
begin
  Result:= FWorkbook.Globals.Names[index-1].GetC2+1;
end;

function TXLSFile.GetRangeSheet(index: integer): integer;
begin
  Result:= FWorkbook.Globals.Names[index-1].RefersToSheet(FWorkbook.Globals.References.GetSheet)+1;
end;

procedure TXLSFile.InsertAndCopyRows(const FirstRow, LastRow, DestRow,
  aCount: integer; const OnlyFormulas: boolean);
begin
  FWorkbook.InsertAndCopyRowsAndCols(FActiveSheet-1, FirstRow-1, LastRow-1, DestRow-1, aCount, 0,0,0,0, OnlyFormulas);
  IsFileModified := true;
end;

procedure TXLSFile.InsertAndCopyCols(const FirstCol, LastCol, DestCol,
  aCount: integer; const OnlyFormulas: boolean);
begin
  FWorkbook.InsertAndCopyRowsAndCols(FActiveSheet-1, 0,0,0,0, FirstCol-1, LastCol-1, DestCol-1, aCount, OnlyFormulas);
  IsFileModified := true;
end;

procedure TXLSFile.InsertAndCopySheets(const CopyFrom, InsertBefore,
  SheetCount: integer);
begin
  FWorkbook.InsertSheets(CopyFrom-1, InsertBefore-1, SheetCount);
  IsFileModified := true;
end;

procedure TXLSFile.OpenStream(const aStream: TStream);
var
  DataStream: TOle2File;
  MemStream: TMemoryStream;
  DeleteStorages: StringArray;
begin
{$IFDEF TRIAL}
{$WARNINGS OFF}
  if DebugHook = 0 then ShowMessage('This is an unregistered version of FlexCel');
{$WARNINGS ON}
{$ENDIF}
  MemStream := TMemoryStream.Create;
  try
    DataStream := TOle2File.Create(aStream);
    try
      DataStream.SelectStream(WorkbookStrS);
      FWorkbook.LoadFromStream(DataStream);
      SetLength(DeleteStorages, 0);
      DataStream.PrepareForWrite(MemStream, WorkbookStrS, DeleteStorages); //Saves all the other streams.
    finally
      FreeAndNil(DataStream);
    end;

    SetLength(FOtherStreams, MemStream.Size);
    MemStream.Position := 0;
    MemStream.ReadBuffer(FOtherStreams[0], Length(FOtherStreams));
  finally
    FreeAndNil(MemStream);
  end;

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

procedure TXLSFile.OpenFile(const FileName: TFileName);
begin
  OpenFileAndOrSearch(FileName, false);
end;

procedure TXLSFile.OpenFileAndSearch(const FileName: TFileName);
begin
  OpenFileAndOrSearch(FileName, true);
end;

procedure TXLSFile.OpenFileAndOrSearch(const FileName: TFileName; const Search: boolean);
var
  fs: TStream;
  TemplateData: ByteArray;
  SearchFileName: string;
begin
  TemplateData := nil; //Avoid stupid warning in D7.
  fs := nil;
  try
    if (FAdapter<>nil) and (FAdapter.TemplateStore<>nil) then
    begin
      fs := TMemoryStream.Create;
      TemplateData := FAdapter.TemplateStore.StoredFile[FileName];
      fs.Write(TemplateData[0], Length(TemplateData));
      fs.Seek(0, soFromBeginning)
    end
    else
    begin
      if Search and (FAdapter <> nil) then
      begin
        SearchFileName := SearchPathStr(FAdapter.BasePathToOpen, FileName);
      end
      else SearchFileName := FileName;

      fs := TFileStream.Create(SearchFileName, fmOpenRead or fmShareDenyNone);
    end;

    OpenStream(fs);
  finally
    FreeAndNil(fs);
  end;
end;

procedure TXLSFile.LoadFromStream(const aStream: TStream);
begin
  OpenStream(aStream);
end;

procedure TXLSFile.RefreshPivotTables;
begin
  //Nothing
end;


procedure TXLSFile.RemoveAutoFilter;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].RemoveAutoFilter;
end;

procedure TXLSFile.SaveAsXls(const aFileName: string; const aStream: TStream);
var
  f: TFileStream;
  CreateMode: word;
begin
  if aStream <> nil then SaveAsXls(aStream)
  else
  begin
    CreateMode := fmCreate;
    f := TFileStream.Create(aFileName, CreateMode);
    try
    try
      SaveAsXls(f);
    except
      SysUtils.DeleteFile(aFileName);
      raise;
    end;
    finally
      FreeAndNil(f);
    end;
  end;
end;

procedure TXLSFile.SaveAsXls(const aStream: TStream);
var
  MemStream: TMemoryStream;
  DataStream: TOle2File;
  DeleteStreams: StringArray;
begin
  MemStream := TMemoryStream.Create;
  try
    MemStream.WriteBuffer(FOtherStreams[0], Length(FOtherStreams));
    MemStream.Position := 0;
    DataStream := TOle2File.Create(MemStream);
    try
      SetLength(DeleteStreams, 0);
      DataStream.PrepareForWrite(aStream, WorkbookStrS, DeleteStreams);
      FWorkbook.SaveToStream(DataStream, IsFileModified);
    finally
      FreeAndNil(DataStream);
    end;
  finally
    FreeAndNil(MemStream);
  end;

end;

procedure TXLSFile.SaveAsTextDelimited(const FileName: string;
  const DataStream: TStream; const Delim: Char);
begin
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 (not AllowOverwritingFiles) and FileExists(aFileName) then raise Exception.CreateFmt(ErrCantWriteToFile, [aFileName]); 
      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: UTF16String);
begin
  FWorkbook.Globals.SheetName[FActiveSheet-1]:= Value;
end;

procedure TXLSFile.SetActiveSheetCodeName(const Value: UTF16String);
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: UTF16String);
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;