grepresultsdlg.pas

此软件支持多文档打开

{***************************************************************
 *
 * Unit Name   : GrepResultsDlg
 * Date        :
 * Purpose     : Grep Search Result Dialog
 * History     :
 *       2000-02-19 16:38:08
 *         + MBCS Support
 *
 ****************************************************************}

Unit GrepResultsDlg;

//! StH: This unit has been completely prepared for localization
//! StH: This unit is fully compatible with C++Builder

Interface

Uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  StdCtrls,
  ExtCtrls,
  SearchFile,
  Buttons,
  ComCtrls,
  AppUtils,
  Menus,
  DropSource,
  vgNLS,
  MainEdit,
  IniFiles,
  JediLocalStr;

Type
  TGrepAction = (gaAllFilesGrep, gaCurrentOnlyGrep, gaOpenFilesGrep, gaDirGrep);

  TSearchResult = Class(TCollectionItem)
  Private
    FLine: String;
    FLineNo: Integer;
    FSPos: Integer;
    FEPos: Integer;
  Published
    Property Line: String Read FLine Write FLine;
    Property LineNo: Integer Read FLineNo Write FLineNo;
    Property SPos: Integer Read FSPos Write FSPos;
    Property EPos: Integer Read FEPos Write FEPos;
  End;

  TSearchResults = Class(TCollection)
  Private
    FExpanded: Boolean;
    FFileName: String;
    Function GetItem(Index: Integer): TSearchResult;
    Procedure SetItem(Index: Integer; Value: TSearchResult);
  Public
    Constructor Create;
    Function Add: TSearchResult;
    Property Expanded: Boolean Read FExpanded Write FExpanded;
    Property FileName: String Read FFileName Write FFileName;
    Property Items[Index: Integer]: TSearchResult Read GetItem Write SetItem; Default;
  End;

  // Saved grep settings (used for refresh)
  TGrepSettings = Packed Record
    NoComments,
      NoCase,
      WholeWord,
      Regex,
      IncludeSubdirs: Boolean;
    Directory,
      Mask,
      Pattern: String;
    GrepAction: TGrepAction;
    CanRefresh: Boolean;
  End;

  TfrmGrepResults = Class(TForm)
    pnlToolbar: TPanel;
    StatusBar: TStatusBar;
    sbSearch: TSpeedButton;
    sbGoto: TSpeedButton;
    sbContract: TSpeedButton;
    sbExpand: TSpeedButton;
    sbAbort: TSpeedButton;
    sbHelp: TSpeedButton;
    sbFont: TSpeedButton;
    dlgGrepFont: TFontDialog;
    lbResults: TListBox;
    sbPrint: TSpeedButton;
    MainMenu: TMainMenu;
    mnuFile: TMenuItem;
    mnuSearch: TMenuItem;
    mnuExit: TMenuItem;
    mnuFileSep: TMenuItem;
    mnuPrint: TMenuItem;
    mnuList: TMenuItem;
    mnuContract: TMenuItem;
    mnuExpand: TMenuItem;
    mnuHelp: TMenuItem;
    mnuFont: TMenuItem;
    mnuHelpHelp: TMenuItem;
    mnuHelpAbout: TMenuItem;
    mnuAbort: TMenuItem;
    mnuGotoSelected: TMenuItem;
    mnuRefresh: TMenuItem;
    sbRefresh: TSpeedButton;
    mnuOnTop: TMenuItem;
    sbOnTopUp: TSpeedButton;
    sbOnTopDown: TSpeedButton;
    sbReplace: TSpeedButton;
    Procedure BtnCloseClick(Sender: TObject);
    Procedure BtnNewClick(Sender: TObject);
    Procedure sbGotoClick(Sender: TObject);
    Procedure FormResize(Sender: TObject);
    Procedure sbContractClick(Sender: TObject);
    Procedure sbExpandClick(Sender: TObject);
    Procedure sbAbortClick(Sender: TObject);
    Procedure FormDestroy(Sender: TObject);
    Procedure FormCreate(Sender: TObject);
    Procedure FormShow(Sender: TObject);
    Procedure lbResultsMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    Procedure lbResultsKeyPress(Sender: TObject; Var Key: Char);
    Procedure FormKeyPress(Sender: TObject; Var Key: Char);
    Procedure sbFontClick(Sender: TObject);
    Procedure lbResultsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    Procedure sbPrintClick(Sender: TObject);
    Procedure mnuContractClick(Sender: TObject);
    Procedure mnuExpandClick(Sender: TObject);
    Procedure mnuSearchClick(Sender: TObject);
    Procedure mnuPrintClick(Sender: TObject);
    Procedure mnuExitClick(Sender: TObject);
    Procedure mnuFontClick(Sender: TObject);
    Procedure mnuAbortClick(Sender: TObject);
    Procedure mnuGotoSelectedClick(Sender: TObject);
    Procedure mnuTopClick(Sender: TObject);
    Procedure lbResultsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    Procedure lbResultsMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    Procedure mnuRefreshClick(Sender: TObject);
    Procedure mnuOnTopClick(Sender: TObject);
    Procedure sbOnTopClick(Sender: TObject);
    Procedure sbRefreshClick(Sender: TObject);
    Procedure sbReplaceClick(Sender: TObject);
    Procedure FormClose(Sender: TObject; Var Action: TCloseAction);
  Private
    Total: Integer;
    DragSource: TDropFileSource;
    DragPoint: TPoint;
    tran: TvgTranslator;
    Procedure FoundIt(Sender: TObject; LineNo: Integer; Line: String; SPos, EPos: Integer);
    Procedure StartSearch(Sender: TObject);
    Procedure SaveSettings;
    Procedure LoadSettings;
    Procedure ExpandContract(n: Integer);
    Procedure ResizeListBox;
  Protected
    Function GetOnTop: Boolean;
    Procedure SetOnTop(Value: Boolean);
    Procedure WMExitSizeMove(Var Message: TMessage); Message WM_EXITSIZEMOVE;
  Public
    GrepSettings: TGrepSettings;
    SAbort: Boolean;
    Searching: Boolean;
    OpenFiles: Boolean;
    Results: TSearchResults;
    Searcher: TSearcher;
    FileCount: Integer;
    IsDocked: Boolean;
    Procedure Execute(Refresh: Boolean);
    Property OnTop: Boolean Read GetOnTop Write SetOnTop;
  End;

