selectfile.frm

***** 展会管理系统 V1.1 共享版 ************** 一、安装 1.运行setup.exe文件； 2.如果不同意默认安装目录

VERSION 5.00
Begin VB.Form SelectFile 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "选择图片文件"
   ClientHeight    =   4005
   ClientLeft      =   45
   ClientTop       =   615
   ClientWidth     =   8385
   Icon            =   "SelectFile.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4005
   ScaleWidth      =   8385
   ShowInTaskbar   =   0   'False
   Begin VB.CheckBox Check2 
      BackColor       =   &H00C0C0C0&
      Caption         =   "自动大小"
      Enabled         =   0   'False
      ForeColor       =   &H00404000&
      Height          =   240
      Left            =   1500
      TabIndex        =   8
      Top             =   3090
      Width           =   1065
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      Height          =   3645
      Left            =   5340
      ScaleHeight     =   3585
      ScaleWidth      =   2865
      TabIndex        =   10
      Top             =   150
      Width           =   2925
      Begin VB.CommandButton Command3 
         Height          =   270
         Left            =   2610
         TabIndex        =   13
         Top             =   3330
         Visible         =   0   'False
         Width           =   270
      End
      Begin VB.HScrollBar HScroll1 
         Height          =   270
         LargeChange     =   1000
         Left            =   -15
         SmallChange     =   100
         TabIndex        =   12
         Top             =   3330
         Visible         =   0   'False
         Width           =   2640
      End
      Begin VB.VScrollBar VScroll1 
         Height          =   3360
         LargeChange     =   1000
         Left            =   2610
         SmallChange     =   100
         TabIndex        =   11
         Top             =   -15
         Visible         =   0   'False
         Width           =   270
      End
      Begin VB.Image DisplayPicture 
         Height          =   3600
         Left            =   -15
         MouseIcon       =   "SelectFile.frx":0442
         MousePointer    =   99  'Custom
         Top             =   -15
         Width           =   2880
      End
   End
   Begin VB.CheckBox Check1 
      Caption         =   "预览图片"
      ForeColor       =   &H00404000&
      Height          =   300
      Left            =   240
      TabIndex        =   7
      Top             =   3060
      Width           =   1155
   End
   Begin VB.ComboBox SelectType 
      Height          =   300
      Left            =   210
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   3480
      Width           =   2340
   End
   Begin VB.FileListBox File1 
      Height          =   1890
      Left            =   210
      TabIndex        =   1
      Top             =   1065
      Width           =   2340
   End
   Begin VB.CommandButton Command2 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   390
      Left            =   3480
      TabIndex        =   6
      Top             =   795
      Width           =   1380
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定(&O)"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   390
      Left            =   3480
      TabIndex        =   5
      Top             =   345
      Width           =   1380
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   2760
      TabIndex        =   3
      Top             =   3465
      Width           =   2235
   End
   Begin VB.DirListBox Dir1 
      Height          =   1770
      Left            =   2760
      TabIndex        =   4
      Top             =   1530
      Width           =   2235
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Left            =   225
      Locked          =   -1  'True
      TabIndex        =   0
      Top             =   660
      Width           =   2325
   End
   Begin VB.Label Label1 
      Caption         =   "文件名称及路径"
      Height          =   225
      Left            =   240
      TabIndex        =   9
      Top             =   270
      Width           =   1410
   End
   Begin VB.Menu MenuEdit 
      Caption         =   "编辑"
      Begin VB.Menu DelFile 
         Caption         =   "删除(&D)"
         Shortcut        =   ^D
      End
   End
End
Attribute VB_Name = "SelectFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Sx As Long, Sy As Long, Mx As Long, My As Long, LB As Boolean
Private Sub Check1_Click()
If Check1.Value = 1 Then
   SelectFile.Width = 8475
   Else
   SelectFile.Width = 5355
   DisplayPicture.Picture = LoadPicture()
   Exit Sub
End If
If Text1.Text <> "" Then
SelectFile.MousePointer = 11
On Error GoTo NOp
If Check2.Value = 1 Then
     DisplayPicture.Stretch = False
      Else
     DisplayPicture.Height = 3645
     DisplayPicture.Width = 2925
     DisplayPicture.Stretch = True
  End If
DisplayPicture.Picture = LoadPicture(Text1.Text)
  'Large photo display
  If Check2.Value = 1 Then
  HScroll1.Value = 0
  VScroll1.Value = 0
  HScroll1.Max = DisplayPicture.Width - Picture1.Width + 280
  VScroll1.Max = DisplayPicture.Height - Picture1.Height + 280
  VScroll1.Visible = Picture1.Height < DisplayPicture.Height
  HScroll1.Visible = Picture1.Width < DisplayPicture.Width
      If HScroll1.Visible Or VScroll1.Visible Then
        Command3.Visible = True
       Else
        Command3.Visible = False
      End If
  Else
   VScroll1.Visible = False
   HScroll1.Visible = False
   Command3.Visible = False
  End If
