rm_e_xls.pas

这是一个功能强大

  begin
    AddProgress;
    if ParentReport.Terminated then Break;

//    FXlsReadWrite.Sheets[lSheetIndex]  MulDiv(value, wawPointPerInch10, GetCharacterWidth)
    //lSheet.Cols[lCol].InchWidth := Round(RMFromScreenPixels(FMatrixList.ColWidth[lCol], rmutInches) * 0.937 * 100) / 100;
  end;

  SetProgress(FMatrixList.RowCount * FMatrixList.ColCount, 'Exporting Cells');
  for lRow := 0 to FMatrixList.RowCount - 1 do
  begin
    if ParentReport.Terminated then Break;
    for lCol := 0 to FMatrixList.ColCount - 1 do
    begin
      AddProgress;
      if ParentReport.Terminated then Break;

      lCell := FMatrixList.Cells[lCol, lRow];
      if (lCell = nil) or (lCell.Counter > 0) then Continue;

      lCellStyle := FMatrixList.CellStyle[lCell];
      lCell.Counter := 1;
      if lCell.ObjType = rmemText then
        _ExportAsText
      else if FExportImages then
        _ExportAsGraphic;
    end;
  end;

  FMatrixList.Clear(False);
end;
{$ELSE}
procedure TRMXLSExport.ExportPages;
var
  lRow, lCol: Integer;
  lRange: TwawXLSRange; //by waw
  lSheet: TwawXLSWorkSheet; //waw
  lCell: TRMIEMData;
  lCellStyle: TRMIEMCellStyle;

  procedure _SetXLSBorders;

    procedure _SetXLSBorder(bi: cardinal; b: TRMFrameLine);
    var
      bt: TwawXLSBorderType;
    begin
      bt := TwawXLSBorderType(nil);
      if not b.Visible then exit;
      case bi of
        xlEdgeLeft: bt := wawxlEdgeLeft;
        xlEdgeTop: bt := wawxlEdgeTop;
        xlEdgeRight: bt := wawxlEdgeRight;
        xlEdgeBottom: bt := wawxlEdgeBottom;
      end;
      case TPenStyle(b.Style) of
        psSolid: lRange.Borders[bt].LineStyle := wawlsThin;
        psDash: lRange.Borders[bt].LineStyle := wawlsDashed;
        psDot: lRange.Borders[bt].LineStyle := wawlsDotted;
        psDashDot: lRange.Borders[bt].LineStyle := wawlsDashDot;
        psDashDotDot: lRange.Borders[bt].LineStyle := wawlsDashDotDot;
        psClear: lRange.Borders[bt].LineStyle := wawlsNone;
        psInsideFrame: lRange.Borders[bt].LineStyle := wawlsNone;
      end;
      lRange.Borders[bt].Color := b.Color;
      lRange.Borders[bt].Weight := wawxlThin;
    end;

  begin
    if ExportFrames then
    begin
      _SetXLSBorder(xlEdgeLeft, lCellStyle.LeftFrame);
      _SetXLSBorder(xlEdgeTop, lCellStyle.TopFrame);
      _SetXLSBorder(xlEdgeRight, lCellStyle.RightFrame);
      _SetXLSBorder(xlEdgeBottom, lCellStyle.BottomFrame);
    end;
  end;

  procedure _ExportAsGraphic;
  var
    lPicture: TPicture;
  begin
    lPicture := TPicture.Create;
    try
      lPicture.Assign(lCell.Graphic);
