dmain.pas

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

var
   sr : string;
   i,b,s,f:integer;
   g: PChar;
   linecnt: Integer;
   pct : Integer;
   pPC : PChar;
begin

  if selDoc <> nil then
    if SelDoc.bHexMode = false then begin
      {bDunUpdate := True;
      lineCnt := 0;
      if SelDoc.SciMain.SelLength > 1 then begin
        g := PChar(selDoc.sciMain.SelText);
        for i:= 0 to strLen(g) do begin
          if g[i] = chr(10) then lineCnt := lineCnt + 1;
        end;
      end;
      b := seldoc.sciMain.CharIndexToRowCol(seldoc.sciMain.SelStart).Y;
      for i:= (b-1) to (b-1) + (linecnt) do begin

        for s := selDoc.cmbKeywords.Items.Count-1 downto 0 do begin

          if Integer(selDoc.cmbKeywords.Items.Objects[s]) = i + 1 then
            SelDoc.cmbKeywords.Items.Delete(s);
        end;
      end;
//      selDoc.NeedUpdateFunc(-(linecnt-1));
      selDoc.sciMain.CutToClipboard;
      With TClipBoard.Create do begin
        g := PChar(asText);
      end;
      //LineCnt := 0;
      iAdd := LineCnt + 1;
      selDoc.NeedUpdateFunc(-(linecnt));}
      selDoc.sciMain.CutToClipboard;
    end
    else begin
      with selDoc.hxMain
      do begin
        pCT := SelCount;
        pPC := BufferFromFile ( Min ( SelStart , SelEnd ) , pCT );
        SetCBText ( pPC , pCT );
        FreeMem ( pPC , pCT );
        DeleteSelection;
      end;
    end;


end;

procedure TdmMain.actEditAppendCutExecute(Sender: TObject);
var
   sr : string;
   i,b,s,f:integer;
   g: PChar;
   linecnt: Integer;
   pct : Integer;
   pPC : PChar;
begin
    if dmMain.SelDoc = nil then exit;
    if SelDoc.bHexMode then exit;
    with TClipboard.Create do
      try

        AsText := AsText {+ CrLf} + dmMain.SelDoc.sciMain.SelText;
      finally
        Free;
      end;
{      bDunUpdate := True;
      lineCnt := 0;
      if SelDoc.SciMain.SelLength > 1 then begin
        g := PChar(selDoc.sciMain.SelText);
        for i:= 0 to strLen(g) do begin
          if g[i] = chr(10) then lineCnt := lineCnt + 1;
        end;
      end;
      b := selDoc.sciMain.CaretXY.Y;
      for i:= (b-1) to (b-1) + (linecnt) do begin

        for s := selDoc.cmbKeywords.Items.Count-1 downto 0 do begin

          if Integer(selDoc.cmbKeywords.Items.Objects[s]) = i + 1 then
            SelDoc.cmbKeywords.Items.Delete(s);
        end;
      end;
//      selDoc.NeedUpdateFunc(-(linecnt-1));
      dmMain.SelDoc.sciMain.SelText := '';
      With TClipBoard.Create do begin
        g := PChar(asText);
      end;
      //LineCnt := 0;
      iadd := 1;
      selDoc.NeedUpdateFunc(-(linecnt));}

end;

procedure TdmMain.actEditCopyExecute(Sender: TObject);
var
  pct : Integer;
  pPC : PChar;
begin
  if selDoc <> nil then
    if SelDoc.bHexMode = false then
      selDoc.sciMain.CopyToClipboard
    else begin
      with SelDoc.hxMain
      do begin
        pCT := SelCount;
        pPC := BufferFromFile ( Min ( SelStart , SelEnd ) , pCT );
        SetCBText ( pPC , pCT );
        FreeMem ( pPC , pCT );
      end;
    end;

end;

procedure TdmMain.actEditAppendCopyExecute(Sender: TObject);
begin
    if dmMain.SelDoc = nil then exit;
    if SelDoc.bHexMode then exit;    
    with TClipboard.Create do
      try
        AsText := AsText {+ CrLf} + dmMain.SelDoc.sciMain.SelText;
      finally
        Free;
      end;
end;

procedure TdmMain.actEditPasteExecute(Sender: TObject);
var
   sr : string;
   i,b,s,f:integer;
   g: PChar;
   linecnt: Integer;
