胡子高级记事本VB版1.093源码

'胡子高级记事本VB版1.093源码
'━━━━━━━━━━━━━━━━━━━━━━━━━━

form1

Private  Declare  Function  SetWindowPos Lib  "user32"  ( ByVal  hwnd As  Long ,  ByVal  hWndInsertAfter As  Long ,  ByVal  x As  Long ,  ByVal  y As  Long ,  ByVal  cx As  Long ,  ByVal  cy As  Long ,  ByVal  wFlags As  Long ) As  Long
'总在最上面的API
Dim  ontop As  Boolean
Dim  cliptext As  String      '上一剪粘板文本
Dim  mydocments As  String    '取我的文档目录
Dim  LWidth As Integer     '自动换行的行宽
Dim  CurFileName As  String      '前一个文本的文件名
'Dim tsys(9, 3) As String    '标题、文件名、文本、保存。(卡号即数组索引)  '改为在模块2中的public公有变量


Private   Sub  copy_ Click ()
     Call  复制_ Click
End   Sub

Private   Sub  cut_ Click ()
     Call  剪切_ Click
End   Sub

Private   Sub  del_ Click ()
     Call  删除_ Click
End   Sub

Private   Sub   Form _Load()
     On   Error  GoTo label
    SSTab.Move 0, 360, Form1.Width - 110, Form1.Height - 1525
    RichTextBox.Width = SSTab.Width - 20
    RichTextBox.Height = SSTab.Height - 395

    mydocments = Environ( "userprofile" ) &  "/My Documents"    '取我的文档目录

     '  LineWidth = RichTextBox.RightMargin  '设为自动换行
     '  RichTextBox.RightMargin = LineWidth
     '
    RichTextBox.OLEDropMode = 1
    Tsys(0, 0) =  "新文件1"
    Tsys(0, 1) =  ""
    Tsys(0, 2) =  ""
    Tsys(0, 3) =  "F"
    StatusBar1.Panels(2) =  "文件名："           '在状态栏中显示文章数及全文件名
    StatusBar1.Panels(1) =  "文章数："  & SSTab.Tabs

    Load Form2
    Form2.Visible =  False
    Form2.Move Screen.Width - Form2.Width, Screen.Height - Form2.Height - 450
     'MsgBox App.Path
    Form1.RichTextBox.SetFocus
label:
     Exit   Sub

End   Sub

Private   Sub   Form _Resize()
    SSTab.Move 0, 360, Form1.Width - 110, Form1.Height - 1525
    RichTextBox.Width = SSTab.Width - 20
    RichTextBox.Height = SSTab.Height - 395
End   Sub

Private   Sub   Form _Unload(Cancel As Integer)
    Unload Form2
    Unload Form3
    Unload Form4
End   Sub

Private   Sub  paste_ Click ()
     Call  粘贴_ Click
End   Sub

Private   Sub  RichTextBox_DblClick()
    With RichTextBox
         If  .Tag =  "min"   Then
            .Font.Size = 11
            .Font.Name =  "微软雅黑"
            .Tag =  "max"
             Exit   Sub
         Else
            .Font.Size = 9
            .Font.Name =  "宋体"
            .Tag =  "min"
             Exit   Sub
         End   If
     End  With
End   Sub

Private   Sub  RichTextBox_MouseDown(Button As Integer, Shift As Integer, x As  Single , y As  Single )
'MouseDown事件各种语法包含下列部分：
'button 返回一个整数，用来标识该事件的产生是按下哪个按钮
'其中 左按钮（位 0），右按钮（位 2），以及中间按钮（位 4）
'shift   返回一个整数，标示是否同时有Shift,Ctrl,Alt键按下
'x, y    返回一个指定鼠标指针当前位置的数
'Button = 2 表示右键按下
'PopupMenu方法用来弹出一个菜单
'语法是 object.PopupMenu menuname, flags, X, Y
'mnufile是我们在菜单编辑器中设计好的菜单
'X,Y是弹出菜单的位置，可以为数字，如果直接写为X,Y则是在当前鼠标位置弹出菜单

     If  Button = 2  Then
        PopupMenu 右键菜单, 0, x, y
     End   If

End   Sub

