grepresultsdlg.pas

Delphi编写的一个支持语法高亮显示和很多语言的文本编辑器

procedure TfrmGrepResults.lbResultsMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
begin
  //Make sure mouse has moved at least 10 pixels before starting drag ...
  if (DragPoint.X = -1) or ((Shift <> [ssLeft]) and (Shift <> [ssRight])) or
    ((Abs(DragPoint.X - X) < 10) and (Abs(DragPoint.Y - Y) < 10)) then Exit;

  i := lbResults.ItemAtPos(Point(X, Y), True);

  if (i > -1) then
  begin
    DragSource.Files.Clear;
    if lbResults.Items.Objects[i] is TSearchResults then
      DragSource.Files.Add(TSearchResults(lbResults.Items.Objects[i]).FFileName)
    else if lbResults.Items.Objects[i] is TSearchResult then
      DragSource.Files.Add(TSearchResults(TSearchResult(lbResults.Items.Objects[i]).Collection).FFileName);
    if DragSource.Files.Count > 0 then
      DragSource.Execute;
  end;
end;

procedure TfrmGrepResults.lbResultsMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  DragPoint := Point(X, Y);
end;

procedure TfrmGrepResults.FormResize(Sender: TObject);
begin
  StatusBar.Panels.Items[0].Width := StatusBar.Width - 100;
  Invalidate;
end;

procedure TfrmGrepResults.FormDestroy(Sender: TObject);
begin
  actClearExecute(actClear);
  SaveSettings;
  frmGrepResults := nil;
  SAbort := True;
  DragSource.Free;
  DragSource := nil;
  inherited;
end;

procedure TfrmGrepResults.SaveSettings;
var
  Reg : TRegistry;
begin
  // do not localize any of the below strings
  Reg := TRegistry.Create;
  Reg.OpenKey(GrepKey, True);
  try
    SaveFont(Reg, lbResults.Font);
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
end;

procedure TfrmGrepResults.LoadSettings;
var
  Reg : TRegistry;
begin
  // do not localize any of the below strings
  Reg := TRegistry.Create;
  Reg.OpenKey(GrepKey, True);
  try
    LoadFont(Reg, lbResults.Font);
  finally
    Reg.Free;
  end;
end;

procedure TfrmGrepResults.FormCreate(Sender: TObject);
begin
  inherited;
  {tran := TvgTranslator.Create(Self);}
  Searching := False;
  LoadSettings;
  ResizeListBox;
  DragSource := TDropFileSource.Create(nil);
end;

procedure TfrmGrepResults.lbResultsMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  p: Integer;
begin
  if Button = mbLeft then
  begin
    p := lbResults.ItemAtPos(Point(X, Y), True);
    if p <> -1 then
      if lbResults.Items.Objects[p] is TSearchResults then
        ExpandContract(p);
  end;
end;

procedure TfrmGrepResults.ExpandContract(n: Integer);
var
  Results: TSearchResults;
  i: Integer;
begin
  if (n < 0) or (n > lbResults.Items.Count - 1) or Searching then
    Exit;
  if lbResults.Items.Objects[n] is TSearchResults then
  begin
    try
      lbResults.Items.BeginUpdate;
      Results := TSearchResults(lbResults.Items.Objects[n]);
      if Results.Expanded then
      begin
        while (n + 1 <= lbResults.Items.Count - 1) and
          (not (lbResults.Items.Objects[n + 1] is TSearchResults)) do
        begin
          lbResults.Items.Delete(n + 1);
        end;
        Results.Expanded := False;
      end
      else
      begin
        for i := Results.Count - 1 downto 0 do
          lbResults.Items.InsertObject(n + 1, Results.Items[i].Line, Results.Items[i]);
        Results.Expanded := True;
      end
    finally
      lbResults.Items.EndUpdate;
    end;
  end;
end;

procedure TfrmGrepResults.lbResultsKeyPress(Sender: TObject; var Key: Char);
begin
  case Key of
    '+',
      '=',
      '-': ExpandContract(lbResults.ItemIndex);
    #13: actGotoLineExecute(actGotoLine);
  end;