//      SaveBitmapToPicture(TBitmap(lDataRec.Graphic), ExportImageFormat{$IFDEF JPEG}, JPEGQuality{$ENDIF}, lPicture);
      lSheet.AddImage(lCell.StartCol - 1, lCell.StartRow - 1,
        lCell.EndCol, lCell.EndRow, lPicture, True);
    finally
      lPicture.Free;
    end;
  end;

  procedure _ExportAsText;
  var
    i, lCount: Integer;
    lText: WideString;
    lValue: Extended;
  begin
    lRange := lSheet.Ranges[lCell.StartCol - 1, lCell.StartRow - 1, lCell.EndCol - 1, lCell.EndRow - 1];
    lCount := lCell.Memo.Count;
    lText := '';
    for i := 0 to lCount - 1 do
    begin
      if i > 0 then
        lText := lText + #13#10;

      lText := lText + lCell.Memo[i];
    end;

    lText := StringReplace(lText, #1, '', [rfReplaceAll]);
    if (lText = '') or (lText = #13#10) then
    begin
      lRange.Value := ' ';
      lRange.WrapText := False;
    end
    else
    begin
      if (Copy(lText, Length(lText) - 1, 2) = #13#10) then
        lText := Copy(lText, 1, Length(lText) - 2);

      if (lCell.ExportAsNum or (lCellStyle.DisplayFormat.FormatIndex1 = 1)) and
      	TryStrToFloat(lText, lValue) then
        lRange.Value := lValue
      else
      begin
        lRange.Value := lText;
        if ((Pos(#13#10, lText) > 0) or (Pos(#10, lText) > 0)) then
          lRange.WrapText := True
        else
          lRange.WrapText := False;
      end;
    end;

    lRange.Font.Assign(lCellStyle.Font);
    _SetXLSBorders;
    if (lCellStyle.FillColor <> clNone) and (lCellStyle.FillColor <> clWhite) then
    begin
      lRange.ForegroundFillPatternColor := lCellStyle.FillColor;
      lRange.BackgroundFillPatternColor := clWhite;
      lRange.FillPattern := wawfpSolid;
    end;

    case lCellStyle.VAlign of
      rmvBottom: lRange.VerticalAlignment := wawxlVAlignBottom;
      rmvCenter: lRange.VerticalAlignment := wawxlVAlignCenter;
      rmvTop: lRange.VerticalAlignment := wawxlVAlignTop;
    else
      lRange.VerticalAlignment := wawxlVAlignJustify;
    end;

    case lCellStyle.HAlign of
      rmhLeft: lRange.HorizontalAlignment := wawxlHAlignLeft;
      rmhCenter: lRange.HorizontalAlignment := wawxlHAlignCenter;
      rmhRight: lRange.HorizontalAlignment := wawxlHAlignRight;
    else
      lRange.HorizontalAlignment := wawxlHAlignJustify;
    end;
  end;

begin
  FMatrixList.Prepare;

  lSheet := FWorkBook.AddSheet; //by waw
  if (FPageSize < 256) and (FPageSize < Integer(wawxlPaperA3ExtraTransverse)) then
  begin
    lSheet.PageSetup.PaperSize := TwawXLSPaperSizeType(FPageSize);
    lSheet.PageSetup.FitToPagesWide := 1;
    lSheet.PageSetup.FitToPagesTall := 1;
  end;
  if FPageOr = rmpoPortrait then
    lSheet.PageSetup.Orientation := wawxlPortrait
  else
    lSheet.PageSetup.Orientation := wawxlLandscape;

  lSheet.PageSetup.LeftMargin := (Round(RMFromScreenPixels(FLeftMargin, rmutInches) * 100) / 100) - 0.18;
  lSheet.PageSetup.TopMargin := Round(RMFromScreenPixels(FTopMargin, rmutInches) * 100) / 100;
  lSheet.PageSetup.RightMargin := (Round(RMFromScreenPixels(FRightMargin, rmutInches) * 100) / 100) - 0.18;
  lSheet.PageSetup.BottomMargin := Round(RMFromScreenPixels(FBottomMargin, rmutInches) * 100) / 100;
  lSheet.PageSetup.HeaderMargin := 0.0;
  lSheet.PageSetup.FooterMargin := 0.0;
  lSheet.Title := 'Sheet' + IntToStr(FSheetCount);
  Inc(FSheetCount);

  SetProgress(FMatrixList.RowCount * FMatrixList.ColCount, 'Exporting Row Height');
  lCol := 0;
  for lRow := 0 to FMatrixList.RowCount - 1 do
  begin
    AddProgress;
    if ParentReport.Terminated then Break;

    lSheet.Rows[lRow].InchHeight := Round(RMFromScreenPixels(FMatrixList.RowHeight[lRow], rmutInches) * 100) / 100; //waw
    if FMatrixList.GetCellRowPos(lRow) >= FMatrixList.PageBreak[lCol] then
    begin
      lSheet.AddPageBreakAfterRow(lRow + 1);
      Inc(lCol);
    end;
  end;

  SetProgress(FMatrixList.RowCount * FMatrixList.ColCount, 'Exporting Column Width');
  for lCol := 0 to FMatrixList.ColCount - 1 do
  begin
    AddProgress;
    if ParentReport.Terminated then Break;

    lSheet.Cols[lCol].InchWidth := Round(RMFromScreenPixels(FMatrixList.ColWidth[lCol], rmutInches) * 0.937 * 100) / 100;
  end;

  SetProgress(FMatrixList.RowCount * FMatrixList.ColCount, 'Exporting Cells');
  for lRow := 0 to FMatrixList.RowCount - 1 do
  begin
    if ParentReport.Terminated then Break;
    for lCol := 0 to FMatrixList.ColCount - 1 do
    begin
      AddProgress;
      if ParentReport.Terminated then Break;

      lCell := FMatrixList.Cells[lCol, lRow];
      if (lCell = nil) or (lCell.Counter > 0) then Continue;

      lCellStyle := FMatrixList.CellStyle[lCell];
      lCell.Counter := 1;
      if lCell.ObjType = rmemText then
        _ExportAsText
      else if FExportImages then
        _ExportAsGraphic;
    end;
  end;

  FMatrixList.Clear(False);
end;
{$ENDIF}

procedure TRMXLSExport.OnBeginDoc;
begin
  inherited OnBeginDoc;

  if FMatrixList = nil then
  begin
    FMatrixList := TRMIEMList.Create(Self);
  end;
  FMatrixList.Clear(True);
  FMatrixList.ExportPrecision := ExportPrecision;
  FMatrixList.ExportImage := ExportImages;
  FMatrixList.ExportHighQualityPicture := False;

  ParentReport.Terminated := False;
  FTotalPage := 0;
  FSheetCount := 1;
  OnAfterExport := DoAfterExport;
  try
{$IFDEF XLSReadWriteII}
    FXlsReadWrite := TXLSReadWriteII.Create(nil);
    FXlsReadWrite.Clear;

    FXlsPageNo := 1;
    FXlsReadWrite.PictureOptions := FXlsReadWrite.PictureOptions + [poDeleteTempFiles];
{$ELSE}
    FWorkBook := TwawXLSWorkbook.Create; //By waw
    FWorkBook.Clear;
{$ENDIF}
  except
  end;
end;

procedure TRMXLSExport.OnEndDoc;
begin
  inherited OnEndDoc;
end;

procedure TRMXLSExport.OnBeginPage;
begin
  inherited;

  Inc(FTotalPage);
end;

procedure TRMXLSExport.OnEndPage;
begin
  inherited;
end;

procedure TRMXLSExport.OnExportPage(const aPage: TRMEndPage);
var
  i: Integer;
  t: TRMReportView;
begin
  FLeftMargin := aPage.spMarginLeft;
  FTopMargin := aPage.spMarginTop;
  FRightMargin := aPage.spMarginRight;
  FBottomMargin := aPage.spMarginBottom;
  FPageOr := aPage.PageOrientation;
  FPageSize := aPage.PageSize;
  for i := 0 to aPage.Page.Objects.Count - 1 do
  begin
    t := aPage.Page.Objects[i];
    if t.IsBand or (t is TRMSubReportView) then Continue;

    FMatrixList.AddObject(t);
  end;

  if FTotalPage >= FPagesOfSheet then
  begin
    FTotalPage := 0;
    ExportPages;
{$IFDEF XLSReadWriteII}
    Inc(FXlsPageNo);
{$ENDIF}    
  end
  else
  begin
    FMatrixList.EndPage;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMXLSExportForm }

procedure TRMXLSExportForm.Localize;
begin
  Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  RMSetStrProp(chkExportImages, 'Caption', rmRes + 1821);
  RMSetStrProp(lblExportImageFormat, 'Caption', rmRes + 1816);
  RMSetStrProp(lblJPEGQuality, 'Caption', rmRes + 1814);
  RMSetStrProp(Label4, 'Caption', rmRes + 1788);

  RMSetStrProp(GroupBox1, 'Caption', rmRes + 044);
  RMSetStrProp(rdbPrintAll, 'Caption', rmRes + 045);
  RMSetStrProp(rbdPrintCurPage, 'Caption', rmRes + 046);
  RMSetStrProp(rbdPrintPages, 'Caption', rmRes + 047);
  RMSetStrProp(Label2, 'Caption', rmRes + 048);
  RMSetStrProp(GroupBox2, 'Caption', rmRes + 379);
  RMSetStrProp(Label1, 'Caption', rmRes + 378);
  RMSetStrProp(chkShowAfterGenerate, 'Caption', rmRes + 380);
  RMSetStrProp(chkExportFrames, 'Caption', rmRes + 1778);
  RMSetStrProp(Label3, 'Caption', rmRes + 382); //waw
  RMSetStrProp(chkWYB, 'Caption', rmRes + 1775);

  RMSetStrProp(Self, 'Caption', rmRes + 1779);
  btnOK.Caption := RMLoadStr(SOk);
  btnCancel.Caption := RMLoadStr(SCancel);
end;

procedure TRMXLSExportForm.FormCreate(Sender: TObject);
begin
  Localize;
  cmbImageFormat.Items.Clear;
{$IFDEF RXGIF}
  cmbImageFormat.Items.AddObject(ImageFormats[ifGIF], TObject(ifGIF));
{$ENDIF}
{$IFDEF JPEG}
  cmbImageFormat.Items.AddObject(ImageFormats[ifJPG], TObject(ifJPG));
{$ENDIF}
  cmbImageFormat.Items.AddObject(ImageFormats[ifBMP], TObject(ifBMP));
  cmbImageFormat.ItemIndex := 0;
end;

procedure TRMXLSExportForm.btnFileNameClick(Sender: TObject);
begin
  SaveDialog.FileName := edtExportFileName.Text;
  if SaveDialog.Execute then
    edtExportFileName.Text := SaveDialog.FileName;
end;

procedure TRMXLSExportForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if (ModalResult = mrOK) and (edtExportFileName.Text = '') then
    CanClose := False;
end;

procedure TRMXLSExportForm.rbdPrintPagesClick(Sender: TObject);
begin
  edtPages.SetFocus;
end;

procedure TRMXLSExportForm.edtPagesEnter(Sender: TObject);
begin
  rbdPrintPages.Checked := True;
end;

procedure TRMXLSExportForm.chkExportFramesClick(Sender: TObject);
begin
  RMSetControlsEnable(gbExportImages, chkExportImages.Checked);
  cmbImageFormatChange(Sender);
end;

procedure TRMXLSExportForm.edJPEGQualityKeyPress(Sender: TObject;
  var Key: Char);
begin
  if not (Key in ['0'..'9', #8]) then
    Key := #0;
end;

procedure TRMXLSExportForm.cmbImageFormatChange(Sender: TObject);
begin
  if chkExportImages.Checked and (cmbImageFormat.Text = ImageFormats[ifJPG]) then
  begin
    lblJPEGQuality.Enabled := True;
    edJPEGQuality.Enabled := True;
    edJPEGQuality.Color := clWindow;
  end
  else
  begin
    lblJPEGQuality.Enabled := False;
    edJPEGQuality.Enabled := False;
    edJPEGQuality.Color := clInactiveBorder;
  end;
end;

initialization

finalization

{$ENDIF}
end.