unit mdhReplaceDialog;

{
[mdhReplaceDialog] [1.0]
Delphi 2005
January 2008


LICENSE

The contents of this file are subject to the Mozilla Public License Version
1.1 (the "License"); you may not use this file except in compliance with
the License. You may obtain a copy of the License at
"http://www.mozilla.org/MPL/"

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is "[mdhReplaceDialog.pas] and [mdhReplaceDialog.dfm]".

The Initial Developer of the Original Code is Martin Holmes (Victoria,
BC, Canada, "http://www.mholmes.com/"). Copyright (C) 2005-8 Martin Holmes.
The code was developed by Martin Holmes as part of his personal project
"Markin", and open-sourced in order to make it available for use in projects
developed in his day-job at the University of Victoria. All rights remain with
Martin Holmes. All Rights Reserved.
}

{
  Written by Martin Holmes, October 2007 - January 2008.

  This is designed to be a Unicode search-and-replace dialog box. It should be
  usable as either, based on how it's set up.

  To use this form, first you need to create methods which match the signatures
  of the five procedural types declared at the head of the file. You don't
  actually have to implement all of them, but it's recommended that you at
  least implement TmdhFindProc, TmdhReplaceProc, and TmdhReplaceAllProc.

  Next, call the SetUp procedure and pass in pointers to your functions. If
  you pass in nil for TmdhFindAllProc, that component of the dialog box will
  be hidden. When buttons in the dialog box are pressed, the functions you
  created will be called.

  The dialog box can remember its position and size, and it also keeps a
  history of previous search and replace strings (all WideStrings). You can
  control the number of items it remembers through the ItemsToRetain property.

  Dependencies:

 FormState (to save and reload form state).
 TntUnicode libraries (Troy Wolbrink).
 mdhHelp (Martin Holmes).

}


interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, TntForms, FormState, ExtCtrls, StdCtrls, TntStdCtrls, Buttons,
  TntButtons, ComCtrls, TntComCtrls, TntClasses, TntDialogs, mdhHelp;

type
  TmdhFindProc = procedure(wsFind: WideString;
                           MatchCase, WholeWordOnly, Down: Boolean) of object;
  TmdhFindAllProc = procedure(wsFind: WideString; uslHits: TTntStringList;
                           MatchCase, WholeWordOnly, Down: Boolean) of object;
  TmdhReplaceProc = procedure(wsFind, wsReplaceWith: WideString; var Replaced: Boolean;
                           MatchCase, WholeWordOnly, Down: Boolean) of object;
  TmdhReplaceAllProc = procedure(wsFind, wsReplaceWith: WideString; var TotalReplacements: integer;
                           MatchCase, WholeWordOnly, Down: Boolean) of object;
  TmdhGoToSearchHitProc = procedure(ItemNum: integer) of object;

type
  TufrmReplaceDialog = class(TTntForm)
    ucmbFind: TTntComboBox;
    ulbFind: TTntLabel;
    ubnFind: TTntButton;
    ubnFindAll: TTntButton;
    bvlFind: TBevel;
    ulbReplaceWith: TTntLabel;
    ucmbReplace: TTntComboBox;
    ubnReplace: TTntButton;
    ubnReplaceAll: TTntButton;
    bvlReplace: TBevel;
    ucbMatchCase: TTntCheckBox;
    ucbWholeWord: TTntCheckBox;
    ubnClose: TTntBitBtn;
    ubnHelp: TTntBitBtn;
    bvlList: TBevel;
    ulvHits: TTntListView;
    ulbHits: TTntLabel;
    ulbmsgTotalHits: TTntLabel;
    ulbmsgTotalReplacements: TTntLabel;
    ucbDown: TTntCheckBox;
    ustmsgWrapAroundToBeginning: TTntStaticText;
    ustmsgWrapAroundToEnd: TTntStaticText;
    procedure ubnHelpClick(Sender: TObject);
    procedure ulvHitsResize(Sender: TObject);
    procedure ulvHitsDblClick(Sender: TObject);
    procedure ubnCloseClick(Sender: TObject);
    procedure ubnReplaceAllClick(Sender: TObject);
    procedure ubnReplaceClick(Sender: TObject);
    procedure ubnFindAllClick(Sender: TObject);
    procedure ubnFindClick(Sender: TObject);
    procedure TntFormDestroy(Sender: TObject);
    procedure TntFormCreate(Sender: TObject);
  private
    FFindProc: TmdhFindProc;
    FFindAllProc: TmdhFindAllProc;
    FReplaceProc: TmdhReplaceProc;
    FReplaceAllProc: TmdhReplaceAllProc;
    FGoToSearchHitProc: TmdhGoToSearchHitProc;
    FItemsToRetain: integer;
    FLastFullClientHeight: integer;
    FormStateSaver: TFormStateSaver;
    procedure SetFindProc(Proc: TmdhFindProc);
    procedure SetFindAllProc(Proc: TmdhFindAllProc);
    procedure SetReplaceProc(Proc: TmdhReplaceProc);
    procedure SetReplaceAllProc(Proc: TmdhReplaceAllProc);
    procedure SetGoToSearchHitProc(Proc: TmdhGoToSearchHitProc);
    procedure AssignHitListToListView;
    procedure ClearHitLists;
    procedure HideFindAll;
    procedure ShowFindAll;
    { Private declarations }
  public
    TotalHits: integer;