Var
  frmGrepResults: TfrmGrepResults = Nil;

Const
  secGrepResult = 'GrepResult';

Procedure SaveFont(Ini: TIniFile; Const Key: String; Font: TFont);
Procedure LoadFont(Ini: TIniFile; Const Key: String; Font: TFont);

Implementation

{$R *.DFM}

Uses
  {$IFOPT D+}
  DbugIntf,
  {$ENDIF D+}
  GrepSearchDlg,
  ReplaceDialog,
  SynEdit,
  ShellAPI;

Procedure SaveFont(Ini: TIniFile; Const Key: String; Font: TFont);
Begin
  With Ini Do Begin
    // Do not localize any of the following strings
    WriteString(Key, 'Name', Font.Name);
    WriteInteger(Key, 'Size', Font.Size);
    WriteBool(Key, 'Bold', (FsBOld In Font.Style));
    WriteBool(Key, 'Italic', (FsItalic In Font.Style));
    WriteBool(Key, 'Underline', (FsUnderLine In Font.Style));
  End;
End;

Procedure LoadFont(Ini: TIniFile; Const Key: String; Font: TFont);
Begin
  With Ini Do Begin
    // Do not localize any of the following strings
    Font.Name := ReadString(Key, 'Name', Font.Name);
    Font.Size := ReadInteger(Key, 'Size', Font.Size);
    If ReadBool(Key, 'Bold', (FsBOld In Font.Style)) Then
      Font.Style := Font.Style + [FsBOld];
    If ReadBool(Key, 'Italic', (FsItalic In Font.Style)) Then
      Font.Style := Font.Style + [FsItalic];
    If ReadBool(Key, 'Underline', (FsUnderLine In Font.Style)) Then
      Font.Style := Font.Style + [FsUnderLine];
  End;
End;

