unit vcl.wwlocate;
{
//
// Component : TwwLocateDialog
//
// Non-indexed searching
//
// Copyright (c) 1995-2001 by Woll2Woll Software
//
// 11/06/1997 - Changed UpperCase to AnsiUpperCase and OEMTOANSI to Dataset.Translate
//              to handle international character support.
//
// 11/10/97 - Do not call dbiGetNextRecord for memo field
// 12/12/97 - Changed MemoMatch to use String instead of BlobStream technique.
// 1/7/98 - Ensure non-null value when comparing floating field value from table
//
// 4/20/98 - Test eof after calling dataset.Next
//
// 1/21/01 - Add CloseOnMatch property to allow dialog to stay open
// 10/16/01- Support ftLargeInt.
// 10/25/2001 - Need to check EOF again. (PYW)
}

interface

{$i wwIfDef.pas}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, db, ExtCtrls,
{$ifndef GRIDESSENTIALS}
  wwdialog,
{$endif}
  dbctrls, {Wwdbcomb, }wwstr,
  system.Types, system.UITypes;

type

  TwwLocateMatchType = (mtExactMatch,  mtPartialMatchStart, mtPartialMatchAny);
  TwwFieldSortType = (fsSortByFieldNo, fsSortByFieldName);
  TwwDefaultButtonType = (dbFindFirst, dbFindNext);
  TwwFieldSelection = (fsAllFields, fsVisibleFields);
  TwwLocateDlgOption = (ldoCaseSensitiveBelow, ldoCloseOnMatch, ldoPreserveSearchText);
  TwwLocateDlgOptions = Set of TwwLocateDlgOption;

  TwwLocateDlg = class;
  TwwOnInitLocateDlgEvent = procedure(Dialog : TwwLocateDlg) of object;
  TwwLocateSelectFieldEvent = procedure(Dialog: TwwLocateDlg; SearchField: string) of object;


  TwwLocateDlg = class(TForm)
    SearchTypeGroup: TGroupBox;
    FieldsGroup: TGroupBox;
    CaseSensitiveCheckBox: TCheckBox;
    ExactMatchBtn: TRadioButton;
    PartialMatchStartBtn: TRadioButton;
    PartialMatchAnyBtn: TRadioButton;
    Panel1: TPanel;
    FieldValueGroup: TGroupBox;
    SearchValue: TEdit;
    FirstButton: TButton;
    NextButton: TButton;
    FieldNameComboBox: TComboBox;
    procedure FindFirst(Sender: TObject);
    procedure FindNextBtnClick(Sender: TObject);
    procedure BitBtn1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FieldNameComboBoxChange(Sender: TObject);
    procedure FieldNameComboBoxEnter(Sender: TObject);
    procedure FieldNameComboBoxExit(Sender: TObject);
    procedure FieldNameComboBoxKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);

  private
    Function GetFieldNameFromTitle(fieldTitle: string): string;
    procedure ApplyIntl;

  public
    DataSet: TDataSet;
    {$ifdef wwDelphi2008Up}
    CancelBtn: TCustomButton;
    {$else}
    CancelBtn: TButton;
    {$endif}
    DlgComponent: TComponent;
    Function FindMatch(FromBeginning: boolean): boolean;
    constructor Create(AOwner: TComponent); override;
  end;

{$ifndef GRIDESSENTIALS}
TwwLocateDialog = class(TwwCustomDialog)
  private
     FCaption: String;
     FDataField: String;
     FDataLink: TDataLink;
     FFieldValue: string;
     FMatchType: TwwLocatematchType;
     FCaseSensitive: boolean;
     FSortFields: TwwFieldSortType;
     FDefaultButton: TwwDefaultButtonType;
     FFieldSelection: TwwFieldSelection;
     FShowMessages: boolean;
     FOptions: TwwLocateDlgOptions;
//     FCloseOnMatch: boolean;
     FOnInitDialog: TwwOnInitLocateDlgEvent;
     FOnSelectField: TwwLocateSelectFieldEvent;
     FUseLocateMethod: boolean;
//     FUseLocateMethod: boolean;

     procedure SetDataSource(value : TDataSource);
     Function GetDataSource: TDataSource;

  protected
     procedure DoInitDialog; virtual;  { called by locate dialog form }
  public
     Form: TwwLocateDlg;  {Used by TwwLocateDlg }
     Patch: Variant;

     function GetPrimaryDataSet: TDataSet; override;

     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;

     function Execute: boolean; override;  { shows dialog }
     function FindPrior: boolean;
     function FindNext: boolean;
     function FindFirst: boolean;
     property FieldValue: string read FFieldValue write FFieldValue;
  published
     property Caption: string read FCaption write FCaption;
     property DataSource: TDataSource read GetDataSource write SetDataSource;
     property SearchField: String read FDataField write FDataField;
     property MatchType: TwwLocateMatchType read FMatchType write FMatchType;
     property CaseSensitive: boolean read FCaseSensitive write FCaseSensitive;
     property SortFields: TwwFieldSortType read FSortFields write FSortFields;
     property DefaultButton: TwwDefaultButtonType read FDefaultButton write FDefaultButton;
     property FieldSelection: TwwFieldSelection read FFieldSelection write FFieldSelection;
     property ShowMessages: boolean read FShowMessages write FShowMessages;
     property UseLocateMethod: boolean read FUseLocateMethod write FUseLocateMethod default False;
     property Options : TwwLocateDlgOptions read FOptions write FOptions default [ldoCloseOnMatch];