//This string list is passed to the calling procedure, which is responsible
//for populating it with strings and objects.
    uslHits: TTntStringList;
    procedure SetUp(inFindProc: TmdhFindProc;
                    inFindAllProc: TmdhFindAllProc;
                    inReplaceProc: TmdhReplaceProc;
                    inReplaceAllProc: TmdhReplaceAllProc;
                    inGoToSearchHitProc: TmdhGoToSearchHitProc);
    { Public declarations }
  published
    property ItemsToRetain: integer read FItemsToRetain write FItemsToRetain;
    property FindProc: TmdhFindProc read FFindProc write SetFindProc;
    property FindAllProc: TmdhFindAllProc read FFindAllProc write SetFindAllProc;
    property ReplaceProc: TmdhReplaceProc read FReplaceProc write SetReplaceProc;
    property ReplaceAllProc: TmdhReplaceAllProc read FReplaceAllProc write SetReplaceAllProc;
    property GoToSearchHitProc: TmdhGoToSearchHitProc read FGoToSearchHitProc
             write SetGoToSearchHitProc;
  end;

var
  ufrmReplaceDialog: TufrmReplaceDialog;

implementation

{$R *.DFM}

procedure TufrmReplaceDialog.TntFormCreate(Sender: TObject);
var
i: integer;

begin
  uslHits := TTntStringList.Create;
  ItemsToRetain := 16;
  FormStateSaver := TFormStateSaver.Create(Self, True, True, True, True, True, True,
                                           True, True, False);
//This will have reloaded previous search items. We need to trim this list.
  while ucmbFind.Items.Count > ItemsToRetain do
    ucmbFind.Items.Delete(ucmbFind.Items.Count-1);
  while ucmbReplace.Items.Count > ItemsToRetain do
    ucmbReplace.Items.Delete(ucmbReplace.Items.Count-1);
  FLastFullClientHeight := ClientHeight;
end;

procedure TufrmReplaceDialog.TntFormDestroy(Sender: TObject);
begin
//Before closing, we need to restore the display of FindAll items
//so that the dimensions stored on disk are not distorted.
  if ubnFindAll.Visible = False then
    ShowFindAll;
  FreeAndNil(FormStateSaver);
  FreeAndNil(uslHits);
end;

procedure TufrmReplaceDialog.ubnFindClick(Sender: TObject);
begin
  if Length(ucmbFind.Text) < 1 then
    Exit;
//First, make sure the searched item goes into the list
  if ucmbFind.Items.IndexOf(ucmbFind.Text) > -1 then
    ucmbFind.Items.Move(ucmbFind.Items.IndexOf(ucmbFind.Text), 0)
  else
    ucmbFind.Items.Insert(0, ucmbFind.Text);
  ucmbFind.ItemIndex := 0;
  if Assigned(FFindProc) then
    FFindProc(ucmbFind.Text, ucbMatchCase.Checked, ucbWholeWord.Checked,
                             ucbDown.Checked);
end;

procedure TufrmReplaceDialog.ubnFindAllClick(Sender: TObject);
var
i: integer;

begin
  if Length(ucmbFind.Text) < 1 then
    Exit;