SelectFile.MousePointer = 0
End If
Exit Sub
NOp:
  MsgBox "图片出错，不能浏览！", vbOKOnly + 16, "图片不能安装"
  DisplayPicture.Picture = LoadPicture()
  SelectFile.MousePointer = 0
  Exit Sub
End Sub

Private Sub Check2_Click()
If Check1.Value = 1 Then
   If Check2.Value = 1 Then
     DisplayPicture.Stretch = False
     HScroll1.Value = 0
     VScroll1.Value = 0
     HScroll1.Max = DisplayPicture.Width - Picture1.Width + 280
     VScroll1.Max = DisplayPicture.Height - Picture1.Height + 280
     VScroll1.Visible = Picture1.Height < DisplayPicture.Height
     HScroll1.Visible = Picture1.Width < DisplayPicture.Width
        If HScroll1.Visible Or VScroll1.Visible Then
           Command3.Visible = True
         Else
           Command3.Visible = False
        End If
      Else
     DisplayPicture.Height = 3645
     DisplayPicture.Width = 2925
     DisplayPicture.Stretch = True
     DisplayPicture.Move 0, 0
     VScroll1.Visible = False
     HScroll1.Visible = False
     Command3.Visible = False
  End If
End If
End Sub

Private Sub Command1_Click()
ConfigForm.Text2.Text = Text1.Text
Unload Me
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Command3_Click()
If HScroll1.Value < HScroll1.Max - 100 Then
   HScroll1.Value = HScroll1.Value + 100
End If
If VScroll1.Value < VScroll1.Max - 100 Then
   VScroll1.Value = VScroll1.Value + 100
End If
End Sub

Private Sub DelFile_Click()
Dim DelOk As Integer
    DelOk = MsgBox("真的要删除文件：(Y/N) " & Chr(10) & Chr(13) & Text1.Text, vbYesNo + 16, "删除文件")
    If DelOk = 6 Then
       On Error GoTo KillErr
       Kill Text1.Text
       Text1.Text = ""
       If Check1.Value = 1 Then
          DisplayPicture.Picture = LoadPicture()
       End If
       File1.Refresh
      Else
       Exit Sub
    End If
Exit Sub
KillErr:
  MsgBox "删除文件错误，文件被打开或共享", vbOKOnly + 16, "警告"
  Exit Sub
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
Select Case SelectType.Text
  Case "位图文件|*.BMP"
       File1.Pattern = "*.bmp"
  Case "压缩文件|*.JPG"
       File1.Pattern = "*.jpg"
  Case "GIF文件|*.GIF"
       File1.Pattern = "*.gif"
  Case "图标文件|*.ICO"
       File1.Pattern = "*.ico"
  Case "WMF|*.WMF"
       File1.Pattern = "*.wmf"
  Case "EMF|*.EMF"
       File1.Pattern = "*.emf"
  Case "RLE|*.RLE"
       File1.Pattern = "*.rle"
End Select
Text1.Text = ""
End Sub

Private Sub DisplayPicture_DblClick()
If Command1.Enabled = True Then
   Call Command1_Click
End If
End Sub

Private Sub DisplayPicture_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   LB = True
   Sx = X
   Sy = Y
   DisplayPicture.MouseIcon = LoadPicture(Browser + "Smove.Cur")
End Sub

Private Sub DisplayPicture_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If HScroll1.Visible = True Or VScroll1.Visible = True Then
If LB = True Then
  Mx = X
  My = Y
  If HScroll1.Value + (Mx - Sx) / 50 <= HScroll1.Max And HScroll1.Value + (Mx - Sx) / 50 > 0 Then
     HScroll1.Value = HScroll1.Value + (Mx - Sx) / 50
  End If
  If VScroll1.Value + (My - Sy) / 50 <= VScroll1.Max And VScroll1.Value + (My - Sy) / 50 > 0 Then
     VScroll1.Value = VScroll1.Value + (My - Sy) / 50
  End If
End If
End If
If Text1.Text = "" Then
   DisplayPicture.ToolTipText = "没有图片装载"
    ElseIf Check2.Value = 1 Then
      DisplayPicture.ToolTipText = "图片：宽 " & DisplayPicture.Width / 15 & " 点、高 " & DisplayPicture.Height / 15 & " 点"
        Else
      DisplayPicture.ToolTipText = "要想显示图片大小，选取自动大小！"
