vbAccelerator - Contents of code file: VBRichEdit.ctl

VERSION 5.00
Begin VB.UserControl vbalRichEdit 
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ControlContainer=   -1  'True
   ForwardFocus    =   -1  'True
   ScaleHeight     =   3600
   ScaleWidth      =   4800
   ToolboxBitmap   =   "VBRichEdit.ctx":0000
   Begin VB.Label lblText 
      Caption         =   "vbAccelerator Rich Edit Control"
      Height          =   255
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   4875
   End
End
Attribute VB_Name = "vbalRichEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' ======================================================================
' Visit vbAccelerator at http://vbaccelerator.com/
' - the VB Programmer's Resource
' ======================================================================

' ======================================================================
' vbalRichEdit
' Copyright  1998 Steve McMahon (steve@vbaccelerator.com)
' 14 June 1998
'
' An lightweight RichEdit control all in VB with lots of great features
' Requires:
'  mRichEdit.Bas
'  mWinGeneral.Bas
'  SSUBTMR.DLL
' ======================================================================

' ======================================================================
' Enums:
' ======================================================================
Public Enum ERECControlVersion
    eRICHED32
    eRICHED20
End Enum
Public Enum ERECFileTypes
    SF_TEXT = &H1
    SF_RTF = &H2
End Enum
Public Enum ERECSetFormatRange
   ercSetFormatAll = SCF_ALL
   ercSetFormatSelection = SCF_SELECTION
   ercSetFormatWord = SCF_WORD Or SCF_SELECTION
End Enum
Public Enum ERECTextTypes
   ercTextNormal
   ercTextSuperscript
   ercTextSubscript
End Enum
Public Enum ERECViewModes
   ercDefault = 0
   ercWordWrap = 1
   ercWYSIWYG = 2
End Enum
' /*  UndoName info */
Public Enum ERECUndoTypeConstants
    ercUID_UNKNOWN = 0
    ercUID_TYPING = 1
    ercUID_DELETE = 2
    ercUID_DRAGDROP = 3
    ercUID_CUT = 4
    ercUID_PASTE = 5
End Enum
Public Enum ERECSelectionTypeConstants
   SEL_EMPTY = &H0
   SEL_TEXT = &H1
   SEL_OBJECT = &H2
   SEL_MULTICHAR = &H4
   SEL_MULTIOBJECT = &H8
End Enum
Public Enum ERECFindTypeOptions
   FR_DEFAULT = &H0
   FR_DOWN = &H1
   FR_WHOLEWORD = &H2
   FR_MATCHCASE = &H4&
End Enum
Public Enum ERECOptionTypeConstants
' /* Edit control options */
   ECO_AUTOWORDSELECTION = &H1&
   ECO_AUTOVSCROLL = &H40&
   ECO_AUTOHSCROLL = &H80&
   ECO_NOHIDESEL = &H100&
   ECO_READONLY = &H800&
   ECO_WANTRETURN = &H1000&
   ECO_SAVESEL = &H8000&
   ECO_SELECTIONBAR = &H1000000
   ECO_VERTICAL = &H400000                  ' /* FE specific */
End Enum

Public Enum ERECInbuiltShortcutConstants
   [_First] = 1
   ' Inbuilt methods
   ercCut_CtrlX = 1
   ercCopy_CtrlC = 2
   ercPaste_CtrlV = 3
   ercUndo_CtrlZ = 4
   ercSelectAll_CtrlA = 5
   
   ' Supplied methods:
   ercBold_CtrlB = 6
   ercItalic_CtrlI = 7
   ercUnderline_CtrlU = 8
   ercPrint_CtrlP = 9
   ercRedo_CtrlY = 10
   
   ercSuperscript_CtrlPlus = 11
   ercSubscript_CtrlMinus = 12
   
   ercNew_CtrlN = 13
   [_Last] = 13
End Enum

Public Enum ERECProgressTypeConstants
   ercNone = 0
   ercLoad = 1
   ercSave = 2
   ercPrint = 3
End Enum

Public Enum ERECParagraphNumberingConstants
   ercParaNone = 0
   ercParaBullet = PFN_BULLET
   ercParaArabicNumbers_NS = 2
   ercParaLowerCaseLetters_NS = 3
   ercParaUpperCaseLetters_NS = 4
   ercParaLowerCaseRoman_NS = 5
   ercParaUpperCaseRoman_NS = 6
   ercParaCustomNumber_NS = 7
End Enum

Public Enum ERECParagraphAlignmentConstants
   ercParaLeft = PFA_LEFT
   ercParaCentre = PFA_CENTER
   ercParaRight = PFA_RIGHT
   ercParaJustify = PFA_JUSTIFY
End Enum

Public Enum ERECTabAlignmentConstants
   ercTabOrdinary = 0
   ercTabCentre_NS = 1
   ercTabRight_NS = 2
   ercTabDecimal_NS = 3
   ercTabWordBarTab_NS = 4
End Enum

Public Enum ERECTabLeaderConstants
   ercTabNoLeader = 0
   ercTabDottedLeader_NS = 1
   ercTabDashedLeader_NS = 2
   ercTabUnderlinedLeader_NS = 3
   ercTabThickLineLeader_NS = 4
   ercTabDoubleLineLeader_NS = 5
End Enum

Public Enum ERECParagraphLineSpacingConstants
   ercLineSpacingSingle = 0
   ercLineSpacingOneAndAHalf = 1
   ercLineSpacingDouble = 2
   ercLineSpacingTwips = 3
   ercLineSpacingTwipsAnyMinimum = 4
   ercLineSpacingTwentiethLine = 5
End Enum

Public Enum ERECLinkEventTypeCOnstants
   ercLButtonDblClick = WM_LBUTTONDBLCLK
   ercLButtonDown = WM_LBUTTONDOWN
   ercLButtonUp = WM_LBUTTONUP
   ercMouseMove = WM_MOUSEMOVE
   ercRButtonDblClick = WM_RBUTTONDBLCLK
   ercRButtonDown = WM_RBUTTONDOWN
   ercRBUttonUp = WM_RBUTTONUP
   ercSetCursor = WM_SETCURSOR
End Enum

' ======================================================================
' Internal Control Variables:
' ======================================================================
Private m_hWnd As Long
Private m_hWndParent As Long
Private m_hWndForm  As Long
Private m_bRunTime As Boolean
Private m_bSubClassing As Boolean
Private m_hLib As Long
Private m_eVersion As ERECControlVersion
Private m_eViewMode As ERECViewModes
Private m_bRedraw As Boolean
Private m_sText As String
Private m_bAllowMethod(ERECInbuiltShortcutConstants.[_First] To
 ERECInbuiltShortcutConstants.[_Last]) As Boolean
Private m_sFileName As String
Private m_eProgressType As ERECProgressTypeConstants
Private m_sLastFindText As String
Private m_eLastFindMode As ERECFindTypeOptions
Private m_bLastFindNext As Boolean
Private m_eCharFormatRange As ERECSetFormatRange
Private m_bBorder As Boolean
Private m_lLeftMargin As Long
Private m_lRightMargin As Long
Private m_lTopMargin As Long
Private m_lBottomMargin As Long
Private m_lLeftMarginPixels As Long
Private m_lRightMarginPixels As Long
Private m_lLimit As Long
Private m_bTrapTab As Boolean
Private m_bAutoURLDetect As Boolean
Private m_bReadOnly As Boolean
Private m_bTransparent As Boolean
' Over-riding VB UserControl's default IOLEInPlaceActivate:
Private m_IPAOHookStruct As IPAOHookStruct
' Tiling images
Private m_cTile As cTile

' ======================================================================
' Events:
' ======================================================================
Public Event SelectionChange(ByVal lMin As Long, ByVal lMax As Long, ByVal
 eSelType As ERECSelectionTypeConstants)