//First, make sure the searched item goes into the list
  if ucmbFind.Items.IndexOf(ucmbFind.Text) > -1 then
    ucmbFind.Items.Move(ucmbFind.Items.IndexOf(ucmbFind.Text), 0)
  else
    ucmbFind.Items.Insert(0, ucmbFind.Text);
  ucmbFind.ItemIndex := 0;
  if Assigned(FFindAllProc) then
    begin
      ClearHitLists;
      TotalHits := 0; //initialize
      FFindAllProc(ucmbFind.Text, uslHits, ucbMatchCase.Checked, ucbWholeWord.Checked,
                             ucbDown.Checked);
//We must handle assigning strings to the ulvHits, and show some feedback.
      if (uslHits.Count > 0) then
        begin
          AssignHitListToListView;
          WideShowMessage(ulbmsgTotalHits.Caption +
                            IntToStr(uslHits.Count) + '.');
        end
      else
        WideShowMessage(ulbmsgTotalHits.Caption + ' 0.');
    end;
end;

procedure TufrmReplaceDialog.ubnReplaceClick(Sender: TObject);
var
boolReplaced: Boolean;
begin
  if Length(ucmbFind.Text) < 1 then
    Exit;
//First, make sure the searched item goes into the list
  if ucmbFind.Items.IndexOf(ucmbFind.Text) > -1 then
    ucmbFind.Items.Move(ucmbFind.Items.IndexOf(ucmbFind.Text), 0)
  else
    ucmbFind.Items.Insert(0, ucmbFind.Text);
  ucmbFind.ItemIndex := 0;
//Now, make sure the replaced item goes into the list
  if ucmbReplace.Items.IndexOf(ucmbReplace.Text) > -1 then
    ucmbReplace.Items.Move(ucmbReplace.Items.IndexOf(ucmbReplace.Text), 0)
  else
    ucmbReplace.Items.Insert(0, ucmbReplace.Text);
  ucmbReplace.ItemIndex := 0;
  if Assigned(FReplaceProc) then
    begin
      FReplaceProc(ucmbFind.Text, ucmbReplace.Text, boolReplaced,
                    ucbMatchCase.Checked, ucbWholeWord.Checked,
                     ucbDown.Checked);
//TODO: if we need to show some kind of feedback, do it here.
    end;
end;

procedure TufrmReplaceDialog.ubnReplaceAllClick(Sender: TObject);
var
TotalReplacements: integer;
begin
  if Length(ucmbFind.Text) < 1 then
    Exit;
//First, make sure the searched item goes into the list
  if ucmbFind.Items.IndexOf(ucmbFind.Text) > -1 then
    ucmbFind.Items.Move(ucmbFind.Items.IndexOf(ucmbFind.Text), 0)
  else
    ucmbFind.Items.Insert(0, ucmbFind.Text);
  ucmbFind.ItemIndex := 0;
//Now, make sure the replaced item goes into the list
  if ucmbReplace.Items.IndexOf(ucmbReplace.Text) > -1 then
    ucmbReplace.Items.Move(ucmbReplace.Items.IndexOf(ucmbReplace.Text), 0)
  else
    ucmbReplace.Items.Insert(0, ucmbReplace.Text);
  ucmbReplace.ItemIndex := 0;
  if Assigned(FReplaceAllProc) then
    begin
      TotalReplacements := 0;
      FReplaceAllProc(ucmbFind.Text, ucmbReplace.Text, TotalReplacements,
                            ucbMatchCase.Checked, ucbWholeWord.Checked,
                             ucbDown.Checked);
//Show feedback
      if TotalReplacements > 0 then
        WideShowMessage(ulbmsgTotalReplacements.Caption + ' ' +
                        IntToStr(TotalReplacements) + '.');
    end;
end;

procedure TufrmReplaceDialog.ubnCloseClick(Sender: TObject);
begin
  Hide;
end;

procedure TufrmReplaceDialog.ulvHitsDblClick(Sender: TObject);
begin
  if Assigned(FGoToSearchHitProc) then
    if ulvHits.Items.Count > 0 then
      if ulvHits.Selected.Index > -1 then
        FGoToSearchHitProc(ulvHits.Selected.Index);
end;

procedure TufrmReplaceDialog.SetGoToSearchHitProc(Proc: TmdhGoToSearchHitProc);
begin
  if Assigned(Proc) then
    FGoToSearchHitProc := Proc
  else
    FGoToSearchHitProc := nil;
