selectfile.frm

需要控件：Active Report 2.0(专业报表控件破解版)2.0下的ardespro2.dll和arpro2.dll ARVIEW2.OCX等文件。即可打开源代码。

       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()
   
    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()
    frmMain.Image1.Picture = LoadPicture(Text1)
    frmMain.WellPicture.PaintPicture frmMain.Image1.Picture, 0, 0, frmMain.ScaleWidth, frmMain.ScaleHeight
    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"
    Dir1.pAth = GetSetting(App.EXEName, "Settings", "PicDir", "")
    Text1.Text = GetSetting(App.EXEName, "Settings", "PicName", "")
    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
 
 SaveSetting App.EXEName, "Settings", "PicDir", Dir1.pAth
 SaveSetting App.EXEName, "Settings", "PicName", Text1.Text

End Sub

Private Sub HScroll1_Change()
DisplayPicture.Left = -HScroll1.Value
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