您所在位置：主题：富文本框一拖即开、一拖即存以及拖放编辑的代码
一江秋水
[专家分：9680] 发布于 2020-05-09 15:55:45
富文本框一拖即开、一拖即存以及拖放编辑的代码
本代码有３个功能：
1.一拖即开：可以将rtf文件、txt文本以及其它文本文件拖放到文本框并打开，如果是多个文本文件，就进行文本合并。操作时会出现一个带加号的小框。
2.一拖即存：用鼠标选定一段文本，先按住【Ctrl】键，再用鼠标按住按选定的文本拖至窗口外，该段文本保存到桌面上为一个txt文件（文件名后面有可以连续递增的序数，让用户可以保存多个这样的小文本文件）。代码中用到了一个检测鼠标位置的API函数 GetCursorPos。该函数只有一个参数，即POINTAPI结构，它用于检测选中的文本是否拖出了窗体。
3.拖放编辑：相当于将“剪切”和“粘贴”两个编辑功能合并了，并且不但能在本窗口内拖放字符串文本，还能将别的程序窗口中的文本拖到本窗口来。操作时先选定一段文本，用鼠标按住在窗口内移动，鼠标尖处会出现一个虚线长方框，移动到位松开鼠标即可。
新建一个窗体，在窗体上添加一个富文本框（RichTextBox控件），一个按纽和一个计时器。
属性设置：
富文本框：ScrollBars＝2，MultiLine＝True
计时器：Enabled＝False，Interval＝200
按纽：Caption＝“拖放模式”
代码如下：
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Dim dropMode As Boolean '拖放模式：0-拖放编辑，1-拖放文件
Dim fName As String '文件名
Dim st1 As String, fNum As Integer
Private Sub Form_Load()
RichTextBox1.OLEDropMode = 2
Command1.ToolTipText = "拖放编辑"
End Sub
Private Sub Command1_Click()
dropMode = Not dropMode
Command1.ToolTipText = IIf(dropMode, "拖放文件", "拖放编辑")
RichTextBox1.OLEDropMode = IIf(dropMode, 1, 2)
RichTextBox1.SetFocus
End Sub
Private Sub RichTextBox1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Shift = 2 Then Timer1.Enabled = True
End Sub
Private Sub RichTextBox1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Timer1.Enabled = False
End Sub
Private Sub RichTextBox1_OLEDragOver(Data As RichTextLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
On Error GoTo 100
Effect = IIf(InStr("RTF,TXT,LOG,HTM,INI,REG", Right(UCase(Data.Files.Item(1)), 3)), 1, 0) '文件后缀是例举的就显示可以放下的带加号图标，否则显示不可放下的圆圈加斜线的图标
100
End Sub
Private Sub RichTextBox1_OLEDragDrop(Data As RichTextLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo 100
Effect = 1
fName = Data.Files.Item(1)
If UCase(Right(fName, 3)) = "RTF" Then
RichTextBox1.LoadFile fName
Else
Dim st2 As String, z As String, i As Integer
For i = 1 To Data.Files.Count
st1 = ""
fName = Data.Files.Item(i)
Open fName For Input As #1
Do Until EOF(1)
Line Input #1, z
st1 = st1 & z & vbCrLf
Loop
Close #1
st2 = st2 & st1
Next
RichTextBox1.Text = st2
End If
100
End Sub
Private Sub Timer1_Timer()
Dim PO As POINTAPI, Ws
GetCursorPos PO '检测鼠标位置
If (PO.x < Left \ 15 Or PO.x > (Left + Width) \ 15 Or PO.y < Top \ 15 Or PO.y > (Top + Height) \ 15) And RichTextBox1.SelLength > 0 Then '如果剪贴板不为空，并且鼠标移出窗体外
Set Ws = CreateObject("WScript.Shell")
st1 = Ws.SpecialFolders("Desktop") '获取桌面路径
Set Ws = Nothing
fNum = fNum + 1: fName = st1 & "\快存(" & Format(fNum, "00") & ").txt" '添加序号作为新文件名
Open fName For Output As #2
Print #2, RichTextBox1.SelText
Close #2
Timer1.Enabled = False
End If
End Sub
简要分析：
1.操作
程序开始时，默认为拖放编辑，点击按纽就改变为一拖即开。一拖即存与按纽的拖放模式无关。
2.事件
以上代码中，富文本框的OLEDragOver事件和OLEDragDrop事件处理一拖即开，鼠标事件和计时器事件处理一拖即存。其中：
OLEDragOver事件判断拖来的文件是否rtf文件、txt文件或其它文本文件。
OLEDragDrop事件将文件打开，如果是文本文件就进行合并（rtf文件也可进行合并，但处理起来较复杂，本文不赘述）。
Timer1_Timer事件判断如果鼠标移出窗口，就将选定文本保存。其中的有关数据除以15的目的是保持计量单位的统一（API函数用“像素”，VB默认用“缇”，1像素＝15缇）。
3.参数
富文本框OLEDragOver事件和OLEDragDrop事件中的Effect参数有３个值：
0—不接受数据，常用。
1—接受数据，且初始数据没有被拖放操作改动，常用。
2—接受数据，但拖动后，拖放源要被删去数据，极少使用。
4.属性
富文本框的OLEDropMode属性决定了是拖放编辑还是一拖即开，它有３个值：
0—不接受任何拖放操作。
1—允许用代码处理拖放操作，一拖即开必须设置为此值。
2—自动接受拖放操作，允许窗口内的数据移动，拖放编辑必须设置为此值。
如果你想坐享其成，可以去163信箱下载实例，帐号：vb62013，密码：vb620132013。