TRichEdit CHARFORMAT2A CFU_UNDERLINEWAVE

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

Afin de repérer les mots mal orthographiés dans TRichEdit Spellchecking lorsqu'une sélection est effectué, je voudrais vérifier si la sélection comporte une ligne ondulée.

J'utilise CHARFORMAT2A pour récupéré la valeur du type bUnderlineType

Pièce jointe 653911
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 { MisspelledWord } procedure MisspelledWord(RichEdit: TRichEdit); const CFU_UNDERLINEWAVE = 8; { Ligne ondulée } var Format2A: CHARFORMAT2A; begin FillChar(Format2A, SizeOf(Format2A), 0); with Format2A do begin cbSize := SizeOf(Format2A); RichEdit.Perform(EM_GETCHARFORMAT, SCF_SELECTION, LPARAM(@Format2A)); Form1.Caption := 'bUnderlineType = ' + IntToStr(bUnderlineType); if bUnderlineType = CFU_UNDERLINEWAVE then ShowMessage('Mot mal orthographié !'); end; end;
Code:

1 2 3 4 5 procedure TForm1.RichEditMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin MisspelledWord(RichEdit); end;
Le hic, c'est que je ne parviens pas à récupérer la valeur du type bUnderlineType, Cela me renvoie toujours la valeur 1.

Auriez-vous une petite idée ? Merci

1 pièce(s) jointe(s)

En appliquant la ligne ondulée avec EM_SETCHARFORMAT, j'arrive bien a récupéré la valeur du type bUnderlineType, donc ça fonctionne depuis le début.

Toutefois, je ne peux toujours pas récupérer la valeur du type bUnderlineType sur les lignes ondulées rouges du SpellChecking, comme si elle se trouvait en surface du RichEdit.

Code:

1
2
var
  Format2A: CHARFORMAT2A;

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
{ SET_UnderlineWare }
procedure SET_UnderlineWare(RichEdit: TRichEdit);
const
  CFU_UNDERLINEWAVE = 8; { Ligne ondulée }
begin
  FillChar(Format2A, SizeOf(Format2A), 0);
 
  with Format2A do
  begin
    cbSize := SizeOf(Format2A);
    dwMask := CFM_UNDERLINETYPE;
    dwEffects := CFM_UNDERLINE;
    bUnderlineType := CFU_UNDERLINEWAVE;
 
    RichEdit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@Format2A));
  end;
end;

Code:

1
2
3
4
5
6
7
8
9
10
11
12
{ GET_UnderlineType}
procedure GET_UnderlineType(RichEdit: TRichEdit);
begin
  FillChar(Format2A, SizeOf(Format2A), 0);
 
  with Format2A do
  begin
    cbSize := SizeOf(Format2A);
    RichEdit.Perform(EM_GETCHARFORMAT, SCF_SELECTION, LPARAM(@Format2A));
    Form1.Caption := 'bUnderlineType = ' + IntToStr(bUnderlineType);
  end;
end;

Code:

1
2
3
4
5
6
7
8
9
10
11
procedure TForm1.RichEditMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  case Button of
    mbLeft:
      GET_UnderlineType(RichEdit);
 
    mbRight:
      SET_UnderlineWare(RichEdit);
  end;
end;

Pièce jointe 653923

29/04/2024, 06h28
XeGregory

Cette méthode visait à attribuer un TPopupMenu lorsqu'une sélection est effectuée.
Le problème avec le SpellChecking lorsqu'il est activé, pour avoir le menu des suggestions de correction, il faut définir le RichEdit.PopupMenu := nil.

Donc je me suis dit si j'arrive à récupérer la valeur de cette ligne ondulée je pouvais peut-être gérer les TPopupMenu

Citation:

Si ( Ligne Ondulée ) et (SpellChecking = True) Alors RichEdit.PopupMenu := nil Sauf RichEdit.PopupMenu := PopupMenu1

ou

Si ( GET_UnderlineType = 1 ) Alors RichEdit.PopupMenu := PopupMenu1 Sauf RichEdit.PopupMenu := nil

