advgridexcel.pas

TMS Component Pack Pro v4.2

      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;

    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;
  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);

      //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];

      if FOptions.ImportFormulas then
      begin
        Formula := Workbook.CellFormula[r,c];
        if (Pos('=',Formula) = 1) then
          v := Formula;
       end;

      //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

        {
        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 := XlsFormatValue(v, Fm.Format, 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] := 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);
begin
  FAdvGridWorkbook := nil;
  FAdvStringGrid := Value;
end;

procedure TAdvGridExcelIO.SetAdvGridWorkbook(const Value: TAdvGridWorkbook);
begin
  FAdvStringGrid := nil;
  FAdvGridWorkbook := Value;
end;


procedure TAdvGridExcelIO.OpenText(const Workbook: TExcelFile; const FileName: TFileName; const Delimiter: char);
var
  DataStream: TFileStream;
begin
  DataStream := TFileStream.Create(FileName, fmOpenRead);
  try
    Workbook.NewFile;
    LoadFromTextDelim(DataStream, Workbook, Delimiter, 1, 1, []);
  finally
    FreeAndNil(DataStream);
  end; //finally
end;

procedure TAdvGridExcelIO.InternalXLSImport(const FileName: TFileName; const SheetNumber: integer; const SheetName: widestring);
var
  Workbook: TExcelFile;
  i: integer;
  Ext: string;
  aSheetNumber: integer;
  UseWorkbook: boolean;
begin
  aSheetNumber := SheetNumber;
  UseWorkbook := (FAdvGridWorkbook <> nil) and (SheetNumber < 0) and (SheetName = '');

  if CurrentGrid = nil then raise Exception.Create(ErrNoAdvStrGrid);
  //Open the file
  if FAdapter = nil then
    Workbook := TXLSFile.Create(nil) else
    Workbook := FAdapter.GetWorkbook;
  try
    Workbook.Connect;
    Ext := UpperCase(ExtractFileExt(FileName));
    if Ext = '.CSV' then OpenText(Workbook, FileName, ListSeparator) else //Note that ListSeparator mightbe other than "," (for example ";") so CSV might not be "comma" separated. This is the way excel handles it.
      if Ext = '.TXT' then OpenText(Workbook, FileName, #9) else
        Workbook.OpenFile(FileName);

    if UseWorkbook then
    begin
      FAdvGridWorkbook.ActiveSheet := 0;
      FAdvGridWorkbook.Sheets.Clear;
    end;


    SetLength(FSheetNames, Workbook.SheetCount);

    FWorkSheetNum := Workbook.SheetCount;

    for i := 0 to Workbook.SheetCount - 1 do
    begin
      FWorkSheet := i + 1;
      Workbook.ActiveSheet := i + 1;
      FSheetNames[i] := Workbook.ActiveSheetName;
      if WideUpperCase98(SheetName) = WideUpperCase98(FSheetNames[i]) then aSheetNumber := i + 1;
      if UseWorkbook then
      begin
        FAdvGridWorkbook.Sheets.Add;
        FAdvGridWorkbook.ActiveSheet := i;
        FAdvGridWorkbook.Sheets[i].Name := FSheetNames[i];
        Workbook.ParseComments;
        ImportData(Workbook);
        CurrentGrid.VAlignment := vtaBottom;
      end;
    end;

    if not UseWorkbook then
    begin
      if aSheetNumber < 1 then
        aSheetNumber := 1;

      FWorkSheetNum := 1;
      FWorkSheet := 1;
      if (aSheetNumber = 0) and (SheetName <> '') then raise Exception.CreateFmt(ErrInvalidSheetName, [SheetName]);
      if (aSheetNumber > 0) and (aSheetNumber <= Workbook.SheetCount) then
      begin
        Workbook.ActiveSheet := aSheetNumber;
        Workbook.SelectSheet(aSheetNumber);
      end
      else raise Exception.CreateFmt(ErrIndexOutBounds, [aSheetNumber, 'ActiveSheet', 1, Workbook.SheetCount]);

      Workbook.ParseComments;
      ImportData(Workbook);
      CurrentGrid.VAlignment := vtaBottom;
    end;
  finally
    CloseFile(Workbook);
  end;
end;

procedure TAdvGridExcelIO.XLSImport(const FileName: TFileName);
begin
  XlsImport(FileName, -1);
  if FAdvGridWorkbook <> nil then
    FAdvGridWorkbook.ActiveSheet := 0;
end;

procedure TAdvGridExcelIO.XLSImport(const FileName: TFileName; const SheetName: widestring);
begin
  if SheetName = '' then raise Exception.CreateFmt(ErrInvalidSheetName, [SheetName]);
  InternalXLSImport(FileName, 0, SheetName);
end;

procedure TAdvGridExcelIO.XLSImport(const FileName: TFileName; const SheetNumber: integer);
begin
  InternalXLSImport(FileName, SheetNumber, '');
end;


procedure TAdvGridExcelIO.ExportImage(const Workbook: TExcelFile; const Pic: TGraphic; const rx, cx, cg, rg: integer);
//Adapted from FlexCelImport.AddPicture
var
  s: string;
  Ms: TMemoryStream;
  Props: TImageProperties;
  PicType: TXlsImgTypes;
  JPic: TJPEGImage;
  BPic: TBitmap;
  PSize, CSize: TPoint;
  dh, dw: integer;
  Cr: TCellGraphic;
begin
  PicType := xli_Jpeg;
{$IFDEF USEPNGLIB}
  if Pic is TPNGObject then PicType := xli_Png;
{$ENDIF}

  Ms := TMemoryStream.Create;
  try
    if (PicType = xli_Jpeg) and not (Pic is TJPEGImage) then
    begin //Convert the image
      JPic := TJPEGImage.Create;
      try
        BPic := TBitmap.Create; //we can't assign a metafile to a jpeg, so the temporary bitmap.
        try
          BPic.Width := Pic.Width;
          BPic.Height := Pic.Height;
          BPic.Canvas.Draw(0, 0, Pic);
          JPic.Assign(BPic);
        finally
          FreeAndNil(BPic);
        end; //finally
        JPic.SaveToStream(Ms);
      finally
        FreeAndNil(JPic);
      end; //finally
    end
    else
      Pic.SaveToStream(Ms);

    Ms.Position := 0;
    SetLength(s, Ms.Size);
    Ms.Read(s[1], Ms.Size);
    PSize := CurrentGrid.CellGraphicSize[cg, rg];
    CSize := CurrentGrid.CellSize(cg, rg);
    dh := 1;
    dw := 1;
    Cr := CurrentGrid.CellGraphics[cg, rg];

    case Cr.CellHAlign of
      haLeft:
        begin
        //Nothing, this is default
        end;