秋·风

  博客园 :: 首页 :: 博问 :: 闪存 :: 新随笔 :: 联系 :: 订阅 订阅 :: 管理 ::
  278 随笔 :: 0 文章 :: 308 评论 :: 20万 阅读
< 2025年3月 >
23 24 25 26 27 28 1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30 31 1 2 3 4 5
lazreport的pdf导出插件lrPDFExport缺失MemoView功能,导出的报表如有TfrMemoView,生成的pdf会直接丢弃TfrMemoView的文字,原TfrMemoView的位置出现空白。

 导出的pdf:

修复步骤: 
打开Lazreport\source\addons\lrFclPDFExport\lr_e_fclpdf.pas

原lr_e_fclpdf.pas的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;
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插件就可以。

 

posted on   秋·风  阅读(101)  评论(0编辑  收藏  举报
相关博文:
阅读排行:
· TypeScript + Deepseek 打造卜卦网站:技术与玄学的结合
· Manus的开源复刻OpenManus初探
· AI 智能体引爆开源社区「GitHub 热点速览」
· 从HTTP原因短语缺失研究HTTP/2和HTTP/3的设计差异
· 三行代码完成国际化适配,妙~啊~
点击右上角即可分享
微信分享提示