Board index » delphi » Adding colors ability to TMemo - repin problem

Adding colors ability to TMemo - repin problem

Hello

I'm writing my (first indeed:P) component, that will be able to color
any regular expression matched text in memo. After I gave up with
RichEdit (to slow and a little poor), i decided to do this with TMemo.
So, my class inherits from TMemo. I wrote following OnPaint event, and
this works... only in IDE.

procedure TMyMemo.WMPaint;
var DC: HDC;
     PS: TPaintStruct;
     Canvas: TCanvas;
     I: Integer;
begin
   DC := Message.DC;
   if DC = 0 then DC := BeginPaint(Handle, PS);
   Canvas := TCanvas.Create;
   Canvas.Handle := DC;
   If Self.Lines.Count >0 then
   for i := 0 to Self.Lines.Count - 1 do
   begin
     Canvas.Font.Color := Random($FFFFFF);
     Canvas.TextOut(1, 1 + Canvas.TextHeight(Self.Lines[i]) * i,
Self.Lines[i]);
   end;
   Canvas.Free;
   inherited;
end;

This method should color lines of memo in random colors. And it works,
only in IDE, so when i resize or move the component, the colors are
changing, but, when i run my test app, nothing happens when i try to add
some text to memo (nothing means - every text is in default (black)
color). So, what's wrong ?

yours
qdlacz

 

Re:Adding colors ability to TMemo - repin problem


Why are you trapping the wm_Paint message instead of overriding the
appropriate paint method in the tMemo hierarchy?

Re:Adding colors ability to TMemo - repin problem


Quote
Bruce Roberts wrote:
> Why are you trapping the wm_Paint message instead of overriding the
> appropriate paint method in the tMemo hierarchy?

Can you give short code example, please ? :)

thanks & yours
qdlacz

Re:Adding colors ability to TMemo - repin problem


"qdlaty" <qdl...@ikom.pl> skrev i melding news:3D75CFD2.6030705@ikom.pl...

Quote
> Hello

> I'm writing my (first indeed:P) component, that will be able to color
> any regular expression matched text in memo. After I gave up with
> RichEdit (to slow and a little poor), i decided to do this with TMemo.
> So, my class inherits from TMemo. I wrote following OnPaint event, and
> this works... only in IDE.

> procedure TMyMemo.WMPaint;
> var DC: HDC;
>      PS: TPaintStruct;
>      Canvas: TCanvas;
>      I: Integer;
> begin
>    DC := Message.DC;
>    if DC = 0 then DC := BeginPaint(Handle, PS);
>    Canvas := TCanvas.Create;
>    Canvas.Handle := DC;
>    If Self.Lines.Count >0 then
>    for i := 0 to Self.Lines.Count - 1 do
>    begin
>      Canvas.Font.Color := Random($FFFFFF);
>      Canvas.TextOut(1, 1 + Canvas.TextHeight(Self.Lines[i]) * i,
> Self.Lines[i]);
>    end;
>    Canvas.Free;
>    inherited;
> end;

> This method should color lines of memo in random colors. And it works,
> only in IDE, so when i resize or move the component, the colors are
> changing, but, when i run my test app, nothing happens when i try to add
> some text to memo (nothing means - every text is in default (black)
> color). So, what's wrong ?

My guess is, you haven't got the correct version of the unit compiled in. To
test this, do something like the following (you don't need to recompile the
component):

TMyMemo = blabla...
protected
  procedure Loaded; override;

procedure TMyMemo.Loaded;
begin
  inherited Loaded;
  Lines.Add('IF YOU CAN SEE THIS, IT''S USING THE CORRECT UNIT');
end;

If the line doesn't show up, I guess yopu must check your search path.
Remove the .dcu files for a start.

--
Bjorge Sather
bjorge@hahaha_itte.no

Re:Adding colors ability to TMemo - repin problem


Quote
Bruce Roberts wrote:
> Why are you trapping the wm_Paint message instead of overriding the
> appropriate paint method in the tMemo hierarchy?

but Method 'Paint' not found in class :(... So ?

Yours
qdlacz

Re:Adding colors ability to TMemo - repin problem


Perhaps this approach will do what you want?  I think I had the same
functional problem that you had. I wanted to allow different words to have
different color backgrounds in a TMemo.

First, I used a TPanel to hold the words (not a TMemo). Then I created, on
the fly, a TLabel for each word, carefully placing each TLabel in the right
place.

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, ExtCtrls;

type
 TForm1 = class(TForm)
  Panel1 : TPanel;
  Edit1 : TEdit;
  Label1 : TLabel;
  Button1 : TButton;
  procedure Button1Click(Sender : TObject);
  procedure ClearWords;
  procedure FormCreate(Sender : TObject);
  procedure FormDestroy(Sender : TObject);
  procedure PostSentence;
  procedure WordClick(Sender : TObject);
 private
    { Private declarations }
 public
    { Public declarations }
 end;

var
 Form1 : TForm1;
 Words : array of TLabel;
 Sentence : tstringlist;

implementation

{$R *.DFM}

procedure TForm1.ClearWords;
var i : integer;
begin
 for i := 0 to Sentence.count - 1 do
  Words[i].free;
 Sentence.clear;
end;

procedure TForm1.PostSentence;
var i, l, pantop, panleft : integer;
begin
 pantop := 6;
 panleft := 8;
 with Sentence do
  SetLength(Words, Sentence.count);
 for i := 0 to Sentence.count - 1 do begin
  Words[i] := TLabel.create(Panel1);
  with TLabel(Words[i]) do begin
   Parent := Panel1;
   caption := Sentence[i];
   OnClick := WordClick;
   tag := i mod 5;
   l := Canvas.TextWidth(caption);
   width := l + 6;
   if panleft + l > Panel1.width then begin
    Panleft := 10;
    pantop := pantop + 15;
   end;
   left := PanLeft;
   top := PanTop;
   PanLeft := PanLeft + width;
  end;
 end;
end;

procedure TForm1.Button1Click(Sender : TObject);
var i : integer; word : string;
begin
 ClearWords;
 word := '';
 for i := 1 to length(Edit1.text) do
  if edit1.text[i] = ' ' then begin
   Sentence.add(word);
   word := '';
  end
  else
   word := word + edit1.text[i];
 if word <> '' then
  Sentence.add(word); { pick up the last word }
 PostSentence;
end;

procedure TForm1.FormCreate(Sender : TObject);
begin
 Sentence := tstringlist.create;
end;

procedure TForm1.FormDestroy(Sender : TObject);
begin
 ClearWords;
 Sentence.free;
end;

procedure TForm1.WordClick(Sender : TObject);
const DarkColorSet : set of 1..10 = [2, 3, 4];
begin
 with TLabel(Sender) do begin
  case tag of
   0 : color := clYellow;
   1 : color := clRed;
   2 : color := clNavy;
   3 : color := clblack;
   4 : color := clgreen;
  end;
  if tag in DarkColorSet then
   Font.color := clwhite;
 end;
end;

end.

Other Threads