uses
  {...,} RichEdit;

procedure TForm1.Button1Click(Sender: TObject);
var
  cf: TCharFormat;
begin
  cf.cbSize := SizeOf(cf);
  cf.dwMask := CFM_OFFSET;
  // Смещение по y; положительное для смещения верх и отрицательное для смещения вниз
  cf.yOffset := 70;

  // При желании можно изменить высоту смещаемого текста
  // RichEdit1.SelAttributes.Size := 16;
  RichEdit1.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Integer(@cf));
end;

// SCF_ALL - применить ко всему тексту
// SCF_SELECTION - применить к веделенному тексту
// SCF_WORD or SCF_SELECTION - применить к выделенным словам

// Общий смысл можно передать так
// SendMessage(RichEdit1.Handle, EM_SETZOOM, 2, 1); {масштаб (2:1) 200%}
// SendMessage(RichEdit1.Handle, EM_SETZOOM, 1, 1); {масштаб (1:1) 100%}
// SendMessage(RichEdit1.Handle, EM_SETZOOM, 1, 2); {масштаб (1:2) 50%}
// SendMessage(RichEdit1.Handle, EM_SETZOOM, 1, 4); {масштаб (1:4) 25%}

// Пример
type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    procedure RichEdit1MouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure Button1Click(Sender: TObject);
  private
    function GetZoom: Integer;
    procedure SetZoom(const Value: Integer);
    property Zoom: Integer read GetZoom write SetZoom;
  {...}
  end;

const
  EM_GETZOOM = WM_USER + 224;
  EM_SETZOOM = WM_USER + 225;

var
  Form1: TForm1;
  Delta: Integer = 100;

implementation

function TForm1.GetZoom: Integer;
var
  wp, lp: Integer;
begin
  Result := 100;
  SendMessage(RichEdit1.Handle, EM_GETZOOM, Integer(@wp), Integer(@lp));
  if lp > 0 then
    Result := MulDiv(100, wp, lp);
end;

procedure TForm1.SetZoom(const Value: Integer);
begin
  if Value = 0 then
    SendMessage(Richedit1.Handle, EM_SETZOOM, 0, 0)
  else
    SendMessage(Richedit1.Handle, EM_SETZOOM, Value, 100);
end;

procedure TForm1.RichEdit1MouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  if (Delta + WheelDelta div 12) < 1 then
    Delta := 1
  else
    Delta := Delta + WheelDelta div 12;
  Zoom := Delta;
end;

unit re_bmp;

interface

uses
  Windows;

  procedure InsertBitmapToRE(Wnd: HWND; Bmp: HBITMAP);

implementation

uses
  Activex, RichEdit;

const
  IID_IDataObject: TGUID = (
    D1: $0000010E; D2: $0000; D3: $0000; D4: ($C0, $00, $00, $00, $00, $00, $00, $46));
  IID_IOleObject: TGUID = (
    D1: $00000112; D2: $0000; D3: $0000; D4: ($C0, $00, $00, $00, $00, $00, $00, $46));

  REO_CP_SELECTION = ULONG(-1);
  REO_IOB_SELECTION = ULONG(-1);
  REO_GETOBJ_POLEOBJ = $00000001;

type
  TReobject = record
    cbStruct: DWORD;
    cp: ULONG;
    clsid: TCLSID;
    poleobj: IOleObject;
    pstg: IStorage;
    polesite: IOleClientSite;
    sizel: TSize;
    dvAspect: LongInt;
    dwFlags: DWORD;
    dwUser: DWORD;
  end;

