tmsadvgridexcel.pas

TMS Component Pack V5.0包含了超过 280 个为 Delphi 以及 C++Builder 设计的 TMS 生产控件

            (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: UTF16String): UTF16String;
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: UTF16String;
  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');

  CurrentGrid.BeginUpdate;
  try
    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.XYOffset.Y;
      CurrentGrid.DefaultColWidth := Round(Workbook.DefaultColWidth / ColMult * Zoom100) + CellOfs + CurrentGrid.XYOffset.X;
    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)
                {$IFDEF DELPHI2008UP} and(VarType(v)<>varUString) {$ENDIF}

                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 FLX_HASCUSTOMVARIANTS}varInt64, {$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);
  finally
    CurrentGrid.EndUpdate;
  end;
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);