unit1.pas

一个很好用的控件

          P := I;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then QuickSortStrings(lst1, lst2, L, J, SCompare);
    L := I;
  until I >= R;
end;

function CompareStrings(List: TStringList; Index1, Index2: Integer): Integer;
begin
  Result := AnsiCompareStr(List[Index1], List[Index2]);
end;

procedure TfrmMain.SortFindReplaceStrings;
//need to sort both lists concurrently based on find strings alpha
var
  lst1, lst2: TStringList;
begin
  if (memOldStrings.Lines.Count > 1) and
     (memNewStrings.Lines.Count > 1) and
     (memOldStrings.Lines.Count = memNewStrings.Lines.Count) then
  begin
    lst1 := TStringList.Create;
    lst2 := TStringList.Create;
    Screen.Cursor := crHourglass;
    try
      lst1.Assign(memOldStrings.Lines);
      lst2.Assign(memNewStrings.Lines);
      QuickSortStrings(lst1, lst2, 0, lst1.Count - 1, CompareStrings);
      memOldStrings.Lines.Assign(lst1);
      memNewStrings.Lines.Assign(lst2);
    finally
      lst1.Free;
      lst2.Free;
      Screen.Cursor := crDefault;
    end;
  end;
end;

procedure TfrmMain.ShowMatchingFiles;
var
  Dialog: TfrmFileList;
begin
  Dialog := TfrmFileList.Create(Self);
  with Dialog do
  try
    abcGetFileNames(dirSource.Text, cboFileType.Text, True,
      (rdgFileSelect.ItemIndex=0), Memo1.Lines);
    if Memo1.Lines.Count = 0 then
      ShowMessage('No matching files')
    else
    begin
      ShowModal;
      if (ModalResult = mrOk) and chkAddUnits.Checked then
      begin
        Self.Repaint;
        Screen.Cursor := crHourglass;
        AddUnitNamesFrom(Memo1.Lines);
        Screen.Cursor := crDefault;
      end;
    end;
  finally
    Free;
  end;
end;

function TfrmMain.PromptToSave: TModalResult;
const
  DEFAULT_FILE = 'Untitled file';
begin
  if not FDataChanged then
    Result := mrNone
  else
  begin
    if FFileName = '' then
      FFileName := DEFAULT_FILE;
    Result := MessageDlg('Save changes to ' + FFileName + '?', mtConfirmation, [mbYes, mbNo, mbCancel],0);
    if FFileName = DEFAULT_FILE then
      FFileName := '';
  end;
  if Result = mrYes then
    if not SaveChanges(False) then
      Result := mrCancel;
end;

function TfrmMain.SaveChanges(AlwaysPrompt: Boolean): Boolean;
begin
  Result := False;
  if AlwaysPrompt or (FFileName = '') then
  begin
    SaveDialog1.FileName := '';
    if SaveDialog1.Execute then
      DoSaveAs(SaveDialog1.FileName)
    else
      Exit;
  end
  else
    DoSaveAs(FFileName);
  Result := True;
end;

procedure TfrmMain.DoSaveAs(FileName: TFileName);
var
  IniFile: TIniFile;
  i: integer;