Public Event LinkOver(ByVal iType As ERECLinkEventTypeCOnstants, ByVal lMin As
 Long, ByVal lMax As Long)
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyPress(KeyAscii As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Public Event DblClick(x As Single, y As Single)
Public Event MouseDown(x As Single, y As Single, Shift As Integer)
Public Event MouseMove(x As Single, y As Single, Shift As Integer)
Public Event MouseUp(x As Single, y As Single, Shift As Integer)
Public Event ProgressStatus(ByVal lAmount As Long, ByVal lTotal As Long)
Public Event ModifyProtected(ByRef bDoIt As Boolean, ByVal lMin As Long, ByVal
 lMax As Long)
Public Event VScroll()
Public Event HScroll()

' ======================================================================
' Subclassing:
' ======================================================================
Implements ISubclass
Private m_emr As EMsgResponse

Public Property Set Picture(ByRef sPic As IPicture)
   If m_hWnd = 0 Then
      Set UserControl.Picture = sPic
   Else
      m_cTile.Picture = sPic
   End If
   PropertyChanged "Picture"
End Property
Public Property Get Picture() As IPicture
   Set Picture = UserControl.Picture
End Property

Public Property Get Transparent() As Boolean
   Transparent = m_bTransparent
End Property
Public Property Let Transparent(ByVal bState As Boolean)
Dim lS As Long
   m_bTransparent = bState
   If m_hWnd <> 0 Then
      lS = GetWindowLong(m_hWnd, GWL_EXSTYLE)
      If bState Then
         lS = lS Or WS_EX_TRANSPARENT
      Else
         lS = lS And Not WS_EX_TRANSPARENT
      End If
      SetWindowLong m_hWnd, GWL_EXSTYLE, lS
      pStyleChanged
   End If
   PropertyChanged "Transparent"
End Property
Private Sub pStyleChanged(Optional ByVal hwnd As Long = 0)
   If hwnd = 0 Then hwnd = m_hWnd
   SetWindowPos m_hWnd, 0, 0, 0, 0, 0, SWP_FRAMECHANGED Or SWP_NOMOVE Or
    SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_NOACTIVATE
End Sub

Friend Function TranslateAccelerator(lpMsg As VBOleGuids.msg) As Long
    
   TranslateAccelerator = S_FALSE
   If m_hWnd <> 0 Then
      ' Here you can modify the response to the key down
      ' accelerator command using the values in lpMsg.  This
      ' can be used to capture Tabs, Returns, Arrows etc.
      ' Just process the message as required and return S_OK.
      If lpMsg.message = WM_KEYDOWN Or lpMsg.message = WM_CHAR Or lpMsg.message
       = WM_KEYUP Then
         Select Case lpMsg.wParam And &HFFFF&
         Case vbKeyUp, vbKeyDown, vbKeyLeft, vbKeyRight, vbKeyPageDown,
          vbKeyPageUp, vbKeyHome, vbKeyEnd, vbKeyReturn
            SendMessageLong m_hWnd, lpMsg.message, lpMsg.wParam, lpMsg.lParam
            TranslateAccelerator = S_OK
         Case vbKeyTab
            If Not ReadOnly Then
               If m_bTrapTab Then
                  ' Allow shift-tab to move out of control:
                  If GetAsyncKeyState(vbKeyShift) = 0 Then
                     ' Default handling of tab:
                     If lpMsg.message = WM_KEYDOWN Then
                        SendMessageLong m_hWnd, WM_CHAR, lpMsg.wParam,
                         lpMsg.lParam
                     End If
                     TranslateAccelerator = S_OK
                  End If
               End If
            End If
         End Select
      End If
   End If
   
End Function

Public Property Get TrapTab() As Boolean
   TrapTab = m_bTrapTab
End Property
Public Property Let TrapTab(ByVal bState As Boolean)
   m_bTrapTab = bState
   PropertyChanged "TrapTab"
End Property

Public Property Get TextLimit() As Long
   TextLimit = m_lLimit
End Property
Public Property Let TextLimit(ByVal lLimit As Long)
Dim lR As Long
   m_lLimit = lLimit
   If m_hWnd <> 0 Then
      lR = SendMessageLong(m_hWnd, EM_EXLIMITTEXT, 0, lLimit)
   End If
   PropertyChanged "TextLimit"
End Property

Public Property Get MaxLength() As Long
   If (m_hWnd <> 0) Then
      MaxLength = SendMessageLong(m_hWnd, EM_GETLIMITTEXT, 0, 0)
   End If
End Property
Public Property Let MaxLength(ByVal lMax As Long)
   If (m_hWnd <> 0) Then
      SendMessageLong m_hWnd, EM_EXLIMITTEXT, 0, lMax
   End If
End Property

Public Property Get Border() As Boolean
   Border = m_bBorder
End Property
Public Property Let Border(ByVal bState As Boolean)
Dim dwStyle As Long
Dim dwExStyle As Long

   m_bBorder = bState
   If m_hWnd <> 0 Then
      ' Make sure that the RichEdit never has a border:
      dwStyle = GetWindowLong(m_hWnd, GWL_STYLE)
      dwExStyle = GetWindowLong(m_hWnd, GWL_EXSTYLE)
      dwStyle = dwStyle And Not ES_SUNKEN
      dwExStyle = dwExStyle And Not WS_EX_CLIENTEDGE
      SetWindowLong m_hWnd, GWL_STYLE, dwStyle
      SetWindowLong m_hWnd, GWL_EXSTYLE, dwExStyle
      pStyleChanged
   End If
   UserControl.BorderStyle() = Abs(bState)
   
End Property

Public Property Get ProgressType() As ERECProgressTypeConstants
   ProgressType = m_eProgressType
End Property

Public Function FindText( _
      ByVal sText As String, _
      Optional ByVal eOptions As ERECFindTypeOptions = FR_DEFAULT, _
      Optional ByVal bFindNext As Boolean = True, _
      Optional ByVal bFIndInSelection As Boolean = False, _
      Optional ByRef lMin As Long, _
      Optional ByRef lMax As Long _
   ) As Long
Dim tEx1 As FINDTEXTEX_A
'Dim tEx2 As FINDTEXTEX_W
Dim tCR As CHARRANGE
Dim lR As Long
Dim lJunk As Long
Dim b() As Byte

   m_sLastFindText = sText
   m_eLastFindMode = eOptions
   m_bLastFindNext = bFindNext
   
   lMin = -1: lMax = -1
   If (bFIndInSelection) Then
      GetSelection tCR.cpMax, tCR.cpMax
   Else
      If (bFindNext) Then
         GetSelection tCR.cpMin, lJunk
         If (lJunk >= tCR.cpMin) Then
            tCR.cpMin = lJunk + 1
         End If
         tCR.cpMax = -1
      Else
         tCR.cpMin = 0
         tCR.cpMax = -1
      End If
   End If
   
   b = StrConv(sText, vbFromUnicode)
   ' VB won't do the terminating null for you!
   ReDim Preserve b(0 To UBound(b) + 1) As Byte
   b(UBound(b)) = 0
   tEx1.lpstrText = VarPtr(b(0))
   LSet tEx1.chrg = tCR
   
   lR = SendMessage(m_hWnd, EM_FINDTEXTEX, eOptions, tEx1)
   
   LSet tCR = tEx1.chrgText
   If (lR <> -1) Then
      lMax = tCR.cpMax
      lMin = lMax - Len(sText)
   End If
   FindText = lR
   
End Function
Public Property Get LastFindText() As String
   LastFindText = m_sLastFindText
End Property
Public Property Get LastFindMode() As ERECFindTypeOptions
   LastFindMode = m_eLastFindMode
End Property
Public Property Get LastFindNext() As Boolean
   LastFindNext = m_bLastFindNext
End Property

Public Property Get Font() As StdFont
   If (m_eCharFormatRange = ercSetFormatAll) Or (m_hWnd = 0) Then
      Set Font = UserControl.Font
   Else
      Dim sFnt As New StdFont
      Set Font = GetFont(True)
   End If
End Property
Public Property Set Font(ByRef sFnt As StdFont)
   With UserControl.Font
      .Name = sFnt.Name
      .Size = sFnt.Size
      .Bold = sFnt.Bold
      .Italic = sFnt.Italic
      .Underline = sFnt.Underline
      .Strikethrough = sFnt.Strikethrough
      .Charset = sFnt.Charset
   End With
   If (m_hWnd <> 0) Then
      SetFont sFnt, , , , m_eCharFormatRange
   End If
   PropertyChanged "Font"
End Property
Public Property Get BackColor() As OLE_COLOR
   BackColor = UserControl.BackColor
End Property
Public Property Let BackColor(ByVal oColor As OLE_COLOR)
   UserControl.BackColor = oColor
   lblText.BackColor = oColor
   If (m_hWnd <> 0) Then
      SendMessageLong m_hWnd, EM_SETBKGNDCOLOR, 0, TranslateColor(oColor)
   End If
   PropertyChanged "BackColor"
End Property
Public Property Get ForeColor() As OLE_COLOR
   ForeColor = UserControl.ForeColor
End Property
Public Property Let ForeColor(ByVal oColor As OLE_COLOR)
   UserControl.ForeColor = oColor
   If (m_hWnd <> 0) Then
      SetFont UserControl.Font, TranslateColor(oColor), , , ercSetFormatAll
   End If
   PropertyChanged "ForeColor"
End Property
Public Property Get Text() As String
   If (m_hWnd = 0) Then
      Text = m_sText
      If (m_sText = "") Then
         'blText.Caption = "vbAccelerator Rich Edit Control"
      Else
         lblText.Caption = m_sText
      End If
   Else
      Text = Contents(SF_TEXT)
   End If
End Property
Public Property Let Text(ByRef sText As String)
   If (m_hWnd = 0) Then
      m_sText = sText
   Else
      Contents(SF_TEXT) = sText
   End If
End Property
Public Property Get Modified() As Boolean
   If (m_hWnd <> 0) Then
      Modified = (SendMessageLong(m_hWnd, EM_GETMODIFY, 0, 0) <> 0)
   End If
End Property
Public Property Let Modified(ByVal bModified As Boolean)
   If (m_hWnd <> 0) Then
      SendMessageLong m_hWnd, EM_SETMODIFY, Abs(bModified), 0
   End If
End Property

Public Property Get RichEditOption( _
      ByVal eOption As ERECOptionTypeConstants _
   ) As Boolean
Dim lR As Long
   lR = SendMessageLong(m_hWnd, EM_GETOPTIONS, 0, 0)
   RichEditOption = ((lR And eOption) = eOption)
End Property
Public Property Let RichEditOption( _
      ByVal eOption As ERECOptionTypeConstants, _
      ByVal bState As Boolean _
   )
Dim lOptions As Long
Dim lR As Long
   lOptions = SendMessageLong(m_hWnd, EM_GETOPTIONS, 0, 0)
   If (bState) Then
      lOptions = lOptions Or eOption
   Else
      lOptions = lOptions And Not eOption
   End If
   lR = SendMessageLong(m_hWnd, EM_SETOPTIONS, 0, lOptions)
End Property

Public Property Get LineForCharacterIndex(ByVal lIndex As Long) As Long
   LineForCharacterIndex = (SendMessageLong(m_hWnd, EM_EXLINEFROMCHAR, 0,
    lIndex))
End Property

Private Function Unsupported(Optional ByVal iType As Integer = 0)
   If (iType = 0) Then
      'Debug.Assert "Function not supported in eRICHED32 mode, use RICHED20" =
       ""
   ElseIf (iType = 1) Then
      Debug.Assert "Property is read-only at run-time" = ""
   End If
End Function

Public Property Get SelectedText() As String
Dim sBuff As String
Dim lStart As Long
Dim lEnd As Long
Dim lR As Long

   GetSelection lStart, lEnd
   If (lEnd > lStart) Then
      sBuff = String$(lEnd - lStart + 1, 0)
      lR = SendMessageStr(m_hWnd, EM_GETSELTEXT, 0, sBuff)
      If (lR > 0) Then
         SelectedText = Left$(sBuff, lR)
      End If
   End If
End Property

Public Property Get TextInRange(ByVal lStart As Long, ByVal lEnd As Long)
Dim tR As TEXTRANGE
Dim lR As Long
Dim sText As String
Dim b() As Byte
      
   tR.chrg.cpMin = lStart
   tR.chrg.cpMax = lEnd
   
   sText = String$(lEnd - lStart + 1, 0)
   b = StrConv(sText, vbFromUnicode)
   ' VB won't do the terminating null for you!
   ReDim Preserve b(0 To UBound(b) + 1) As Byte
   b(UBound(b)) = 0
   tR.lpstrText = VarPtr(b(0))

   lR = SendMessage(m_hWnd, EM_GETTEXTRANGE, 0, tR)
   If (lR > 0) Then
      sText = StrConv(b, vbUnicode)
      TextInRange = Left$(sText, lR)
   End If
End Property

Public Property Let AutoURLDetect(ByVal bState As Boolean)
Dim lR As Long
   If (m_eVersion = eRICHED20) Then
      m_bAutoURLDetect = bState
      If m_hWnd <> 0 Then
         lR = SendMessageLong(m_hWnd, EM_AUTOURLDETECT, Abs(bState), 0)
         Debug.Assert (lR = 0)
      End If
      PropertyChanged m_bAutoURLDetect
   Else
      Unsupported
   End If
End Property
Public Property Get AutoURLDetect() As Boolean
   AutoURLDetect = m_bAutoURLDetect
End Property

Public Property Let ReadOnly(ByVal bState As Boolean)
   m_bReadOnly = bState
   If m_hWnd <> 0 Then
      SendMessageLong m_hWnd, EM_SETREADONLY, Abs(bState), 0
   End If
   PropertyChanged "ReadOnly"
End Property
Public Property Get ReadOnly() As Boolean
Dim lStyle As Long
   If (m_hWnd <> 0) Then
      lStyle = GetWindowLong(m_hWnd, GWL_STYLE)
      If (lStyle And ES_READONLY) = ES_READONLY Then
         ReadOnly = True
      End If
   End If
End Property

Public Property Get LineCount() As Long
   LineCount = SendMessageLong(m_hWnd, EM_GETLINECOUNT, 0, 0)
End Property

Public Property Get FirstVisibleLine() As Long
   FirstVisibleLine = SendMessageLong(m_hWnd, EM_GETFIRSTVISIBLELINE, 0, 0)
End Property
Public Property Get CurrentLine() As Long
Dim lStart As Long, lEnd As Long
   GetSelection lStart, lEnd
   ' Use EX to ensure we can cope with > 32k text
   CurrentLine = SendMessageLong(m_hWnd, EM_EXLINEFROMCHAR, 0, lStart)
End Property

Public Property Get LineForCharacter(ByVal lCharacter As Long)
   ' Use EX to ensure we can cope with > 32k text
   LineForCharacter = SendMessageLong(m_hWnd, EM_EXLINEFROMCHAR, 0, lCharacter)
End Property

Public Property Get CharFromPos(ByVal xPixels As Long, ByVal yPixels As Long)
Dim tP As POINTAPI
   tP.x = xPixels
   tP.y = yPixels
   CharFromPos = SendMessage(m_hWnd, EM_CHARFROMPOS, 0, tP)
End Property

Public Sub GetPosFromChar(ByVal lIndex As Long, ByRef xPixels As Long, ByRef
 yPixels As Long)
Dim lxy As Long
   lxy = SendMessageLong(m_hWnd, EM_POSFROMCHAR, lIndex, 0)
   xPixels = (lxy And &HFFFF&)
   yPixels = (lxy \ &H10000) And &HFFFF&
End Sub

Public Sub GetSelection(ByRef lStart As Long, ByRef lEnd As Long)
Dim tCR As CHARRANGE
   SendMessage m_hWnd, EM_EXGETSEL, 0, tCR
   lStart = tCR.cpMin
   lEnd = tCR.cpMax
End Sub

Public Sub SetSelection(ByVal lStart As Long, ByVal lEnd As Long)
Dim tCR As CHARRANGE
   tCR.cpMin = lStart
   tCR.cpMax = lEnd
   SendMessage m_hWnd, EM_EXSETSEL, 0, tCR
End Sub
Public Sub SelectAll()
   SetSelection 0, -1
End Sub
Public Sub SelectNone()
Dim tC As CHARRANGE
    tC.cpMax = 0
    tC.cpMin = 0
    SendMessage m_hWnd, EM_EXSETSEL, 0, tC
End Sub

Public Property Get CanPaste() As Boolean
   CanPaste = SendMessageLong(m_hWnd, EM_CANPASTE, 0, 0)
End Property
Public Property Get CanCopy() As Boolean
Dim lStart As Long, lEnd As Long
   GetSelection lStart, lEnd
   If (lEnd > lStart) Then
      CanCopy = True
   End If
End Property
Public Property Get CanUndo() As Boolean
   CanUndo = SendMessageLong(m_hWnd, EM_CANUNDO, 0, 0)
End Property
Public Property Get CanRedo() As Boolean
   If m_eVersion = eRICHED20 Then
      CanRedo = SendMessageLong(m_hWnd, EM_CANREDO, 0, 0)
   Else
      Unsupported
   End If
End Property
Public Property Get UndoType() As ERECUndoTypeConstants
   If m_eVersion = eRICHED20 Then
      UndoType = SendMessageLong(m_hWnd, EM_GETUNDONAME, 0, 0)
   Else
      Unsupported
   End If
End Property
Public Property Get RedoType() As ERECUndoTypeConstants
   If m_eVersion = eRICHED20 Then
      RedoType = SendMessageLong(m_hWnd, EM_GETREDONAME, 0, 0)
   Else
      Unsupported
   End If
End Property
Public Sub Cut()
   SendMessageLong m_hWnd, WM_CUT, 0, 0
End Sub
Public Sub Copy()
   SendMessageLong m_hWnd, WM_COPY, 0, 0
End Sub
Public Sub Paste()
   SendMessageLong m_hWnd, WM_PASTE, 0, 0
End Sub
Public Sub PasteSpecial()
   SendMessageLong m_hWnd, EM_PASTESPECIAL, 0, 0
End Sub
Public Sub Undo()
   SendMessageLong m_hWnd, EM_UNDO, 0, 0
End Sub
Public Sub Redo()
   If (m_eVersion = eRICHED20) Then
      SendMessageLong m_hWnd, EM_REDO, 0, 0
   Else
      Unsupported
   End If
End Sub
Public Sub Delete()
   ' TODO
End Sub

Public Sub InsertContents(ByVal eType As ERECFileTypes, ByRef sText As String)
Dim tStream As EDITSTREAM
Dim lR As Long
   ' Don't redraw:
   Redraw = False
   ' Insert the text:
   tStream.dwCookie = m_hWnd
   tStream.pfnCallback = plAddressOf(AddressOf LoadCallBack)
   tStream.dwError = 0
   StreamText = sText
   ' The text will be streamed in though the LoadCallback function:
   lR = SendMessage(m_hWnd, EM_STREAMIN, eType Or SFF_SELECTION, tStream)
   ' Redraw again:
   Redraw = True
   
End Sub

Public Property Get ViewMode() As ERECViewModes
   ViewMode = m_eViewMode
End Property

Public Property Let ViewMode(ByVal eViewMode As ERECViewModes)
   If (eViewMode <> m_eViewMode) Then
      m_eViewMode = eViewMode
      pSetViewMode eViewMode
   End If
End Property
Private Sub pSetViewMode(ByVal eViewMode As ERECViewModes)
   Select Case m_eViewMode
   Case ercWYSIWYG
      On Error Resume Next
      SendMessageLong m_hWnd, EM_SETTARGETDEVICE, Printer.hDC, Printer.Width
   Case ercWordWrap
      SendMessageLong m_hWnd, EM_SETTARGETDEVICE, 0, 0
   Case ercDefault
      SendMessageLong m_hWnd, EM_SETTARGETDEVICE, 0, 1
   End Select
End Sub
Public Property Get CharFormatRange() As ERECSetFormatRange
   CharFormatRange = m_eCharFormatRange
End Property
Public Property Let CharFormatRange(ByVal eRange As ERECSetFormatRange)
   m_eCharFormatRange = eRange
End Property
Public Property Get CharacterCount() As Long
   If m_eVersion = eRICHED20 Then
      CharacterCount = SendMessageLong(m_hWnd, WM_GETTEXTLENGTH, 0, 0)
   Else
      CharacterCount = SendMessageLong(m_hWnd, EM_GETTEXTLENGTHEX, 0, 0)
   End If
End Property
Public Property Get FontBold() As Boolean
Dim tCF As CHARFORMAT
Dim lR As Long
   tCF.dwMask = CFM_BOLD
   tCF.cbSize = Len(tCF)
   lR = SendMessage(m_hWnd, EM_GETCHARFORMAT, m_eCharFormatRange, tCF)
   FontBold = ((tCF.dwEffects And CFE_BOLD) = CFE_BOLD)
End Property
Public Property Let FontBold(ByVal bBold As Boolean)
Dim tCF As CHARFORMAT
Dim lR As Long
   tCF.dwMask = CFM_BOLD
   If (bBold) Then
      tCF.dwEffects = CFE_BOLD
   End If
   tCF.cbSize = Len(tCF)
   lR = SendMessage(m_hWnd, EM_SETCHARFORMAT, m_eCharFormatRange, tCF)
End Property
Public Property Get FontItalic() As Boolean
Dim tCF As CHARFORMAT
Dim lR As Long
   tCF.dwMask = CFM_ITALIC
   tCF.cbSize = Len(tCF)
   lR = SendMessage(m_hWnd, EM_GETCHARFORMAT, m_eCharFormatRange, tCF)
   FontItalic = ((tCF.dwEffects And CFE_ITALIC) = CFE_ITALIC)
End Property
Public Property Let FontItalic(ByVal bItalic As Boolean)
Dim tCF As CHARFORMAT
Dim lR As Long
   tCF.dwMask = CFM_ITALIC
   If (bItalic) Then
      tCF.dwEffects = CFE_ITALIC
   End If
   tCF.cbSize = Len(tCF)
   lR = SendMessage(m_hWnd, EM_SETCHARFORMAT, m_eCharFormatRange, tCF)
End Property
Public Property Get FontUnderline() As Boolean
Dim tCF As CHARFORMAT
Dim lR As Long
   tCF.dwMask = CFM_UNDERLINE
   tCF.cbSize = Len(tCF)
   lR = SendMessage(m_hWnd, EM_GETCHARFORMAT, m_eCharFormatRange, tCF)
   FontUnderline = ((tCF.dwEffects And CFE_UNDERLINE) = CFE_UNDERLINE)
End Property
Public Property Let FontUnderline(ByVal bUnderline As Boolean)
Dim tCF As CHARFORMAT
Dim lR As Long
   tCF.dwMask = CFM_UNDERLINE
   If (bUnderline) Then
      tCF.dwEffects = CFE_UNDERLINE
   End If
   tCF.cbSize = Len(tCF)
   lR = SendMessage(m_hWnd, EM_SETCHARFORMAT, m_eCharFormatRange, tCF)
End Property
Public Property Get FontStrikeOut() As Boolean
Dim tCF As CHARFORMAT
Dim lR As Long
   tCF.dwMask = CFM_STRIKEOUT
   tCF.cbSize = Len(tCF)
   lR = SendMessage(m_hWnd, EM_GETCHARFORMAT, m_eCharFormatRange, tCF)
   FontStrikeOut = ((tCF.dwEffects And CFE_STRIKEOUT) = CFE_STRIKEOUT)
End Property
Public Property Let FontStrikeOut(ByVal bStrikeOut As Boolean)
Dim tCF As CHARFORMAT
Dim lR As Long
   tCF.dwMask = CFM_STRIKEOUT
   If (bStrikeOut) Then
      tCF.dwEffects = CFE_STRIKEOUT
   End If
   tCF.cbSize = Len(tCF)
   lR = SendMessage(m_hWnd, EM_SETCHARFORMAT, m_eCharFormatRange, tCF)
End Property

Public Property Get FontColour() As OLE_COLOR
Dim tCF As CHARFORMAT
Dim lR As Long
Dim lColour As Long
   tCF.dwMask = CFM_COLOR
   tCF.cbSize = Len(tCF)
   lR = SendMessage(m_hWnd, EM_GETCHARFORMAT, m_eCharFormatRange, tCF)
   FontColour = tCF.crTextColor
End Property
Public Property Let FontColour(ByVal oColour As OLE_COLOR)
Dim tCF As CHARFORMAT
Dim lR As Long
Dim lColour As Long
   If oColour = -1 Then
      tCF.dwMask = CFM_COLOR
      tCF.dwEffects = CFE_AUTOCOLOR
      tCF.crTextColor = -1
   Else
      tCF.crTextColor = TranslateColor(oColour)
      tCF.dwMask = CFM_COLOR
   End If
   tCF.cbSize = Len(tCF)
   lR = SendMessage(m_hWnd, EM_SETCHARFORMAT, m_eCharFormatRange, tCF)
End Property
Public Property Get FontBackColour() As OLE_COLOR
Dim tCF2 As CHARFORMAT2
Dim lR As Long
   If (m_eVersion = eRICHED20) Then
      tCF2.dwMask = CFM_BACKCOLOR
      tCF2.cbSize = Len(tCF2)
      lR = SendMessage(m_hWnd, EM_GETCHARFORMAT, m_eCharFormatRange, tCF2)
      FontBackColour = tCF2.crBackColor
   Else
      Unsupported
   End If
End Property
Public Property Let FontBackColour(ByVal oColor As OLE_COLOR)
Dim tCF2 As CHARFORMAT2
Dim lR As Long
   If (m_eVersion = eRICHED20) Then
      If oColor = -1 Then
         tCF2.dwMask = CFM_BACKCOLOR
         tCF2.dwEffects = CFE_AUTOBACKCOLOR
         tCF2.crBackColor = -1
      Else
         tCF2.dwMask = CFM_BACKCOLOR
         tCF2.crBackColor = TranslateColor(oColor)
      End If
      tCF2.cbSize = Len(tCF2)
      lR = SendMessage(m_hWnd, EM_SETCHARFORMAT, m_eCharFormatRange, tCF2)
   Else
      Unsupported
   End If
End Property
Public Property Get FontLink() As Boolean
Dim tCF2 As CHARFORMAT2
Dim lR As Long
   If (m_eVersion = eRICHED20) Then
      tCF2.dwMask = CFM_LINK
      tCF2.cbSize = Len(tCF2)
      lR = SendMessage(m_hWnd, EM_GETCHARFORMAT, m_eCharFormatRange, tCF2)
      FontLink = ((tCF2.dwEffects And CFE_LINK) = CFE_LINK)
   Else
      Unsupported
   End If
End Property
Public Property Let FontLink(ByVal bState As Boolean)
Dim tCF2 As CHARFORMAT2
Dim lR As Long
   If (m_eVersion = eRICHED20) Then
      tCF2.dwMask = CFM_LINK
      If (bState) Then
         tCF2.dwEffects = CFE_LINK
      End If
      tCF2.cbSize = Len(tCF2)
      lR = SendMessage(m_hWnd, EM_SETCHARFORMAT, m_eCharFormatRange, tCF2)
   Else
      Unsupported
   End If
End Property
Public Property Get FontProtected() As Boolean
Dim tCF2 As CHARFORMAT2
Dim lR As Long
   If (m_eVersion = eRICHED20) Then
      tCF2.dwMask = CFM_PROTECTED
      tCF2.cbSize = Len(tCF2)
      lR = SendMessage(m_hWnd, EM_GETCHARFORMAT, m_eCharFormatRange, tCF2)
      FontProtected = ((tCF2.dwEffects And CFE_PROTECTED) = CFE_PROTECTED)
   Else
      Unsupported
   End If
End Property
Public Property Let FontProtected(ByVal bState As Boolean)
Dim tCF2 As CHARFORMAT2
Dim lR As Long
   If (m_eVersion = eRICHED20) Then
      tCF2.dwMask = CFM_PROTECTED
      If (bState) Then
         tCF2.dwEffects = CFE_PROTECTED
      End If
      tCF2.cbSize = Len(tCF2)
      lR = SendMessage(m_hWnd, EM_SETCHARFORMAT, m_eCharFormatRange, tCF2)
   Else
      Unsupported
   End If
End Property

Public Property Get FontSuperScript() As Boolean
Dim tCF As CHARFORMAT
Dim tCF2 As CHARFORMAT2
Dim lR As Long
   If (m_eVersion = eRICHED32) Then
      tCF.dwMask = CFM_OFFSET
      tCF.cbSize = Len(tCF)
      lR = SendMessage(m_hWnd, EM_GETCHARFORMAT, m_eCharFormatRange, tCF)
      FontSuperScript = (tCF.yOffset > 0)
   Else
      tCF2.dwMask = CFM_SUPERSCRIPT
      tCF2.cbSize = Len(tCF2)
      lR = SendMessage(m_hWnd, EM_GETCHARFORMAT, m_eCharFormatRange, tCF2)
      FontSuperScript = ((tCF2.dwEffects And CFE_SUPERSCRIPT) = CFE_SUPERSCRIPT)
   End If
End Property
Public Property Get FontSubScript() As Boolean
Dim tCF As CHARFORMAT
Dim tCF2 As CHARFORMAT2
Dim lR As Long
   If (m_eVersion = eRICHED32) Then
      tCF.dwMask = CFM_OFFSET
      tCF.cbSize = Len(tCF)
      lR = SendMessage(m_hWnd, EM_GETCHARFORMAT, m_eCharFormatRange, tCF)
   Else
      tCF2.dwMask = CFM_SUBSCRIPT
      tCF2.cbSize = Len(tCF2)
      lR = SendMessage(m_hWnd, EM_GETCHARFORMAT, m_eCharFormatRange, tCF2)
      FontSuperScript = ((tCF2.dwEffects And CFE_SUBSCRIPT) = CFE_SUBSCRIPT)
   End If
End Property
Public Property Let FontSuperScript(ByVal bState As Boolean)
Dim tCF As CHARFORMAT
Dim tCF2 As CHARFORMAT2
Dim lR As Long
Dim y As Long

   If (m_eVersion = eRICHED32) Then
      ' Get the current font size in twips:
      tCF.dwMask = CFM_SIZE
      tCF.cbSize = Len(tCF)
      lR = SendMessage(m_hWnd, EM_GETCHARFORMAT, ercSetFormatSelection, tCF)
      y = tCF.yHeight \ 2
      
      ' Set the offset:
      tCF.dwMask = CFM_OFFSET
      tCF.cbSize = Len(tCF)
      If (bState) Then
         tCF.yOffset = y
      Else
         tCF.yOffset = 0
      End If
      lR = SendMessage(m_hWnd, EM_SETCHARFORMAT, m_eCharFormatRange, tCF)
   Else
      tCF2.dwMask = CFM_SUPERSCRIPT
      If (bState) Then
         tCF2.dwEffects = CFE_SUPERSCRIPT
      End If
      tCF2.cbSize = Len(tCF2)
      lR = SendMessage(m_hWnd, EM_SETCHARFORMAT, m_eCharFormatRange, tCF2)
   End If
End Property
Public Property Let FontSubScript(ByVal bState As Boolean)
Dim tCF As CHARFORMAT
Dim tCF2 As CHARFORMAT2
Dim lR As Long
Dim y As Long

   If (m_eVersion = eRICHED32) Then
      ' Get the current font size in twips:
      tCF.dwMask = CFM_SIZE
      tCF.cbSize = Len(tCF)
      lR = SendMessage(m_hWnd, EM_GETCHARFORMAT, ercSetFormatSelection, tCF)
      y = tCF.yHeight \ -2
      
      ' Set the offset:
      tCF.dwMask = CFM_OFFSET
      tCF.cbSize = Len(tCF)
      If (bState) Then
         tCF.yOffset = y
      Else
         tCF.yOffset = 0
      End If
      lR = SendMessage(m_hWnd, EM_SETCHARFORMAT, m_eCharFormatRange, tCF)
   Else
      tCF2.dwMask = CFM_SUBSCRIPT
      If (bState) Then
         tCF2.dwEffects = CFE_SUBSCRIPT
      End If
      tCF2.cbSize = Len(tCF2)
      lR = SendMessage(m_hWnd, EM_SETCHARFORMAT, m_eCharFormatRange, tCF2)
   End If
End Property
Public Sub SetFont( _
      ByRef fntThis As StdFont, _
      Optional ByVal oColor As OLE_COLOR = vbWindowText, _
      Optional ByVal eType As ERECTextTypes = ercTextNormal, _
      Optional ByVal bHyperLink As Boolean = False, _
      Optional ByVal eRange As ERECSetFormatRange = ercSetFormatSelection _
   )
Dim tCF As CHARFORMAT
Dim tCF2 As CHARFORMAT2
Dim dwEffects As Long
Dim dwMask As Long
Dim i As Long
   
   tCF.cbSize = Len(tCF)
   tCF.crTextColor = TranslateColor(oColor)
   dwMask = CFM_COLOR
   If fntThis.Bold Then
      dwEffects = dwEffects Or CFE_BOLD
   End If
   dwMask = dwMask Or CFM_BOLD
   If fntThis.Italic Then
      dwEffects = dwEffects Or CFE_ITALIC
   End If
   dwMask = dwMask Or CFM_ITALIC
   If fntThis.Strikethrough Then
      dwEffects = dwEffects Or CFE_STRIKEOUT
   End If
   dwMask = dwMask Or CFM_STRIKEOUT
   If fntThis.Underline Then
      dwEffects = dwEffects Or CFE_UNDERLINE
   End If
   dwMask = dwMask Or CFM_UNDERLINE

   If bHyperLink Then
      dwEffects = dwEffects Or CFE_LINK
   End If
   dwMask = dwMask Or CFM_LINK
   
   tCF.dwEffects = dwEffects
   tCF.dwMask = dwMask Or CFM_FACE Or CFM_SIZE
   
   For i = 1 To Len(fntThis.Name)
      tCF.szFaceName(i - 1) = Asc(Mid$(fntThis.Name, i, 1))
   Next i
   tCF.yHeight = (fntThis.Size * 20)
   If (eType = ercTextSubscript) Then
      tCF.yOffset = -tCF.yHeight \ 2
   End If
   If (eType = ercTextSuperscript) Then
      tCF.yOffset = tCF.yHeight \ 2
   End If
   
   If (m_eVersion = eRICHED32) Then
      SendMessage m_hWnd, EM_SETCHARFORMAT, eRange, tCF
   Else
      CopyMemory tCF2, tCF, Len(tCF)
      tCF2.cbSize = Len(tCF2)
      tCF.yOffset = 0
      If (eType = ercTextSubscript) Then
         tCF.dwEffects = tCF.dwEffects Or CFE_SUBSCRIPT
         tCF.dwMask = tCF.dwMask Or CFM_SUBSCRIPT
      End If
      If (eType = ercTextSuperscript) Then
         tCF.dwEffects = tCF.dwEffects Or CFE_SUPERSCRIPT
         tCF.dwMask = tCF.dwMask Or CFM_SUPERSCRIPT
      End If
      SendMessage m_hWnd, EM_SETCHARFORMAT, eRange, tCF2
   End If
   
End Sub
Public Function GetFont( _
      Optional ByVal bForSelection As Boolean = False, _
      Optional ByRef oColor As OLE_COLOR, _
      Optional ByRef bHyperLink As Boolean, _
      Optional ByVal eType As ERECTextTypes = ercTextNormal _
   ) As StdFont
Dim sFnt As New StdFont
Dim tCF As CHARFORMAT
Dim tCF2 As CHARFORMAT2
Dim dwEffects As Long
Dim dwMask As Long
Dim i As Long
Dim sName As String
   
   tCF.cbSize = Len(tCF)
   dwMask = dwMask Or CFM_COLOR

   dwMask = dwMask Or CFM_BOLD
   dwMask = dwMask Or CFM_ITALIC
   dwMask = dwMask Or CFM_STRIKEOUT
   dwMask = dwMask Or CFM_UNDERLINE
   dwMask = dwMask Or CFM_LINK
   If (m_eVersion = eRICHED32) Then
      tCF.dwEffects = dwEffects
      tCF.dwMask = dwMask Or CFM_FACE Or CFM_SIZE
      SendMessage m_hWnd, EM_GETCHARFORMAT, Abs(bForSelection), tCF
   Else
      CopyMemory tCF2, tCF, Len(tCF)
      tCF2.cbSize = Len(tCF2)
      SendMessage m_hWnd, EM_GETCHARFORMAT, Abs(bForSelection), tCF2
   End If
      
   If (m_eVersion = eRICHED32) Then
      'tCF.crTextColor = TranslateColor(oColor)
      oColor = tCF.crTextColor
      For i = 1 To LF_FACESIZE
         sName = sName & Chr$(tCF.szFaceName(i - 1))
      Next i
      sFnt.Name = sName
      sFnt.Size = tCF.yHeight \ 20
      sFnt.Bold = ((tCF.dwEffects And CFE_BOLD) = CFE_BOLD)
      sFnt.Italic = ((tCF.dwEffects And CFE_ITALIC) = CFE_ITALIC)
      sFnt.Underline = ((tCF.dwEffects And CFE_UNDERLINE) = CFE_UNDERLINE)
      sFnt.Strikethrough = ((tCF.dwEffects And CFE_STRIKEOUT) = CFE_STRIKEOUT)
      bHyperLink = ((tCF.dwEffects And CFE_LINK) = CFE_LINK)
      If (tCF.yOffset = 0) Then
         eType = ercTextNormal
      ElseIf (tCF.yOffset < 0) Then
         eType = ercTextSubscript
      Else
         eType = ercTextSuperscript
      End If
   Else
      oColor = tCF2.crTextColor
      For i = 1 To LF_FACESIZE
         sName = sName & Chr$(tCF2.szFaceName(i - 1))
      Next i
      sFnt.Name = sName
      sFnt.Size = tCF2.yHeight \ 20
      sFnt.Bold = ((tCF2.dwEffects And CFE_BOLD) = CFE_BOLD)
      sFnt.Italic = ((tCF2.dwEffects And CFE_ITALIC) = CFE_ITALIC)
      sFnt.Underline = ((tCF2.dwEffects And CFE_UNDERLINE) = CFE_UNDERLINE)
      sFnt.Strikethrough = ((tCF2.dwEffects And CFE_STRIKEOUT) = CFE_STRIKEOUT)
      bHyperLink = ((tCF2.dwEffects And CFE_LINK) = CFE_LINK)
      eType = ercTextNormal
      If ((tCF2.dwEffects And CFE_SUPERSCRIPT) = CFE_SUPERSCRIPT) Then
         eType = ercTextSuperscript
      End If
      If ((tCF2.dwEffects And CFE_SUBSCRIPT) = CFE_SUBSCRIPT) Then
         eType = ercTextSubscript
      End If
   End If
   Set GetFont = sFnt
End Function

Public Property Get ParagraphNumbering() As ERECParagraphNumberingConstants
Dim tP As PARAFORMAT
Dim tP2 As PARAFORMAT2
Dim lR As Long

   If (m_eVersion = eRICHED32) Then
      tP.dwMask = PFM_NUMBERING
      tP.cbSize = Len(tP)
      lR = SendMessage(m_hWnd, EM_GETPARAFORMAT, 0, tP)
      ParagraphNumbering = tP.wNumbering
   Else
      tP2.dwMask = PFM_NUMBERING
      tP2.cbSize = Len(tP2)
      lR = SendMessage(m_hWnd, EM_GETPARAFORMAT, 0, tP2)
      ParagraphNumbering = tP2.wNumbering
   End If
End Property
Public Property Let ParagraphNumbering(ByVal eStyle As
 ERECParagraphNumberingConstants)
Dim tP As PARAFORMAT
Dim tP2 As PARAFORMAT2
Dim lR As Long

   If (m_eVersion = eRICHED32) Then
      tP.dwMask = PFM_NUMBERING
      tP.cbSize = Len(tP)
      tP.wNumbering = eStyle
      lR = SendMessage(m_hWnd, EM_SETPARAFORMAT, 0, tP)
   Else
      tP2.dwMask = PFM_NUMBERING
      tP2.wNumbering = eStyle
      tP2.cbSize = Len(tP2)
      lR = SendMessage(m_hWnd, EM_SETPARAFORMAT, 0, tP2)
   End If
End Property
Public Sub GetParagraphOffsets( _
      ByRef lStartIndent As Long, _
      ByRef lLeftOffset As Long, _
      ByRef lRightOffset As Long _
   )
Dim tP As PARAFORMAT
Dim tP2 As PARAFORMAT2
Dim lR As Long

   If (m_eVersion = eRICHED32) Then
      tP.dwMask = PFM_STARTINDENT Or PFM_RIGHTINDENT Or PFM_OFFSET
      tP.cbSize = Len(tP)
      lR = SendMessage(m_hWnd, EM_GETPARAFORMAT, 0, tP)
      lStartIndent = tP.dxStartIndent
      lLeftOffset = tP.dxOffset
      lRightOffset = tP.dxRightIndent
   Else
      tP2.dwMask = PFM_STARTINDENT Or PFM_RIGHTINDENT Or PFM_OFFSET
      tP2.cbSize = Len(tP2)
      lR = SendMessage(m_hWnd, EM_GETPARAFORMAT, 0, tP2)
      lStartIndent = tP2.dxStartIndent
      lLeftOffset = tP2.dxOffset
      lRightOffset = tP2.dxRightIndent
   End If
End Sub
Public Sub SetParagraphOffsets( _
      ByVal lStartIndent As Long, _
      ByVal lLeftOffset As Long, _
      ByVal lRightOffset As Long _
   )
Dim tP As PARAFORMAT
Dim tP2 As PARAFORMAT2
Dim lR As Long

   If (m_eVersion = eRICHED32) Then
      tP.dwMask = PFM_STARTINDENT Or PFM_RIGHTINDENT Or PFM_OFFSET
      tP.dxStartIndent = lStartIndent
      tP.dxOffset = lLeftOffset
      tP.dxRightIndent = lRightOffset
      tP.cbSize = Len(tP)
      lR = SendMessage(m_hWnd, EM_SETPARAFORMAT, 0, tP)
   Else
      tP2.dwMask = PFM_STARTINDENT Or PFM_RIGHTINDENT Or PFM_OFFSET
      tP2.dxStartIndent = lStartIndent
      tP2.dxOffset = lLeftOffset
      tP2.dxRightIndent = lRightOffset
      tP2.cbSize = Len(tP2)
      lR = SendMessage(m_hWnd, EM_SETPARAFORMAT, 0, tP2)
   End If
      
End Sub
Public Property Get ParagraphAlignment() As ERECParagraphAlignmentConstants
Dim tP As PARAFORMAT
Dim tP2 As PARAFORMAT2
Dim lR As Long

   If (m_eVersion = eRICHED32) Then
      tP.dwMask = PFM_ALIGNMENT
      tP.cbSize = Len(tP)
      lR = SendMessage(m_hWnd, EM_GETPARAFORMAT, 0, tP)
      ParagraphAlignment = tP.wAlignment
   Else
      tP2.dwMask = PFM_ALIGNMENT
      tP2.cbSize = Len(tP2)
      lR = SendMessage(m_hWnd, EM_GETPARAFORMAT, 0, tP2)
      ParagraphAlignment = tP2.wAlignment
   End If

End Property
Public Property Let ParagraphAlignment(ByVal eAlign As
 ERECParagraphAlignmentConstants)
Dim tP As PARAFORMAT
Dim tP2 As PARAFORMAT2
Dim lR As Long

   If (m_eVersion = eRICHED32) Then
      If (eAlign = ercParaJustify) Then
         Unsupported
      Else
         tP.dwMask = PFM_ALIGNMENT
         tP.cbSize = Len(tP)
         tP.wAlignment = eAlign
         lR = SendMessage(m_hWnd, EM_SETPARAFORMAT, 0, tP)
      End If
   Else
      tP2.dwMask = PFM_ALIGNMENT
      tP2.cbSize = Len(tP2)
      tP2.wAlignment = eAlign
      lR = SendMessage(m_hWnd, EM_SETPARAFORMAT, 0, tP2)
   End If

End Property
Public Sub GetParagraphTabs( _
      ByRef iCount As Integer, _
      ByRef lTabSize() As Long, _
      Optional ByRef eTabAlignment As Variant, _
      Optional ByRef eTabLeader As Variant _
   )
Dim tP As PARAFORMAT
Dim tP2 As PARAFORMAT2
Dim lR As Long
Dim lNumTabs As Long
Dim lPtrTabs As Long
Dim lTabs() As Long
Dim i As Long
Dim lAlign() As Long
Dim lLeader() As Long


   Erase lTabSize
   eTabAlignment = 0
   eTabLeader = 0
   iCount = 0
   
   If (m_eVersion = eRICHED32) Then
      tP.dwMask = PFM_TABSTOPS
      tP.cbSize = Len(tP)
      lR = SendMessage(m_hWnd, EM_GETPARAFORMAT, 0, tP)
      lNumTabs = tP.cTabCount
      If (lNumTabs > 0) Then
         iCount = tP.cTabCount
         ReDim lTabSize(1 To lNumTabs) As Long
         For i = 0 To lNumTabs - 1
            lTabSize(i + 1) = tP.lTabStops(i)
         Next i
      End If
   Else
      tP2.dwMask = PFM_TABSTOPS
      tP2.cbSize = Len(tP2)
      lR = SendMessage(m_hWnd, EM_GETPARAFORMAT, 0, tP2)
      lNumTabs = tP2.cTabCount
      If (lNumTabs > 0) Then
         iCount = tP2.cTabCount
         ReDim lTabSize(1 To lNumTabs) As Long
         ReDim lAlign(1 To lNumTabs) As Long
         ReDim lLeader(1 To lNumTabs) As Long
         For i = 0 To lNumTabs - 1
            ' First 24 bits are size:
            lTabSize(i + 1) = (tP2.lTabStops(i) And &HFFFFFF)
            ' Bits 24-27 are alignment:
            lAlign(i + 1) = (tP2.lTabStops(i) And &HF000000) \ &H1000000
            ' Bits 28-31 are leader:
            lLeader(i + 1) = (tP2.lTabStops(i) And &H70000000) \ &H10000000
         Next i
         eTabAlignment = lAlign
         eTabLeader = lLeader
      End If
   End If
        
End Sub
Public Sub SetParagraphTabs( _
      ByVal iCount As Integer, _
      ByRef lTabSize() As Long, _
      Optional ByRef eTabAlignment As Variant, _
      Optional ByRef eTabLeader As Variant _
   )
Dim tP As PARAFORMAT
Dim tP2 As PARAFORMAT2
Dim lR As Long
Dim lNumTabs As Long
Dim lPtrTabs As Long
Dim i As Long
   
   
   If (m_eVersion = eRICHED32) Then
      tP.dwMask = PFM_TABSTOPS
      tP.cbSize = Len(tP)
      tP.cTabCount = iCount
      If (iCount > 0) Then
         For i = 0 To iCount - 1
            tP.lTabStops(i) = lTabSize(i + 1)
         Next i
      End If
      lR = SendMessage(m_hWnd, EM_SETPARAFORMAT, 0, tP)
   Else
      tP2.dwMask = PFM_TABSTOPS
      tP2.cbSize = Len(tP2)
      tP2.cTabCount = iCount
      If (iCount > 0) Then
         For i = 0 To iCount - 1
            tP2.lTabStops(i) = lTabSize(i + 1)
         Next i
      End If
      lR = SendMessage(m_hWnd, EM_SETPARAFORMAT, 0, tP2)
   End If
   
End Sub
Public Sub GetParagraphLineSpacing( _
      ByRef eLineSpacingStyle As ERECParagraphLineSpacingConstants, _
      ByRef ySpacing As Long _
   )
Dim tCF2 As PARAFORMAT2
Dim lR As Long
   If (m_eVersion = eRICHED32) Then
      Unsupported
   Else
      tCF2.dwMask = PFM_LINESPACING
      tCF2.cbSize = Len(tCF2)
      lR = SendMessage(m_hWnd, EM_GETPARAFORMAT, 0, tCF2)
      eLineSpacingStyle = tCF2.bLineSpacingRule
      ySpacing = tCF2.dyLineSpacing
   End If
End Sub
Public Sub SetParagraphLineSpacing( _
      ByVal eLineSpacingStyle As ERECParagraphLineSpacingConstants, _
      ByVal ySpacing As Long _
   )
Dim tCF2 As PARAFORMAT2
Dim lR As Long
   If (m_eVersion = eRICHED32) Then
      Unsupported
   Else
      tCF2.dwMask = PFM_LINESPACING
      tCF2.cbSize = Len(tCF2)
      tCF2.bLineSpacingRule = eLineSpacingStyle
      tCF2.dyLineSpacing = ySpacing
      lR = SendMessage(m_hWnd, EM_SETPARAFORMAT, 0, tCF2)
   End If
End Sub
Public Sub GetParagraphSpacing( _
      ByRef lSpaceAfter As Long, _
      ByRef lSpaceBefore As Long _
   )
Dim tCF2 As PARAFORMAT2
Dim lR As Long
   If (m_eVersion = eRICHED32) Then
      Unsupported
   Else
      tCF2.dwMask = PFM_SPACEBEFORE Or PFM_SPACEAFTER
      tCF2.cbSize = Len(tCF2)
      lR = SendMessage(m_hWnd, EM_GETPARAFORMAT, 0, tCF2)
      lSpaceAfter = tCF2.dySpaceAfter
      lSpaceBefore = tCF2.dySpaceBefore
   End If
End Sub
Public Sub SetParagraphSpacing( _
      ByVal lSpaceAfter As Long, _
      ByVal lSpaceBefore As Long _
   )
Dim tCF2 As PARAFORMAT2
Dim lR As Long
   If (m_eVersion = eRICHED32) Then
      Unsupported
   Else
      tCF2.dwMask = PFM_SPACEBEFORE Or PFM_SPACEAFTER
      tCF2.cbSize = Len(tCF2)
      tCF2.dySpaceAfter = lSpaceAfter
      tCF2.dySpaceBefore = lSpaceBefore
      lR = SendMessage(m_hWnd, EM_SETPARAFORMAT, 0, tCF2)
   End If
   
End Sub

Public Property Let UseVersion(ByVal eVersion As ERECControlVersion)
    If (UserControl.Ambient.UserMode) Then
        ' can't set at run time in this implementation.
        Unsupported 1
    Else
        m_eVersion = eVersion
    End If
End Property
Public Property Get UseVersion() As ERECControlVersion
    UseVersion = m_eVersion
End Property
Public Property Get IsRtf(ByRef sFileText As String) As Boolean
   If (Left$(sFileText, 5) = "{\rtf") Then
      IsRtf = True
   End If
End Property
Public Property Get Redraw() As Boolean
   Redraw = m_bRedraw
End Property
Public Property Let Redraw(ByVal bState As Boolean)
   If (m_bRedraw <> bState) Then
      If (m_hWnd <> 0) Then
         If Not (bState) Then
            ' Don't redraw:
            SendMessageLong m_hWnd, WM_SETREDRAW, 0, 0
         Else
            ' Redraw again:
            SendMessageLong m_hWnd, WM_SETREDRAW, 1, 0
            InvalidateRectAsNull m_hWnd, 0, 1
            UpdateWindow m_hWnd
         End If
      End If
   End If
   m_bRedraw = bState
   PropertyChanged "Redraw"
End Property
Public Property Let Contents(ByVal eType As ERECFileTypes, ByRef sContents As
 String)
Dim tStream As EDITSTREAM
Dim lR As Long
   
   m_eProgressType = ercLoad
   
   Redraw = False
   ' Load the text:
   tStream.dwCookie = m_hWnd
   tStream.pfnCallback = plAddressOf(AddressOf LoadCallBack)
   tStream.dwError = 0
   StreamText = sContents
   RichEdit = Me
   ' The text will be streamed in though the LoadCallback function:
   lR = SendMessage(m_hWnd, EM_STREAMIN, eType, tStream)
   ClearRichEdit
   ' Set unmodified flag
   SendMessageLong m_hWnd, EM_SETMODIFY, 0, 0
   Redraw = True
   
   m_eProgressType = ercNone
   
End Property
Public Property Get Contents(ByVal eType As ERECFileTypes) As String
Dim tStream As EDITSTREAM
        
   m_eProgressType = ercSave
        
   tStream.dwCookie = m_hWnd
   tStream.pfnCallback = plAddressOf(AddressOf SaveCallBack)
   tStream.dwError = 0
   ' The text will be streamed out though the SaveCallback function:
   ClearStreamText
   RichEdit = Me
   SendMessage m_hWnd, EM_STREAMOUT, eType, tStream
   ClearRichEdit
   
   Contents = StreamText()
    
   m_eProgressType = ercNone
    
End Property
Public Function LoadFromFile( _
      ByVal sFIle As String, _
      ByVal eType As ERECFileTypes _
   ) As Boolean
Dim hFile As Long
Dim tOF As OFSTRUCT
Dim tStream As EDITSTREAM
Dim lR As Long

   m_eProgressType = ercLoad
   
   Redraw = False

   hFile = OpenFile(sFIle, tOF, OF_READ)
   If (hFile <> 0) Then
      tStream.dwCookie = hFile
      tStream.pfnCallback = plAddressOf(AddressOf LoadCallBack)
      tStream.dwError = 0
      
      RichEdit = Me
      FileMode = True
      
      ' The text will be streamed in though the LoadCallback function:
      lR = SendMessage(m_hWnd, EM_STREAMIN, eType, tStream)
      
      LoadFromFile = (lR <> 0)
      
      FileMode = False
      ClearRichEdit
      
      CloseHandle hFile
   End If
   Redraw = True
   
   m_eProgressType = ercNone
End Function
Public Function SaveToFile( _
      ByVal sFIle As String, _
      ByVal eType As ERECFileTypes _
   ) As Boolean
Dim tStream As EDITSTREAM
Dim tOF As OFSTRUCT
Dim hFile As Long
Dim lR As Long
        
   m_eProgressType = ercSave
        
   hFile = OpenFile(sFIle, tOF, OF_CREATE)
   If (hFile <> 0) Then
      tStream.dwCookie = hFile
      tStream.pfnCallback = plAddressOf(AddressOf SaveCallBack)
      tStream.dwError = 0
      FileMode = True
      RichEdit = Me
      
      lR = SendMessage(m_hWnd, EM_STREAMOUT, eType, tStream)
      
      SaveToFile = (lR <> 0)
      
      FileMode = False
      ClearRichEdit
   
      CloseHandle hFile
   End If
    
   m_eProgressType = ercNone
       
End Function

Public Sub RaiseLoadStatus(ByVal lAmount As Long, ByVal lTotalAmount As Long)
   RaiseEvent ProgressStatus(lAmount, lTotalAmount)
End Sub

Public Sub PrintDocDC( _
      ByVal lPrinterHDC As Long, _
      ByVal sDocTitle As String, _
      Optional ByVal nStartPage As Long, _
      Optional ByVal nEndPage As Long _
   )
Dim fr As FORMATRANGE
Dim lTextOut As Long, lTextAmt As Long
Dim lLastTextOut As Long
Dim hJob As Long
Dim lR As Long
Dim lMin As Long
Dim lWidth As Long, lHeight As Long
Dim lLeft As Long, lTop As Long
Dim lXOffset As Long, lYOffset As Long
Dim lPixelsX As Long, lPixelsY As Long
Dim iPage As Long
Dim rcPage As RECT, rcRender As RECT
Dim lSavedState As Long
   
   m_eProgressType = ercPrint
   
   '// Fill out the DOCINFO structure.
   Dim b() As Byte
   Dim di As DOCINFO
   di.cbSize = Len(di)
   di.lpszOutput = 0
   ' This need sorting out.
   If (sDocTitle = "") Then
       sDocTitle = "RTF Document (vbAccelerator RichEdit control)"
   End If
   b = StrConv(sDocTitle, vbFromUnicode)
   ReDim Preserve b(0 To UBound(b) + 1) As Byte
   di.lpszDocName = VarPtr(b(0))
   
   '// Fill out the FORMATRANGE structure for the RTF output.
   fr.hDC = lPrinterHDC '; // HDC
   fr.hdcTarget = fr.hDC
   fr.chrg.cpMin = 0 '; // print
   fr.chrg.cpMax = -1 '; // entire contents
    
   ' Get information about the physically printable page on the
   ' printer:
    
   ' This is the number of Pixels per inch:
   lPixelsX = GetDeviceCaps(lPrinterHDC, LOGPIXELSX)
   lPixelsY = GetDeviceCaps(lPrinterHDC, LOGPIXELSY)
    
   ' This is the number of pixels across:
   lWidth = MulDiv(GetDeviceCaps(lPrinterHDC, PHYSICALWIDTH), 1440, lPixelsX)
   ' This is the number of pixels down:
   lHeight = MulDiv(GetDeviceCaps(lPrinterHDC, PHYSICALHEIGHT), 1440, lPixelsY)
   rcPage.Right = lWidth
   rcPage.Bottom = lHeight
        
   ' Save DC so we can restore it later to the initial state:
   lSavedState = SaveDC(fr.hDC)
   ' Ensure printer DC is in text mode:
   SetMapMode fr.hDC, MM_TEXT
        
   ' Evaluate the left and right physical offsets:
   lXOffset = -GetDeviceCaps(lPrinterHDC, PHYSICALOFFSETX)
   lYOffset = -GetDeviceCaps(lPrinterHDC, PHYSICALOFFSETY)
      
   lLeft = MulDiv(m_lLeftMargin, lPixelsX, 1440)
   lLeft = lLeft + lXOffset
   If lLeft < 0 Then lLeft = 0
   lTop = MulDiv(m_lTopMargin, lPixelsY, 1440)
   lTop = lTop + lYOffset
   If lTop < 0 Then lTop = 0
   rcRender.Right = lWidth - m_lRightMargin - m_lLeftMargin
   rcRender.Bottom = lHeight - m_lBottomMargin - m_lTopMargin
    
   ' Adjust the DC left,top according to the x & y offset:
   SetViewportOrgEx fr.hDC, lLeft, lTop, ByVal 0&
      
   ' Get the text out range:
   lTextOut = 0
   lTextAmt = CharacterCount()

   ' Clear the formatting buffer:
   SendMessageLong m_hWnd, EM_FORMATRANGE, 0, 0
   '
   
   ' Get each of the pages:
   Dim tP() As FORMATRANGE
   Dim lCount As Long
   Dim bSkip As Boolean
   
   If lTextAmt > 0 Then
      fr.chrg.cpMin = 0
      fr.chrg.cpMax = -1
      lCount = 0
      Do
         ' Work out the size of text to render:
         LSet fr.rc = rcRender
         LSet fr.rcPage = rcPage
         lMin = fr.chrg.cpMin
         lTextOut = SendMessage(m_hWnd, EM_FORMATRANGE, 0, fr)
         fr.chrg.cpMin = lTextOut
         If lCount > 0 Then
            ' This problem doesn't seem to get mentioned anywhere!
            ' If format range returns a smaller value than
            ' the last minimum, it has actually finished:
            If lTextOut < lMin Then
               fr.chrg.cpMin = lTextAmt
               bSkip = True
            End If
         End If
         If Not bSkip Then
            ' We cache the output rectangle and start &
            ' finish positions for subsequent printing:
            lCount = lCount + 1
            ReDim Preserve tP(1 To lCount) As FORMATRANGE
            tP(lCount).chrg.cpMin = lMin
            tP(lCount).chrg.cpMax = lTextOut - 1
            LSet tP(lCount).rc = fr.rc
         End If
      Loop While fr.chrg.cpMin <> -1 And fr.chrg.cpMin < lTextAmt
   End If
   
   RestoreDC fr.hDC, -1
   
   If nStartPage <= 0 Then
      nStartPage = 1
   ElseIf nStartPage > lCount Then
      nStartPage = lCount
   End If
   If nEndPage <= 0 Then
      nEndPage = lCount
   ElseIf nEndPage > lCount Then
      nEndPage = lCount
   End If
               
   RaiseEvent ProgressStatus(-1, -1)
   hJob = StartDoc(lPrinterHDC, di)
   If (hJob <> 0) Then
      
      ' Reset the output buffer:
      SendMessage m_hWnd, EM_FORMATRANGE, 0, 0
      
      For iPage = nStartPage To nEndPage
      
         'If Not iPage = 1 Then
            StartPage fr.hDC
         'End If
         
         ' Return DC to printing condition:
         lSavedState = SaveDC(fr.hDC)
         SetMapMode fr.hDC, MM_TEXT
         SetViewportOrgEx fr.hDC, lLeft, lTop, ByVal 0&
         
         LSet fr.rc = tP(iPage).rc
         LSet fr.rcPage = rcPage
         LSet fr.chrg = tP(iPage).chrg
         
         fr.chrg.cpMin = SendMessage(m_hWnd, EM_FORMATRANGE, 1, fr)
         
         RestoreDC fr.hDC, -1
         
         RaiseEvent ProgressStatus(lTextOut, lTextAmt)
         
         EndPage fr.hDC
         
      Next iPage
                        
      RaiseEvent ProgressStatus(lTextAmt, lTextAmt)

      '// Reset the formatting of the rich edit control.
      SendMessageLong m_hWnd, EM_FORMATRANGE, True, 0
    
      EndDoc fr.hDC
      
    Else
        Debug.Print "Failed to start print job"
    End If
   
End Sub


Public Sub PrintDoc( _
      ByVal sDocTitle As String _
   )
Dim pd As PrintDlg

   '// Initialize the PRINTDLG structure.
   pd.lStructSize = Len(pd)
   pd.hWndOwner = m_hWnd
   pd.hDevMode = 0
   pd.hDevNames = 0
   pd.nFromPage = 0
   pd.nToPage = 0
   pd.nMinPage = 0
   pd.nMaxPage = 0
   pd.nCopies = 0
   pd.hInstance = App.hInstance
   pd.flags = PD_RETURNDC Or PD_NOSELECTION Or PD_PRINTSETUP
   pd.lpfnSetupHook = 0
   pd.lpSetupTemplateName = 0
   pd.lpfnPrintHook = 0
   pd.lpPrintTemplateName = 0
   
   '// Get the printer DC.
   If (PrintDlg(pd) <> 0) Then
      
      PrintDocDC pd.hDC, sDocTitle
       '// Delete the printer DC.
       DeleteDC pd.hDC
       
       m_eProgressType = ercNone
   End If

End Sub

Private Function plAddressOf(ByVal lAddr As Long) As Long
    ' Why do we have to write nonsense like this?
    plAddressOf = lAddr
End Function
Public Property Get hwnd() As Long
   hwnd = UserControl.hwnd
End Property

Public Property Get RichEdithWnd() As Long
   RichEdithWnd = m_hWnd
End Property

Public Sub SetFocus()
   SetFocusAPI m_hWnd
End Sub

Private Sub pInitialise()
Dim dwStyle As Long
Dim dwExStyle As Long
Dim lS As Long
Dim hP As Long
Dim sLib As String
Dim sClass As String

    pTerminate

    If (UserControl.Ambient.UserMode) Then
        If (m_eVersion = eRICHED20) Then
            sLib = "RICHED20.DLL"
            sClass = RICHEDIT_CLASSA
        Else
            sLib = "RICHED32.DLL"
            sClass = RICHEDIT_CLASS10A
        End If
        m_hLib = LoadLibrary(sLib)
        If m_hLib <> 0 Then
            dwStyle = WS_CHILD Or WS_CLIPCHILDREN Or WS_CLIPSIBLINGS
            dwStyle = dwStyle Or WS_HSCROLL Or WS_VSCROLL
            dwStyle = dwStyle Or WS_TABSTOP
            dwStyle = dwStyle Or ES_MULTILINE Or ES_SAVESEL
            dwStyle = dwStyle Or ES_AUTOVSCROLL Or ES_AUTOHSCROLL
            dwStyle = dwStyle Or ES_SELECTIONBAR Or ES_NOHIDESEL
         
         If (m_bBorder) Then
            dwStyle = dwStyle Or ES_SUNKEN
            dwExStyle = WS_EX_CLIENTEDGE
         End If
         
         If (m_bTransparent) Then
            dwExStyle = dwExStyle Or WS_EX_TRANSPARENT
         End If
            
        '// Create the rich edit control.
        Set m_cTile = New cTile
         m_hWndParent = UserControl.hwnd
         m_hWndForm = UserControl.Parent.hwnd
         m_hWnd = CreateWindowEX( _
             dwExStyle, _
             sClass, _
             "", _
             dwStyle, _
             0, 0, UserControl.ScaleWidth \ Screen.TwipsPerPixelX,
              UserControl.ScaleHeight \ Screen.TwipsPerPixelY, _
             m_hWndParent, _
             0, _
             App.hInstance, _
             0)
         If (m_hWnd <> 0) Then
             EnableWindow m_hWnd, 1
             pAttachMessages
         End If
      End If
   End If
End Sub
Private Function pTerminate()
   If (m_hWnd <> 0) Then
      ' Remove printer DC from the
      ViewMode = ercDefault
      ' Stop subclassing:
      pDetachMessages
      ' Destroy the window:
      ShowWindow m_hWnd, SW_HIDE
      SetParent m_hWnd, 0
      DestroyWindow m_hWnd
      ' store that we haven't a window:
      m_hWnd = 0
      Set m_cTile = Nothing
   End If
   If (m_hLib <> 0) Then
       FreeLibrary m_hLib
       m_hLib = 0
   End If
End Function
Private Sub pAttachMessages()
Dim dwMask As Long
   m_emr = emrPreprocess
   
   AttachMessage Me, m_hWndForm, WM_ACTIVATE
   AttachMessage Me, m_hWndParent, WM_NOTIFY
   AttachMessage Me, m_hWndParent, WM_SETFOCUS
   AttachMessage Me, m_hWndParent, WM_PAINT
   AttachMessage Me, m_hWnd, WM_ERASEBKGND
   AttachMessage Me, m_hWnd, WM_SETFOCUS
   AttachMessage Me, m_hWnd, WM_MOUSEACTIVATE
   AttachMessage Me, m_hWnd, WM_VSCROLL
   AttachMessage Me, m_hWnd, WM_HSCROLL
   AttachMessage Me, m_hWnd, WM_DESTROY
    
    ' Key And Mouse Events
    dwMask = ENM_KEYEVENTS Or ENM_MOUSEEVENTS
    ' Selection change
    dwMask = dwMask Or ENM_SELCHANGE
    ' Update
    dwMask = dwMask Or ENM_DROPFILES
    ' Scrolling
    dwMask = dwMask Or ENM_SCROLL
    ' Update:
    dwMask = dwMask Or ENM_UPDATE
    If (m_eVersion = eRICHED20) Then
      ' Link over messages:
      dwMask = dwMask Or ENM_LINK
      ' Protected messages:
      dwMask = dwMask Or ENM_PROTECTED
    End If
    SendMessageLong m_hWnd, EM_SETEVENTMASK, 0, dwMask
    m_bSubClassing = True
End Sub
Private Sub pDetachMessages()
   If (m_bSubClassing) Then
      DetachMessage Me, m_hWndForm, WM_ACTIVATE
      DetachMessage Me, m_hWndParent, WM_NOTIFY
      DetachMessage Me, m_hWndParent, WM_SETFOCUS
      DetachMessage Me, m_hWndParent, WM_PAINT
      DetachMessage Me, m_hWnd, WM_ERASEBKGND
      DetachMessage Me, m_hWnd, WM_SETFOCUS
      DetachMessage Me, m_hWnd, WM_MOUSEACTIVATE
      DetachMessage Me, m_hWnd, WM_VSCROLL
      DetachMessage Me, m_hWnd, WM_HSCROLL
      DetachMessage Me, m_hWnd, WM_DESTROY
      m_bSubClassing = False
   End If
End Sub
Public Property Get AllowShortCut(ByVal eShortCut As
 ERECInbuiltShortcutConstants) As Boolean
   AllowShortCut = m_bAllowMethod(eShortCut)
End Property
Public Property Let AllowShortCut(ByVal eShortCut As
 ERECInbuiltShortcutConstants, ByVal bState As Boolean)
   m_bAllowMethod(eShortCut) = bState
End Property
Public Sub GetPageMargins( _
      ByRef lLeftMargin As Long, _
      ByRef lTopMargin As Long, _
      ByRef lRightMargin As Long, _
      ByRef lBottomMargin As Long _
   )
   lLeftMargin = m_lLeftMargin
   lTopMargin = m_lTopMargin
   lRightMargin = m_lRightMargin
   lBottomMargin = m_lBottomMargin
End Sub
Public Sub SetPageMargins( _
      Optional ByVal lLeftMargin As Long = 1800, _
      Optional ByVal lTopMargin As Long = 1800, _
      Optional ByVal lRightMargin As Long = 1440, _
      Optional ByVal lBottomMargin As Long = 1440 _
   )
   m_lLeftMargin = lLeftMargin
   m_lTopMargin = lTopMargin
   m_lRightMargin = lRightMargin
   m_lBottomMargin = lBottomMargin
   If (m_eViewMode = ercWYSIWYG) Then
      ' Reset the view to account for
      ' left & right margins:
      ViewMode = ercWordWrap
      ViewMode = ercWYSIWYG
   End If
End Sub
Public Property Let ControlRightMargin(ByVal lRightMarginPixels As Long)
   If (m_hWnd <> 0) Then
      SendMessageLong m_hWnd, EM_SETMARGINS, EC_RIGHTMARGIN, lRightMarginPixels
       * &H10000
      pSetViewMode m_eViewMode
   End If
   m_lRightMarginPixels = lRightMarginPixels
   PropertyChanged "ControlRightMargin"
End Property
Public Property Get ControlRightMargin() As Long
   ControlRightMargin = m_lRightMarginPixels
End Property
Public Property Let ControlLeftMargin(ByVal lLeftMarginPixels As Long)
   If (m_hWnd <> 0) Then
      SendMessageLong m_hWnd, EM_SETMARGINS, EC_LEFTMARGIN, lLeftMarginPixels
      pSetViewMode m_eViewMode
   End If
   m_lLeftMarginPixels = lLeftMarginPixels
   PropertyChanged "ControlLeftMargin"
End Property
Public Property Get ControlLeftMargin() As Long
   ControlLeftMargin = m_lLeftMarginPixels
End Property

Private Function pDoDefault( _
      ByRef iKeyCode As Integer, _
      ByRef iShift As Integer, _
      ByRef bDefault As Boolean _
   )
Dim tCF As CHARFORMAT

   ' Debug.Print iKeyCode
   If (iShift And vbCtrlMask) = vbCtrlMask Then
      Select Case iKeyCode
      
      ' Inbuilt methods:
      Case vbKeyC
         If Not (AllowShortCut(ercCopy_CtrlC)) Then
            bDefault = False
         End If
      Case vbKeyV
         If Not (AllowShortCut(ercPaste_CtrlV)) Then
            bDefault = False
         End If
      Case vbKeyX
         If Not (AllowShortCut(ercCut_CtrlX)) Then
            bDefault = False
         End If
      Case vbKeyA
         If Not (AllowShortCut(ercSelectAll_CtrlA)) Then
            bDefault = False
         End If
      Case vbKeyZ
         If Not (AllowShortCut(ercUndo_CtrlZ)) Then
            bDefault = False
         End If
      
      ' Supplied methods:
      Case vbKeyY
         If AllowShortCut(ercRedo_CtrlY) Then
            Redo
            bDefault = False
         End If
      Case vbKeyB
         If AllowShortCut(ercBold_CtrlB) Then
            pInvertFontOption CFM_BOLD, CFE_BOLD
            bDefault = False
         End If
      Case vbKeyI
         If AllowShortCut(ercItalic_CtrlI) Then
            pInvertFontOption CFM_ITALIC, CFE_ITALIC
            bDefault = False
         End If
      Case vbKeyU
         If AllowShortCut(ercUnderline_CtrlU) Then
            pInvertFontOption CFM_UNDERLINE, CFE_UNDERLINE
            bDefault = False
         End If
      Case vbKeyAdd, 187
         If AllowShortCut(ercSubscript_CtrlMinus) Then
            ' Debug.Print "Add"
            pInvertSubScriptOption 1
            bDefault = False
         End If
      Case vbKeySubtract, 189
         If AllowShortCut(ercSuperscript_CtrlPlus) Then
            ' Debug.Print "Subtract"
            pInvertSubScriptOption -1
            bDefault = False
         End If
      Case vbKeyP
         If AllowShortCut(ercPrint_CtrlP) Then
            PrintDoc m_sFileName
            bDefault = False
         End If
      Case vbKeyN
         If AllowShortCut(ercNew_CtrlN) Then
            Contents(SF_TEXT) = ""
         End If
      
      End Select
   End If

End Function
Private Sub pInvertSubScriptOption(ByVal lSelItem As Long)
Dim tCF As CHARFORMAT
Dim lR As Long

   tCF.dwMask = CFM_OFFSET
   tCF.cbSize = Len(tCF)
   lR = SendMessage(m_hWnd, EM_GETCHARFORMAT, 1, tCF)
      ' Debug.Print lR
   If (Abs(tCF.yOffset) = Abs(lSelItem)) Then
      tCF.yOffset = 0
   Else
      tCF.yOffset = Sgn(lSelItem)
   End If
   tCF.dwMask = CFM_OFFSET
   tCF.cbSize = Len(tCF)
   lR = SendMessage(m_hWnd, EM_SETCHARFORMAT, 1, tCF)
      ' Debug.Print lR
      
End Sub
Private Sub pInvertFontOption(ByVal lEffect As Long, ByVal lMask As Long)
Dim tCF As CHARFORMAT
Dim lR As Long

   tCF.dwEffects = lEffect
   tCF.dwMask = lMask
   tCF.cbSize = Len(tCF)
   lR = SendMessage(m_hWnd, EM_GETCHARFORMAT, (SCF_WORD Or SCF_SELECTION), tCF)
   If ((tCF.dwEffects And lEffect) = lEffect) Then
      tCF.dwEffects = 0
   Else
      tCF.dwEffects = lEffect
   End If
   tCF.dwMask = lMask
   tCF.cbSize = Len(tCF)
   lR = SendMessage(m_hWnd, EM_SETCHARFORMAT, (SCF_WORD Or SCF_SELECTION), tCF)
      ' Debug.Print lR
   
End Sub

Private Sub pDrawBackground(ByVal lHDC As Long, ByRef tR As RECT)
Dim hBr As Long
   If Not m_cTile.Picture Is Nothing Then
      m_cTile.TileArea lHDC, tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom -
       tR.Top
   Else
      hBr = CreateSolidBrush(TranslateColor(BackColor))
      FillRect lHDC, tR, hBr
      DeleteObject hBr
   End If
End Sub
Private Sub pClipScrollBars(ByRef tR As RECT)
Dim lS As Long
Dim bHorz As Boolean
Dim bVert As Boolean
Dim tWR As RECT
Dim lH As Long
Dim lW As Long

   ' This doesn't actually have the desired effect.
   ' Left in anyway in case I can work out how to do it
   ' properly.  See pRedrawScrollBars
   lS = GetWindowLong(m_hWnd, GWL_STYLE)
   bHorz = ((lS And WS_HSCROLL) = WS_HSCROLL)
   bVert = ((lS And WS_VSCROLL) = WS_VSCROLL)
   If bHorz Or bVert Then
      GetWindowRect m_hWnd, tWR
      If bHorz Then
         lH = GetSystemMetrics(SM_CYHSCROLL)
         If tR.Bottom - tR.Top > tWR.Bottom - tWR.Top - lH Then
            tR.Bottom = tR.Bottom - lH
         End If
      End If
      If bVert Then
         lW = GetSystemMetrics(SM_CXVSCROLL)
         If tR.Right - tR.Left > tWR.Right - tWR.Left - lW Then
            tR.Right = tR.Right - lW
         End If
      End If
   End If
   
End Sub
Private Sub pRedrawScrollBars()
Dim lS As Long
Dim bHorz As Boolean
Dim bVert As Boolean
Dim tR As RECT
Dim lH As Long
Dim lW As Long

   lS = GetWindowLong(m_hWnd, GWL_STYLE)
   bHorz = ((lS And WS_HSCROLL) = WS_HSCROLL)
   bVert = ((lS And WS_VSCROLL) = WS_VSCROLL)
   If bHorz Or bVert Then
      ' unsubtle, but on deadline:
      InvalidateRectAsNull m_hWndParent, 0&, 1
      UpdateWindow m_hWndParent
      InvalidateRectAsNull m_hWnd, 0&, 1
      UpdateWindow m_hWnd
   End If

End Sub
Private Property Let ISubclass_MsgResponse(ByVal RHS As EMsgResponse)
    '
End Property

Private Property Get ISubclass_MsgResponse() As EMsgResponse
   Select Case CurrentMessage
   Case WM_MOUSEACTIVATE, WM_ERASEBKGND, WM_PAINT
      ISubclass_MsgResponse = emrConsume
   Case Else
      ISubclass_MsgResponse = emrPreprocess
   End Select
End Property

Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long,
 ByVal wParam As Long, ByVal lParam As Long) As Long
