advgridexcel.pas

DELPHI tms.component.pack.v4.6.0.7

          CurrentGrid.MergeCells(StartX + GridStartCol - XlsStartCol, StartY + GridStartRow - XlsStartRow, SpanX, SpanY);
          //Load the image
          Pic.Position := 0;
          CalcImgDimentions(Workbook, Anchor, w, h);
          TmpPic := TPicture.Create;
          try
            SaveImgStreamToGraphic(Pic, PicType, TmpPic, Handled);
            if not Handled then
              raise Exception.Create('Not handled'); //This will be catched below. It is an internal exception so image is deleted
            Bmp := TBitmap.Create;
            try
              Picture.Graphic := Bmp;
            finally
              FreeAndNil(Bmp); //Remember TPicture.Graphic keeps a COPY of the TGraphic
            end;
            (Picture.Graphic as TBitmap).Width := Round(w * Zoom100);
            (Picture.Graphic as TBitmap).Height := Round(h * Zoom100);
            (Picture.Graphic as TBitmap).Canvas.StretchDraw(Rect(0, 0, Round(w * Zoom100), Round(h * Zoom100)), TmpPic.Graphic);
          finally
            FreeAndNil(TmpPic);
          end; //finally
        except
          //CurrentGrid.RemovePicture(Anchor.Col1+GridStartCol-XlsStartCol, Anchor.Row1+GridStartRow-XlsStartRow);
          CurrentGrid.RemovePicture(StartX + GridStartCol - XlsStartCol, StartY + GridStartRow - XlsStartRow);
          //Dont raise... is not a major error;
        end; //except
      finally
        FreeAndNil(Pic);
      end; //Finally
    end;
  end;
end;

procedure TAdvGridExcelIO.ImportNodes(const Workbook: TExcelFile; const first, last, level: integer);
var
  StartNode: integer;
  r: integer;
  CurrentLevel: integer;
begin
  r:=first;
  while r<=last do
  begin
    CurrentLevel:=Workbook.GetRowOutlineLevel(r);
    if CurrentLevel=Level then
    begin
      StartNode:=r;
      inc(r);
      while (r<=last) and (Workbook.GetRowOutlineLevel(r)>=CurrentLevel) do inc(r);
      if (r-StartNode>1) then
        CurrentGrid.AddNode(StartNode-1, r-StartNode+1);
    end
    else inc(r);
  end;
end;

procedure TAdvGridExcelIO.ImportAllNodes(const Workbook: TExcelFile; const first, last: integer);
var
  i: integer;
begin
  for i:=1 to 7 do
    ImportNodes(Workbook, first, last, i);
end;

function TAdvGridExcelIO.WideAdjustLineBreaks(const w: widestring): widestring;
var
  i, p: integer;
begin
  SetLength(Result, Length(w)*2);
  p:=0;
  for i:=1 to Length(w) do
  begin
    if w[i]=#10 then
    begin
      Result[p+i]:=#13;
      inc(p);
    end;
    Result[p+i]:=w[i];
  end;
  SetLength(Result, Length(w)+p);
end;

procedure TAdvGridExcelIO.ImportData(const Workbook: TExcelFile);
var
  r, c, i: integer;
  Fm: TFlxFormat;
  Mb: TXlsCellRange;

  MaxC, MaxR, cg, rg: integer;

  XF: integer;

  Zoom100: extended;
  FontColor: integer;
  w: widestring;
  v: variant;
  HAlign: TAlignment;

  HasTime, HasDate: boolean;
  Formula: string;
