xlsadapter.pas

TMS Component Pack Pro v4.2

begin
  if Fm=nil then SetCellValue(ARow, ACol, v) else
  begin
    Value.XF:=AddFormat(Fm^);
    Value.Value:=v;
    Value.IsFormula:=False;
    SetCellValueX(aRow, aCol, Value);
  end;
end;

function TXlsFile.SkipThousands(const s: string): string;
var
  s1: string;
  i,L: integer;
begin
  // on german locales, "11.11.02" is a valid date, and it could be a number too. So we *Must* check thousands come on groups of 3.
  i:= pos(DecimalSeparator, s);
  if i>0 then
    s1:=copy(s,1,i-1)
  else s1:=s;

  if (i>0) and (pos(ThousandSeparator, copy(s,i,length(s)))>0) then   //No thousand separators after decimalseparator.
  begin
    result:=s;
    exit;
  end;

  if (length(s)>0) and (s[1]=ThousandSeparator) then   //No numbers like ",000.3"  .
  begin
    result:=s;
    exit;
  end;

  i:=3;
  L:=Length(s1);
  while i<L do
  begin
    if (s1[L-i]<>ThousandSeparator) and (s1[L-i]<>'-')then
    begin
      result:=s;
      exit;
    end;
    inc(i,4);
  end;

  result:=StringReplace(s,ThousandSeparator,'', [rfReplaceAll]);
end;

procedure TXLSFile.InternalSetCellString(const aRow, aCol: integer; const Text: Widestring; const Fm: PFlxFormat; const DateFormat, TimeFormat: widestring);
var
  e:extended;
  d:double;
  ok: boolean;
  s: string;
  dt: TDateTime;
  dFormat: widestring;
  Fmt: TFlxFormat;
  HasTime, HasDate: boolean;
begin
  //try to convert to number
    s:=Text; //for if value is a widestring
    // if TextToFloat(PChar(StringReplace(s,ThousandSeparator,'', [rfReplaceAll])), e, fvExtended) then  //Dont use val because it doesnt handle locales
    ok:=false; d:=0;
    if TextToFloat(PChar(SkipThousands(s)), e, fvExtended) then  //Dont use val because it doesnt handle locales
    begin
      try
        d:=e;
        ok:=true;
      except
      end; //except
    end;
    if ok then SetCellValueAndFmt(ARow, ACol, d, Fm) else
  //try to convert to boolean
    if UpperCase(s)=TxtFalse then SetCellValueAndFmt(ARow, ACol, false, Fm)  else
    if UpperCase(s)=TxtTrue then SetCellValueAndFmt(ARow, ACol, true, Fm) else
  //try to convert to a date
    if FlxTryStrToDateTime(s, dt, dFormat, HasDate, HasTime, DateFormat, TimeFormat) then
    begin
      if Fm=nil then Fmt:=GetFormatList(CellFormat[ARow, ACol]) else Fmt:=Fm^;
      Fmt.Format:=dFormat;
      SetCellValueAndFmt(ARow, ACol, double(dt), @Fmt)
    end else
      SetCellValueAndFmt(ARow, ACol, Text, Fm);
end;

procedure TXLSFile.SetCellString(const aRow, aCol: integer; const Text: Widestring; const DateFormat: widestring; const TimeFormat: widestring);
begin
  InternalSetCellString(aRow, aCol, Text, nil, DateFormat, TimeFormat);
end;

procedure TXLSFile.SetCellString(const aRow, aCol: integer; const Text: Widestring; const Fm: TFlxFormat; const DateFormat: widestring; const TimeFormat: widestring);
begin
  InternalSetCellString(aRow, aCol, Text, @Fm, DateFormat, TimeFormat);
end;


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

procedure TXLSFile.AssignComment(const Row, aPos: integer;
  const Comment: widestring);
begin
  if FWorkbook.IsWorkSheet(ActiveSheet-1) then
  begin
    if Comment='' then FWorkbook.WorkSheets[ActiveSheet-1].Notes[Row-1].Delete(aPos) else
    FWorkbook.WorkSheets[ActiveSheet-1].Notes[Row-1][aPos].Text:= Comment;
  end;
end;

procedure TXLSFile.AssignPicture(const Row, aPos: integer; const Pic: string; const PicType: TXlsImgTypes);
var
  MyPos: integer;
begin
  if Row>0 then MyPos:=RowPictures[Row][aPos] else MyPos:=aPos;
  if FWorkbook.IsWorkSheet(ActiveSheet-1) then
    FWorkbook.WorkSheets[ActiveSheet-1].AssignDrawing(MyPos, Pic, PicType);
