VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form ReNameListForm 
   BorderStyle     =   3  '固定ﾀﾞｲｱﾛｸﾞ
   Caption         =   "フォルダ選択"
   ClientHeight    =   4515
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9135
   BeginProperty Font 
      Name            =   "ＭＳ ゴシック"
      Size            =   12
      Charset         =   128
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "ReNameList.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4515
   ScaleWidth      =   9135
   StartUpPosition =   1  'ｵｰﾅｰ ﾌｫｰﾑの中央
   Begin VB.CommandButton cmdDown 
      Caption         =   "▼"
      BeginProperty Font 
         Name            =   "ＭＳ ゴシック"
         Size            =   9.75
         Charset         =   128
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   975
      Left            =   4320
      TabIndex        =   4
      Top             =   3120
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.CommandButton cmdDel 
      Caption         =   "×"
      BeginProperty Font 
         Name            =   "ＭＳ ゴシック"
         Size            =   9.75
         Charset         =   128
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   855
      Left            =   4320
      TabIndex        =   3
      Top             =   1920
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.CommandButton cmdUp 
      Caption         =   "▲"
      BeginProperty Font 
         Name            =   "ＭＳ ゴシック"
         Size            =   9.75
         Charset         =   128
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   975
      Left            =   4320
      TabIndex        =   2
      Top             =   600
      Visible         =   0   'False
      Width           =   255
   End
   Begin MSComctlLib.ProgressBar prgGauge 
      Align           =   2  '下揃え
      Height          =   255
      Left            =   0
      TabIndex        =   17
      Top             =   4260
      Width           =   9135
      _ExtentX        =   16113
      _ExtentY        =   450
      _Version        =   393216
      Appearance      =   1
      Enabled         =   0   'False
   End
   Begin VB.ListBox lstChangeFileList 
      BeginProperty Font 
         Name            =   "ＭＳ ゴシック"
         Size            =   9
         Charset         =   128
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3480
      IMEMode         =   3  'ｵﾌ固定
      Left            =   240
      Sorted          =   -1  'True
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   600
      Visible         =   0   'False
      Width           =   4050
   End
   Begin VB.TextBox txtStartCnt 
      Height          =   300
      IMEMode         =   2  'ｵﾌ
      Left            =   6720
      MaxLength       =   9
      TabIndex        =   7
      Text            =   "1"
      Top             =   1200
      Width           =   1260
   End
   Begin VB.CommandButton cmdSetFolder 
      Caption         =   "フォルダ確定"
      BeginProperty Font 
         Name            =   "ＭＳ ゴシック"
         Size            =   11.25
         Charset         =   128
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4800
      TabIndex        =   9
      Top             =   2520
      Width           =   4095
   End
   Begin VB.TextBox txtChangeFileName 
      Height          =   300
      Left            =   6720
      TabIndex        =   8
      Text            =   "Temp_"
      Top             =   1680
      Width           =   2220
   End
   Begin VB.TextBox txtColCnt 
      Height          =   300
      IMEMode         =   2  'ｵﾌ
      Left            =   6720
      MaxLength       =   1
      TabIndex        =   6
      Text            =   "3"
      Top             =   720
      Width           =   300
   End
   Begin VB.TextBox txtExtension 
      Height          =   300
      IMEMode         =   2  'ｵﾌ
      Left            =   6720
      TabIndex        =   5
      Text            =   "JPEG"
      Top             =   240
      Width           =   1260
   End
   Begin VB.DirListBox dirListBox 
      BeginProperty Font 
         Name            =   "ＭＳ ゴシック"
         Size            =   9
         Charset         =   128
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3450
      IMEMode         =   1  'ｵﾝ
      Left            =   240
      TabIndex        =   0
      Top             =   600
      Width           =   4335
   End
   Begin VB.CommandButton cmdEnd 
      Caption         =   "終了"
      BeginProperty Font 
         Name            =   "ＭＳ ゴシック"
         Size            =   11.25
         Charset         =   128
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4800
      TabIndex        =   11
      Top             =   3720
      Width           =   4095
   End
   Begin VB.CommandButton cmdDisposition 
      Caption         =   "付番開始"
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "ＭＳ ゴシック"
         Size            =   11.25
         Charset         =   128
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4800
      TabIndex        =   10
      Top             =   3120
      Width           =   4095
   End
   Begin VB.DriveListBox drvDriveList 
      BeginProperty Font 
         Name            =   "ＭＳ ゴシック"
         Size            =   9
         Charset         =   128
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   240
      TabIndex        =   12
      Top             =   120
      Width           =   4335
   End
   Begin VB.Label lblTitle 
      AutoSize        =   -1  'True
      Caption         =   "変更対象ファイルの並び替え順一覧"
      Height          =   240
      Left            =   240
      TabIndex        =   18
      Top             =   270
      Visible         =   0   'False
      Width           =   3840
   End
   Begin VB.Label lblStartCnt 
      Alignment       =   1  '右揃え
      AutoSize        =   -1  'True
      BackStyle       =   0  '透明
      Caption         =   "開始数値"
      Height          =   240
      Left            =   5520
      TabIndex        =   15
      Top             =   1245
      Width           =   960
   End
   Begin VB.Label lblChangeFileName 
      Alignment       =   1  '右揃え
      AutoSize        =   -1  'True
      BackStyle       =   0  '透明
      Caption         =   "統一ファイル名"
      Height          =   240
      Left            =   4800
      TabIndex        =   16
      Top             =   1725
      Width           =   1680
   End
   Begin VB.Label lblColCnt 
      Alignment       =   1  '右揃え
      AutoSize        =   -1  'True
      BackStyle       =   0  '透明
      Caption         =   "数値桁数"
      Height          =   240
      Left            =   5520
      TabIndex        =   14
      Top             =   765
      Width           =   960
   End
   Begin VB.Label lblExtension 
      Alignment       =   1  '右揃え
      AutoSize        =   -1  'True
      BackStyle       =   0  '透明
      Caption         =   "変更対象拡張子"
      Height          =   240
      Left            =   4800
      TabIndex        =   13
      Top             =   270
      Width           =   1680
   End
End
Attribute VB_Name = "ReNameListForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdUp_Click()
    Dim lngLocate As Long
    Dim strFileNameWork As String

    '/////  選択されている場合  /////
    If lstChangeFileList.ListIndex >= 0 And lstChangeFileList.ListIndex > 0 Then
        '/////  現在の情報取得  /////
        lngLocate = lstChangeFileList.ListIndex
        strFileNameWork = lstChangeFileList.List(lngLocate)
        '/////  ファイルを対象一覧から削除  /////
        lstChangeFileList.RemoveItem lstChangeFileList.ListIndex
        '/////  ファイル再設定  /////
        lstChangeFileList.AddItem strFileNameWork, lngLocate - 1
        '/////  連続設定できるようにするためフォーカスを戻す  /////
        lstChangeFileList.SetFocus
        lstChangeFileList.ListIndex = lngLocate - 1
    End If
End Sub

Private Sub cmdDown_Click()
    Dim lngLocate As Long
    Dim strFileNameWork As String

    '/////  選択されている場合  /////
    If lstChangeFileList.ListIndex >= 0 And lstChangeFileList.ListIndex < lstChangeFileList.ListCount - 1 Then
        '/////  現在の情報取得  /////
        lngLocate = lstChangeFileList.ListIndex
        strFileNameWork = lstChangeFileList.List(lngLocate)
        '/////  ファイルを対象一覧から削除  /////
        lstChangeFileList.RemoveItem lstChangeFileList.ListIndex
        '/////  ファイル再設定  /////
        lstChangeFileList.AddItem strFileNameWork, lngLocate + 1
        '/////  連続設定できるようにするためフォーカスを戻す  /////
        lstChangeFileList.SetFocus
        lstChangeFileList.ListIndex = lngLocate + 1
    End If
End Sub

