text.frm

两个VB播放器 两个VB播放器 两个VB播放器 两个VB播放器

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form Form3 
   AutoRedraw      =   -1  'True
   Caption         =   "HongYe Reader"
   ClientHeight    =   6795
   ClientLeft      =   2145
   ClientTop       =   1950
   ClientWidth     =   8670
   DrawStyle       =   2  'Dot
   FillColor       =   &H80000006&
   FillStyle       =   0  'Solid
   Icon            =   "Text.frx":0000
   LinkTopic       =   "Form3"
   PaletteMode     =   2  'Custom
   ScaleHeight     =   6795
   ScaleWidth      =   8670
   Begin MSComDlg.CommonDialog CommonDialog2 
      Left            =   5760
      Top             =   2160
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      FontName        =   "Fixedsys"
      FontSize        =   12
   End
   Begin RichTextLib.RichTextBox Ric 
      Height          =   1695
      Left            =   2160
      TabIndex        =   0
      Top             =   1920
      Width           =   2535
      _ExtentX        =   4471
      _ExtentY        =   2990
      _Version        =   393217
      BackColor       =   12648384
      BorderStyle     =   0
      HideSelection   =   0   'False
      ReadOnly        =   -1  'True
      ScrollBars      =   2
      MousePointer    =   1
      AutoVerbMenu    =   -1  'True
      TextRTF         =   $"Text.frx":030A
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Fixedsys"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Menu meuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu meuNew 
         Caption         =   "新建(&N)"
         Enabled         =   0   'False
         Shortcut        =   ^N
      End
      Begin VB.Menu meuOpen 
         Caption         =   "打开(&O)"
         Shortcut        =   ^O
      End
      Begin VB.Menu meuli 
         Caption         =   "我的文档(&F)"
         Begin VB.Menu meulishi 
            Caption         =   "历史文件"
            Index           =   1
         End
      End
      Begin VB.Menu meuLinev 
         Caption         =   "-"
      End
      Begin VB.Menu meuSaveNow 
         Caption         =   "保存(&S)"
         Enabled         =   0   'False
         Shortcut        =   ^S
      End
      Begin VB.Menu meuSave 
         Caption         =   "另存为(&L)"
         Enabled         =   0   'False
         Begin VB.Menu meuTXT 
            Caption         =   "TXT文件(&T)"
         End
         Begin VB.Menu meuRTF 
            Caption         =   "RTF文件(&R)"
         End
         Begin VB.Menu meuVisual 
            Caption         =   "程序文件(&V)"
            Begin VB.Menu meuC 
               Caption         =   "C文件(&C)"
            End
            Begin VB.Menu meu_C 
               Caption         =   "C++文件(&D)"
            End
         End
      End
      Begin VB.Menu meuline 
         Caption         =   "-"
      End
      Begin VB.Menu meuPrint 
         Caption         =   "打印选中文本(&P)"
      End
      Begin VB.Menu meuPrintAll 
         Caption         =   "打印全文(&A)"
         Shortcut        =   ^P
      End
      Begin VB.Menu meulinem 
         Caption         =   "-"
      End
      Begin VB.Menu meuLook 
         Caption         =   "打印预览(&L)"
      End
      Begin VB.Menu meuExit 
         Caption         =   "退出(&E)"
         Shortcut        =   ^Q
      End
   End
   Begin VB.Menu meuEdit 
      Caption         =   "编辑(&E)"
      Begin VB.Menu mnuUndo 
         Caption         =   "撤消(&U)"
         Enabled         =   0   'False
         Shortcut        =   ^U
      End
      Begin VB.Menu mnuReDo 
         Caption         =   "重做(&R)"
         Enabled         =   0   'False
         Shortcut        =   ^R
      End
      Begin VB.Menu meulineo 
         Caption         =   "-"
      End
      Begin VB.Menu mnuCut 
         Caption         =   "剪切(&C)"
         Enabled         =   0   'False
         Shortcut        =   ^X
      End
      Begin VB.Menu mnuCopy 
         Caption         =   "复制(&P)"
         Enabled         =   0   'False
         Shortcut        =   ^C
      End
      Begin VB.Menu mnuPaste 
         Caption         =   "粘贴(&S)"
         Enabled         =   0   'False
         Shortcut        =   ^V
      End
      Begin VB.Menu meulineb 
         Caption         =   "-"
      End
      Begin VB.Menu mnuDelete 
         Caption         =   "删除(&D)"
         Enabled         =   0   'False
         Shortcut        =   ^D
      End
      Begin VB.Menu meuAll 
         Caption         =   "全选(&A)"
         Shortcut        =   ^A
      End
      Begin VB.Menu meuline5 
         Caption         =   "-"
      End
      Begin VB.Menu meuMiddle 
         Caption         =   "文字正中(&M)"
         Enabled         =   0   'False
         Shortcut        =   ^{F1}
      End
      Begin VB.Menu meuLeft 
         Caption         =   "文字偏左(&L)"
         Enabled         =   0   'False
         Shortcut        =   ^{F2}
      End
      Begin VB.Menu meuRight 
         Caption         =   "文字偏又(&R)"
         Enabled         =   0   'False
         Shortcut        =   +{F3}
      End
      Begin VB.Menu meulinec 
         Caption         =   "-"
      End
      Begin VB.Menu meuEditFont 
         Caption         =   "编辑字体(&E)"
         Enabled         =   0   'False
         Shortcut        =   ^F
      End
      Begin VB.Menu meuSuo 
         Caption         =   "增加缩进(&I)"
         Shortcut        =   ^I
      End
      Begin VB.Menu meuXiao 
         Caption         =   "减小缩进(&X)"
         Shortcut        =   ^L
      End
      Begin VB.Menu meulineg 
         Caption         =   "-"
      End
      Begin VB.Menu meuTimeDate 
         Caption         =   "时间/日期(&D)"
      End
      Begin VB.Menu meuFind 
         Caption         =   "查找(&F)"
      End
   End
   Begin VB.Menu meuChange 
      Caption         =   "设置(&A)"
      Begin VB.Menu meuFirst 
         Caption         =   "标准设置一(&O)"
         Shortcut        =   ^K
      End
      Begin VB.Menu meuTwo 
         Caption         =   "标准设置二(&T)"
         Shortcut        =   ^T
      End
      Begin VB.Menu meuThree 
         Caption         =   "标准设置三(&S)"
         Shortcut        =   ^Z
      End
      Begin VB.Menu meulinet 
         Caption         =   "-"
      End
      Begin VB.Menu meuEdite 
         Caption         =   "可编辑的(&E)"
         Shortcut        =   ^{F4}
      End
      Begin VB.Menu meuNo 
         Caption         =   "不可编辑(&N)"
         Shortcut        =   ^{F5}
      End
      Begin VB.Menu meulinef 
         Caption         =   "-"
      End
      Begin VB.Menu meuColor 
         Caption         =   "背景颜色(&C)"
         Shortcut        =   ^B
      End
      Begin VB.Menu meuFont 
         Caption         =   "字体(&F)"
         Shortcut        =   ^E
      End
   End
   Begin VB.Menu meuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu meuHelpP 
         Caption         =   "帮助主题(&H)"
         Shortcut        =   {F1}
      End
      Begin VB.Menu meulinel 
         Caption         =   "-"
      End
      Begin VB.Menu meuAbout 
         Caption         =   "关于(&A)"
      End
   End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private trapUndo As Boolean           'flag to indicate whether actions should be trapped