Private   Sub  RichTextBox_OLEDragDrop(Data As RichTextLib.DataObject, Effect As  Long , Button As Integer, Shift As Integer, x As  Single , y As  Single )
Rem 拖放文件
     On   Error  GoTo label
     If  RichTextBox. Text  <>  ""   Then
         Call  新建_ Click
     End   If

     If  Data.GetFormat(vbCFText)  Then
        RichTextBox.LoadFile Data.GetData(vbCFText)
     End   If

     If  Data.Files.Count = 0  Then
         Exit   Sub
     End   If

     If  Data.GetFormat(vbCFFiles)  Then
        tt =  LCase ( Right (Data.Files(1), 3))
        ts =  InStr ( "txt ini htm tml bas fmr bas cmd bat" , tt)
         'MsgBox tt
         If  ts = 0  Then
             Exit   Sub
         Else
            RichTextBox.LoadFile Data.Files(1)   'Load one file for demo
         End   If
     End   If

    Caption = RichTextBox.FileName
    i = SSTab.Tab
    fnlen =  Len (Caption)
    j =  InStrRev (Caption,  "/" )
    shortfn =  Mid (Caption, j + 1, fnlen - j - 4)
    shortfn =  Left $(shortfn, 5)
    SSTab.Caption = shortfn

    Tsys(i, 1) = Caption
    StatusBar1.Panels(2) =  "文件名："  & Tsys(i, 1)         '在状态栏中显示文章数及全文件名
    StatusBar1.Panels(1) =  "文章数："  & 1 + SSTab.Tab &  "/"  & SSTab.Tabs

label:
     Exit   Sub

End   Sub

Private   Sub  RichTextBox_Validate(Cancel As  Boolean )    'validate事件：当前控件将要失去焦点，即第二个控件获得焦点前
     Dim  i
    i = SSTab.Tab
    Tsys(i, 2) = RichTextBox. Text       '当编辑框将要失去焦点时及时将临时文本存入数组
End   Sub

Private   Sub  selt_ Click ()
     Call  全选_ Click
End   Sub

Private   Sub  SSTab_ Click (PreviousTab As Integer)
    With SSTab
        i = .Tab
        RichTextBox. Text  =  ""
        RichTextBox. Text  = Tsys(i, 2)
        StatusBar1.Panels(2) =  "文件名："  & Tsys(i, 1)         '在状态栏中显示文章数及全文件名
        StatusBar1.Panels(1) =  "文章数："  & 1 + SSTab.Tab &  "/"  & SSTab.Tabs
     End  With
End   Sub


Private   Sub  SSTab_DblClick()
    With SSTab
         If  .Tab <> 0  Then
            i = SSTab.Tab
            SSTab.TabVisible(i) =  False        '双击关闭当前文章
         End   If
     End  With
End   Sub

Private   Sub  Timer1_Timer()
     If  Clipboard.GetText <>  ""   And  Clipboard.GetText <> cliptext  Then
        Form2.List1.AddItem Clipboard.GetText, 0
        cliptext = Clipboard.GetText
     End   If
End   Sub

Private   Sub  Toolbar1_ButtonClick( ByVal  Button As MSComctlLib.Button)
     Select   Case  Button.Key

     Case   "新建"
         Call  新建_ Click
     Case   "打开"
         Call  打开_ Click
     Case   "保存"
         Call  保存_ Click
     Case   "剪切"
         Call  剪切_ Click
     Case   "复制"
         Call  复制_ Click
     Case   "粘贴"
         Call  粘贴_ Click
     Case   "全选"
         Call  全选_ Click
         Call  复制_ Click
     Case   "撤销"
         Call  撤销_ Click
     Case   "删除"
         If  RichTextBox.SelText <>  ""   Then
             Call  删除_ Click
         Else
            SendKeys  "{DEL}"
         End   If
     Case   "行首缩进"
         Call  行首缩进_ Click
     Case   "删除行首空格"
         Call  删除行首空格_ Click
     Case   "插入空行"
         Call  段后插入空行_ Click
     Case   "删除空行"
         Call  删除空行_ Click
     Case   "分割线"
        RichTextBox.SelText = vbCrLf &  "━━━━━━━━━━━━━━━━━━━━━━━━━━"  & vbCrLf
     Case   "方括号"
         If  RichTextBox.SelText <>  ""   Then
            RichTextBox.SelText =  "【"  & RichTextBox.SelText &  "】"
         Else
            RichTextBox.SelText =  "【】"
            SendKeys  "{LEFT}"
         End   If
     Case   "回车"
        SendKeys  "{ENTER}"
     Case   "硬回车"
         '测试
         MsgBox   "未填写代码"
     Case   "WORD"
         Call  wordopen
     Case   "最上面"
        总在最前面_ Click
     Case   "剪贴板"
        Form2.Visible =  Not  Form2.Visible   '取反
        Timer1.Interval = 300
     Case   "计算器"
         Dim  a() As  String
        a() =  Split (RichTextBox. Text , vbCrLf)
         For  i = 0  To   UBound (a)
            m =  Val (a(i))   '取每行
             If  m <> 0  Then
                n = n +  Val (m)
                js = js + 1
             End   If
         Next  i
        r = n / js
        msg =  MsgBox ( "有效值："  & Str(js) & vbCrLf &  "求和值："  & Str(n) & vbCrLf &  "平均值："  &  Val (r), ,  "计算结果" )
     Case   "首个"
        SSTab.Tab = 0
     Case   "末个"
        i = SSTab.Tabs
        SSTab.Tab = i - 1
     End   Select
