How to find the font descritpion of a word in a richedit?

Hi team,
I have a richedit box and I have programmed into it the ability to change the font size, style, name etc.
When I click my the mouse onto a word in this richedit box I would like to be able to determine all the details of the selected word. I found some code on the net which I have adapted to suit my purposes. see below:

uses richedit;

procedure TfrmWriter.richEditorMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  WhatStyle(X, Y);
end;

procedure TfrmWriter.WhatStyle(X, Y: Integer);
//Purpose : To make show what style of text is currently where the mouse pointer is
var
  iCharIndex, iLineIndex, iCharOffset, i, j: Integer;
  Pt: TPoint;
  s: string;
begin
with richeditor do
  begin
    Pt := Point(X, Y);
    // Get Character Index from word under the cursor
    iCharIndex := Perform(Messages.EM_CHARFROMPOS, 0, Integer(@Pt));
    if iCharIndex < 0 then Exit;
    // Get line Index
    iLineIndex  := Perform(EM_EXLINEFROMCHAR, 0, iCharIndex);
    iCharOffset := iCharIndex - Perform(EM_LINEINDEX, iLineIndex, 0);
    if Lines.Count - 1 < iLineIndex then Exit;
    // store the current line in a variable
    s := Lines[iLineIndex];
    // get the first letter of the selected word
    i := iCharOffset + 1;
    SelStart := i;
    label1.Caption := SelAttributes.Name;
    label2.Caption := inttostr(SelAttributes.size);
    label3.Caption := inttostr(SelAttributes.Color);

    if SelAttributes.Style = [fsbold] then
    begin
      label4.Caption := 'Bold'
    end
    else
    begin
      label4.Caption := 'Not Bold'
    end;

    if SelAttributes.Style = [fsItalic] then
    begin
      label5.Caption := 'Italic'
    end
    else
    begin
      label5.Caption := 'Not fsItalic'
    end;

    if SelAttributes.Style = [fsUnderline] then
    begin
      label6.Caption := 'fsUnderline'
    end
    else
    begin
      label6.Caption := 'Not fsUnderline'
    end;
  end;
end;

If I comment out the functioncall WhatStyles, then my rich edit control works fine and I can move the insertion point all around the control. But for some strange reason, when I include the function then it seems to limit where I can move the insertion point to only the first couple of lines ???

I also think I am not using the selattributes.styles property properly as the output in the captions for bold, italic and underline is not consistent.

Does anyone have any ideas?

thanks

Myles :)
mylesevenAsked:
Who is Participating?
 
LRHGuyConnect With a Mentor Commented:
procedure TfrmHelpEditor.eFile1SelectionChange(Sender: TObject);
begin
with RichEditor  do
  begin
    label1.Caption := SelAttributes.Name;
    label2.Caption := inttostr(SelAttributes.size);
    label3.Caption := inttostr(SelAttributes.Color);

    if fsBold in SelAttributes.Style then
    begin
      label4.Caption := 'Bold'
    end
    else
    begin
      label4.Caption := 'Not Bold'
    end;

    if fsItalic in SelAttributes.Style then
    begin
      label5.Caption := 'Italic'
    end
    else
    begin
      label5.Caption := 'Not fsItalic'
    end;

    if fsUnderline in SelAttributes.Style then
    begin
      label6.Caption := 'fsUnderline'
    end
    else
    begin
      label6.Caption := 'Not fsUnderline'
    end;
  end;
end;
0
 
LRHGuyCommented:
You can fix the font styles like so:

if fsUnderline in SelAttributes.Style then
  label6.caption:='fsUnderline'
else
  ....

The Style property is a "set" of attributes, so:

if fsBold in SelAttributes then ..

is true if bold is in the set...
0
 
LRHGuyCommented:
The WhatStyles procedure is moving the cursor with the

SelStart:=

call, which is why you're having trouble.

If you move the whole routine to the OnSelectionChanged() event of the rich edit, I believe you'll have the correct results.
0
 
LRHGuyCommented:
Oh, in OnSelectionChange() event, you won't need anything from the SelStart line up in your WhatStyles routine. SelStart already has the cursor position if nothing is selected.
0
 
mylesevenAuthor Commented:
That was awesom thank LRHGuy, I leaned something today :)

Myles
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.