Private UndoStack As New Collection   'collection of undo elements
Private RedoStack As New Collection   'collection of redo elements

Private Sub Command1_Click()
End Sub

Private Sub Form_Load()
  On Error Resume Next
  ric.Top = 0
  ric.Left = 0                                   '//初始化
  meuNo.Checked = True
  meuSave.Enabled = False
  
  ric.Width = Form3.Width - 100
  ric.Height = Form3.Height - 680
  ric.Locked = True
  ric.LoadFile (Form1.CommonDialog2.FileName)
  ric.SelStart = 0
  ric.SelLength = Len(ric.Text)
  
  ric.SelIndent = 1000                     '//文本距左边距离的宽度
  'Ric.RightMargin = 100
  ric.SelLength = 0
  'Ric.SelBullet = True
  i = 0
  Open App.Path & "\temp\histroy" For Input As #1
      Do While Not EOF(1)
        i = i + 1                                                 '//计算有多少条记录
        Line Input #1, nextline
        If nextline = "" Then Exit Do
      Loop
   Close #1
  Open App.Path & "\temp\histroy" For Input As #1                           '//把最近使用过的文件加到菜单中
    For x = 1 To i
         Line Input #1, nextline
         Load meulishi(x)
      If Len(nextline) <> 0 Then
         meulishi(x).Caption = nextline
      Else
         meulishi(x).Caption = Form1.CommonDialog2.FileName
      End If
    Next x
  Close #1
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Dim vb
 If ric.Text <> "" Then
   If meuEdite.Checked = True Then                               '//是否保存文件
     x = MsgBox("文档已经改变，是否保存改变", vbYesNoCancel + vbExclamation, "提示")
      If x = vbYes Then
           ric.SaveFile (CommonDialog2.FileName), rtfText
           Unload Form3
      ElseIf x = vbNo Then
           Unload Form3
      ElseIf x = vbCancel Then
           Cancel = 2
      End If
   End If
 Else
   DoEvents
 End If
