xlsadapter.pas

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

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.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;

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;

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.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;

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

  DocOUT: TOle2Storage;
  StreamOUT: TOle2Stream;
  WorkbookStr: widestring;
  Range0: TXlsCellRange;
{$ENDIF}
begin
{$IFNDEF TMSASG}
  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;