type
  IRichEditOle = interface( IUnknown )
    ['{00020d00-0000-0000-c000-000000000046}']
    function GetClientSite(out clientSite: IOleClientSite): HResult; stdcall;
    function GetObjectCount: HResult; stdcall;
    function GetLinkCount: HResult; stdcall;
    function GetObject(iob: Longint; out reobject: TReObject;
      dwFlags: DWORD): HResult; stdcall;
    function InsertObject(var reobject: TReObject): HResult; stdcall;
    function ConvertObject(iob: LongInt; rclsidNew: TIID;
      lpstrUserTypeNew: LPCSTR): HResult; stdcall;
    function ActivateAs(rclsid: TIID; rclsidAs: TIID): HResult; stdcall;
    function SetHostNames(lpstrContainerApp: LPCSTR;
      lpstrContainerObj: LPCSTR): HResult; stdcall;
    function SetLinkAvailable(iob: LongInt; fAvailable: BOOL): HResult; stdcall;
    function SetDvaspect(iob: LongInt; dvaspect: DWORD): HResult; stdcall;
    function HandsOffStorage(iob: LongInt): HResult; stdcall;
    function SaveCompleted(iob: LongInt; const stg: IStorage): HResult; stdcall;
    function InPlaceDeactivate: HResult; stdcall;
    function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
    function GetClipboardData(var chrg: TCharRange; reco: DWORD;
      out dataobj: IDataObject): HResult; stdcall;
    function ImportDataObject(dataobj: IDataObject; cf: TClipFormat;
      hMetaPict: HGLOBAL): HResult; stdcall;
  end;

  TImageDataObject = class(TInterfacedObject, IDataObject)
  private
    FBmp: HBITMAP;
    FMedium: TStgMedium;
    FFormatEtc: TFormatEtc;
    procedure SetBitmap(Bmp: HBITMAP);
    function GetOleObject(OleClientSite: IOleClientSite; Storage: IStorage): IOleObject;
    destructor Destroy; override;

    // IDataObject
    function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult; stdcall;
    function GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium): HResult; stdcall;
    function QueryGetData(const formatetc: TFormatEtc): HResult; stdcall;
    function GetCanonicalFormatEtc(const formatetc: TFormatEtc;
      out formatetcOut: TFormatEtc): HResult; stdcall;
    function SetData(const formatetc: TFormatEtc; var medium: TStgMedium;
      fRelease: BOOL): HResult; stdcall;
    function EnumFormatEtc(dwDirection: LongInt; out enumFormatEtc:
      IEnumFormatEtc): HResult; stdcall;
    function DAdvise(const formatetc: TFormatEtc; advf: LongInt;
      const advSink: IAdviseSink; out dwConnection: LongInt): HResult; stdcall;
    function DUnadvise(dwConnection: LongInt): HResult; stdcall;
    function EnumDAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;
  public
    procedure InsertBitmap(Wnd: HWND; Bitmap: HBITMAP);
  end;

{ TImageDataObject }

function TImageDataObject.DAdvise(const formatetc: TFormatEtc; advf: Integer;
  const advSink: IAdviseSink; out dwConnection: Integer): HResult;
begin
  Result := E_NOTIMPL;
end;

function TImageDataObject.DUnadvise(dwConnection: Integer): HResult;
begin
  Result := E_NOTIMPL;
end;

function TImageDataObject.EnumDAdvise(out enumAdvise: IEnumStatData): HResult;
begin
  Result := E_NOTIMPL;
end;

function TImageDataObject.EnumFormatEtc(dwDirection: Integer;
  out enumFormatEtc: IEnumFormatEtc): HResult;
begin
  Result := E_NOTIMPL;
end;

function TImageDataObject.GetCanonicalFormatEtc(const formatetc: TFormatEtc;
  out formatetcOut: TFormatEtc): HResult;
begin
  Result := E_NOTIMPL;
end;

function TImageDataObject.GetDataHere(const formatetc: TFormatEtc;
  out medium: TStgMedium): HResult;
begin
  Result := E_NOTIMPL;
end;

function TImageDataObject.QueryGetData(const formatetc: TFormatEtc): HResult;
begin
  Result := E_NOTIMPL;
end;

destructor TImageDataObject.Destroy;
begin
  ReleaseStgMedium(FMedium);
end;

function TImageDataObject.GetData(const formatetcIn: TFormatEtc;
  out medium: TStgMedium): HResult;
begin
  medium.tymed := TYMED_GDI;
  medium.hBitmap := FMedium.hBitmap;
  medium.unkForRelease := nil;
  Result := S_OK;
end;

function TImageDataObject.SetData(const formatetc: TFormatEtc;
  var medium: TStgMedium; fRelease: BOOL): HResult;
begin
  FFormatEtc := formatetc;
  FMedium := medium;
  Result:= S_OK;
end;

procedure TImageDataObject.SetBitmap(Bmp: HBITMAP);
var
 stgm: TStgMedium;
 fm:TFormatEtc;
begin
  stgm.tymed := TYMED_GDI;
  stgm.hBitmap := bmp;
  stgm.UnkForRelease := nil;

  fm.cfFormat := CF_BITMAP;
  fm.ptd := nil;
  fm.dwAspect := DVASPECT_CONTENT;
  fm.lindex := -1;
  fm.tymed := TYMED_GDI;
  SetData(fm, stgm, False);
