xlsadapter.pas

DELPHI tms.component.pack.v4.6.0.7

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;

function TXlsFile.GetUsedPaletteColors: BooleanArray;
begin
  Result := FWorkbook.Globals.XF.GetUsedColors(56 + 1, FWorkbook.Globals.Fonts);
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;

procedure TXLSFile.SetFormatList(index: integer; Value: TFlxFormat);
begin
  if (Index<0) or (Index>=FWorkbook.Globals.XF.Count) then Index:=0;
  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);
{$IFDEF FLEXCEL}
var
  MyHandle: THandle;
  BiffPtr: pointer;
  MemStream: TMemoryStream;
  FreeHandle: boolean;
  AsText: TStringStream;

  DocOUT: TOle2Storage;
  StreamOUT: TOle2Stream;
  WorkbookStr: widestring;
  Range0: TXlsCellRange;
{$ENDIF}
begin
{$IFDEF FLEXCEL}
  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, false, MemStream);
      try
        StreamOUT:= TOle2Stream.Create(DocOUT, WorkbookStr);
        try
          FWorkbook.SaveRangeToStream(StreamOUT, FActiveSheet-1, Range0, IsFileModified);
        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, false, 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, false, 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;
        IsFileModified := true;
        for r:= d.FirstRow to d.LastRow-1 do
          for c:= d.FirstCol to d.LastCol-1 do
          begin