我想实现这样一个功能?
有一个文本文件,当我输入一个字或词组时,可以将这个文本中所有含该词的句子取出来,并连词带句子一起输出来。
不知小妹是否讲述清楚?例子如下:
如下一段文本:
“美国康乃尔大学一项研究发现,爱情是大脑中的巴胺、苯乙胺及催产素等综合而成的鸡尾酒式「缠绵化学物质」发挥作用,一旦人体对这类化学物质产生抗体,其缠绵功能便会失效,因此,男女真爱最长只能维持三十个月。据香港《太阳报》报导,康乃尔大学教授哈赞两年来针对三十七个不同文化的五千对夫妇进行了调查,结果发现,十八个至三十个月的时间已经足够让男女相识、约会、结合和生儿育女,之後双方都不会再对彼此产生心跳加速和冒汗的情况。哈赞说,爱情其实是大脑中的「化学鸡尾酒」发生作用,之後男女要不分手,要不让爱变成习惯,即使有了孩子,「鸡尾酒」也不会再起作用。研究也显示,男性通常比较容易坠入爱河。哈赞说,爱情其实是一种精神状态,两、三年後爱情走了,但男女可能仍喜欢对方,有人仍可成功跨越三十个月的爱情,维持婚姻超过五十年。有人认为,两人最好一起生活一到两年,这样便能知道对方是否适合和自己生活一辈子。”当输入“爱情“时
输出:爱情美国康乃尔大学一项研究发现,爱情是大脑中的巴胺、苯乙胺及催产素等综合而成的鸡尾酒式「缠绵化学物质」发挥作用,一旦人体对这类化学物质产生抗体,其缠绵功能便会失效,因此,男女真爱最长只能维持三十个月。哈赞说,爱情其实是大脑中的「化学鸡尾酒」发生作用,之後男女要不分手,要不让爱变成习惯,即使有了孩子,「鸡尾酒」也不会再起作用。哈赞说,爱情其实是一种精神状态,两、三年後爱情走了,但男女可能仍喜欢对方,有人仍可成功跨越三十个月的爱情,维持婚姻超过五十年。输入其他字或词也是一样。非常感谢!!