begin
  Assert(Workbook <> nil, 'AdvGridWorkbook can''t be nil');
  Assert(CurrentGrid <> nil, 'AdvStringGrid can''t be nil');

  if FZoomSaved then Zoom100 := Workbook.SheetZoom / 100 else Zoom100 := FZoom / 100;

  CurrentGrid.Clear;

  if Options.ImportPrintOptions then
  begin
    if Workbook.PrintOptions and fpo_NoPls = 0 then
    begin
      if (Workbook.PrintOptions and fpo_Orientation = 0) then
      begin
        CurrentGrid.PrintSettings.Orientation := poLandscape;
      end else
      begin
        CurrentGrid.PrintSettings.Orientation := poPortrait;
      end;
    end;
  end;


  if FAutoResizeGrid then
  begin
    if Workbook.MaxRow - XlsStartRow + 1 + GridStartRow > CurrentGrid.FixedRows then
      CurrentGrid.RowCount := Workbook.MaxRow - XlsStartRow + 1 + GridStartRow;
    if Workbook.MaxCol - XlsStartCol + 1 + GridStartCol > CurrentGrid.FixedCols then
      CurrentGrid.ColCount := Workbook.MaxCol - XlsStartCol + 1 + GridStartCol;
  end;

  if FOptions.ImportCellSizes then
  begin
    CurrentGrid.DefaultRowHeight := Round(Workbook.DefaultRowHeight / RowMult * Zoom100) + CellOfs;
    CurrentGrid.DefaultColWidth := Round(Workbook.DefaultColWidth / ColMult * Zoom100) + CellOfs;
  end;

  ImportImages(Workbook, Zoom100); //Load them first, so if there is some resizing to do, it is done here

  if Workbook.MaxRow > CurrentGrid.RowCount + XlsStartRow - 1 - GridStartRow
    then MaxR := CurrentGrid.RowCount + XlsStartRow - 1 - GridStartRow else MaxR := Workbook.MaxRow;
  if Workbook.MaxCol > CurrentGrid.ColCount + XlsStartCol - 1 - GridStartCol
    then MaxC := CurrentGrid.ColCount + XlsStartCol - 1 - GridStartCol else MaxC := Workbook.MaxCol;

  //Adjust Row/Column sizes and set Row/Column formats
  for r := XlsStartRow to MaxR do
  begin
    rg := r + GridStartRow - XlsStartRow;
    if FOptions.ImportCellSizes then
      CurrentGrid.RowHeights[rg] := Round(Workbook.RowHeight[r] / RowMult * Zoom100) + CellOfs + CurrentGrid.XYOffset.Y;

    XF := Workbook.RowFormat[r];

    if (XF >= 0) and FOptions.ImportCellProperties then
    begin
      Fm := Workbook.FormatList[XF];
      CurrentGrid.RowColor[rg] := GetColor(Workbook, Fm);
      if (Fm.Font.ColorIndex > 0) and (integer(Fm.Font.ColorIndex) <= 56) then
        CurrentGrid.RowFontColor[rg] := Workbook.ColorPalette[Fm.Font.ColorIndex];
    end;
  end;

  for c := XlsStartCol to MaxC do
  begin
    cg := c + GridStartCol - XlsStartCol;
    if FOptions.ImportCellSizes then
      CurrentGrid.ColWidths[cg] := Round(Workbook.ColumnWidth[c] / ColMult * Zoom100) + CellOfs + CurrentGrid.XYOffset.X;
  end;

  //Import data
  for r := XlsStartRow to MaxR do
  begin
    rg := r + GridStartRow - XlsStartRow;
    for c := XlsStartCol to MaxC do
    begin
      cg := c + GridStartCol - XlsStartCol;
      Fm := CellFormatDef(Workbook, r, c);

      //Merged Cells
      //We check this first, so if its not the first of a merged cell we exit
      Mb := Workbook.CellMergedBounds[r, c];
      if ((Mb.Left <> c) or (Mb.Top <> r)) then continue;

      if ((Mb.Left = c) and (Mb.Top = r)) and ((Mb.Right > c) or (Mb.Bottom > r)) then
        CurrentGrid.MergeCells(cg, rg, Mb.Right - Mb.Left + 1, Mb.Bottom - Mb.Top + 1);

      if (FOptions.ImportLockedCellsAsReadonly) then
      begin
        CurrentGrid.ReadOnly[cg, rg] := fm.Locked;
      end;

      //Font
      if FOptions.ImportCellProperties then
      begin
        if (Fm.Font.ColorIndex > 0) and (integer(Fm.Font.ColorIndex) <= 56) then
          CurrentGrid.FontColors[cg, rg] := Workbook.ColorPalette[Fm.Font.ColorIndex]
        else
          CurrentGrid.FontColors[cg, rg] := 0;

        CurrentGrid.FontSizes[cg, rg] := Trunc((Fm.Font.Size20 / 20 * Zoom100));

        CurrentGrid.FontNames[cg, rg] := Fm.Font.Name;

        if flsBold in Fm.Font.Style then
          CurrentGrid.FontStyles[cg, rg] := CurrentGrid.FontStyles[cg, rg] + [fsBold];
        if flsItalic in Fm.Font.Style then
          CurrentGrid.FontStyles[cg, rg] := CurrentGrid.FontStyles[cg, rg] + [fsItalic];
        if flsStrikeOut in Fm.Font.Style then
          CurrentGrid.FontStyles[cg, rg] := CurrentGrid.FontStyles[cg, rg] + [fsStrikeOut];
        if Fm.Font.Underline <> fu_None then
          CurrentGrid.FontStyles[cg, rg] := CurrentGrid.FontStyles[cg, rg] + [fsUnderline];
      end;

      //Pattern
      {Bmp:=nil;
      try
        if Fm.FillPattern.Pattern=1 then
        begin
          if (ACanvas.Brush.Color<>clwhite) then
            ACanvas.Brush.Color:=clwhite;
        end else
        if Fm.FillPattern.Pattern=2 then
        begin
          if (ACanvas.Brush.Color<>ABrushFg) then
            ACanvas.Brush.Color:=ABrushFg;
        end else
        begin
          Bmp:=CreateBmpPattern(Fm.FillPattern.Pattern, ABrushFg, ABrushBg);
          Acanvas.Brush.Bitmap:=Bmp;
        end;

        ACanvas.FillRect(Rect(Round(Cw*ZoomPreview), Round(Ch*ZoomPreview), Round((Cw+RealColWidth(Col,Zoom100,XPpi))*ZoomPreview), Round((Ch+RealRowHeight(Row,Zoom100,YPpi))*ZoomPreview)));

      finally
        ACanvas.Brush.Bitmap:=nil;
        FreeAndNil(Bmp);
      end; //finally
      }
      if FOptions.ImportCellProperties then
      begin
        CurrentGrid.Colors[cg, rg] := GetColor(Workbook, Fm);

        if Fm.Rotation > 0 then
          if Fm.Rotation <= 90 then CurrentGrid.SetRotated(cg, rg, Fm.Rotation) else
            if Fm.Rotation <= 180 then CurrentGrid.SetRotated(cg, rg, 90 - Fm.Rotation);
      end;

      //pending: cellborders, brush, cell align, empty right cells, imagesize,
      //pending: fechas y otros formatos, copy/paste, events, comentarios on flexcel .

      //pending: export deafultreowheights/colwidths
      //Ask for: Rotated unicode. Image Size.  Vertical Aligns Word wraps in cells.
      //pending keepexcelformat on import/export don't work with dates
      //pending: export placement of images

      v := Workbook.CellValue[r, c];

      //Cell Align
      if FOptions.ImportCellProperties then
      begin
        case Fm.HAlignment of
          fha_left: HAlign := taLeftJustify;
          fha_center: HAlign := taCenter;
          fha_right: HAlign := taRightJustify;
        else
          begin
            if VarType(v) = VarBoolean then HAlign := taCenter else
              if (VarType(v) <> VarOleStr) and (VarType(v) <> VarString) then HAlign := taRightJustify
              else HAlign := taLeftJustify;
          end;
        end; //case

       //this must be done after reading the alignment, since it depends on the formula value.
      if FOptions.ImportFormulas then
      begin
        Formula := Workbook.CellFormula[r,c];
        if (Pos('=',Formula) = 1) then
          v := Formula;
       end;


        {
        case Fm.VAlignment of
        fva_top: VAlign:=AL_TOP;
        fva_center: VAlign:=AL_VCENTER;
        else VAlign:=AL_BOTTOM ;
        end; //case
        }

        CurrentGrid.Alignments[cg, rg] := HAlign;
      end;

      FontColor := CurrentGrid.FontColors[cg, rg];
      w := XlsFormatValue1904(v, Fm.Format, Workbook.Options1904Dates, FontColor);

      if FOptions.ImportCellProperties then
        CurrentGrid.FontColors[cg, rg] := FontColor;

      if FOptions.ImportCellFormats then
      begin
        if UseUnicode then
          CurrentGrid.WideCells[cg, rg] := WideAdjustLineBreaks(w)
        else
          CurrentGrid.Cells[cg, rg] := Trim(AdjustLineBreaks(w));
      end
      else
      begin
        case VarType(V) of
          varByte,
            varSmallint,
            varInteger: CurrentGrid.Ints[cg, rg] := v;