end;

procedure TfrmGrepResults.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #27 then
  begin
    if Searching then
      SAbort := True
    else
      Hide;
  end;
end;

procedure TfrmGrepResults.ResizeListBox;
begin
  with lbResults do
  begin
    Canvas.Font.Assign(Font);
    ItemHeight := Canvas.TextHeight('W') + 3; // "W" is any character
    Refresh;
  end;
end;

procedure TfrmGrepResults.lbResultsDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  TopColor: TColor;
  BottomColor: TColor;
  ResultsCanvas: TCanvas;
  c: Integer;
  p: Integer;
  i: Integer;
  st: string;
  Result: TSearchResult;
  sb: TColor;
  sf: TColor;
  nb: TColor;
  nf: TColor;
begin
  ResultsCanvas := lbResults.Canvas;
  TopColor := clBtnHighlight;
  BottomColor := clBtnShadow;
  if lbResults.Items.Objects[Index] is TSearchResults then
  begin
    ResultsCanvas.Brush.Color := clBtnFace;
    ResultsCanvas.Font.Color := clBtnText;
    ResultsCanvas.FillRect(Rect);
    Rect.Right := Rect.Right + 2;
    if odSelected in State then
      Frame3D(ResultsCanvas, Rect, BottomColor, TopColor, 1)
    else
      Frame3D(ResultsCanvas, Rect, TopColor, BottomColor, 1);
    i := ResultsCanvas.TextWidth('+');
    ResultsCanvas.TextOut(Rect.Left + i + 8, Rect.Top, lbResults.Items[Index]);
    //c:=Rect.Top+((Rect.Bottom-Rect.Top) div 2);
    if TSearchResults(lbResults.Items.Objects[Index]).Expanded then
      ResultsCanvas.TextOut(Rect.Left + 3, Rect.Top, '-')
    else
      ResultsCanvas.TextOut(Rect.Left + 3, Rect.Top, '+');
    st := SItemMatches{tran.TMsg(SItemMatches)} + IntToStr(TSearchResults(lbResults.Items.Objects[Index]).Count);
    p := ResultsCanvas.TextWidth(SItemMatches + '00000') + 10; // do not localize
    if (ResultsCanvas.TextWidth(lbResults.Items[Index]) + i + 7) <= Rect.Right - p then
      ResultsCanvas.TextOut(lbResults.ClientWidth - p, Rect.Top, st);
  end
  else
  begin
    Result := TSearchResult(lbResults.Items.Objects[Index]);
    if odSelected in State then
    begin
      nb := clHighLight;
      nf := clHighLightText;
      sb := clWindow;
      sf := clWindowText;
    end
    else
    begin
      sb := clHighLight;
      sf := clHighLightText;
      nb := clWindow;
      nf := clWindowText;
    end;
    ResultsCanvas.Brush.Color := nb;
    ResultsCanvas.Font.Color := nf;
    ResultsCanvas.FillRect(Rect);
    ResultsCanvas.TextOut(Rect.Left + 10, Rect.Top + 1, IntToStr(Result.LineNo));
    p := 60;
    st := lbResults.Items[Index];
    c := MyTrim(st);
    i := 1;
    while i <= Length(st) do
    begin
      if (i >= Result.SPos - c) and (i <= Result.EPos - c) then
      begin
        ResultsCanvas.Font.Color := sf;
        ResultsCanvas.Brush.Color := sb;
      end
      else
      begin
        ResultsCanvas.Font.Color := nf;
        ResultsCanvas.Brush.Color := nb;
      end;
      If ByteType(st, i) <> mbSingleByte Then
      Begin
        // It's a MBCS
        ResultsCanvas.TextOut(Rect.Left + p, Rect.Top + 1, Copy(st, i, 2));
        p := p + ResultsCanvas.TextWidth(Copy(st, i, 2));
        inc(i);
      end
      else begin
        ResultsCanvas.TextOut(Rect.Left + p, Rect.Top + 1, Copy(st, i, 1));
        p := p + ResultsCanvas.TextWidth(Copy(st, i, 1));
      End;
      inc(i);
    end;
  end;
