frmchild.frm

《Visual Basic 6.0趣味程序导学》光盘

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form frmChild 
   Caption         =   "Form1"
   ClientHeight    =   4860
   ClientLeft      =   750
   ClientTop       =   975
   ClientWidth     =   6630
   BeginProperty Font 
      Name            =   "楷体_GB2312"
      Size            =   12
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmChild.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   324
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   442
   Begin RichTextLib.RichTextBox rtfText 
      Height          =   3165
      Left            =   375
      TabIndex        =   0
      Top             =   540
      Width           =   4845
      _ExtentX        =   8546
      _ExtentY        =   5583
      _Version        =   393217
      BorderStyle     =   0
      ScrollBars      =   3
      AutoVerbMenu    =   -1  'True
      OLEDragMode     =   0
      OLEDropMode     =   1
      TextRTF         =   $"frmChild.frx":08CA
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuFileNew 
         Caption         =   "新建(&N)"
         Shortcut        =   ^N
      End
      Begin VB.Menu mnuFileOpen 
         Caption         =   "打开(&O)..."
         Shortcut        =   ^O
      End
      Begin VB.Menu mnuFileClose 
         Caption         =   "关闭(&C)"
      End
      Begin VB.Menu mnuFileSave 
         Caption         =   "保存(&S)"
         Shortcut        =   ^S
      End
      Begin VB.Menu mnuFileSaveAs 
         Caption         =   "另存为(&A)..."
      End
      Begin VB.Menu mnuFilePrint 
         Caption         =   "打印(&P)"
         Shortcut        =   ^P
      End
      Begin VB.Menu mnuFilePageSetup 
         Caption         =   "打印机设置..."
      End
      Begin VB.Menu mnuBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit 
         Caption         =   "退出(&X)"
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "编辑(&E)"
      Begin VB.Menu mnuEditCut 
         Caption         =   "剪切"
      End
      Begin VB.Menu mnuEditCopy 
         Caption         =   "拷贝"
      End
      Begin VB.Menu mnuEditPaste 
         Caption         =   "粘贴"
      End
      Begin VB.Menu mnuEditDelete 
         Caption         =   "删除"
         Shortcut        =   {DEL}
      End
      Begin VB.Menu mnuBar2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuEditSelectAll 
         Caption         =   "全选"
         Shortcut        =   ^A
      End
      Begin VB.Menu mnuBar3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuEditUndo 
         Caption         =   "撤消"
      End
   End
   Begin VB.Menu mnuChar 
      Caption         =   "字符(&C)"
      Begin VB.Menu mnuCharLeft 
         Caption         =   "左对齐(&L)"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuCharRight 
         Caption         =   "右对齐(&R)"
      End
      Begin VB.Menu mnuCharCenter 
         Caption         =   "居中对齐(&C)"
      End
      Begin VB.Menu mnuBar4 
         Caption         =   "-"
      End
      Begin VB.Menu mnuCharWrap 
         Caption         =   "换行(&W)"
      End
      Begin VB.Menu mnuBar5 
         Caption         =   "-"
      End
      Begin VB.Menu mnuCharFont 
         Caption         =   "字体(&F)..."
      End
   End
   Begin VB.Menu mnuEight 
      Caption         =   "趣味作文(&P)"
      Begin VB.Menu mnuEightWoman 
         Caption         =   "印度女人"
      End
      Begin VB.Menu mnuEightDate 
         Caption         =   "约会"
      End
      Begin VB.Menu mnuEightNight 
         Caption         =   "世纪之夜"
      End
      Begin VB.Menu mnuEightSkeeter 
         Caption         =   "蚊子"
      End
      Begin VB.Menu mnuEightLone 
         Caption         =   "孤独"
      End
      Begin VB.Menu mnuEightPoem 
         Caption         =   "诗歌"
      End
   End
   Begin VB.Menu mnuWindow 
      Caption         =   "窗口(&W)"
      WindowList      =   -1  'True
      Begin VB.Menu mnuWindowTileHorizontal 
         Caption         =   "水平平铺(&H)"
      End
      Begin VB.Menu mnuWindowTileVertical 
         Caption         =   "垂直平铺(&V)"
      End
      Begin VB.Menu mnuWindowCascade 
         Caption         =   "层叠(&C)"
      End
      Begin VB.Menu mnuWindowArrangeIcon 
         Caption         =   "图标排列(&A)"
      End
   End
End
Attribute VB_Name = "frmChild"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public m_bModify As Boolean

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intResult As Integer
    If m_bModify Then
    '倘若文件被修改过则提示是否保存
        intResult = MsgBox("将所做的修改保存到 " & Me.Caption, vbYesNoCancel + vbQuestion, "关闭窗口")
        If intResult = vbCancel Then
            Cancel = 1
        ElseIf intResult = vbYes Then
            '保存文件后退出
            mnuFileSave_Click
            Cancel = 0
        Else
            '不保存退出
            Cancel = 0
        End If
    End If
