lazreport的pdf导出插件lrPDFExport缺失MemoView功能,导出的报表如有TfrMemoView,生成的pdf会直接丢弃TfrMemoView的文字,原TfrMemoView的位置出现空白。
导出的pdf:
修复步骤:
打开Lazreport\source\addons\lrFclPDFExport\lr_e_fclpdf.pas
procedure TlrPdfExportFilter.DoMemoView(View: TfrMemoView); var S,text: String; W: Double; x,y,r:single; i:Integer; ADescender: single; begin DrawRectView(View); S:=TfrMemoView(View).URLInfo; if LazStartsText('HTTP://', S) or LazStartsText('HTTPS://', S) then WriteURL(View.Left, View.Top, View.Width, View.Height, TfrMemoView(View).URLInfo); //prepare font FCurFont:=FFontItems.AddItem(View.Font.Name, View.Font.Style); if Assigned(FCurFont) then begin FCurFont.FontSize:=View.Font.Size; FCurFont.FontColor:=View.Font.Color; FCurFont.Activate; end; end;
补充procedure TlrPdfExportFilter.DoMemoView(View: TfrMemoView)功能:
procedure TlrPdfExportFilter.DoMemoView(View: TfrMemoView); var S,text: String; W: Double; x,y,r:single; i:Integer; ADescender: single; begin DrawRectView(View); S:=TfrMemoView(View).URLInfo; if LazStartsText('HTTP://', S) or LazStartsText('HTTPS://', S) then WriteURL(View.Left, View.Top, View.Width, View.Height, TfrMemoView(View).URLInfo); //prepare font FCurFont:=FFontItems.AddItem(View.Font.Name, View.Font.Style); if Assigned(FCurFont) then begin FCurFont.FontSize:=View.Font.Size; FCurFont.FontColor:=View.Font.Color; FCurFont.Activate; end;
if (View is TfrMemoView) and Assigned(FCurFont) then begin x:=View.x; y:=View.y; for i:=0 to TfrMemoView(View).Memo.Count-1 do begin text:=UTF8ToSys (TfrMemoView(View).Memo[i]); //text:=LConvEncoding.UTF8ToCP936(TfrMemoView(View).Memo.Text,False); if TfrMemoView(View).FirstLine then W:=TfrMemoView(View).Width - TfrMemoView(View).ParagraphGap - InternalGapX * 2 else W:=TfrMemoView(View).Width - InternalGapX * 2; if TfrMemoView(View).Justify and not TfrMemoView(View).LastLine then WriteTextRectJustify(FCurFont, X + InternalGapX, Y, W, View.dy,( Text), true) else WriteTextRect(FCurFont, X + InternalGapX, Y, W, (Text), TfrMemoView(View).Alignment,TfrMemoView(View).Angle); y:=y+ abs(FCurFont.FontSize)+TfrMemoView(View).LineSpacing ; end; end; end;
2024-10-22:
完善DoMemoView功能:
procedure TlrPdfExportFilter.DoMemoView(View: TfrMemoView); var ss,ss1,S,text: String; W,w1,vw: Double; x,y,r,hg,tw:single; i,j,hs,pgap:Integer; ms:TStringList; fl:boolean; function GetTextWidth(str:string):integer; begin FCurFont.FontSize:=View.Font.Size; Result:=ROUND(ConvetUnits1(FCurFont.TextWidth(str))); end; begin DrawRectView(View); S:=TfrMemoView(View).URLInfo; if LazStartsText('HTTP://', S) or LazStartsText('HTTPS://', S) then WriteURL(View.Left, View.Top, View.Width, View.Height, TfrMemoView(View).URLInfo); //prepare font FCurFont:=FFontItems.AddItem(View.Font.Name, View.Font.Style); if Assigned(FCurFont) then begin FCurFont.FontSize:=View.Font.Size; FCurFont.FontColor:=View.Font.Color; FCurFont.Activate; end; if (View is TfrMemoView) and Assigned(FCurFont) then begin x:=View.Left; y:=View.Top; ms:=TStringList.Create; if ((TfrMemoView(View).Flags and 2)<>0) and (TfrMemoView(View).Memo.Count<>0) then //flWordWrap=2 //自动换行 Begin for j:=0 to TfrMemoView(View).Memo.Count-1 do begin //#02<sup></sup> #03<sub></sub> #04取消上下标粗体斜体 #05粗体<b></b> #06下划线<u></u> #07斜体<i></i> ss:=TfrMemoView(View).Memo[j]; ss:=Ss.Replace('<br>', '', [rfReplaceAll]); ss:=Ss.Replace('<sup>', '', [rfReplaceAll]); ss:=ss.Replace ('</sup>', '', [rfReplaceAll]); ss:=ss.Replace ('<sub>', '', [rfReplaceAll]); ss:=ss.Replace ('</sub>', '', [rfReplaceAll]); ss:=ss.Replace ('<b>', '', [rfReplaceAll]); ss:=ss.Replace ('</b>', '', [rfReplaceAll]); ss:=ss.Replace ('<u>', '', [rfReplaceAll]); ss:=ss.Replace ('</u>', '', [rfReplaceAll]); ss:=ss.Replace ('<i>', '', [rfReplaceAll]); ss:=ss.Replace ('</i>', '', [rfReplaceAll]); i:=1; ss1:=''; tw:=GetTextWidth(ss); vw:=View.Width; fl:=true; if tw>vw then begin while i<=UTF8Length(ss) do begin if fl then pgap:= round(GetTextWidth('国')*TfrMemoView(View).ParagraphGap) else pgap:=0; if GetTextWidth(ss1+Utf8Copy(ss,i+1,1))+pgap<View.Width-View.GapX*2-View.FrameWidth then Begin ss1:=ss1+Utf8Copy(ss,i,1); end else begin ms.Add(ss1); ss1:=Utf8Copy(ss,i,1); end; inc(i); end; if ss1<>'' then ms.Add(ss1); end else ms.Add(ss); fl:=false; end; end else ms.Assign(TfrMemoView(View).Memo); hs:=ms.Count;;//行数 hg:= ConvetUnits1(FCurFont.TextHeight(ms[0])); if View.Layout=tlTop then //文字垂直对齐--顶 y := y + View.gapy; if View.Layout=tlCenter then //文字垂直对齐--中 y := y + View.dy/2-((hg+TfrMemoView(View).LineSpacing)*hs)/2; if View.Layout=tlBottom then //文字垂直对齐--底 y := y + View.dy - View.gapy - 5 - (hg+TfrMemoView(View).LineSpacing)*hs; fl:=true; for i:=0 to ms.Count-1 do begin if fl then pgap:= round(GetTextWidth('国')*TfrMemoView(View).ParagraphGap) else pgap:=0; text:=ms[i]; if TfrMemoView(View).FirstLine then W:=TfrMemoView(View).Width - TfrMemoView(View).ParagraphGap - InternalGapX * 2 else W:=TfrMemoView(View).Width - InternalGapX * 2; if TfrMemoView(View).Justify and not TfrMemoView(View).LastLine then WriteTextRectJustify(FCurFont, X +pgap+ InternalGapX, Y, W, View.dy,( Text), true) else WriteTextRect(FCurFont, X +pgap+ InternalGapX, Y, W, (Text), TfrMemoView(View).Alignment,TfrMemoView(View).Angle); y:=y+ ConvetUnits1(FCurFont.TextHeight(Text))+TfrMemoView(View).LineSpacing ; fl:=false; end; end; end;
修改后,重新编译安装lrPDFExport插件就可以。
【推荐】国内首个AI IDE,深度理解中文开发场景,立即下载体验Trae
【推荐】编程新体验,更懂你的AI,立即体验豆包MarsCode编程助手
【推荐】抖音旗下AI助手豆包,你的智能百科全书,全免费不限次数
【推荐】轻量又高性能的 SSH 工具 IShell:AI 加持,快人一步
· TypeScript + Deepseek 打造卜卦网站:技术与玄学的结合
· Manus的开源复刻OpenManus初探
· AI 智能体引爆开源社区「GitHub 热点速览」
· 从HTTP原因短语缺失研究HTTP/2和HTTP/3的设计差异
· 三行代码完成国际化适配,妙~啊~