Searching a RichMemo

The TRichMemo component is not yet part of the standard installation of Lazarus, but it is not difficult to download and install. A stepwise guide to its installation and use for developing a rich text editor has been created by LazPlanet in a manner that should be accessible to school students. We installed the (console) svn client provided by SlikSVN in order to copy the code of all of the required files in the repository. The set-up of the 64-bit version for Windows is quick and painless and comes with thorough documentation in a PDF file.

This demonstration is based on the search demonstration provided with the TRichMemo component. It introduces the ability to search within the selection chosen by the user. Press the Search button repeatedly to see the occurrence highlighted and its position output in a label. When no more occurrences are found, the initial selection is restored.

You can see within the Pascal code the rich text format (RTF) code that we obtained using Jerzy Griffith's word processor. Jergy used the TRichEdit component in Delphi to create and display formatted text and to output .rtf files.

The Pascal code and the code of the form follow a screenshot of the program in action.

Search in action

Search in action

Pascal Code

unit mainform;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  RichMemo, RichMemoUtils, LazUTF8;

type
  TForm1 = class(TForm)
    Button1, Button2: TButton;
    chkCaseSensitive: TCheckBox;
    chkWholeWord: TCheckBox;
    Edit1: TEdit;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    RichMemo1: TRichMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RichMemo1MouseDown(Sender: TObject; Button: TMouseButton;
                                 Shift: TShiftState; X, Y: Integer);
  private
    InitialSelStart, InitialSelLength, SearchFrom, SearchTo, MatchPos, Matches: integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    LoadRTFFile(RichMemo1, OpenDialog1.FileName);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  SearchOptions: TSearchOptions;
begin
  if Matches = 0 then
    begin
      InitialSelStart := RichMemo1.SelStart;
      SearchFrom := InitialSelStart;
      InitialSelLength := RichMemo1.SelLength;
      if InitialSelLength = 0 then
        SearchTo := Length(RichMemo1.Text)
      else
        SearchTo := SearchFrom + InitialSelLength;
    end;
  SearchOptions := [];
  if chkCaseSensitive.Checked then
    include(SearchOptions, soMatchCase);
  if chkWholeWord.Checked then
    include(SearchOptions, soWholeWord);
  MatchPos := RichMemo1.Search(Edit1.Text, SearchFrom, SearchTo - SearchFrom + 1, SearchOptions);

  if MatchPos >= 0 then
    begin
      inc(Matches);
      Label1.Caption := 'Found at position ' + intToStr(MatchPos);
      SearchFrom := MatchPos + 1;
      RichMemo1.SelStart := MatchPos;
      RichMemo1.SetSelLengthFor(Edit1.text);
    end
  else
    begin
      if Matches = 0 then
        Label1.Caption := 'Not found!'
      else
        Label1.Caption := 'No more occurrences.  Matches: ' + intToStr(Matches);
      RichMemo1.SelStart := InitialSelStart;
      RichMemo1.SelLength := InitialSelLength;
      Matches := 0;
    end;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
  Matches := 0;
  Label1.Caption := 'New Search';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  RichMemo1.Rtf:='{\rtf1\fbidis\ansi\ansicpg1252\deff0\deflang2057\deflangfe2057' +
                 '{\fonttbl{\f0\fswiss\fprq2\fcharset0 Tahoma;}' +
                 '{\f1\fswiss\fprq2\fcharset0 Arial Black;}{\f2\froman\fprq2\fcharset0' +
                 ' Palatino Linotype;}{\f3\fmodern\fprq1\fcharset0 Courier New;}}' +
                 '{\colortbl ;\red0\green0\blue0;\red0\green128\blue0;\red128\green0\blue0;'+
                 '\red0\green0\blue128;\red0\green255\blue0;\red255\green0\blue0;}' +
                 ' {\*\generator Riched20 6.3.9600}\viewkind4\uc1' +
                 '  \pard\sl240\slmult1\cf1\f0\fs28\tab Different styles' +
                 ' (normal, \b bold\b0 ,\i  italic\i0 , \ul underline\ulnone )' +
                 '\par \tab\cf2 Different\cf1  \cf3 colours\par \tab\cf4 Different' +
                 ' \f1 font\f0  \f2 faces\par \tab Different\fs36  font\fs28' +
                 '  \fs44 sizes\fs28\par \cf5 \tab Cut, copy and paste\cf4\par' +
                 ' \tab\cf6\b Drag and drop\cf4\b0\par \cf1\f3\fs18\par }  ';
end;

procedure TForm1.RichMemo1MouseDown(Sender: TObject; Button: TMouseButton;
                                    Shift: TShiftState; X, Y: Integer);
begin
  Edit1Change(Sender);
end;

end.

Code of Form

object Form1: TForm1
  Left = 400
  Height = 338
  Top = 203
  Width = 615
  Caption = 'Searching selected text'
  ClientHeight = 338
  ClientWidth = 615
  OnCreate = FormCreate
  LCLVersion = '1.2.4.0'
  object Button1: TButton
    Left = 532
    Height = 25
    Top = 16
    Width = 75
    Anchors = [akTop, akRight]
    Caption = 'Load RTF'
    OnClick = Button1Click
    TabOrder = 3
  end
  object Button2: TButton
    Left = 440
    Height = 25
    Top = 16
    Width = 75
    Anchors = [akTop, akRight]
    Caption = 'Search'
    OnClick = Button2Click
    TabOrder = 1
  end
  object Edit1: TEdit
    Left = 8
    Height = 23
    Top = 18
    Width = 424
    Anchors = [akTop, akLeft, akRight]
    OnChange = Edit1Change
    TabOrder = 0
    Text = 'Different'
  end
  object RichMemo1: TRichMemo
    Left = 9
    Height = 240
    Top = 80
    Width = 599
    Anchors = [akTop, akLeft, akRight, akBottom]
    HideSelection = False
    Lines.Strings = (
      ''
    )
    OnMouseDown = RichMemo1MouseDown
    ScrollBars = ssAutoBoth
    TabOrder = 2
    ZoomFactor = 1
  end
  object chkCaseSensitive: TCheckBox
    Left = 9
    Height = 19
    Top = 48
    Width = 94
    Caption = 'Case Sensitive'
    TabOrder = 4
  end
  object chkWholeWord: TCheckBox
    AnchorSideLeft.Control = chkCaseSensitive
    AnchorSideLeft.Side = asrBottom
    Left = 108
    Height = 19
    Top = 48
    Width = 86
    BorderSpacing.Left = 5
    Caption = 'Whole Word'
    TabOrder = 5
  end
  object Label1: TLabel
    Left = 400
    Height = 1
    Top = 52
    Width = 1
    Font.Style = [fsBold]
    ParentColor = False
    ParentFont = False
  end
  object OpenDialog1: TOpenDialog
    left = 368
    top = 48
  end
end    
Programming - a skill for life!

How to search a memo in Lazarus and log the results in another memo