synautocorrect.pas

SynEditStudio delphi 代码编辑器

      for i := 0 to Pred(FItems.Count) do
      begin
        WriteString('', 'Original' + IntToStr(i), HalfString(FItems[i], True));
        WriteString('', 'Correction' + IntToStr(i),
          HalfString(FItems[i], False));
      end;
      WriteBool('', 'Enabled', Enabled);
      WriteInteger('', 'ItemSepChar', Ord(ItemSepChar));
      for Option := ascoCorrectOnMouseDown to ascoMaintainCase do
        OptionStr := OptionStr + IntToStr(Integer(Option in Options));
      WriteString('', 'Options', OptionStr);
    end;
  finally
    Reg.Free;
  end;
end;
{$ENDIF}

procedure TCustomSynAutoCorrect.Add(AOriginal, ACorrection: string);
begin
  FItems.Add(AOriginal + FItemSepChar + ACorrection);
end;

procedure TCustomSynAutoCorrect.AddEditor(AEditor: TCustomSynEdit);
var
  i : integer;
begin
  if AEditor = nil then
    exit;
  i := fEditors.IndexOf(AEditor);
  if i = -1 then begin
    fEditors.Add(AEditor);
    AEditor.FreeNotification(Self);
    AEditor.RegisterCommandHandler( KeyboardHandler, nil );
    AEditor.AddMouseDownHandler( MouseDownHandler );
  end;
end;

function TCustomSynAutoCorrect.AutoCorrectAll(Editor: TCustomSynEdit): Boolean;
var
  i, cx: Integer;
  s, Original, Correction, CurrText: string;

begin
  Result := False;
  if Assigned(Editor) then
  begin
    s := Editor.Lines.Text;
    cx := -1;

    for i := 0 to Pred(FItems.Count) do
    begin
      CurrText := FItems[i];
      Original := HalfString(CurrText, True);
      Correction := HalfString(CurrText, False);
      FindAndCorrect(Editor, s, Original, Correction, cx);
    end;
    Editor.Lines.Text := s;
  end;
end;

function TCustomSynAutoCorrect.CorrectItemStart(EditLine, SearchString: string;
  StartPos: LongInt; MatchCase, WholeWord: Boolean): LongInt;
var
  SearchCount, I: Integer;
  C: Char;
  CharMap: array [Char] of Char;
  CurBuf, Buf: PChar;
  BufLen: Integer;

