Creating visual components

[geraldholdsworth]

I've been tinkering with creating my own components. So far, been successful having managed to create my own version of a Tick Box, Radio Box, Coloured Slider and Buttons. But I'm now onto something a bit more ambitious - a TMemo style with coloured text (OK, doesn't need to be editable, so read only is fine).

Before you ask, I have tried RichMemo and SynEdit and I either can't get on with them or they don't serve my purpose. Plus, this is also a learning curve - would you believe that after 30-odd years of programming with Delphi and Lazarus I've only just recently taken up creating components?

Oh yes, I have had a look at this.

OK, what I've got so far:

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls;
9.  
10. type
11.  
12.  TColouredMemo = class(TGraphicControl)
13.  private
14.   FLines    : TStringList;
15.   FLineSpace: Cardinal;
16.   FIndent   : Cardinal;
17.  protected
18.   procedure Paint; override;
19.   property Canvas;
20.  public
21.   constructor Create(AOwner: TComponent); override;
22.   destructor Destroy; override;
23.  published
24.   property Indent    : Cardinal    read FIndent    write FIndent;
25.   property Lines     : TStringList read FLines     write FLines;
26.   property LineSpace : Cardinal    read FLineSpace write FLineSpace;
27.  end;
28.  
29.  { TForm1 }
30.  
31.  TForm1 = class(TForm)
32.   Button1: TButton;
33.   Memo1: TColouredMemo;
34.   Panel1: TPanel;
35.   procedure Button1Click(Sender: TObject);
36.   procedure FormCreate(Sender: TObject);
37.   procedure FormShow(Sender: TObject);
38.  private
39.  
40.  public
41.  
42.  end;
43.  
44. var
45.  Form1: TForm1;
46.  
47. implementation
48.  
49. {$R *.lfm}
50.  
51. { TForm1 }
52.  
53. procedure TForm1.FormCreate(Sender: TObject);
54. begin
55.  Memo1:=TColouredMemo.Create(Form1);
56.  Memo1.Parent:=Form1;
57.  Memo1.Align:=alClient;
58.  Memo1.Visible:=True;
59. end;
60.  
61. procedure TForm1.Button1Click(Sender: TObject);
62. begin
63.  Memo1.Lines.Add('Some more text');
64. end;
65.  
66. procedure TForm1.FormShow(Sender: TObject);
67. begin
68.  Memo1.Lines.Add('Some'+#$81#$00#$00#$FF+' red'+#$82#$01+' bold'+#$81#$00#$00#$00#$82#$00+' text');
69.  Memo1.Lines.Add('');
70.  Memo1.Lines.Add('Some'+#$81#$FF#$00#$00+' blue'+#$82#$02+' italic'+#$81#$00#$00#$00#$82#$00+' text');
71.  Memo1.Lines.Add('');
72.  Memo1.Lines.Add('Some'+#$81#$00#$77#$00+' green'+#$82#$03+' bold italic'+#$81#$00#$00#$00#$82#$00+' text');
73. end;
74.  
75. //--------------------- TColouredMemo definitions -----------------------
76.  
77. constructor TColouredMemo.Create(AOwner: TComponent);
78. begin
79.  inherited Create(AOwner);
80.  //Create the line container
81.  FLines:=TStringList.Create;
82.  //Defaults
83.  FLineSpace:=4; //Space between lines, in pixels
84.  FIndent:=4;    //Indent in from the left, in pixels
85.  Color:=clWhite;//Default background colour
86.  Font.Name:='Courier New';//Default font
87. end;
88.  
89. destructor TColouredMemo.Destroy;
90. begin
91.  inherited;
92. end;
93.  
94. procedure TColouredMemo.Paint;
95. var
96.  LLine,
97.  LIndex,
98.  XPos,
99.  YPos   : Integer;
100.  LPart,
101.  LText  : String;
102.  LRed,
103.  LGreen,
104.  LBlue  : Byte;
105. begin
106.  //Clear the background
107.  Canvas.Brush.Color:=Color;
108.  Canvas.Brush.Style:=bsSolid;
109.  Canvas.Pen.Color:=Color;
110.  Canvas.Pen.Style:=psSolid;
111.  Canvas.Rectangle(0,0,Width,Height);
112.  //Are there any lines entered?
113.  if FLines.Count>0 then
114.  begin
115.   //Start at the top
116.   YPos:=FLineSpace;
117.   //Work our way through the lines
118.   for LLine:=0 to FLines.Count-1 do
119.   begin
120.    //Default font colour
121.    Canvas.Font.Color:=clBlack;
122.    //No styles
123.    Canvas.Font.Style:=[];
124.    //Transparent background
125.    Canvas.Brush.Style:=bsClear;
126.    //Get the current line
127.    LText:=FLines[LLine];
128.    //If it is empty, put a space in so we get a blank line
129.    if LText='' then LText:=' ';
130.    //Indent it
131.    XPos:=FIndent;
132.    //Clear the 'part of' string
133.    LPart:='';
134.    //Start at the beginning
135.    LIndex:=1;
136.    while LIndex<=Length(LText) do
137.    begin
138.     //Top bit set? Then this means a change of style or colour
139.     if(ord(LText[LIndex])and$80)=$80 then
140.     begin
141.      //Output what we currently have
142.      if LPart<>'' then
143.      begin
144.       Canvas.TextOut(XPos,YPos,LPart);
145.       inc(XPos,Canvas.TextWidth(LPart));
146.      end;
147.      //New part of string
148.      LPart:='';
149.      //Change of colour
150.      if(ord(LText[LIndex])AND$01)=$01 then
151.      begin
152.       //Get the Blue index
153.       inc(LIndex);
154.       if LIndex<=Length(LText) then LBlue :=ord(LText[LIndex]);
155.       //Get the Green index
156.       inc(LIndex);
157.       if LIndex<=Length(LText) then LGreen:=ord(LText[LIndex]);
158.       //Get the Red index
159.       inc(LIndex);
160.       if LIndex<=Length(LText) then LRed  :=ord(LText[LIndex]);
161.       //Set the colour
162.       Canvas.Font.Color:=LRed+LGreen<<8+LBlue<<16;
163.      end;
164.      //Change of style
165.      if(ord(LText[LIndex])AND$02)=$02 then
166.      begin
167.       inc(LIndex);
168.       if LIndex<=Length(LText) then
169.       begin
170.        //Bold
171.        if(ord(LText[LIndex])AND$01)=$01 then
172.         Canvas.Font.Style:=Canvas.Font.Style+[fsBold]
173.        else //No Bold
174.         Canvas.Font.Style:=Canvas.Font.Style-[fsBold];
175.        //Italic
176.        if(ord(LText[LIndex])AND$02)=$02 then
177.         Canvas.Font.Style:=Canvas.Font.Style+[fsItalic]
178.        else //No Italic
179.         Canvas.Font.Style:=Canvas.Font.Style-[fsItalic];
180.       end;
181.      end;
182.     end;
183.     //Valid ASCII character? add it to the 'part of' string
184.     if(ord(LText[LIndex])>31)and(ord(LText[LIndex])<127)then
185.      LPart:=LPart+LText[LIndex];
186.     //Next character
187.     inc(LIndex);
188.    end;
189.    //Anything left that hasn't been printed?
190.    if LPart<>'' then Canvas.TextOut(XPos,YPos,LPart);
191.    //Move the Y pointer downwards
192.    inc(YPos,Canvas.TextHeight(LText)+FLineSpace);
193.   end;
194.  end;
195. end;
196.  
197. end.
198.  

It works - unless you add a line on the fly (i.e., click the button)...so need to work out how to repaint when the TStringList changes. I've tried to assign the Paint procedure to the TStringList OnChange event, but it didn't like it...and what if the user assigns something to this same event? One or the other will get overridden. But, the main thing is adding scroll bars when the content is bigger than the available space.

I think I need to create a container component and then create a child TScrollBox and child TGraphicControl (or TCanvas) inside this. I have tried this approach, but failed miserably. Plus, when I create the TScrollBox inside the component's Create method, what do I give it as the parent?

Or, do I leave this as is, then create another component that encapsulates this and a TScrollBox?
(although, I think I need a bit of code to determine the overall size of the content control based on the contents of the TStringList).

[simone]

Have you tried to use TScrollingWinControl instead of TGraphicControl as parent class of TColouredMemo?

Can you upload a compilable project? Otherwise whoever wants to help you has to rebuild your project by hand.

[geraldholdsworth]

I'll try TScrollingWinControl, see how far I get.

I tried to base the control off a TMemo and put a canvas over the top...but TMemo has no Paint method, so that failed.

Project attached.

[Onur2x]

There are customdrawn components in lazarus for this, you can check them out. And if you want to take advantage of the githup page where I'm trying to improve these components a bit, here's the link..
https://github.com/Onur2x/onurcomp
good luck

[simone]

It works - unless you add a line on the fly (i.e., click the button)...so need to work out how to repaint when the TStringList changes. I've tried to assign the Paint procedure to the TStringList OnChange event, but it didn't like it...and what if the user assigns something to this same event? One or the other will get overridden.

For the first problem, I would use an extended TStringList type (named TExtStringList in my code), privately defined in TColouredMemo, with the Add method (which is virtual) overridden such that it update the canvas of the associated TColouredMemo instance (that is a field of TExtStringList), when text is added.

Moreover, in general I would use the 'Invalidate' method, rather than 'Paint', to redraw the component when there are changes.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls;
9.  
10. type
11.  
12.  TColouredMemo = class(TGraphicControl) //
13.  private //
14.   type //
15.     TExtStringList=class(TStringList) //
16.       FColouredMemo : TColouredMemo; //
17.       function Add(const S: string): Integer; override; //
18.     end; //
19.   var
20.     FLines    : TExtStringList; //
21.     FLineSpace: Cardinal;
22.     FIndent   : Cardinal;
23.  protected
24.   procedure Paint; override;
25.   procedure SetLines(const AValue: TExtStringList); //
26.   property Canvas;
27.  public
28.   constructor Create(AOwner: TComponent); override;
29.   destructor Destroy; override;
30.  published
31.   property Indent    : Cardinal    read FIndent    write FIndent;
32.   property Lines     : TExtStringList read FLines     write SetLines; //
33.   property LineSpace : Cardinal    read FLineSpace write FLineSpace;
34.  end;
35.  
36.  { TForm1 }
37.  
38.  TForm1 = class(TForm)
39.   Button1: TButton;
40.   MyMemo: TColouredMemo;
41.   Panel1: TPanel;
42.   procedure Button1Click(Sender: TObject);
43.   procedure FormCreate(Sender: TObject);
44.   procedure FormShow(Sender: TObject);
45.  private
46.  
47.  public
48.  
49.  end;
50.  
51. var
52.  Form1: TForm1;
53.  
54. implementation
55.  
56. {$R *.lfm}
57.  
58. { TColouredMemo.TExtStringList }
59.  
60. function TColouredMemo.TExtStringList.Add(const S: string): Integer; //
61. begin //
62.   Result:=inherited Add(S); //
63.   if Assigned(FColouredMemo) then //
64.     FColouredMemo.Invalidate; //
65. end; //
66.  
67. { TForm1 }
68.  
69. procedure TForm1.FormCreate(Sender: TObject);
70. begin
71.  MyMemo:=TColouredMemo.Create(Form1);
72.  MyMemo.Parent:=Form1;
73.  MyMemo.Align:=alClient;
74.  MyMemo.Visible:=True;
75. end;
76.  
77. procedure TForm1.Button1Click(Sender: TObject);
78. begin
79.  MyMemo.Lines.Add('Some more text');
80. // ShowMessage(IntToStr(Memo1.VertScrollBar.Range)+'x'+IntToStr(Memo1.HorzScrollBar.Range));
81. end;
82.  
83. procedure TForm1.FormShow(Sender: TObject);
84. begin
85.  MyMemo.Lines.Add('Some'+#$81#$00#$00#$FF+' red'+#$82#$01+' bold'+#$81#$00#$00#$00#$82#$00+' text');
86.  MyMemo.Lines.Add('');
87.  MyMemo.Lines.Add('Some'+#$81#$FF#$00#$00+' blue'+#$82#$02+' italic'+#$81#$00#$00#$00#$82#$00+' text');
88.  MyMemo.Lines.Add('');
89.  MyMemo.Lines.Add('Some'+#$81#$00#$77#$00+' green'+#$82#$03+' bold italic'+#$81#$00#$00#$00#$82#$00+' text');
90. end;
91.  
92. //--------------------- TColouredMemo definitions -----------------------
93.  
94. constructor TColouredMemo.Create(AOwner: TComponent);
95. begin
96.  inherited Create(AOwner);
97.  //Create the line container
98.  FLines:=TExtStringList.Create; //
99.  FLines.FColouredMemo:=self; //
100.  //Defaults
101.  FLineSpace:=4; //Space between lines, in pixels
102.  FIndent:=4;    //Indent in from the left, in pixels
103.  Color:=clWhite;//Default background colour
104.  Font.Name:='Courier New';//Default font
105.  
106. end;
107.  
108. destructor TColouredMemo.Destroy;
109. begin
110.  inherited Destroy;
111. end;
112.  
113. procedure TColouredMemo.Paint;
114. var
115.  LLine,
116.  LIndex,
117.  XPos,
118.  YPos   : Integer;
119.  LPart,
120.  LText  : String;
121.  LRed,
122.  LGreen,
123.  LBlue  : Byte;
124. begin
125.  //Clear the background
126.  Canvas.Brush.Color:=Color;
127.  Canvas.Brush.Style:=bsSolid;
128.  Canvas.Pen.Color:=Color;
129.  Canvas.Pen.Style:=psSolid;
130.  Canvas.Rectangle(0,0,Width,Height);
131.  //Are there any lines entered?
132.  if FLines.Count>0 then
133.  begin
134.   //Start at the top
135.   YPos:=FLineSpace;
136.   //Work our way through the lines
137.   for LLine:=0 to FLines.Count-1 do
138.   begin
139.    //Default font colour
140.    Canvas.Font.Color:=clBlack;
141.    //No styles
142.    Canvas.Font.Style:=[];
143.    //Transparent background
144.    Canvas.Brush.Style:=bsClear;
145.    //Get the current line
146.    LText:=FLines[LLine];
147.    //If it is empty, put a space in so we get a blank line
148.    if LText='' then LText:=' ';
149.    //Indent it
150.    XPos:=FIndent;
151.    //Clear the 'part of' string
152.    LPart:='';
153.    //Start at the beginning
154.    LIndex:=1;
155.    while LIndex<=Length(LText) do
156.    begin
157.     //Top bit set? Then this means a change of style or colour
158.     if(ord(LText[LIndex])and$80)=$80 then
159.     begin
160.      //Output what we currently have
161.      if LPart<>'' then
162.      begin
163.       Canvas.TextOut(XPos,YPos,LPart);
164.       inc(XPos,Canvas.TextWidth(LPart));
165.      end;
166.      //New part of string
167.      LPart:='';
168.      //Change of colour
169.      if(ord(LText[LIndex])AND$01)=$01 then
170.      begin
171.       //Get the Blue index
172.       inc(LIndex);
173.       if LIndex<=Length(LText) then LBlue :=ord(LText[LIndex]);
174.       //Get the Green index
175.       inc(LIndex);
176.       if LIndex<=Length(LText) then LGreen:=ord(LText[LIndex]);
177.       //Get the Red index
178.       inc(LIndex);
179.       if LIndex<=Length(LText) then LRed  :=ord(LText[LIndex]);
180.       //Set the colour
181.       Canvas.Font.Color:=LRed+LGreen<<8+LBlue<<16;
182.      end;
183.      //Change of style
184.      if(ord(LText[LIndex])AND$02)=$02 then
185.      begin
186.       inc(LIndex);
187.       if LIndex<=Length(LText) then
188.       begin
189.        //Bold
190.        if(ord(LText[LIndex])AND$01)=$01 then
191.         Canvas.Font.Style:=Canvas.Font.Style+[fsBold]
192.        else //No Bold
193.         Canvas.Font.Style:=Canvas.Font.Style-[fsBold];
194.        //Italic
195.        if(ord(LText[LIndex])AND$02)=$02 then
196.         Canvas.Font.Style:=Canvas.Font.Style+[fsItalic]
197.        else //No Italic
198.         Canvas.Font.Style:=Canvas.Font.Style-[fsItalic];
199.       end;
200.      end;
201.     end;
202.     //Valid ASCII character? add it to the 'part of' string
203.     if(ord(LText[LIndex])>31)and(ord(LText[LIndex])<127)then
204.      LPart:=LPart+LText[LIndex];
205.     //Next character
206.     inc(LIndex);
207.    end;
208.    //Anything left that hasn't been printed?
209.    if LPart<>'' then Canvas.TextOut(XPos,YPos,LPart);
210.    //Move the Y pointer downwards
211.    inc(YPos,Canvas.TextHeight(LText)+FLineSpace);
212.   end;
213.  end;
214. end;
215.  
216. procedure TColouredMemo.SetLines(const AValue: TExtStringList); //
217. begin
218.  if AValue<>nil then FLines.Assign(AValue); //
219.  Invalidate; //
220. end;
221.  
222.  
223. end.
224.  

[simone]

Moreover in your code there is a memory leak because the FLines instance created in the constructor of TColouredMemo is not destroyed in the destructor.

So the destructor must be:

Code: Pascal  [Select][+][-]

1. destructor TColoredMemo.Destroy;
2. begin
3.   FLines.Free;
4.   inherited Destroy;
5. end;

[geraldholdsworth]

Cool, thank you simone. I never knew that we could define a class within a class.
I did try FreeAndNil(FLines), but Lazarus didn't like it...never thought of just changing it to FLines.Free.

Thank you Onyr2x - I'll have a browse through that code.

I think I need a parent class to encapsulate TColouredMemo to get the scroll bars...but I've now got some more ideas here on how to proceed. I'll post up if I get it working (for anyone looking to do the same thing in the future).

[simone]

I did try FreeAndNil(FLines), but Lazarus didn't like it...never thought of just changing it to FLines.Free.

if you want, you can also use FreeAndNil in the destructor, as follows:

Code: Pascal  [Select][+][-]

1. destructor TColouredMemo.Destroy;
2. begin
3.  FreeAndNil(Flines);
4.  inherited Destroy;
5. end;

[geraldholdsworth]

I am happy to say that I (with thanks to you guys) have managed to get scroll bars. I've created another control inside the TScrollingWinControl to handle the canvas. I initially used a TCanvas, but found it wouldn't let me change the size (you can read Width and Height but can't set them). So, I substituted that for a TGraphicControl, but that kept throwing up errors when its Canvas was getting accessed. Finally, I tried a TImage, which works. OK, I could probably do it with a TBitmap instead.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls;
9.  
10. type
11.  
12.  TColouredMemo = class(TScrollingWinControl)
13.  private
14.   type
15.    TExtStringList=class(TStringList)
16.     FColouredMemo : TColouredMemo;
17.     function Add(const S: string): Integer; override;
18.    end;
19.  var
20.   FLines    : TExtStringList;
21.   FLineSpace: Cardinal;
22.   FIndent   : Cardinal;
23.   FContent  : TImage;
24.  protected
25.   procedure Paint; override;
26.   procedure SetLines(const AValue: TExtStringList);
27.  public
28.   constructor Create(AOwner: TComponent); override;
29.   destructor Destroy; override;
30.  published
31.   property Indent    : Cardinal       read FIndent    write FIndent;
32.   property Lines     : TExtStringList read FLines     write SetLines;
33.   property LineSpace : Cardinal       read FLineSpace write FLineSpace;
34.  end;
35.  
36.  { TForm1 }
37.  
38.  TForm1 = class(TForm)
39.   Button1: TButton;
40.   MyMemo: TColouredMemo;
41.   Panel1: TPanel;
42.   procedure Button1Click(Sender: TObject);
43.   procedure FormCreate(Sender: TObject);
44.   procedure FormShow(Sender: TObject);
45.  private
46.  
47.  public
48.  
49.  end;
50.  
51. var
52.  Form1: TForm1;
53.  
54. implementation
55.  
56. {$R *.lfm}
57.  
58. { TForm1 }
59.  
60. procedure TForm1.FormCreate(Sender: TObject);
61. begin
62.  MyMemo:=TColouredMemo.Create(Form1);
63.  MyMemo.Parent:=Form1;
64.  MyMemo.Align:=alClient;
65.  MyMemo.Visible:=True;
66.  MyMemo.AutoScroll:=True;
67.  MyMemo.Font.Name:='Courier New';
68. end;
69.  
70. procedure TForm1.Button1Click(Sender: TObject);
71. begin
72.  MyMemo.Lines.Add('Some more text');
73. end;
74.  
75. procedure TForm1.FormShow(Sender: TObject);
76. begin
77.  MyMemo.Lines.Add('Some'+#$81#$00#$00#$FF+' red'+#$82#$01+' bold'+#$81#$00#$00#$00#$82#$00+' text');
78.  MyMemo.Lines.Add('');
79.  MyMemo.Lines.Add('Some'+#$81#$FF#$00#$00+' blue'+#$82#$02+' italic'+#$81#$00#$00#$00#$82#$00+' text');
80.  MyMemo.Lines.Add('');
81.  MyMemo.Lines.Add('Some'+#$81#$00#$77#$00+' green'+#$82#$03+' bold italic'+#$81#$00#$00#$00#$82#$00+' text');
82. end;
83.  
84. //--------------------- TColouredMemo definitions -----------------------
85.  
86. { TColouredMemo.TExtStringList }
87.  
88. function TColouredMemo.TExtStringList.Add(const S: string): Integer;
89. begin
90.  Result:=inherited Add(S);
91.  if Assigned(FColouredMemo) then FColouredMemo.Invalidate;
92. end;
93.  
94. { TColouredMemo }
95.  
96. constructor TColouredMemo.Create(AOwner: TComponent);
97. begin
98.  inherited Create(AOwner);
99.  //Create the line container
100.  FLines:=TExtStringList.Create;
101.  FLines.FColouredMemo:=Self;
102.  //Create the canvas
103.  FContent:=TImage.Create(Self);
104.  FContent.Parent:=Self;
105.  FContent.Top :=0;
106.  FContent.Left:=0;
107.  FContent.Picture.Bitmap.Width :=ClientWidth;
108.  FContent.Picture.Bitmap.Height:=ClientHeight;
109.  FContent.Width :=ClientWidth;
110.  FContent.Height:=ClientHeight;
111.  FContent.Visible:=True;
112.  //Defaults
113.  FLineSpace:=4;   //Space between lines, in pixels
114.  FIndent:=4;      //Indent in from the left, in pixels
115.  Color:=$FFFFFF;  //Default background colour
116. end;
117.  
118. destructor TColouredMemo.Destroy;
119. begin
120.  FLines.Free;
121.  FContent.Free;
122.  inherited Destroy;
123. end;
124.  
125. procedure TColouredMemo.Paint;
126. var
127.  LLine,
128.  LIndex,
129.  XPos,
130.  YPos,
131.  W,H    : Integer;
132.  LPart,
133.  LText  : String;
134.  LRed,
135.  LGreen,
136.  LBlue  : Byte;
137. begin
138.  //First pass, calculate then set the canvas size
139.  if FLines.Count>0 then
140.  begin
141.   //Starting size
142.   W:=ClientWidth;
143.   H:=FLineSpace;
144.   for LLine:=0 to FLines.Count-1 do
145.   begin
146.    LText:='';
147.    if FLines[LLine]='' then LText:=' ' //blank line will give 0 height
148.    else //Remove control characters
149.     for LIndex:=1 to Length(FLines[LLine]) do
150.      if(ord(FLines[LLine][LIndex])>31)and(ord(FLines[LLine][LIndex])<127)then
151.       LText:=LText+FLines[LLine][LIndex];
152.    if FContent.Canvas.TextWidth(LText)+FIndent>W then
153.     W:=FContent.Canvas.TextWidth(LText)+FIndent;
154.    inc(H,FContent.Canvas.TextHeight(LText)+FLineSpace);
155.   end;
156.   //Can't be smaller than the scroll width
157.   if H<ClientHeight then H:=ClientHeight;
158.   //Set the canvas size
159.   FContent.Picture.Bitmap.Width:=W;
160.   FContent.Picture.Bitmap.Height:=H;
161.   FContent.Width:=W;
162.   FContent.Height:=H;
163.  end;
164.  //Clear the background
165.  FContent.Canvas.Brush.Color:=Color;
166.  FContent.Canvas.Brush.Style:=bsSolid;
167.  FContent.Canvas.Pen.Color:=Color;
168.  FContent.Canvas.Pen.Style:=psSolid;
169.  FContent.Canvas.Rectangle(0,0,W,H);
170.  //Are there any lines entered?
171.  if FLines.Count>0 then
172.  begin
173.   //Start at the top
174.   YPos:=FLineSpace;
175.   //Work our way through the lines
176.   for LLine:=0 to FLines.Count-1 do
177.   begin
178.    //Set the font
179.    FContent.Canvas.Font:=Font;
180.    //Default font colour
181.    FContent.Canvas.Font.Color:=Font.Color;
182.    //No styles
183.    FContent.Canvas.Font.Style:=[];
184.    //Transparent background
185.    FContent.Canvas.Brush.Style:=bsClear;
186.    //Get the current line
187.    LText:=FLines[LLine];
188.    //If it is empty, put a space in so we get a blank line
189.    if LText='' then LText:=' ';
190.    //Indent it
191.    XPos:=FIndent;
192.    //Clear the 'part of' string
193.    LPart:='';
194.    //Start at the beginning
195.    LIndex:=1;
196.    while LIndex<=Length(LText) do
197.    begin
198.     //Top bit set? Then this means a change of style or colour
199.     if(ord(LText[LIndex])and$80)=$80 then
200.     begin
201.      //Output what we currently have
202.      if LPart<>'' then
203.      begin
204.       FContent.Canvas.TextOut(XPos,YPos,LPart);
205.       inc(XPos,FContent.Canvas.TextWidth(LPart));
206.      end;
207.      //New part of string
208.      LPart:='';
209.      //Change of colour
210.      if(ord(LText[LIndex])AND$01)=$01 then
211.      begin
212.       //Get the Blue index
213.       inc(LIndex);
214.       if LIndex<=Length(LText) then LBlue :=ord(LText[LIndex]);
215.       //Get the Green index
216.       inc(LIndex);
217.       if LIndex<=Length(LText) then LGreen:=ord(LText[LIndex]);
218.       //Get the Red index
219.       inc(LIndex);
220.       if LIndex<=Length(LText) then LRed  :=ord(LText[LIndex]);
221.       //Set the colour
222.       FContent.Canvas.Font.Color:=LRed+LGreen<<8+LBlue<<16;
223.      end;
224.      //Change of style
225.      if(ord(LText[LIndex])AND$02)=$02 then
226.      begin
227.       inc(LIndex);
228.       if LIndex<=Length(LText) then
229.       begin
230.        //Bold
231.        if(ord(LText[LIndex])AND$01)=$01 then
232.         FContent.Canvas.Font.Style:=FContent.Canvas.Font.Style+[fsBold]
233.        else //No Bold
234.         FContent.Canvas.Font.Style:=FContent.Canvas.Font.Style-[fsBold];
235.        //Italic
236.        if(ord(LText[LIndex])AND$02)=$02 then
237.         FContent.Canvas.Font.Style:=FContent.Canvas.Font.Style+[fsItalic]
238.        else //No Italic
239.         FContent.Canvas.Font.Style:=FContent.Canvas.Font.Style-[fsItalic];
240.       end;
241.      end;
242.     end;
243.     //Valid ASCII character? add it to the 'part of' string
244.     if(ord(LText[LIndex])>31)and(ord(LText[LIndex])<127)then
245.      LPart:=LPart+LText[LIndex];
246.     //Next character
247.     inc(LIndex);
248.    end;
249.    //Anything left that hasn't been printed?
250.    if LPart<>'' then FContent.Canvas.TextOut(XPos,YPos,LPart);
251.    //Move the Y pointer downwards
252.    inc(YPos,FContent.Canvas.TextHeight(LText)+FLineSpace);
253.   end;
254.  end;
255. end;
256.  
257. procedure TColouredMemo.SetLines(const AValue: TExtStringList);
258. begin
259.  if AValue<>nil then FLines.Assign(AValue);
260.  Invalidate;
261. end;
262.  
263.  
264. end.
265.  

I have a further question, which is more generic - when you create a class descended from another class, how does one hide properties that are not wanted to be exposed outside of the class being created (but still available inside)?
You probably saw that I put "property Canvas" inside the protected part, but this made no difference.

EDIT: TBitmap no worky in this instance.

[KodeZwerg]

how does one hide properties that are not wanted to be exposed outside of the class being created (but still available inside)?

Probably by changing their visibility from Public/Protected to (strict) Private.

[Joanna from IRC]

Interesting project. Memos definitely need more color. I’ve created descendant classes like tmybutton = class(tcdbutton) and tmycombobox = class (tcombobox) etc.

I’m curious why you did you use

TColouredMemo = class(TGraphicControl)

Instead of TColouredMemo = class(TMemo) so that there would be more memo like methods in it to override .

Does tmemo have behaviors that you don’t like ?

[geraldholdsworth]

I’m curious why you did you use

TColouredMemo = class(TGraphicControl)

Instead of TColouredMemo = class(TMemo) so that there would be more memo like methods in it to override .

Does tmemo have behaviors that you don’t like ?

Because I couldn't work out how to write to the Memo - didn't have a canvas and I wasn't sure of any other way of doing it.

[Joanna from IRC]

Oh that’s strange I assumed it would... I wonder what it’s putting the text on, it says it’s a descendant of tcustomedit , twincontrol and ultimately tcontrol. I’m not sure what unit tgraphical control is in.
In any case good luck with your endeavor 

[geraldholdsworth]

I've revisited this code. Mostly because I realised that if the control had tons of lines it would produce a huge canvas which would crash the application if it got too big.

So, I've created a coloured label control which is then used for each line in the memo. This also speeds up the adding of lines (particularly when there are loads). However, it is still slow. I then changed the control characters used to determine styles and used the ANSI escape sequences (well, some of them). This speeded it up somewhat. Is there anything else I can do to speed this up? Would ditching the TColouredLabel in favour of having a TCanvas per line in the memo work better?

(code not inline because the messages are restricted to 20,000 characters )

[kupferstecher]

However, it is still slow.

Do you still use TScrollingWinControl? (I'm not at the PC right now, so its not convenient to check your code). I'm not sure, but I think this is not ideal as you have to represent each line somehow, even those that are not visible. When I did something like that before (a hex memo) I also stumbled over the speed issue. My solution then was to use a TCustomControl, and only draw the lines that are currently visible on the Canvas. Two TScrollbar are placed and the content that is rendered depends on the current scrollbar position. That way in theory the rendering time only depends on the visible area and not on the number of lines. In practice linebreakes and similar things do introduce some impact of the number of lines.The programming effort to go that way is quite high, but the result worked for me, well. (But in the end I also limited the number of characters).