{$IFDEF ConditionalExpressions}{$IF CompilerVersion >= 14}varInt64, {$IFEND}{$ENDIF} //Delphi 6 or above
          varCurrency,
            varSingle,
            varDouble:
            begin
              if HasXlsDateTime(Fm.Format, HasDate, HasTime) then
              begin
                if HasTime and HasDate then //We can't map this to a date or time cell.
                  if UseUnicode then
                    CurrentGrid.WideCells[cg, rg] := w else
                    CurrentGrid.Cells[cg, rg] := w

                else if HasDate then CurrentGrid.Dates[cg, rg] := v else CurrentGrid.Times[cg, rg] := v
              end
              else CurrentGrid.Floats[cg, rg] := v;
            end;

          varDate: CurrentGrid.Dates[cg, rg] := v;
        else
          if UseUnicode then
            CurrentGrid.WideCells[cg, rg] := w else
            CurrentGrid.Cells[cg, rg] := w;

        end; //case
      end;
    end;

    //Import Comments
    if FOptions.ImportCellProperties then
      for i := 0 to Workbook.CommentsCount[r] - 1 do
        CurrentGrid.AddComment(Workbook.CommentColumn[r, i] + GridStartCol - XlsStartCol, r + GridStartRow - XlsStartRow, Workbook.CommentText[r, i]);

    if Assigned(FOnProgress) then
      FOnProgress(Self, FWorkSheet, FWorkSheetNum, r - XlsStartRow, MaxR - XlsStartRow);
  end;

  //Import nodes
  if FOptions.ImportCellProperties then //After all has been loaded
    ImportAllNodes(Workbook, XlsStartRow, MaxR);

end;

procedure TAdvGridExcelIO.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FAdapter then
      FAdapter := nil;
    if AComponent = FAdvStringGrid then
      FAdvStringGrid := nil;
    if AComponent = FAdvGridWorkbook then
      FAdvGridWorkbook := nil;
  end;
end;

//procedure TAdvGridExcelIO.SetAdapter(const Value: TExcelAdapter);
//begin
//  FAdapter := Value;
//end;

procedure TAdvGridExcelIO.SetAdvStringGrid(const Value: TAdvStringGrid);