//     property CloseOnMatch: boolean read FCloseOnMatch write FCloseOnMatch default True;
     property OnInitDialog: TwwOnInitLocateDlgEvent read FOnInitDialog write FOnInitDialog;
     property OnSelectField: TwwLocateSelectFieldEvent read FOnSelectField write FOnSelectField;
//     property UseLocateMethod: boolean read FUseLocateMethod write FUseLocateMethod;
 end;
{$endif}

Function wwFindMatch(FromBeginning: boolean;
	       DataSet: TDataSet;
	       searchField: string;
	       searchValue: string;
	       matchType: TwwLocateMatchType;
	       caseSens: boolean;
               UseLocateMethod: boolean = False): boolean;

var
  wwLocateDlg: TwwLocateDlg;

implementation

uses wwCommon, wwSystem, wwintl,
     comctrls;

{$ifndef GRIDESSENTIALS}
{$R *.DFM}
{$endif}

Function Match(val1: string; val2: string;
	       matchType: TwwLocateMatchType;
	       caseSens: boolean): boolean;
var matchPos: integer;
begin
   if not caseSens then val1:= AnsiUppercase(val1); {11/06/1997 - Changed to AnsiUppercase}

   if MatchType = mtExactMatch then begin
      if length(val1)<>length(val2) then result:= False
      else begin
	 if length(val1)=0 then result:= True
	 else begin
	    matchPos:= Pos(val2, val1);
	    result:= (matchPos=1);
	 end
      end
   end else if matchType = mtPartialMatchStart then
   begin
      matchPos:= Pos(val2, val1);
      result:= (matchPos=1);
   end
   else if MatchType = mtPartialMatchAny then
   begin
      matchPos:= Pos(val2, val1);
      result:= (matchPos<>0);
   end
   else result:= False;

end;

{ 12/12/97 - Changed MemoMatch to use String instead of BlobStream technique.}
{$ifdef wwDelphi3Up}
Function MemoMatch(field : TField;
	       memoBuffer: PChar; val1 :Pchar;
	       matchType: TwwLocateMatchType;
	       caseSens: boolean;
               RichEditControl: TRichEdit): boolean;
var matchPos: Integer;
    s: string;
begin
{   result:= False;}

   if RichEditControl<>Nil then
   begin
      RichEditControl.PlainText:= False;
      RichEditControl.Lines.Assign(Field);
      RichEditControl.PlainText:= True;
      s:= RichEditControl.Text;
   end
   else s:= field.asstring;

   if not caseSens then s := AnsiUpperCase(s);

   if MatchType = mtExactMatch then begin
      {$WARNINGS OFF}
      if strlen(val1)<>length(s) then result:= False
      {$WARNINGS ON}
      else begin
         matchPos:= AnsiPos(StrPas(val1),s);
         result:= (matchPos=1);
      end
   end
   else if matchType = mtPartialMatchStart then begin
       matchPos:= AnsiPos(StrPas(val1),s);
       result:= (matchPos=1);
   end
   else if MatchType = mtPartialMatchAny then begin
       matchPos:= AnsiPos(StrPas(val1),s);
       result:= (matchPos<>0);
   end
   else result:= False;
end;

{$else}
Function MemoMatch(field : TField;
	       memoBuffer: PChar; val1 :Pchar;
	       matchType: TwwLocateMatchType;
	       caseSens: boolean): boolean;
var matchPtr: PChar;
    numread: integer;
    blobStream: TBlobStream;
begin
   result:= False;
   blobStream:= Nil;
   try
      blobStream:= TBlobStream.create(TBlobField(field), bmRead);
      if blobStream=Nil then begin
	 MessageDlg('Fail to create blob', mtinformation, [mbok], 0);
	 exit;
      end;

      numread:= blobStream.read(memobuffer^, 32767);
      memobuffer[numread]:= #0; { null-terminate }

      if numread = 0 then strcopy(memobuffer, '');

      if not caseSens then
        StrUpper(memobuffer);

      if MatchType = mtExactMatch then begin
	 if strlen(val1)<>numread then result:= False
	else begin
	    matchPtr:= strPos(memobuffer, val1);
	    if matchPtr<>Nil then
	       result:= (matchPtr=memoBuffer);
	 end
      end else if matchType = mtPartialMatchStart then
      begin
	 matchPtr:= strPos(memobuffer, val1);
	 if matchPtr<>Nil then
	    result:= (matchPtr=memoBuffer);
      end
      else if MatchType = mtPartialMatchAny then
      begin
	 matchPtr:= strPos(memobuffer, val1);
	 result:= (matchPtr<>Nil);
      end
      else result:= False;
   finally
       blobStream.free;
   end;
