unit UParseText;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  MXArrays;

const
  anyChar = [chr(0)..chr(255)];

type
  TLocation = record
                start : integer;
                len   : integer;
              end;
  TSetOfChars = set of char;

  EParseText = class(Exception);

  TPatternPart = class(TComponent)
  private
    { Private-Deklarationen }
    myNumChars   : integer;
    mySetOfChars : TSetOfChars;
  protected
    { Protected-Deklarationen }
  public
    { Public-Deklarationen }
    property numChars   : integer     read myNumChars;
    property setOfChars : TSetOfChars read mySetOfChars;
    procedure init(pattern : string; var position : integer);
  published
    { Published-Deklarationen }
  end;

  TPattern = class(TComponent)
  private
    { Private-Deklarationen }
    myPattern : TStringList;
  protected
    { Protected-Deklarationen }
    procedure createPatternPart(pattern : string; var position : integer);
  public
    { Public-Deklarationen }
    procedure showPattern;
    procedure clear;
    procedure init(pattern : string);
    procedure lowerPatternParts;
    constructor create(AOwner: TComponent); override;
    destructor destroy; override;
  published
    { Published-Deklarationen }
  end;

  EBeforeFindFirst      = procedure of object;
  EAfterFindFirst       = procedure (actMatch : integer) of object;
  EBeforeFindPrev       = procedure (actMatch : integer) of object;
  EAfterFindPrev        = procedure (actMatch : integer) of object;
  EBeforeFindNext       = procedure (actMatch : integer) of object;
  EAfterFindNext        = procedure (actMatch : integer) of object; 
  EBeforeFindLast       = procedure (actMatch : integer) of object;
  EAfterFindLast        = procedure (actMatch : integer) of object;
  ETextChanged          = procedure of object;
  EPatternChanged       = procedure of object;
  ECaseSensitiveChanged = procedure of object;

  TParseText = class(TComponent)
  private
    { Private-Deklarationen }
    myText          : string;
    myPatternString : string;
    myPatternObj    : TPattern;
    myCaseSensitive : boolean;
    myMatches       : TStringList;
    myActMatch      : integer;
    myLastLocation  : TLocation;

    myOnBeforeFindFirst      : EBeforeFindFirst;
    myOnAfterFindFirst       : EAfterFindFirst;
    myOnBeforeFindPrev       : EBeforeFindPrev;
    myOnAfterFindPrev        : EAfterFindPrev;
    myOnBeforeFindNext       : EBeforeFindNext;
    myOnAfterFindNext        : EAfterFindNext;
    myOnBeforeFindLast       : EBeforeFindLast;
    myOnAfterFindLast        : EAfterFindLast;
    myOnTextChanged          : ETextChanged;
    myOnPatternChanged       : EPatternChanged;
    myOnCaseSensitiveChanged : ECaseSensitiveChanged;

    procedure setMyText(t : string);
    procedure setMyPatternString(p : string);
    procedure setMyCaseSensitive(cs : boolean);
  protected
    { Protected-Deklarationen }

    procedure BeforeFindFirst; dynamic;
    procedure AfterFindFirst(actMatch : integer); dynamic;
    procedure BeforeFindPrev(actMatch : integer); dynamic;
    procedure AfterFindPrev(actMatch : integer); dynamic;
    procedure BeforeFindNext(actMatch : integer); dynamic;
    procedure AfterFindNext(actMatch : integer); dynamic;
    procedure BeforeFindLast(actMatch : integer); dynamic;
    procedure AfterFindLast(actMatch : integer); dynamic;
    procedure TextChanged; dynamic;
    procedure PatternChanged; dynamic;
    procedure CaseSensitiveChanged; dynamic;

    function getNextMatch : boolean;
  public
    { Public-Deklarationen }
  published
    { Published-Deklarationen }
    property text          : string  read myText          write setMyText;
    property pattern       : string  read myPatternString write setMyPatternString;
    property caseSensitive : boolean read myCaseSensitive write setMyCaseSensitive;

    property OnBeforeFindFirst      : EBeforeFindFirst      read myOnBeforeFindFirst      write myOnBeforeFindFirst;
    property OnAfterFindFirst       : EAfterFindFirst       read myOnAfterFindFirst       write myOnAfterFindFirst;
    property OnBeforeFindPrev       : EBeforeFindPrev       read myOnBeforeFindPrev       write myOnBeforeFindPrev;
    property OnAfterFindPrev        : EAfterFindPrev        read myOnAfterFindPrev        write myOnAfterFindPrev;
    property OnBeforeFindNext       : EBeforeFindNext       read myOnBeforeFindNext       write myOnBeforeFindNext;
    property OnAfterFindNext        : EAfterFindNext        read myOnAfterFindNext        write myOnAfterFindNext;
    property OnBeforeFindLast       : EBeforeFindLast       read myOnBeforeFindLast       write myOnBeforeFindLast;
    property OnAfterFindLast        : EAfterFindLast        read myOnAfterFindLast        write myOnAfterFindLast;
    property OnTextChanged          : ETextChanged          read myOnTextChanged          write myOnTextChanged;
    property OnPatternChanged       : EPatternChanged       read myOnPatternChanged       write myOnPatternChanged;
    property OnCaseSensitiveChanged : ECaseSensitiveChanged read myOnCaseSensitiveChanged write myOnCaseSensitiveChanged;

    procedure showPattern;
    function findFirst(var loc : TLocation) : boolean;
    function findPrev(var loc : TLocation) : boolean;
    function findNext(var loc : TLocation) : boolean;
    procedure findClose;
    constructor create(AOwner: TComponent); override;
    destructor destroy; override;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Freeware', [TParseText]);
end;

end.