End   Sub

Private   Sub  undo_ Click ()
     Call  撤销_ Click
End   Sub

Private   Sub  半角转全角_ Click ()
    With RichTextBox
         If  .SelText =  ""   Then
            . Text  = StrConv(. Text , 4)     '8为将双字节转换为单字节，4为单字节到双字节
         Else
            .SelText = StrConv(.SelText, 4)     '1转换为大写，2转换为小写
         End   If
     End  With
End   Sub

Private   Sub  帮助_ Click ()
    Load Form4
    Form4.Visible =  True
End   Sub

Private   Sub  保存_ Click ()
    CommonDialog1.CancelError =  True
    CommonDialog1.FileName =  ""
    CommonDialog1.DefaultExt =  "txt"
     On   Error  GoTo label

     Dim  fname As  String , i As Integer
    i = SSTab.Tab
     If  RichTextBox. Text  =  ""   Then   Exit   Sub
    fname = Tsys(i, 1)

     If  Tsys(i, 1) <>  ""   Then                                   '已有文件名的取原文件名
         If  Tsys(i, 3) =  "T"   Then
            RichTextBox.SaveFile fname, rtfText
         Else
            With CommonDialog1
                . Filter  =  "文本文件|*.txt|所有文件|*.*)"
                .InitDir = mydocments
                fname = Tsys(i, 1)
                .FileName = fname
                .ShowSave
                RichTextBox.SaveFile .FileName, rtfText         ' rtfText参数不可少，否则默认保存为RTF格式
                Tsys(i, 3) =  "T"
             End  With
         End   If
     End   If

     If  Tsys(i, 1) =  ""   Then
         If  RichTextBox.SelText <>  ""   Then                         '其次取选中的文本作文件名
            With CommonDialog1
                . Filter  =  "文本文件|*.txt|所有文件|*.*)"
                .InitDir = mydocments
                .FileName = RichTextBox.SelText
                .ShowSave
                RichTextBox.SaveFile .FileName, rtfText
                Tsys(i, 3) =  "T"
                Tsys(i, 0) =  Left (.FileTitle, 5)
                Tsys(i, 1) = .FileName
                SSTab.Caption =  Left (.FileTitle, 5)
                StatusBar1.Panels(2) =  "文件名："  & .FileName        '在状态栏中显示文章数及全文件名
             End  With
             Exit   Sub
         End   If

        sn =  InStr (RichTextBox. Text ,  Chr (13))
         If  sn > 0  Then
            fline =  Left (RichTextBox. Text , sn - 1)                 '再次取首行作文件名
             If  fline =  ""   Then
                fline =  Left $(RichTextBox. Text , 10)
             End   If

            With CommonDialog1
                . Filter  =  "文本文件|*.txt|所有文件|*.*)"
                .InitDir = mydocments
                .FileName = fline
                .ShowSave
                RichTextBox.SaveFile .FileName, rtfText
                Tsys(i, 3) =  "T"
                Tsys(i, 0) =  Left (.FileTitle, 5)
                Tsys(i, 1) = .FileName
                SSTab.Caption =  Left (.FileTitle, 5)
                StatusBar1.Panels(2) =  "文件名："  & .FileName        '在状态栏中显示文章数及全文件名
             End  With
         Else
            With CommonDialog1
                . Filter  =  "文本文件|*.txt|所有文件|*.*)"
                .InitDir = mydocments
                .ShowSave
                RichTextBox.SaveFile .FileName, rtfText
                Tsys(i, 3) =  "T"
                Tsys(i, 0) =  Left (.FileTitle, 5)
                Tsys(i, 1) = .FileName
                SSTab.Caption =  Left (.FileTitle, 5)
                StatusBar1.Panels(2) =  "文件名："  & .FileName        '在状态栏中显示文章数及全文件名
             End  With
         End   If
     End   If
    RichTextBox.SetFocus
label:
     If   Err . Number  = vbCancel  Then
         Exit   Sub
     End   If

End   Sub

Private   Sub  背景色_ Click ()
    CommonDialog1.ShowColor
    RichTextBox.BackColor = CommonDialog1.Color
End   Sub

Private   Sub  插入日期_ Click ()
    RichTextBox.SelText =  "【"  &  Date  &  "  "  &  Time  &  "】"
End   Sub

Private   Sub  查找_ Click ()
    Load Form3
    Form3.Visible =  True
End   Sub

