rm_findreplace.pas

进销存·完整的·有数据库的·非常完整·只得参考

unit RM_FindReplace;

interface

{$I RM.INC}
uses
  Windows, Forms, Buttons, Graphics, SysUtils, Dialogs, ComCtrls, RM_Class, RM_Desgn,
  StdCtrls, Controls, Classes, Menus;

type
//  TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase);
  TSearchFunction = function(const AText, ASubText: string): Boolean;
  TReplaceFunction = function(const AText, AFromText, AToText: string): string;
  TActionProcedure = procedure(aCnt: Integer) of object;

  TActionThread = class;

 {TRMFindReplaceForm}
  TRMFindReplaceForm = class(TForm)
    chkCase: TCheckBox;
    chkScript: TCheckBox;
    cmbReplace: TComboBox;
    cmbSearch: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    chkMemo: TCheckBox;
    btnSearch: TBitBtn;
    btnStop: TBitBtn;
    btnReplace: TBitBtn;
    btnReplaceAll: TBitBtn;
    btnClose: TBitBtn;
    ListView1: TListView;
    PopupMenu1: TPopupMenu;
    Search1: TMenuItem;
    Stop1: TMenuItem;
    N1: TMenuItem;
    Replace1: TMenuItem;
    ReplaceAll1: TMenuItem;
    N2: TMenuItem;
    ClearResults1: TMenuItem;
    procedure btnStopClick(Sender: TObject);
    procedure chkCaseClick(Sender: TObject);
    procedure ClearResults1Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure btnReplaceClick(Sender: TObject);
    procedure btnReplaceAllClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnSearchClick(Sender: TObject);
    procedure ListView1Change(Sender: TObject; Item: TListItem;
      Change: TItemChange);
  private
    { Private declarations }
    SearchThread: TActionThread;
    FDesigner: TRMDesignerForm;
    FSearcher: TSearchFunction;
    FReplacer: TReplaceFunction;
    FAction: TActionProcedure;
    FModified: Boolean;
    FOnModifyView: TNotifyEvent;
    function GetObjCount: Integer;
    procedure OnTerminate(Sender: TObject);
    procedure SetModified(AView: TRMView);
    procedure UpdateCombos;
    procedure Localize;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure CreateParams(var Params: TCreateParams); override;
    function Comparator(aCnt: Integer): Boolean;
    procedure OnSearchAction(aCnt: Integer);
    procedure OnReplaceAllAction(aCnt: Integer);
    property ObjCount: Integer read GetObjCount;
    property OnModifyView: TNotifyEvent read FOnModifyView write FOnModifyView;
  end;

  {TActionThred}
  TActionThread = class(TThread)
  private
    FSnr: TRMFindReplaceForm;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean; ASnr: TRMFindReplaceForm);
  end;

implementation

{$R *.dfm}

uses RM_Utils, RM_Const, RM_Const1;
{
function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
var
  SearchStr, Patt, NewStr: string;
  Offset: Integer;
begin
  if rmrfIgnoreCase in Flags then
  begin
    SearchStr := AnsiUpperCase(S);
    Patt := AnsiUpperCase(OldPattern);
  end
  else
  begin
    SearchStr := S;
    Patt := OldPattern;
  end;
  NewStr := S;
  Result := '';
  while SearchStr <> '' do
  begin
    Offset := AnsiPos(Patt, SearchStr);
    if Offset = 0 then
    begin
      Result := Result + NewStr;
      Break;
    end;
    Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
    NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
    if not (rmrfReplaceAll in Flags) then
    begin
      Result := Result + NewStr;
      Break;
    end;
    SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
  end;
end;
}
function AnsiContainsText(const AText, ASubText: string): Boolean;
begin
  Result := AnsiPos(AnsiUppercase(ASubText), AnsiUppercase(AText)) > 0;
end;

function AnsiReplaceText(const AText, AFromText, AToText: string): string;
begin
  Result := StringReplace(AText, AFromText, AToText, [rfReplaceAll, rfIgnoreCase]);
end;

function AnsiContainsStr(const AText, ASubText: string): Boolean;
begin
  Result := AnsiPos(ASubText, AText) > 0;
end;

function AnsiReplaceStr(const AText, AFromText, AToText: string): string;
begin
  Result := StringReplace(AText, AFromText, AToText, [rfReplaceAll]);
end;

constructor TActionThread.Create(CreateSuspended: Boolean; ASnr: TRMFindReplaceForm);
begin
  inherited Create(CreateSuspended);
  FSnr := ASnr;
  FreeOnTerminate := True;
  OnTerminate := FSnr.OnTerminate;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TActionThread }

procedure TActionThread.Execute;
var
  oCounter: Integer;
begin
  oCounter := 0;
  while (not Terminated) and (oCounter < FSnr.ObjCount) do
  begin
    if FSnr.Comparator(oCounter) then
    begin
      FSnr.FAction(oCounter);
      Sleep(0);
    end;
    Inc(oCounter);
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMFindReplaceForm }

procedure TRMFindReplaceForm.Localize;
begin
  Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  RMSetStrProp(Self, 'Caption', rmRes + 823);
  RMSetStrProp(Label1, 'Caption', rmRes + 821);
  RMSetStrProp(Label2, 'Caption', rmRes + 822);
  RMSetStrProp(chkCase, 'Caption', rmRes + 824);
  RMSetStrProp(chkScript, 'Caption', rmRes + 825);
  RMSetStrProp(chkMemo, 'Caption', rmRes + 826);
  RMSetStrProp(btnSearch, 'Caption', rmRes + 827);
  RMSetStrProp(btnReplace, 'Caption', rmRes + 828);
  RMSetStrProp(btnStop, 'Caption', rmRes + 829);
  RMSetStrProp(btnReplaceAll, 'Caption', rmRes + 830);
  RMSetStrProp(btnClose, 'Caption', rmRes + 831);
  RMSetStrProp(ListView1.Columns[0], 'Caption', rmRes + 832);
//  RMSetStrProp(ListView1.Columns[1], 'Caption', rmRes + 833);
  RMSetStrProp(ListView1.Columns[1], 'Caption', rmRes + 834);
  RMSetStrProp(ListView1.Columns[2], 'Caption', rmRes + 835);
end;

constructor TRMFindReplaceForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDesigner := TRMDesignerForm(AOwner);
  FSearcher := AnsiContainsText;
  FReplacer := AnsiReplaceText;
  FModified := False;
  Localize;
end;

procedure TRMFindReplaceForm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.WndParent := TWinControl(Owner).Handle;
end;

procedure TRMFindReplaceForm.chkCaseClick(Sender: TObject);
begin
  if chkCase.Checked then
  begin
    FSearcher := AnsiContainsText;
    FReplacer := AnsiReplaceText;
  end
  else
  begin
    FSearcher := AnsiContainsStr;
    FReplacer := AnsiReplaceStr;
  end;
end;

procedure TRMFindReplaceForm.UpdateCombos;
begin
  if Trim(cmbSearch.Text) <> '' then
  begin
    if cmbSearch.Items.IndexOf(cmbSearch.Text) = -1 then
      cmbSearch.Items.Insert(0, cmbSearch.Text);
  end;

  if Trim(cmbReplace.Text) <> '' then
  begin
    if cmbReplace.Items.IndexOf(cmbReplace.Text) = -1 then
      cmbReplace.Items.Insert(0, cmbReplace.Text);
  end;
end;

function TRMFindReplaceForm.GetObjCount: Integer;
begin
  Result := FDesigner.Page.Objects.Count;
end;

procedure TRMFindReplaceForm.OnTerminate(Sender: TObject);
begin
  btnSearch.Enabled := True;
  btnStop.Enabled := False;
  btnReplace.Enabled := (ListView1.Items.Count > 0);
  Search1.Enabled := True;
  Stop1.Enabled := False;
  Replace1.Enabled := (ListView1.Items.Count > 0);
  ClearResults1.Enabled := (ListView1.Items.Count > 0);

  if FModified then
  begin
    FModified := False;
    FDesigner.Modified := True;
    FDesigner.RedrawPage;
  end;
end;

function TRMFindReplaceForm.Comparator(aCnt: Integer): Boolean;
begin
  Result := (chkMemo.Checked and
    FSearcher(TRMView(FDesigner.Page.Objects[aCnt]).Memo.Text, cmbSearch.Text)) or
    (chkScript.Checked and FSearcher(TRMView(FDesigner.Page.Objects[aCnt]).Script.Text, cmbSearch.Text));
end;

procedure TRMFindReplaceForm.btnStopClick(Sender: TObject);
begin
  SearchThread.Terminate;

  btnSearch.Enabled := True;
  btnStop.Enabled := False;
  Search1.Enabled := True;
  Stop1.Enabled := False;
end;

procedure TRMFindReplaceForm.OnSearchAction(aCnt: Integer);
var
  ListItem: TListItem;
begin
  with ListView1 do
  begin
    ListItem := ListView1.Items.Add;
    ListItem.Caption := TRMView(FDesigner.Page.Objects[aCnt]).Name;
//    ListItem.SubItems.Add(IntToStr(TRMView(FDesigner.Page.Objects[aCnt]).ID));
    ListItem.SubItems.Add(TRMView(FDesigner.Page.Objects[aCnt]).Memo.Text);
    ListItem.SubItems.Add(TRMView(FDesigner.Page.Objects[aCnt]).Script.Text);
  end;
end;

procedure TRMFindReplaceForm.OnReplaceAllAction(aCnt: Integer);
var
  AView: TRMView;
begin
  AView := TRMView(FDesigner.Page.Objects[aCnt]);

  if chkMemo.Checked then
  begin
    AView.Memo.Text := FReplacer(AView.Memo.Text, cmbSearch.Text, cmbReplace.Text);
    SetModified(AView);
  end;
  if chkScript.Checked then
  begin
    AView.Script.Text := FReplacer(AView.Script.Text, cmbSearch.Text, cmbReplace.Text);
    SetModified(AView);
  end;