const
  WordDelimiters: set of Char = [#0..#32];

  function FindNextWordStart(var BufPtr: PChar): Boolean;
  begin
    while (SearchCount > 0) and not (BufPtr^ in WordDelimiters) do
    begin
      Inc(BufPtr, 1);
      Dec(SearchCount);
    end;

    while (SearchCount > 0) and (BufPtr^ in WordDelimiters) do
    begin
      Inc(BufPtr, 1);
      Dec(SearchCount);
    end;

    Result := SearchCount >= 0;
  end;

  function ScanText(var BufPtr: PChar): Boolean;
  var
     FirstWord: Boolean;
  begin
    Result := False;

    FirstWord := True;

    if WholeWord then
    begin
       while (SearchCount > 0) and (BufPtr^ in WordDelimiters) do
       begin
         Inc(BufPtr, 1);
         Dec(SearchCount);
       end;
    end;

    while SearchCount >= 0 do
    begin
      if WholeWord and (FirstWord = False) then
        if not FindNextWordStart(BufPtr) then Break;
      I := 0;
      while (CharMap[BufPtr[I]] = SearchString[I+1]) do
      begin
        Inc(I);
        if I >= Length(SearchString) then
        begin
          if (not WholeWord) or (SearchCount = 0) or
            (BufPtr[I] in WordDelimiters) then
          begin
            Result := True;
            Exit;
          end;
          Break;
        end;
      end;
      FirstWord := False;
      Inc(BufPtr);
      Dec(SearchCount);
    end;
  end;

begin
  Result := -1;
  BufLen := Length(EditLine);
  Buf := PChar(EditLine);

  if BufLen > 0 then
  begin
    SearchCount := succ(BufLen - StartPos - Length(SearchString));

    if (SearchCount >= 0) and (SearchCount <= BufLen) and
      (StartPos + SearchCount <= BufLen) then
    begin
      CurBuf := PChar( @Buf[StartPos] );
      for C := Low(CharMap) to High(CharMap) do
      {$IFDEF SYN_CLX}
      begin
        if not MatchCase then
          CharMap[C] := UpCase(C)
        else
          CharMap[C] := C;
      end;
      {$ELSE}
        CharMap[C] := C;
      {$ENDIF}
      if not MatchCase then
      begin
      {$IFDEF SYN_CLX}
        SearchString := UpperCase(SearchString);
      {$ELSE}
        CharUpperBuff(PChar(@CharMap), SizeOf(CharMap));
        CharUpperBuff(@SearchString[1], Length(SearchString));
      {$ENDIF}
      end;
      if not ScanText(CurBuf) then
        CurBuf := nil
      else
      begin
        if CurBuf <> nil then
          Result := CurBuf - Buf;
      end;
    end;
  end;

  CurBuf := nil;
end;

procedure TCustomSynAutoCorrect.Delete(AIndex: Integer);
begin
  FItems.Delete(AIndex);
end;

procedure TCustomSynAutoCorrect.Edit(AIndex: Integer;
  ANewOriginal, ANewCorrection: string);
begin
  if AIndex > -1 then
    FItems[AIndex] := ANewOriginal + FItemSepChar + ANewCorrection;
end;

procedure TCustomSynAutoCorrect.KeyboardHandler(Sender: TObject; AfterProcessing: boolean;
  var Handled: boolean; var Command: TSynEditorCommand; var AChar: char;
  Data: pointer; HandlerData: pointer);
var
  b: Boolean;
  i, cx: Integer;
  s, Original, Correction, CurrText: string;
  vEditor : TCustomSynEdit;
begin
  if Enabled and (not AfterProcessing) and (not Handled) then
  begin
    vEditor := TCustomSynEdit(Sender);
//    FPrevLine := vEditor.CaretY;
    case Command of
      //修改 增加对输入法的支持
      ecLineBreak, ecTab, ecChar, ecImeStr:
      begin
        if (Command = ecChar) and (AChar in AC_IdentChars) then
          Exit;
        b := False;
        s := PreviousToken(vEditor);
        if s <> '' then
        begin
          cx := vEditor.CaretX;
          for i := 0 to Pred(FItems.Count) do
          begin
            CurrText := FItems[i];
            Original := HalfString(CurrText, True);
            Correction := HalfString(CurrText, False);
            b := b or FindAndCorrect(vEditor, s, Original, Correction, cx);
          end;

          if Assigned(OnCorrected) then
            OnCorrected( Self );
        end;
      end;
    end; {endcase}
  end;
end;

procedure TCustomSynAutoCorrect.MouseDownHandler(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  Action: TAutoCorrectAction;
  b: Boolean;
  i, cx: Integer;
  s, Original, Correction, CurrText: string;
  vEditor : TCustomSynEdit;
  vPrevLine : Integer;
begin
  if ascoCorrectOnMouseDown in FOptions then
  begin
    vEditor := TCustomSynEdit(Sender);
//    if Assigned(vEditor) and Enabled and (FPrevLine <> -1) then
    if Assigned(vEditor) and Enabled then
    begin
      b := False;
      vPrevLine := vEditor.CaretY;
      s := vEditor.Lines[Pred(vPrevLine)];
//      s := vEditor.Lines[Pred(FPrevLine)];
      cx := -1;

      for i := 0 to Pred(FItems.Count) do
      begin
        CurrText := FItems[i];
        Original := HalfString(CurrText, True);
        Correction := HalfString(CurrText, False);
        b := b or FindAndCorrect(vEditor, s, Original, Correction, cx);
      end;

      if b then
      begin
        if Assigned(FOnAutoCorrect) then
        begin
          Action := aaCorrect;
//          FOnAutoCorrect(Self, Editor.Lines[Pred(FPrevLine)], s, Editor.CaretY,
          FOnAutoCorrect(Self, Editor.Lines[Pred(vPrevLine)], s, Editor.CaretY,
            0, Action);
          if Action = aaAbort then Exit;
        end;
        Editor.Lines[Pred(vPrevLine)] := s;
//        Editor.Lines[Pred(FPrevLine)] := s;

        if Assigned(OnCorrected) then
          OnCorrected( Self );
      end;
    end;
  end;
end;

function TCustomSynAutoCorrect.FindAndCorrect(Editor: TCustomSynEdit;
  var EditLine: string; Original, Correction: string;
  var CurrentX: Integer): Boolean;
var
  StartPos: LongInt;
  EndPos: Integer;
  FoundText, ReplaceDefText: string;
  p: TBufferCoord;
  Action: TAutoCorrectAction;

  function FirstCapCase(S: string): string;
  begin
    if S <> '' then
    begin
      s := LowerCase(s);
      s[1] := UpCase(s[1]);
    end;

    Result := s;
  end;

begin
  Result := False;
  ReplaceDefText := Correction;
  StartPos := 0;
  EndPos := Length(Original);

  if (Editor <> nil) and not (Editor.ReadOnly) then
  begin
    StartPos := CorrectItemStart(EditLine, Original, StartPos,
      not (ascoIgnoreCase in FOptions), True);

    while StartPos > -1 do
    begin
      if (ascoMaintainCase in FOptions) then
      begin
        Correction := ReplaceDefText;
        FoundText := Copy(EditLine,StartPos+1,EndPos);

        if FoundText = AnsiUpperCase(FoundText) then
          Correction := AnsiUpperCase(Correction)
        else
        begin
          if FoundText = AnsiLowerCase(FoundText) then
            Correction := AnsiLowerCase(Correction)
          else
          begin
            if FoundText = FirstCapCase(FoundText) then
              Correction := FirstCapCase(Correction);
          end;
        end;
      end;

      if CurrentX > - 1 then
      begin
        p := Editor.CaretXY;
        if Assigned(FOnAutoCorrect) then
        begin
          Action := aaCorrect;
          FOnAutoCorrect(Self, Original, Correction, P.Line, P.Char, Action);

          if Action = aaAbort then Break;
        end;

        Editor.BeginUpdate;

        try
          if p.Char = 0 then
            Editor.BlockBegin := BufferCoord(p.Char - 1 - EndPos, p.Line)
          else
            Editor.BlockBegin := BufferCoord(p.Char - EndPos, p.Line);

          Editor.BlockEnd := p;
          p := Editor.BlockBegin;
          Editor.SelText := Correction;
          Result := True;
        finally
          Editor.EndUpdate;
        end;

        Break;
      end
      else
      begin
        Result := True;
        EditLine := Copy(EditLine, 1, StartPos) + Correction +
          Copy(EditLine, StartPos + EndPos + 1, MaxInt);
        Inc(StartPos, EndPos);
        StartPos := CorrectItemStart(EditLine, Original, StartPos,
          not (ascoIgnoreCase in FOptions), True);
      end;
    end;
  end;
end;
                      
function TCustomSynAutoCorrect.GetItems: TStrings;
begin
  Result := FItems;
end;

procedure TCustomSynAutoCorrect.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) then
  begin
    if Editor = AComponent then
      Editor := nil
    else if AComponent is TCustomSynEdit then
      RemoveEditor( TCustomSynEdit(AComponent) );
  end;
{  if (Operation = opRemove) and (AComponent = FEditor) then
  begin
    Editor := nil;
  end;}
end;

function TCustomSynAutoCorrect.PreviousToken(Editor: TCustomSynEdit): string;
var
  i, cx: Integer;

begin
  Result := Editor.LineText;
  cx := Editor.CaretX;
  i := Pred(cx);

  if i <= Length(Result) then
  begin
    while (i > 0) and (Result[i] > ' ') do Dec(i);
    Inc(i);
    Result := Copy(Result, i, cx - i);
  end
  else
    Result := '';
end;

function TCustomSynAutoCorrect.RemoveEditor(AEditor: TCustomSynEdit): boolean;
var
  i: integer;
begin
  result := false;
  if AEditor = nil then
    exit;
  i := fEditors.Remove(AEditor);
  result := i <> -1;
  if result then begin
    AEditor.RemoveMouseDownHandler( MouseDownHandler );
    AEditor.UnregisterCommandHandler( KeyboardHandler );
{$IFDEF SYN_COMPILER_5_UP}
    AEditor.RemoveFreeNotification(Self);
{$ENDIF}
    if fEditor = AEditor then
      fEditor := nil;
  end;
end;

procedure TCustomSynAutoCorrect.SetEditor(Value: TCustomSynEdit);
begin
  if FEditor <> Value then
  begin
    if Assigned(FEditor) then
    begin
      RemoveEditor(FEditor);
//      Editor.RemoveMouseDownHandler( MouseDownHandler );
//      Editor.UnregisterCommandHandler( KeyboardHandler );
{$IFDEF SYN_COMPILER_5_UP}
//      Editor.RemoveFreeNotification(Self);
{$ENDIF}
    end;

    FEditor := Value;

    if Assigned(FEditor) then
    begin
      AddEditor(FEditor);
//      Editor.FreeNotification(Self);
//      Editor.RegisterCommandHandler( KeyboardHandler, nil );
//      Editor.AddMouseDownHandler( MouseDownHandler );
    end;
  end;
end;

procedure TCustomSynAutoCorrect.SetItems(const Value: TStrings);
begin
  FItems.Assign(Value);
end;

end.