Recent

Author Topic: LazReport bold font to a word into a memo (memo report)  (Read 439 times)

cpalx

  • Hero Member
  • *****
  • Posts: 728
LazReport bold font to a word into a memo (memo report)
« on: July 20, 2022, 09:10:04 pm »
Is it posible, tgo format a word in bold into a memo report

somethink like this

this is the bold word

korba812

  • Sr. Member
  • ****
  • Posts: 307
Re: LazReport bold font to a word into a memo (memo report)
« Reply #1 on: July 21, 2022, 12:02:04 am »
Unfortunately, this is currently not possible. To achieve this you have to use separate memo objects with different font styles.

cpalx

  • Hero Member
  • *****
  • Posts: 728
Re: LazReport bold font to a word into a memo (memo report)
« Reply #2 on: July 21, 2022, 03:37:34 pm »
Thanks

Nicola Gorlandi

  • Full Member
  • ***
  • Posts: 119
Re: LazReport bold font to a word into a memo (memo report)
« Reply #3 on: September 03, 2022, 08:04:50 am »
I did it using an html like notation in the memo, e.g. <br>Bolded text<br> changhing the source code in lr_class unit

See the method below, the cahnges are under k6 comments.

It is not perfect but it coluld be a starting point.

Code: Pascal  [Select][+][-]
  1. procedure TfrCustomMemoView.ShowMemo;
  2. var
  3.   DR         : TRect;
  4.   SavX,SavY  : Integer;
  5.  
  6.   procedure OutMemo;
  7.   var
  8.     i: Integer;
  9.     curyf, thf, linespc: double;
  10.     FTmpFL:boolean;
  11.  
  12.     function OutLine(st: String): Boolean;
  13.     var
  14.       {$IFDEF DebugLR}
  15.       aw: Integer;
  16.       {$ENDIF}
  17.       cond: boolean;
  18.       n, {nw, w, }curx, lasty: Integer;
  19.       lastyf: Double;
  20.       Ts: TTextStyle;
  21.       //K6
  22. bAddedBold, bAddedUnderline:boolean;
  23.       //K6
  24.     begin
  25.       lastyf := curyf + thf - LineSpc - 1;
  26.       lastY := Round(lastyf);
  27.       cond := not streaming and (lasty<=DR.Bottom);
  28.       {$IFDEF DebugLR_detail}
  29.       DebugLn('OutLine curyf=%f + thf=%f - gapy=%d = %f (%d) <= dr.bottom=%d == %s',
  30.         [curyf,thf,gapy,lastyf,lasty,dr.bottom,dbgs(Cond)]);
  31.       {$ENDIF}
  32.       if not Streaming and cond then
  33.       begin
  34.         n := Length(St);
  35.         //w := Ord(St[n - 1]) * 256 + Ord(St[n]);
  36.         LastLine := true;
  37.         SetLength(St, n - 2);
  38.         if Length(St) > 0 then
  39.         begin
  40.           FTmpFL:=false;
  41.           if St[Length(St)] = #1 then
  42.           begin
  43.             FTmpFL:=true;
  44.             SetLength(St, Length(St) - 1);
  45.           end
  46.           else
  47.             LastLine := false;
  48.         end;
  49.  
  50.         // handle any alignment with same code
  51.         Ts := Canvas.TextStyle;
  52.         Ts.Layout    :=tlTop;
  53.         Ts.Alignment := taLeftJustify;
  54.         Ts.Wordbreak :=false;
  55.         Ts.SingleLine:=True;
  56.         Ts.Clipping  :=True;
  57.         Canvas.TextStyle := Ts;
  58.         //K6
  59.         // se il testo inizia per <b> allora lo metto bold..
  60.  
  61.         bAddedBold:=false;
  62.         bAddedUnderline:=false;
  63.         try
  64.  
  65.  
  66.           if LowerCase(St).StartsWith('<b>') then
  67.              begin
  68.               if not(fsBold in Canvas.Font.Style) then
  69.                begin
  70.                  Canvas.Font.Style :=  Canvas.Font.Style+ [fsBold];
  71.                  bAddedBold:=true;
  72.                end;
  73.  
  74.               // rimuovo dal testo <b> e </b>
  75.               St:=St.Replace('<b>','');
  76.               St:=St.Replace('</b>','');
  77.              end;
  78.  
  79.           if LowerCase(St).StartsWith('<u>') then
  80.              begin
  81.               if not(fsUnderline in Canvas.Font.Style) then
  82.                begin
  83.                  Canvas.Font.Style :=  Canvas.Font.Style+ [fsUnderline];
  84.                  bAddedUnderline:=true;
  85.                end;
  86.  
  87.               // rimuovo dal testo <b> e </b>
  88.               St:=St.Replace('<u>','');
  89.               St:=St.Replace('</u>','');
  90.              end;
  91.  
  92.  
  93.         // k6
  94.         (*
  95.         // the disabled code allows for text-autofitting adjusting font size
  96.         // TODO: waiting for users mising this and make it an option or remove it
  97.         nw := Round(w * ScaleX);                    // needed width
  98.         {$IFDEF DebugLR_detail}
  99.         DebugLn('TextWidth=%d st=%s',[Canvas.TextWidth(St),copy(st, 1, 20)]);
  100.         {$ENDIF}
  101.         while (Canvas.TextWidth(St) > nw) and (Canvas.Font.Size>1) do
  102.         begin
  103.           Canvas.Font.Size := Canvas.Font.Size-1;
  104.           {$IFDEF DebugLR}
  105.           DebugLn('Rescal font %d',[Canvas.Font.Size]);
  106.           {$ENDIF}
  107.         end;
  108.         {$IFDEF DebugLR_detail}
  109.         Debugln('Canvas.Font.Size=%d TextWidth=%d',[Canvas.Font.Size,Canvas.TextWidth(St)]);
  110.         aw := Canvas.TextWidth(St);                // actual width
  111.         DebugLn('nw=%d  aw=%d',[nw,aw]);
  112.         {$ENDIF}
  113.         *)
  114.         case Alignment of
  115.           Classes.taLeftJustify : CurX :=x+InternalGapX;
  116.           Classes.taRightJustify: CurX :=x+dx-1-InternalGapX-Canvas.TextWidth(St);
  117.           Classes.taCenter      : CurX :=x+InternalGapX+(dx-InternalGapX-InternalGapX-Canvas.TextWidth(St)) div 2;
  118.         end;
  119.  
  120.         if not Exporting then
  121.         begin
  122.           if Justify and not LastLine then
  123.           begin
  124.             if FirstLine then
  125.               CanvasTextRectJustify(Canvas, DR, x+InternalGapX + FParagraphGap, x+dx-1-InternalGapX, round(CurYf), St, true)
  126.             else
  127.               CanvasTextRectJustify(Canvas, DR, x+InternalGapX, x+dx-1-InternalGapX, round(CurYf), St, true)
  128.           end
  129.           else
  130.           begin
  131.             if FirstLine then
  132.               Canvas.TextRect(DR, CurX + FParagraphGap, round(curYf), St)
  133.             else
  134.               Canvas.TextRect(DR, CurX, round(curYf), St);
  135.           end;
  136.         end
  137.         else
  138.         begin
  139.           if FirstLine then
  140.             CurReport.InternalOnExportText(X + FParagraphGap, round(curYf), St, Self)
  141.           else
  142.             CurReport.InternalOnExportText(X, round(curYf), St, Self);
  143.         end;
  144.  
  145.         // k6
  146.         finally
  147.           if bAddedBold then  Canvas.Font.Style :=  Canvas.Font.Style- [fsBold];
  148.           if bAddedUnderline  then  Canvas.Font.Style :=  Canvas.Font.Style- [fsUnderline];
  149.         end;
  150.         //K6
  151.  
  152.         Inc(CurStrNo);
  153.         Result := False;
  154.       end
  155.       else
  156.         Result := True;
  157.  
  158.       curyf := curyf + thf;
  159.       FirstLine:=FTmpFL;
  160.     end;
  161.  
  162.   begin {OutMemo}
  163.     if Alignment in [Classes.taLeftJustify..Classes.taCenter] then
  164.     begin
  165.       if Layout=tlCenter then
  166.         y:=y+(dy-VHeight) div 2
  167.       else
  168.       if Layout=tlBottom then
  169.         y:=y+dy-VHeight;
  170.     end;
  171.     curyf := y + InternalGapY;
  172.  
  173.     LineSpc := LineSpacing * ScaleY;
  174.     // calc our reference at 100% and then scale it
  175.     // NOTE: this should not be r((Self.Font.Size*96/72 + LineSpacing)*ScaleY)
  176.     //       as our base at 100% is rounded.
  177.     if Self.Font.Size = 0 then
  178.       i := Round((-GetFontData(Self.Font.Handle).Height * 72 / Self.Font.PixelsPerInch))
  179.     else
  180.       i := Self.Font.Size;
  181.     thf := Round(i*96/72 + LineSpacing)* ScaleY;
  182.     // Corrects font height, that's the total line height minus the scaled linespacing
  183.     Canvas.Font.Height := -Round(thf - LineSpc);
  184.     {$IFDEF DebugLR}
  185.     DebugLn('curyf=%f thf=%f Font.height=%d TextHeight(H)=%d DR=%s Memo1.Count=%d',
  186.       [curyf, thf, Canvas.Font.Height, Canvas.Textheight('H'), dbgs(DR), Memo1.Count]);
  187.     {$ENDIF}
  188.     CurStrNo := 0;
  189.  
  190.     FirstLine:=true;
  191.  
  192.     for i := 0 to Memo1.Count - 1 do
  193.       if OutLine(Memo1[i]) then
  194.         break;
  195.  
  196.     {$IFDEF DebugLR}
  197.     DebugLn('CurStrNo=%d CurYf=%f Last"i"=%d',[CurStrNo, CurYf, i]);
  198.     {$ENDIF}
  199.   end;
  200.  
  201.  

 

TinyPortal © 2005-2018