#include Once "afx/AfxRichEdit.inc"
Type Class_RichEdit Extends Class_Control
Private : 
     hMenuRT As HMENU '右键菜单
Public : 
   Declare Constructor
   Declare Destructor
   Declare Property Text() As CWStr                '返回/设置控件中的普通文本
   Declare Property Text(sText As CWStr)
   Declare Property TextRtf() As String                '返回/设置控件中的RTF格式文本
   Declare Property TextRtf(sText As String)
   Declare Function GetLineCount() As Long '检索一个多行文本框中的行数。如果没有文本存在，则返回值为 1。
   Declare Function GetLine(nLine As Long) As CWStr '获取TextBox 控件某行的文本 。行的索引从零开始。
   Declare Property MaxLength() As Long                 '返回/设置当前的文本长度限制，以字符为单位。。默认限制是64,000个字符
   Declare Property MaxLength(MaxCharacters As Long)
   Declare Sub SelClear() '清除（删除）当前所选内容。
   Declare Sub SelCopy() ' 复制当前所选内容，并放置在剪贴板。
   Declare Sub SelCut() ' 剪切当前所选内容，并放置在剪贴板。
   Declare Sub Paste() ' 粘贴剪贴板中的到当前位置，有选择将替换选择。
   Declare Sub PopMenu() '弹出常用功能菜单，通常用于右键菜单
   Declare Function CanUndo() As Long ' 是否有撤消 ,如果撤消队列为空，则返回值为零，如果撤消队列中有操作，则返回值不为零。
   Declare Function CanRedo() As Long ' 是否有重做 ,如果重做队列为空，则返回值为零，如果重做队列中有操作，则返回值不为零。
   Declare Function Undo() As Long ' 撤消 ,对于单行编辑控件，返回值始终为非零值。对于多行编辑控件，如果撤消操作成功则返回值为非零值;如果撤销操作失败，则返回值为零。
   Declare Function Redo() As Long ' 重做 ,如果Redo操作成功，返回值是一个非零值。如果Redo操作失败，返回值为零。
   
   Declare Sub ReplaceText(TheText As CWStr) ' 当前所选内容替换成指定的文本。
   Declare Sub Scroll(nScrollFlag As Long) ' 滚动多行文本框中的文本。{1.SB_LINEDOWN 滚动下移一行。.SB_LINEUP 滚动一行。.SB_PAGEDOWN 滚动下移一页。.SB_PAGEUP 滚动一页。}
   
   Declare Property MarginLeft() As Long '设置 左侧的边距(不支持获取，获取=0,MSDN也这么说)
   Declare Property MarginLeft(nLeftMargin As Long)
   Declare Property MarginRight() As Long '设置 右侧的边距 (不支持获取，获取=0,MSDN也这么说)
   Declare Property MarginRight(nRightMargin As Long)
   Declare Property Modify() As Boolean '返回/设置文本框已被修改标志。{=.True.False}
   Declare Property Modify(nFlagValue As Boolean)
   Declare Property SelStart() As Long '返回/设置当前所选内容在文本框中的起始字符位置。XP系统无效
   Declare Property SelStart(Value As Long)
   Declare Property SelEnd() As Long '返回/设置文本框中当前所选内容的结束字符位置。XP系统无效
   Declare Property SelEnd(Value As Long)
   Declare Function SetSel(nStartPos As Long, nEndPos As Long) As Long ' 设置选择某个范围的字符(当前所选字符)。XP系统无效
   Declare Function TextLength() As Long '返回文本的长度
   Declare Property AutoURLDetect() As Boolean '返回/设置启用或禁用富编辑控件自动检测超链接(默认不检查)。{=.True.False}
   Declare Property AutoURLDetect(Value As Boolean)
   Declare Property EditStyle() As Long '返回/设置 编辑样式。有18种组合，详细看MSDN，
   Declare Property EditStyle(fStyle As Long)
   Declare Property EditStyleEx() As Long '返回/设置 编辑更多样式（WIN8 系统）。有8种组合，详细看MSDN，
   Declare Property EditStyleEx(fStyleEx As Long)
    Declare Property Locked() As Boolean '返回/设置是否锁住内容，上锁后用户不可以修改，代码还是可以修改的{=.True 上锁，不可以编辑.False 没锁，可以编辑}
    Declare Property Locked(nValue As Boolean) 
End Type