begin
  IniFile := TIniFile.Create(FileName);
  with IniFile do
  try
    WriteString(SEC_GENERAL, ITEM_SOURCE, dirSource.Text);
    WriteString(SEC_GENERAL, ITEM_DEST, dirDest.Text);
    WriteString(SEC_GENERAL, ITEM_PATTERN, cboFileType.Text);

    WriteInteger(SEC_GENERAL, ITEM_FILE_SELECT, rdgFileSelect.ItemIndex);

    WriteBool(SEC_GENERAL, ITEM_CASE, chkCaseInsensitive.Checked);

    WriteBool(SEC_GENERAL, ITEM_WHOLE_WORDS, chkWholeWordsOnly.Checked);

    WriteBool(SEC_GENERAL, ITEM_COPY_UNCHANGED, chkCopyUnchangedFiles.Checked);

    WriteBool(SEC_GENERAL, ITEM_FIND_ONLY, chkFindOnly.Checked);

    WriteBool(SEC_GENERAL, ITEM_UNITS, chkFixUnitIdentifiers.Checked);

    WriteString(SEC_GENERAL, ITEM_VERSION, abcVersionLabel1.ValueByKey['FileVersion']);

    EraseSection(SEC_DESCRIPTION);
    WriteInteger(SEC_DESCRIPTION, ITEM_COUNT, memDescription.Lines.Count);
    with memDescription.Lines do
      for i := 0 to Count - 1 do
        WriteString(SEC_DESCRIPTION, ITEM_PREFIX + IntToStr(i), Strings[i]);

    EraseSection(SEC_REPLACE);
    WriteInteger(SEC_REPLACE, ITEM_COUNT, memOldStrings.Lines.Count);
    with memOldStrings.Lines do
      for i := 0 to Count - 1 do
        WriteString(SEC_REPLACE, ITEM_PREFIX + IntToStr(i), '"' + Strings[i] + '"');

    EraseSection(SEC_REPLACE_WITH);
    WriteInteger(SEC_REPLACE_WITH, ITEM_COUNT, memNewStrings.Lines.Count);
    with memNewStrings.Lines do
      for i := 0 to Count - 1 do
        WriteString(SEC_REPLACE_WITH, ITEM_PREFIX + IntToStr(i), '"' + Strings[i] + '"');

  finally
    Free;
  end;
  FDataChanged := False;
  SetFileName(FileName);
end;

procedure TfrmMain.FileOpen;
begin
  if OpenDialog1.Execute then
    OpenFile(OpenDialog1.FileName);
end;

procedure TfrmMain.OpenFile(FileName: TFileName);
var
  IniFile: TIniFile;
  i, iTemp: integer;
  strFind, strRepl, strDesc: TStringList;
begin
  Screen.Cursor := crHourGlass;
  Repaint;
  try
    Clear;
    IniFile := TIniFile.Create(FileName);
    strFind := TStringList.Create;
    strRepl := TStringList.Create;
    strDesc := TStringList.Create;
    with IniFile do
    try
      dirSource.Text := ReadString(SEC_GENERAL, ITEM_SOURCE, '');
      dirDest.Text := ReadString(SEC_GENERAL, ITEM_DEST, '');

      cboFileType.Text := ReadString(SEC_GENERAL, ITEM_PATTERN, '');

      iTemp := ReadInteger(SEC_GENERAL, ITEM_FILE_SELECT, 0);
      if (iTemp > -1) and (iTemp < rdgFileSelect.Items.Count) then
        rdgFileSelect.ItemIndex := iTemp;

      chkCaseInsensitive.Checked := ReadBool(SEC_GENERAL, ITEM_CASE, False);

      chkWholeWordsOnly.Checked := ReadBool(SEC_GENERAL, ITEM_WHOLE_WORDS, False);

      chkCopyUnchangedFiles.Checked := ReadBool(SEC_GENERAL, ITEM_COPY_UNCHANGED, False);

      chkFindOnly.Checked := ReadBool(SEC_GENERAL, ITEM_FIND_ONLY, False);

      chkFixUnitIdentifiers.Checked := ReadBool(SEC_GENERAL, ITEM_UNITS, False);

      iTemp := ReadInteger(SEC_DESCRIPTION, ITEM_COUNT, 0);
      for i := 0 to iTemp - 1 do
        strDesc.Add(ReadString(SEC_DESCRIPTION, ITEM_PREFIX + IntToStr(i), ''));

      iTemp := ReadInteger(SEC_REPLACE, ITEM_COUNT, 0);
      for i := 0 to iTemp - 1 do
        strFind.Add(ReadString(SEC_REPLACE, ITEM_PREFIX + IntToStr(i), ''));

      iTemp := ReadInteger(SEC_REPLACE_WITH, ITEM_COUNT, 0);
      for i := 0 to iTemp - 1 do
        strRepl.Add(ReadString(SEC_REPLACE_WITH, ITEM_PREFIX + IntToStr(i), ''));

      memDescription.Lines.Assign(strDesc);
      memOldStrings.Lines.Assign(strFind);
      memNewStrings.Lines.Assign(strRepl);

    finally
      Free;
      strFind.Free;
      strRepl.Free;
      strDesc.Free;
    end;
    FDataChanged := False;
    SetFileName(FileName);
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TfrmMain.SetFileName(Value: TFileName);
begin
  FFileName := Value;
  if Value = '' then
    Caption := C_CAPTION
  else
    Caption := C_CAPTION + ' - [' + ExtractFileName(Value) + ']';
