frmdirbrowse.frm

VB6.0编写的医院影像系统

VERSION 5.00
Object = "{05B9F8C4-05D2-11D1-A081-444553540000}#1.0#0"; "NEWEX.OCX"
Begin VB.Form frmDirBrowse 
   BackColor       =   &H8000000A&
   Caption         =   "图像浏览"
   ClientHeight    =   6420
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9360
   Icon            =   "frmDirBrowse.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   6420
   ScaleWidth      =   9360
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox picCmd 
      BorderStyle     =   0  'None
      Height          =   1995
      Left            =   60
      ScaleHeight     =   1995
      ScaleWidth      =   3135
      TabIndex        =   2
      Top             =   4320
      Width           =   3135
      Begin VB.CommandButton cmdBrowse 
         Caption         =   "浏览"
         Height          =   435
         Left            =   0
         TabIndex        =   9
         Top             =   1500
         Width           =   915
      End
      Begin VB.Frame Frame1 
         Caption         =   "选项"
         Height          =   615
         Left            =   0
         TabIndex        =   7
         Top             =   720
         Width           =   3135
         Begin VB.CheckBox chkIncludeSub 
            Caption         =   "包含子目录"
            Height          =   315
            Left            =   120
            TabIndex        =   8
            Top             =   240
            Width           =   1275
         End
      End
      Begin VB.CommandButton cmdExit 
         Caption         =   "退出"
         Height          =   435
         Left            =   1080
         TabIndex        =   6
         Top             =   1500
         Width           =   915
      End
      Begin VB.Frame Frame2 
         Caption         =   "目录"
         Height          =   615
         Left            =   0
         TabIndex        =   4
         Top             =   0
         Width           =   3135
         Begin VB.Label lblDir 
            Height          =   195
            Left            =   120
            TabIndex        =   5
            Top             =   300
            Width           =   2955
         End
      End
      Begin VB.CommandButton cmdHelp 
         Caption         =   "帮助"
         Height          =   435
         Left            =   2220
         TabIndex        =   3
         Top             =   1500
         Width           =   915
      End
   End
   Begin NEWEXLib.ExplorerTree expTree 
      Height          =   4155
      Left            =   60
      TabIndex        =   1
      Top             =   60
      Width           =   3135
      _Version        =   65536
      _ExtentX        =   5530
      _ExtentY        =   7329
      _StockProps     =   161
      BackColor       =   16777215
      Appearance      =   1
   End
   Begin USNet.ImageBrowserControl IB 
      Height          =   6195
      Left            =   3300
      TabIndex        =   0
      Top             =   60
      Width           =   6015
      _ExtentX        =   10610
      _ExtentY        =   10927
   End
End
Attribute VB_Name = "frmDirBrowse"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Private Sub cmdBrowse_Click()
    
    '-----------------------------
    '浏览某目录下的所有文件
    '-----------------------------
    
    Dim cF As ImageFile
    
    IB.BrowseFolderImages expTree.Path, (chkIncludeSub.Value = 1)
    For Each cF In IB.ImageFiles
        Debug.Print cF.FileFullName
    Next cF
    
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub


Private Sub cmdHelp_Click()
    
    '帮助
    MsgBox "在「目录选择」中点击要显示的目录；" & vbCrLf & "双击图片或图片的标题可以编辑该图片；" & vbCrLf & "按「CTRL」键的同时可以选择多个文件。", vbQuestion + vbOKOnly, "帮助"
    
End Sub

Private Sub expTree_OnDirChanged()
    
    '改变lblDir的显示
    lblDir.Caption = expTree.Path
    
End Sub

Private Sub Form_Resize()
    
    '-----------------------------
    '重置控件大小
    '-----------------------------
    
    On Error Resume Next
    
    With IB
        .Move .Left, .Top, Me.ScaleWidth - .Left - 120, Me.ScaleHeight - .Top - 120
    End With
    picCmd.Top = Me.ScaleHeight - picCmd.height - 60
    expTree.height = picCmd.Top - 120
    
End Sub