frmmdis.frm

vb做的看图系统

         Caption         =   "Add ExifDate"
      End
      Begin VB.Menu MnuSpace5 
         Caption         =   "-"
      End
      Begin VB.Menu MnuCopyTo 
         Caption         =   "Copy To"
      End
      Begin VB.Menu MnuMoveTo 
         Caption         =   "Move To"
      End
      Begin VB.Menu MNuSpace6 
         Caption         =   "-"
      End
      Begin VB.Menu MnuSmartMove 
         Caption         =   "Smart Move"
      End
      Begin VB.Menu MnuSendTo 
         Caption         =   "Send To"
         Begin VB.Menu MnuADrive 
            Caption         =   "A Drive"
         End
         Begin VB.Menu MnuSendtoFolder 
            Caption         =   "Folder"
         End
      End
      Begin VB.Menu MnuResize 
         Caption         =   "Resize"
      End
      Begin VB.Menu MnuSpace7 
         Caption         =   "-"
      End
      Begin VB.Menu MnuOpenWith 
         Caption         =   "Open With"
         Begin VB.Menu MnuPaint 
            Caption         =   "EZPaint"
         End
         Begin VB.Menu MnuPlugIn 
            Caption         =   "PlugIn"
            Begin VB.Menu MnuPlugIn1 
               Caption         =   "PlugIn 1"
               Index           =   0
            End
         End
         Begin VB.Menu MnuBurn 
            Caption         =   "Burn"
         End
      End
      Begin VB.Menu MnuDeskShortCut 
         Caption         =   "Desktop ShortCut"
      End
      Begin VB.Menu MnuSetWallPaper 
         Caption         =   "Set Wallpaper"
         Begin VB.Menu MnuWallStretch 
            Caption         =   "Stretch"
         End
         Begin VB.Menu MnuWallTile 
            Caption         =   "Tile"
         End
         Begin VB.Menu MnuWallCenter 
            Caption         =   "Center"
         End
      End
      Begin VB.Menu MnuBatchRename 
         Caption         =   "Batch Rename"
      End
      Begin VB.Menu MnuProperties 
         Caption         =   "Properties"
      End
   End
   Begin VB.Menu mnuWindow 
      Caption         =   "Window"
      Visible         =   0   'False
      Begin VB.Menu mnuWindowArrangeIcons 
         Caption         =   "Arrange Icons"
      End
      Begin VB.Menu mnuWindowTileVertical 
         Caption         =   "Tile Vertical"
      End
      Begin VB.Menu mnuWindowTileHorizontal 
         Caption         =   "Tile Horizontal"
      End
      Begin VB.Menu mnuWindowCascade 
         Caption         =   "Cascade"
      End
   End
   Begin VB.Menu MnuFolder 
      Caption         =   "Folder"
      Visible         =   0   'False
      Begin VB.Menu MnuFCreate 
         Caption         =   "Create"
      End
      Begin VB.Menu MnuFDelete 
         Caption         =   "Delete"
      End
      Begin VB.Menu MnuFRename 
         Caption         =   "Rename"
      End
      Begin VB.Menu MnuFRefresh 
         Caption         =   "Refresh"
      End
   End
End
Attribute VB_Name = "FrmMdi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：2007/10/12
'描    述：极速数码照片查看播放工具 Ver 2.02
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************

Option Explicit

Enum ImgOperation
    Rotate_90 = 1
    Rotate_180 = 2
    Rotate_270 = 3
    Flip_Vertical = 4
    Flip_Horizontal = 5
    Exif_Date = 6
    moveto = 7
    SmartMove = 8
    copyto = 9
    AddExifDate = 10
End Enum

Dim ShowDelPic As Boolean
Const DT_BOTTOM = &H8
Const DT_LEFT = &H0
Const DT_RIGHT = &H2
Dim FontAlign As Long
Dim Software$, ModiDate$
Dim CFile$, cFileName$

Private Sub cbPath_Click()
    GoPaths cbPath.Text