end;

procedure TfrmGrepResults.WMExitSizeMove(var Message: TMessage);
begin
  lbResults.Repaint;
end;

procedure TfrmGrepResults.mnuRefreshClick(Sender: TObject);
begin
  Execute(True);
end;

procedure TfrmGrepResults.FormShow(Sender: TObject);
begin
  {tran.LanguageFile := CurrentLan;}
  {tran.Translate;}
end;

procedure TfrmGrepResults.FormDockDrop(Sender: TObject;
  Source: TDragDockObject; X, Y: Integer);
begin
  lbResults.Invalidate;
end;

procedure TfrmGrepResults.SpeedButton1Click(Sender: TObject);
begin
  lbResults.Invalidate;
  lbResults.Refresh;
  lbResults.Repaint;
  ShowMessage(IntToStr(lbResults.Items.Count));
end;

procedure TfrmGrepResults.Loaded;
begin
  inherited Loaded;
  //Visible := false;
  //Position := poDefault;
  //BorderIcons := [];
  //BorderStyle := bsNone;
  //HandleNeeded;
end;

procedure TfrmGrepResults.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  //Params.Style := WS_CHILD or WS_CLIPSIBLINGS;
  //Params.X := 0;
  //Params.Y := 0;
end;

procedure TfrmGrepResults.actGrepExecute(Sender: TObject);
begin
  Execute(False);
end;

procedure TfrmGrepResults.actRefreshExecute(Sender: TObject);
begin
  Execute(True);
end;

procedure TfrmGrepResults.actAbortExecute(Sender: TObject);
begin
  sAbort := True;
end;

procedure TfrmGrepResults.actGotoLineExecute(Sender: TObject);
var
  Result          : TSearchResult;
  CurrentFileName : string;
  R               : TPoint;
  fEditor         : TfrmDoc;
  n               : Integer;
  found           : Boolean;
begin
  fEditor := nil;
  found := False;
  if (lbResults.ItemIndex < 0) then
    Exit;
  if (lbResults.Items.Objects[lbResults.ItemIndex] is TSearchResults) then
  begin
    ExpandContract(lbResults.ItemIndex);
    Exit;
  end;
  Result := TSearchResult(lbResults.Items.Objects[lbResults.ItemIndex]);
  if Result = nil then Exit;
  with TSearchResults(Result.Collection) do
  begin
    CurrentFileName := FileName;
  end; //with
  R.X := Result.SPos;
  R.Y := Result.LineNo;

  for n := 0 to frmMain.MDIChildCount - 1 do
  begin
    if UpperCase(tfrmDoc(frmMain.MDIChildren[n]).Filename) = uppercase(CurrentFileName) then
    begin
      frmMain.MDIChildren[n].BringToFront;
      fEditor := TfrmDoc(frmMain.MDIChildren[n]);
//      fEditor.sciMain.Set(R.Y-1,R.X-1);
      fEditor.sciMain.CaretY := r.y;
      fEditor.sciMain.CaretX := r.X;
      found := True;
      fEditor.sciMain.SetFocus;
    end;
  end;
  if not found then
  begin
    dmMain.NewDoc(CurrentFileName);
    fEditor := frmMain.GetCurrentEditor;
//    fEditor.sciMain.SetSection(R.Y-1,R.X-1);

    fEditor.sciMain.CaretY := r.y;
    fEditor.sciMain.CaretX := r.X;
    Windows.SetFocus(dmMain.SelDoc.sciMain.Handle)
  end;
  if Assigned(fEditor) then
  Begin
{    fEditor.synMDI.SelLength := (Result.EPos + 1) - Result.SPos;
    fEditor.synMDI.Perform(EM_SCROLLCARET, 0, 0);}

  end;
  Windows.SetFocus(dmMain.SelDoc.sciMain.Handle)
end;

procedure TfrmGrepResults.actPrintExecute(Sender: TObject);
var
  RichEdit: TRichEdit;
  Results: TSearchResults;
  Line: string;
  i, j, c: Integer;
  LinePos: Integer;

