xlsadapter.pas

TMS Component Pack Pro v4.2

  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;
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: TXlsSheetVisible);
begin
  FWorkbook.Globals.SheetVisible[FActiveSheet-1]:= Value;
end;

procedure TXLSFile.AssignCellDataX2(const aRow, aColOffset: integer;
  const Value: TXlsCellValue; const RTFRuns: TRTFRunList);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.SetValueX2(aRow-1, FirstColumn + aColOffset, Value, RTFRuns);
end;

procedure TXLSFile.GetCellDataX2(const aRow, aColOffset: integer;
  out v: TXlsCellValue; out RTFRuns: TRTFRunList);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; v.Value:=unassigned; v.XF:=-1; SetLength(RTFRuns, 0); exit; end;
  FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.GetValueX2(aRow-1,FirstColumn+aColOffset,v,RTFRuns);
end;

procedure TXLSFile.ClearSheet;
begin
  if FWorkbook.IsWorkSheet(FActiveSheet-1) then
  begin;
    FWorkbook.WorkSheets[FActiveSheet-1].ClearValues;
    SelectSheet(FActiveSheet);
  end;
end;

procedure TXLSFile.DeleteSheet(aSheetCount: integer);
begin
  if ((SheetCount<=aSheetCount) or(SheetCount<0)) then raise Exception.Create(ErrNoSheetVisible);

  FWorkbook.DeleteSheets(FActiveSheet-1, aSheetCount);
  if (FActiveSheet>= SheetCount) then ActiveSheet:=SheetCount-1;  //Guarantee that ActiveSheet remains valid.

end;

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

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

function TXLSFile.GetFontList(index: integer): TFlxFont;
begin
  if Index=4 then Index:=0;  //font 4 does not exists
  if Index>4 then Index:=Index-1;
  if (Index<0) or (Index>=FWorkbook.Globals.Fonts.Count) then Index:=0;
  Result:=FWorkbook.Globals.Fonts[Index].FlxFont;
end;

procedure TXLSFile.SetFontList(index: integer; Value: TFlxFont);
begin
  if Index=4 then exit;  //font 4 does not exists
  if Index>4 then Index:=Index-1;
  if (Index<0) or (Index>=FWorkbook.Globals.Fonts.Count) then Index:=0;
  FWorkbook.Globals.Fonts[Index]:=TFontRecord.CreateFromFlxFont(Value);
end;

function TXLSFile.FontListCount: integer;
begin
  Result:=FWorkbook.Globals.Fonts.Count+1; //Font 4 does not exists!!!
end;

procedure TXLSFile.AssignCellValueX2(aRow, aCol: integer; const Value: TXlsCellValue; const RTFRuns: TRTFRunList);
var
  i: integer;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  for i:=Low(RTFRuns) to High(RTFRuns) do dec(RTFRuns[i].FirstChar);
  FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.SetValueX2(aRow-1, aCol-1, Value, RTFRuns);
end;

procedure TXLSFile.GetCellValueX2(aRow, aCol: integer; out v: TXlsCellValue; out RTFRuns: TRTFRunList);
var
  i: integer;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; v.Value:=unassigned; v.XF:=-1; SetLength(RTFRuns, 0); exit; end;
  FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.GetValueX2(aRow-1,aCol-1,v,RTFRuns);
  for i:=Low(RTFRuns) to High(RTFRuns) do inc(RTFRuns[i].FirstChar);
end;

procedure TXLSFile.AddHyperLink(const CellRange: TXlsCellRange; const value: THyperLink);
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;