Private   Sub  打开_ Click ()
     On   Error  GoTo label                '设置错误处理陷阱
    CommonDialog1.CancelError =  True    '允许截获取消错误'响应取消事件，默认为False
     Dim  strOpen As  String               '定义字符型变量strOpen，用于存放文件名
     Dim  shortfn As  String               '定义短文件名,用于tabcaption
     Dim  shortfnn As  String


    With CommonDialog1
         '    MsgBox Environ("userprofile") & "/My Documents"    '获取我的文档路径文本作为初始目录
        .InitDir = Environ( "userprofile" ) &  "/My Documents"

        . Filter  =  "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"    '设置文件过滤
        .DefaultExt =  "txt"
        .FilterIndex = 1                       '设置默认的过滤文件为 *.txt

        .FileName =  ""
        .ShowOpen                              '调用打开文件对话框，选择要打开的文件
        strOpen = .FileName                    '将指定文件名赋给变量strOpen
        CurFileName = .FileName                '赋值给全局变量供切换子程序调用

         If  RichTextBox. Text  <>  ""   Then
             Call  新建_ Click
         End   If

        RichTextBox.LoadFile strOpen           '用 LoadFile 方法打开strOpen中的文件
         'RichTextBox.FileName= .FileName      '另一种打开文件的方式
         'SSTab.Caption = .FileTitle           '显示完整的文件标题


         If  (strOpen <>  "" )  Then
            shortfn =  Left (.FileTitle,  Len (.FileTitle) - 4)     '不显示扩展名
            shortfnn =  Left (shortfn, 5)      '显示标题最长取5个字
             If  StrLen(shortfnn) < 8  Then
                shortfnn =  Left (shortfn, 10)
             End   If
         End   If
        SSTab.Caption = shortfnn

     End  With
    With SSTab
        curtab = .Tab
        Tsys(curtab, 0) = .Caption
        Tsys(curtab, 1) = strOpen
        Tsys(curtab, 2) = RichTextBox. Text
        Tsys(curtab, 3) =  "T"
     End  With
    StatusBar1.Panels(2) =  "文件名："  & strOpen          '在状态栏中显示文件数及全文件名
    StatusBar1.Panels(1) =  "文章数："  & 1 + SSTab.Tab &  "/"  & SSTab.Tabs
    RichTextBox.SetFocus
label:
     If   Err . Number  = cdlCancel  Then
         Exit   Sub
     End   If

End   Sub

Private   Sub  大写转小写_ Click ()
    With RichTextBox
         If  .SelText =  ""   Then
            . Text  =  LCase (. Text )
         Else
            .SelText =  LCase (.SelText)
         End   If
     End  With
End   Sub

Private   Sub  段后插入空行_ Click ()
     Dim  a() As  String
     Dim  sel As  Boolean
    With RichTextBox
         If  .SelText =  ""   Then
            sel =  False
         Else
            sel =  True
         End   If

         If  sel =  False   Then
            a() =  Split (. Text , vbCrLf)
         Else
            a() =  Split (.SelText, vbCrLf)
         End   If

         For  i = 0  To   UBound (a)
             If  a(i) <>  ""   Then
                tt = tt & a(i) & vbCrLf & vbCrLf
             Else
                tt = tt &  ""
             End   If
         Next  i

         If  sel =  False   Then
            . Text  =  ""
            . Text  = tt
         Else
            .SelText = tt
         End   If
     End  With

End   Sub

Private   Sub  关于_ Click ()
    i =  MsgBox ( "胡子高级记事本VB版 v1.0"  &  Chr (13) &  Chr (10) &  Chr (13) &  Chr (10) &  "  胡子软件工作室出品" , ,  "关于……" )
End   Sub

Private   Sub  另存为_ Click ()
     On   Error  GoTo label
    CommonDialog1.DefaultExt =  "txt"
    CommonDialog1.CancelError =  True              '设置陷阱
     Dim  fname As  String , i As Integer
    i = SSTab.Tab
    fname = Tsys(i, 1)

     If  Tsys(i, 1) <>  ""   Then
        With CommonDialog1
            . Filter  =  "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*)"
            .InitDir = mydocments
            fname = Tsys(i, 1)
            .FileName = fname
            .ShowSave
            RichTextBox.SaveFile .FileName, rtfText
            Tsys(i, 3) =  "T"
         End  With
     End   If

     If  Tsys(i, 1) =  ""   Then
         If  RichTextBox.SelText <>  ""   Then          '取选中的文本作文件名
            With CommonDialog1
                . Filter  =  "文本文件|*.txt|所有文件|*.*)"
                .InitDir = mydocments
                .FileName = RichTextBox.SelText
                .ShowSave
                RichTextBox.SaveFile .FileName, rtfText
                Tsys(i, 3) =  "T"
                Tsys(i, 0) =  Left (.FileName, 5)
                Tsys(i, 1) = .FileName
                StatusBar1.Panels(2) =  "文件名："  & .FileName        '在状态栏中显示文章数及全文件名
             End  With
             Exit   Sub
         End   If

        sn =  InStr (RichTextBox. Text ,  Chr (13))
         If  sn > 0  Then
            fline =  Left (RichTextBox. Text , sn - 1)   '取首行作文件名
            With CommonDialog1
                . Filter  =  "文本文件|*.txt|所有文件|*.*)"
                .InitDir = mydocments
                .FileName = fline
                .ShowSave
                RichTextBox.SaveFile .FileName, rtfText
                Tsys(i, 3) =  "T"
                Tsys(i, 0) =  Left (.FileName, 5)
                Tsys(i, 1) = .FileName
                StatusBar1.Panels(2) =  "文件名："  & .FileName        '在状态栏中显示文章数及全文件名
             End  With
         Else
            With CommonDialog1
                . Filter  =  "文本文件|*.txt|所有文件|*.*)"
                .InitDir = mydocments
                .ShowSave
                RichTextBox.SaveFile .FileName, rtfText
                Tsys(i, 3) =  "T"
                Tsys(i, 0) =  Left (.FileName, 5)
                Tsys(i, 1) = .FileName
                StatusBar1.Panels(2) =  "文件名："  & .FileName        '在状态栏中显示文章数及全文件名
             End  With
         End   If
     End   If