Mais cela me semble beaucoup plus complexe que ça :?
29/04/2024, 09h29
ShaiLeTroll

Il existe le CallBack de EM_SETAUTOCORRECTPROC, dommage qu'il n'existe pas un Callback pour la détection qui indiquerait la position du Mot en erreur

As-tu essayé avec ITextFont::GetUnderline à tomWave ?
Il faut travailler sur le ITextDocument obtenu par un RichEdit.Perform EM_GETOLEINTERFACE
29/04/2024, 11h43
anapurna

salut

comme le dis shailetroll il existe une fonctions et des message depuis quelque temps deja

les message mis en œuvre

EM_GETAUTOCORRECTPROC = (WM_USER + 233)
EM_SETAUTOCORRECTPROC = (WM_USER + 234)
EM_CALLAUTOCORRECTPROC = (WM_USER + 255)

La fonction callback est du type
TAutoCorrectProc = function(LangId : WORD;PszBefore,PszAfter : PWChar;CchAfter : LongInt;PCchReplaced : Pointer): integer;

dans tout ceci il n'y a pas de notion de position
29/04/2024, 18h46
XeGregory

Citation:

Envoyé par ShaiLeTroll

As-tu essayé avec ITextFont::GetUnderline à tomWave ?
Il faut travailler sur le ITextDocument obtenu par un RichEdit.Perform EM_GETOLEINTERFACE

Non j'ai pas recherché de ce côté-la, j'ai pris exemple le TRichEdit, mes je dispose du LMDRichEdit qui lui donne accès au TextDocument & TextDocument2 TOM2
Je vais rechercher de ce côté-là.

Merci ShaiLeTroll & Anapurna

Salut

il faut peut être passer par la redéfinition du wnproc
comme nous le faisions à l'époque pour activer les liens cliquable

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
procedure TForm1.WndProc(var Message: TMessage);
var
  p: TENLink;
  strURL: string;
begin
  if (Message.Msg = WM_NOTIFY) then
  begin
    if (PNMHDR(Message.lParam).code = EN_LINK) then
    begin
      p := TENLink(Pointer(TWMNotify(Message).NMHdr)^);
      if (p.Msg = WM_LBUTTONDOWN) then
      begin
        SendMessage(RichEdit1.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
        strURL := RichEdit1.SelText;
        ShellExecute(Handle, 'open', PChar(strURL), 0, 0, SW_SHOWNORMAL);
      end
    end;
  end;
 
  inherited;
end;

30/04/2024, 18h46
XeGregory

J'ai fait des recherches du côté de LMDRichEdit, en espérant obtenir un peu plus d'éléments avec ce composant., Mes riens de plus que le TRichEdit coté SpellChecking.

Après, il y a peut-être une autre alternative : ce serait d'intercepter l'ouverture du PopupMenu du SpellChecking.

Peut-être en récupérant le Message.hWnd du PopupMenu il y peut-être un truc a faire :koi:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
 
type
  TRichEdit = class(Vcl.ComCtrls.TRichEdit)
  protected
    procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
  end;
 
procedure TRichEdit.WMContextMenu(var Message: TWMContextMenu);
begin
  // Message.hWnd 
  inherited;
end;

1 pièce(s) jointe(s)

J'ai trouvé cette solution-là :D, vu que le SpellChecking se présente avant la demande d'ouverture du PopUpMenu1 on lui laisse la place, s'il se présente pas ont réattribue le PopUpMenu1 au Control.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
type
  TCustomRE = class(TCustomRichEdit);
 
procedure TForm1.RichEditMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  case Button of
    mbRight:
      begin
        if (Screen.ActiveControl is TCustomRichEdit) and
          not Assigned(TCustomRE(Screen.ActiveControl).PopupMenu) then
          TCustomRE(Screen.ActiveControl).PopupMenu := PopupMenu1
        else
          TCustomRE(Screen.ActiveControl).PopupMenu := nil;
      end;
  end;
end;

Pièce jointe 654047