Recent

Author Topic: Setting text background color when using canvas.TextRect  (Read 631 times)

scribly

  • Jr. Member
  • **
  • Posts: 68
Setting text background color when using canvas.TextRect
« on: April 08, 2019, 11:06:13 pm »
I've got a customcontrol on which I draw using a canvas.
The screen is currently white, and the canvas brush.color is set to red and brush.style is set to bsSolid , but the background of the text stays white.

Do I have to call fillRect first before calling textRext  ?Or is there another option ?

440bx

  • Hero Member
  • *****
  • Posts: 1127
Re: Setting text background color when using canvas.TextRect
« Reply #1 on: April 08, 2019, 11:38:49 pm »
Disclaimer: I know nothing about the LCL but something like this
Code: Pascal  [Select]
  1. SetBkMode(Canvas.Handle,TRANSPARENT);
might solve the problem.

using FPC v3.0.4 and Lazarus 1.8.2 on Windows 7 64bit.

lucamar

  • Hero Member
  • *****
  • Posts: 2018
Re: Setting text background color when using canvas.TextRect
« Reply #2 on: April 08, 2019, 11:49:36 pm »
Use the full form of TextRect and make
  Style.Opaque := True;
or simply set:
  Canvas.TextStyle.Opaque := True;
that is:
Code: Pascal  [Select]
  1. var
  2.   Style: TTextStyle;
  3. [... more code ...]
  4.   Style.Opaque := True;
  5.   { Set other Style members as you see fit ... }
  6.   Canvas.TextRext(ARect,  X, Y, 'My Text', Style);
  7.  
  8. { ALTERNATIVELY, just set the TextStyle of the Canvas:
  9.   Canvas.TextStyle.Opaque := True;
  10.   Canvas.TextRext(ARect,  X, Y, 'My Text');
  11. }
« Last Edit: April 08, 2019, 11:57:59 pm by lucamar »
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus 2.0.2/2.0.4  - FPC 3.0.4 on:
(K|L)Ubuntu 12..16, Windows XP SP3, various DOSes.

scribly

  • Jr. Member
  • **
  • Posts: 68
Re: Setting text background color when using canvas.TextRect
« Reply #3 on: April 09, 2019, 07:39:19 am »
Thanks

Though one big issue is that when using a textrect that's higher than the text itself, the color under it will change as well (also the background after the text). Even if it's multiple lines.  I just need the textpart to have the background color, not the rect that's being written in (Multiple textrect calls with different colors in the same rect)

So I'm ending up specifying a rect with just the textheight and width of the string i'm going to write, within the provided rect region, bringing me back to similarly calling fillcanvas on the textpart
« Last Edit: April 09, 2019, 08:17:53 am by scribly »

wp

  • Hero Member
  • *****
  • Posts: 6231
Re: Setting text background color when using canvas.TextRect
« Reply #4 on: April 09, 2019, 10:29:13 am »
The following user-defined TCustomControl displays the text background color correctly out of the box. Please show more of you code.
Code: Pascal  [Select]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs;
  9.  
  10. type
  11.   TMyControl = class(TCustomControl)
  12.   private
  13.     FTextBackground: TColor;
  14.     procedure SetTextBackground(AValue: TColor);
  15.   protected
  16.     procedure Paint; override;
  17.   published
  18.     constructor Create(AOwner: TComponent); override;
  19.     property Caption;
  20.     property Color;
  21.     property TextBackground: TColor read FTextBackground write SetTextBackground;
  22.   end;
  23.  
  24.   { TForm1 }
  25.  
  26.   TForm1 = class(TForm)
  27.     procedure FormCreate(Sender: TObject);
  28.   private
  29.  
  30.   public
  31.  
  32.   end;
  33.  
  34. var
  35.   Form1: TForm1;
  36.  
  37. implementation
  38.  
  39. {$R *.lfm}
  40.  
  41. { TForm1 }
  42.  
  43. procedure TForm1.FormCreate(Sender: TObject);
  44. begin
  45.   with TMyControl.Create(self) do begin
  46.     Left := 10;
  47.     Top := 10;
  48.     Width := 200;
  49.     Height := 100;
  50.     Caption := 'Hallo world';
  51.     Color := clYellow;
  52.     TextBackground := clRed;
  53.     Parent := Self;
  54.   end;
  55. end;
  56.  
  57. constructor TMyControl.Create(AOwner: TComponent);
  58. begin
  59.   inherited;
  60.   FTextBackground := Color;
  61. end;
  62.  
  63. procedure TMyControl.Paint;
  64. begin
  65.   with Canvas do begin
  66.     Brush.Color := Self.Color;
  67.     Brush.Style := bsSolid;
  68.     FillRect(0, 0, ClientWidth, ClientHeight);
  69.  
  70.     Brush.Color := FTextBackground;
  71.     Font.Assign(Self.Font);
  72.     TextOut(0, 0, Caption);
  73.   end;
  74. end;
  75.  
  76. procedure TMyControl.SetTextBackground(AValue: TColor);
  77. begin
  78.   if FTextBackground = AValue then exit;
  79.   FTextBackground := AValue;
  80.   Invalidate;
  81. end;
  82.  
  83. end.
