TRichEdit

Code:

{

So what we need:

1. drop on your form a RichEdit component from win32 page of component

palette

2. in OnCreate event of your form write the next code:

}

procedure TForm1.FormCreate(Sender: TObject);

var

  mask: Word;

begin

  mask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0);

  SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);

  SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, Integer(True), 0);

  RichEdit1.Text := 'SwissDelphiCenter.com: '#13#10 +

    ' Site is located at www.SwissDelphiCenter.com';

end;

{

After that your Richedit will convert automatically any URLs in highlighted

(blue color and underlined). Even if you'll start to enter any text directly

in Richedit, any begings for URL will be converted too (not only existing

text string but new too)

}

// 3. now we must detect mouse clicks in URL range. For this task we must

//    override WndProc method of our form:

type

  TForm1 = class(TForm)

  protected

    procedure WndProc(var Message: TMessage); override;

  end;

// 4. the implementation looks like this:

procedure TForm1.WndProc(var Message: TMessage);

var

  p: TENLink;

  strURL: string;

begin

  if (Message.Msg = WM_NOTIFY) then

  begin

    if (PNMHDR(Message.lParam).code = EN_LINK) then

    begin

      p := TENLink(Pointer(TWMNotify(Message).NMHdr)^);

      if (p.Msg = WM_LBUTTONDOWN) then

      begin

        SendMessage(RichEdit1.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));

        strURL := RichEdit1.SelText;

        ShellExecute(Handle, 'open', PChar(strURL), 0, 0, SW_SHOWNORMAL);

      end

    end

  end;

  inherited;

end;

{

5. Now you can compile your project (don't forget to include Richedit and

ShellAPI units in uses clause).

}

Code:

{+------------------------------------------------------------

| Function FindTextBackwards

|

| Parameters :

|   findWhat: text to find

|   inString: string to find it in

|   startAt : character index to start at (1-based)

|   caseSensitive: determines whether search is case-sensitive

|   words   : if true the characters immediately surrounding

|             a found location must not be alphanumeric

| Returns    :

|   character index (1-based) of first character of a found

|   location, or 0, if the text was not found.

| Description:

|   Performs a simple sequential search for a string in a larger

|   string, starting at the specified position and working towards

|   the start of the string.

| Error Conditions: none

| Created: 27.02.99 by P. Below

+------------------------------------------------------------}

function FindTextBackwards(findWhat, inString : string;

  startAt : integer;

  caseSensitive, words : boolean): integer;

var

  i, patternlen, findpos : integer;

  lastchar, firstchar : char;

begin

  Result := 0;  { assume failure }

  patternlen := Length(findWhat);

  { Do a few sanity checks on the parameters }

  if (patternlen = 0) or

    (startAt < patternlen) or

    (Length(inString) < patternlen) then

    Exit;

  if not caseSensitive then

   begin

    { convert both strings to lower case }

    findWhat := AnsiLowercase(findWhat);

    inString := AnsiLowercase(inString);

  end; { If }

  i := startAt;

  lastchar := findWhat[patternlen];

  firstchar := findWhat[1];

  while (Result = 0) and (i >= patternlen) do

   begin

    if inString[i] = lastchar then

     begin

      findPos := i - patternlen + 1;

      if inString[findPos] = firstchar then

       begin

        { We have a candidate. Compare the substring of length

         patternlen starting at findPos with findWhat. With

         AnsiStrLComp we can do that without having to copy

         the substring to a temp string first. }

        if AnsiStrLComp(@findWhat[1], @inString[findPos],

          patternlen) = 0 then

         begin

          { We have a match! }

          Result := findPos;

          if words then

           begin

            { Check the characters surrounding the hit. For the hit

             to constitute a word they must not be alphanumeric. }

            if (findPos > 1) and

              IsCharAlphanumeric(inString[findPos - 1]) then

             begin

              { Not a match after all, <sigh>. }

              Result := 0;

            end { If }

            else

             begin

              if (i < Length(inString)) and

                IsCharAlphanumeric(inString[i + 1]) then

               begin

                { Not a match after all, <sigh>. }

                Result := 0;

              end; { If }

            end; { Else }

          end; { If }

        end; { If }

      end; { If }

    end; { If }

    Dec(i);

  end; { While }