end;

{$endif}

{$Warnings Off}
{$ifdef wwDelphi2008Up}
Function ValueAsString(field : TField; buffer: PAnsiChar) : string;
{$else}
Function ValueAsString(field : TField; buffer: PChar) : string;
{$endif}
type
   WordPtr =^Word;
   IntegerPtr = ^Integer;
   LongPtr =^LongInt;
   FloatPtr = ^Double;
   Int64Ptr=^Int64;

   TDateTimeRec = record
     case TFieldType of
       ftDate: (Date: Longint);
       ftTime: (Time: Longint);
       ftDateTime: (DateTime: TDateTime);
   end;
   DateTimePtr = ^TDateTimeRec;

var
   DateTimeData: TDateTimeRec;
   floatValue: Double;

    TimeStamp: TTimeStamp;

begin
   result:= '';

   case field.DataType of
      ftString:
	 begin
	    if (field is TStringField) then
	       if TStringField(field).transliterate then
               begin
                  { 11/06/1997 - Added international character support.}
                  {$ifdef wwDelphi2008Up}
                  Field.DataSet.Translate(Buffer,Buffer,False);
//                  Field.DataSet.Translate(PByte(Buffer),PByte(Buffer),False);
                  {$else}
                  Field.DataSet.Translate(Buffer,Buffer,False);
                  {$endif}
               end;
	    result:= strPas(buffer);
	 end;

      ftSmallInt, ftWord: result:= inttostr(WordPtr(buffer)^);

      ftInteger: result:= inttostr(LongPtr(buffer)^);

      ftLargeInt: result := inttostr(Int64Ptr(Buffer)^);  //10/16/2001-Support ftLargeInt?

      ftAutoInc: result:= inttostr(LongPtr(buffer)^);  { 12/2/96 - Support autoincrement field }

      {$ifdef wwDelphi6Up}
      ftFMTBcd,
      {$endif}

      {$ifdef wwDelphi2011Up}
      ftSingle,
      {$endif}

      ftFloat, ftBCD, ftCurrency:
	 begin
	    floatValue:= FloatPtr(buffer)^;
	    result:= floattostr(floatValue);
	 end;

      ftBoolean: begin
		     if buffer[0]<>char(0) then result:= 'True'
		     else result:= 'False';
		 end;

      ftDateTime:  begin
	    DateTimeData:= DateTimePtr(buffer)^;
            result := DateToStr(TimeStampToDateTime(MSecsToTimeStamp(FloatPtr(Buffer)^))); {12/10/96 }
	 end;

      ftDate :  begin
	    DateTimeData:= DateTimePtr(buffer)^;
	    TimeStamp.Time:= 0;
	    TimeStamp.Date:= DateTimeData.Date;
	    result:= DateToStr(TimeStampToDateTime(TimeStamp));
	 end;

      ftTime :  begin
	    DateTimeData:= DateTimePtr(buffer)^;
	    result:= TimeToStr(DateTimeData.Time/MSecsPerDay);
	 end;

      else;
   end
end;
{$Warnings On}


Function wwFindMatch(FromBeginning: boolean;
	       DataSet: TDataSet;
	       searchField: string;
	       searchValue: string;
	       matchType: TwwLocateMatchType;
	       caseSens: boolean;
               UseLocateMethod: boolean = False): boolean;
var FindText, TableFieldValue: string;
    //fieldNo: integer;
    MatchFound: boolean;
    cfindText, recBuffer, buffer, memobuffer: PChar;
    //isBlank: Bool;
    Bookmark: TBookmark;
    fldtype: TFieldType;
    curfield: TField;
    currentValue: string;
    stopOnMismatch: boolean;
    firstIndexField: TField;
    IndexFieldCount: integer;
    TempRichEdit: TRichEdit;
    IndexDefs: TIndexDefs;
    DisabledControls: boolean;

  Function IndexCaseSensitive(Tbl: TDataSet): boolean;
  begin
     result:= wwDataSetIsCaseSensitiveIndex(tbl);