label:
     If   Err . Number  = vbCancel  Then
         Exit   Sub
     End   If

End   Sub

Private   Sub  前景色_ Click ()
    CommonDialog1.ShowColor
    RichTextBox.SelColor = CommonDialog1.Color
End   Sub

Private   Sub  全角转半角_ Click ()
    With RichTextBox
         If  .SelText =  ""   Then
            . Text  = StrConv(. Text , 8)     '8为将双字节转换为单字节，4为单字节到双字节
         Else
            .SelText = StrConv(.SelText, 8)
         End   If
     End  With
End   Sub

Private   Sub  全选并复制_ Click ()
     Call  全选_ Click
     Call  复制_ Click
End   Sub

Private   Sub  删除换行符_ Click ()
     Dim  a() As  String
    With RichTextBox
         If  .SelText =  ""   Then
            a() =  Split (. Text , vbCrLf)
         Else
            a() =  Split (.SelText, vbcrtlf)
         End   If
         For  i = 0  To   UBound (a)
             If  a(i) <>  ""   Then
                tt = tt &  Replace (a(i), vbCrLf,  "" )
             Else
                tt = tt & vbCrLf & vbCrLf
             End   If
         Next  i
         If  .SelText =  ""   Then
            . Text  =  ""
            . Text  = tt
         Else
            .SelText = tt
         End   If
     End  With
End   Sub

Private   Sub  删除空行_ Click ()
     Dim  linetxt() As  String
    With RichTextBox
         If  .SelText =  ""   Then
            linetxt() =  Split (. Text , vbCrLf)
            . Text  =  ""
             For  i = 0  To   UBound (linetxt)
                 If  linetxt(i) <>  ""   Then
                    . Text  = . Text  & linetxt(i) & vbCrLf
                 End   If
             Next  i
         Else
            linetxt() =  Split (.SelText, vbCrLf)
            .SelText =  ""
             For  i = 0  To   UBound (linetxt)
                 If  linetxt(i) <>  ""   Then
                    .SelText = linetxt(i) & vbCrLf
                 End   If
             Next  i
         End   If
     End  With
End   Sub

Private   Sub  删除同类字符_ Click ()
     Dim  tt As  String
    With RichTextBox
         If  .SelText <>  ""   Then
            tt =  Replace (. Text , .SelText,  "" )   '这里的.seltext前面的小点丢了，检查了一天没查出来
            . Text  =  ""
            . Text  = tt
         End   If
     End  With
End   Sub

Private   Sub  删除行首空格_ Click ()
     Dim  ftt() As  String
    With RichTextBox
         If  .SelText =  ""   Then
            ftt() =  Split (. Text , vbCrLf)
            . Text  =  ""
             For  i = 0  To   UBound (ftt)
                 If  ftt(i) <>  ""   Then
                    . Text  = . Text  &  Trim (ftt(i)) & vbCrLf
                 End   If
             Next  i
         Else
            ftt() =  Split (.SelText, vbCrLf)
            .SelText =  ""
             For  i = 0  To   UBound (ftt)
                 If  ftt(i) <>  ""   Then
                    .SelText =  Trim (ftt(i)) & vbCrLf
                 End   If
             Next  i
         End   If
     End  With
End   Sub

Private   Sub  小写转大写_ Click ()
    With RichTextBox
         If  .SelText =  ""   Then
            . Text  =  UCase (. Text )
         Else
            .SelText =  UCase (.SelText)
         End   If
     End  With
End   Sub