end; { FindTextBackwards }

procedure TForm1.Button1Click(Sender : TObject);

var

  findPos : integer;

begin

  findPos := FindTextBackwards(findEdit.Text,

    richedit1.Text,

    richedit1.selstart + 1,

    caseCheckbox.Checked,

    wordsCheckbox.Checked);

  if findPos > 0 then

   begin

    with richedit1 do

     begin

      selstart := findPos - 1;

      sellength := findEdit.GetTextLen;

      Perform(em_scrollcaret, 0, 0);

      SetFocus;

    end;

  end

  else

    ShowMessage('Text not found');

end;

Code:

function GetWord: boolean;

var

s: string; {предположим что слова не содержат>255 символов}

c: char;

begin

result := false;

s := ' ';

while not eof(f) do

begin

   read(f, c);

   if not (c in ['a'..'z', 'A'..'Z' {,... и т.д, и т.п.}]) then

     break;

   s := s + c;

end;

result := (s <> ' ');

end;

procedure GetWordCount(TextFile: string);

begin

Count := 0;

assignfile(f, TextFile);

reset(f);

while not eof(f) do

   if GetWord then

     inc(Count);

closefile(f);

end;

Code:

with Richedit1 do

begin

    selstart := perform( EM_LINEINDEX, linenumber, 0 );

    perform( EM_SCROLLCARET, 0, 0 );

end;

{

The EM_LINEINDEX message returns the character index of the first character

on a given line, assigning that to selstart moves the caret to that position.

The control will only automatically scroll the caret into view if it has

the focus, thus the EM_SCROLLCARET.

}

Code:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls, ComCtrls;

type

TForm1 = class(TForm)

   Button1: TButton;

   Button2: TButton;

   RichEdit1: TRichEdit;

   procedure RichEdit1KeyPress(Sender: TObject; var Key: Char);

private

   { Private declarations }

public

   { Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

uses

richedit;

procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char);

var

line, col, indent: integer;

S: string;

begin

if key = #13 then

begin

   key := #0;

   with sender as TRichEdit do

   begin

     {figure out line and column position of caret}

     line := PerForm( EM_EXLINEFROMCHAR, 0, SelStart );

     Col := SelStart - Perform( EM_LINEINDEX, line, 0 );

     {get part of current line in front of caret}

     S:= Copy( lines[ line ], 1, col );

     {count blanks and tabs in this string}

     indent := 0;

     while (indent < length( S )) and (S[indent + 1] in [' ', #9]) do

       Inc( indent );

     {insert a linebreak followed by the substring of blanks and tabs}

     SelText := #13#10 + Copy(S, 1, indent);

   end;

end;

end;

end.

Code:

procedure HTMLSyntax(RichEdit: TRichEdit; TextCol,

TagCol, DopCol: TColor);

var

i, iDop: Integer;

s: string;

Col: TColor;

isTag, isDop: Boolean;

begin

iDop := 0;

isDop := False;

isTag := False;

Col := TextCol;

RichEdit.SetFocus;

for i := 0 to Length(RichEdit.Text) do

begin

   RichEdit.SelStart := i;

   RichEdit.SelLength := 1;

   s := RichEdit.SelText;

   if (s = '<') or (s = '{') then isTag := True;

   if isTag then

     if (s = '"') then

       if not isDop then

       begin

         iDop  := 1;

         isDop := True;

       end

       else

         isDop := False;

   if isTag then

     if isDop then

     begin

       if iDop <> 1 then Col := DopCol;

     end

     else

       Col := TagCol

   else

     Col := TextCol;

   RichEdit.SelAttributes.Color := Col;

   iDop := 0;

   if (s = '>') or (s = '}') then isTag := False;

end;

RichEdit.SelLength := 0;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

RichEdit1.Lines.BeginUpdate;

HTMLSyntax(RichEdit1, clBlue, clRed, clGreen);

RichEdit1.Lines.EndUpdate;

end;