• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 259
  • Last Modified:

Tmemo,Trichedit, etc DELPHI 3......

I want to show a Txt file in  differents colors and fonts.

ie: test 'monday' in black, text saturday in red and italic, etc

and at the same time if the user change the text and types theses texts in the component then show in theses color too?

any help with this components or any other will be very useful.



Thanks in advance

0
alaingated
Asked:
alaingated
1 Solution
 
interCommented:
Try using TRichEdit with format capabilities...Its now late on my land so I do not want your question be unattended. So, search for the TRichEdit in help, but before that look at the demo in your Delphi\demos\richedit\ directory for an extended notepad application with delphi.
Bye Igor
0
 
viktornetCommented:
Tell me your e-mail address and I'll send you a component that does that....

Regards,
Viktor Ivanov
0
 
itamarCommented:
Also take a look at this:

" Rich edit control with extended capabilities. Extra formatting
    properties (highlight, indices), URL detection, multilevel undo/redo, support for Unicode strings.
    Requires RICHED20.DLL. (ver. 1.1, added 5/10/98, updated 5/31/98)  by Alexander
    Obukhov " at:

http://sunsite.icm.edu.pl/delphi/ftp/d30free/riched98.zip

IHTH

0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
erajojCommented:
Hi,
Is this what you want?:
(Lots of room for improvement below :)

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    procedure RichEdit1Change(Sender: TObject);
    procedure RichEdit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
  private
    m_iFirstLine : Integer;
    m_rgsLookup  : TStringList;
    procedure SyntaxHighLight( iStart, iEnd: Integer );
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.SyntaxHighLight( iStart, iEnd: Integer );
var
  iIndex, iPos : Integer;
  iStartToken, iEndToken, iLastToken: Integer;
  sToken  : string;
  bInToken: Boolean;
begin
  with RichEdit1 do begin
    bInToken := False;
    iLastToken  := iStart; iStartToken := iStart; iEndToken   := iStart;
    for iIndex := iStart to iEnd do
    begin
      if ( IsCharAlphaNumeric( Text[ iIndex ] ) ) then begin
        if ( not bInToken ) then iStartToken := iIndex;
        iEndToken := iIndex;
        bInToken := True;
      end else begin
        if ( bInToken ) then begin
          sToken := Copy( Text, iStartToken, iEndToken - iStartToken + 1 );
          Caption := sToken;
          if ( m_rgsLookup.Find( sToken, iPos ) ) then begin
            SelStart  := iLastToken;
            SelLength := iStartToken - iLastToken;
            with SelAttributes do begin
              Color := clWindowText;
              Style := [  ];
            end;
            SelStart  := iStartToken - 1;
            SelLength := iEndToken - iStartToken + 1;
            with SelAttributes do begin
              Color := clRed;
              Style := [ fsItalic ];
            end;
            SelText   := m_rgsLookup[ iPos ];
            iLastToken := iEndToken + 1;
          end;
        end;
        bInToken := False;
      end;
    end;
    SelStart  := iLastToken;
    SelLength := iEnd - iLastToken;
    with SelAttributes do begin
      Color := clWindowText;
      Style := [  ];
    end;
  end;
end;

procedure TForm1.RichEdit1Change(Sender: TObject);
var
  iStart, iEnd, iMax, iSelStart, iSelLength: Integer;
begin
  with RichEdit1 do if Tag = 0 then begin
    Enabled := False; // reduces flicker
    Tag := 1;
    iSelStart  := SelStart;
    iSelLength := SelLength;

    iStart := iSelStart;
    iEnd   := iSelStart + iSelLength;
    iMax   := Length( Text );
    while ( iStart > 0 ) and ( not IsCharAlphaNumeric( Text[ iStart ] ) ) do Dec( iStart );
    while ( iStart > 0 ) and ( IsCharAlphaNumeric( Text[ iStart ] ) ) do Dec( iStart );
    while ( iEnd   <= iMax ) and ( not IsCharAlphaNumeric( Text[ iEnd ] ) ) do Inc( iEnd );
    while ( iEnd   <= iMax ) and ( IsCharAlphaNumeric( Text[ iEnd ] ) ) do Inc( iEnd );
    if ( iStart < iEnd ) then SyntaxHighLight( iStart, iEnd );

    SelStart  := iSelStart;
    SelLength := iSelLength;
    Tag := 0;
    Enabled := True;
    try SetFocus except end;
  end;
end;

procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
//  m_iFirstLine := SendMessage( RichEdit1.Handle, EM_LINEFROMCHAR, RichEdit1.SelStart, 0 );
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  m_rgsLookup  := TStringList.Create;
  with m_rgsLookup do begin
    Sorted := True;
    Add( 'Saturday' );
    Add( 'Sunday' );
  end;
end;

end.

/// John
0
 
alaingatedAuthor Commented:
Thanks a lot,
 It works fine whe you type in, but it does not work properly loading a txt file
0
 
erajojCommented:
You must use SyntaxHighLight after loading on the whole file:

procedure TForm1.LoadFile( sFileName: string );
var
  iStart, iEnd, iMax, iSelStart, iSelLength: Integer;
begin
  with RichEdit1 do if Tag = 0 then begin
    Enabled := False; // reduces flicker
    Tag := 1;
    Lines.LoadFromFile( sFileName );
    iSelStart  := SelStart;
    iSelLength := SelLength;

    iStart := 0;
    iEnd   := iSelStart;
    if ( iStart < iEnd ) then SyntaxHighLight( iStart, iEnd );

    SelStart  := iSelStart;
    SelLength := iSelLength;
    Tag := 0;
    Enabled := True;
    try SetFocus except end;
  end;
end;
 
.or something like that...

/// John
0
 