Dim tNMH As NMHDR_RICHEDIT
Dim tSC As SELCHANGE
Dim tEN As ENLINK
Dim tMF As MSGFILTER
Dim tPR As ENPROTECTED
Dim tP As POINTAPI
Dim tR As RECT
Dim tPS As PAINTSTRUCT
Dim x As Single, y As Single
Dim iKeyCode As Integer, iKeyAscii As Integer, iShift As Integer
Dim bDefault As Boolean
Dim bDoIt As Boolean
Dim ID As Long
Dim bLock As Boolean

   Select Case iMsg
   Case WM_NOTIFY
      CopyMemory tNMH, ByVal lParam, Len(tNMH)
      If (tNMH.hwndFrom = m_hWnd) Then
         
         Select Case tNMH.code
         Case EN_SELCHANGE
            CopyMemory tSC, ByVal lParam, Len(tSC)
            RaiseEvent SelectionChange(tSC.chrg.cpMin, tSC.chrg.cpMax,
             tSC.seltyp)
            
         Case EN_LINK
            CopyMemory tEN, ByVal lParam, Len(tEN)
            RaiseEvent LinkOver(tEN.msg, tEN.chrg.cpMin, tEN.chrg.cpMax)
         
         Case EN_PROTECTED
            CopyMemory tPR, ByVal lParam, Len(tPR)
            bDoIt = False
            RaiseEvent ModifyProtected(bDoIt, tPR.chrg.cpMin, tPR.chrg.cpMax)
            If (bDoIt) Then
               ISubclass_WindowProc = 0
            Else
               ISubclass_WindowProc = 1
            End If
            
         Case EN_MSGFILTER
            bDefault = True
            CopyMemory tMF, ByVal lParam, Len(tMF)
            Select Case tMF.msg
            Case 515
               'Debug.Print "Double click", tMF.lParam, tMF.wPad2
               GetCursorPos tP
               ScreenToClient m_hWnd, tP
               x = tP.x * Screen.TwipsPerPixelX
               y = tP.y * Screen.TwipsPerPixelY
               RaiseEvent DblClick(x, y)
            Case 33
               iShift = giGetShiftState()
               GetCursorPos tP
               ScreenToClient m_hWnd, tP
               x = tP.x * Screen.TwipsPerPixelX
               y = tP.y * Screen.TwipsPerPixelY
               RaiseEvent MouseDown(x, y, iShift)
            Case 514
               iShift = giGetShiftState()
               GetCursorPos tP
               ScreenToClient m_hWnd, tP
               x = tP.x * Screen.TwipsPerPixelX
               y = tP.y * Screen.TwipsPerPixelY
               RaiseEvent MouseUp(x, y, iShift)
            Case 512
               iShift = giGetShiftState()
               GetCursorPos tP
               ScreenToClient m_hWnd, tP
               x = tP.x * Screen.TwipsPerPixelX
               y = tP.y * Screen.TwipsPerPixelY
               RaiseEvent MouseMove(x, y, iShift)
            Case 256
               iShift = giGetShiftState()
               iKeyCode = tMF.wParam
               RaiseEvent KeyDown(iKeyCode, iShift)
               If Not (pDoDefault(iKeyCode, iShift, bDefault)) Then
                  If (iKeyCode <> tMF.wParam) Then
                     bDefault = False
                  End If
               End If
            Case 258
               iShift = giGetShiftState()
               iKeyAscii = tMF.wParam
               ' Debug.Print iKeyAscii, iShift
               If Not (pDoDefault(iKeyAscii, iShift, bDefault)) Then
                  RaiseEvent KeyPress(iKeyAscii)
                  If (iKeyAscii <> tMF.wParam) Then
                     bDefault = False
                  End If
               End If
            Case 257
               iShift = giGetShiftState()
               iKeyCode = tMF.wParam
               RaiseEvent KeyUp(iKeyCode, iShift)
            Case Else
               ' Debug.Print "Something Different:", tMF.msg, tMF.wParam,
                tMF.lParam, tMF.wPad1, tMF.wPad2
            End Select
            If Not bDefault Then
               ' Debug.Print "No default.."
               ISubclass_WindowProc = 1&
            End If
         End Select
         
      End If
      
   Case WM_VSCROLL
      RaiseEvent VScroll
      
   Case WM_HSCROLL
      RaiseEvent HScroll
      
   '
    ----------------------------------------------------------------------------
   --
   ' Implement focus.  Many many thanks to Mike Gainer for showing me this
   ' code.
   Case WM_SETFOCUS
      If (m_hWnd = hwnd) Then
         ' The RichEdit control:
         Dim pOleObject                  As IOleObject
         Dim pOleInPlaceSite             As IOleInPlaceSite
         Dim pOleInPlaceFrame            As IOleInPlaceFrame
         Dim pOleInPlaceUIWindow         As IOleInPlaceUIWindow
         Dim pOleInPlaceActiveObject     As IOleInPlaceActiveObject
         Dim PosRect                     As RECT
         Dim ClipRect                    As RECT
         Dim FrameInfo                   As OLEINPLACEFRAMEINFO
         Dim grfModifiers                As Long
         Dim AcceleratorMsg              As msg
         
         'Get in-place frame and make sure it is set to our in-between
         'implementation of IOleInPlaceActiveObject in order to catch
         'TranslateAccelerator calls
         Set pOleObject = Me
         Set pOleInPlaceSite = pOleObject.GetClientSite
         If Not pOleInPlaceSite Is Nothing Then
            pOleInPlaceSite.GetWindowContext pOleInPlaceFrame,
             pOleInPlaceUIWindow, VarPtr(PosRect), VarPtr(ClipRect),
             VarPtr(FrameInfo)
            If m_IPAOHookStruct.ThisPointer <> 0 Then
               CopyMemory pOleInPlaceActiveObject,
                m_IPAOHookStruct.ThisPointer, 4
               If Not pOleInPlaceActiveObject Is Nothing Then
                  If Not pOleInPlaceFrame Is Nothing Then
                     pOleInPlaceFrame.SetActiveObject pOleInPlaceActiveObject,
                      vbNullString
                     If Not pOleInPlaceUIWindow Is Nothing Then
                        pOleInPlaceUIWindow.SetActiveObject
                         pOleInPlaceActiveObject, vbNullString
                     End If
                  End If
               End If
               CopyMemory pOleInPlaceActiveObject, 0&, 4
            End If
         End If
      Else
         ' THe user control:
         SetFocusAPI m_hWnd
      End If
      
   Case WM_MOUSEACTIVATE
      If GetFocus() <> m_hWnd Then
         SetFocusAPI m_hWndParent
         ISubclass_WindowProc = MA_NOACTIVATE
      Else
         ISubclass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
      End If
   ' End Implement focus.
   '
    ----------------------------------------------------------------------------
   --
   
   
   Case WM_ERASEBKGND
      If m_bTransparent Then
         GetClientRect hwnd, tR
         pClipScrollBars tR
         pDrawBackground wParam, tR
         ISubclass_MsgResponse = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
      Else
         ISubclass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
      End If
   
   Case WM_PAINT
      If m_bTransparent Then
         BeginPaint hwnd, tPS
         pClipScrollBars tPS.rcPaint
         pDrawBackground tPS.hDC, tPS.rcPaint
         EndPaint hwnd, tPS
         ISubclass_MsgResponse = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
      Else
         ISubclass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
      End If
      
   Case WM_ACTIVATE
      If m_bTransparent Then
         If wParam > 0 Then
            pRedrawScrollBars
         End If
      End If
   
   Case WM_DESTROY
      pTerminate
   
   End Select
      
