• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 263
  • 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
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

 
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

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