home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / CodeCounte176740782004.psc / frmAddIn.frm < prev    next >
Text File  |  2004-07-08  |  14KB  |  348 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MsComCtl.ocx"
  3. Begin VB.Form frmAddIn 
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "Code counter"
  6.    ClientHeight    =   3195
  7.    ClientLeft      =   2175
  8.    ClientTop       =   1935
  9.    ClientWidth     =   6015
  10.    ControlBox      =   0   'False
  11.    Icon            =   "frmAddIn.frx":0000
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   3195
  16.    ScaleWidth      =   6015
  17.    StartUpPosition =   2  'CenterScreen
  18.    Begin VB.CommandButton cmdAbout 
  19.       Caption         =   "&About"
  20.       Enabled         =   0   'False
  21.       Height          =   375
  22.       Left            =   4680
  23.       TabIndex        =   2
  24.       Top             =   120
  25.       Width           =   1215
  26.    End
  27.    Begin MSComctlLib.ImageList imlMain 
  28.       Left            =   5100
  29.       Top             =   1860
  30.       _ExtentX        =   1005
  31.       _ExtentY        =   1005
  32.       BackColor       =   -2147483643
  33.       ImageWidth      =   16
  34.       ImageHeight     =   16
  35.       MaskColor       =   12632256
  36.       _Version        =   393216
  37.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  38.          NumListImages   =   10
  39.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  40.             Picture         =   "frmAddIn.frx":000C
  41.             Key             =   ""
  42.          EndProperty
  43.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  44.             Picture         =   "frmAddIn.frx":035E
  45.             Key             =   ""
  46.          EndProperty
  47.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  48.             Picture         =   "frmAddIn.frx":06B0
  49.             Key             =   ""
  50.          EndProperty
  51.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  52.             Picture         =   "frmAddIn.frx":0A02
  53.             Key             =   ""
  54.          EndProperty
  55.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  56.             Picture         =   "frmAddIn.frx":0D54
  57.             Key             =   ""
  58.          EndProperty
  59.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  60.             Picture         =   "frmAddIn.frx":10A6
  61.             Key             =   ""
  62.          EndProperty
  63.          BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  64.             Picture         =   "frmAddIn.frx":13F8
  65.             Key             =   ""
  66.          EndProperty
  67.          BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  68.             Picture         =   "frmAddIn.frx":174A
  69.             Key             =   ""
  70.          EndProperty
  71.          BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  72.             Picture         =   "frmAddIn.frx":1A9C
  73.             Key             =   ""
  74.          EndProperty
  75.          BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  76.             Picture         =   "frmAddIn.frx":1DEE
  77.             Key             =   ""
  78.          EndProperty
  79.       EndProperty
  80.    End
  81.    Begin MSComctlLib.TreeView trvSturcture 
  82.       Height          =   2715
  83.       Left            =   120
  84.       TabIndex        =   0
  85.       Top             =   120
  86.       Width           =   4455
  87.       _ExtentX        =   7858
  88.       _ExtentY        =   4789
  89.       _Version        =   393217
  90.       Indentation     =   529
  91.       LineStyle       =   1
  92.       Sorted          =   -1  'True
  93.       Style           =   7
  94.       Appearance      =   1
  95.    End
  96.    Begin VB.CommandButton cmdCancel 
  97.       Cancel          =   -1  'True
  98.       Caption         =   "&Close"
  99.       Enabled         =   0   'False
  100.       Height          =   375
  101.       Left            =   4680
  102.       TabIndex        =   3
  103.       Top             =   600
  104.       Width           =   1215
  105.    End
  106.    Begin VB.Frame fraBusy 
  107.       BorderStyle     =   0  'None
  108.       Height          =   3015
  109.       Left            =   120
  110.       TabIndex        =   4
  111.       Top             =   120
  112.       Width           =   4455
  113.       Begin MSComctlLib.ProgressBar pgbMain 
  114.          Height          =   375
  115.          Left            =   0
  116.          TabIndex        =   5
  117.          Top             =   0
  118.          Width           =   4455
  119.          _ExtentX        =   7858
  120.          _ExtentY        =   661
  121.          _Version        =   393216
  122.          Appearance      =   1
  123.       End
  124.       Begin VB.Label Label1 
  125.          Alignment       =   2  'Center
  126.          BackStyle       =   0  'Transparent
  127.          Caption         =   "Please wait while counting lines of code..."
  128.          Height          =   255
  129.          Left            =   0
  130.          TabIndex        =   6
  131.          Top             =   660
  132.          Width           =   4455
  133.       End
  134.    End
  135.    Begin VB.Label lblTotal 
  136.       AutoSize        =   -1  'True
  137.       BackStyle       =   0  'Transparent
  138.       Caption         =   "lblTotal"
  139.       Height          =   195
  140.       Left            =   120
  141.       TabIndex        =   1
  142.       Top             =   2940
  143.       Width           =   510
  144.    End
  145. End
  146. Attribute VB_Name = "frmAddIn"
  147. Attribute VB_GlobalNameSpace = False
  148. Attribute VB_Creatable = False
  149. Attribute VB_PredeclaredId = True
  150. Attribute VB_Exposed = False
  151. Public VBInstance As VBIDE.VBE
  152. Public Connect As Connect
  153.  
  154. Private Type typMember
  155.     Name As String
  156.     CodeLocation As Long
  157.     Type As Long
  158. End Type
  159.  
  160. Option Explicit
  161.  
  162. Private Sub cmdAbout_Click()
  163.     MsgBox App.Title & " by W.O. van der Logt", vbInformation
  164. End Sub
  165.  
  166. Private Sub cmdCancel_Click()
  167.     Unload Me
  168. End Sub
  169.  
  170. Private Sub Form_Load()
  171.     On Error GoTo Error_Handler
  172.     
  173.     Dim lngLines As Long                'Lines in all projects
  174.     Dim lngProjectLines As Long         'Lines in project
  175.     Dim lngMemberLines As Integer       'Lines in member (Method or property)
  176.     
  177.     Dim objVBProject As VBProject       'VB Project
  178.     Dim objVBComponent As VBComponent   'VB Component
  179.     Dim objMember As Member             'Member of the component (Method or property)
  180.     Dim objNode As Node                 'Project
  181.     Dim objSubNode As Node              'Component
  182.     Dim intCounter As Integer           'Counter
  183.     Dim intIcon As Integer              'Icon to add with the node
  184.     
  185.     Dim arrMembers() As typMember       'Temp members array
  186.     
  187.     'Make sure progressbar frame is on top
  188.     fraBusy.ZOrder
  189.     
  190.     'Show dialog. So the user can see the progressbar
  191.     Me.Show
  192.     
  193.     'Set image list
  194.     Set trvSturcture.ImageList = imlMain
  195.     
  196.     'Set progressbar max value
  197.     Dim lngPBCount As Long
  198.     For Each objVBProject In VBInstance.VBProjects
  199.         lngPBCount = lngPBCount + objVBProject.VBComponents.Count
  200.     Next
  201.     pgbMain.Max = lngPBCount
  202.     
  203.     'Loop through all projects
  204.     For Each objVBProject In VBInstance.VBProjects
  205.         'Add project to treeview
  206.         Set objNode = trvSturcture.Nodes.Add(, , objVBProject.Name, objVBProject.Name, 1)
  207.         lngProjectLines = 0
  208.         'Loop trrough all components in project
  209.         For Each objVBComponent In objVBProject.VBComponents
  210.             'Update progressbar
  211.             pgbMain.Value = pgbMain.Value + 1
  212.             DoEvents
  213.             'Only components with a name.. This excludes .RES files
  214.             If objVBComponent.Name <> "" Then
  215.                 'Determine icon for the object
  216.                 Select Case objVBComponent.Type
  217.                     Case vbext_ct_ActiveXDesigner
  218.                         intIcon = 7
  219.                     Case vbext_ct_ClassModule
  220.                         intIcon = 4
  221.                     Case vbext_ct_DocObject
  222.                         intIcon = 7
  223.                     Case vbext_ct_MSForm
  224.                         intIcon = 2
  225.                     Case vbext_ct_PropPage
  226.                         intIcon = 6
  227.                     Case vbext_ct_RelatedDocument
  228.                         intIcon = 3
  229.                     Case vbext_ct_ResFile
  230.                         intIcon = 3
  231.                     Case vbext_ct_StdModule
  232.                         intIcon = 3
  233.                     Case vbext_ct_VBForm
  234.                         intIcon = 2
  235.                     Case vbext_ct_VBMDIForm
  236.                         intIcon = 8
  237.                     Case vbext_ct_UserControl
  238.                         intIcon = 5
  239.                 End Select
  240.                 
  241.                 'Add the component to project node
  242.                 Set objSubNode = trvSturcture.Nodes.Add(objNode.Key, tvwChild, objVBProject.Name & "_" & objVBComponent.Name, objVBComponent.Name & ": " & objVBComponent.CodeModule.CountOfLines & " lines", intIcon)
  243.                 'Loop all component codemodule members
  244.                 ReDim arrMembers(objVBComponent.CodeModule.Members.Count)
  245.                 For intCounter = 1 To objVBComponent.CodeModule.Members.Count
  246.                     'Add all members to array
  247.                     Set objMember = objVBComponent.CodeModule.Members(intCounter)
  248.                     arrMembers(intCounter).Name = objMember.Name
  249.                     arrMembers(intCounter).CodeLocation = objMember.CodeLocation
  250.                     arrMembers(intCounter).Type = objMember.Type
  251.                 Next
  252.                     
  253.                 'Sort members array on codelocation
  254.                 'Based on Philippe Lord's Array-handling/sorting v3 functions
  255.                 'http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=24546&lngWId=1
  256.                 '====================================================================================
  257.                 Dim i          As Long   ' Loop Counter
  258.                 Dim j          As Long
  259.                 Dim iLBound    As Long
  260.                 Dim iUBound    As Long
  261.                 Dim iMax       As Long
  262.                 Dim iTemp      As Long
  263.                 Dim iVal1      As Long
  264.                 Dim sVal2      As String
  265.                 Dim distance   As Long
  266.                 
  267.                 iLBound = LBound(arrMembers)
  268.                 iUBound = UBound(arrMembers)
  269.                 
  270.                 iMax = iUBound - iLBound + 1
  271.                 
  272.                 Do
  273.                     distance = distance * 3 + 1
  274.                 Loop Until distance > iMax
  275.                 
  276.                 Do
  277.                     distance = distance \ 3
  278.                     For i = distance + iLBound To iUBound
  279.                         iTemp = arrMembers(i).CodeLocation
  280.                         iVal1 = arrMembers(i).Type
  281.                         sVal2 = arrMembers(i).Name
  282.                         j = i
  283.                         Do While (arrMembers(j - distance).CodeLocation > iTemp)
  284.                             arrMembers(j).CodeLocation = arrMembers(j - distance).CodeLocation
  285.                             arrMembers(j).Type = arrMembers(j - distance).Type
  286.                             arrMembers(j).Name = arrMembers(j - distance).Name
  287.                             j = j - distance
  288.                             If j - distance < iLBound Then Exit Do
  289.                         Loop
  290.                         arrMembers(j).CodeLocation = iTemp
  291.                         arrMembers(j).Type = iVal1
  292.                         arrMembers(j).Name = sVal2
  293.                     Next i
  294.                 Loop Until distance = 1
  295.                 '====================================================================================
  296.                 
  297.                 'Add members to component node
  298.                 For intCounter = 1 To UBound(arrMembers)
  299.                     If arrMembers(intCounter).Type = vbext_mt_Method Or arrMembers(intCounter).Type = vbext_mt_Property Then
  300.                         If intCounter = UBound(arrMembers) Then
  301.                             'last member
  302.                             lngMemberLines = (objVBComponent.CodeModule.CountOfLines + 1) - arrMembers(intCounter).CodeLocation
  303.                         Else
  304.                             lngMemberLines = arrMembers(intCounter + 1).CodeLocation - arrMembers(intCounter).CodeLocation
  305.                         End If
  306.                         
  307.                         'Icon
  308.                         Select Case arrMembers(intCounter).Type
  309.                             Case vbext_mt_Method
  310.                                 'Method icon
  311.                                 intIcon = 9
  312.                             Case vbext_mt_Property
  313.                                 'Property icon
  314.                                 intIcon = 10
  315.                         End Select
  316.                         
  317.                         trvSturcture.Nodes.Add objSubNode.Key, tvwChild, objVBProject.Name & "_" & objVBComponent.Name & "_" & arrMembers(intCounter).Name, arrMembers(intCounter).Name & ": " & lngMemberLines & " lines", intIcon
  318.                     End If
  319.                 Next
  320.                 
  321.                 'Add the total number of lines in the codemodule to the overall counter
  322.                 lngLines = lngLines + objVBComponent.CodeModule.CountOfLines
  323.                 'Add the total number of lines in the codemodule to the projectlines counter
  324.                 lngProjectLines = lngProjectLines + objVBComponent.CodeModule.CountOfLines
  325.             End If
  326.         Next
  327.         'Update project node with the linecount
  328.         objNode.Text = objNode.Text & ": " & lngProjectLines
  329.     Next
  330.         
  331.     'Show total count over all projects
  332.     lblTotal.Caption = "Total number of lines in all projects: " & lngLines & " lines"
  333.     
  334. Error_Exit:
  335.     'Hide progressbar frame
  336.     fraBusy.Visible = False
  337.     'Enable buttons
  338.     cmdCancel.Enabled = True
  339.     cmdAbout.Enabled = True
  340.     
  341.     Exit Sub
  342. Error_Handler:
  343.     MsgBox "There was an error while counting your code: " & Err.Description, vbExclamation
  344.  
  345.     Resume Error_Exit
  346. End Sub
  347.  
  348.