End Function


Private Sub UserControl_Initialize()
Dim i As Long
   Debug.Print "RichEditControl:Initialise"
   ' Trap tab key:
   m_bTrapTab = True
   ' Default printing margins for an RTF file:
   m_lLeftMargin = 1800
   m_lRightMargin = 1800
   m_lTopMargin = 1440
   m_lBottomMargin = 1440
   ' Default to the simplistic version of RichEdit:
   m_eVersion = eRICHED32
   ' Redraw the control:
   m_bRedraw = True
   ' Allow all in-built shortcuts:
   For i = ERECInbuiltShortcutConstants.[_First] To
    ERECInbuiltShortcutConstants.[_Last]
      m_bAllowMethod(i) = True
   Next i
   lblText.Caption = "vbAccelerator Rich Edit Control"
   ' Default text limit
   m_lLimit = 32767
   ' Attach custom IOleInPlaceActiveObject interface
   Dim IPAO As IOleInPlaceActiveObject

   With m_IPAOHookStruct
      Set IPAO = Me
      CopyMemory .IPAOReal, IPAO, 4
      CopyMemory .TBEx, Me, 4
      .lpVTable = IPAOVTable
      .ThisPointer = VarPtr(m_IPAOHookStruct)
   End With
   
End Sub

Private Sub UserControl_InitProperties()
    pInitialise
    m_eCharFormatRange = ercSetFormatAll
    Set Font = UserControl.Ambient.Font
    m_eCharFormatRange = ercSetFormatSelection