end;

function TImageDataObject.GetOleObject(OleClientSite: IOleClientSite;
  Storage: IStorage): IOleObject;
begin
  if Fmedium.hBitmap = 0 then
    Result := nil
  else
    OleCreateStaticFromData(Self, IID_IOleObject, OLERENDER_FORMAT,
                            @FFormatEtc, OleClientSite, Storage, Result);
end;

procedure TImageDataObject.InsertBitmap(Wnd:HWND; Bitmap: HBITMAP);
var
  OleClientSite: IOleClientSite;
  RichEditOLE: IRichEditOLE;
  Storage: IStorage;
  LockBytes: ILockBytes;
  OleObject: IOleObject;
  reobject: TReobject;
  clsid: TGUID;
begin
  if SendMessage(Wnd, EM_GETOLEINTERFACE, 0, Cardinal(@RichEditOle)) = 0 then
    Exit;

  FBmp := CopyImage(Bitmap, IMAGE_BITMAP, 0, 0, 0);
  if  FBmp = 0 then
    Exit;

  try
    SetBitmap(Fbmp);

    RichEditOle.GetClientSite(OleClientSite);
    if OleClientSite = nil then
        Exit;

    CreateILockBytesOnHGlobal(0, True, LockBytes);
    if LockBytes = nil then
      Exit;

    if StgCreateDocfileOnILockBytes(LockBytes, STGM_SHARE_EXCLUSIVE or STGM_CREATE
                                    or STGM_READWRITE, 0, Storage) <> S_OK then
    begin
      LockBytes._Release;
      Exit;
    end;

    if Storage = nil then
      Exit;

    OleObject := GetOleObject(OleClientSite, Storage);
    if OleObject = nil then
      Exit;

    OleSetContainedObject(OleObject, True);

    ZeroMemory(@reobject, SizeOf(TReobject));
    reobject.cbStruct := SizeOf(TReobject);
    OleObject.GetUserClassID(clsid);
    reobject.clsid := clsid;
    reobject.cp := REO_CP_SELECTION;
    reobject.dvaspect := DVASPECT_CONTENT;
    reobject.poleobj := OleObject;
    reobject.polesite := OleClientSite;
    reobject.pstg := Storage;

    RichEditOle.InsertObject(reobject);
  finally
    DeleteObject(FBmp);
  end;
end;

procedure InsertBitmapToRE(Wnd: HWND; bmp: HBITMAP);
begin
  with TImageDataObject.Create do
  try
    InsertBitmap(Wnd, Bmp);
  finally
    Free;
  end;
end;

end.

// Варианты использования
uses
  {...,} re_bmp;

// Вставка из TImage
procedure TForm1.Button1Click(Sender: TObject);
begin
  InsertBitmapToRE(RichEdit1.Handle, Image1.Picture.Bitmap.Handle);
end;

// Вставка из файла
procedure TForm1.Button2Click(Sender: TObject);
var
  bmp: TBitmap;
begin
  if not OpenPictureDialog1.Execute then
    Exit;

  bmp := TBitmap.Create;
  try
    bmp.LoadFromFile(OpenPictureDialog1.Filename);
    InsertBitmapToRE(RichEdit1.Handle, bmp.Handle);
  finally
    bmp.Free;
  end;
end;

// Вставка из ресурса
procedure TForm1.Button3Click(Sender: TObject);
var
  bmp: TBitmap;
  ResStream: TResourceStream;
begin
  bmp := TBitmap.Create;

  try
    ResStream := TResourceStream.CreateFromID(HInstance, 1, RT_RCDATA);
    bmp.LoadFromStream(ResStream);
    InsertBitmapToRE(RichEdit1.Handle, bmp.Handle);
  finally
    ResStream.Free;
    bmp.Free;
  end;
end;

uses
  {...,} RichEdit;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RichEdit1.Perform(EM_SETBKGNDCOLOR, 0, clRed);
end;

uses
  {...,} RichEdit, ShellAPI;

  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    procedure FormCreate(Sender: TObject);
  protected
    procedure WndProc(var Message: TMessage); override;
  end;

implementation

procedure TForm1.FormCreate(Sender: TObject);
var
  Mask: Word;
