tmsxlsadapter.pas

TMS Component Pack V5.0包含了超过 280 个为 Delphi 以及 C++Builder 设计的 TMS 生产控件

  TempWorkbook:=TXlsFile.Create;
  try
    TempWorkbook.Connect;
    try
      TempWorkbook.OpenStream(Stream);

      if (TempWorkbook.SheetCount<=0) or (not TempWorkbook.IsWorksheet(1)) then exit; //Biff8 only pastes one sheet
      d:=TempWorkbook.FWorkbook.WorkSheets[0].OriginalDimensions;
      IsFileModified := true;
      for r:= d.FirstRow to d.LastRow-1 do
        for c:= d.FirstCol to d.LastCol-1 do
        begin
          TempWorkbook.FWorkbook.WorkSheets[0].Cells.CellList.GetValueX2(r,c, Value, RTFRuns);
          if Value.XF<0 then XF:=TempWorkbook.FWorkbook.Globals.XF[0] else XF:= TempWorkbook.FWorkbook.Globals.XF[Value.XF];
          if not FWorkbook.Globals.XF.FindFormat( XF, Value.XF) then
            Value.XF:=FWorkbook.Globals.XF.Add(TXFRecord.CreateFromFormat(XF.FlxFormat(TempWorkbook.FWorkbook.Globals.Fonts, TempWorkbook.FWorkbook.Globals.Formats), FWorkbook.Globals.Fonts, FWorkbook.Globals.Formats));

          if (Length(RTFRuns) > 0) then
          begin
            for i:= 0 to Length(RTFRuns) - 1 do
            begin
              Index := RTFRuns[i].FontIndex;
              if Index=4 then Index:=0;  //font 4 does not exists
              if Index>4 then Index:=Index-1;
              if (Index<0) or (Index>= Tempworkbook.FWorkbook.Globals.Fonts.Count) then Index:=0;
              fnt := TempWorkbook.FWorkbook.Globals.Fonts[Index].FlxFont;
              RTFRuns[i].FontIndex := FWorkbook.Globals.Fonts.AddFont(fnt)
            end;
          end;
          FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.SetValueX2(int64(Row)-1+r-d.FirstRow, int64(Col)-1+c-d.FirstCol, Value, RTFRuns, Options1904Dates);
        end;
    finally
      TempWorkbook.Disconnect;
    end;
  finally
    FreeAndNil(TempWorkbook);
  end; //Finally
end;

{$IFDEF FLX_WINDOWSCLIPBOARD}
procedure TXlsFile.PasteFromBiff8(const Row, Col: integer);
var
  MyHandle: THandle;
  BiffPtr: pointer;
  BiffSize: Cardinal;
  MemStream: TMemoryStream;
begin
  ClipBoard.Open;
  try
    MyHandle := Clipboard.GetAsHandle(RegisterClipboardFormat('Biff8'));
    BiffPtr := GlobalLock(MyHandle);
    try
      BiffSize:=GlobalSize(MyHandle);
      MemStream:=TMemoryStream.Create;
      try
        MemStream.Write(BiffPtr^, BiffSize);
        MemStream.Position:=0;
        PasteFromXlsClipboardFormat(Row, Col, MemStream);
      finally
        FreeAndNil(MemStream);
      end; //finally
    finally
      GlobalUnlock(MyHandle);
    end;
  finally
    Clipboard.Close;
  end;
end;
{$ENDIF}

procedure TXlsFile.PasteFromText(const Row, Col: integer);
begin
  PasteFromTextClipboardFormat(Row, Col, ClipBoard.AsText);
end;

procedure TXlsFile.PasteFromTextClipboardFormat(const Row, Col: integer; const Data: string);
begin
end;

procedure TXLSFile.PasteFromClipboard(const Row, Col: integer);
begin
  if Clipboard.HasFormat(RegisterClipboardFormat('Biff8')) then PasteFromBiff8(Row, Col) else
  if Clipboard.HasFormat(CF_TEXT) then PasteFromText(Row, Col);
end;

{$IFNDEF FLX_WINDOWSCLIPBOARD}
procedure TXlsFile.PasteFromBiff8(const Row, Col: integer);
var
  MemStream: TMemoryStream;