(*
     if Tbl is TTable then with Tbl as TTable do begin
        for i:= 0 to IndexDefs.count-1 do begin      {11/06/1997-Changed to AnsiUpperCase}
           if (AnsiUppercase(IndexDefs.Items[i].Name)=AnsiUppercase(IndexName)) then begin
    	      result:= not (ixCaseInsensitive in IndexDefs.Items[i].Options);
              break;
           end
        end
     end
*)
  end;

   { Make sure indexed field is in field map}
   Function ValidIndexField: boolean;
   var parts: TStrings;
       i: integer;
   begin
      result:= False;
      parts:= TStringList.create;

      with dataset do for i:= 0 to IndexDefs.count-1 do begin
	 with IndexDefs do begin
	     if (AnsiUppercase(wwGetIndexName(dataset))=AnsiUppercase(Items[i].name)) then {Changed to AnsiUpperCase}
	     begin
		strBreakApart(Items[i].fields, ';', parts);
		if parts.count<=0 then continue;
		result:= FindField(parts[0])<>Nil;
		break;
	     end
	 end
      end;

      parts.Free;
   end;

   procedure ApplyMatch;
   begin
      dataset.updatecursorpos;  {4/14/97}
      dataset.resync([rmExact,rmCenter]); { Always call resync }
      MatchFound := True;
   end;

   Function FloatingType(field: TField): boolean;
   begin
      result:= field.DataType in [ftFloat, ftBCD,
      {$ifdef wwDelphi6Up}
      ftFMTBcd,
      {$endif}

      {$ifdef wwDelphi2011Up}
      ftSingle,
      {$endif}

      ftCurrency];
   end;

   Function GetNextFieldValue(Forward: boolean; var FieldValue: string): boolean;
   //var res: variant;
   begin
      FieldValue:= '';

      if True or wwisNonBDEField(curField) then begin // Bypass bde specific optimizations to remove bde dependency
         Result:= not DataSet.eof;
	       if Result then begin
	          Dataset.Next;
            // 10/25/2001 - Need to check EOF again. (PYW)
            result := not Dataset.eof;
            if result then FieldValue:= curField.asString;
         end
      end
      else begin
{
         FieldValue:= '';
         res:= wwGetVariableWithParams(DataSet, 'GetNextFieldValue', searchField);
         result:= (res<>null);
         if result then FieldValue:= res;
}
(*
	       result:= dbiGetNextRecord((Dataset as TDBDataSet).handle, dbiNoLock, buffer, nil)=0;
	       if result then begin
	          dbiGetField((DataSet as TDBDataSet).handle, FieldNo+1, buffer, recBuffer, isBlank);
            if isBlank then FieldValue:= ''  { 4/29/97 - Delphi 1 bug with null fields requires this }
            else FieldValue:= ValueAsString(curField, recBuffer); {5/24/95}
	       end
*)
      end

   end;


   Function FindRecord: boolean;
   begin
     if caseSens then begin
         if (MatchType=mtExactMatch) then result:= DataSet.Locate(searchField, SearchValue, [])
         else result:= DataSet.Locate(searchField, SearchValue, [loPartialKey]);
     end
     else begin
        if (MatchType=mtExactMatch) then result:= DataSet.Locate(searchField, SearchValue, [loCaseInsensitive])
        else result:= DataSet.Locate(searchField, SearchValue, [loPartialKey, loCaseInsensitive]);
     end;
   end;


begin
   Result:= False;
   DataSet.checkBrowseMode;

   curField:= DataSet.findField(searchField);
   if curField=Nil then begin
      MessageDlg('Field ' + searchField + ' not found.', mtWarning, [mbok], 0);
      exit;
   end;

   //FieldNo:= curField.FieldNo - 1;

   if wwMemAvail(32767) then begin
      MessageDlg('Out of memory', mtWarning, [mbok], 0);
      exit;
   end;

   DataSet.updateCursorPos;

   if not caseSens then FindText:= AnsiUppercase(SearchValue) {11/06/1997 - Changed to AnsiUpperCase}
   else FindText:= SearchValue;

   stopOnMismatch:= False;
   wwGetIndexDefs(dataset, IndexDefs);


   if wwIsClass(dataSet, 'TwwTable')
      and (curField.dataType<>ftMemo) and (not wwIsTableQuery(DataSet)) then
   begin
      IndexDefs.update;
      IndexFieldCount:= wwGetIndexFieldCount(dataSet);
      if IndexFieldCount>0 then FirstIndexField:= wwGetIndexFields(dataSet, 0)
      else FirstIndexField:= nil;

      if not caseSens then currentValue:= AnsiUppercase(curField.asString) {11/06/1997- Changed to AnsiUpperCase}
      else currentValue:= curField.asString;;

      if (indexFieldCount>0) and (matchType=mtExactMatch) and
	 validIndexField and
	 (AnsiUppercase(curField.fieldName) = AnsiUppercase(FirstIndexField.fieldName)) and
	 ((currentValue<>FindText) or FromBeginning) and (curField.dataType<>ftBoolean) then
      begin
	 if (curField.DataType <> ftString) or {case sensitive matches index }
	    (IndexCaseSensitive(dataSet) = caseSens) then
	 begin
            result:= wwGetVariableWithParams2(dataset, 'FindKey', [FindText], []);
            exit;
