📄 frmoper.frm
字号:
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 3
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "名称"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "路径"
Object.Width = 5292
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "相片日期"
Object.Width = 2540
EndProperty
End
Begin MSComctlLib.ListView LvSelect
Height = 2295
Left = 120
TabIndex = 12
Top = 3120
Width = 6975
_ExtentX = 12303
_ExtentY = 4048
View = 3
MultiSelect = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 2
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "名称"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "源文件"
Object.Width = 3528
EndProperty
End
End
Attribute VB_Name = "FrmOper"
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 ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Option Explicit
Dim DestFolder$
Private Sub cboDestFolder_Click()
DestFolder = cboDestFolder.Text
DestFolder = DestFolder + IIf(Right(DestFolder, 1) <> "\", "\", "")
End Sub
Private Sub cboDestFolder_KeyUp(KeyCode As Integer, Shift As Integer)
Dim i%
Dim Gotit As Boolean
On Error GoTo DestfolderErr
Gotit = False
If KeyCode = 13 Then
If Dir(cboDestFolder.Text, vbDirectory) = "" Then MkDir cboDestFolder.Text
cboDestFolder.Text = cboDestFolder.Text + IIf(Right$(cboDestFolder.Text, 1) <> "\", "\", "")
DestFolder = cboDestFolder.Text
For i% = 0 To cboDestFolder.ListCount - 1
If cboDestFolder.List(i%) = cboDestFolder.Text Then Gotit = True
Next i
If Not Gotit Then cboDestFolder.AddItem cboDestFolder.Text: cboDestFolder.ListIndex = cboDestFolder.ListCount - 1
End If
Exit Sub
DestfolderErr:
MsgBox cboDestFolder.Text & vbCrLf & Err.Description
Resume Next
End Sub
Private Sub cboPrefix_KeyUp(KeyCode As Integer, Shift As Integer)
Dim i%
Dim Gotit As Boolean
Gotit = False
If KeyCode = 13 Then
If Right$(cboPrefix.Text, 1) <> "#" Then Exit Sub
For i% = 0 To cboPrefix.ListCount - 1
If cboPrefix.List(i%) = cboPrefix.Text Then Gotit = True
Next i
If Not Gotit Then cboPrefix.AddItem cboPrefix.Text: cboPrefix.ListIndex = cboPrefix.ListCount - 1
End If
End Sub
Sub Convert()
If InStr(1, cboPrefix.Text, "Time Stamp") > 0 Then
TimeStamp
Else
If InStr(1, cboPrefix.Text, "Original") > 0 Then
CopyOriginal
Else
'MoveSelectedFile
ConvertFName
End If
End If
End Sub
Sub ConvertFName()
Dim i%, j%
Dim PrefixLen As Integer
Dim itmx As ListItem
Dim formatLen As String
Dim start As Integer
If LvRename.ListItems.Count = 0 Then
MsgBox "没有选择文件!", vbInformation, "提示"
Exit Sub
End If
If InStr(1, cboPrefix.Text, "#") = 0 Then
MsgBox "图片前缀必须是 :'Img#' 或者 'image###'", vbInformation, "提示"
Exit Sub
End If
If Val(TxtStart.Text) < 0 Then
MsgBox "其实数字必须大于 '0'", vbInformation, "提示"
TxtStart.SelStart = 0
TxtStart.SelLength = Len(TxtStart)
TxtStart.SetFocus
Exit Sub
End If
PrefixLen = Len(Mid$(cboPrefix.Text, InStr(1, cboPrefix.Text, "#")))
Dim PreFix$
PreFix$ = Mid$(cboPrefix.Text, 1, Len(cboPrefix.Text) - PrefixLen)
formatLen = "0"
For i% = 1 To PrefixLen - 1
formatLen = formatLen & "0"
Next i%
LvSelect.ListItems.Clear
With LvRename
For i% = 1 To .ListItems.Count
j% = i% + Val(TxtStart.Text) - 1
Set itmx = LvSelect.ListItems.Add(, DestFolder & PreFix & Format$(Trim$(j%), formatLen) & ".JPG", PreFix & Format$(Trim$(j%), formatLen) & ".JPG")
itmx.SubItems(1) = .ListItems(i%).Key
Next
End With
End Sub
Sub CopyOriginal()
Dim i%
Dim itmx As ListItem
If LvRename.ListItems.Count = 0 Then
MsgBox "没有选择文件!", vbInformation, "提示"
Exit Sub
End If
LvSelect.ListItems.Clear
With LvRename
For i% = 1 To .ListItems.Count
Set itmx = LvSelect.ListItems.Add(, DestFolder & .ListItems(i).Text, .ListItems(i).Text)
itmx.SubItems(1) = .ListItems(i%).Key
Next
End With
End Sub
Sub TimeStamp()
Dim i%
Dim itmx As ListItem
Dim MsgErr As String
Dim ErrLoad As Boolean
On Error GoTo TErr
ErrLoad = False
If LvRename.ListItems.Count = 0 Then
MsgBox "没有选择文件!", vbInformation, "提示"
Exit Sub
End If
With LvRename
For i% = 1 To .ListItems.Count
Set itmx = LvSelect.ListItems.Add(, DestFolder & .ListItems(i).Text, .ListItems(i).SubItems(2) & ".JPG")
itmx.SubItems(1) = .ListItems(i%).Key
Next
End With
Set itmx = Nothing
If ErrLoad Then MsgBox "文件 :" & vbCrLf & MsgErr & vbCrLf & "时间戳错误!", vbOKOnly, "提示"
Exit Sub
TErr:
MsgErr = MsgErr & "文件前缀" & vbCrLf
ErrLoad = True
Resume Next
End Sub
Private Sub Form_Load()
LoadAllValue
End Sub
Private Sub Image3_MouseDown(index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then Image3(3).Picture = Image3(1).Picture
End Sub
Private Sub Image3_MouseUp(index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then Image3(3).Picture = Image3(0).Picture
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then DragForm Me
End Sub
Private Sub TMcmdFolder_Click()
Dim Folder As String
Folder = BrowseForFolderDlg(cboDestFolder.Text, "选择源文件", Me.hwnd)
If Folder <> "" Then
cboDestFolder.Text = Folder
End If
'tempfolder = cboDestFolder.Text
cboDestFolder_KeyUp 13, 1
End Sub
Private Sub TMcmdOK_Click()
SaveAllValue
Unload Me
End Sub
Sub LoadAllValue()
Dim DestCount%, PreCount%, i%
DestCount = Val(QueryValue(HKEY_CURRENT_USER, "XPViewer\Folder\DestFolder", "DestCount"))
For i% = 1 To DestCount
cboDestFolder.AddItem QueryValue(HKEY_CURRENT_USER, "XPViewer\Folder\DestFolder", "Dest " & Trim$(i%))
Next i%
PreCount = Val(QueryValue(HKEY_CURRENT_USER, "XPViewer\Prefix", "PreCount"))
For i% = 1 To PreCount
cboPrefix.AddItem QueryValue(HKEY_CURRENT_USER, "XPViewer\Prefix", "Pre " & Trim$(i%))
Next
cboPrefix.ListIndex = 0
End Sub
Sub SaveAllValue()
Dim i%
Dim ret
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Prefix", "PreCount", cboPrefix.ListCount, REG_SZ
For i% = 1 To cboPrefix.ListCount
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Prefix", "Pre " & Trim$(i%), cboPrefix.List(i - 1), REG_SZ
Next i%
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Folder\DestFolder", "DestCount", cboDestFolder.ListCount, REG_SZ
For i% = 1 To cboDestFolder.ListCount
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Folder\DestFolder", "Dest " & Trim$(i%), cboDestFolder.List(i% - 1), REG_SZ
Next i%
End Sub
Private Sub TMcmdCancel_Click()
Unload Me
End Sub
Private Sub TMcmdRename_Click()
On Error GoTo FCopyErr
Dim i%
With LvSelect
For i% = 1 To .ListItems.Count
FileCopy .ListItems(i%).SubItems(1), DestFolder & .ListItems(i%).Text
AddMsg "复制 " & .ListItems(i%).Text & "..."
Next
End With
AddMsg "完成."
Exit Sub
FCopyErr:
If Err.Number = 70 Then ShowMsg "源文件和目标文件路径相同!", vbOKOnly, "更名错误"
Resume Next
End Sub
Private Sub TMcmdSelect_Click()
Convert
End Sub
Sub MoveSelectedFile()
Dim formatLen As String
Dim PreFix$, PrefixLen%
Dim i%, j%
Dim itmx As ListItem
PrefixLen = Len(Mid$(cboPrefix.Text, InStr(1, cboPrefix.Text, "#")))
PreFix$ = Mid$(cboPrefix.Text, 1, Len(cboPrefix.Text) - PrefixLen)
formatLen = "0"
For i% = 1 To PrefixLen - 1
formatLen = formatLen & "0"
Next i%
With LvRename
For i% = 1 To .ListItems.Count
If .ListItems(i%).Selected = True Then
j% = i% + Val(TxtStart.Text) - 1
Set itmx = LvSelect.ListItems.Add(, DestFolder & PreFix & Format$(Trim$(i%), formatLen) & ".JPG", PreFix & Format$(Trim$(j%), formatLen) & ".JPG")
itmx.SubItems(1) = .ListItems(i%).Key
End If
Next
End With
End Sub
Sub AddMsg(Msg As String)
LstProcess.AddItem Msg
LstProcess.ListIndex = LstProcess.ListCount - 1
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -