rm_e_oldxls.pas

这是一个功能强大

        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, lDataRec.Obj.LeftFrame);
        _SetXLSBorder(xlEdgeTop, lDataRec.Obj.TopFrame);
        _SetXLSBorder(xlEdgeRight, lDataRec.Obj.RightFrame);
        _SetXLSBorder(xlEdgeBottom, lDataRec.Obj.BottomFrame);
      end;
    end;

  begin
    lRange := lSheet.Ranges[lItem^.LeftCol.Index + 1, lItem^.TopRow.Index + 1,
      lItem^.RightCol.Index, lItem^.BottomRow.Index];
    if lDataRec.BmpWidth > 0 then
    begin
      lRange.Value := ' ';
      Exit;
    end;

    lText := StringReplace(lDataRec.Obj.Memo.Text, #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);
      lText := StringReplace(lText, 'm~2|', #$A9#$4F, [rfReplaceAll]);
      lRange.Value := lText;
      if THackMemoView(lDataRec.Obj).ExportAsNumber then
        lRange.Value := VarAsType(lRange.Value, varDouble);

      if ((Pos(#13#10, lRange.Value) > 0) or (Pos(#10, lRange.Value) > 0)) then
        lRange.WrapText := True
      else
        lRange.WrapText := False;
    end;

    lRange.Font.Assign(TRMCustomMemoView(lDataRec.Obj).Font);
    lRange.Font.Style := [];
    if fsBold in TRMCustomMemoView(lDataRec.Obj).Font.Style then
      lRange.Font.Style := lRange.Font.Style + [fsBold];
    if fsItalic in TRMCustomMemoView(lDataRec.Obj).Font.Style then
      lRange.Font.Style := lRange.Font.Style + [fsItalic];
    if fsUnderline in TRMCustomMemoView(lDataRec.Obj).Font.Style then
      lRange.Font.Style := lRange.Font.Style + [fsUnderline];
    if fsStrikeOut in TRMCustomMemoView(lDataRec.Obj).Font.Style then
      lRange.Font.Style := lRange.Font.Style + [fsStrikeout];

    _SetXLSBorders;

    if (lDataRec.Obj.FillColor <> clNone) and (lDataRec.Obj.FillColor <> clWhite) then
    begin
      lRange.ForegroundFillPatternColor := lDataRec.Obj.FillColor;
      lRange.BackgroundFillPatternColor := clWhite;
      lRange.FillPattern := wawfpSolid;
    end;

    case THackMemoView(lDataRec.Obj).RotationType of //waw Add
      rmrt90:
        lRange.Rotation := 90; //Rotation +90
      rmrt270:
        lRange.Rotation := 180; //Rotation -90
    else
      lRange.Rotation := 0; //Excel Rotation Range Is -90...+90
    end;

    case THackMemoView(lDataRec.Obj).VAlign of
      rmvBottom:
        lRange.VerticalAlignment := wawxlVAlignBottom;
      rmvCenter:
        lRange.VerticalAlignment := wawxlVAlignCenter;
      rmvTop:
        lRange.VerticalAlignment := wawxlVAlignTop;
    else
      lRange.VerticalAlignment := wawxlVAlignJustify;
    end;

    case THackMemoView(lDataRec.Obj).HAlign of
      rmhLeft:
        lRange.HorizontalAlignment := wawxlHAlignLeft;
      rmhCenter:
        lRange.HorizontalAlignment := wawxlHAlignCenter;
      rmhRight:
        lRange.HorizontalAlignment := wawxlHAlignRight;
    else
      lRange.HorizontalAlignment := wawxlHAlignJustify;
    end;

  end;

begin
  if (FpgList.Count <> 0) and (FpgList.IndexOf(IntToStr(FPageNo + 1)) < 0) then
  begin
    inherited OnEndPage;
    Exit;
  end;

  pe := TList.Create;
  for i := 0 to FDataList.Count - 1 do
  begin
    New(lItem);
    pe.Add(lItem);
  end;

  try
    for i := 0 to FDataList.Count - 1 do
    begin
      Application.ProcessMessages;
      lDataRec := FDataList[i];
      lItem := pXLSExport(pe[i]);

      k := 0;
      while (k < FCols.Count) and not _CEP(TCol(FCols[k]).X, lDataRec.Left) do Inc(k);
      if k >= FCols.Count then
        lItem^.LeftCol := TCol(FCols[FCols.Add(TCol.CreateCol(lDataRec.Left))])
      else
        lItem^.LeftCol := TCol(FCols[k]);

      k := 0;
      while (k < FCols.Count) and not _CEP(TCol(FCols[k]).X, lDataRec.Left + lDataRec.Width) do Inc(k);
      if k >= FCols.Count then
        lItem^.RightCol := TCol(FCols[FCols.Add(TCol.CreateCol(lDataRec.Left + lDataRec.Width))])
      else
        lItem^.RightCol := TCol(FCols[k]);

      k := 0;
      while (k < FRows.Count) and not _CEP(TRow(FRows[k]).Y, lDataRec.Top) do Inc(k);
      if k >= FRows.Count then
        lItem^.TopRow := TRow(FRows[FRows.Add(TRow.CreateRow(lDataRec.Top, FPageNo))])
      else
        lItem^.TopRow := TRow(FRows[k]);
      k := 0;
      while (k < FRows.Count) and not _CEP(TRow(FRows[k]).Y, lDataRec.Top + lDataRec.Height) do Inc(k);
      if k >= FRows.Count then
        lItem^.BottomRow := TRow(FRows[FRows.Add(TRow.CreateRow(lDataRec.Top + lDataRec.Height, FPageNo))])
      else
        lItem^.BottomRow := TRow(FRows[k]);
    end;

    FCols.Sort(SortCols);
    FRows.Sort(SortRows);

    if FMultiSheet or FFirstPage then ///whf
    begin
      lSheet := FWorkBook.AddSheet; //by waw
      if (aPage.PageSize < 256) and (aPage.PageSize < Integer(wawxlPaperA3ExtraTransverse)) then
      begin
        lSheet.PageSetup.PaperSize := TwawXLSPaperSizeType(aPage.PageSize);
        lSheet.PageSetup.FitToPagesWide := 1;
        lSheet.PageSetup.FitToPagesTall := 1;
      end;
      if aPage.PageOrientation = rmpoPortrait then
        lSheet.PageSetup.Orientation := wawxlPortrait
      else
        lSheet.PageSetup.Orientation := wawxlLandscape;
      lSheet.PageSetup.LeftMargin := Round(RMFromScreenPixels(aPage.spMarginLeft, rmutInches) * 100) / 100;
      lSheet.PageSetup.TopMargin := Round(RMFromScreenPixels(aPage.spMarginTop, rmutInches) * 100) / 100;
      lSheet.PageSetup.RightMargin := Round(RMFromScreenPixels(aPage.spMarginRight, rmutInches) * 100) / 100;
      lSheet.PageSetup.BottomMargin := Round(RMFromScreenPixels(aPage.spMarginBottom, rmutInches) * 100) / 100;
      lSheet.PageSetup.HeaderMargin := 0.0;
      lSheet.PageSetup.FooterMargin := 0.0;
      lSheet.Title := Format('Sheet%d', [FPageNo + 1]); //by waw

      for i := 0 to FCols.Count - 1 do // 设置cell宽度
      begin
        if i = 0 then
          lSheet.Cols[i].PixelWidth := Round(TCol(FCols[i]).X * KoefX)
        else
          lSheet.Cols[i].PixelWidth := Round((TCol(FCols[i]).X - TCol(FCols[i - 1]).X) * KoefX);
      end;
    end
    else
      lSheet := FWorkBook.Sheets[0];

    for i := 0 to FCols.Count - 1 do // 设置 Colnum 序号
    begin
      TCol(FCols[i]).Index := i;
    end;

    for i := 0 to FRows.Count - 1 do // 设置cell高度
    begin
      TRow(FRows[i]).Index := FrStart + i; // 设置 Row 序号
      r := TRow(FRows[i]);
      if i = 0 then
        lSheet.Rows[TRow(FRows[i]).Index].PixelHeight := r.Y
      else
      begin
        pr := TRow(FRows[i - 1]);
        if r.PageIndex = pr.PageIndex then
          lSheet.Rows[TRow(FRows[i]).Index].PixelHeight := r.Y - pr.Y
        else
          lSheet.Rows[TRow(FRows[i]).Index].PixelHeight := r.Y;
      end;
    end;

    if FMultiSheet then
      FrStart := 0
    else
    begin
      FrStart := FrStart + FRows.Count;
      lSheet.AddPageBreakAfterRow(FrStart);
    end;

    for i := 0 to FDataList.Count - 1 do
    begin
      Application.ProcessMessages;
      lDataRec := FDataList[i];
      lItem := pXLSExport(pe[i]);
      lFlag := True;
      for k := i + 1 to FDataList.Count - 1 do
      begin
        Application.ProcessMessages;
        lDataRec1 := FDataList[k];
        if (lDataRec1.Left >= lDataRec.Left) and (lDataRec1.Top >= lDataRec.Top) and
          (lDataRec1.Left + lDataRec1.Width <= lDataRec.Left + lDataRec.Width) and
          (lDataRec1.Top + lDataRec1.Height <= lDataRec.Top + lDataRec.Height) then
        begin
          lFlag := False;
          Break;
        end;
      end;

      if lFlag then
      begin
        case lDataRec.ObjType of
          rmemText: _ExportText;
          rmemPicture: _ExportPicture;
        end;  
      end;
    end;
  finally
    while pe.Count > 0 do
    begin
      Dispose(pXLSExport(pe[0]));
      pe.Delete(0);
    end;
    pe.Free;

    _ClearColsAndRows;
    FFirstPage := False;
    inherited OnEndPage;
  end;
end;

procedure TRMOldXLSExport.SaveToFile(const FileName: string);
var
  Writer: TwawCustomWriter; //By waw
begin
  if FWorkBook = nil then exit;
  if ExtractFileExt(FileName) = '.xls' then
    Writer := TwawExcelWriter.Create //By waw
  else
    Writer := TwawHTMLWriter.Create; //By waw
  try
    Writer.Save(FWorkBook, FileName); //By waw
  finally
    Writer.Free; //By waw
  end;
  FWorkBook.Free; //By waw
  FWorkBook := nil;
end;

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

procedure TRMOldXLSExportForm.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 + 381);  //显示导出过程
  RMSetStrProp(chkExportFrames, 'Caption', rmRes + 1803); //导出框线
  RMSetStrProp(chkMultiSheet, 'Caption', rmRes + 382);

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

function TRMOldXLSExportForm.GetExportPages: string;
begin
  Result := '';
  if rbdPrintCurPage.Checked then
    Result := 'CURPAGE'
  else if rbdPrintPages.Checked then
    Result := edtPages.Text;
end;

procedure TRMOldXLSExportForm.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 TRMOldXLSExportForm.btnFileNameClick(Sender: TObject);
begin
  SaveDialog.FileName := edtExportFileName.Text;
  if SaveDialog.Execute then
    edtExportFileName.Text := SaveDialog.FileName;
end;

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

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

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

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

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

procedure TRMOldXLSExportForm.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.