Private Sub cmdDel_Click()
    Dim lngLocate As Long

    '/////  選択されている場合  /////
    If lstChangeFileList.ListIndex >= 0 Then
        '/////  現在の情報取得  /////
        lngLocate = lstChangeFileList.ListIndex
        '/////  ファイルを対象一覧から削除  /////
        lstChangeFileList.RemoveItem lstChangeFileList.ListIndex
        '/////  リスト件数が無くなった場合  /////
        If lstChangeFileList.ListCount <= 0 Then
            '/////  各項目を使用不可能に設定  /////
            lstChangeFileList.Enabled = False
            cmdUp.Visible = False
            cmdDel.Visible = False
            cmdDown.Visible = False
            cmdDisposition.Enabled = False
            Exit Sub
        End If
        '/////  連続設定できるようにするためフォーカスを戻す  /////
        lstChangeFileList.SetFocus
        '/////  同じ位置に選択できるファイル名がある場合
        If lstChangeFileList.ListCount > lngLocate Then
            lstChangeFileList.ListIndex = lngLocate
        Else
            lstChangeFileList.ListIndex = lngLocate - 1
        End If
    End If
End Sub

Private Sub cmdDisposition_Click()
    Dim lngRetCnt As Long

    '/////  桁数チェック  /////
    If IsNumeric(txtColCnt.Text) = False Then
        MsgBox "桁数の設定値が不正です", vbExclamation, "桁数設定値エラー"
        txtColCnt.SetFocus
        Exit Sub
    End If
    '/////  開始数値チェック  /////
    If IsNumeric(txtStartCnt.Text) = False Then
        MsgBox "開始数値の設定値が不正です", vbExclamation, "開始数値設定値エラー"
        txtStartCnt.SetFocus
        Exit Sub
    End If
    '/////  開始数値チェック  /////
    If CLng(txtStartCnt.Text) < 0 Then
        MsgBox "開始数値の設定値が不正です", vbExclamation, "開始数値設定値エラー"
        txtStartCnt.SetFocus
        Exit Sub
    End If
    '/////  リスト件数が存在しない場合  /////
    If lstChangeFileList.ListCount <= 0 Then
        MsgBox "処理対象のファイルがありません", vbExclamation, "処理対象エラー"
        lstChangeFileList.SetFocus
        Exit Sub
    End If

    '/////  ファイル名変更開始  /////
    lngRetCnt = SetReNameList()

    '/////  処理完了通知  /////]
    If lngRetCnt > 0 Then
        MsgBox CStr(lngRetCnt) & " 件の処理を行いました", vbOKOnly, "処理完了"
    Else
        MsgBox "処理を行いませんでした", vbOKOnly, "処理終了"
    End If
End Sub

Private Sub cmdEnd_Click()
    '/////  終了  /////
    Unload Me
End Sub

Private Sub cmdSetFolder_Click()
    '/////  画面表示切替  /////
    Call DisplayModeChange
End Sub

Private Sub drvDriveList_Change()
    On Error Resume Next
    '/////  ドライブ変更  /////
    dirListBox.Path = drvDriveList.Drive
End Sub

Private Sub dirListBox_KeyDown(KeyCode As Integer, Shift As Integer)
    '/////  キーが押された場合  /////
    Select Case KeyCode
    Case vbKeyReturn    '/エンターキー
        '/////  フォルダを選択  /////
        dirListBox.Path = dirListBox.List(dirListBox.ListIndex)
    End Select
End Sub

Private Sub Form_Load()
    '/////  ツールトピック設定  /////
    cmdUp.ToolTipText = "上段に移動"
    cmdDel.ToolTipText = "対象ファイル一覧から削除"
    cmdDown.ToolTipText = "下段に移動"
End Sub

Private Sub txtChangeFileName_GotFocus()
    '/////  テキストボックスの文字列を全体選択  /////
    txtChangeFileName.SelStart = 0
    txtChangeFileName.SelLength = Len(txtChangeFileName.Text)
End Sub