//            result:= (dataSet as TTable).findKey([FindText]);
	 end
      end;

      { Partial match start using index}
      if (indexFieldCount>0) and (matchType=mtPartialMatchStart) and
	 validIndexField and
	 (AnsiUppercase(curField.fieldName) = AnsiUppercase(FirstIndexField.fieldName)) and
	 (curField.dataType=ftString) then
      begin
	 if (IndexCaseSensitive(dataSet) = caseSens) then
	 begin
	    stopOnMismatch:= True;

	    if ((not Match(FirstIndexField.asString, FindText, matchType, caseSens)) or
		fromBeginning) then
	    begin

	       if not FromBeginning then begin
		 if not caseSens then begin
		    if (FindText<Ansiuppercase(FirstIndexField.asString)) then exit;  {Not found} {11/07/1997 - Changed to AnsiUpperCase}
		 end
		 else begin
		    if (FindText<FirstIndexField.asString) then exit;  {Not found}
		 end
	       end;

               wwGetVariableWithParams2(dataset, 'FindNearest', [FindText], []);
//               if (dataSet is TTable) then
//                  (dataSet as TTAble).findNearest([FindText]);
	       result:= Match(FirstIndexField.asString, FindText, matchType, caseSens);
	       exit;
	    end
	 end
      end
   end;

   buffer:= Nil;
   recBuffer:= Nil;
   cfindText:= Nil;
   memoBuffer:= Nil;
   bookmark:= nil;
   tempRichEdit:= nil;
   DisabledControls:= false;
   try
      fldType:= curField.DataType;

      GetMem(buffer, 32767);
      GetMem(recBuffer, 256);
      Bookmark:= Dataset.GetBookmark;
      if FromBeginning then begin
	 DataSet.First; { do before allocating blob }
	 DataSet.updateCursorPos;
      end;

      if fldType = ftMemo then begin
	 GetMem(memoBuffer, 32767);
	 GetMem(cFindText, 256);
	 strpcopy(cfindText, FindText);
	 if not caseSens then
           AnsiStrUpper(cfindText); {11/06/1997 - Changed to AnsiStrUpper}
         if wwIsRichEditField(curField, True) then begin
            tempRichEdit:= TRichEdit.create(Screen.ActiveForm);
            tempRichEdit.visible:= False;
            tempRichEdit.parent:= Screen.ActiveForm;
         end
      end;

      Screen.cursor:= crHourGlass;

      if FromBeginning then begin
	 if fldType <> ftMemo then begin
	    if (matchType = mtExactMatch) and FloatingType(curField) and (FindText<>'') then begin
	       if wwStrToFloat(FindText) and (curField.asFloat=StrToFloat(FindText)) then
	       begin
		  ApplyMatch;
		  exit;
	       end
	    end
	    else if Match(curField.asString, FindText, matchType, caseSens) then
	    begin
	       ApplyMatch;
	       exit;
	    end
	 end
	 else begin
	    if MemoMatch(curField, memoBuffer, CFindText, matchType, caseSens, TempRichEdit) then
	    begin
	       ApplyMatch;
               exit;
            end
	 end;
	 DataSet.updateCursorPos;

      end;

      MatchFound:= False;
      if fldType <> ftMemo then begin
	       {if wwisNonBDEField(curField) then }
         Dataset.DisableControls;  // 4/24/10 - Always disablecontrols now
         DisabledControls:=true;

         { 2/24/2000 - Optimization for ADO datasets - Use locate method }
         if FromBeginning and (matchType in [mtExactMatch, mtPartialMatchStart]) then
         begin
            if (wwInternational.ADO.UseLocateWhenFindingValue and
                wwIsClass(DataSet.ClassType, 'TCustomADODataSet')) or
                UseLocateMethod then
            begin
               if (curField.dataType<>ftMemo) and not (curField.calculated) and
                  not (curfield.lookup) then
               begin
                  if FindRecord then ApplyMatch;
                  exit;
               end
            end
         end;

	 while GetNextFieldValue(True, TableFieldValue) do
	 begin
	    if (matchType = mtExactMatch) and FloatingType(curField) and (FindText<>'') then begin
	       if wwStrToFloat(FindText) and (TableFieldValue<>'') and {1/7/98 - Ensure non-null value }
                 (StrToFloat(TableFieldValue)=StrToFloat(FindText)) then
	       begin
		  ApplyMatch;
		  exit;
	       end
	    end
	    else if Match(TableFieldValue, FindText, matchType, caseSens) then
	    begin
	       ApplyMatch;
	       break;
	    end
	    else if StopOnMismatch then break;
	 end
      end
      else begin
	 Dataset.DisableControls;
         DisabledControls:=True;
         while True do
         begin
            { 11/10/97 - Do not call dbiGetNextRecord for memo field }
            if DataSet.eof then break;
            DataSet.Next;
            if DataSet.eof then break;  { 4/20/98 - Test eof after calling Next }

            if MemoMatch(curField, memoBuffer, CFindText, matchType, caseSens, TempRichEdit) then
	    begin
               ApplyMatch;
               break;
            end
	 end;
	 Dataset.EnableControls;
      end;

   finally
      {if wwisNonBDEField(curField) then } Dataset.EnableControls; // 4/24/10 - Always disablecontrols now
      if DisabledControls then
         DataSet.EnableControls;
      FreeMem(recBuffer, 256);
      FreeMem(buffer, 32767);
      if curField.dataType = ftMemo then begin
	 FreeMem(cFindText, 256);
	 FreeMem(memoBuffer, 32767);
      end;
      Screen.cursor:= crDefault;
      if (not MatchFound) then dataSet.gotoBookmark(bookmark);
      dataSet.FreeBookmark(bookmark);
      tempRichEdit.Free;

      result:= MatchFound;
   end;