解决方案 »

  1.   

    关于矩形和圆形都要调用API函数,其实不太难的
    下面是矩形的代码,不过是画在窗体中的,你自己加一个picture控件,把画在窗体中的代码改在picture控件中就行了:
    Option Explicit
    Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Type RECT
            Left As Long
            Top As Long
            Right As Long
            Bottom As Long
    End Type
    Dim flag As Boolean
    Dim hdc1 As Long
    Dim pos As RECT
    Dim handle As Long
    Dim X1 As Long
    Dim x2 As Long
    Dim y2 As Long
    Dim Y1 As Long
    Public Function small(ByVal a, ByVal b)
    small = a
    If a < b Then small = a
    If b < a Then small = bEnd FunctionPrivate Sub Form_Load()
    flag = False
        Me.ScaleMode = 3
    Me.AutoRedraw = True
    Form1.Shape1.Visible = False
    End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    flag = True
    pos.Left = X
    pos.Top = Y
     X1 = X
        Y1 = Y
    End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (flag) Then
    pos.Right = X
    pos.Bottom = Y
    Shape1.Visible = True
        Shape1.Top = small(Y1, Y)
        Shape1.Left = small(X1, X)
        Shape1.Width = Abs(X - X1)
        Shape1.Height = Abs(Y - Y1)
    End If
    End SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (flag) Then
    pos.Right = X
    pos.Bottom = Y
    Rectangle Me.hdc, pos.Left, pos.Bottom, pos.Right, pos.Top
    flag = False
    End If
    End Sub
    下面是圆形的代码,不过是画在窗体中的,你自己加一个picture控件,把画在窗体中的代码改在picture控件中就行了:
    Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
    Dim flag As Boolean
    Dim hdc1 As Long
    Dim X1 As Long
    Dim x2 As Long
    Dim y2 As Long
    Dim Y1 As LongPrivate Sub Form_Load()
    flag = True
     Me.AutoRedraw = False
     Me.ScaleMode = 3
        Me.DrawWidth = 1
    End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    X1 = X
    Y1 = Y
    End SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    x2 = X
    y2 = Y
    Me.ForeColor = vbRed
    Ellipse Me.hdc, X1, Y1, x2, y2
    End Sub
      

  2.   

    Option ExplicitPrivate Function getline(str As String, findstr As String) As String
    Dim i As Integer, temp() As String
    getline = ""
    temp = Split(str, "。")
    For i = 0 To UBound(temp)
        If InStr(1, str, findstr) > 1 Then
           getline = getline + temp(i) + "。" + vbCrLf
        End If
    Next
    getline = Left(getline, Len(getline) - 5)
    End FunctionPrivate Sub Text1_Change()
    Dim s As String, s1 As String
    s = "美国康乃尔大学一项研究发现,爱情是大脑中的巴胺、苯乙胺及催产素等综合而成的鸡尾酒式「缠绵化学物质」发挥作用,一旦人体对这类化学物质产生抗体,其缠绵功能便会失效,因此,男女真爱最长只能维持三十个月。据香港《太阳报》报导,康乃尔大学教授哈赞两年来针对三十七个不同文化的五千对夫妇进行了调查,结果发现,十八个至三十个月的时间已经足够让男女相识、约会、结合和生儿育女,之後双方都不会再对彼此产生心跳加速和冒汗的情况。哈赞说,爱情其实是大脑中的「化学鸡尾酒」发生作用,之後男女要不分手,要不让爱变成习惯,即使有了孩子,「鸡尾酒」也不会再起作用。研究也显示,男性通常比较容易坠入爱河。哈赞说,爱情其实是一种精神状态,两、三年後爱情走了,但男女可能仍喜欢对方,有人仍可成功跨越三十个月的爱情,维持婚姻超过五十年。有人认为,两人最好一起生活一到两年,这样便能知道对方是否适合和自己生活一辈子。"
    s1 = Text1.Text
    Text2.Text = getline(s, s1)
    End Sub
      

  3.   

    注意,要设定text2为多行文本
      

  4.   

    有数据库来操作最快最好like就行了
      

  5.   

    首先你应该知道:
    1,什么是词
    2,什么是句子
        找到词不难:枚举全部行,用instr函数就可以判断有没有。
        输出句子也不难:从发现词的位置向前找到句号,向后找到句号,这之间的就是拉!
    我一会帮你做哦,小妹!!wait for me and trust me!
      

  6.   

    在窗体上放一个按钮,一个CommonDialog1,两个text,
    还要在引用里引上
    microsoft scripting runtime
    Private Sub Command1_Click()
    Dim Mystr As String
    Dim i As Integer
    Dim a As Integer
    Dim fso As New FileSystemObject
    Dim txtfile As File
    Dim fil1 As File
    Dim ts As TextStreamCommonDialog1.ShowOpen
        Set txtfile = fso.OpenTextFile(CommonDialog1.FileName)
        Set fil1 = fso.GetFile(CommonDialog1.FileName)
        Set ts = fil1.OpenAsTextStream(ForReading)
            If ts.AtEndOfLine Then
                 MsgBox "结尾"
            Else
                     Do While Not ts.AtEndOfStream
                        ' 读取文件的内容。
                         Mystr = Trim(ts.ReadLine)
                         MyArray = Split(Mystr, "。")
                         For i = 0 To UBound(MyArray) - 1
                             If InStr(MyArray(i), Text1.Text) > 0 Then
                                 Text2.Text = Text2.Text & MyArray(i) & "。" & vbCrLf & vbCrLf
                             End If
                         Next
                     Loop
            End If
        ts.Close
    End Sub
    以上代码测试好使,小妹!:)
      

  7.   

    这几句是关键:
                         Mystr = Trim(ts.ReadLine)
                         MyArray = Split(Mystr, "。")
                    If InStr(MyArray(i), Text1.Text) > 0 Then
    就是InStr和Split函数
     
    Split函数
          描述返回一个下标从零开始的一维数组,它包含指定数目的子字符串。语法Split(expression[, delimiter[, count[, compare]]])Split函数语法有如下几部分:部分 描述 
    expression 必需的。包含子字符串和分隔符的字符串表达式 。如果expression是一个长度为零的字符串(""),Split则返回一个空数组,即没有元素和数据的数组。 
    delimiter 可选的。用于标识子字符串边界的字符串字符。如果忽略,则使用空格字符(" ")作为分隔符。如果delimiter是一个长度为零的字符串,则返回的数组仅包含一个元素,即完整的 expression字符串。 
    count 可选的。要返回的子字符串数,–1表示返回所有的子字符串。 
    compare 可选的。数字值,表示判别子字符串时使用的比较方式。关于其值,请参阅“设置值”部分。 
    设置值compare参数的设置值如下:常数 值 描述 
    vbUseCompareOption –1 用Option Compare语句中的设置值执行比较。 
    vbBinaryCompare 0 执行二进制比较。 
    vbTextCompare 1 执行文字比较。 
    vbDatabaseCompare 2 仅用于Microsoft Access。基于您的数据库的信息执行比较。 
     
    InStr 函数
          返回 Variant (Long),指定一字符串在另一字符串中最先出现的位置。语法 InStr([start, ]string1, string2[, compare])InStr 函数的语法具有下面的参数:部分 说明 
    start 可选参数。为数值表达式,设置每次搜索的起点。如果省略,将从第一个字符的位置开始。如果 start 包含 Null,将发生错误。如果指定了 compare 参数,则一定要有 start 参数。 
    string1 必要参数。接受搜索的字符串表达式。 
    string2 必要参数。被搜索的字符串表达式。 
    Compare 可选参数。指定字符串比较。如果 compare 是 Null,将发生错误。如果省略 compare,Option Compare 的设置将决定比较的类型。 
    设置 compare 参数设置为:常数 值 描述 
    vbUseCompareOption -1 使用Option Compare 语句设置执行一个比较。 
    vbBinaryCompare 0 执行一个二进制比较。 
    vbTextCompare 1 执行一个按照原文的比较。 
    vbDatabaseCompare 2 仅适用于Microsoft Access,执行一个基于数据库中信息的比较。 
    返回值如果 InStr返回 
    string1 为零长度 0 
    string1 为 Null Null 
    string2 为零长度 Start 
    string2 为 Null Null 
    string2 找不到 0 
    在 string1 中找到string2  找到的位置 
    start > string2 0 
    说明InStrB 函数作用于包含在字符串中的字节数据。所以 InStrB 返回的是字节位置,而不是字符位置。
      

  8.   


        Set txtfile = fso.OpenTextFile(CommonDialog1.FileName)
        Set fil1 = fso.GetFile(CommonDialog1.FileName)
        Set ts = fil1.OpenAsTextStream(ForReading)
            
    type mismatch?
      

  9.   

    同意越级大笨狼的,只有Split应该以回车换行为分界符:
    MyArray =Split(Mystr,vbcrlf)
      

  10.   

    越级大笨狼,fso.OpenTextFile(CommonDialog1.FileName) 只能打开ascii文件,可我的文件是中文的文档,可以将其转换为ascii文件吗?谢谢小妹
      

  11.   

    为何我运行时老是报错
    run time error "13#"
    type mismatch非常焦急小妹