BeforePasteText, remove formatting, set font name & size

Can you please give an example of using the BeforePasteText event to:

• remove all character formatting except Bold, Italic, Underline
• force the font of all of the pasted text to a specific face and size

Thanks!

Hi,

this event handler does all this. It buffers the CharAttr to save time.

procedure TForm.WPRichText1BeforePasteText(Sender: TObject;
  RTFData: TWPRTFDataCollection; par: TParagraph; Stream: TStream;
  Reader: TWPCustomTextReader; OnlyBodyText: Boolean;
  var LoadedText: TWPRTFDataBlock);
var i, a, b: Integer;
    ca  : TWPCharAttr;
    atr : TWPStoredCharAttrInterface;
begin

  atr := TWPStoredCharAttrInterface.Create(RTFData);
  a := -1;
  try

  while par <> nil do
  begin
    // Clear Paragraph attributes if required
    par.AClear;
    // Clear Characterattributes except for bold, italic and underline
    for i := 0 to par.CharCount - 1 do
    begin
      b := par.CharAttr[i] and cafsNONE;
      if b<>a then
      begin
        // Set the attributes
        atr.Clear;
        atr.SetFontName('Courier New');
        atr.SetFontSize(10.5);
        atr.SetColor(clBlue);

        // Merge in Bold, Italic, Underline
        RTFData.RTFProps.Attributes.GetCharAttr(b, ca);
        if (ca.MaskHash and BitMask[WPAT_CharStyleOn])<>0 then
        atr.SetCharStyles(
           ca.Values[WPAT_CharStyleMask] and (WPSTY_BOLD  + WPSTY_ITALIC + WPSTY_UNDERLINE),
           ca.Values[WPAT_CharStyleOn] and (WPSTY_BOLD  + WPSTY_ITALIC + WPSTY_UNDERLINE),
          );
        a := b;
      end;
      // Apply Attribute
      par.CharAttr[i] := atr.CharAttr;
    end;
    par := par.next;
  end;

  finally
    atr.Free;
  end;
end;

Another example:

This code will delete all attributes, links, bookmarks, images and objects

procedure TForm1.WPRichText1BeforePasteText(Sender: TObject;
  RTFData: TWPRTFDataCollection; par: TParagraph; Stream: TStream;
  Reader: TWPCustomTextReader; OnlyBodyText: Boolean;
  var LoadedText: TWPRTFDataBlock);
var i : Integer;
begin
  while par<>nil do
  begin
     i := par.CharCount-1;
     while i>=0 do
     begin
       if par.ObjectRef[i]<>nil then
          par.DeleteChar(i);
       dec(i);
     end;
     par.ClearCharAttr(true);
     par := par.next;
  end;
end;