end;

constructor TwwLocateDlg.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   CancelBtn:= TButton(wwCreateCommonButton(Self, bkCancel));
   CancelBtn.TabOrder := 5;
   CancelBtn.Width:= (screen.pixelsperinch * 72) div 96;
   CancelBtn.visible:= True;
   CancelBtn.Top:= NextButton.Top;
   CancelBtn.Left:= FieldsGroup.Left + FieldsGroup.Width - CancelBtn.Width - 1;
   CancelBtn.Height:= (screen.pixelsperinch * 27) div 96;
end;

Function TwwLocateDlg.GetFieldNameFromTitle(fieldTitle: string): string;
var i: integer;
begin
   result:= '';

   with DataSet do begin
      { Give priority to non-calculated fields of the same name, if they exist }
      for i:= 0 to fieldCount-1 do begin
	 if wwisNonPhysicalField(fields[i]) then continue;
	 if strReplaceChar(fields[i].displayLabel,'~',' ')=strReplaceChar(fieldTitle,'~',' ') then begin
	    result:= fields[i].FieldName;
	    exit;
	 end
      end;

      for i:= 0 to fieldCount-1 do begin
	 if not wwisNonPhysicalField(fields[i]) then continue;
	 if strReplaceChar(fields[i].displayLabel,'~', ' ')=strReplaceChar(fieldTitle,'~', ' ') then begin
	    result:= fields[i].FieldName;
	    exit;
	 end
      end
   end;
end;

Function TwwLocateDlg.FindMatch(FromBeginning: boolean): boolean;
var
   MatchType: TwwLocateMatchType;
   curFieldName: string;
begin
   result:= false;
   if ExactMatchBtn.Checked then
      MatchType:= mtExactmatch
   else if PartialMatchStartBtn.Checked then
      MatchType:= mtPartialMatchStart
   else MatchType:= mtPartialMatchAny;

   curFieldName:= getfieldNameFromTitle(FieldNameComboBox.text);
   if curFieldName='' then exit;

{$ifndef GRIDESSENTIALS}
   result:= wwFindMatch(FromBeginning, DataSet, curFieldName,
	searchValue.text, matchType, CaseSensitiveCheckbox.State<> cbUnchecked,
        (DlgComponent as TwwLocateDialog).UseLocateMethod);
{$endif}
end;

procedure TwwLocateDlg.FindFirst(Sender: TObject);
begin
{$ifndef GRIDESSENTIALS}
   if not FindMatch(True) then begin
      MessageDlg(wwInternational.UserMessages.LocateNoMatches,
	 mtInformation, [mbok], 0);
   end
   else if (ldoCloseOnMatch in (DlgComponent as TwwLocateDialog).Options) then
      ModalResult:= mrOK;
{$endif}
end;

procedure TwwLocateDlg.FindNextBtnClick(Sender: TObject);
begin
{$ifndef GRIDESSENTIALS}
   if not FindMatch(False) then begin
      MessageDlg(wwInternational.UserMessages.LocateNoMoreMatches,
	   mtInformation, [mbok], 0);
   end
   else if (ldoCloseOnMatch in (DlgComponent as TwwLocateDialog).Options) then
      ModalResult:= mrOK;
{$endif}
end;


procedure TwwLocateDlg.BitBtn1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   if (key = VK_ESCAPE) then
      ModalResult := mrCancel;
end;

{$ifndef GRIDESSENTIALS}

function TwwLocateDialog.Execute: boolean;
var
   field: TField;
   i: integer;
