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 (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2004-07-08  |  13.7 KB  |  330 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. Attribute VB_Name = "frmAddIn"
  146. Attribute VB_GlobalNameSpace = False
  147. Attribute VB_Creatable = False
  148. Attribute VB_PredeclaredId = True
  149. Attribute VB_Exposed = False
  150. Public VBInstance As VBIDE.VBE
  151. Public Connect As Connect
  152. Private Type typMember
  153.     Name As String
  154.     CodeLocation As Long
  155.     Type As Long
  156. End Type
  157. Option Explicit
  158. Private Sub cmdAbout_Click()
  159.     MsgBox App.Title & " by W.O. van der Logt", vbInformation
  160. End Sub
  161. Private Sub cmdCancel_Click()
  162.     Unload Me
  163. End Sub
  164. Private Sub Form_Load()
  165.     On Error GoTo Error_Handler
  166.     Dim lngLines As Long                'Lines in all projects
  167.     Dim lngProjectLines As Long         'Lines in project
  168.     Dim lngMemberLines As Integer       'Lines in member (Method or property)
  169.     Dim objVBProject As VBProject       'VB Project
  170.     Dim objVBComponent As VBComponent   'VB Component
  171.     Dim objMember As Member             'Member of the component (Method or property)
  172.     Dim objNode As Node                 'Project
  173.     Dim objSubNode As Node              'Component
  174.     Dim intCounter As Integer           'Counter
  175.     Dim intIcon As Integer              'Icon to add with the node
  176.     Dim arrMembers() As typMember       'Temp members array
  177.     'Make sure progressbar frame is on top
  178.     fraBusy.ZOrder
  179.     'Show dialog. So the user can see the progressbar
  180.     Me.Show
  181.     'Set image list
  182.     Set trvSturcture.ImageList = imlMain
  183.     'Set progressbar max value
  184.     Dim lngPBCount As Long
  185.     For Each objVBProject In VBInstance.VBProjects
  186.         lngPBCount = lngPBCount + objVBProject.VBComponents.Count
  187.     Next
  188.     pgbMain.Max = lngPBCount
  189.     'Loop through all projects
  190.     For Each objVBProject In VBInstance.VBProjects
  191.         'Add project to treeview
  192.         Set objNode = trvSturcture.Nodes.Add(, , objVBProject.Name, objVBProject.Name, 1)
  193.         lngProjectLines = 0
  194.         'Loop trrough all components in project
  195.         For Each objVBComponent In objVBProject.VBComponents
  196.             'Update progressbar
  197.             pgbMain.Value = pgbMain.Value + 1
  198.             DoEvents
  199.             'Only components with a name.. This excludes .RES files
  200.             If objVBComponent.Name <> "" Then
  201.                 'Determine icon for the object
  202.                 Select Case objVBComponent.Type
  203.                     Case vbext_ct_ActiveXDesigner
  204.                         intIcon = 7
  205.                     Case vbext_ct_ClassModule
  206.                         intIcon = 4
  207.                     Case vbext_ct_DocObject
  208.                         intIcon = 7
  209.                     Case vbext_ct_MSForm
  210.                         intIcon = 2
  211.                     Case vbext_ct_PropPage
  212.                         intIcon = 6
  213.                     Case vbext_ct_RelatedDocument
  214.                         intIcon = 3
  215.                     Case vbext_ct_ResFile
  216.                         intIcon = 3
  217.                     Case vbext_ct_StdModule
  218.                         intIcon = 3
  219.                     Case vbext_ct_VBForm
  220.                         intIcon = 2
  221.                     Case vbext_ct_VBMDIForm
  222.                         intIcon = 8
  223.                     Case vbext_ct_UserControl
  224.                         intIcon = 5
  225.                 End Select
  226.                 
  227.                 'Add the component to project node
  228.                 Set objSubNode = trvSturcture.Nodes.Add(objNode.Key, tvwChild, objVBProject.Name & "_" & objVBComponent.Name, objVBComponent.Name & ": " & objVBComponent.CodeModule.CountOfLines & " lines", intIcon)
  229.                 'Loop all component codemodule members
  230.                 ReDim arrMembers(objVBComponent.CodeModule.Members.Count)
  231.                 For intCounter = 1 To objVBComponent.CodeModule.Members.Count
  232.                     'Add all members to array
  233.                     Set objMember = objVBComponent.CodeModule.Members(intCounter)
  234.                     arrMembers(intCounter).Name = objMember.Name
  235.                     arrMembers(intCounter).CodeLocation = objMember.CodeLocation
  236.                     arrMembers(intCounter).Type = objMember.Type
  237.                 Next
  238.                     
  239.                 'Sort members array on codelocation
  240.                 'Based on Philippe Lord's Array-handling/sorting v3 functions
  241.                 'http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=24546&lngWId=1
  242.                 '====================================================================================
  243.                 Dim i          As Long   ' Loop Counter
  244.                 Dim j          As Long
  245.                 Dim iLBound    As Long
  246.                 Dim iUBound    As Long
  247.                 Dim iMax       As Long
  248.                 Dim iTemp      As Long
  249.                 Dim iVal1      As Long
  250.                 Dim sVal2      As String
  251.                 Dim distance   As Long
  252.                 
  253.                 iLBound = LBound(arrMembers)
  254.                 iUBound = UBound(arrMembers)
  255.                 
  256.                 iMax = iUBound - iLBound + 1
  257.                 
  258.                 Do
  259.                     distance = distance * 3 + 1
  260.                 Loop Until distance > iMax
  261.                 
  262.                 Do
  263.                     distance = distance \ 3
  264.                     For i = distance + iLBound To iUBound
  265.                         iTemp = arrMembers(i).CodeLocation
  266.                         iVal1 = arrMembers(i).Type
  267.                         sVal2 = arrMembers(i).Name
  268.                         j = i
  269.                         Do While (arrMembers(j - distance).CodeLocation > iTemp)
  270.                             arrMembers(j).CodeLocation = arrMembers(j - distance).CodeLocation
  271.                             arrMembers(j).Type = arrMembers(j - distance).Type
  272.                             arrMembers(j).Name = arrMembers(j - distance).Name
  273.                             j = j - distance
  274.                             If j - distance < iLBound Then Exit Do
  275.                         Loop
  276.                         arrMembers(j).CodeLocation = iTemp
  277.                         arrMembers(j).Type = iVal1
  278.                         arrMembers(j).Name = sVal2
  279.                     Next i
  280.                 Loop Until distance = 1
  281.                 '====================================================================================
  282.                 
  283.                 'Add members to component node
  284.                 For intCounter = 1 To UBound(arrMembers)
  285.                     If arrMembers(intCounter).Type = vbext_mt_Method Or arrMembers(intCounter).Type = vbext_mt_Property Then
  286.                         If intCounter = UBound(arrMembers) Then
  287.                             'last member
  288.                             lngMemberLines = (objVBComponent.CodeModule.CountOfLines + 1) - arrMembers(intCounter).CodeLocation
  289.                         Else
  290.                             lngMemberLines = arrMembers(intCounter + 1).CodeLocation - arrMembers(intCounter).CodeLocation
  291.                         End If
  292.                         
  293.                         'Icon
  294.                         Select Case arrMembers(intCounter).Type
  295.                             Case vbext_mt_Method
  296.                                 'Method icon
  297.                                 intIcon = 9
  298.                             Case vbext_mt_Property
  299.                                 'Property icon
  300.                                 intIcon = 10
  301.                         End Select
  302.                         
  303.                         trvSturcture.Nodes.Add objSubNode.Key, tvwChild, objVBProject.Name & "_" & objVBComponent.Name & "_" & arrMembers(intCounter).Name, arrMembers(intCounter).Name & ": " & lngMemberLines & " lines", intIcon
  304.                     End If
  305.                 Next
  306.                 
  307.                 'Add the total number of lines in the codemodule to the overall counter
  308.                 lngLines = lngLines + objVBComponent.CodeModule.CountOfLines
  309.                 'Add the total number of lines in the codemodule to the projectlines counter
  310.                 lngProjectLines = lngProjectLines + objVBComponent.CodeModule.CountOfLines
  311.             End If
  312.         Next
  313.         'Update project node with the linecount
  314.         objNode.Text = objNode.Text & ": " & lngProjectLines
  315.     Next
  316.         
  317.     'Show total count over all projects
  318.     lblTotal.Caption = "Total number of lines in all projects: " & lngLines & " lines"
  319. Error_Exit:
  320.     'Hide progressbar frame
  321.     fraBusy.Visible = False
  322.     'Enable buttons
  323.     cmdCancel.Enabled = True
  324.     cmdAbout.Enabled = True
  325.     Exit Sub
  326. Error_Handler:
  327.     MsgBox "There was an error while counting your code: " & Err.Description, vbExclamation
  328.     Resume Error_Exit
  329. End Sub
  330.