Histogram Vbs

Histogram.vbs
Dim appRef, startRulerUnits, startTypeUnits, startDisplayDialogs, docRef
Dim totalCount, channelIndex, activeChannels, myChannels, secondaryIndex
Dim largestCount, histogramIndex, pixelsPerX, outputX, a, visibleChannelCount
PropertyValue TypeWhat it is
Application Object
(Application)
Read-only. The application that the collection belongs to.
Count Number (Long) Read-only. The number of elements in the Channels
collection.
Item
Object (Channel)
Read-only. Gets an element from the collection.
typename String Read-only. The class name of the referenced Channels
object.
Method Parameter TypeReturnsWhat it does
Add
()
Channel Creates a new Channel object.
Index
(ItemPtr) Object (Channel)
Number (Long)
RemoveAll
()
Removes all Channel objects from the
Channels collection.
Adobe Photoshop CS2
VBScript Scripting Reference VBScript Interface 42
Dim aChannelArray(), aChannelIndex, oFileSys, fileOut, hist
Set appRef = CreateObject("Photoshop.Application")
' Save the current preferences
startRulerUnits = appRef.Preferences.RulerUnits
startTypeUnits = appRef.Preferences.TypeUnits
startDisplayDialogs = appRef.DisplayDialogs
' Set Photoshop CS2 to use pixels and display no dialogs
appRef.Preferences.RulerUnits = 1 'for PsUnits --> 1 (psPixels)
appRef.Preferences.TypeUnits = 1 'for PsTypeUnits --> 1 (psPixels)
appRef.DisplayDialogs = 3 'for PsDialogModes --> 3 (psDisplayNoDialogs)
' if there are no documents open then try to open a sample file
If appRef.Documents.Count = 0 Then
appRef.Open(appRef.Path + "/Samples/Eagle.psd")
End If
Set docRef = appRef.ActiveDocument
' create the output file
Set oFileSys = CreateObject("Scripting.FileSystemObject")
Set fileOut = oFileSys.CreateTextFile("C:\\Histogram.log")
' write out a header
fileOut.Write "Histogram report for " & docRef.Name
' find out how many pixels I have
totalCount = docRef.Width * docRef.Height
' more info to the out file
fileOut.WriteLine " with a total pixel count of " & totalCount
' remember which channels are currently active
activeChannels = appRef.ActiveDocument.ActiveChannels
' document histogram only works in these modes
If docRef.Mode = 2 Or docRef.Mode = 3 Or docRef.Mode = 6 Then
'enumerated values = PsDocumentMode --> 2 (psRGB), 3 (psCMYK), 6 (psIndexedColor)
' activate the main channels so we can get the document’s histogram
' using the TurnOnDocumentHistogramChannels function
Call TurnOnDocumentHistogramChannels(docRef)
' Output the documents histogram
Call OutputHistogram(docRef.Histogram, "Luminosity", fileOut)
End If
' local reference to work from
Set myChannels = docRef.Channels
' loop through each channel and output the histogram
For channelIndex = 1 To myChannels.Count
' the channel has to be visible to get a histogram
myChannels(channelIndex).Visible = true
' turn off all the other channels
for secondaryIndex = 1 to myChannels.Count
If Not channelIndex = secondaryIndex Then
Adobe Photoshop CS2
VBScript Scripting Reference VBScript Interface 43
myChannels(secondaryIndex).Visible = false
End If
Next
' Use the function to dump the histogram
Call OutputHistogram(myChannels(channelIndex).Histogram,
myChannels(channelIndex).Name, fileOut)
Next
' close down the output file
fileOut.Close
' reset the active channels
docRef.ActiveChannels = activeChannels
' Reset the application preferences
appRef.Preferences.RulerUnits = startRulerUnits
appRef.Preferences.TypeUnits = startTypeUnits
appRef.DisplayDialogs = startDisplayDialogs
' Utility function that takes a histogram and name
' and dumps to the output file
Private Function OutputHistogram (inHistogram, inHistogramName, inOutFile)
' find out which count has the largest number
' I scale everything to this number for the output
largestCount = 0
' a simple indexer I can reuse
histogramIndex = 0
' search through all and find the largest single item
For Each hist In inHistogram
histogramCount = histogramCount + CLng(hist)
If CLng(hist) --> largestCount Then
largestCount = CLng(hist)
End If
Next
'These should match
If Not histogramCount = totalCount Then
MsgBox "Something bad is happening!"
End If
inOutFile.WriteLine "This histogram has a pixel count of " & histogramCount
inOutFile.WriteLine
'see how much each "X" is going to count as
pixelsPerX = largestCount / 100
'output this data to the file
inOutFile.WriteLine "One X = " & pixelsPerX & " pixels."
'output the name of this histogram
inOutFile.WriteLine inHistogramName
inOutFile.WriteLine "Mean Pixels: " & AverageHistogram(inHistogram)
inOutFile.WriteLine "Std. Dev. Pixels: " &
StandardDeviationHistogram(inHistogram)
Adobe Photoshop CS2
VBScript Scripting Reference VBScript Interface 44
inOutFile.WriteLine "Median Pixels: " & MedianHistogram(inHistogram,
histogramCount)
' loop through all the items and output in the following format
' 001
' 002
' For histogramIndex = 0 To (inHistogram.Count - 1)
histogramIndex = 0
For Each hist in inHistogram
' I need an extra "0" for this line item to keep everything in line
If histogramIndex < 10 Then
inOutFile.Write "0"
End If
' I need an extra "0" for this line item to keep everything in line
If histogramIndex < 100 Then
inOutFile.Write "0"
End If
' output the index to file
inOutFile.Write histogramIndex
' some spacing to make it look nice
inOutFile.Write " "
'figure out how many X’s I need
outputX = CDbl(hist) / largestCount * 100
'output the X’s
For a = 0 to outputX ' (outputX - 1)
inOutFile.Write "X"
Next
inOutFile.WriteLine
histogramIndex = histogramIndex + 1
Next
inOutFile.WriteLine
End Function
' Function to active all the channels according to the document’s mode
' Takes a document reference for input
Private Function TurnOnDocumentHistogramChannels (inDocument)
' see how many channels we need to activate
visibleChannelCount = 0
'based on the mode of the document
Select Case inDocument.Mode
Case 1
visibleChannelCount = 1
Case 5
visibleChannelCount = 1
Case 6
visibleChannelCount = 1
Case 8
visibleChannelCount = 2
Case 2
Adobe Photoshop CS2
VBScript Scripting Reference VBScript Interface 45
visibleChannelCount = 3
Case 4
visibleChannelCount = 3
Case 3
visibleChannelCount = 4
Case 8
visibleChannelCount = 4
Case 7
visibleChannelCount = (inDocument.Channels.Count + 1)
Case Else
visibleChannelCount = (inDocument.Channels.Count + 1)
End Select
' now get the channels to activate into a local array
ReDim aChannelArray(visibleChannelCount)
' index for the active channels array
aChannelIndex = 1
For channelIndex = 1 to inDocument.channels.Count
If channelIndex <= visibleChannelCount Then
Set aChannelArray(aChannelIndex) = inDocument.Channels(channelIndex)
aChannelIndex = aChannelIndex + 1
End If
Next
End Function
Private Function StandardDeviationHistogram(inputArray)
Dim numPixels, sum1, sum2, x, gray
numPixels = 0
sum1 = 0.0
sum2 = 0.0
' Compute totals for the various statistics
For gray = 0 To 255
x = inputArray(gray)
numPixels = numPixels + x
sum1 = sum1 + y * gray
sum2 = sum2 + y * (gray * gray)
Next
StandardDeviationHistogram = Sqr((sum2 - (sum1 * sum1) / numPixels) / (numPixels -
1))
End Function
Private Function AverageHistogram(inputArray)
Dim numPixels, sum1, sum2, x, gray
numPixels = 0
sum1 = 0.0
sum2 = 0.0
' Compute totals for the various statistics
For gray = 0 To 255
x = inputArray(gray)
numPixels = numPixels + y
sum1 = sum1 + x * gray
Adobe Photoshop CS2
VBScript Scripting Reference VBScript Interface 46
sum2 = sum2 + x * (gray * gray)
Next
AverageHistogram = sum1 / numPixels
End Function
Private Function MedianHistogram(inputArray, numPixels)
Dim gray, total, mid
gray = 0
total = inputArray(0)
mid = (numPixels + 1) / 2
Do While (total < mid)
gray = gray + 1
total = total + inputArray(gray)
Loop
MedianHistogram = gray
End Function