End Sub

Private Sub Dir1_Change()
    Dim NewPath$
    NewPath = Dir1.Path + IIf(Right$(Dir1.Path, 1) <> "\", "\", "")
    Dir1.Refresh
    LoadNewWin NewPath
    FilePath = NewPath + IIf(Right$(NewPath, 1) <> "\", "\", "")
End Sub

Private Sub Drive1_Change()
    On Error Resume Next
    Dir1.Path = Drive1.Drive
    If Err Then
        Drive1.Drive = Dir1.Path
    End If

End Sub

Private Sub Image2_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 2 Then PopupMenu MnuFolder
End Sub

Private Sub Image6_Click()
    Static T As Boolean
    If T Then
        Image6.Picture = ImageList1.ListImages(1).Picture
        ChkCRC = True
    Else
        Image6.Picture = ImageList1.ListImages(3).Picture
        ChkCRC = False
    End If
    T = Not T
End Sub

Private Sub ImgClosed_Click()
    If PicLeft.Tag = "closed" Then
        PicLeft.Width = 5175
        PicLeft.Tag = "Open"
        PicClosed.Left = 336
        'PicClosed.ToolTipText = "Clicked to closed"
        ImgClosed.ToolTipText = "单击关闭"
    Else
        PicLeft.Width = 120
        PicLeft.Tag = "closed"
        PicClosed.Left = 0
        'PicClosed.ToolTipText = "Clicked to open"
        ImgClosed.ToolTipText = "单击打开"
    End If
End Sub

Private Sub MDIForm_Load()
    Dim i%, PluginCount%
    ''On Error Resume Next
    Check1stTime
    SearchJpgType
    LoadPlugIns
    LoadPrintDate
    LoadFolderReg
    LoadMiscReg
    LoadWallPaper
    GoPaths StartPath
    PicExif.Left = PicPreview.Left
    LoadTitle
End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim retval As Boolean
    retval = ShowMsg("确认要退出本看图程序 ?", vbYesNo, "提示")
    If retval = True Then
        ClosedAll
    Else
        Cancel = -1
    End If
End Sub

Private Sub MDIForm_Resize()
    On Error Resume Next
    cbPath.Width = Picture1.ScaleWidth - cbPath.Left
End Sub

Private Sub MnuAddExifDate_Click()
    Me.MousePointer = 11
    Oper AddExifDate
    Me.MousePointer = 0
End Sub

Private Sub MnuADrive_Click()
    Me.MousePointer = 11
    SaveResize
    Me.MousePointer = 0
End Sub

Private Sub MnuBatchRename_Click()
    'Open BatchRename Form
    Dim foper As FrmOper
    Dim X1exif As cEXIF
    Dim fs, F, S, FExt
    Dim i%
    Set foper = New FrmOper
    Dim itmx As ListItem
    Set itmx = Me.ActiveForm.Lv1.SelectedItem
    Me.MousePointer = 11
    Set fs = CreateObject("Scripting.FileSystemObject")
    For Each itmx In Me.ActiveForm.Lv1.ListItems
        If itmx.Selected Then
            Set F = fs.GetFile(itmx.Key)
            i% = i% + 1
            SetAttr itmx.Key, vbArchive
            foper.LvRename.ListItems.Add i%, itmx.Key, itmx.Text ', itmx.Icon
            foper.LvRename.ListItems(i%).SubItems(1) = F.ParentFolder
            Set X1exif = New cEXIF
            If X1exif.Load(F.Path) = True Then
                FExt = X1exif.EXIFmodified
                If X1exif.EXIFmodified = "12:00:00 AM" Then
                    foper.LvRename.ListItems(i%).SubItems(2) = Format$(F.DateLastModified, "yyyy-mm-dd hh-nn-ss")
                Else
                    foper.LvRename.ListItems(i%).SubItems(2) = Format$(FExt, "yyyy-mm-dd hh-nn-ss")
                End If
            End If
            Set X1exif = Nothing
        End If
    Next
    Me.MousePointer = 0
    foper.Show 1
    Set foper = Nothing
    Set F = Nothing
    Set fs = Nothing
End Sub

Private Sub MnuBurn_Click()
    ShellExecute Me.hwnd, "open", BurnSoftware, " /w", vbNullString, SW_SHOWNORMAL
End Sub

Private Sub mnuCopy_Click()
    CFile = Me.ActiveForm.Lv1.SelectedItem.Key
    cFileName = Me.ActiveForm.Lv1.SelectedItem.Text
End Sub

Private Sub MnuCopyTo_Click()
    FilePath = Me.ActiveForm.Caption
    LastPathSelect = BrowseForFolderDlg(FilePath, "Select a folder", Me.hwnd)
    LastPathSelect = LastPathSelect + IIf(Right$(LastPathSelect, 1) <> "\", "\", "")
    Oper copyto
    SetKeyValue HKEY_CURRENT_USER, "XPViewer\Folder", "LastPathSelect", LastPathSelect, REG_SZ
End Sub

Private Sub MnuCut_Click()
    ShowPreview
End Sub

Private Sub mnuDelete_Click()
    ShowDelPic = True
    OperDelete
End Sub

Private Sub MnuDeskShortCut_Click()
    Me.MousePointer = 11
    fCreateShellLink "..\..\Desktop", Me.ActiveForm.Lv1.SelectedItem.Text, Me.ActiveForm.Lv1.SelectedItem.Key, ""
    Me.MousePointer = 0
End Sub

Private Sub MnuExifDate_Click()
    Oper Exif_Date
End Sub

Private Sub MnuFlipHorizontal_Click()
    Oper Flip_Horizontal
End Sub

Private Sub MnuFlipVertical_Click()
    Oper Flip_Vertical
End Sub

Private Sub MnuFRefresh_Click()
    GoPaths FilePath
End Sub

Private Sub MnuKill_Click()
    ShowDelPic = False
    OperDelete
End Sub

Private Sub MnuMoveTo_Click()
    FilePath = Me.ActiveForm.Caption
    LastPathSelect = BrowseForFolderDlg(FilePath, "Select a folder", Me.hwnd)
    LastPathSelect = LastPathSelect + IIf(Right$(LastPathSelect, 1) <> "\", "\", "")
    Oper moveto
    SetKeyValue HKEY_CURRENT_USER, "XPViewer\Folder", "LastPathSelect", LastPathSelect, REG_SZ
End Sub

Private Sub MnuPaste_Click()
    Me.MousePointer = 11
    DiskOps CFile, Me.ActiveForm.Caption & cFileName, F_CopySmart, 1
    MnuRefresh_Click
    Me.MousePointer = 0
End Sub

Private Sub MnuPlugIn1_Click(index As Integer)
    ShellExecute Me.hwnd, "open", PlugInSoftware(index + 1), Chr$(34) & Me.ActiveForm.Lv1.SelectedItem.Key & Chr$(34), vbNullString, SW_SHOWNORMAL
End Sub

Private Sub MnuProperties_Click()
    FileProperties Me.ActiveForm.Lv1.SelectedItem.Key
End Sub

Private Sub MnuRefresh_Click()
    Me.ActiveForm.RefreshLv Me.ActiveForm.Caption
End Sub

Private Sub MnuResize_Click()
    Me.MousePointer = 11
    FilePath = Me.ActiveForm.Caption
    ResizePic
    GotoForm FilePath
    Me.MousePointer = 0
End Sub

Private Sub MnuRotate180_Click()
    Oper Rotate_180
End Sub

Private Sub MnuRotate270_Click()
    Oper Rotate_270
End Sub

Private Sub MnuRotate90_Click()
    Oper Rotate_90
End Sub

Private Sub MnuSendtoFolder_Click()
    Me.MousePointer = 11
    SaveResizeCD CDBurnPath
    Me.MousePointer = 0