6-3.frm

vb6.0编程实例详解,很详细的介绍,对学习VB有帮助

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.MDIForm MDIForm1 
   BackColor       =   &H8000000C&
   Caption         =   "文件查看器"
   ClientHeight    =   6165
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   8700
   LinkTopic       =   "MDIForm1"
   OLEDropMode     =   1  'Manual
   StartUpPosition =   3  '窗口缺省
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   0
      Top             =   0
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Menu File 
      Caption         =   "文件（&F）"
      Begin VB.Menu Open 
         Caption         =   "打开（&O）"
      End
      Begin VB.Menu Close 
         Caption         =   "关闭（&C）"
      End
      Begin VB.Menu CloseAll 
         Caption         =   "全部关闭"
      End
      Begin VB.Menu Separete 
         Caption         =   "-"
      End
      Begin VB.Menu Exit 
         Caption         =   "退出（&E）"
      End
   End
   Begin VB.Menu Window 
      Caption         =   "窗口（&W）"
      WindowList      =   -1  'True
      Begin VB.Menu Cascade 
         Caption         =   "层叠"
      End
      Begin VB.Menu Tile 
         Caption         =   "平铺"
      End
      Begin VB.Menu ArrangeIcons 
         Caption         =   "重排图标"
      End
   End
End
Attribute VB_Name = "MDIForm1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim MaxSubForm As Integer

Private Sub OpenFile(FileName As String)
    '设置鼠标为沙漏
    Screen.MousePointer = 11
    
    If InStr(1, UCase(FileName), ".TXT") > 0 Then
        Dim f1 As New Form1 '创建文本编辑子窗口
        f1.RichTextBox1.LoadFile FileName, rtfText '打开文件
        f1.Caption = FileName '显示文件名
        MaxSubForm = MaxSubForm + 1 '增加最大子窗体数
    ElseIf InStr(1, UCase(FileName), ".RTF") > 0 Then
        Dim f2 As New Form1
        f2.RichTextBox1.LoadFile FileName, rtfRTF
        f2.Caption = FileName
        MaxSubForm = MaxSubForm + 1 '增加最大子窗体数
    ElseIf InStr(1, UCase(FileName), ".FRM") > 0 Then
        Dim f3 As New Form1
        f3.RichTextBox1.LoadFile FileName, rtfText
        f3.Caption = FileName
        MaxSubForm = MaxSubForm + 1 '增加最大子窗体数
    ElseIf InStr(1, UCase(FileName), ".BMP") > 0 Or _
           InStr(1, UCase(FileName), ".DIB") > 0 Or _
           InStr(1, UCase(FileName), ".GIF") > 0 Or _
           InStr(1, UCase(FileName), ".JPG") > 0 Then
        Dim f4 As New Form2 '创建图片显示子窗口
        f4.Picture2 = LoadPicture(FileName) '打开并显示图片
        f4.Caption = FileName
        f4.Init_Scroll '调整滚动条
        MaxSubForm = MaxSubForm + 1 '增加最大子窗体数
    End If
    '恢复鼠标显示
    Screen.MousePointer = 0
End Sub

Private Sub ArrangeIcons_Click()
    Me.Arrange vbArrangeIcons '排列图标
End Sub

Private Sub Cascade_Click()
    Me.Arrange vbCascade '层叠子窗口
End Sub

Private Sub Close_Click()
'关闭当前活动子窗体
    If MaxSubForm > 0 Then
        Unload Me.ActiveForm
        MaxSubForm = MaxSubForm - 1
    End If
End Sub

Private Sub CloseAll_Click()
'关闭所有子窗体
    Dim i As Integer
    
    For i = 1 To MaxSubForm
        Unload Me.ActiveForm
    Next i
End Sub

Private Sub Exit_Click()
    Unload Me '关闭主窗体
End Sub

Private Sub MDIForm_Load()
    MaxSubForm = 0
End Sub

Private Sub MDIForm_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
'系统完成 OLE 拖放时，触发该事件
    Dim i As Integer
    
    If Data.GetFormat(vbCFFiles) Then
    '拖放数据为文件名
        For i = 1 To Data.Files.Count
        '检索全部文件名
            OpenFile (Data.Files(i))
        Next i
    End If
End Sub

Private Sub Open_Click()
    Dim FileName As String '文件名
    
    With CommonDialog1
        '设置文件过滤器，注意字符串中的“|”符号。
        'Filter属性以“|”符号为分割符，单数列为显示文本，
        '双数列为实际过滤的文件类型。
        '如果需要过滤多中文件类型，可用“；”分割各项。
        .Filter = "所有支持的文件| *.txt;*.rtf;*.jpg;*.bmp;*.dib;*.frm" & _
                "| 文本文件 | *.txt" & _
                "| RTF 文件 | *.rtf" & _
                "| GIF 文件 | *.gif" & _
                "| JPEG 文件 | *.jpg" & _
                "| 位图文件 | *.bmp;*.dib" & _
                "| 窗体文件 （*.frm） | *.frm"
        .ShowOpen '显示“打开文件”对话框
        FileName = .FileName '保存输入（选择）文件名
    End With
    
    If Len(FileName) > 0 Then
    '有输入文件名
        OpenFile (FileName) '打开文件
    End If
End Sub

Private Sub Tile_Click()
    Me.Arrange vbTileHorizontal '平铺窗口
End Sub