Set the character format in a TRichEdit to subscript or superscript

Problem/Question/Abstract:

I need to set the character format in a RichEdit control to subscript or superscipt. When I produce an RTF file including this formatting, the Delphi TRichEdit shows it correctly. But I cannot set the formatting by code. I tried to send a EM_SETCHARFORMAT message to the TRichEdit with dwEffects set to CFE_SUBSCRIPT but this doesn't have the desired effect.

Answer:

Solve 1:

You have to use a little API here since the TTextAttributes class used to implement DefAttributes does not surface this ability (since it was designed to be compatible to TFont). You should be able to set sub/ superscripts by sending an EM_SETCHARFORMAT message to a TRichedit. Something like this:

var
  format: TCharFormat; {defined in Unit RichEdit}

FillChar(format, sizeof(format), 0);
with format do
begin
  cbSize := Sizeof(format);
  dwMask := CFM_OFFSET;
  yOffset := 60; {superscript by 60 twips, negative values give subscripts}
end;
richedit1.Perform(EM_SETCHARFORMAT, SCF_SELECTION, LongInt(@format));

The message affects the current selection. If there is none it will affect new text inserted via seltext.

The problem with this is that the rich edit common control version 1 does not properly adjust the line spacing in lines containing super- or subscripted text. So if you don't reduce the font size as well, the text may be cut off at top or bottom. This version of the control also has no way to manually adjust the linespacing. There are wrappers for version 2 and 3 of the control around, e.g. the TRxrichEdit component in RXLib. These versions handle sub/superscripted text correctly but they require riched20.dll on the target system and it may not be present on all of them.


Solve 2:

Pressing the Up arrow sets to SuperScript, the down arrow to SubScript and the Left arrow back to normal.

procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  ref: TCharFormat;
begin
  FillChar(ref, sizeof(ref), 0);
  if ssAlt in Shift then
    case Key of
      VK_UP:
        begin
          with ref do
          begin
            cbSize := Sizeof(ref);
            dwMask := CFM_OFFSET;
            yOffset := 60;
          end;
        end;
      VK_DOWN:
        begin
          with ref do
          begin
            cbSize := Sizeof(ref);
            dwMask := CFM_OFFSET;
            yOffset := -60;
          end;
        end;
      VK_LEFT:
        begin
          with ref do
          begin
            cbSize := Sizeof(ref);
            dwMask := CFM_OFFSET;
            yOffset := 0;
          end;
        end;
    end;
  (Sender as TRichEdit).Perform(EM_SETCHARFORMAT, SCF_SELECTION, LongInt(@ref));
end;


Solve 3:

{ ... }
type
  TCharacterFormat = (CFM_Superscript, CFM_Subscript, CFM_Normal);

procedure RE_SetCharFormat(RichEdit: TRichEdit; CharacterFormat: TCharacterFormat);
var
  {The CHARFORMAT structure contains information about character formatting
  in a rich edit control}
  Format: TCharFormat;
begin
  FillChar(Format, SizeOf(Format), 0);
  with Format do
  begin
    cbSize := SizeOf(Format);
    dwMask := CFM_OFFSET;
    {Character offset, in twips, from the baseline. If the value of this member
                is positive, the character is a superscript; if it is negative, the
                character is a subscript}
    case CharacterFormat of
      CFM_Superscript: yOffset := 60;
      CFM_Subscript: yOffset := -60;
      CFM_Normal: yOffset := 0;
    end;
  end;
  {The EM_SETCHARFORMAT message sets character formatting in a rich edit control.
  SCF_SELECTION: Applies the formatting to the current selection}
  Richedit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));
end;

Examples:

{Apply Subscript to the current selection}

procedure TForm1.Button1Click(Sender: TObject);
begin
  RE_SetCharFormat(RichEdit1, CFM_Superscript);
end;

{Apply subscript to the current selection}

procedure TForm1.Button2Click(Sender: TObject);
begin
  RE_SetCharFormat(RichEdit1, CFM_Subscript);
end;