Lazarus trunk / fpc 3.0.4 / all 32-bit on Win-10

scribly

  • Jr. Member
  • **
  • Posts: 68
Re: Setting text background color when using canvas.TextRect
« Reply #5 on: April 09, 2019, 05:19:20 pm »
Replace your Paint with this code and you'll see what I mean
Code: Pascal  [Select]
  1. procedure TMyControl.Paint;
  2. var style: TTextStyle;
  3. begin
  4.   with Canvas do begin
  5.     Brush.Color := Self.Color;
  6.     Brush.Style := bsSolid;
  7.     FillRect(0, 0, ClientWidth, ClientHeight);
  8.  
  9.     Brush.Color := FTextBackground;
  10.     Font.Assign(Self.Font);
  11.  
  12.     //I only want to the text to be within the topleft corner
  13.     style:=canvas.TextStyle;
  14.  
  15.     style.Opaque:=true;
  16.  
  17.     TextRect(rect(0,0,ClientWidth div 2, ClientHeight div 2),0,20, 'This is a long piece of text that will not fit in the small space provided by the rect',  Style);
  18.     TextRect(rect(0,0,ClientWidth div 2, ClientHeight div 2),0,0, 'This is another long piece of text that will not fit in the small space provided by the rect',  Style);
  19.  
  20.   end;
  21. end;  
  22.  
I like the autocut off that TextRect does, but apparently it also fills the whole region with the color if opaque
Anyhow, just calculating the height and width of the text first and then draw a rectangle for just those strings will work as well
« Last Edit: April 09, 2019, 05:46:42 pm by scribly »

lucamar

  • Hero Member
  • *****
  • Posts: 2018
Re: Setting text background color when using canvas.TextRect
« Reply #6 on: April 09, 2019, 09:55:04 pm »
I like the autocut off that TextRect does, but apparently it also fills the whole region with the color if opaque

Take into account that TextRect() basically just draws a filled rectangle as specified by ARect and renders the text into it as specified by the rest of parameters. The behaviour you're seeing is exactly as it should be.

Of course, you can use TextExtent() to define ARect or, maybe better, change to TextOut(), as wp did.
« Last Edit: April 09, 2019, 10:03:18 pm by lucamar »
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus 2.0.2/2.0.4  - FPC 3.0.4 on:
(K|L)Ubuntu 12..16, Windows XP SP3, various DOSes.

wp

  • Hero Member
  • *****
  • Posts: 6231
Re: Setting text background color when using canvas.TextRect
« Reply #7 on: April 09, 2019, 10:13:05 pm »
If you want wordwrap with colored text background you can use TextRect with adapted TextStyle, too. Turn clipping off and set the height of the rectangle to zero:
Code: Pascal  [Select]
  1. procedure TMyControl.Paint;
  2. var
  3.   style: TTextStyle;
  4.   R: TRect;
  5. begin
  6.   with Canvas do begin
  7.     Brush.Color := Self.Color;
  8.     Brush.Style := bsSolid;
  9.     FillRect(0, 0, ClientWidth, ClientHeight);
  10.  
  11.     style := TextStyle;
  12.     style.Opaque := true;
  13.     style.WordBreak := true;
  14.     style.SingleLine := false;
  15.     style.Clipping := false;
  16.  
  17.     R := Rect(0, 0, ClientWidth, 0);
  18.  
  19.     Font.Assign(Self.Font);
  20.     Brush.Color := FTextBackground;
  21.     TextRect(R, 0, 0, Caption, style);
  22.   end;
  23. end;
  24.  
  25. procedure TForm1.FormCreate(Sender: TObject);
  26. begin
  27.   with TMyControl.Create(self) do begin
  28.     Left := 10;
  29.     Top := 10;
  30.     Width := 200;
  31.     Height := 100;
  32.     Caption := 'This is a long piece of text that will not fit in the small space provided by the rect';
  33.     Color := clYellow;
  34.     TextBackground := clRed;
  35.     Parent := Self;
  36.   end;
  37. end;
Lazarus trunk / fpc 3.0.4 / all 32-bit on Win-10