end;

procedure TXLSFile.AssignPicture(const Row, aPos: integer; const Pic: string;
  const PicType: TXlsImgTypes; const Props: TImageProperties; const Anchor: TFlxAnchorType);
begin
  AssignPicture(Row, aPos, Pic, PicType);
  AssignPictureProperties(Row, aPos, Props, Anchor);
end;

procedure TXLSFile.AssignPictureProperties(const Row, aPos: integer; const Props: TImageProperties; const Anchor: TFlxAnchorType);
var
  MyPos: integer;
  ClientAnchor: TClientAnchor;
begin
  if Row>0 then MyPos:=RowPictures[Row][aPos] else MyPos:=aPos;

  case Anchor of
    at_MoveAndResize: ClientAnchor.Flag:=00;
    at_DontMoveAndDontResize: ClientAnchor.Flag:=03;
    else ClientAnchor.Flag:=02;
  end; //case

  ClientAnchor.Col1:=Props.Col1-1;
  ClientAnchor.Dx1:=Props.dx1;
  ClientAnchor.Col2:=Props.Col2-1;
  ClientAnchor.Dx2:=Props.dx2;
  ClientAnchor.Row1:=Props.Row1-1;
  ClientAnchor.Dy1:=Props.dy1;
  ClientAnchor.Row2:=Props.Row2-1;
  ClientAnchor.Dy2:=Props.dy2;

  if FWorkbook.IsWorkSheet(ActiveSheet-1) then
    FWorkbook.WorkSheets[ActiveSheet-1].SetAnchor(MyPos, ClientAnchor);

end;

procedure TXLSFile.GetPicture(const Row, aPos: integer; const Pic: TStream;
  var PicType: TXlsImgTypes; var Anchor: TClientAnchor);
var
  MyPos: integer;
begin
  if Row>0 then MyPos:=RowPictures[Row][aPos] else MyPos:=aPos;
  if FWorkbook.IsWorkSheet(ActiveSheet-1) then
  begin
    if (Pic<>nil) then FWorkbook.WorkSheets[ActiveSheet-1].GetDrawingFromStream(MyPos, Pic, PicType);
    Anchor:=FWorkbook.WorkSheets[ActiveSheet-1].GetAnchor(MyPos);
    inc(Anchor.Col1);
    inc(Anchor.Col2);
    inc(Anchor.Row1);
    inc(Anchor.Row2);
  end;
end;

procedure TXLSFile.ParsePictures;
var
  i:integer;

begin
  FreeAndNil(RowPictures);
  RowPictures:= TRowComments.Create;
  if FWorkbook.IsWorkSheet(ActiveSheet-1) then
    for i:=0 to FWorkbook.WorkSheets[ActiveSheet-1].DrawingCount-1 do
      RowPictures.Add(FWorkbook.WorkSheets[ActiveSheet-1].DrawingRow[i]+1, i);
end;


procedure TXLSFile.BeginSheet;
begin
  ParsePictures;
end;

function TXLSFile.CellCount(const aRow: integer): integer;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result:=0; exit; end;
  if aRow-1<FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Count then
    Result:=LastColumn-FirstColumn+1
  else Result:=0;
end;

procedure TXLSFile.CloseFile;
begin
  //Nothing
end;

procedure TXLSFile.Connect;
begin
  FWorkbook:= TWorkbook.Create;
end;

constructor TXLSFile.Create(const aAdapter: TXLSAdapter);
begin
  inherited Create;
  FAdapter:= aAdapter;
end;

procedure TXLSFile.DeleteMarkedRows(const Mark: widestring);
var
  i:integer;
  s: widestring;
  Cl: TCellList;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  Cl:=FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList;
  for i:=Cl.Count -1 downto 0 do
  try
    s:= Cl.Value[i,0].Value;
    if (s=Mark) then
      FWorkbook.DeleteRowsAndCols(FActiveSheet-1, i, 1,0,0);
  except
    //nothing
  end;//except
end;

procedure TXLSFile.MakePageBreaks(const Mark: widestring);
var
  i:integer;
  s: widestring;
  V: TXlsCellValue;
  Cl: TCellList;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then exit;
  V.Value:=Unassigned; V.XF:=-1;
  Cl:=FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList;
  for i:=Cl.Count -1 downto 0 do
  try
    s:= Cl.Value[i,0].Value;
    if (s=Mark) then
    begin
      FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Value[i,0]:=V;
      FWorkbook.InsertHPageBreak(FActiveSheet-1, i);
    end;
  except
    //nothing
  end;//except
end;

