tmsadvgridexcel.pas

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

              end;

              if FUseUnicode then
                w := SupressCR(CurrentGrid.WideCells[creal, rreal])
              else
                w := SupressCR(CurrentGrid.SaveCell(creal, rreal));

              Formula := SupressCR(CurrentGrid.SaveCell(creal, rreal));
              if Assigned(FOnGetCellFormula) then
                FOnGetCellFormula(CurrentGrid, creal, rreal, w, Formula);

              if (FOptions.ExportReadonlyCellsAsLocked) then
              begin
                Fm.Locked := CurrentGrid.ReadOnly[creal, rreal];
              end;

              if not Options.ExportHTMLTags then
              begin
                StringReplace(w,'<br>','#13#10',[rfReplaceAll, rfIgnoreCase]);
              end;

              if (pos(#10, w) > 0) or (CurrentGrid.WordWrap and Options.ExportWordWrapped) then
                Fm.WrapText := true;

              if (pos('</',w) > 0) and not Options.ExportHTMLTags then
              begin
                w := HTMLStrip(w);
                w := StringReplace(w,'&nbsp;',' ',[rfIgnoreCase, rfReplaceAll]);  //***
                w := StringReplace(w,'&amp;','&',[rfIgnoreCase, rfReplaceAll]);    //***
                w := StringReplace(w,'&quot;','"',[rfIgnoreCase, rfReplaceAll]);  //***
              end;

              //Cell Align
              case HA of
                taLeftJustify: Fm.HAlignment := fha_left;
                taCenter: Fm.HAlignment := fha_center;
                taRightJustify: Fm.HAlignment := fha_right;
              else Fm.HAlignment := fha_general;
              end; //case

              case VA of
                vtaTop: Fm.VAlignment := fva_top;
                vtaCenter: Fm.VAlignment := fva_center;
              else Fm.VAlignment := fva_bottom;
              end; //case

              if Assigned(OnCellFormat) then
                OnCellFormat(CurrentGrid, creal, rreal, cx, rx, w, Fm);

              ExportCellAsString := not FOptions.ExportCellFormats;
              if Assigned(OnExportColumnFormat) then OnExportColumnFormat(CurrentGrid, creal, rreal, cx, rx, w, ExportCellAsString);
              if not ExportCellAsString then
              begin
                aDateFormat := FDateFormat;
                aTimeFormat := FTimeFormat;
                if Assigned(OnDateTimeFormat) then
                  OnDateTimeFormat(CurrentGrid, creal, rreal, cx, rx, w, aDateFormat, aTimeFormat);

                if (pos('=',Formula) = 1) and FOptions.ExportFormulas then
                begin
                  Workbook.CellFormula[rx,cx] := Formula;
                  if Options.ExportCellProperties then
                    Workbook.CellFormat[rx, cx] := Workbook.AddFormat(Fm);
                end
                else
                begin
                  if Options.ExportCellProperties then
                    Workbook.SetCellString(rx, cx, w, Fm, aDateFormat, aTimeFormat)
                  else
                  begin
                    Fm := CellFormatDef(Workbook, rx, cx);
                    Workbook.SetCellString(rx, cx, w, Fm, aDateFormat, aTimeFormat);
                  end;
                end;
                CopyFmToMerged(Workbook, cp, rx, cx, Fm) ;
              end
              else
              begin
                if (pos('=',Formula) = 1) and FOptions.ExportFormulas then
                begin
                  Workbook.CellFormula[rx,cx] := Formula;
                end
                else
                begin
                  Workbook.CellValue[rx, cx] := w;
                end;
                if Options.ExportCellProperties then
                begin
                  Workbook.CellFormat[rx, cx] := Workbook.AddFormat(Fm);
                  CopyFmToMerged(Workbook, cp, rx, cx, Fm) ;
                end;
              end;
            finally
              FreeAndNil(ABrush);
            end; //finally
          finally
            FreeAndNil(AFont);
          end; //finally

          //Export Images
          Pic := CurrentGrid.CellGraphics[creal, rreal];
          if (Pic <> nil) and (Pic.CellBitmap <> nil) then
          begin
            if (Pic.CellType = cTBitmap) then
               ExportImage(Workbook, Pic.CellBitmap, rx, cx, creal, rreal);

          if (Pic.CellType in [ctPicture, ctInterface]) and (TPicture(Pic.CellBitmap).Graphic <> nil) then
               ExportImage(Workbook, TPicture(Pic.CellBitmap).Graphic, rx, cx, creal, rreal);
          end;

          if (Pic <> nil) and (Pic.CellType = ctImageList) then
            begin
               membmp := TBitmap.Create;
               try
              if CurrentGrid.GridImages.GetBitmap(Pic.CellIndex, membmp) then
                 ExportImage(Workbook, membmp, rx, cx, creal, rreal);
               finally
                 membmp.Free;
            end;
          end;


        //Export Comments
          if CurrentGrid.IsComment(creal, rreal, Comment) then
          begin
            Cr := Workbook.CellMergedBounds[rx, cx];
            CommentHeight:= 75;
            CommentWidth:= 130;
            Comment := SupressCR(Comment);
            ResizeCommentBox(Workbook, Comment, CommentHeight, CommentWidth);
            if Assigned(OnGetCommentBoxSize) then OnGetCommentBoxSize(CurrentGrid, Comment, CommentHeight, CommentWidth);

            CalcImgCells(Workbook, rx - 1, cx + Cr.Right - Cr.Left + 1, 8, 14, CommentHeight, CommentWidth, Properties);
            Workbook.SetCellComment(rx, cx, Comment, Properties);
          end;

          if Assigned(FOnProgress) then
            FOnProgress(Self, FWorksheet, FWorkSheetNum, rg - GridStartRow, CurrentGrid.RowCount - 1 - GridStartRow);

        end;


        //Export Nodes
        if Options.ExportCellProperties then
          if (CurrentGrid.GetNodeLevel(rreal)>=0) and (CurrentGrid.GetNodeLevel(rreal)<=7) then
            Workbook.SetRowOutlineLevel(rx+1, rx+CurrentGrid.GetNodeSpan(rreal)-1, CurrentGrid.GetNodeLevel(rreal));

      end;
    finally
      if Options.FExportHiddenRows then
        CurrentGrid.RowCount := CurrentGrid.RowCount - HiddenRowCount;
    end; //finally

  finally
    //if Options.ExportHiddenColumns then
      CurrentGrid.ColCount := CurrentGrid.ColCount - HiddenColCount;
  end; //finally

  CurrentGrid.ExportNotification(esExportDone,-1);
end;

function TAdvGridExcelIO.FindSheet(const Workbook: TExcelFile; const SheetName: UTF16String; out index: integer): boolean;
var
  i: integer;
begin
  Result := False;
  Index := -1;
  for i := 1 to Workbook.SheetCount do
  begin
    Workbook.ActiveSheet := i;
    if (WideUpperCase98(Workbook.ActiveSheetName) = WideUpperCase98(SheetName)) then
    begin
      Result := True;
      Index := i;
      Exit;
    end;
  end;
end;

procedure TAdvGridExcelIO.OpenFile(const Workbook: TExcelFile; const FileName: string);
begin
  Workbook.OpenFile(FileName);
end;

procedure TAdvGridExcelIO.XLSExport(const FileName: TFileName; const SheetName: UTF16String = ''; const SheetPos: integer = -1; const SelectSheet: integer = 1; const InsertInSheet: TInsertInSheet = InsertInSheet_Clear);
var
  Workbook: TExcelFile;
  UseWorkbook: boolean;
  Sp, i: integer;
  rows, cols, dr, dc: integer;
  GridRowCount, GridColCount: integer;
begin
  if CurrentGrid = nil then
    raise Exception.Create(ErrNoAdvStrGrid);


  case Options.ExportOverwrite of
  omAlways:
    begin
      if FileExists(FileName) then
        DeleteFile(FileName);
    end;
  omWarn:
    begin
      if FileExists(FileName) then
      begin
        if MessageDlg(Format(Options.ExportOverwriteMessage,[FileName]),mtCOnfirmation,[mbYes,mbNo],0) = mrYes then
          DeleteFile(FileName)
        else
          Exit;
      end;
    end;
  end;

  UseWorkbook := (FAdvGridWorkbook <> nil) and (SheetName = '') and (SheetPos = -1);
  //Open the file
  if FAdapter = nil then
    Workbook := TXLSFile.Create(nil) else
    Workbook := FAdapter.GetWorkbook;
  try
    Workbook.Connect;

    if UseWorkbook then
    begin
      Workbook.NewFile(FAdvGridWorkbook.Sheets.Count);
      for i := 1 to Workbook.SheetCount do
      begin
        Workbook.ActiveSheet := i;
        Workbook.ActiveSheetName := '_xx_@' + IntToStr(i) + '__' + IntToStr(i); //Just to make sure it is an unique name
      end;
    end else
      if FileExists(FileName) then
      begin
        OpenFile(Workbook, FileName);
        if FindSheet(Workbook, SheetName, Sp) then
        begin
          Workbook.ActiveSheet := Sp;
          case InsertInSheet of
             InsertInSheet_Clear:
               Workbook.ClearSheet;
             InsertInSheet_InsertRows,
             InsertInSheet_InsertRowsExceptFirstAndSecond:
             begin
               dr := 0;
               if (InsertInSheet = InsertInSheet_InsertRowsExceptFirstAndSecond) then dr:=1;
               GridRowCount := CurrentGrid.RowCount;
               if Options.FExportHiddenRows then Inc(GridRowCount, CurrentGrid.NumHiddenRows);
               rows := GridRowCount - GridStartRow - dr * 2;
               if rows > 0 then Workbook.InsertAndCopyRows(Max_Rows + 1, Max_Rows + 1, XlsStartRow + dr, rows ,true);
             end;

             InsertInSheet_InsertCols,
             InsertInSheet_InsertColsExceptFirstAndSecond:
             begin
               dc:=0;
               if (InsertInSheet = InsertInSheet_InsertColsExceptFirstAndSecond) then dc:=1;
               GridColCount := CurrentGrid.ColCount;
               if Options.ExportHiddenColumns then Inc(GridColCount, CurrentGrid.NumHiddenColumns);
               cols := GridColCount - GridStartCol - dc * 2;
               if cols > 0 then Workbook.InsertAndCopyRows(Max_Columns + 1, Max_Columns + 1, XlsStartCol + dc, cols ,true);
             end;
          end; //case.
        end else
        begin
          if (SheetPos <= 0) or (SheetPos > Workbook.SheetCount) then
            Sp := Workbook.SheetCount + 1 else Sp := SheetPos;
          Workbook.InsertAndCopySheets(-1, Sp, 1);
          Workbook.ActiveSheet := Sp;
        end;
      end else
        Workbook.NewFile(1);

    if UseWorkbook then
    begin
      FWorkSheetNum := FAdvGridWorkbook.Sheets.Count;
      for i := 1 to FAdvGridWorkbook.Sheets.Count do
      begin
        FWorkSheet := i;
        Workbook.ActiveSheet := i;
        FAdvGridWorkbook.ActiveSheet := i - 1;
        ExportData(Workbook);
        Workbook.ActiveSheetName := FAdvGridWorkbook.Sheets[i - 1].Name;
      end;
    end
    else
    begin
      FWorkSheetNum := 1;
      FWorkSheet := 1;
      ExportData(Workbook);
    end;

    if SheetName <> '' then Workbook.ActiveSheetName := SheetName;
    if FileExists(FileName) then DeleteFile(FileName);
    Workbook.SelectSheet(SelectSheet);
    Workbook.Save(true, FileName, nil);
  finally
    CloseFile(Workbook);
  end;

  if Options.ExportShowInExcel then
    ShellExecute(0,'open',pchar(FileName),nil,nil,SW_NORMAL);
end;

constructor TAdvGridExcelIO.Create(AOwner: TComponent);
begin
  inherited;
  FAutoResizeGrid := true;

  FGridStartCol := 1;
  FGridStartRow := 1;
  FXlsStartCol := 1;
  FXlsStartRow := 1;

  FZoomSaved := true;
  FZoom := 100;

  FOptions := TASGIOOptions.Create;
end;

function TAdvGridExcelIO.GetSheetNames(index: integer): UTF16String;
begin
  Result := FSheetNames[index];
end;

function TAdvGridExcelIO.GetSheetNamesCount: integer;
begin
  Result := Length(FSheetNames);
end;

procedure TAdvGridExcelIO.SetGridStartCol(const Value: integer);
begin
  if Value >= 0 then FGridStartCol := Value else FGridStartCol := 1;
end;

procedure TAdvGridExcelIO.SetGridStartRow(const Value: integer);
begin
  if Value >= 0 then FGridStartRow := Value else FGridStartRow := 1;
end;

procedure TAdvGridExcelIO.SetXlsStartCol(const Value: integer);
begin
  if Value > 0 then FXlsStartCol := Value else FXlsStartCol := 1;
end;

procedure TAdvGridExcelIO.SetXlsStartRow(const Value: integer);
begin
  if Value > 0 then FXlsStartRow := Value else FXlsStartRow := 1;
end;

procedure TAdvGridExcelIO.SetZoom(const Value: integer);
begin
  if Value < 10 then FZoom := 10 else if Value > 400 then FZoom := 400 else
    FZoom := Value;
end;



function TAdvGridExcelIO.CurrentGrid: TAGrid;
begin
  if FAdvGridWorkbook <> nil then
    Result := TAGrid(FAdvGridWorkbook.Grid)
  else
    Result := TAGrid(FAdvStringGrid