Private Sub txtColCnt_GotFocus()
    '/////  テキストボックスの文字列を全体選択  /////
    txtColCnt.SelStart = 0
    txtColCnt.SelLength = Len(txtColCnt.Text)
End Sub

Private Sub txtExtension_GotFocus()
    '/////  テキストボックスの文字列を全体選択  /////
    txtExtension.SelStart = 0
    txtExtension.SelLength = Len(txtExtension.Text)
End Sub

Private Sub txtStartCnt_GotFocus()
    '/////  テキストボックスの文字列を全体選択  /////
    txtStartCnt.SelStart = 0
    txtStartCnt.SelLength = Len(txtStartCnt.Text)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    '/////  プログラム解放  /////
    Set ReNameListForm = Nothing
    '/////  プログラム終了  /////
    End
End Sub

Private Sub DisplayModeChange()
    '/////  表示切替設定  /////
    If dirListBox.Visible = True Then
        '/////  フォルダ確定  /////
        '/////  表示モード変更  /////
        cmdSetFolder.Caption = "フォルダ確定解除"
        drvDriveList.Visible = False
        dirListBox.Visible = False
        lblTitle.Visible = True
        lstChangeFileList.Visible = True
        cmdUp.Visible = True
        cmdDel.Visible = True
        cmdDown.Visible = True
        cmdDisposition.Enabled = True
        '/////  入力不可領域設定  /////
        txtExtension.Enabled = False
        txtColCnt.Enabled = False
        txtStartCnt.Enabled = False
        txtChangeFileName.Enabled = False
        lstChangeFileList.Enabled = True
        '/////  変更対象リスト作成  /////
        Call SetChangeFileList
        '/////  フォーカス設定  /////
        lstChangeFileList.SetFocus
    Else
        '/////  フォルダ確定解除  /////
        '/////  表示モード変更  /////
        cmdSetFolder.Caption = "フォルダ確定"
        drvDriveList.Visible = True
        dirListBox.Visible = True
        lblTitle.Visible = False
        lstChangeFileList.Visible = False
        cmdUp.Visible = False
        cmdDel.Visible = False
        cmdDown.Visible = False
        cmdDisposition.Enabled = False
        '/////  入力可能領域設定  /////
        txtExtension.Enabled = True
        txtColCnt.Enabled = True
        txtStartCnt.Enabled = True
        txtChangeFileName.Enabled = True
        lstChangeFileList.Enabled = False
    End If
End Sub

Private Function GetExtension(ByVal strFileName As String) As String
    Dim lngCutPoint As Long

    '拡張子位置を検索
    lngCutPoint = InStr(1, strFileName, ".", vbTextCompare)
    If lngCutPoint > 0 Then
        '拡張子有り
        GetExtension = LCase(Mid(strFileName, lngCutPoint))
    Else
        '拡張子無し
        GetExtension = ""
    End If
End Function