begin
  if lbResults.Items.Count = 0 then
    Exit;
  RichEdit := TRichEdit.Create(Self);
  try
    RichEdit.Visible := False;
    RichEdit.Parent := Self;
    RichEdit.Font.Name := 'Arial';
    RichEdit.Font.Size := 10;
    RichEdit.Clear;

    for i := 0 to lbResults.Items.Count - 1 do
      if lbResults.Items.Objects[i] is TSearchResults then
      begin
        RichEdit.Lines.Add(''); // space between fileresults

        Results := TSearchResults(lbResults.Items.Objects[i]);

        RichEdit.SelAttributes.Style := [fsBold];
        RichEdit.Lines.Add(Results.FileName);
        RichEdit.SelAttributes.Style := [];

        for j := 0 to Results.Count - 1 do
        begin
          LinePos := RichEdit.GetTextLen;
          Line := Results.Items[j].Line;
          c := MyTrim(Line);
          with RichEdit do
          begin
            Lines.Add(Format('  %5d'#9, [Results.Items[j].LineNo]) + Line);
            // Now make the found Text bold
            SelStart := LinePos + 7 - c + Results.Items[j].SPos;
            SelLength := Results.Items[j].EPos - Results.Items[j].SPos + 1;
            SelAttributes.Style := [fsBold];
            SelLength := 0;
            SelAttributes.Style := [];
          end;
        end;
      end;
    RichEdit.Print('Grep Search Results');
  finally
    RichEdit.Free;
  end;
end;

procedure TfrmGrepResults.actContractExecute(Sender: TObject);
var
  i: Integer;
begin
  Self.Enabled := False;
  lbResults.Items.BeginUpdate;
  try
    i := 0;
    while i <= lbResults.Items.Count - 1 do
      if lbResults.Items.Objects[i] is TSearchResult then
      begin
        lbResults.Items.Delete(i);
      end
      else
      begin
        TSearchResults(lbResults.Items.Objects[i]).Expanded := False;
        Inc(i);
      end;
  finally
    lbResults.Items.EndUpdate;
    Self.Enabled := True;
  end;
end;

procedure TfrmGrepResults.actExpandExecute(Sender: TObject);

  function Expand(n: Integer): Integer;
  var
    Results: TSearchResults;
    t: integer;
  begin
    Results := TSearchResults(lbResults.Items.Objects[n]);
    for t := Results.Count - 1 downto 0 do
      lbResults.Items.InsertObject(n + 1, Results.Items[t].Line, Results.Items[t]);
    Results.Expanded := True;
    Result := n + Results.Count - 1;
  end;

var
  i: integer;
begin
  Self.Enabled := false;
  lbResults.Items.BeginUpdate;
  try
    i := 0;
    while i <= lbResults.Items.Count - 1 do
      if lbResults.Items.Objects[i] is TSearchResults then
      begin
        if not TSearchResults(lbResults.Items.Objects[i]).Expanded then
          i := Expand(i);
        Inc(i);
      end
      else
        Inc(i);
  finally
    lbResults.Items.EndUpdate;
    Self.Enabled := True;
  end;
end;

procedure TfrmGrepResults.actFontExecute(Sender: TObject);
begin
  dlgGrepFont.Font.Assign(lbResults.Font);
  if dlgGrepFont.Execute then
  begin
    lbResults.Font.Assign(dlgGrepFont.Font);
    ResizeListBox;
  end;

end;

procedure TfrmGrepResults.actClearExecute(Sender: TObject);
begin
  lbResults.Clear;
  actExpand.Enabled := False;
  actContract.Enabled := False;
  actGotoLine.Enabled := False;
  actPrint.Enabled := False;
end;

procedure TfrmGrepResults.lbResultsDblClick(Sender: TObject);
begin
  actGotoLineExecute(actGotoLine);
end;

procedure TfrmGrepResults.MakeVisible;
begin
  Visible := True;
  FormResize(Self);
end;

procedure TfrmGrepResults.ClearResults1Click(Sender: TObject);
begin
  lbResults.Clear;
end;

procedure TfrmGrepResults.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  frmMain.FindInFiles2.Checked := false;
end;

end.