end;

procedure TfrmMain.Clear;
begin
  memOldStrings.Lines.Clear;
  memNewStrings.Lines.Clear;
  memDescription.Lines.Text := 'DESCRIPTION:';
  dirSource.Text := '';
  cboFileType.ItemIndex := 0;
  rdgFileSelect.ItemIndex := 0;
  lstSelectFiles.Items.Clear;
  dirDest.Text := '';
  chkCaseInsensitive.Checked := False;
  chkFindOnly.Checked := False;
  chkWholeWordsOnly.Checked := False;
  chkCopyUnchangedFiles.Checked := False;
  chkFixUnitIdentifiers.Checked := False;
  SetFileName('');
  FDataChanged := False;
end;

function TfrmMain.ValidReplacementCount: Boolean;
begin
  Result := False;
  if memOldStrings.Lines.Count < memNewStrings.Lines.Count then
  begin
    pagMain.ActivePage := tabStrings;
    memOldStrings.SetFocus;
    MessageDlg('Number of strings to be replaced is less than number of replacement strings.',
               mtWarning, [mbOk], 0);
  end
  else if memNewStrings.Lines.Count < memOldStrings.Lines.Count then
  begin
    pagMain.ActivePage := tabStrings;
    memNewStrings.SetFocus;
    MessageDlg('Number of replacement strings is less than number of strings to be replaced.',
               mtWarning, [mbOk], 0);
  end
  else if memOldStrings.Lines.Count = 0 then
  begin
    pagMain.ActivePage := tabStrings;
    memOldStrings.SetFocus;
    MessageDlg('There is nothing to replace.  Please enter a string.',
               mtWarning, [mbOk], 0);
  end
  else
    Result := True;
end;

function TfrmMain.ValidSourceDir: Boolean;
begin
  Result := DirectoryExists(dirSource.Text);
  if not Result then
  begin
    pagMain.ActivePage := tabSource;
    dirSource.SetFocus;
    MessageDlg('Source Directory does not exist.',
               mtWarning, [mbOk], 0);
  end;
end;

function TfrmMain.ValidDestDir: Boolean;
var
  sDir: string;
begin
  if dirDest.Text = '' then
    dirDest.Text := dirSource.Text;
  if dirDest.Text = dirSource.Text then
  begin
    Result := MessageDlg('Destination same as source. Changed files will be overwritten.',
               mtWarning, [mbOk, mbCancel], 0) = mrOk;
    Exit;
  end
  else if DirectoryExists(dirDest.Text) then
  begin
    Result := MessageDlg('Destination already exists. Files may be overwritten.',
               mtWarning, [mbOk, mbCancel], 0) = mrOk;
    Exit;
  end;
  sDir := dirDest.Text;
  Result := CreateDirectory(PChar(sDir), nil);
  if not Result then
    MessageDlg('Unable to create destination directory ' + sDir,
               mtError, [mbOk], 0);
end;

{Form Events}

procedure TfrmMain.StopShow;
begin
  abcEffectsImage1.Stop;
end;