End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    Debug.Print KeyCode
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
   If (UserControl.Ambient.UserMode) Then
      m_eVersion = PropBag.ReadProperty("Version", eRICHED32)
   Else
      UseVersion = PropBag.ReadProperty("Version", eRICHED32)
   End If
   m_bBorder = PropBag.ReadProperty("Border", True)
   Transparent = PropBag.ReadProperty("Transparent", False)
   pInitialise
   Border = m_bBorder
   m_eCharFormatRange = ercSetFormatSelection
   Dim sFnt As New StdFont
   On Error Resume Next
   Set Font = PropBag.ReadProperty("Font")
   Err.Clear
   On Error GoTo 0
   m_eCharFormatRange = ercSetFormatSelection

   BackColor = PropBag.ReadProperty("BackColor", vbWindowBackground)
   ForeColor = PropBag.ReadProperty("ForeColor", vbWindowText)
   Text = PropBag.ReadProperty("Text", "")
   ViewMode = PropBag.ReadProperty("ViewMode", ercWordWrap)
   ControlLeftMargin = PropBag.ReadProperty("ControlLightMargin", 0)
   ControlRightMargin = PropBag.ReadProperty("ControlRightMargin", 0)
   TextLimit = PropBag.ReadProperty("TextLimit", 32767)
   TrapTab = PropBag.ReadProperty("TrapTab", True)
   If (UserControl.Ambient.UserMode) Then
      lblText.Visible = False
   Else
      lblText.Visible = True
   End If
   If m_eVersion = eRICHED20 Then
      AutoURLDetect = PropBag.ReadProperty("AutoURLDetect", True)
   Else
      m_bAutoURLDetect = PropBag.ReadProperty("AutoURLDetect", True)
   End If
   ReadOnly = PropBag.ReadProperty("ReadOnly", False)