End Sub
Private Sub mnuCharCenter_Click()
    '设定中间对齐
    mnuCharLeft.Checked = False
    mnuCharRight.Checked = False
    mnuCharCenter.Checked = True
    rtfText.SelAlignment = rtfCenter
End Sub


Private Sub mnuCharFont_Click()
    On Error GoTo FontError
    '用通用对话框设置字体
    With g_fMainForm.dlgCommonDialog
        .Flags = cdlCFBoth + cdlCFEffects
        .ShowFont
        .CancelError = True
    End With
    With rtfText
        .SelFontName = g_fMainForm.dlgCommonDialog.FontName
        .SelFontSize = g_fMainForm.dlgCommonDialog.FontSize
        .SelBold = g_fMainForm.dlgCommonDialog.FontBold
        .SelItalic = g_fMainForm.dlgCommonDialog.FontItalic
        .SelStrikeThru = g_fMainForm.dlgCommonDialog.FontStrikethru
        .SelUnderline = g_fMainForm.dlgCommonDialog.FontUnderline
    End With
    Exit Sub
FontError:
    Exit Sub
End Sub

Private Sub mnuCharLeft_Click()
    '设置为左对齐
    mnuCharLeft.Checked = True
    mnuCharRight.Checked = False
    mnuCharCenter.Checked = False
    rtfText.SelAlignment = rtfLeft
End Sub

Private Sub mnuCharRight_Click()
    '设置段落为右对齐
    mnuCharLeft.Checked = False
    mnuCharRight.Checked = True
    mnuCharCenter.Checked = False
    rtfText.SelAlignment = rtfRight
End Sub

Private Sub mnuCharWrap_Click()
    mnuCharWrap.Checked = Not mnuCharWrap.Checked
End Sub

Private Sub mnuEditSelectAll_Click()
    '选中所有内容
    rtfText.SelStart = 0
    rtfText.SelLength = Len(rtfText.TextRTF)
End Sub

Private Sub mnuEditUndo_Click()
    '向窗口发送ctrl+z键，自动执行撤消操作
    SendKeys "^Z"
End Sub

Private Sub mnuEightDate_Click()
    rtfText.SelRTF = "    找个顺眼的女人把儿子搞定，这是老妈最实际的打算。"
    rtfText.SelRTF = "在这种思想指引下，不断有好心人叫你去约会，"
    rtfText.SelRTF = "不断有女孩和你说再会，有点烦，又不算累，想逃跑，没机会。" & vbCrLf
    rtfText.SelRTF = "    不再老想初恋情人，可昨天表姐介绍的姑娘，"
    rtfText.SelRTF = "今天已经忘记了模样。也试着专心一意，可如今女孩"
    rtfText.SelRTF = "子流行多项选择，一不小心，你成了备份答案。" & vbCrLf
End Sub

Private Sub mnuEightLone_Click()
    rtfText.SelRTF = "生活得不算有品味，新鲜的东西老也学不会。" & vbCrLf
    rtfText.SelRTF = "去酒吧太吵，泡茶坊无味；" & vbCrLf
    rtfText.SelRTF = "打麻将不会，扔保龄太累；" & vbCrLf
    rtfText.SelRTF = "租房子有点贵，吃父母有点愧；" & vbCrLf
    rtfText.SelRTF = "谈不谈朋友有所谓，不想讨老婆对不对？" & vbCrLf
    rtfText.SelRTF = "装深沉咱也会，到头来还是不懂社会。" & vbCrLf
    rtfText.SelRTF = "晃一晃又快三十岁，每天晚上还是一个人跟自己睡。" & vbCrLf
End Sub

Private Sub mnuEightNight_Click()
    rtfText.SelRTF = "　　子夜过去，江水漆黑，这一段的江面没有霓虹。"
    rtfText.SelRTF = "预言的灾难没有发生，啤酒喝光后才发现这一晚只是寻常的一晚，"
    rtfText.SelRTF = "2000年又是一个成年人自欺欺人的童话。"
    rtfText.SelRTF = "我蒙头大睡，困得实在无法等到下世纪的第一缕曙光。"
    rtfText.SelRTF = "醒来时阳光普照，照在我通红的眼睛上，"
    rtfText.SelRTF = "我蓬头垢面地迎来了我的“新生”。带着上个结束处所有的烦恼和阵阵的头痛，"
    rtfText.SelRTF = "我掉进了另一个开端。我想，就在那一刻我得了嗜睡的毛病，"
    rtfText.SelRTF = "再见不到初升的太阳，在梦里也为我仍是旧的我感到气绥?" & vbCrLf
End Sub

Private Sub mnuEightPoem_Click()
    rtfText.SelRTF = "孤山寺北贾亭西，" & vbCrLf
    rtfText.SelRTF = "水面初平云脚低。" & vbCrLf
    rtfText.SelRTF = "几处早莺争暖树，" & vbCrLf
    rtfText.SelRTF = "谁家新燕啄春泥。 " & vbCrLf
    rtfText.SelRTF = "乱花渐欲迷人眼，" & vbCrLf
    rtfText.SelRTF = "浅草才能没马蹄。" & vbCrLf
    rtfText.SelRTF = "最爱湖东行不足，" & vbCrLf
    rtfText.SelRTF = "绿杨阴里白沙堤。" & vbCrLf