End If
End Sub

Private Sub DisplayPicture_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  LB = False
  DisplayPicture.MouseIcon = LoadPicture(Browser + "Pmove.Cur")
End Sub

Private Sub Drive1_Change()
On Error GoTo Noread
Dir1.Path = Drive1.Drive
Text1.Text = ""
Exit Sub
Noread:
  Dim Okread As Integer
   Okread = MsgBox("" & Drive1.Drive & " 驱动器没有准备好！", vbRetryCancel + 16, "驱动器没有准备好！")
  If Okread = 4 Then
    Call Drive1_Change
  Else
   Drive1.Drive = Dir1.Path
   Text1.Text = ""
  End If
End Sub

Private Sub File1_Click()
Dim DirStr As String
DirStr = Dir1.Path
If Right(DirStr, 1) <> "\" Then
   DirStr = DirStr + "\"
End If
  DirStr = DirStr + File1.FileName
  Text1.Text = DirStr
If Check1.Value = 1 Then
  On Error GoTo PictureErr
  SelectFile.MousePointer = 11
  If Check2.Value = 1 Then
     DisplayPicture.Stretch = False
      Else
     DisplayPicture.Height = 3645
     DisplayPicture.Width = 2925
     DisplayPicture.Stretch = True
  End If
  DisplayPicture.Picture = LoadPicture(Text1.Text)
  'Large photo display
  If Check2.Value = 1 Then
  HScroll1.Value = 0
  VScroll1.Value = 0
  HScroll1.Max = DisplayPicture.Width - Picture1.Width + 280
  VScroll1.Max = DisplayPicture.Height - Picture1.Height + 280
  VScroll1.Visible = Picture1.Height < DisplayPicture.Height
  HScroll1.Visible = Picture1.Width < DisplayPicture.Width
   If HScroll1.Visible Or VScroll1.Visible Then
     Command3.Visible = True
      Else
     Command3.Visible = False
   End If
   Else
   VScroll1.Visible = False
   HScroll1.Visible = False
   Command3.Visible = False
  End If
End If
  SelectFile.MousePointer = 0
  Exit Sub
PictureErr:
  MsgBox "图片出错，不能浏览！", vbOKOnly + 16, "图片不能安装"
  DisplayPicture.Picture = LoadPicture()
  SelectFile.MousePointer = 0
  Exit Sub
End Sub

Private Sub File1_DblClick()
Call Command1_Click
End Sub

Private Sub File1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
   If File1.ListIndex >= 0 Then
      DelFile.Enabled = True
         Else
           DelFile.Enabled = False
             End If
      PopupMenu MenuEdit
End If
End Sub

Private Sub Form_Load()
MenuEdit.Visible = False
SelectFile.Width = 5355
SelectType.AddItem "位图文件|*.BMP", 0
SelectType.AddItem "压缩文件|*.JPG", 1
SelectType.AddItem "GIF文件|*.GIF", 2
SelectType.AddItem "图标文件|*.ICO", 3
SelectType.AddItem "WMF|*.WMF", 4
SelectType.AddItem "EMF|*.EMF", 5
SelectType.AddItem "RLE|*.RLE", 6
SelectType.ListIndex = 0
File1.Pattern = "*.bmp"
End Sub

Private Sub Form_Resize()
SelectFile.Left = (Screen.Width - SelectFile.Width) / 2
SelectFile.Top = (Screen.Height - SelectFile.Height) / 2
End Sub

Private Sub HScroll1_Change()
DisplayPicture.Left = -HScroll1.Value
End Sub

Private Sub PastFile_Click()

End Sub

Private Sub SelectType_Click()
Text1.Text = ""
Select Case SelectType.Text
  Case "位图文件|*.BMP"
       File1.Pattern = "*.bmp"
  Case "压缩文件|*.JPG"
       File1.Pattern = "*.jpg"
  Case "GIF文件|*.GIF"
       File1.Pattern = "*.gif"
  Case "图标文件|*.ICO"
       File1.Pattern = "*.ico"
  Case "WMF|*.WMF"
       File1.Pattern = "*.wmf"
  Case "EMF|*.EMF"
       File1.Pattern = "*.emf"
  Case "RLE|*.RLE"
       File1.Pattern = "*.rle"
End Select
  File1.Refresh
End Sub

Private Sub Text1_Change()
If Trim(Text1.Text) = "" Then
   Command1.Enabled = False
   DisplayPicture.Picture = LoadPicture()
   Check2.Enabled = False
   Else
   Command1.Enabled = True
   Check2.Enabled = True
End If
End Sub

Private Sub VScroll1_Change()
DisplayPicture.Top = -VScroll1.Value
End Sub