selectfile.frm

档案管理系统源码VB档案管理系统源码VB

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()
   
   On Error Resume Next
   
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.CC(5).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 = picDown.Picture
   
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 = picUP.Picture
  
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()

Me.Left = Val(GetSetting(App.EXEName, "SelectPhoto", "Left"))
Me.Top = Val(GetSetting(App.EXEName, "SelectPhoto", "Top"))

MenuEdit.Visible = False
SelectFile.Width = 5355
SelectType.AddItem "所有图片文件(*.*)", 0
SelectType.AddItem "位图文件|*.BMP", 1
SelectType.AddItem "压缩文件|*.JPG", 2
SelectType.AddItem "GIF文件|*.GIF", 3
SelectType.AddItem "图标文件|*.ICO", 4
SelectType.AddItem "WMF|*.WMF", 5
SelectType.AddItem "EMF|*.EMF", 6
SelectType.AddItem "RLE|*.RLE", 7
SelectType.ListIndex = 0
File1.Pattern = "*.bmp;*.jpg;*.gif;*.ico;*.wmf;*.emf;*.rle"
DisplayPicture.MousePointer = 99
DisplayPicture.MouseIcon = picUP.Picture

End Sub


Private Sub Form_Unload(Cancel As Integer)

 SaveSetting App.EXEName, "SelectPhoto", "Left", Me.Left
 SaveSetting App.EXEName, "SelectPhoto", "Top", Me.Top
 
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 "所有图片文件(*.*)"
       File1.Pattern = "*.bmp;*.jpg;*.gif;*.ico;*.wmf;*.emf;*.rle"
  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