End Sub

Private Sub mnuEightSkeeter_Click()
    rtfText.SelRTF = "    尽管存有风险，但它不能放弃。它与我一样，定居于这间小屋里，"
    rtfText.SelRTF = "我是它唯一的食物来源，不从我的身上弄点吃的，它就没别的可吃了。"
    rtfText.SelRTF = "生存？抑或毁灭？它没有退路。意志与体力将经受考验?" & vbCrLf
End Sub

Private Sub mnuEightWoman_Click()
    rtfText.SelRTF = "……她只能生活在那里，她靠那个地方生活，"
    rtfText.SelRTF = "她靠印度、加尔各答每天分泌出来的绝望生活，"
    rtfText.SelRTF = "同样，她也因此而死，她死就像被印度毒死。" & vbCrLf
End Sub

Private Sub mnuFileClose_Click()
    '卸载当前的活动窗体
    Unload Me
End Sub

Private Sub mnuFileNew_Click()
    LoadNewDoc
End Sub
Private Sub mnuFileExit_Click()
    ExitProgram
End Sub

Private Sub mnuFileOpen_Click()
    OpenDoc
End Sub

Private Sub mnuWindowArrangeIcon_Click()
    g_fMainForm.Arrange vbArrangeIcons
End Sub

Private Sub mnuWindowTileVertical_Click()
    g_fMainForm.Arrange vbTileVertical
End Sub
Private Sub mnuWindowCascade_Click()
    g_fMainForm.Arrange vbCascade
End Sub

Private Sub mnuWindowTileHorizontal_Click()
    g_fMainForm.Arrange vbTileHorizontal
End Sub

Private Sub mnuFileSave_Click()
    '若是没有被保存过的文件则调用另存过程，否则保存文件
    Dim sFile As String
    If Left(Me.Caption, 4) = "未定标题" Then
        mnuFileSaveAs_Click
    Else
        sFile = Caption
        rtfText.SaveFile sFile
        m_bModify = False
    End If
End Sub
Private Sub mnuFileSaveAs_Click()
    Dim sFile As String
    '取得保存文件名，保存文件
    With g_fMainForm.dlgCommonDialog
        .DialogTitle = "Save As"
        .CancelError = False
        .Filter = "RTFText (*.rtf)|*.rtf|All Files (*.*)|*.*"
        .FilterIndex = 1
        .ShowSave
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With
    Caption = sFile
    rtfText.SaveFile sFile
    m_bModify = False
End Sub
Private Sub mnuFilePrint_Click()
    On Error Resume Next
    '用通用对话框打印文件
    With g_fMainForm.dlgCommonDialog
        .DialogTitle = "Print"
        .CancelError = True
        .Flags = cdlPDReturnDC + cdlPDNoPageNums
        If rtfText.SelLength = 0 Then
            .Flags = .Flags + cdlPDAllPages
        Else
            .Flags = .Flags + cdlPDSelection
        End If
        .ShowPrinter
        If Err <> MSComDlg.cdlCancel Then
            rtfText.SelPrint .hDC
        End If
    End With
End Sub

Private Sub mnuFilePageSetup_Click()
    On Error Resume Next
    '调用打印设置对话框
    With g_fMainForm.dlgCommonDialog
        .DialogTitle = "Page Setup"
        .CancelError = True
        .ShowPrinter
    End With
End Sub

Private Sub mnuEditPaste_Click()
    On Error Resume Next
    '从剪贴板粘贴文本
    rtfText.SelRTF = Clipboard.GetText
End Sub

Private Sub mnuEditCopy_Click()
    On Error Resume Next
    '把所选文本拷贝到剪贴板
    Clipboard.Clear
    Clipboard.SetText rtfText.SelRTF
End Sub

Private Sub mnuEditCut_Click()
    On Error Resume Next
    '把所选文本剪贴到剪贴板
    Clipboard.Clear
    Clipboard.SetText rtfText.SelRTF
    rtfText.SelText = vbNullString
End Sub

Private Sub mnuEditDelete_Click()
    '删除所选的文本
    rtfText.SelText = vbNullString
End Sub

Private Sub Form_Load()
    Form_Resize
End Sub


Private Sub Form_Resize()
    On Error Resume Next
    '子窗口大小变化时，文本框跟着变化
    rtfText.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
    rtfText.RightMargin = rtfText.Width
End Sub

Private Sub rtfText_Change()
    '如果文本有变化，则设置修改标志
    m_bModify = True
End Sub

Private Sub rtfText_OLEDragDrop(Data As RichTextLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    '从资源管理器里拖动文件到子窗口
    If Data.GetFormat(vbCFFiles) Then
        Dim vFN
        For Each vFN In Data.Files
            '打开文件
            LoadNewDoc
            g_fMainForm.ActiveForm.Caption = vFN
            g_fMainForm.ActiveForm.rtfText.LoadFile vFN
        Next vFN
    End If
End Sub