xlsadapter.pas

来自「DELPHI界面增强控件,非常好,里面有显示GIF的图片控件,更美观的下拉框控件」· PAS 代码 · 共 1,566 行 · 第 1/4 页

  ParsePictures;
end;

function TXLSFile.CellCount(const aRow: integer): integer;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result:=0; exit; end;
  if aRow-1<FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Count then
    Result:=LastColumn-FirstColumn+1
  else Result:=0;
end;

procedure TXLSFile.CloseFile;
begin
  //Nothing
end;

procedure TXLSFile.Connect;
begin
  FWorkbook:= TWorkbook.Create;
end;

constructor TXLSFile.Create(const aAdapter: TXLSAdapter);
begin
  inherited Create;
  FAdapter:= aAdapter;
end;

procedure TXLSFile.DeleteMarkedRows(const Mark: widestring);
var
  i:integer;
  s: widestring;
  Cl: TCellList;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  Cl:=FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList;
  for i:=Cl.Count -1 downto 0 do
  try
    s:= Cl.Value[i,0].Value;
    if (s=Mark) then
      FWorkbook.DeleteRows(FActiveSheet-1, i, 1);
  except
    //nothing
  end;//except
end;

procedure TXLSFile.MakePageBreaks(const Mark: widestring);
var
  i:integer;
  s: widestring;
  V: TXlsCellValue;
  Cl: TCellList;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  V.Value:=Unassigned; V.XF:=-1;
  Cl:=FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList;
  for i:=Cl.Count -1 downto 0 do
  try
    s:= Cl.Value[i,0].Value;
    if (s=Mark) then
    begin
      FWorkbook.InsertHPageBreak(FActiveSheet-1, i);
      FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Value[i,0]:=V;
    end;
  except
    //nothing
  end;//except
end;

procedure TXLSFile.DeleteRows(const aRow, aCount: integer);
begin
  FWorkbook.DeleteRows(FActiveSheet-1, aRow-1, aCount);
end;

destructor TXLSFile.Destroy;
begin
  FreeAndNil(RowPictures);
  FreeAndNil(FTmpTemplate);
  inherited;
end;

procedure TXLSFile.Disconnect;
begin
  FreeAndNil(FWorkbook);
end;

procedure TXLSFile.EndSheet(const RowOffset: integer);
begin
  //Nothing
end;

function TXLSFile.GetActiveSheet: integer;
begin
  Result:= FActiveSheet;
end;

function TXLSFile.GetActiveSheetName: WideString;
begin
  Result:= FWorkbook.Globals.SheetName[FActiveSheet-1];
end;

function TXLSFile.GetCellData(const aRow, aColOffset: integer): variant;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result:=unassigned; exit; end;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Value[aRow-1,FirstColumn+aColOffset].Value;
end;

function TXLSFile.GetCellDataX(const aRow, aColOffset: integer): TXlsCellValue;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result.Value:=unassigned; Result.XF:=-1; exit; end;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Value[aRow-1,FirstColumn+aColOffset];
end;

function TXLSFile.GetCommentsCount(Row: integer): integer;
begin
  if FWorkbook.IsWorkSheet(ActiveSheet-1) then
    if Row-1<FWorkbook.WorkSheets[ActiveSheet-1].Notes.Count then
      Result:=FWorkbook.WorkSheets[ActiveSheet-1].Notes[Row-1].Count
    else
      Result:=0
  else
    Result:=0;
end;

function TXLSFile.GetCommentText(Row, aPos: integer): widestring;
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): widestring;
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): widestring;
begin
  Result:= FWorkbook.Globals.Names[index-1].Name;
end;

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

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

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

function TXLSFile.GetRangeC2(index: integer): integer;
begin
  Result:= FWorkbook.Globals.Names[index-1].C2+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.InsertAndCopyRows(FActiveSheet-1, FirstRow-1, LastRow-1, DestRow-1, aCount, OnlyFormulas)
end;

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

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 TMSASG}
var
  OutStream: TFileStream;
{$ENDIF}
begin
{$IFNDEF TMSASG}
  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.SetBounds(const aRangePos: integer);
begin
  FirstColumn:=FWorkbook.Globals.Names[aRangePos-1].C1;
  LastColumn:=FWorkbook.Globals.Names[aRangePos-1].C2;
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;