Private   Sub  新建_ Click ()
     On   Error  GoTo label
     Dim  tabn As Integer, curtab As Integer, nexttab As Integer
    With SSTab
         If  .Tabs < 10  Then
            curtab = .Tabs
            curtab = curtab - 1
            Tsys(curtab, 0) = .Caption
             'Tsys(curtab, 1) = CurFileName
            Tsys(curtab, 2) = RichTextBox. Text
             'Tsys(curtab, 3) = "F"                  '以上保存前一个文本信息到数组
            RichTextBox. Text  =  ""
            CurFileName =  ""

            .Tabs = .Tabs + 1
            nexttab = .Tabs
            .Tab = nexttab - 1
            .Caption =  "新文件"  & .Tabs
            Tsys(nexttab - 1, 0) = .Caption
            Tsys(nexttab - 1, 1) =  ""
            Tsys(nexttab - 1, 2) =  ""
            Tsys(nexttab - 1, 3) =  "F"               '以上保存新建文件信息到数组

            StatusBar1.Panels(2) =  "文件名："        '在状态栏中显示文件数及全文件名
            StatusBar1.Panels(1) =  "文章数："  & 1 + SSTab.Tab &  "/"  & SSTab.Tabs
         Else
            msg =  MsgBox ( "对不起，最多允许可以同时打开10个文件" , ,  "提示信息" )
         End   If
     End  With
    RichTextBox.SetFocus                        '编辑框获取焦点
label:
     Exit   Sub
End   Sub


Private   Sub  全选_ Click ()
    With RichTextBox
        .SelStart = 0
        .SelLength =  Len (. Text )
     End  With
End   Sub


Private   Sub  剪切_ Click ()
     If  RichTextBox.SelText <>  ""   Then
        Clipboard.Clear
        Clipboard.SetText RichTextBox.SelText, vbCFText
        RichTextBox.SelText =  ""
     End   If
End   Sub


Private   Sub  行首缩进_ Click ()
     Dim  a() As  String
     Dim  sel As  Boolean
    With RichTextBox
         If  .SelText =  ""   Then
            sel =  False
         Else
            sel =  True
         End   If

         If  .SelText =  ""   Then
            a() =  Split (. Text , vbCrLf)
         Else
            a() =  Split (.SelText, vbCrLf)
         End   If

         For  i = 0  To   UBound (a)
             If  a(i) <>  ""   Then
                tt = tt &  "　　"  & a(i) & vbCrLf   '两个全角空格
             Else
                tt = tt & vbCrLf
             End   If
         Next  i

         If  sel =  False   Then
            . Text  =  ""
            . Text  = tt
         Else
            .SelText = tt
         End   If
     End  With


End   Sub

Private   Sub  粘贴_ Click ()
    RichTextBox.SelText = Clipboard.GetText
End   Sub

Private   Sub  复制_ Click ()
    VB.Clipboard.Clear
    Clipboard.SetText RichTextBox.SelText, vbCFText
End   Sub

Private   Sub  撤销_ Click ()
    SendKeys  "^Z"
End   Sub


Private   Sub  删除_ Click ()
    RichTextBox.SelText =  ""
End   Sub

Private   Sub  退出_ Click ()
'End
    Unload Me
End   Sub

Private   Sub  SetOnTop( ByVal  IsOnTop As  Boolean )
     Dim  rtn As  Long
     If  IsOnTop =  True   Then          '将窗口置于最上面
        rtn = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)
     Else
        rtn = SetWindowPos(Me.hwnd, -2, 0, 0, 0, 0, 3)
     End   If
End   Sub

Private   Sub  wordopen()
     Dim  oApp As Word.Application
     Dim  oDoc As Word. Document
     Dim  Content As  String     '保存内容的字符串

     'RichTextBox.SaveFile "c:/temp.txt"
     '打开需要的文件
     Set  oApp =  CreateObject ( "Word.Application" )
    oApp.Visible =  True
     Set  oDoc = oApp.Documents.Add
    oDoc.Content. Text  = RichTextBox. Text
End   Sub

Private   Sub  字数行数统计_ Click ()
     Dim  a() As  String
     Dim  b() As  String
     Dim  sel As  Boolean
    With RichTextBox
         If  .SelText =  ""   Then
            sel =  False
         Else
            sel =  True
         End   If

        .HideSelection =  False    '保持文本选中状态
        RichTextBox.SetFocus     '重新获取焦点
         If  sel =  True   Then
            b() =  Split (.SelText, vbCrLf)
            msg =  MsgBox ( "字符数："  & Str( Len (.SelText)) & vbCrLf & vbCrLf &  "行  数："  &  UBound (b) + 1, ,  "统计信息" )
         Else
            a() =  Split (. Text , vbCrLf)
            msg =  MsgBox ( "字符数："  & Str( Len (. Text )) & vbCrLf & vbCrLf &  "行  数："  &  UBound (a) + 1, ,  "统计信息" )
         End   If
     End  With