begin
   result:= True;
   with TwwLocateDlg.create(Application) do
   try
      if (DataSource=Nil) or (DataSource.dataSet=Nil) or
	 (not DataSource.dataSet.active) then begin
	 MessageDlg('DataSource does not reference an active DataSet', mtError, [mbok], 0);
	 exit;
      end;
      DlgComponent:= Self;
      field:= DataSource.DataSet.findField(SearchField);
      FieldNameComboBox.items.clear;
      if SortFields = fsSortByFieldNo then
	 FieldNameComboBox.sorted:= False;

      if DefaultButton = dbFindFirst then begin
	 FirstButton.Default:= True;
	 NextButton.Default:= False;
      end
      else begin
	 FirstButton.Default:= False;
	 NextButton.Default:= True;
      end;

      with DataSource.DataSet do begin
	 for i:= 0 to fieldCount-1 do begin
{            if not fields[i].calculated then begin}
	       if (fields[i].dataType = ftBlob) or (fields[i].dataType=ftGraphic) or
		  (fields[i].dataType = ftVarBytes) or (fields[i].dataType=ftBytes) then
		  continue;
	       if (FFieldSelection = fsAllFields) or (fields[i].visible) then
		  FieldNameComboBox.items.add(strReplaceChar(fields[i].DisplayLabel, '~',' '));
{            end}
	 end
      end;
      if field<>Nil then begin
	 SearchValue.Text:= fieldValue;
	 FieldNameCombobox.itemIndex:=
	    FieldNameComboBox.items.indexOf(strReplaceChar(Field.displayLabel, '~',' '));
      end
      else SearchValue.text:= '';

      DataSet:= dataSource.DataSet;
      caseSensitiveCheckBox.checked:= caseSensitive;
      case matchType of
	 mtExactMatch: ExactMatchBtn.checked:= True;
	 mtPartialMatchStart: PartialMatchStartBtn.checked:= True;
	 mtPartialMatchAny: PartialMatchAnyBtn.checked:= True;
      end;

      Caption:=  self.Caption;
      Result := ShowModal = IDOK;

      { Use user selections from dialog to update this component }
      if ExactMatchBtn.Checked then
	 MatchType:= mtExactmatch
      else if PartialMatchStartBtn.Checked then
	 MatchType:= mtPartialMatchStart
      else MatchType:= mtPartialMatchAny;
      caseSensitive:= caseSensitiveCheckBox.checked;
      fieldValue:= SearchValue.Text;
      SearchField:= getfieldNameFromTitle(FieldNameComboBox.text);

   finally
      Free;
   end

end;

constructor TwwLocateDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  MatchType:= mtPartialMatchStart;
  caseSensitive:= False;
  SortFields:= fsSortByFieldName;
  Caption:=  'Locate Field Value';
  FDefaultButton:= dbFindNext;
  FFieldSelection:= fsAllFields;
  FDataLink:= TDataLink.create;
  FShowMessages:= True;
  FOptions:= [ldoCloseOnMatch];

  if wwGridEssentials then
  begin
      DisplayProfessionalVersionOnlyMessage(self, 'TwwLocateDialog is only supported in the professional version');
  end;

//  FCloseOnMatch:= True;

end;

destructor TwwLocatedialog.Destroy;
begin
  FDataLink.free;
  inherited destroy;
end;

procedure TwwLocateDialog.SetDataSource(value : TDataSource);
begin
   FDataLink.dataSource:= value;
end;

Function TwwLocateDialog.getDataSource: TDataSource;
begin
   Result:= FdataLink.dataSource;
end;

function TwwLocateDialog.FindPrior: boolean;
begin
   result:= False;
end;

function TwwLocateDialog.FindFirst: boolean;
begin
   result:= False;
   if (dataSource=Nil) or (datasource.dataset=Nil) or (not datasource.dataset.active) then
   begin
      MessageDlg('DataSource does not refer to an active table!', mtWarning, [mbok], 0);
      exit;
   end;
   if FieldValue='' then begin
      DefaultButton:= dbFindFirst;
      result:= execute;
   end
   else begin
      result:= wwFindMatch(True, DataSource.DataSet, SearchField, FieldValue,
	matchType, caseSensitive, UseLocateMethod);
      if (not result) and FShowMessages then
	 MessageDlg(wwInternational.UserMessages.LocateNoMoreMatches,
	   mtInformation, [mbok], 0);
   end
end;

function TwwLocateDialog.FindNext: boolean;
begin
   result:= False;
   if (dataSource=Nil) or (datasource.dataset=Nil) or (not datasource.dataset.active) then
   begin
      MessageDlg('DataSource does not refer to an active table!', mtWarning, [mbok], 0);
      exit;
   end;
   if FieldValue='' then begin
      DefaultButton:= dbFindNext;
      result:= execute;
   end
   else begin
      result:= wwFindMatch(False, DataSource.DataSet, SearchField, FieldValue,
	 matchType, caseSensitive, UseLocateMethod);
      if (not result) and FShowMessages then
	 MessageDlg(wwInternational.UserMessages.LocateNoMoreMatches,
	   mtInformation, [mbok], 0);
   end