end;

procedure TRMFindReplaceForm.SetModified(AView: TRMView);
begin
  FDesigner.Modified := True;
  FModified := True;
end;

procedure TRMFindReplaceForm.ListView1DblClick(Sender: TObject);
var
  AView: TRMView;
  ListItem: TListItem;
  i: Integer;
begin
  if ListView1.Items.Count > 0 then
  begin
    AView := nil;
    ListItem := ListView1.ItemFocused;
    for i := 0 to ObjCount do
    begin
      if AnsiCompareText(TRMView(FDesigner.Page.Objects[i]).Name, ListItem.Caption) = 0 then
      begin
        AView := TRMView(FDesigner.Page.Objects[i]);
        Break;
      end;
    end;

    if AView = nil then
      exit;

    SetModified(AView);
    FDesigner.ShowMemoEditor(AView);
  end;
end;

procedure TRMFindReplaceForm.ClearResults1Click(Sender: TObject);
begin
  ListView1.Items.Clear;
end;

procedure TRMFindReplaceForm.btnReplaceClick(Sender: TObject);
var
  ListItem: TListItem;
  AView: TRMView;
  i, rc: Integer;
  nonStop: Boolean;
  str: string;
begin
  if ListView1.SelCount = 0 then
  begin
    ShowMessage(RMLoadStr(rmRes + 836));
    exit;
  end;

  FModified := False;
  nonStop := False;
  rc := 0;

  UpdateCombos;
  ListItem := ListView1.Selected;
  repeat
    AView := nil;
    for i := 0 to ObjCount do
    begin
      if AnsiCompareText(TRMView(FDesigner.Page.Objects[i]).Name, ListItem.Caption) = 0 then
      begin
        AView := TRMView(FDesigner.Page.Objects[i]);
        break;
      end;
    end;

    if AView = nil then
      continue;

    if not nonStop then
    begin
      str := Format(RMLoadStr(rmRes + 838), [#10#13, cmbSearch.Text, #10#13, #10#13, cmbReplace.Text]);
      rc := MessageDlg(str, mtConfirmation, [mbYes, mbNo, mbCancel, mbAll], 0);
    end;
    case rc of
      mrYes:
        begin
          if chkMemo.Checked then
          begin
            AView.Memo.Text := FReplacer(AView.Memo.Text, cmbSearch.Text, cmbReplace.Text);
            SetModified(AView);
          end;
          if chkScript.Checked then
          begin
            AView.Script.Text := FReplacer(AView.Script.Text, cmbSearch.Text, cmbReplace.Text);
            SetModified(AView);
          end;
        end; // mrYes
      mrAll:
        begin
          nonStop := True;
          rc := mrYes;
        end; // mrAll
      mrCancel: break;
    end; // case

    ListItem := ListView1.GetNextItem(ListItem, sdAll, [isSelected]);
  until ListItem = nil;

  if FModified then
  begin
    FModified := False;
    FDesigner.Modified := True;
    FDesigner.RedrawPage;
  end;
end;

procedure TRMFindReplaceForm.btnReplaceAllClick(Sender: TObject);
var
  str: string;
begin
  str := Format(RMLoadStr(rmRes + 837), [#10#13, cmbSearch.Text, #10#13, #10#13, cmbReplace.Text]);
  if Application.MessageBox(PChar(str),
    PChar(RMLoadStr(SConfirm)), mb_IconQuestion + mb_YesNo) = IDYES then
  begin
    UpdateCombos;
    FAction := OnReplaceAllAction;
    SearchThread := TActionThread.Create(False, Self);
  end;
end;

procedure TRMFindReplaceForm.btnCloseClick(Sender: TObject);
begin
  ListView1.Items.Clear;
  if Assigned(SearchThread) then
    SearchThread.Terminate;
  Self.Close;
end;

procedure TRMFindReplaceForm.btnSearchClick(Sender: TObject);
begin
  UpdateCombos;

  btnSearch.Enabled := True;
  btnStop.Enabled := False;

  Search1.Enabled := True;
  Stop1.Enabled := False;

  FAction := OnSearchAction;
  ListView1.Items.Clear;
  SearchThread := TActionThread.Create(False, Self);
end;

procedure TRMFindReplaceForm.ListView1Change(Sender: TObject; Item: TListItem; Change: TItemChange);
var
  AView: TRMView;
  i: Integer;
begin
  if (Item = nil) or (Item.SubItems.Count <= 0) then
    Exit;
  AView := nil;
  for i := 0 to ObjCount do
  begin
    if AnsiCompareText(TRMView(FDesigner.Page.Objects[i]).Name, Item.Caption) = 0 then
    begin
      AView := TRMView(FDesigner.Page.Objects[i]);
      Break;
    end;
  end;

  if (AView <> nil) and Assigned(FOnModifyView) then
    FOnModifyView(aView);
end;

end.