xlsadapter.pas

DELPHI tms.component.pack.v4.6.0.7

            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);
{$IFDEF FLEXCEL}
var
  InStream: TStringStream;
{$ENDIF}
begin
{$IFDEF FLEXCEL}
  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);
  finally
    FreeAndNil(MemStream);
  end; //finally
end;

procedure TXLSFile.PasteFromClipboard(const Row, Col: integer);
begin
  if Clipboard.Provides('Biff8') then PasteFromBiff8(Row, Col) else
  if Clipboard.Provides('text/plain') then PasteFromText(Row, Col);
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, 'FLXEMPTYSHEET', RT_RCDATA);
  P:=LockResource(LoadResource(HINSTANCE, H));
  MemStream:=TMemoryStream.Create;
  try
    MemStream.Write(P^, SizeofResource(HINSTANCE, H));
    MemStream.Position:=0;
    OpenFileOrStream('', 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.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;

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;

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

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

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

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

function TXLSFile.GetCellFormula(aRow, aCol: integer): widestring;
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: widestring);
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: string; 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): widestring;
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: widestring; 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[FActiveSheet-1].SheetZoom;
end;

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

procedure TXLSFile.MergeCells(const FirstRow, FirstCol, LastRow, LastCol: integer);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].MergeCells(FirstRow-1, FirstCol-1, LastRow-1, LastCol-1);
end;

procedure TXLSFile.UnMergeCells(const FirstRow, FirstCol, LastRow, LastCol: integer);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].UnMergeCells(FirstRow-1, FirstCol-1, LastRow-1, LastCol-1);
end;

procedure TXLSFile.ParseComments;
begin
  //Nothing
end;


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

function TXLSFile.GetActiveSheetVisible: TXlsSheetVisible;
begin
  Result:= FWorkbook.Globals.SheetVisible[FActiveSheet-1];
end;

procedure TXLSFile.SetActiveSheetVisible(const Value: TXlsSheetVisib