Searching a Memo and RichMemo

This demonstration is based on this Free Pascal Wiki page but does not use the "very odd" typed constants in the original. To keep it simple, we have not implemented the LoadFromFile or SaveToFile routines of a memo, but you can paste the text to be searched into the top memo. You can also select text in the bottom memo and then copy and paste it into a document to save a log of your searches.

The following page shows you how to search selected text in a RichMemo (which you need to install in Lazarus).

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 uPopupMenuDemo;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
  StdCtrls, strUtils,  LCLProc;

type
  TForm1 = class(TForm)
    btnSearch, btnCount: TButton;  
    Edit1: TEdit;
    Label1: TLabel;
    Memo1, Memo2: TMemo;
    procedure btnCountClick(Sender: TObject);
    procedure btnSearchClick(Sender: TObject);
    procedure Log;
    function FindInMemo(AMemo: TMemo; AString: String; StartPos: Integer): Integer;
  private
    SearchStr: String;
    SearchStart, FoundCount: Integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure TForm1.Log;
begin
  if FoundCount = 1 then
    Memo2.Lines.Add(Edit1.Text + ': 1 match')
  else
    Memo2.Lines.Add(Edit1.Text + ': ' + inttostr(FoundCount) + ' matches');
end;

// FindInMemo: Returns the position where the string to search was found
function TForm1.FindInMemo(AMemo: TMemo; AString: String; StartPos: Integer): Integer;
begin
  Result := PosEx(AString, AMemo.Text, StartPos);
  if Result > 0 then
  begin
    AMemo.SelStart := UTF8Length(PChar(AMemo.Text), Result - 1);
    AMemo.SelLength := Length(AString);
    AMemo.SetFocus;
  end;
end;

procedure TForm1.btnSearchClick(Sender: TObject);
begin
  if SearchStr <> Edit1.Text then
    begin       // If the string to search for changed
      SearchStart := 0;
      FoundCount := 0;
      SearchStr := Edit1.Text;
    end;
  SearchStart := FindInMemo(Memo1, SearchStr, SearchStart + 1);
  if SearchStart > 0 then
    begin
     label1.Caption := 'Found at position ' + IntToStr(SearchStart);
     inc(FoundCount);
    end
  else
    begin
      if FoundCount = 0 then
        label1.Caption := 'Not found'
      else
        label1.Caption := 'No more occurrences';
      Log;
    end;
end;

procedure TForm1.btnCountClick(Sender: TObject);
begin
  SearchStart := 0;
  FoundCount := 0;
  SearchStr := Edit1.Text;
  repeat
    SearchStart := PosEx(SearchStr, Memo1.Text, SearchStart + 1);
    if SearchStart > 0 then
      inc(FoundCount);
  until SearchStart < 1;
  label1.Caption := ' Matches: ' + inttostr(FoundCount);
  Log;
  SearchStart := 0;
  FoundCount := 0;
end;

end.

Code of Form

object Form1: TForm1
  Left = 166
  Height = 337
  Top = 130
  Width = 255
  Caption = 'Searching a Memo'
  ClientHeight = 337
  ClientWidth = 255
  LCLVersion = '1.2.4.0'
  object Memo1: TMemo
    Left = 8
    Height = 106
    Top = 48
    Width = 240
    Lines.Strings = (
      'one'
      'one two'
      'one two three'
      'one two three four'
      'one two three four five'
      'one two three four five six'
    )
    TabOrder = 0
  end
  object btnSearch: TButton
    Left = 92
    Height = 25
    Top = 15
    Width = 75
    Caption = 'Search'
    OnClick = btnSearchClick
    TabOrder = 1
  end
  object Edit1: TEdit
    Left = 8
    Height = 23
    Top = 16
    Width = 80
    TabOrder = 2
    Text = 'three'
  end
  object Label1: TLabel
    Left = 8
    Height = 1
    Top = 160
    Width = 1
    ParentColor = False
  end
  object Memo2: TMemo
    Left = 8
    Height = 144
    Top = 184
    Width = 238
    TabOrder = 3
  end
  object btnCount: TButton
    Left = 173
    Height = 25
    Top = 16
    Width = 75
    Caption = 'Count'
    OnClick = btnCountClick
    TabOrder = 4
  end
end
Programming - a skill for life!

Using widgets (such as list boxes, combo boxes, string grids, DBgrids, charts and maps) and drawing on the canvas