begin
  MemStream:=TMemoryStream.Create;
  try
    ClipBoard.GetFormat(RegisterClipboardFormat('Biff8'), MemStream);
    MemStream.Position:=0;
    PasteFromXlsClipboardFormat(Row, Col, MemStream);
  finally
    FreeAndNil(MemStream);
  end; //finally
end;

{$ENDIF}


function TXLSFile.GetCellFormat(aRow, aCol: integer): integer;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result:=-1; exit; end;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Value[aRow-1,aCol-1].XF;
end;

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

procedure TXLSFile.NewFile(const SheetCount: integer=3);
var
  P: Pointer;
  H: THandle;
  MemStream: TMemoryStream;
begin
  H:=FindResource(HINSTANCE, RESOURCE_EMPTYSHEET, RT_RCDATA);
  P:=LockResource(LoadResource(HINSTANCE, H));
  MemStream:=TMemoryStream.Create;
  try
    MemStream.Write(P^, SizeofResource(HINSTANCE, H));
    MemStream.Position:=0;
    OpenStream(MemStream);
  finally
    FreeAndNil(MemStream);
  end; //finally
  InsertAndCopySheets(-1, 2, SheetCount-1);
end;

procedure TXLSFile.DeleteHPageBreak(const Row: integer);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].DeleteHPageBreak(Row);
end;

procedure TXLSFile.DeleteVPageBreak(const Col: integer);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].DeleteVPageBreak(Col);
end;

procedure TXLSFile.InsertHPageBreak(const Row: integer);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].InsertHPageBreak(Row);
end;

procedure TXLSFile.InsertVPageBreak(const Col: integer);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].InsertVPageBreak(Col);
end;


function TXLSFile.HasAutoFilter: Boolean;
begin
  Result := false;
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  Result := FWorkbook.WorkSheets[FActiveSheet-1].HasAutoFilter;
end;

function TXLSFile.HasAutoFilter(const row, col: Int32): Boolean;
begin
  Result := false;
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  Result := FWorkbook.WorkSheets[FActiveSheet-1].HasAutoFilter(FActiveSheet - 1, row - 1, col - 1);
end;

function TXLSFile.HasHPageBreak(const Row: integer): boolean;
begin
  Result:=false;
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].HasHPageBreak(Row); //Page break arrays are 1-based
end;

function TXLSFile.HasVPageBreak(const Col: integer): boolean;
begin
  Result:=false;
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].HasVPageBreak(Col); //Page break arrays are 1-based
end;

function TXLSFile.GetMargins: TXlsMargins;
begin
  Result:=FWorkbook.Sheets[FActiveSheet-1].Margins;
end;

procedure TXLSFile.SetMargins(const Value: TXlsMargins);
begin
  FWorkbook.Sheets[FActiveSheet-1].Margins:=Value;
end;


function TXLSFile.GetPrintNumberOfHorizontalPages: word;
begin
  Result:=1;
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].PrintNumberOfHorizontalPages;
end;

function TXLSFile.GetPrintNumberOfVerticalPages: word;
begin
  Result:=1;
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].PrintNumberOfVerticalPages;
end;

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

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

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

procedure TXLSFile.SetPrintNumberOfHorizontalPages(const Value: word);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].PrintNumberOfHorizontalPages:=Value;
end;

procedure TXLSFile.SetPrintNumberOfVerticalPages(const Value: word);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].PrintNumberOfVerticalPages:=Value;
end;

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

procedure TXLSFile.SetPrintToFit(const Value: boolean);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].PrintToFit:=Value;
end;

procedure TXLSFile.SetPrintVCentered(const Value: boolean);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].PrintVCentered := value;
end;

function TXLSFile.GetPageFooter: UTF16String;
begin
  Result:=FWorkbook.Sheets[FActiveSheet-1].PageFooter;
end;

function TXLSFile.GetPageHeader: UTF16String;
begin
  Result:=FWorkbook.Sheets[FActiveSheet-1].PageHeader;
end;

procedure TXLSFile.SetPageFooter(const Value: UTF16String);
begin
  FWorkbook.Sheets[FActiveSheet-1].PageFooter:=Value;
