⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 xlsadapter.pas

📁 TMS Component Pack Pro v4.2
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  FWorkbook.Globals.XF[Index]:=TXFRecord.CreateFromFormat(Value, FWorkbook.Globals.Fonts, FWorkbook.Globals.Formats);;
end;

function TXLSFile.AddFont(const Fmt: TFlxFont): integer;
begin
  Result:=FWorkbook.Globals.Fonts.AddFont(Fmt);
end;

function TXLSFile.AddFormat(const Fmt: TFlxFormat): integer;
var
  XF: TXFRecord;
begin
  XF:= TXFRecord.CreateFromFormat(Fmt, FWorkbook.Globals.Fonts, FWorkbook.Globals.Formats);
  try
    if FWorkbook.Globals.XF.FindFormat(XF, Result) then
    begin
      FreeAndNil(XF);
      exit;
    end;

    Result:=FWorkbook.Globals.XF.Add(XF);
  except
    FreeAndNil(XF);
    raise;
  end; //Except

end;

function TXLSFile.ColByIndex(const Row, ColIndex: integer): integer;
begin
  Result:=0;
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  if IsEmptyRow(Row) then exit;
  if (ColIndex<=0) or (ColIndex>FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList[Row-1].Count) then exit;
  Result:= FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList[Row-1][ColIndex-1].Column+1;
end;

function TXLSFile.ColIndexCount(const Row: integer): integer;
begin
  Result:=0;
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  if IsEmptyRow(Row) then exit;
  Result:= FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList[Row-1].Count;
end;

function TXLSFile.ColIndex(const Row, Col: integer): integer;
begin
  Result:=0;
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  if IsEmptyRow(Row) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList[Row-1].Find(Col, Result);
  inc(Result);
end;

function TXLSFile.GetDefaultColWidth: integer;
begin
  Result:=$A;
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].DefColWidth;
end;

function TXLSFile.GetDefaultRowHeight: integer;
begin
  Result:=$FF;
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].DefRowHeight;
end;


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

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

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

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

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

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


function TXLSFile.GetCellMergedBounds(aRow, aCol: integer): TXlsCellRange;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].CellMergedBounds(aRow-1, aCol-1);
  inc(Result.Left);
  inc(Result.Top);
  inc(Result.Right);
  inc(Result.Bottom);
end;

function TXLSFile.GetCellMergedList(index: integer): TXlsCellRange;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].CellMergedList(index);
  inc(Result.Left);
  inc(Result.Top);
  inc(Result.Right);
  inc(Result.Bottom);
end;

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