'----------------------------------------------------------------------------------------------------------------------------------------------------------------
Constructor Class_RichEdit
   '注意：由于窗口类是永久的，全局变量，因此为了可以完成特殊功能，Constructor 和 Destructor 会重复执行
   '1，开启软件后创建了窗口类，执行1次 Constructor
   '2，每 xxForm.Show 就执行1次 Constructor
   '3，每次窗口销毁  就执行1次 Destructor  ，多次显示和关窗口就重复 2，3 操作
   '4，退出软件  执行1次 Destructor
   if hMenuRT = 0 Then
      hMenuRT = CreatePopupMenu()
      AppendMenu hMenuRT, MF_STRING, 8800, "复制(&C)"
      AppendMenu hMenuRT, MF_STRING, 8801, "剪切(&T)"
      AppendMenu hMenuRT, MF_SEPARATOR, 0, Null
      AppendMenu hMenuRT, MF_STRING, 8802, "粘贴(&P)"
      AppendMenu hMenuRT, MF_SEPARATOR, 0, Null
      AppendMenu hMenuRT, MF_STRING, 8803, "撤销(&U)"
      AppendMenu hMenuRT, MF_STRING, 8804, "重做(&R)"
   End if
End Constructor

Destructor Class_RichEdit
   if hMenuRT Then 
      DestroyMenu hMenuRT 
      hMenuRT = 0
   End if  
End Destructor
   
Property Class_RichEdit.Text() As CWStr                '返回/设置控件中的普通文本
  Return AfxGetWindowText(hWndControl)
End Property
Property Class_RichEdit.Text(sText As CWStr)
  AfxSetWindowText  hWndControl, sText
End Property
Property Class_RichEdit.TextRtf() As String                '返回/设置控件中的RTF格式文本
  Return RichEdit_GetRtfText(hWndControl)
End Property
Property Class_RichEdit.TextRtf(sText As String)  
  Dim bb As SETTEXTEX 
  bb.flags = ST_NEWCHARS
  bb.codepage = CP_ACP
  SendMessageA( hWndControl , EM_SETTEXTEX ,Cast(wParam, @bb) ,Cast(lParam, StrPtr(sText)) )
End Property
Function Class_RichEdit.GetLineCount () As Long '检索一个多行文本框中的行数。如果没有文本存在，则返回值为 1。
  Function = SendMessage(hWndControl, EM_GETLINECOUNT, 0, 0)
End Function
Function Class_RichEdit.GetLine (nLine As Long) As CWStr '获取TextBox 控件某行的文本 。行的索引从零开始。
    Function = RichEdit_GetLine(hWndControl,nLine)
End Function
Property Class_RichEdit.MaxLength() As Long                 '返回/设置当前的文本长度限制，以字符为单位。
  Return SendMessage(hWndControl, EM_GETLIMITTEXT, 0, 0)
End Property
Property Class_RichEdit.MaxLength(MaxCharacters As Long)
  SendMessage hWndControl, EM_SETLIMITTEXT, MaxCharacters, 0
End Property

Sub Class_RichEdit.SelClear () '清除（删除）当前所选内容。
    SendMessage hWndControl, WM_CLEAR, 0, 0
End Sub
Sub Class_RichEdit.SelCopy () ' 复制当前所选内容，并放置在剪贴板。
    SendMessage hWndControl, WM_COPY, 0, 0
End Sub
Sub Class_RichEdit.SelCut () ' 剪切当前所选内容，并放置在剪贴板。
    SendMessage hWndControl, WM_CUT, 0, 0
End Sub
Sub Class_RichEdit.Paste () ' 粘贴剪贴板中的到当前位置，有选择将替换选择。
    SendMessage hWndControl, WM_PASTE, 0, 0
End Sub
Sub Class_RichEdit.ReplaceText (TheText As CWStr) ' 当前所选内容替换成指定的文本。
    SendMessageW hWndControl, EM_REPLACESEL, True, Cast(lParam, TheText.vptr)
End Sub
Sub Class_RichEdit.Scroll (nScrollFlag As Long) ' 滚动多行文本框中的文本。
    SendMessage hWndControl, EM_SCROLL, nScrollFlag, 0
End Sub


Property Class_RichEdit.Modify() As Boolean '返回/设置文本框已被修改标志。{=.True.False}
  Property = SendMessage(hWndControl, EM_GETMODIFY, 0, 0)
End Property
Property Class_RichEdit.Modify(nFlagValue As Boolean)
    SendMessage(hWndControl, EM_SETMODIFY, nFlagValue, 0)
End Property
Property Class_RichEdit.MarginLeft() As Long '返回/设置 左侧的边距
    Property = LoWord(SendMessage(hWndControl, EM_GETMARGINS, 0, 0))
End Property
Property Class_RichEdit.MarginLeft(nLeftMargin As Long)
  SendMessage hWndControl, EM_SETMARGINS,  EC_LEFTMARGIN ,nLeftMargin
End Property
Property Class_RichEdit.MarginRight() As Long '返回/设置 右侧的边距
  Property = HiWord(SendMessage(hWndControl, EM_GETMARGINS, 0, 0))
End Property
Property Class_RichEdit.MarginRight(nRightMargin As Long)
    SendMessage hWndControl, EM_SETMARGINS,   EC_RIGHTMARGIN, nRightMargin
End Property
Property Class_RichEdit.SelStart() As Long '检索当前所选内容在文本框中的起始字符位置。
    Dim nStartPos As Long, nEndPos As Long
    SendMessage(hWndControl, EM_GETSEL, Cast(wParam,@nStartPos),Cast(lParam,@nEndPos))
    Property = nStartPos