begin

  if selDoc <> nil then
    if SelDoc.bHexMode = false then begin
{      bDunUpdate := True;
      lineCnt := 0;
      if SelDoc.SciMain.SelLength > 1 then begin
        g := PChar(selDoc.sciMain.SelText);
        for i:= 0 to strLen(g) do begin
          if g[i] = chr(10) then lineCnt := lineCnt + 1;
        end;
      end;

//      if selDoc.sciMain.SelStart < selDoc.sciMain.CaretX
      b := seldoc.sciMain.CharIndexToRowCol(seldoc.sciMain.SelStart).Y;
//      b := selDoc.sciMain.CaretXY.Y;
      for i:= (b-1) to (b-1) + (linecnt) do begin

        for s := selDoc.cmbKeywords.Items.Count-1 downto 0 do begin

          if Integer(selDoc.cmbKeywords.Items.Objects[s]) = i + 1 then
            SelDoc.cmbKeywords.Items.Delete(s);
        end;
      end;
//      selDoc.NeedUpdateFunc(-(linecnt-1));}
      selDoc.sciMain.PasteFromClipboard;     {
      With TClipBoard.Create do begin
        g := PChar(asText);
      end;
      LineCnt := 0;
      for s := 0 to StrLen(g) do begin
        if g[s] = chr(10) then
          LineCnt:=LineCnt+1;
      end;
      iadd := lineCnt + 1; //25; //lineCnt;
      selDoc.NeedUpdateFunc((seldoc.sciMain.CaretY - b)); // - 1 - (linecnt-1)));
      selDoc.ListFunctionsY(b-1, seldoc.sciMain.CaretY);}
    end
    else begin
      sr := Clipboard.AsText;
      SelDoc.hxMain.ReplaceSelection ( @sr[1] , Length ( sr ) );
    end;
end;

procedure TdmMain.actEditDeleteExecute(Sender: TObject);
var
b: PChar;
begin
  b := PChar(SelDOc.sciMain.Text);

  if (Pos(Chr(10), selDoc.sciMain.SelText) <> 0) then begin
    bDunUpdate := true;
//    iadd := 1;
    SelDOc.NeedUpdateFunc(0);
  end
  else if (b[selDoc.sciMain.SelStart + 1] = chr(10)) then begin
    bDunUpdate := true;
    SelDoc.NeedUpdateFunc(-1);
  end;
  if dmMain.SelDoc <> nil then
    dmMain.SelDoc.sciMain.ExecuteCommand(ecDeleteChar, #0, nil);
end;

procedure TdmMain.actEditModifiedExecute(Sender: TObject);
begin
  if dmMain.SelDoc <> nil then
    dmMain.SelDoc.sciMain.Modified := actEditModified.Checked;
end;

procedure TdmMain.actEditReadOnlyExecute(Sender: TObject);
begin
  if dmMain.SelDoc <> nil then
    dmMain.SelDoc.sciMain.ReadOnly := actEditReadOnly.Checked;
end;

procedure TdmMain.actEditSelectAllExecute(Sender: TObject);
begin
  if dmMain.SelDoc <> nil then
    dmMain.SelDoc.sciMain.SelectAll;
end;

procedure TdmMain.actGoto0Execute(Sender: TObject);
begin
  if SelDoc <> nil then
    SelDoc.sciMain.GotoBookMark((Sender as Taction).Tag);
end;

procedure TdmMain.SetBookmark(const AIndex: integer);
begin
  if selDoc <> nil then
    with selDoc.sciMain do
      if IsBookmark(AIndex) then
        ClearBookMark(AIndex)
      else
        SetBookMark(AIndex, CaretX, CaretY);
end;

procedure TdmMain.actToggle0Execute(Sender: TObject);
begin
  if SelDoc <> nil then
    SetBookmark((Sender as Taction).tag);
end;

procedure TdmMain.actEditHexExecute(Sender: TObject);
var
  Stream: TMemoryStream;
  XY: Integer;
begin
  if SelDoc = nil then exit;
  dmMain.actEditHex.Checked := not dmMain.actEditHex.Checked;
  frmMain.HexEdit1.Checked := dmMain.actEditHex.Checked;
  frmMain.tbbHex.Down := dmMain.actedithex.Checked;

  With SelDoc do begin
    stream := TMemoryStream.Create;
    if dmMain.actEditHex.Checked = True then begin
      XY := sciMain.SelStart;
      if xy > strLen(PChar(sciMain.Text)) then xy := strlen(PChar(sciMain.Text));
      sciMain.Lines.SaveToStream(Stream);
      HxMain.LoadFromStream(Stream);
      if XY > 1 then
        hxMain.SelStart := XY-1;
      hxMain.BringToFront;
      bHexMode := True;
      Windows.SetFocus(hxMain.Handle);
    end
    else begin
      XY := hxMain.SelStart;
      hxMain.SaveToStream(Stream);
      sciMain.Lines.LoadFromStream(Stream);
      sciMain.SelStart := XY+1;
      sciMain.BringToFront;
      bHexMode := False;
      Windows.SetFocus(sciMain.Handle);
    end;
  end;
end;

procedure TdmMain.actViewPrefrencesExecute(Sender: TObject);
begin
  ShowOpt;
end;

procedure TdmMain.actHelpAboutExecute(Sender: TObject);
begin
  With TfrmAbout.Create(frmMain) do begin
    ShowModal;
  end;
end;

procedure TdmMain.actFindFindExecute(Sender: TObject);
begin
  if dmMain.SelDoc = nil then exit;
  frmFindText := TfrmFindText.Create(self);
  frmFindText.cmbFind.Text := dmMain.SelDoc.sciMain.SelText;
  if SelDoc.bHexMode = false then begin
    With frmFindText do begin
      SearchText := gsSearchText;
      if (dmMain.SelDoc.sciMain.SelText <> '') then
        SearchText := dmMain.SelDoc.sciMain.SelText;
      SearchTextHistory := gsSearchTextHistory;
      SearchWholeWords := gbSearchWholeWords;
      if ShowModal = mrOK then begin
        gbSearchBackwards := SearchBackwards;
        gbSearchCaseSensitive := SearchCaseSensitive;
        gbSearchFromCaret := SearchFromCursor;
        gbWrapAround := WrapAround;
        gbSearchSelectionOnly := SearchInSelectionOnly;
        gbSearchWholeWords := SearchWholeWords;
        gsSearchText := SearchText;
        gsSearchTextHistory := SearchTextHistory;
        fSearchFromCaret := gbSearchFromCaret;
        if gbSearchBackwards then iSearchDir := 1
        else iSearchDir := 0;
        if gsSearchText <> '' then begin
          DoSearchReplaceText(False, gbSearchBackwards);
          fSearchFromCaret := TRUE;
        end;
      end;

      Destroy;
    end;
  end
  else begin
    With TfrmFindHex.Create(nil) do begin
      if selDoc.hxMain.DataSize = 0 then exit;
      ShowModal;
    end;
  end;
end;

procedure TdmMain.actFindNextExecute(Sender: TObject);
begin
  if dmMain.SelDoc <> nil then begin
    DoSearchReplaceText(False, False);
    if iSearchDir = 1 then
      DoSearchReplaceText(False, False);
    iSearchDir := 0;
  end;
end;


procedure TdmMain.actFindReplaceExecute(Sender: TObject);
var
  mResult: Integer;
begin
  if dmMain.SelDoc = nil then exit;
  With TfrmReplace.Create(self) do begin
    cmbFind.Text := dmMain.SelDoc.sciMain.SelText;
    SearchText := gsSearchText;
    if (dmMain.SelDoc.sciMain.SelText <> '') then
      SearchText := dmMain.SelDoc.sciMain.SelText;
    SearchTextHistory := gsSearchTextHistory;
    SearchWholeWords := gbSearchWholeWords;
    mResult := ShowModal;
    if (mResult = mrOK) or (mResult = mrAll) then begin
      gbSearchBackwards := SearchBackwards;
      gbSearchCaseSensitive := SearchCaseSensitive;
      gbSearchFromCaret := SearchFromCursor;
      gbSearchSelectionOnly := SearchInSelectionOnly;
      gbSearchWholeWords := SearchWholeWords;
      gsSearchText := SearchText;
      gsReplaceText := ReplaceText;
      gsSearchTextHistory := SearchTextHistory;

      fSearchFromCaret := gbSearchFromCaret;
      if gbSearchBackwards then iSearchDir := 1
      else iSearchDir := 0;
      if gsSearchText <> '' then begin
        if mResult = mrOK then
          DoSearchReplaceText(True, gbSearchBackwards)
        else begin
          DoSearchReplaceText(True, gbSearchBackwards, true);
        end;
        fSearchFromCaret := TRUE;
      end;
    end;
    Destroy;
  end;
end;

procedure TdmMain.DoSearchReplaceText(AReplace: boolean;
  ABackwards: boolean; aRepAll: Boolean=False);
var
  Options: TSynSearchOptions;
begin
  frmMain.stbMain.SimpleText := '';
  if AReplace then
    Options := [ssoPrompt, ssoReplace, ssoReplaceAll]
  else
    Options := [];
  if ABackwards then
    Include(Options, ssoBackwards);
  if gbSearchCaseSensitive then
    Include(Options, ssoMatchCase);
  if not fSearchFromCaret then
    Include(Options, ssoEntireScope);
  if gbSearchSelectionOnly then
    Include(Options, ssoSelectedOnly);
  if gbSearchWholeWords then
    Include(Options, ssoWholeWord);
      if(aReplace) and (aRepAll) then begin
        bReplaceAll := True;
        Include(Options, ssoReplaceAll);
      end;
  dmMain.SelDoc.sciMain.SearchEngine := dmMain.SynEditSearch;
  if dmMain.SelDoc.sciMain.SearchReplace(gsSearchText, gsReplaceText, Options) = 0 then
  begin
    if gbWrapAround then begin
      //LockWindowUpdate(dmMain.SelDoc.sciMain.Handle);
      {x:= dmMain.SelDoc.sciMain.SelStart;
      y:= dmMain.SelDoc.sciMain.SelEnd;}
      Include(Options, ssoEntireScope);
      {if ABackwards = False then begin
        dmMain.SelDoc.sciMain.SelStart := 1;
        dmMain.SelDoc.sciMain.SelEnd := 1;
      end
      else begin
        dmMain.SelDoc.sciMain.SelStart := Length(dmMain.SelDoc.sciMain.Text);