{$IFDEF FLX_VCL}
procedure TXLSFile.CopyToClipboard(const Range: TXlsCellRange);
{$IFNDEF TMSASGx}
var
  MyHandle: THandle;
  BiffPtr: pointer;
  MemStream: TMemoryStream;
  FreeHandle: boolean;
  AsText: TStringStream;

  DocOUT: TOle2Storage;
  StreamOUT: TOle2Stream;
  WorkbookStr: widestring;
  Range0: TXlsCellRange;
{$ENDIF}
begin
{$IFNDEF TMSASGx}
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  WorkbookStr:=WorkbookStrS;

  AsText:=TStringStream.Create('');
  try
    SaveRangeAsTextDelim(AsText, Self ,#9,Range);

    Range0:=Range;
    Dec(Range0.Left); Dec(Range0.Top); Dec(Range0.Right); Dec(Range0.Bottom);
    if (Range0.Left<0)or(Range0.Top<0)or(Range0.Right<Range0.Left)or(Range0.Bottom<Range0.Top)then exit;

    MemStream:=TMemoryStream.Create;
    try
      DocOUT:= TOle2Storage.Create('', Ole2_Write, MemStream);
      try
        StreamOUT:= TOle2Stream.Create(DocOUT, WorkbookStr);
        try
          FWorkbook.SaveRangeToStream(StreamOUT, FActiveSheet-1, Range0);
        finally
          FreeAndNil(StreamOut);
        end; //finally
      finally
        FreeAndNil(DocOUT);
      end; //Finally

      MemStream.Position:=0;

      FreeHandle:=true;
      MyHandle:=GlobalAlloc(GMEM_MOVEABLE, MemStream.Size);
      try
        BiffPtr:=GlobalLock(MyHandle);
        try
          MemStream.Read(BiffPtr^, MemStream.Size);
        finally
          GlobalUnlock(MyHandle);
        end; //finally

        Clipboard.Clear;
        ClipBoard.Open;
        try
          Clipboard.SetAsHandle(RegisterClipboardFormat('Biff8'), MyHandle);
          FreeHandle:=false;       //Note that we dont have to free MyHandle if the clipboard takes care of it
          //MADE: Add Text Format
          Clipboard.SetTextBuf(PChar(AsText.DataString));
          //PENDING: Add HTML format.
        finally
          Clipboard.Close;
        end; //Finally
      except
        if FreeHandle then GlobalFree(MyHandle);
        raise
      end; //except
    finally
      FreeAndNil(MemStream);
    end;
  finally
    FreeAndNil(AsText);
  end;
{$ENDIF}
end;
{$ENDIF}

{$IFDEF FLX_CLX}
procedure TXLSFile.CopyToClipboard(const Range: TXlsCellRange);
var
  MemStream: TMemoryStream;
  AsText: TStringStream;

  DocOUT: TOle2Storage;
  StreamOUT: TOle2Stream;
  WorkbookStr: widestring;
  Range0: TXlsCellRange;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  WorkbookStr:=WorkbookStrS;

  AsText:=TStringStream.Create('');
  try
    SaveRangeAsTextDelim(AsText, Self ,#9,Range);
    AsText.Position:=0;

    Range0:=Range;
    Dec(Range0.Left); Dec(Range0.Top); Dec(Range0.Right); Dec(Range0.Bottom);
    if (Range0.Left<0)or(Range0.Top<0)or(Range0.Right<Range0.Left)or(Range0.Bottom<Range0.Top)then exit;

    MemStream:=TMemoryStream.Create;
    try
      DocOUT:= TOle2Storage.Create('', Ole2_Write, MemStream);
      try
        StreamOUT:= TOle2Stream.Create(DocOUT, WorkbookStr);
        try
          FWorkbook.SaveRangeToStream(StreamOUT, FActiveSheet-1, Range0);
        finally
          FreeAndNil(StreamOut);
        end; //finally
      finally
        FreeAndNil(DocOUT);
      end; //Finally

      MemStream.Position:=0;

      ClipBoard.SetFormat('Biff8', MemStream);
      ClipBoard.AddFormat('text/plain', AsText)
      //MADE: Add text format
    finally
      FreeAndNil(MemStream);
    end;
  finally
    FreeAndNil(AsText);
  end; //finally
end;
{$ENDIF}

procedure TXLSFile.CopyToClipboard;
var
  Range: TXlsCellRange;
begin
  Range.Left:=1;
  Range.Top:=1;
  Range.Right:= MaxCol;
  Range.Bottom:= MaxRow;
  CopyToClipboard(Range);
end;

procedure TXlsFile.PasteFromStream(const Row, Col: integer; const Stream: TStream);
var
  TempWorkbook: TWorkbook;
  r,c: integer;
  Value: TXlsCellValue;
  XF: TXFRecord;
  DocIN: TOle2Storage;
  StreamIN: TOle2Stream;
  WorkbookStr: widestring;
  d: TDimensionsRec;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  WorkbookStr:=  WorkbookStrS;

  TempWorkbook:=TWorkbook.Create;
  try
    DocIN:= TOle2Storage.Create('', Ole2_Read, Stream);
    try
      StreamIn:= TOle2Stream.Create( DocIN, WorkbookStr);
      try
        TempWorkbook.LoadFromStream(StreamIn);
        if (TempWorkbook.Sheets.Count<=0) or (not TempWorkbook.IsWorksheet(0)) then exit; //Biff8 only pastes one sheet
        d:=TempWorkbook.WorkSheets[0].OriginalDimensions;
        for r:= d.FirstRow to d.LastRow-1 do
          for c:= d.FirstCol to d.LastCol-1 do
          begin
            Value:=TempWorkbook.WorkSheets[0].Cells.CellList.Value[r,c];
            if Value.XF<0 then XF:=TempWorkbook.Globals.XF[0] else XF:= TempWorkbook.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.Globals.Fonts, TempWorkbook.Globals.Formats), FWorkbook.Globals.Fonts, FWorkbook.Globals.Formats));

            FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Value[int64(Row)-1+r-d.FirstRow, int64(Col)-1+c-d.FirstCol]:=Value;
          end;
      finally
        FreeAndNil(StreamIn);
      end; //finally
    finally
      FreeAndNil(DocIn);
    end; //finally
  finally
    FreeAndNil(TempWorkbook);
  end; //Finally

end;

{$IFDEF FLX_VCL}
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;
        PasteFromStream(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);
{$IFNDEF TMSASGx}
var
  InStream: TStringStream;
{$ENDIF}
begin
{$IFNDEF TMSASGx}
  InStream:=TStringStream.Create(ClipBoard.AsText);
  try
    LoadFromTextDelim(InStream, Self, #9, Row, Col,[]);
  finally
    FreeAndNil(InStream);
  end; //finally
{$ENDIF}
end;

{$IFDEF FLX_VCL}
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;
{$ENDIF}


{$IFDEF FLX_CLX}
procedure TXlsFile.PasteFromBiff8(const Row, Col: integer);
var
  MemStream: TMemoryStream;
begin
  MemStream:=TMemoryStream.Create;
  try
    ClipBoard.GetFormat('Biff8', MemStream);
    MemStream.Position:=0;
    PasteFromStream(Row, Col, MemStream);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -