home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Image_Data1863613112005.psc / ImageDB / frmAutoRename.frm < prev    next >
Text File  |  2005-03-10  |  10KB  |  332 lines
  1. VERSION 5.00
  2. Begin VB.Form frmAutoRename 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   " Auto Renaming Utility"
  5.    ClientHeight    =   4635
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   4605
  9.    Icon            =   "frmAutoRename.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   4635
  14.    ScaleWidth      =   4605
  15.    StartUpPosition =   2  'CenterScreen
  16.    Begin ImageDatabase.LaVolpeButton LaVolpeButton2 
  17.       Height          =   495
  18.       Left            =   2880
  19.       TabIndex        =   12
  20.       Top             =   3960
  21.       Width           =   1575
  22.       _ExtentX        =   2778
  23.       _ExtentY        =   873
  24.       BTYPE           =   3
  25.       TX              =   "Cancel"
  26.       ENAB            =   -1  'True
  27.       BeginProperty FONT {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  28.          Name            =   "Times New Roman"
  29.          Size            =   8.25
  30.          Charset         =   0
  31.          Weight          =   400
  32.          Underline       =   0   'False
  33.          Italic          =   0   'False
  34.          Strikethrough   =   0   'False
  35.       EndProperty
  36.       COLTYPE         =   1
  37.       BCOL            =   13160660
  38.       FCOL            =   0
  39.       FCOLO           =   0
  40.       EMBOSSM         =   12632256
  41.       EMBOSSS         =   16777215
  42.       MPTR            =   0
  43.       MICON           =   "frmAutoRename.frx":08CA
  44.       ALIGN           =   1
  45.       ICONAlign       =   0
  46.       ORIENT          =   0
  47.       STYLE           =   0
  48.       IconSize        =   2
  49.       SHOWF           =   -1  'True
  50.       BSTYLE          =   0
  51.       OPTVAL          =   0   'False
  52.       OPTMOD          =   0   'False
  53.       GStart          =   0
  54.       GStop           =   16711680
  55.       GStyle          =   0
  56.    End
  57.    Begin VB.Frame Frame3 
  58.       Caption         =   "Preview"
  59.       Height          =   855
  60.       Left            =   120
  61.       TabIndex        =   9
  62.       Top             =   2760
  63.       Width           =   4335
  64.       Begin VB.Label Label4 
  65.          Caption         =   "0001.jpg"
  66.          Height          =   255
  67.          Left            =   120
  68.          TabIndex        =   10
  69.          Top             =   360
  70.          Width           =   4095
  71.       End
  72.    End
  73.    Begin ImageDatabase.LaVolpeButton LaVolpeButton1 
  74.       Height          =   495
  75.       Left            =   1200
  76.       TabIndex        =   8
  77.       Top             =   3960
  78.       Width           =   1575
  79.       _ExtentX        =   2778
  80.       _ExtentY        =   873
  81.       BTYPE           =   3
  82.       TX              =   "Start"
  83.       ENAB            =   -1  'True
  84.       BeginProperty FONT {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  85.          Name            =   "MS Sans Serif"
  86.          Size            =   8.25
  87.          Charset         =   0
  88.          Weight          =   400
  89.          Underline       =   0   'False
  90.          Italic          =   0   'False
  91.          Strikethrough   =   0   'False
  92.       EndProperty
  93.       COLTYPE         =   1
  94.       BCOL            =   13160660
  95.       FCOL            =   0
  96.       FCOLO           =   0
  97.       EMBOSSM         =   12632256
  98.       EMBOSSS         =   16777215
  99.       MPTR            =   0
  100.       MICON           =   "frmAutoRename.frx":08E6
  101.       ALIGN           =   1
  102.       ICONAlign       =   0
  103.       ORIENT          =   0
  104.       STYLE           =   0
  105.       IconSize        =   2
  106.       SHOWF           =   -1  'True
  107.       BSTYLE          =   0
  108.       OPTVAL          =   0   'False
  109.       OPTMOD          =   0   'False
  110.       GStart          =   0
  111.       GStop           =   16711680
  112.       GStyle          =   0
  113.    End
  114.    Begin VB.Frame Frame2 
  115.       Caption         =   "What images"
  116.       Height          =   855
  117.       Left            =   120
  118.       TabIndex        =   5
  119.       Top             =   120
  120.       Width           =   4335
  121.       Begin VB.OptionButton Option1 
  122.          Caption         =   "All Images"
  123.          Height          =   255
  124.          Left            =   480
  125.          TabIndex        =   7
  126.          Top             =   360
  127.          Width           =   1575
  128.       End
  129.       Begin VB.OptionButton Option2 
  130.          Caption         =   "Selected Images"
  131.          Height          =   255
  132.          Left            =   2400
  133.          TabIndex        =   6
  134.          Top             =   360
  135.          Width           =   1575
  136.       End
  137.    End
  138.    Begin VB.Frame Frame1 
  139.       Caption         =   "Rename to Match Pattern"
  140.       Height          =   1455
  141.       Left            =   120
  142.       TabIndex        =   0
  143.       Top             =   1080
  144.       Width           =   4335
  145.       Begin VB.CheckBox Check1 
  146.          Caption         =   "Remove file extension "
  147.          Height          =   255
  148.          Left            =   240
  149.          TabIndex        =   11
  150.          Top             =   1080
  151.          Width           =   1935
  152.       End
  153.       Begin VB.TextBox Text2 
  154.          Height          =   285
  155.          Left            =   1680
  156.          TabIndex        =   2
  157.          Text            =   "1"
  158.          Top             =   720
  159.          Width           =   615
  160.       End
  161.       Begin VB.TextBox Text1 
  162.          Height          =   285
  163.          Left            =   1200
  164.          TabIndex        =   1
  165.          Top             =   360
  166.          Width           =   2895
  167.       End
  168.       Begin VB.Label Label2 
  169.          Caption         =   "Beginning Number"
  170.          Height          =   255
  171.          Left            =   240
  172.          TabIndex        =   4
  173.          Top             =   720
  174.          Width           =   1335
  175.       End
  176.       Begin VB.Label Label1 
  177.          Caption         =   "Base Name"
  178.          Height          =   255
  179.          Left            =   240
  180.          TabIndex        =   3
  181.          Top             =   360
  182.          Width           =   975
  183.       End
  184.    End
  185. End
  186. Attribute VB_Name = "frmAutoRename"
  187. Attribute VB_GlobalNameSpace = False
  188. Attribute VB_Creatable = False
  189. Attribute VB_PredeclaredId = True
  190. Attribute VB_Exposed = False
  191. Option Explicit
  192.  
  193.  
  194.  
  195. Private Sub Check1_Click()
  196.     Label4.Caption = NewTitle
  197. End Sub
  198.  
  199. Private Sub Form_Load()
  200.     ' If user has chosen any images from the listview then assume selection only
  201.     If CountSelectedItemsInListview(frmMain.ListView1) >= 2 Then
  202.         Option2.Value = True
  203.     Else
  204.         Option1.Value = True
  205.     End If
  206.     Text1.Text = frmMain.List1.Text & "_"
  207.     
  208.     Label4.Caption = Text1.Text & Format(Text2.Text, "0000") & ".jpg"
  209. End Sub
  210.  
  211. Private Sub LaVolpeButton1_Click()
  212.     If Option1.Value = True Then
  213.         RenameAll
  214.     Else
  215.         RenameSome
  216.     End If
  217.     
  218.     Unload Me
  219. End Sub
  220.  
  221. Private Sub LaVolpeButton2_Click()
  222. Unload Me
  223. '   Dim itemx As ListItem
  224. '   Dim myCol As Collection
  225. '
  226. '    Set myCol = GetSelectedItemsFromListview(frmMain.ListView1)
  227. '    Text1.Text = ""
  228. '
  229. '    For Each itemx In myCol
  230. '        Text1.Text = Text1.Text & itemx.Text & vbCrLf
  231. '    Next itemx
  232. End Sub
  233.  
  234. Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
  235.     Label4.Caption = NewTitle
  236. End Sub
  237.  
  238. Private Sub Text2_Change()
  239.     ' Just in case user tries to paste in some bullsh*t
  240.     If IsNumeric(Text2) = False Then
  241.         Text2.Text = "1"
  242.     End If
  243. End Sub
  244.  
  245. Private Sub Text2_KeyPress(KeyAscii As Integer)
  246.     Dim Numbers As Integer
  247.     Numbers = KeyAscii
  248.     ' Allow only numbers to entered
  249.     If ((Numbers < 48 Or Numbers > 57) And Numbers <> 8) Then KeyAscii = 0
  250. End Sub
  251.  
  252. Private Sub Text2_KeyUp(KeyCode As Integer, Shift As Integer)
  253.     Label4.Caption = NewTitle
  254. End Sub
  255.  
  256. Private Function NewTitle() As String
  257.     If Check1.Value = 1 Then
  258.         NewTitle = Text1.Text & Format(Text2.Text, "0000")
  259.     Else
  260.         NewTitle = Text1.Text & Format(Text2.Text, "0000") & ".jpg"
  261.     End If
  262. End Function
  263.  
  264. Private Sub RenameAll()
  265.     Dim intSeq As Long
  266.     Dim i As Long
  267.     Dim dbs As Database
  268.     Dim rst As Recordset
  269.     Dim newname As String
  270.     
  271.     Me.Hide
  272.     intSeq = Text2.Text
  273.     
  274.     Set dbs = OpenDatabase(srcDB)
  275.  
  276.     For i = 1 To frmMain.ListView1.ListItems.Count
  277.         Set rst = dbs.OpenRecordset("SELECT * FROM images where title = '" & frmMain.ListView1.ListItems(i).Text & "';")
  278.         If rst.RecordCount > 0 Then
  279.             If Check1.Value = 1 Then
  280.                 newname = Text1.Text & Format(intSeq, "0000")
  281.             Else
  282.                 newname = Text1.Text & Format(intSeq, "0000") & "." & frmMain.ListView1.ListItems(i).SubItems(3)
  283.             End If
  284.             rst.Edit
  285.             rst.Fields("title") = newname
  286.             rst.Update
  287.             frmMain.ListView1.ListItems(i).Text = newname
  288.         Else
  289.             MsgBox "Could not find to rename"
  290.         End If
  291.         
  292.         intSeq = intSeq + 1
  293.     Next i
  294.     
  295.     rst.Close
  296.     dbs.Close
  297. End Sub
  298.  
  299. Private Sub RenameSome()
  300. Dim intSeq As Long
  301.     Dim i As Long
  302.     Dim dbs As Database
  303.     Dim rst As Recordset
  304.     Dim newname As String
  305.     
  306.     Me.Hide
  307.     intSeq = Text2.Text
  308.     
  309.     Set dbs = OpenDatabase(srcDB)
  310.  
  311.     For i = 1 To frmMain.ListView1.ListItems.Count
  312.         
  313.         Set rst = dbs.OpenRecordset("SELECT * FROM images where title = '" & frmMain.ListView1.ListItems(i).Text & "';")
  314.         If rst.RecordCount > 0 And frmMain.ListView1.ListItems(i).Selected = True Then
  315.             If Check1.Value = 1 Then
  316.                 newname = Text1.Text & Format(Text2.Text, "0000")
  317.             Else
  318.                 newname = Text1.Text & Format(Text2.Text, "0000") & "." & frmMain.ListView1.ListItems(i).SubItems(3)
  319.             End If
  320.             rst.Edit
  321.             rst.Fields("title") = newname
  322.             rst.Update
  323.             frmMain.ListView1.ListItems(i).Text = newname
  324.         End If
  325.         intSeq = intSeq + 1
  326.     Next i
  327.     
  328.     rst.Close
  329.     dbs.Close
  330. End Sub
  331.  
  332.