end;

procedure TXLSFile.SetPageHeader(const Value: UTF16String);
begin
  FWorkbook.Sheets[FActiveSheet-1].PageHeader:=Value;
end;

function TXLSFile.GetCellFormula(aRow, aCol: integer): UTF16String;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result:=unassigned; exit; end;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Formula[aRow-1,aCol-1];
end;

procedure TXLSFile.SetCellFormula(aRow, aCol: integer;
  const Value: UTF16String);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
    FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Formula[aRow-1, aCol-1]:=Value;
    IsFileModified := true;
end;

procedure TXLSFile.AddImage(const Data: ByteArray; const DataType: TXlsImgTypes;
  const Properties: TImageProperties;const Anchor: TFlxAnchorType);
var
  Props: TImageProperties;
begin
  Props:=Properties;
  dec(Props.Col1);
  dec(Props.Col2);
  dec(Props.Row1);
  dec(Props.Row2);

  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.Globals.DrawingGroup.EnsureDwgGroup;
  FWorkbook.WorkSheets[FActiveSheet-1].AddImage(Data, DataType, Props, Anchor);
end;

procedure TXLSFile.ClearImage(const Index: integer);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  if (Index<0) or (Index>=FWorkbook.WorkSheets[ActiveSheet-1].DrawingCount) then
    raise exception.CreateFmt(ErrIndexOutBounds,[Index, 'ImageIndex', 0, FWorkbook.WorkSheets[ActiveSheet-1].DrawingCount]);
  FWorkbook.WorkSheets[FActiveSheet-1].ClearImage(Index);
end;

procedure TXLSFile.DeleteImage(const Index: integer);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  if (Index<0) or (Index>=FWorkbook.WorkSheets[ActiveSheet-1].DrawingCount) then
    raise exception.CreateFmt(ErrIndexOutBounds,[Index, 'ImageIndex', 0, FWorkbook.WorkSheets[ActiveSheet-1].DrawingCount]);
  FWorkbook.WorkSheets[FActiveSheet-1].DeleteImage(Index);
end;

function TXLSFile.GetCellComment(Row, Col: integer): UTF16String;
var
  Index: integer;
begin
  Result:='';
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  if not (Row-1<FWorkbook.WorkSheets[ActiveSheet-1].Notes.Count) then exit;

  if FWorkbook.WorkSheets[ActiveSheet-1].Notes[Row-1].Find(Col-1, Index) then
    Result:=FWorkbook.WorkSheets[ActiveSheet-1].Notes[Row-1][Index].Text;
end;

function TXLSFile.GetCommentColumn(Row, aPos: integer): integer;
begin
  Result:=1;
  if not FWorkbook.IsWorkSheet(FActiveSheet-1)
  or not (Row-1<FWorkbook.WorkSheets[ActiveSheet-1].Notes.Count)
    then exit;

  Result:=FWorkbook.WorkSheets[ActiveSheet-1].Notes[Row-1][aPos].Column+1;
end;

procedure TXLSFile.SetCellComment(Row, Col: integer;
  const Value: UTF16String; const Properties: TImageProperties);
var
  Index: integer;
  Found: boolean;
  Prop:TImageProperties;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  Found:= (Row-1<FWorkbook.WorkSheets[ActiveSheet-1].Notes.Count) and
           FWorkbook.WorkSheets[ActiveSheet-1].Notes[Row-1].Find(Col-1, Index);

  if Value='' then
    if found then FWorkbook.WorkSheets[ActiveSheet-1].Notes[Row-1].Delete(Index) else
  else
    if Found then
      FWorkbook.WorkSheets[ActiveSheet-1].Notes[Row-1][Index].Text:= Value
    else
    begin
      Prop:=Properties;
      dec(Prop.Row1);dec(Prop.Row2);dec(Prop.Col1);dec(Prop.Col2);
      FWorkbook.WorkSheets[ActiveSheet-1].AddNewComment(Row-1, Col-1, Value, Prop);
    end;
end;

function TXLSFile.GetSheetZoom: integer;
begin
  //This doesn't have to be a worksheet
  Result:=FWorkbook.Sheets[FAc