procedure TfrmMain.StartShow;
begin
  Application.ProcessMessages;
  abcEffectsImage1.Play(True);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  pagMain.ActivePage := tabStrings;
  cboFileType.ItemIndex := 0;
  FSourceFiles := TStringList.Create;
  rdgFileSelectClick(Self);
  FDataChanged := False;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  FSourceFiles.Free;
end;

procedure TfrmMain.pagMainChange(Sender: TObject);
begin
  if pagMain.ActivePage = tabAbout then
  begin
    if ImageList1.Count = 0 then
      ImageList1.ResourceLoad(rtBitmap, 'GReplace_ImageList1', clNone);
    StartShow;
  end
  else
    StopShow;
end;

procedure TfrmMain.PopulateFileSelectList;
begin
  Screen.Cursor := crHourglass;
  try
    lstSelectFiles.Clear;
    abcGetFileNames(dirSource.Text, cboFiletype.Text, False, False, lstSelectFiles.Items);
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TfrmMain.rdgFileSelectClick(Sender: TObject);
begin
  case rdgFileSelect.ItemIndex of
    0,1:
      begin
        btnShowFiles.Enabled := True;
        lstSelectFiles.Enabled := False;
        Label9.Enabled := False;
      end;
    2:
      begin
        btnShowFiles.Enabled := False;
        lstSelectFiles.Enabled := True;
        Label9.Enabled := True;
        PopulateFileSelectList;
      end;
  end;
  memOldStringsChange(Self);
end;

procedure TfrmMain.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TfrmMain.memOldStringsChange(Sender: TObject);
begin
  FDataChanged := True;
end;

procedure TfrmMain.New1Click(Sender: TObject);
begin
  if PromptToSave <> mrCancel then
    Clear;
end;

procedure TfrmMain.Open1Click(Sender: TObject);
begin
  if PromptToSave <> mrCancel then
    FileOpen;
end;

procedure TfrmMain.Save1Click(Sender: TObject);
begin
  SaveChanges(False);
end;

procedure TfrmMain.SaveAs1Click(Sender: TObject);
begin
  SaveChanges(True);
end;

procedure TfrmMain.btnGoClick(Sender: TObject);
begin
  if (chkFixUnitIdentifiers.Checked or ValidReplacementCount) and ValidSourceDir and (chkFindOnly.Checked or ValidDestDir) then
    ReplaceAllFiles;
end;

procedure TfrmMain.btnPauseClick(Sender: TObject);
begin
  FPaused := True;
end;

procedure TfrmMain.btnStopClick(Sender: TObject);
begin
  FStopped := True;
end;

procedure TfrmMain.btnShowFilesClick(Sender: TObject);
begin
  if ValidSourceDir then
    ShowMatchingFiles;
end;

procedure TfrmMain.dirSourceChange(Sender: TObject);
begin
  memOldStringsChange(Self);
  if rdgfileSelect.ItemIndex = 2 then
    PopulateFileSelectList;
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := (PromptToSave <> mrCancel);
end;

procedure TfrmMain.abcSplitPane2Resize(Sender: TObject);
begin
  Label6.Left := abcSplitPane2.Left + 10;
end;

procedure TfrmMain.abcURLLabel1Click(Sender: TObject);
begin
  StopShow;
end;

procedure TfrmMain.FormShow(Sender: TObject);
var
  s: string;
  i: integer;
begin
  //command line support
  s := '';
  for i := 1 to ParamCount do
    s := s + ParamStr(i);
  if FileExists(s) then
    OpenFile(s);
end;

procedure TfrmMain.chkFixUnitIdentifiersClick(Sender: TObject);
begin
  if chkFixUnitIdentifiers.Checked then
  begin
    chkCaseInsensitive.Checked := True;
    chkWholeWordsOnly.Checked := True;
  end;
  FDataChanged := True;
end;

procedure TfrmMain.btnSortClick(Sender: TObject);
begin
  if ValidReplacementCount then
    SortFindReplaceStrings;
end;

end.