End Sub

Private Sub UserControl_Resize()
Dim tR As RECT
   If (m_hWnd <> 0) Then
      GetClientRect m_hWndParent, tR
      MoveWindow m_hWnd, 0, 0, tR.Right - tR.Left, tR.Bottom - tR.Top,
       Abs(m_bRedraw)
      tR.Left = m_lLeftMarginPixels
      tR.Right = UserControl.ScaleWidth \ Screen.TwipsPerPixelX -
       m_lRightMarginPixels
      If (tR.Right < tR.Left) Then tR.Right = tR.Left
      tR.Top = 4
      tR.Bottom = UserControl.ScaleHeight \ Screen.TwipsPerPixelY
      'Redraw = False
      SendMessage m_hWnd, EM_SETRECT, 0, tR
      ControlLeftMargin = m_lLeftMarginPixels
      ControlRightMargin = m_lRightMarginPixels
      'Redraw = True
   Else
      lblText.Move 4 * Screen.TwipsPerPixelX, 4 * Screen.TwipsPerPixelY,
       UserControl.ScaleWidth - 4 * Screen.TwipsPerPixelX,
       UserControl.ScaleHeight - 4 * Screen.TwipsPerPixelY
   End If
End Sub

Private Sub UserControl_Terminate()
   
   ' Destroy the control & clear up:
   pTerminate
   
   ' Detach the custom IOleInPlaceActiveObject interface
   ' pointers.
   With m_IPAOHookStruct
      CopyMemory .IPAOReal, 0&, 4
      CopyMemory .TBEx, 0&, 4
   End With

   Debug.Print "RichEditControl:Terminate"

End Sub


Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
   ' Write properties:
   PropBag.WriteProperty "Version", UseVersion, eRICHED32
   m_eCharFormatRange = ercSetFormatAll
   PropBag.WriteProperty "Font", Font
   PropBag.WriteProperty "BackColor", BackColor, vbWindowBackground
   PropBag.WriteProperty "ForeColor", ForeColor, vbWindowText
   PropBag.WriteProperty "Text", m_sText, ""
   PropBag.WriteProperty "ViewMode", ViewMode
   PropBag.WriteProperty "Border", Border, True
   PropBag.WriteProperty "ControlLeftMargin", m_lLeftMarginPixels, 0
   PropBag.WriteProperty "ControlRightMargin", m_lRightMarginPixels, 0
   PropBag.WriteProperty "TextLimit", TextLimit, 32767
   PropBag.WriteProperty "TrapTab", TrapTab, True
   PropBag.WriteProperty "AutoURLDetect", AutoURLDetect, True
   PropBag.WriteProperty "ReadOnly", ReadOnly, False
   PropBag.WriteProperty "Transparent", Transparent, False
End Sub