end;

procedure TufrmReplaceDialog.SetFindProc(Proc: TmdhFindProc);
begin
  if Assigned(Proc) then
    FFindProc := Proc
  else
    FFindProc := nil;
end;

procedure TufrmReplaceDialog.SetReplaceProc(Proc: TmdhReplaceProc);
begin
  if Assigned(Proc) then
    FReplaceProc := Proc
  else
    FReplaceProc := nil;
end;

procedure TufrmReplaceDialog.SetFindAllProc(Proc: TmdhFindAllProc);
begin
  if Assigned(Proc) then
    FFindAllProc := Proc
  else
    FFindAllProc := nil;
end;

procedure TufrmReplaceDialog.SetReplaceAllProc(Proc: TmdhReplaceAllProc);
begin
  if Assigned(Proc) then
    FReplaceAllProc := Proc
  else
    FReplaceAllProc := nil;
end;

procedure TufrmReplaceDialog.SetUp(inFindProc: TmdhFindProc;
                                   inFindAllProc: TmdhFindAllProc;
                                   inReplaceProc: TmdhReplaceProc;
                                   inReplaceAllProc: TmdhReplaceAllProc;
                                   inGoToSearchHitProc: TmdhGoToSearchHitProc);
begin
  if (@inFindAllProc = nil) then
    HideFindAll
  else
    if not(ubnFindAll.Visible) then
      ShowFindAll;
  FindProc := inFindProc;
  FindAllProc := inFindAllProc;
  ReplaceProc := inReplaceProc;
  ReplaceAllProc := inReplaceAllProc;
  GoToSearchHitProc := inGoToSearchHitProc;
end;

procedure TufrmReplaceDialog.AssignHitListToListView;
var
i: integer;

begin
  if uslHits.Count > 0 then
    for i := 0 to uslHits.Count-1 do
      begin
        ulvHits.AddItem(uslHits[i], uslHits.Objects[i]);
      end;
end;

procedure TufrmReplaceDialog.ulvHitsResize(Sender: TObject);
begin
  ulvHits.Columns[0].Width := ulvHits.Width - 4;
end;

procedure TufrmReplaceDialog.ClearHitLists;
var
i: integer;

begin
//TODO: Figure out why this causes access violations. I'm freeing a pointer which
//currently is just an integer, cast to a pointer; I probably shouldn't do that.
  if uslHits.Count > 0 then
    for i := 0 to uslHits.Count-1 do
      if uslHits.Objects[i] <> nil then
        begin
          uslHits.Objects[i].Free;
          uslHits.Objects[i] := nil;
        end;
  uslHits.Clear;
  if ulvHits.Items.Count > 0 then
    for i := 0 to ulvHits.Items.Count-1 do
      if ulvHits.Items[i].Data <> nil then
        begin
          //TObject(ulvHits.Items[i].Data).Free; //TODO: Does this properly dispose of the object?
          ulvHits.Items[i].Data := nil;
        end;
  ulvHits.Clear;
end;

procedure TufrmReplaceDialog.HideFindAll;
begin
//Hide all the elements which are involved in FindAll functionality, and
//resize the form appropriately.
//Bail if no need to do this.
  if ubnFindAll.Visible = False then
    Exit;
//First, record the previous height.
  FLastFullClientHeight := ClientHeight;
  bvlList.Visible := False;
  ulbHits.Visible := False;
  ulvHits.Visible := False;
  ubnFindAll.Visible := False;
  ClientHeight := bvlList.Top + ubnClose.Height + 18;
  Application.ProcessMessages;
end;

procedure TufrmReplaceDialog.ShowFindAll;
begin
//Redisplay all the elements which are involved in FindAll functionality, and
//resize the form appropriately.
  bvlList.Visible := True;
  ulbHits.Visible := True;
  ulvHits.Visible := True;
  ubnFindAll.Visible := True;
  if ClientHeight < FLastFullClientHeight then
    ClientHeight := FLastFullClientHeight;
  ulvHits.Height := ClientHeight - 387;
  Application.ProcessMessages;
end;

procedure TufrmReplaceDialog.ubnHelpClick(Sender: TObject);
begin
  mdhCallHelp(HelpKeyword);
end;

end.