End   Sub

Private   Sub  字体_ Click ()
'CommonDialog1.ShowFont
     Call  RichTextBox_DblClick
     '  With CommonDialog1
     '    CommanDialog1.Flags = cdlCFBoth '或设为cdlCFPrinterFonts Or cdlCFScreenFonts
     '    .ShowFont
     '    CommonDialog1.Flags = &H3 Or &H100
     '    If IsNull(Text1.SelFontName) = True Then
     '      CommonDialog1.FontName = "宋体"  '当您选择了混合字体时SelFontName为空
     '    Else
     '      CommonDialog1.FontName = Text1.SelFontName
     '    End If
     '    CommonDialog1.FontSize = Text1.SelFontSize
     '    CommonDialog1.FontBold = Text1.SelBold
     '    CommonDialog1.FontItalic = Text1.SelItalic
     '    CommonDialog1.Color = Text1.SelColor
     '    CommonDialog1.FontStrikethru = Text1.SelStrikeThru
     '    CommonDialog1.FontUnderline = Text1.SelUnderline
     '    CommonDialog1.ShowFont
     '    If Err <> cdlCancel Then
     '      Text1.SelFontName = CommonDialog1.FontName
     '      Text1.SelFontSize = CommonDialog1.FontSize
     '      Text1.SelBold = CommonDialog1.FontBold
     '      Text1.SelItalic = CommonDialog1.FontItalic
     '      Text1.SelColor = CommonDialog1.Color
     '      Text1.SelStrikeThru = CommonDialog1.FontStrikethru
     '      Text1.SelUnderline = CommonDialog1.FontUnderline
     '    End If
     '  End With
End   Sub

Private   Sub  自动折行_ Click ()
'  RichTextBox.MultiLine = Not RichTextBox.MultiLine
    RichTextBox.MultiLine =  False
End   Sub

Private   Sub  总在最前面_ Click ()
     Dim  rtn As  Long
     If  ontop =  False   Then          '将窗口置于最上面
        rtn = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)
        ontop =  True
     Else
        rtn = SetWindowPos(Me.hwnd, -2, 0, 0, 0, 0, 3)
        ontop =  False
     End   If

End   Sub

━━━━━━━━━━━━━━━━━━━━━━━━━━
form2

Private  Declare  Function  SetWindowPos Lib  "user32"  ( ByVal  hwnd As  Long ,  ByVal  hWndInsertAfter As  Long ,  ByVal  x As  Long ,  ByVal  y As  Long ,  ByVal  cx As  Long ,  ByVal  cy As  Long ,  ByVal  wFlags As  Long ) As  Long
'总在最上面的API

Private   Sub  Command1_ Click ()
    List1.Clear
End   Sub

Private   Sub  Command2_ Click ()
    Form2.Visible =  False
End   Sub

Private   Sub   Form _ Click ()
     Dim  ontop As  Long
     '将窗口置于最上面
    ontop = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)

End   Sub

Private   Sub   Form _Load()
     Dim  ontop As  Long
     '将窗口置于最上面
    ontop = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)

End   Sub

Private   Sub  List1_ Click ()
    i = List1.ListIndex     '选中项的索引
    t = List1. Text
     If  i <> 0  Then  List1.RemoveItem (i)
    Clipboard.SetText t
End   Sub

Private   Sub  List1_DblClick()
    Form1.RichTextBox.SelText = Clipboard.GetText
End   Sub

━━━━━━━━━━━━━━━━━━━━━━━━━━
form3

Option   Explicit    '定义目标位置变量
Private  fpc As Integer
Private  Declare  Function  SetWindowPos Lib  "user32"  ( ByVal  hwnd As  Long ,  ByVal  hWndInsertAfter As  Long ,  ByVal  x As  Long ,  ByVal  y As  Long ,  ByVal  cx As  Long ,  ByVal  cy As  Long ,  ByVal  wFlags As  Long ) As  Long
'总在最上面的API

Private   Sub  Command4_ Click ()
    Unload Me
    Form1.StatusBar1.Panels(2) = Tsys(Form1.SSTab.Tab, 1)         '在状态栏中显示信息
End   Sub

Private   Sub   Form _ Click ()
     Dim  ontop As  Long
     '将窗口置于最上面
    ontop = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)

End   Sub

Private   Sub   Form _Load()
     Dim  ontop As  Long
     Dim  bc As  String
     '将窗口置于最上面
    ontop = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)
     If  Form1.RichTextBox.SelText <>  ""   Then
        bc = Form1.RichTextBox.SelText
        Text1. Text  = bc
     End   If

End   Sub


Private   Sub  Command1_ Click ()
    FindText 1
End   Sub