procedure TXLSFile.DeleteRows(const aRow, aCount: integer);
begin
  FWorkbook.DeleteRowsAndCols(FActiveSheet-1, aRow-1, aCount,0,0);
end;

destructor TXLSFile.Destroy;
begin
  FreeAndNil(RowPictures);
  FreeAndNil(FTmpTemplate);
  inherited;
end;

procedure TXLSFile.Disconnect;
begin
  FreeAndNil(FWorkbook);
end;

procedure TXLSFile.EndSheet(const RowOffset: integer);
begin
  //Nothing
end;

function TXLSFile.GetActiveSheet: integer;
begin
  Result:= FActiveSheet;
end;

function TXLSFile.GetActiveSheetName: WideString;
begin
  Result:= FWorkbook.Globals.SheetName[FActiveSheet-1];
end;

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

function TXLSFile.GetCellData(const aRow, aColOffset: integer): variant;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result:=unassigned; exit; end;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Value[aRow-1,FirstColumn+aColOffset].Value;
end;

function TXLSFile.GetCellDataX(const aRow, aColOffset: integer): TXlsCellValue;
begin
  if not FWorkbook.IsWorkSheet(FActiveSheet-1) then begin; Result.Value:=unassigned; Result.XF:=-1; exit; end;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].Cells.CellList.Value[aRow-1,FirstColumn+aColOffset];
end;

function TXLSFile.GetCommentsCount(Row: integer): integer;
begin
  if FWorkbook.IsWorkSheet(ActiveSheet-1) then
    if Row-1<FWorkbook.WorkSheets[ActiveSheet-1].Notes.Count then
      Result:=FWorkbook.WorkSheets[ActiveSheet-1].Notes[Row-1].Count
    else
      Result:=0
  else
    Result:=0;
end;

function TXLSFile.GetCommentText(Row, aPos: integer): widestring;
begin
  if FWorkbook.IsWorkSheet(ActiveSheet-1)
    and (Row-1<FWorkbook.WorkSheets[ActiveSheet-1].Notes.Count) then
      Result:=FWorkbook.WorkSheets[ActiveSheet-1].Notes[Row-1][aPos].Text
    else
      Result:='';
end;

function TXLSFile.GetExcelNameCount: integer;
begin
  Result:=FWorkbook.Globals.Names.Count;
end;

function TXLSFile.GetPictureName(Row, aPos: integer): widestring;
var
  MyPos: integer;
begin
  if Row>0 then MyPos:=RowPictures[Row][aPos] else MyPos:=aPos;
  Result:= '';
  if not FWorkbook.IsWorksheet(FActiveSheet-1) then exit;
  Result:=FWorkbook.WorkSheets[FActiveSheet-1].DrawingName[MyPos];
end;

function TXLSFile.GetPicturesCount(Row: integer): integer;
begin
  Result:=0;
  if not FWorkbook.IsWorksheet(FActiveSheet-1) then exit;
  if Row>0 then Result:=RowPictures[Row].Count else
    Result:= FWorkbook.WorkSheets[ActiveSheet-1].DrawingCount;
end;

function TXLSFile.GetRangeName(index: integer): widestring;
begin
  Result:= FWorkbook.Globals.Names[index-1].Name;
end;

function TXLSFile.GetRangeR1(index: integer): integer;
begin
  Result:= FWorkbook.Globals.Names[index-1].GetR1+1;
end;

function TXLSFile.GetRangeR2(index: integer): integer;
begin
  Result:= FWorkbook.Globals.Names[index-1].GetR2+1;
end;

function TXLSFile.GetRangeC1(index: integer): integer;
begin
  Result:= FWorkbook.Globals.Names[index-1].GetC1+1;
end;

function TXLSFile.GetRangeC2(index: integer): integer;
begin
  Result:= FWorkbook.Globals.Names[index-1].GetC2+1;
end;

function TXLSFile.GetRangeSheet(index: integer): integer;
begin
  Result:= FWorkbook.Globals.Names[index-1].RefersToSheet(FWorkbook.Globals.References.GetSheet)+1;
end;

procedure TXLSFile.InsertAndCopyRows(const FirstRow, LastRow, DestRow,
  aCount: integer; const OnlyFormulas: boolean);
begin
  FWorkbook.InsertAndCopyRowsAndCols(FActiveSheet-1, FirstRow-1, LastRow-1, DestRow-1, aCount, 0,0,0,0, OnlyFormulas)
end;

procedure TXLSFile.InsertAndCopySheets(const CopyFrom, InsertBefore,
  SheetCount: integer);
begin
  FWorkbook.InsertSheets(CopyFrom-1, InsertBefore-1, SheetCount);
end;