End Sub

Private Sub Form_Resize()
 On Error Resume Next
  ric.Width = Form3.Width - 100                  '//保持文本框与窗体同样大小
  ric.Height = Form3.Height - 680
End Sub



Private Sub meu_C_Click()
   On Error Resume Next
   Dim x
    With CommonDialog2
      If .FileName = "" Then
       .FileName = "C++程序文件"                 '//保存为C++文件
      End If
       .FileName = "C++程序文件"
       .DialogTitle = "另存为"
       .Filter = "C++文件(*.cpp)|*.cpp|All Files(*.*)|*.*|"
       .ShowSave
     If Err.Number = cdlCancel Then Exit Sub
    End With
   ric.SaveFile (CommonDialog2.FileName), rtfText
End Sub

Private Sub meuAbout_Click()
  Dialog2.Show
End Sub

Private Sub meuAll_Click()
 With ric
   ric.SetFocus                                   '//全选
   .SelStart = 0
   .SelLength = Len(ric.Text)
 End With
   ric.SetFocus
End Sub

Private Sub meuC_Click()
  On Error Resume Next
   Dim x
    With CommonDialog2
      If .FileName = "" Then
       .FileName = "C程序文件"                 '//保存为C文件
      End If
       .FileName = "C程序文件"
       .DialogTitle = "另存为"
       .Filter = "C文件(*.c)|*.c|All Files(*.*)|*.*|"
       .ShowSave
     If Err.Number = cdlCancel Then Exit Sub
    End With
   ric.SaveFile (CommonDialog2.FileName), rtfText
End Sub

Private Sub meuColor_Click()
   On Error Resume Next
  CommonDialog2.ShowColor
  If Err.Number = cdlCancel Then Exit Sub
  
  ric.BackColor = CommonDialog2.Color
  
 
End Sub

Private Sub meuDelete_Click()
   ric.SetFocus
   ric.SelText = ""
   ric.SetFocus
End Sub

Private Sub meuEdite_Click()
       meuEdite.Checked = True
   'meuEdite.Checked = Not meuEdite.Checked
    If meuEdite.Checked = True Then
       mnuCut.Enabled = True
       mnuReDo.Enabled = True
       meuSave.Enabled = True
       mnuUndo.Enabled = True
       mnuPaste.Enabled = True
       mnuDelete.Enabled = True
       mnuCopy.Enabled = True
       meuNew.Enabled = True
       meuLeft.Enabled = True
       meuRight.Enabled = True
       'meuFirst.Enabled = False
       'meuTwo.Enabled = False
       'meuThree.Enabled = False
       meuMiddle.Enabled = True
       meuEditFont.Enabled = True
       meuTXT.Enabled = True
       meuRTF.Enabled = True
       ric.Locked = False
       meuNo.Checked = False
       meuSaveNow.Enabled = True
       ric.MousePointer = 0
    End If
End Sub

Private Sub meuEditFont_Click()
   On Error Resume Next
   With CommonDialog2
     .Flags = cdlCFBoth + cdlCFEffects                 '//字体类型
     .ShowFont
     .DialogTitle = "设置字体"
    If Err.Number = cdlCancel Then Exit Sub
   End With
  'Ric.SelStart = 0
  'Ric.SelLength = Len(Ric.Text)
  ric.SelFontName = CommonDialog2.FontName
  ric.SelBold = CommonDialog2.FontBold
  ric.SelItalic = CommonDialog2.FontItalic
  ric.SelFontSize = CommonDialog2.FontSize
  ric.SelColor = CommonDialog2.Color
  ric.SelStrikeThru = CommonDialog2.FontStrikethru
  ric.SelUnderline = CommonDialog2.FontUnderline
  'Ric.RightMargin = 100
  'Ric.SelLength = 0
End Sub

Private Sub meuExit_Click()
 Dim i As Integer
 On Error Resume Next
 If ric.Text <> "" Then
   If meuEdite.Checked = True Then