end;
{$endif}

procedure TwwLocateDlg.FieldNameComboBoxChange(Sender: TObject);
{$ifndef GRIDESSENTIALS}
var Dlg: TwwLocateDialog;
{$endif}
begin
  {$ifndef GRIDESSENTIALS}
   Dlg:= DlgComponent as TwwLocateDialog;

   // 6/15/02
   if not (ldoPreserveSearchText in Dlg.Options) then
       SearchValue.Text:= '';
   if not FieldNameComboBox.DroppedDown then SearchValue.setFocus;
   if DlgComponent=nil then exit;
   if Assigned(TwwLocateDialog(DlgComponent).FOnSelectField) then
      TwwLocateDialog(DlgComponent).FOnSelectField(self, FieldNameComboBox.text);
  {$endif}
end;

procedure TwwLocateDlg.FieldNameComboBoxEnter(Sender: TObject);
begin
   NextButton.default:= False;
end;

procedure TwwLocateDlg.FieldNameComboBoxExit(Sender: TObject);
begin
   NextButton.default:= True;
end;

procedure TwwLocateDlg.FieldNameComboBoxKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
   if (Key=VK_Return) and FieldNameComboBox.DroppedDown then
   begin
      FieldNameComboBox.DroppedDown := False;
      SearchValue.setFocus;
   end
end;

procedure TwwLocateDlg.FormShow(Sender: TObject);
{$ifndef GRIDESSENTIALS}
var Dlg: TwwLocateDialog;
{$endif}
begin
{$ifndef GRIDESSENTIALS}
   ApplyIntl;
   Dlg:= DlgComponent as TwwLocateDialog;
   if not (ldoCloseOnMatch in Dlg.Options) then
   begin
      if CancelBtn is TBitBtn then
      begin
         TBitBtn(CancelBtn).Glyph.Assign(nil);
         TBitBtn(CancelBtn).Margin:=-1;
      end
   end;
   Dlg.Form:= self;

   if {True or }(ldoCaseSensitiveBelow in Dlg.Options) then
   begin
      ExactMatchBtn.Top      := 16;
      PartialMatchStartBtn.Top   := 34;
      PartialMatchAnyBtn.Top   := 52;
      Panel1.Top         := 72;
      CaseSensitiveCheckBox.Top := 75;
   end;

   SearchValue.SetFocus; // 3/7/11 - Focus no longer defaults in Delphi XE

   if Assigned(wwInternational.OnInitInfoPowerDialog) then
      wwInternational.OnInitInfoPowerDialog(Dlg, self);

   Dlg.DoInitDialog;

{$endif}
end;

{$ifndef GRIDESSENTIALS}

Procedure TwwLocateDialog.DoInitDialog;
begin
  if Assigned(FOnInitDialog) then OnInitDialog(Form);
end;
{$endif}

procedure TwwLocateDlg.ApplyIntl;
begin
   Font.Style:= wwInternational.DialogFontStyle;
   with wwInternational.LocateDialog do begin
      FieldValueGroup.caption:= FieldValueLabel;
      SearchTypeGroup.caption:= SearchTypeLabel;
      CaseSensitiveCheckbox.caption:= CaseSensitiveLabel;
      ExactMatchBtn.caption:= MatchExactLabel;
      PartialMatchStartBtn.caption:= MatchStartLabel;
      PartialMatchAnyBtn.caption:= MatchAnyLabel;
      FieldsGroup.caption:= FieldsLabel;
      FirstButton.caption:= BtnFirst;
      NextButton.caption:= BtnNext;
{$ifndef GRIDESSENTIALS}
      if ldoCloseOnMatch in (DlgComponent as TwwLocateDialog).Options then
        wwSetString(CancelBtn, 'Caption', BtnCancel)
//        CancelBtn.caption:= BtnCancel
      else
        wwSetString(CancelBtn, 'Caption', BtnClose);
//        CancelBtn.caption:= BtnClose;
{$endif}
      SearchValue.Hint:= FieldValueHint;
      CaseSensitiveCheckbox.Hint:= CaseSensitiveHint;
      ExactMatchBtn.Hint:= MatchExactHint;
      PartialMatchStartBtn.Hint:= MatchStartHint;
      PartialMatchAnyBtn.Hint:= MatchAnyHint;
      FirstButton.Hint:= BtnFirstHint;
      NextButton.Hint:= BtnNextHint;
      FieldNameComboBox.Hint:= FieldNameHint;
   end;
end;

{$ifndef GRIDESSENTIALS}
function TwwLocateDialog.GetPrimaryDataSet: TDataSet;
begin
  result := nil;
  if DataSource <> nil then
    result := DataSource.DataSet;
end;
{$endif}

end.