Private   Sub  FindText( ByVal  fstart As Integer)
     Dim  pos As Integer
     Dim  i
     If  Check1.Value =  False   Then
        pos =  InStr (fstart, Form1.RichTextBox. Text , Text1. Text , 1)      '1为不区分大小写
     Else
        pos =  InStr (fstart, Form1.RichTextBox. Text , Text1. Text , 0)
     End   If

     If  pos > 0  Then
        fpc = pos
        Form1.RichTextBox.SelStart = fpc - 1
        Form1.RichTextBox.SelLength =  Len (Text1. Text )         '选中找到的字符串
        Form1.RichTextBox.SetFocus
     Else
         'i = MsgBox("  没有找到！  ", vbOKOnly, "查找")
        Form1.StatusBar1.Panels(2) =  "◆◆◆找不到！还是没有了？"           '在状态栏中显示信息
        Form1.RichTextBox.SetFocus
     End   If
End   Sub

Private   Sub  Command2_ Click ()
    FindText fpc + 1
End   Sub

Private   Sub  Command3_ Click ()
     Dim  tt As  String
     Dim  i
     If  Check1.Value =  True   Then
        tt =  Replace (Form1.RichTextBox. Text , Text1. Text , Text2. Text , , , vbTextCompare)
     Else
        tt =  Replace (Form1.RichTextBox. Text , Text1. Text , Text2. Text )
     End   If
    Form1.RichTextBox. Text  =  ""
    Form1.RichTextBox. Text  = tt
    Form3.SetFocus
     'i = MsgBox("全部替换完毕！", vbOKOnly, "信息")
    Form1.StatusBar1.Panels(2) =  "◆◆◆全部替换完毕！"           '在状态栏中显示信息
End   Sub


━━━━━━━━━━━━━━━━━━━━━━━━━━
form4

Option   Explicit    '定义目标位置变量
Private  fpc As Integer
Private  Declare  Function  SetWindowPos Lib  "user32"  ( ByVal  hwnd As  Long ,  ByVal  hWndInsertAfter As  Long ,  ByVal  x As  Long ,  ByVal  y As  Long ,  ByVal  cx As  Long ,  ByVal  cy As  Long ,  ByVal  wFlags As  Long ) As  Long
'总在最上面的API


Private   Sub   Form _ Click ()
    Unload Me
End   Sub

Private   Sub   Form _Load()
     Dim  ontop As  Long                '将窗口置于最上面
    ontop = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)

    Transparency = 255 - 80
    Translucence Me
    Label1.BackStyle = 0   '标签背景透明
    Label1.ForeColor =  RGB (255, 229, 184)
    Label2.ForeColor = vbBlue
    Label3.ForeColor = QBColor(2)
    Label4.ForeColor = QBColor(0)   '显示16色，0-15
End   Sub

━━━━━━━━━━━━━━━━━━━━━━━━━━
module1

Option   Explicit
Declare  Function  GetWindowLong Lib  "user32"  Alias  "GetWindowLongA"  ( ByVal  hwnd As  Long ,  ByVal  nIndex As  Long ) As  Long
Declare  Function  SetWindowLong Lib  "user32"  Alias  "SetWindowLongA"  ( ByVal  hwnd As  Long ,  ByVal  nIndex As  Long ,  ByVal  dwNewLong As  Long ) As  Long
Declare  Function  SetLayeredWindowAttributes Lib  "user32"  ( ByVal  hwnd As  Long ,  ByVal  crKey As  Long ,  ByVal  bAlpha As Byte,  ByVal  dwFlags As  Long ) As  Long

Public  Transparency As Integer
Const  SWP_NOACTIVATE = 3
Const  WS_EX_LAYERED = &H80000
Const  GWL_EXSTYLE = (-20)
Const  LWA_ALPHA = &H2
Const  LWA_COLORKEY = &H1

Sub  Translucence(frm As  Form )
     Dim  rtn As  Long
    rtn = GetWindowLong(frm.hwnd, GWL_EXSTYLE)
    rtn = rtn  Or  WS_EX_LAYERED
    SetWindowLong frm.hwnd, GWL_EXSTYLE, rtn
    SetLayeredWindowAttributes frm.hwnd, 0, Transparency, LWA_ALPHA
End   Sub


━━━━━━━━━━━━━━━━━━━━━━━━━━
module2

'public：公用变量，其他模块可调用
Public  Tsys(9, 3)           '标题、文件名、文本、保存。(卡号即数组索引)


━━━━━━━━━━━━━━━━━━━━━━━━━━
module3


'取字符串中有多少个字符(1个汉字定义为2个字符宽度)

Public   Function  StrLen( ByVal  s As  String ) As Integer
     Dim  i As Integer
    n =  Len (s)
     For  i = 1  To  n
         If   Asc ( Mid $(s, i, 1)) < 0  Then  n = n + 1      '若为汉字,字符个数加1
     Next  i
    StrLen = n
End   Function