End Property
Property Class_RichEdit.SelStart(Value As Long)
  This.SetSel Value, This.SelEnd
End Property
Property Class_RichEdit.SelEnd() As Long '检索文本框中当前所选内容的结束字符位置。
    Dim nStartPos As Long, nEndPos As Long
    SendMessage(hWndControl, EM_GETSEL, Cast(wParam,@nStartPos),Cast(lParam,@nEndPos))
  Property = nEndPos
End Property
Property Class_RichEdit.SelEnd(Value As Long)
    This.SetSel This.SelStart, Value
End Property
Function Class_RichEdit.SetSel(nStartPos As Long, nEndPos As Long) As Long ' 设置选择某个范围的字符。
    Function = SendMessage( hWndControl, EM_SETSEL, nStartPos, nEndPos)
End Function
Function Class_RichEdit.TextLength() As Long '返回文本的长度
    Function = GetWindowTextLength(hWndControl)
End Function
Property Class_RichEdit.AutoURLDetect() As Boolean '返回/设置启用或禁用富编辑控件自动检测超链接(默认不检查)。{=.True.False}
  Property = SendMessage(hWndControl, EM_GETAUTOURLDETECT, 0,0)
End Property
Property Class_RichEdit.AutoURLDetect(Value As Boolean) 
   If Value Then
      SendMessage( hWndControl, EM_AUTOURLDETECT, AURL_ENABLEEA, Null)
   Else 
     SendMessage( hWndControl, EM_AUTOURLDETECT, 0, Null)
   End If
End Property
Property Class_RichEdit.EditStyle() As Long '返回/设置 编辑样式。有18种组合，详细看MSDN，
  Property = SendMessage(hWndControl, EM_GETEDITSTYLE, 0,0)
End Property
Property Class_RichEdit.EditStyle(fStyle As Long)   
     SendMessage( hWndControl, EM_SETEDITSTYLE, fStyle, 0)
End Property
Property Class_RichEdit.EditStyleEx() As Long '返回/设置 编辑更多样式（WIN8 系统）。有8种组合，详细看MSDN，
  Property = SendMessage(hWndControl, WM_USER + 276, 0,0)
End Property
Property Class_RichEdit.EditStyleEx(fStyleEx As Long) 
     SendMessage( hWndControl, WM_USER + 275, fStyleEx, 0)
End Property
Function Class_RichEdit.CanUndo() As Long ' 是否有撤消 ,如果撤消队列为空，则返回值为零，如果撤消队列中有操作，则返回值不为零。
    Function = SendMessage( hWndControl, EM_CANUNDO, 0, 0)
End Function
Function Class_RichEdit.CanRedo() As Long ' 是否有重做 ,如果重做队列为空，则返回值为零，如果重做队列中有操作，则返回值不为零。
    Function = SendMessage( hWndControl, EM_CANREDO, 0, 0)
End Function
Function Class_RichEdit.Undo() As Long ' 撤消 ,对于单行编辑控件，返回值始终为非零值。对于多行编辑控件，如果撤消操作成功则返回值为非零值;如果撤销操作失败，则返回值为零。
    Function = SendMessage( hWndControl, EM_UNDO, 0, 0)
End Function
Function Class_RichEdit.Redo() As Long ' 重做 ,如果Redo操作成功，返回值是一个非零值。如果Redo操作失败，返回值为零。
    Function = SendMessage( hWndControl, EM_REDO, 0, 0)
End Function
Sub Class_RichEdit.PopMenu()
 Dim P As Point
 Dim mType As MenuItemInfo
 GetCursorPos @p
 mType.cbSize = SizeOf(mType)
 mType.fMask = MIIM_STATE
 If CanUndo Then mType.fState = MFS_ENABLED Else mType.fState = MFS_DISABLED
 SetMenuItemInfo(hMenuRT, 8803, False, @mType)
 If CanRedo Then mType.fState = MFS_ENABLED Else mType.fState = MFS_DISABLED
 SetMenuItemInfo(hMenuRT, 8804, False, @mType)
 Select Case TrackPopupMenu(hMenuRT, TPM_RETURNCMD, p.x, p.y, 0, GetParent(hWndControl), Null) '比方说弹出菜单
    Case 8800 ',"复制"
       SelCopy
    Case 8801 ',"剪切"
       SelCut
    Case 8802 ', "粘贴"
       Paste
    Case 8803 ', "撤销"
       Undo
    Case 8804 ', "重做"
       Redo
 End Select
End Sub
Property Class_RichEdit.Locked() As Boolean
    return  (AfxGetWindowStyle(hWndControl) and ES_READONLY) <>0
End Property
Property Class_RichEdit.Locked(nValue As Boolean)
   SendMessage(hWndControl, EM_SETREADONLY, nValue, 0)
End Property