begin
  Mask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0);
  SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, Mask or ENM_LINK);
  SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, Integer(True), 0);
  RichEdit1.Text := 'decoding.dax.ru: '#13#10 +
                    ' Site is located at www.decoding.dax.ru';
end;

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;

uses
  {...,} RichEdit;

procedure TForm1.Button1Click(Sender: TObject);
var
  fr: TFormatRange;
  r: TRect;
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.create;
  r := Rect(0, 0, RichEdit1.Width * Screen.Pixelsperinch, RichEdit1.Height * Screen.Pixelsperinch);
  fr.hdc := Bitmap.Canvas.Handle;
  fr.hdcTarget := Bitmap.Canvas.Handle;
  fr.rc := r;
  fr.rcPage := r;
  fr.chrg.cpMin := 0;
  fr.chrg.cpMax := -1;
  Sendmessage(RichEdit1.Handle, EM_FORMATRANGE, 1, Longint(@fr));
  Richedit1.Height := Trunc( Screen.PixelsPerInch * fr.rc.Bottom / 1440 ) + 8;
  Sendmessage(RichEdit1.Handle, WM_VSCROLL, SB_TOP, 0);
  Bitmap.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: LongInt;
  x, y: LongInt;
begin
  with RichEdit1 do
  begin
    x := SelStart;
    y := SelLength;
    i := SendMessage(Handle, EM_LINEFROMCHAR, -1, 0);
    Lines.Delete(i);
    SelStart := x;
    Sellength := y;
    SetFocus;
  end;
end;

uses
  {...,} RichEdit;

procedure TForm1.Button1Click(Sender: TObject);
var
  Row, Col: Integer;
begin
  Row := SendMessage(Richedit1.Handle, EM_EXLINEFROMCHAR, 0, RichEdit1.SelStart + RichEdit1.SelLength);
  Col := RichEdit1.SelStart + RichEdit1.SelLength - SendMessage(Richedit1.Handle, EM_LINEINDEX, -1, 0);
  Caption := IntToStr(Row+1)+ ' ' + IntToStr(Col+1);
end;

uses
  {...,} SHDocVw, OleCtrls;

procedure TForm1.Button1Click(Sender: TObject);
var
  sl: TStringList;
  wb: TWebbrowser;
begin
  sl := TStringList.Create;
  wb := TWebbrowser.Create(Self);
  try
    // TWinControl(wb).Parent := Form1;
    wb.Navigate('about:blank');
    // Обязательно дожидаемся окончания загрузки
    while wb.ReadyState < READYSTATE_INTERACTIVE do
      Application.ProcessMessages;

    if RichEdit1.SelLength = 0 then
      RichEdit1.SelectAll;
    RichEdit1.CopyToClipboard;
    RichEdit1.SelLength := 0;

    wb.OleObject.document.selection.createRange.execCommand('Paste');
    sl.Add(wb.OleObject.document.body.innerHTML);
    sl.SaveToFile('c:\test.html');
  finally
    sl.Free;
    wb.Free;
  end;
end;

// Код RichEdit1.Lines.LoadFromFile( 'document.rtf' ) может некорректно загрузить документ в случае,
// если изначально (в самом DFM) параметр Lines компонента RichEdit очищен. В этом случае текст в
// RichEdit1будет отображаться как PlainText, даже если это свойство у RichEdit не установлено.
// Решить эту проблему модно следующим образом:

procedure TForm1.Button1Click(Sender: TObject);

  function RichEditStreamCallBack(Cookie: TMemoryStream; pbBuff: PByte;
    cb: Longint; var pcb: Longint): LongInt; stdcall;
  begin
    Result := 0;
    try
      pcb := Cookie.Read(pbBuff^, cb);
    except
      Result := 1;
    end;
  end;

var
  M: TMemoryStream;
  Param: TEditStream;
begin
  M := TMemoryStream.Create;
  try
    M.LoadFromFile('updates.rtf');
    {$IFDEF WIN64}
    Param.dwCookie := DWORD_PTR(M);
    {$ELSE}
    Param.dwCookie := LongInt(M); // LongInt для совместимости со старыми версиями Delphi
    {$ENDIF}
    Param.dwError := 0;
    Param.pfnCallback := @RichEditStreamCallBack;
    SendMessage(RichEdit1.Handle, EM_STREAMIN, SF_RTF, LPARAM(@Param));
  finally
    M.Free;
  end;
end;