VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "clsPlotSpectrum" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit 'Amptek Spectrum Plot Support Class Version 2 (Updated for DPPAPI with DP5) Private Type POINTAPI X As Long Y As Long End Type Const ALTERNATE = 1 Const WINDING = 2 Private Declare Function SetPolyFillMode Lib "gdi32" (ByVal hdc As Long, ByVal nPolyFillMode As Long) As Long Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long Public Sub Plot(strFilename As String, picPlot As VB.PictureBox, Optional isStrFile As Boolean = False) Dim max As Long Dim buffer As Variant Dim iSize As ArrayIndex ' Dim lastCh As Long Dim points() As POINTAPI Dim NUMPOINTS As Long Dim res As Long Dim xScale As Double Dim yScale As Double Dim xPnt As Double Dim yPnt As Double Dim maxY As Double Dim bufferROI As Variant Dim iSizeROI As ArrayIndex ' Dim lastChROI As Long Dim pointsROI() As POINTAPI Dim NUMPOINTSROI As Long Dim RoiStart As Long Dim RoiEnd As Long Dim strROI As String Dim strStart As String Dim strEnd As String Dim i As Long Dim j As Long Dim k As Long Dim colGreen As Byte picPlot.Cls buffer = GetSpectrumData(strFilename, isStrFile) If (IsEmpty(buffer)) Then Exit Sub iSize = GetArrayIndex(buffer) lastCh = iSize.idxU - iSize.idxL If (max > lastCh) Then max = lastCh If (lastCh <= 0) Then Exit Sub If (picPlot.Width <= 0) Then Exit Sub maxY = 0# For i = iSize.idxL To iSize.idxU If (buffer(i) > maxY) Then maxY = buffer(i) Next xScale = (CDbl(picPlot.ScaleWidth) / CDbl(lastCh)) If (maxY <= 0) Then Exit Sub If (picPlot.Height <= 0) Then Exit Sub yScale = (CDbl(picPlot.ScaleHeight) / CDbl(maxY)) NUMPOINTS = lastCh + 2 ReDim points(lastCh + 1) picPlot.ForeColor = RGB(0, 0, 0) picPlot.FillColor = RGB(255, 0, 0) picPlot.FillStyle = 0 picPlot.DrawWidth = 1 points(0).X = 0 points(0).Y = maxY For i = 1 To lastCh points(i).X = CLng(CDbl(i) * xScale) points(i).Y = CLng((maxY - CDbl(buffer(i - 1))) * yScale) Next points(lastCh + 1).X = CLng(CDbl(lastCh) * xScale) points(lastCh + 1).Y = maxY res = SetPolyFillMode(picPlot.hdc, WINDING) res = Polygon(picPlot.hdc, points(0), NUMPOINTS) picPlot.Refresh bufferROI = GetSpectrumROI(strFilename, isStrFile) If (IsEmpty(bufferROI)) Then Exit Sub iSizeROI = GetArrayIndex(bufferROI) For i = iSizeROI.idxL To iSizeROI.idxU j = i strROI = bufferROI(i) strStart = Left(strROI, InStr(1, strROI, Chr(32)) - 1) strEnd = Mid(strROI, InStr(1, strROI, Chr(32)) + 1) If (IsNumeric(strStart) And IsNumeric(strEnd)) Then RoiStart = CLng(strStart) RoiEnd = CLng(strEnd) Else Exit Sub End If lastChROI = RoiEnd - RoiStart + 1 If (lastChROI < 0) Then Exit Sub NUMPOINTSROI = lastChROI + 2 ReDim pointsROI(lastChROI + 1) For j = RoiStart To RoiEnd k = (j - RoiStart) + 1 pointsROI(k).X = CLng(CDbl(j) * xScale) pointsROI(k).Y = CLng((maxY - CDbl(buffer(j - 1))) * yScale) Next pointsROI(0).X = CLng(CDbl(RoiStart - 1#) * xScale) pointsROI(0).Y = maxY pointsROI(lastChROI + 1).X = CLng(CDbl(RoiEnd + 1#) * xScale) pointsROI(lastChROI + 1).Y = maxY If (i < 1) Then colGreen = 255 Else colGreen = 0 End If picPlot.ForeColor = RGB(0, 0, 0) picPlot.FillColor = RGB(0, colGreen, 255) picPlot.FillStyle = 0 picPlot.DrawWidth = 1 res = SetPolyFillMode(picPlot.hdc, ALTERNATE) res = Polygon(picPlot.hdc, pointsROI(0), NUMPOINTSROI) Next picPlot.Refresh End Sub Public Sub PlotDataFromBuffer(buffer As Variant, picPlot As VB.PictureBox) Dim iSize As ArrayIndex ' Dim lastCh As Long Dim points() As POINTAPI Dim NUMPOINTS As Long Dim res As Long Dim xScale As Double Dim yScale As Double Dim maxY As Double Dim idxPoint As Long picPlot.Cls If (IsEmpty(buffer)) Then Exit Sub iSize = GetArrayIndex(buffer) lastCh = iSize.idxU - iSize.idxL If (lastCh <= 0) Then Exit Sub If (picPlot.Width <= 0) Then Exit Sub maxY = 0# For idxPoint = iSize.idxL To iSize.idxU If (buffer(idxPoint) > maxY) Then maxY = buffer(idxPoint) Next xScale = (CDbl(picPlot.ScaleWidth) / CDbl(lastCh)) If (maxY <= 0) Then Exit Sub If (picPlot.Height <= 0) Then Exit Sub yScale = (CDbl(picPlot.ScaleHeight) / CDbl(maxY)) NUMPOINTS = lastCh + 2 ReDim points(lastCh + 1) picPlot.ForeColor = RGB(0, 0, 0) picPlot.FillColor = RGB(255, 0, 0) picPlot.FillStyle = 0 picPlot.DrawWidth = 1 points(0).X = 0 points(0).Y = maxY For idxPoint = 1 To lastCh points(idxPoint).X = CLng(CDbl(idxPoint) * xScale) points(idxPoint).Y = CLng((maxY - CDbl(buffer(idxPoint - 1))) * yScale) Next points(lastCh + 1).X = CLng(CDbl(lastCh) * xScale) points(lastCh + 1).Y = maxY res = SetPolyFillMode(picPlot.hdc, WINDING) res = Polygon(picPlot.hdc, points(0), NUMPOINTS) picPlot.Refresh End Sub Public Function GetSpectrumData(strFilename As String, Optional isStrFile As Boolean = False) As Variant Dim strMCAData As Variant 'entire file contents in array of strings Dim iSize As ArrayIndex ' Dim MCAData() As Double Dim i As Long Dim j As Long Dim lastCh As Long Dim iData As ArrayIndex If (isStrFile) Then strMCAData = GetMcaFileFromStr(strFilename) 'read mca file data Else strMCAData = GetMcaFile(strFilename) 'read mca file data End If iSize = GetArrayIndex(strMCAData) 'get size of mca file iData = GetDataIndex(strMCAData) 'get location of spectrum data lastCh = iData.idxU - iData.idxL ReDim MCAData(lastCh) j = 0 For i = iData.idxL To iData.idxU 'load the data into an array for processing MCAData(j) = CDbl(strMCAData(i)) j = j + 1 Next GetSpectrumData = MCAData End Function Public Function GetSpectrumROI(strFilename As String, Optional isStrFile As Boolean = False) As Variant Dim strMCAData As Variant 'entire file contents in array of strings Dim iSize As ArrayIndex ' Dim MCAData() As String Dim i As Long Dim j As Long Dim lastCh As Long Dim iROI As ArrayIndex If (isStrFile) Then strMCAData = GetMcaFileFromStr(strFilename) 'read mca file data Else strMCAData = GetMcaFile(strFilename) 'read mca file data End If iSize = GetArrayIndex(strMCAData) 'get size of mca file iROI = GetROIIndex(strMCAData) 'get location of spectrum data If ((iROI.idxU < 0) Or (iROI.idxL < 0)) Then Exit Function lastCh = iROI.idxU - iROI.idxL ReDim MCAData(lastCh) j = 0 For i = iROI.idxL To iROI.idxU 'load the data into an array for processing MCAData(j) = strMCAData(i) j = j + 1 Next GetSpectrumROI = MCAData End Function Public Function GetMcaFileFromStr(strFile As String) As Variant Dim strFileArr As Variant Dim iSize As Integer Dim strTemp As String strTemp = strFile ' make a working copy strFileArr = Split(strTemp, vbCrLf) ' Break the file into lines. iSize = 0 If (Not IsEmpty(strFileArr)) Then iSize = UBound(strFileArr) 'old files have a linefeed (&H0A) vbLF as a line terminator 'only vbCR + vbLF or vbCR are valid line terminators 'try to read lines terminated with vbLF If (iSize <= 1) Then strTemp = strFile ' make a working copy strFileArr = Split(strTemp, vbLf) ' Break the file into lines. End If If (IsEmpty(strFileArr)) Then strFileArr = "" iSize = UBound(strFileArr) If (iSize <= 1) Then strFileArr = "" 'set to an empty string if not valid data GetMcaFileFromStr = strFileArr End Function