erajojCommented:
Hi again,
The code above is painfully slow and doesn't work properly, so I felt I had to make at least some improvements to deserve the points. The new code is much faster:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Load1: TMenuItem;
    OpenDialog1: TOpenDialog;
    StatusBar1: TStatusBar;
    procedure RichEdit1Change(Sender: TObject);
    procedure RichEdit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure Load1Click(Sender: TObject);
  private
    m_iFirstLine : Integer;
    m_rgsLookup  : TStringList;
    procedure SyntaxHighLight( iStart, iEnd: Integer; bRemoveAttr: Boolean );
    procedure LoadFile( sFileName: string );
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.SyntaxHighLight( iStart, iEnd: Integer; bRemoveAttr: Boolean );
const
  ValidChars = [ '0'..'9','A'..'Z','a'..'z'];

var
  iIndex, iPos : Integer;
  iStartToken, iEndToken, iLastToken: Integer;
  sToken  : string;
  bInToken: Boolean;
  sText   : string;
begin
  with RichEdit1 do begin
    bInToken := False;
    iLastToken  := iStart; iStartToken := iStart; iEndToken   := iStart;
    sText := Text; // copy text once
    for iIndex := iStart to iEnd do
    begin
//      if ( IsCharAlphaNumeric( Text[ iIndex ] ) ) then begin
      if ( sText[ iIndex ] in ValidChars ) then begin
        if ( not bInToken ) then iStartToken := iIndex;
        iEndToken := iIndex;
        bInToken := True;
      end else begin
        if ( bInToken ) then begin
          sToken := Copy( sText, iStartToken, iEndToken - iStartToken + 1 );
          if ( m_rgsLookup.Find( sToken, iPos ) ) then begin
            if ( bRemoveAttr ) then begin
              SelStart  := iLastToken;
              SelLength := iStartToken - iLastToken + 1;
              with SelAttributes do begin
                Color := clWindowText;
                Style := [  ];
              end;
            end;
            SelStart  := iStartToken - 1;
            SelLength := iEndToken - iStartToken + 1;
            with SelAttributes do begin
              Color := clBLue;
              Style := [ fsBOLD ];
            end;
            SelText   := m_rgsLookup[ iPos ];
            iLastToken := iEndToken + 1;
          end;
        end;
        bInToken := False;
      end;
    end;
    SelStart  := iLastToken;
    SelLength := iEnd - iLastToken;
    with SelAttributes do begin
      Color := clWindowText;
      Style := [  ];
    end;
  end;
end;

procedure TForm1.RichEdit1Change(Sender: TObject);
var
  iStart, iEnd, iMax, iSelStart, iSelLength: Integer;
begin
  with RichEdit1 do if Tag = 0 then begin
    Enabled := False; // reduces flicker
    Tag := 1;
    iSelStart  := SelStart;
    iSelLength := SelLength;

    iStart := iSelStart;
    iEnd   := iSelStart + iSelLength;
    iMax   := Length( Text );
    while ( iStart > 0 ) and ( not IsCharAlphaNumeric( Text[ iStart ] ) ) do Dec( iStart );
    while ( iStart > 0 ) and ( IsCharAlphaNumeric( Text[ iStart ] ) ) do Dec( iStart );
    while ( iEnd   <= iMax ) and ( not IsCharAlphaNumeric( Text[ iEnd ] ) ) do Inc( iEnd );
    while ( iEnd   <= iMax ) and ( IsCharAlphaNumeric( Text[ iEnd ] ) ) do Inc( iEnd );
    if ( iStart < iEnd ) then SyntaxHighLight( iStart, iEnd, True );

    SelStart  := iSelStart;
    SelLength := iSelLength;
    Tag := 0;
    Enabled := True;
    try SetFocus except end;
  end;
end;

procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
//  m_iFirstLine := SendMessage( RichEdit1.Handle, EM_LINEFROMCHAR, RichEdit1.SelStart, 0 );
end;

procedure TForm1.LoadFile( sFileName: string );
var
  iStart, iEnd, iMax, iSelStart, iSelLength: Integer;
begin
  with RichEdit1 do if Tag = 0 then begin
    Screen.Cursor := crHourGlass;
    Enabled := False; // reduces flicker
    Tag := 1;
    Lines.LoadFromFile( sFileName );
    iSelStart  := SelStart;
    iSelLength := SelLength;

    iStart := 0;
    iEnd   := Length( Text );
    if ( iStart < iEnd ) then SyntaxHighLight( iStart, iEnd, False );

    SelStart  := iSelStart;
    SelLength := iSelLength;
    Tag := 0;
    Enabled := True;
    Screen.Cursor := crDefault;
    try SetFocus except end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  m_rgsLookup  := TStringList.Create;
  with m_rgsLookup do begin
    Sorted := True;
    Add( 'Saturday' );
    Add( 'Sunday' );
    Add( 'saturdays' );
    Add( 'sundays' );
  end;
end;

procedure TForm1.Load1Click(Sender: TObject);
begin
  if ( OpenDialog1.Execute ) then begin
    LoadFile( OpenDialog1.FileName );
  end;
end;

end.

/// John
0
 
alaingatedAuthor Commented:
Hi! i just found that if i want to use not a word, but a frase ie " Sunday morning"," Saturday night", it does not work because the space character in.

any idea how can i sort this?

thanks again
0
 
alaingatedAuthor Commented:
How can i do if i dont want to upgade the text  until i make all the SelAttributes. Because is my tokens are character then is very slow and the flicker  is too much, I really would like to avoid it.
0
 
erajojCommented:
Sorry Alain, I haven't got time to help you for a while.
Ask this as a new question with low points <50 so that others may help you.
Refer to this question and mention that I tried but am not able to help you any further.
If I find anything or discover something helpful to you, I will help you as much as I can. No promises though.

/// John

0

Featured Post

Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now