Function MyTrim(Var st: String): Integer;
Begin
  Result := 0;
  While (Length(st) > 0) And (st[1] In [#9, #32]) Do Begin
    Delete(st, 1, 1);
    Inc(Result);
  End;
End;

Constructor TSearchResults.Create;
Begin
  Inherited Create(TSearchResult);
End;

Function TSearchResults.Add: TSearchResult;
Begin
  Result := TSearchResult(Inherited Add);
End;

Function TSearchResults.GetItem(Index: Integer): TSearchResult;
Begin
  Result := TSearchResult(Inherited GetItem(Index));
End;

Procedure TSearchResults.SetItem(Index: Integer; Value: TSearchResult);
Begin
  Inherited SetItem(Index, Value);
End;

Procedure TfrmGrepResults.BtnCloseClick(Sender: TObject);
Begin
  Close;
End;

Procedure TfrmGrepResults.StartSearch(Sender: TObject);
Begin
  StatusBar.Panels.Items[0].Text := tran.TMsg(SProcessing) + Searcher.FileName;
  StatusBar.Repaint;
End;

Procedure TfrmGrepResults.FoundIt(Sender: TObject; LineNo: Integer; Line: String; SPos, EPos: Integer);
Var
  AResult: TSearchResult;
Begin
  Application.ProcessMessages;
  Inc(Total);
  If (Results = Nil) Or (Results.FileName <> Searcher.FileName) Then Begin
    Results := TSearchResults.Create;
    Results.FileName := Searcher.FileName;
    lbResults.Items.AddObject(Searcher.FileName, Results);
  End;
  AResult := Results.Add;
  AResult.Line := Line;
  AResult.LineNo := LineNo;
  AResult.SPos := SPos;
  AResult.EPos := EPos;
End;

Procedure TfrmGrepResults.Execute(Refresh: Boolean);
Var
  Dlg: TfrmGrepSearch;
  SStart: Integer;
  Send: Integer;
  Edit: TSynEdit;

  Procedure CurrentOnlyGrep;
  Var
    CurrentFile: String;
  Begin
    Results := Nil;
    CurrentFile := '';
    CurrentFile := frmJediEdit.CurrentEditor.FileName;
    If CurrentFile <> '' Then Begin
      Searcher.FileName := CurrentFile;
      Searcher.Execute;
      Inc(FileCount);
    End Else MessageDlg(tran.TMsg(SNoFileOpen), MtError, [MbOK], 0);
  End;

  Procedure AllFilesGrep;
  Var
    I: Integer;
  Begin
    If OpenFiles Then With frmJediEdit Do Begin //Current Open Files in Editor.
        For i := 0 To EditorCount - 1 Do Begin
          Searcher.FileName := '';
          Searcher.FileName := Editor[i].FileName;
          Searcher.Execute;
          Inc(FileCount);
          If SAbort Then Break;
        End; //for
      End
    Else Begin // All files in the project File(.dpr or .bpr)
      // Not implemented yet!
    End;
  End;

  Procedure DirGrep(Dir, Mask: String);
  Var
    Search: TSearchRec;
    Result: Integer;
    S: TStringList;
    i: Integer;
  Begin
    //{$IFOPT D+}SendDebug('DirSearch on:' +Dir+' Mask: '+Mask);{$ENDIF}
    If Dir[Length(Dir)] <> '\' Then Dir := Dir + '\';
    //{$IFOPT D+}SendDebug('Slashed DirSearch on:' +Dir);{$ENDIF}
    S := TStringList.Create;
    Try
      For i := 1 To Length(Mask) Do
        If Mask[i] In [';', ','] Then
          Mask[i] := #13;

      S.Text := Mask;

      { First do sub-directories if option is selected }
      If GrepSettings.IncludeSubdirs Then Begin
        Result := FindFirst(Dir + '*.*', FaAnyFile, Search);
        Try
          While Result = 0 Do Begin
            If (Search.Attr And FaDirectory) <> 0 Then Begin
              If (Search.Name <> '.') And (Search.Name <> '..') Then
                DirGrep(Dir + Search.Name, Mask);
            End;
            Result := FindNext(Search);
          End;
        Finally
          FindClose(Search);
        End;
      End;

      For i := 0 To S.Count - 1 Do Begin
        Result := FindFirst(Dir + Trim(S.Strings[i]), FaAnyFile, Search);
        Try
          While Result = 0 Do Begin