Private Function SetChangeFileList() As Long
    Dim strWork As String
    Dim lngCnt As Long

    '/////  初期化  /////
    SetChangeFileList = 0
    lstChangeFileList.Clear
    lngCnt = 0

    '/////  検索先フォルダ設定  /////
    strWork = Dir(dirListBox.Path & "\" & "*." & txtExtension.Text, vbNormal)
    '/////  ファイル名が無くなるまで検索  /////
    Do While strWork <> ""
        '/////  自分のファイルは名前を変更しない  /////
        If UCase(App.EXEName & ".EXE") <> UCase(strWork) Then
            '/////  処理対象ファイル一覧に追加  /////
            lstChangeFileList.AddItem strWork
            lngCnt = lngCnt + 1
        End If
        strWork = Dir
    Loop
    '/////  連番桁数自動補正  /////
    If Len(txtStartCnt.Text) > CLng(txtColCnt.Text) Then
        txtColCnt.Text = Len(txtStartCnt.Text)
    End If

    '/////  該当数設定  /////
    SetChangeFileList = lngCnt
End Function

Private Function SetReNameList() As Long
    Dim lngi As Long
    Dim lngRet As Long
    Dim strWork As String
    Dim strPutPath As String
    Dim lngSubCnt As Long
    Dim strSubFileName() As String
    Dim strSubChangeFileName() As String

    On Error Resume Next

    '/////  初期化  /////
    SetReNameList = 0
    lngSubCnt = 0

    '/////  最終実行確認メッセージ編集  /////
    strWork = txtChangeFileName.Text & _
              Format(CLng(txtStartCnt.Text), String(CLng(txtColCnt.Text), "0")) & " 〜 " & _
              txtChangeFileName.Text & _
              Format(CLng(txtStartCnt.Text) + lstChangeFileList.ListCount - 1, String(CLng(txtColCnt.Text), "0"))
    strWork = strWork & " の範囲で変更します" & Chr(13) & "ファイル名を変更よろしいですか？"
    '/////  最終実行確認メッセージ表示  /////
    lngRet = MsgBox(strWork, vbYesNo + vbQuestion, "最終確認")
    '/////  キャンセルの場合  /////
    If lngRet <> vbYes Then
        Exit Function
    End If

    '/////  ゲージ初期化  /////
    prgGauge.Value = 0
    prgGauge.Max = lstChangeFileList.ListCount
    '/////  ゲージ更新  /////
    prgGauge.Refresh

    '/////  ファイル名整理開始  /////
    strPutPath = dirListBox.Path
    For lngi = 0 To lstChangeFileList.ListCount - 1 Step 1
        '/////  リネーム名設定  /////
        strWork = txtChangeFileName.Text & _
                  Format(CStr(lngi) + CLng(txtStartCnt.Text), String(CLng(txtColCnt.Text), "0")) & _
                  GetExtension(lstChangeFileList.List(lngi))
        '/////  同じ名前以外で、変更ファイル名が既に存在している場合  /////
        If strPutPath & "\" & lstChangeFileList.List(lngi) <> strPutPath & "\" & strWork And _
           Len(Dir(strPutPath & "\" & lstChangeFileList.List(lngi))) > 0 Then
            '/////  全てのファイル名変更後に変更できるかもしれないので保留  /////
            '/////  変更ファイル名  /////
            ReDim Preserve strSubFileName(lngSubCnt)
            strSubFileName(lngSubCnt) = strPutPath & "\" & lstChangeFileList.List(lngi)
            '/////  元ファイル名  /////
            ReDim Preserve strSubChangeFileName(lngSubCnt)
            strSubChangeFileName(lngSubCnt) = strPutPath & "\" & strWork
            '/////  カウントアップ  /////
            lngSubCnt = lngSubCnt + 1
        Else
            '/////  リネーム設定  /////
            Name strPutPath & "\" & lstChangeFileList.List(lngi) As strPutPath & "\" & strWork
            '/////  ゲージ設定  /////
            prgGauge.Value = prgGauge.Value + 1
            '/////  ゲージ更新  /////
            prgGauge.Refresh
        End If
    Next lngi
    '/////  変更中に変更先ファイル名が存在した場合  /////
    If lngSubCnt > 0 Then
        '/////  変更ミス分の処理  /////
        For lngi = 0 To lngSubCnt Step 1
            '/////  変更ファイル名が既に存在している場合  /////
            If Len(Dir(strPutPath & "\" & lstChangeFileList.List(lngi))) > 0 Then
                MsgBox strSubChangeFileName(lngSubCnt) & "を" & vbCrLf & strSubFileName(lngSubCnt) & "に" & _
                       "変更しようとしましたが、既に存在しているため変更できませんでした", vbInformation, "変更失敗"
            Else
                '/////  リネーム設定  /////
                Name strSubFileName(lngSubCnt) As strSubChangeFileName(lngSubCnt)
                '/////  ゲージ設定  /////
                prgGauge.Value = prgGauge.Value + 1
                '/////  ゲージ更新  /////
                prgGauge.Refresh
            End If
        Next lngi
    End If

    '/////  戻り値設定  /////
    SetReNameList = prgGauge.Value

    '/////  画面表示切替  /////
    Call DisplayModeChange
End Function