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;