(*********************************************)
(* Name: lplSynSearch                        *)
(* Last Revision: 14 Nov. 2000               *)
(* Version: 1.0                              *)
(*                                           *)
(* Copyright © 2000 - Christian Aaangel      *)
(*********************************************)

////////////////////////////////////////////////////////////////////////////////
// PLEASE NOTICE THAT THIS COMPONENT WON'T WORK IF YOU ARE USING THE {$H-}
// COMPILER DIRECTIVE
////////////////////////////////////////////////////////////////////////////////

unit lplSynSearch;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, SynMemo;

type
  TFound = Procedure (Sender: TObject) of object;
  TNotFound = Procedure (Sender: TObject) of Object;
  TlplSynSearch = class(TComponent)
  private
   FStart: Integer;
   FEnd: Integer;
   FStr: String;
   Fmemo: TSynMemo;
   FFound: Integer;
   FMatchCase: Boolean;
   FWords: Boolean;
   fOnFound: TFound;
   fOnNotFound: TNotFound;
   Procedure SetStart(Value: Integer);
   Procedure SetEnd(Value: Integer);
   Procedure SetStr(Value: String);
   Procedure SetMemo(Value: TSynMemo);
   Procedure SetFound(Value: Integer);
   Procedure SetCase(Value: Boolean);
   Procedure SetWords(Value: Boolean);
  protected
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
  published
   Property Offset_Start: Integer Read FStart Write SetStart;
   Property Offset_End: Integer Read FEnd Write SetEnd;
   Property Search_String: String Read FStr Write SetStr;
   Property Search_Memo: TSynMemo Read FMemo Write SetMemo;
   Property Found: Integer Read FFound Write SetFound;
   Property MatchCase: Boolean Read FMatchcase Write SetCase;
   Property WholeWord: Boolean Read FWords Write SetWords;
   Property OnFound: TFound Read fonFound Write fonFound;
   Property OnNotFound: TNotFound Read fonNotFound Write fonNotFound;
   Procedure Execute;
  end;

procedure Register;

implementation

{$R lplSynSearch.Res}

procedure Register;
begin
  RegisterComponents('LPL Tools', [TlplSynSearch]);
end;

Constructor TlplSynSearch.Create(AOwner: TComponent);
Begin
 inherited Create(AOwner);
 FStart := -1;
 FEnd := -1;
 FStr := '';
 FMemo := Nil;
 FFound := -1;
 FMatchCase := False;
 FWords := False;
End;

Procedure TlplSynSearch.SetStart(Value: Integer);
Begin
 FStart := Value;
End;

Procedure TlplSynSearch.SetEnd(Value: Integer);
Begin
 FEnd := Value;
End;

Procedure TlplSynSearch.SetStr(Value: String);
Begin
 FStr := Value;
End;

Procedure TlplSynSearch.SetMemo(Value: TSynMemo);
Begin
 FMemo := Value;
End;

Procedure TlplSynSearch.SetFound(Value: Integer);
Begin
End;

Procedure TlplSynSearch.SetCase(Value: Boolean);
Begin
 FMatchCase := Value;
End;

Procedure TlplSynSearch.SetWords(Value: Boolean);
Begin
 FWords := Value;
End;

Procedure TlplSynSearch.Execute;
Var
 At, I: Integer;
 S1, S2: String;
 Ok : Boolean;
Begin
 S1 := '';
 If FMemo = nil Then begin
  Application.MessageBox(PChar(Self.name + '.memo is not defined'), PChar('TlplSynSearch Error'), 0);
  Exit;
 End;
 For I := 0 to FMemo.Lines.count-1 do
  S1 := S1 + FMemo.lines[I] + #13#10;
 Ok := False;
 If (FEnd = 0) Or (FEnd > Length(S1)) Then FEnd := Length(S1);
 I := FStart;
 S2 := FStr;
 If FWords Then S2 := ' ' + S2 + ' ';
 If I = 0 Then I := 1;
 At := -1;
 Repeat
  If MatchCase then begin
   If Copy(S1, I, Length(S2)) = S2 Then begin
    At := I-1;
    Ok := True;
   End;
  End
   Else
  Begin
   If Uppercase(Copy(S1, I, Length(S2))) = Uppercase(S2) Then begin
    At := I-1;
    Ok := True;
   End;
  End;
  Inc(I);
 Until Ok or (I > FEnd);
 If Ok And FWords Then At := At + 1;
 If Not Ok Then Begin
  At := -1;
  FFound := At;
  If Assigned(fOnNotFound) then fonNotFound(Self);
 End;
 If Ok Then begin
  FFound := At;
  FStart := At + 2;
  If Assigned(fOnFound) then fonFound(Self);
 End;
End;

end.
