Scanning the Chart

Scanning the chart sheet is required immediately after images are added to the bubble chart. A chart scan must be triggered when a new game begins and when the player swaps two images. Since a chart scan may ultimately result in the removal of images and subsequent addition of new images, this may trigger more scans.

The last procedure called from sub Main() is ProcessChart(). The ProcessChart() sub procedure essentially outlines the process of scanning a chart for score sequences, updating the score, removing score sequences, moving images down columns in the chart, and adding new images. Since new images are added randomly to replace scored sequences, it is always possible that more score sequences will be created; thus, the whole process is repeated in a Do Loop until there are no more score sequences found. Most of these tasks are accomplished with calls to the ScanImages() function procedure, and the CalcScore(), RemoveImages(), and MoveImages() sub procedures.

The most interesting statement in this procedure is the conditional used with the If/Then code block If (Not MapRanges) <> -1. On occasion, you may need to test if a dynamic array variable has been dimensioned with a ReDim statement. (The variable MapRanges is declared as a dynamic array and its value is returned from the ScanImages() function procedure.) Unfortunately, VBA does not provide a function that will test this condition (the IsArray() function only tests if the variable was originally declared as an array). To work around this deficiency, you can test the numerical value returned by the statement Not ArrayVariableName, where ArrayVariableName is the name of the array variable. If the expression Not ArrayVariable Name returns -1, then the variable has not been dimensioned with a ReDim statement. It's a bit cryptic, but in the ProcessChart() sub procedure, it works well in the decision structure to identify whether or not the ScanImages() function procedure found any score sequences and thus dimensioned the array.

Private Sub ProcessChart() Dim MapRanges() As Range Dim scanAgain As Boolean

'Scan the chart, remove and score consecutive images, 'then update the chart with new images...repeat.

MapRanges = ScanImages If (Not MapRanges) <> -1 Then scanAgain = True

CalcScore MapRanges Application.ScreenUpdating RemoveImages MapRanges Application.ScreenUpdating Delay 1

Application.ScreenUpdating MoveImages MapRanges

Else scanAgain = False End If Loop While scanAgain End Sub

The function procedure ScanImages() is called from ProcessChart() and serves to search the image types in the chart for score sequences by scanning the values in the image map in the ImageMap worksheet. There is a lot happening in this procedure, so examine it closely. First, note that the function procedure returns an array of Range objects. This is the first example of a function procedure I've shown you that returns an array of any type. All you have to do to denote an array for the return type is add empty parentheses to the data type in the opening statement for the function.

You cannot create function procedures that return arrays in versions of Excel prior to Excel 2000.

Since the function returns an array of objects (specifically Range Objects), each element of the array will have to be referenced with a Set statement, but the return value will be assigned without using the Set keyword. As always, the data type of the return variable must match the function's data type.

Next, please note that the variables endPointsRow and endPointsCol are declared as dynamic arrays of the custom data type DataPoints defined in the general declarations section of the module. These two variables are assigned the return value from calls to the ScanRowOrCol() function procedure (listed later) and end up storing the score sequences. The range component of the endPointsRow and endPointsCol variables actually hold a reference to just the last cell in a range that must be scored. This is why the second component numCells is required in the DataPoints defined type. The first call to ScanRowOrCol() scans the rows in the mapped range and the second call scans the columns. As an example, consider the map shown in Figure 9.17 where I have emphasized the ranges that the program must score.

A sample map showing the image types contained in the bubble chart for the Alienated Game.

A sample map showing the image types contained in the bubble chart for the Alienated Game.

What Cellrange Excel 2007

When this image map is scanned, the array variable endPointsRow will be dimensioned with three elements. The cellRange components of each element will represent the ranges D4, H6, and E7 and their corresponding numCells components will hold 3, 3, and 4, respectively. The array variable endPointsCol will be dimensioned with only one element whose components are K8 and 4.

If a score sequence is found, then the ranges are converted to represent all cells whose values and corresponding images must be removed. This is done with the ConvertToRange() sub procedure that is passed the empty array variable retRange (among others) that serves as the return value of the ScanImages() function procedure. The array variable retRange is dimensioned according to how many different ranges containing score sequences have been found in the image map on the ImageMap worksheet. The elements of the retRange variable are carefully filled depending on whether all elements are in rows, columns, or both. Using the example from Figure 9.17, the array variable retRange will be dimensioned with four elements containing references to the ranges B4:D4, F6:H6, B7:E7, and K5:K8.

As you will see, scanning the rows and columns in the mapped range is not a trivial task so you will have to follow this code carefully.

Private Function ScanImages() As Range() Dim wsMap As Worksheet Dim mapRange As Range

Dim endPointsRow() As DataPoints, endPointsCol() As DataPoints Dim retRange() As Range Dim endlndex As Integer

Dim rowsExist As Boolean, colsExist As Boolean

Set wsMap = Worksheets("ImageMap") Set mapRange = wsMap.Range("ImageMap")

'Scan rows and columns.

endPointsRow = ScanRowOrCol(mapRange.Rows) endPointsCol = ScanRowOrCol(mapRange.Columns) If (Not endPointsRow) <> -1 Then rowsExist = True If (Not endPointsCol) <> -1 Then colsExist = True

'Convert mapped points to ranges for removal.

If rowsExist And colsExist Then

ReDim retRange(UBound(endPointsRow) + UBound(endPointsCol) + 1) ConvertToRange endPointsRow, 0, True, retRange, endIndex ConvertToRange endPointsCol, endIndex, False, retRange End If

If rowsExist And Not colsExist Then

ReDim retRange(UBound(endPointsRow)) ConvertToRange endPointsRow, 0, True, retRange End If

If Not rowsExist And colsExist Then

ReDim retRange(UBound(endPointsCol)) ConvertToRange endPointsCol, 0, False, retRange End If

ScanImages = retRange End Function

The function procedure ScanRowOrCol() is called from ScanImages() and returns a variable array of type DataPoints. The argument passed to this function is a range variable of the columns or rows (see ScanImages() function procedure) in the image map. Nested For/Each loops iterate through the rows or columns in the image map searching for score sequences.

When a sequence is found, the last cell in the range is assigned to the cellRange component of the variable array endPts and the number of cells in the sequence is assigned to the numCells component. The variable array endPts is returned to the calling procedure after the image map has been scanned.

You will notice that I have to Set a reference to a row or column range immediately inside the outer For/Each loop. This seems unnecessary since the range variable r should return an entire row or column from the image map, and the range variable c should subsequently return individual cells from r without having to set a reference to the range variable curRowOrCol; however, without setting the reference to the variable curRowOrCol, the range variable c will end up representing the exact same range as the variable r. This seems counter-intuitive to me and may be a bug in the VBA language, but at least it has an easy fix.

Private Function ScanRowOrCol(rangeToScan As Range) As DataPoints() Dim wsMap As Worksheet Dim c As Range

Dim r As Range, curRowOrCol As Range Dim prevVal As Integer, consecVals As Integer Dim endPts() As DataPoints Dim numPts As Integer

Set wsMap = Worksheets("ImageMap") consecVals = 1

'Loop through individual cells in input range and determine 'number of consecutive cells with the same value.

For Each r In rangeToScan

Set curRowOrCol = wsMap.Range(r.Address) For Each c In curRowOrCol

If prevVal = c.Value Then consecVals = consecVals + 1 If (consecVals >= 3) Then

If consecVals >= 4 Then numPts = numPts - 1 ReDim Preserve endPts(numPts) Set endPts(numPts).cellRange = c endPts(numPts).numCells = consecVals numPts = numPts + 1 End If

Else prevVal = c.Value consecVals = 1 End If

Next prevVal = 0 consecVals = 1

Next

ScanRowOrCol = endPts End Function

The purpose of the sub procedure ConverToRange() is to convert the values of a DataPoints variable representing score sequences to their full range; that is, it takes the cellRange and numCells components of the variable and converts them to a range expressing all cells. For example, the values H6 and 3 stored in the cellRange and numCells components of a DataPoints variable are converted to H4:H6 or F6:H6 depending on whether the variable represents a row or column. The DataPoints variable is passed in as the endPts array. The argument start represents the starting index that must be used to specify the elements assigned to the array variable retRange (passed by reference). The argument isRow specifies whether or not to convert the values in the array variable endPts to a row range or column range, and the argument endlndex is used to specify the last index used in the variable array retRange (required if this procedure is immediately called a second time when there are both row and column ranges to be scored).

Private Sub ConvertToRange(endPts() As DataPoints, start As Integer, _

isRow As Boolean, retRange() As Range, Optional endlndex As _ Integer)

Dim I As Integer

Dim rIndex As Integer, cIndex As Integer

'Convert ranges passed in as single cells to continuous 'ranges representing consecutive cells with same image map.

For I = start To UBound(endPts) + start If isRow Then rIndex = endPts(I - start).cellRange.Row cIndex = endPts(I - start).cellRange.Column - _ endPts(I - start).numCells + 1

endPts(I - start).numCells + 1 cIndex = endPts(I - start).cellRange.Column End If

Set retRange(I) = Worksheets("ImageMap").Range(Chr(cIndex + 64) & _ rIndex & ":" & endPts(I - start).cellRange.Address) Next I

endIndex = I End Sub

The sub procedure CalcScore() is called from ProcessChart() and serves to update the score displayed in an AxisTitle object on the bubble chart. The argument MapRanges contains references to all score sequences found from the latest scan of the image map. Counting the number of cells in these ranges is easy and ten points are assigned to each cell. The point total is updated by setting the Text property of the AxisTitle object for the x-axis.

Private Sub CalcScore(MapRanges() As Range) Dim I As Integer Dim totPts As Integer Dim score As AxisTitle Const PTSPERIMAGE = 10

'Calculates the player's score. 10 pts per removed image.

Set score = Sheets("Alienated").Axes(xlCategory).AxisTitle For I = 0 To UBound(MapRanges)

totPts = totPts + MapRanges(I).Rows.Count totPts = totPts + MapRanges(I).Columns.Count totPts = totPts - 1 Next I

score.Text = Val(score.Text) + totPts * PTSPERIMAGE End Sub

That gets you through the toughest part of the program. What remains are some procedures that handle removing, moving, and swapping images in the chart and updating the corresponding map in the ImageMap worksheet.

The RemoveImages() sub procedure is called from ProcessChart() and its function is to remove images from chart markers that have been scored. The procedure takes advantage of the near one-to-one correspondence between the row and column indices of the image map, and the series and point indices of the chart (there is an offset of 1 because the image map starts with row 2 and column 2 in the ImageMap worksheet, and series and point indices start with 1). A For/Each loop nested inside a For/Next loop handles the image removal. The outer For/Next loop iterates through each Range object referenced in the argument mapRange (variable array) that references the cells in the image map that have been scored. The inner For/Each loop iterates through each cell in a scored range in order to use the cell's row and column indices as indicators for the series, and point indices with the Item() method of the Series Collection object and the Points() method of the Series object. The Item() method returns a specific Series object using the index value passed to the method and the Points() method returns a specific Point object using the index value passed to this method. The ColorIndex property of the Interior object associated with a specific Point object is then used to remove the image by setting its value to xlNone.

Private Sub RemoveImages(mapRange() As Range) Dim chAlien As Chart Dim chSeriesCol As SeriesCollection Dim c As Range Dim I As Integer

'Remove images that have been scored.

Set chAlien = Sheets("Alienated") Set chSeriesCol = chAlien.SeriesCollection For I = 0 To UBound(mapRange) For Each c In mapRange(I)

chSeriesCol.Item(c.Row - 1).Points(c.Column - 1). _ Interior.ColorIndex = xlNone

Next Next I End Sub

Figure 9.18 shows the bubble chart after the ranges shown in Figure 9.17 have been used to remove scored images.

The bubble chart in the Alienated Game after the removal of scored images.

Ê3 Microsoft Excel - Alienated,xls

V*! File Edit View insert Format loot chart Window Help

Select two adjacent aliens to swap. Two sing la clicks will select a single alien.

After scored images are removed from the chart, the images lying above an empty set of markers must be moved down. The MoveImages() sub procedure is called from ProcessChart() to handle this task. Before images can be moved down the chart, the values in the image map in the ImageMap worksheet must be moved. The MoveMap() sub procedure moves the values in the image map down in order to fill vacancies left by removing these values when scoring a range. Updating the chart is easy—just call the InitSeriesImages() sub procedure listed earlier that uses the image map to identify which data markers in the chart receive what alien image.

After a one second delay, the vacancies in the top rows of the mapped range are randomly filled with a call to the FillMap() sub procedure before the new images are added to the chart with another call to InitSeriesImages().

Figure 9.19 shows the bubble chart and image map after the images in Figure 9.18 have been moved down, but before new images have been added.

Private Sub MoveImages(mapRange() As Range)

'Move mapped values down after deletions.

MoveMap mapRange

'Move images down on chart.

InitSeriesImages

Application.ScreenUpdating = True Delay 1

Application.ScreenUpdating = False FillMap

InitSeriesImages End Sub

The bubble chart after moving the images down.

E3 Microsoft Excel - Alienated.xls

[5p] Rle Edit yew insert Format loob chart Window Help - - fl

¿elect two adjacent aliens to swap. Two single clicks will select a single dien.

There are probably numerous algorithms that could be developed for quickly and efficiently moving values down in the image map; unfortunately, I couldn't think of any. My algorithm for moving values down is not particularly efficient, but that's okay; the image map only contains 100 cells and it won't take too long to iterate through them all. After clearing the scored ranges (the easy part), the MoveMap() sub procedure iterates through the columns in the image map with a For/Each loop. With each column returned to the range variable mapCol, I first test for an empty cell within this range using the Find() method of the Range object. If there is no empty cell in the column then the loop iterates to the next column range; so in some cases, this procedure may not have to iterate through all 100 cells in the range.

When an empty cell is discovered, a nested For/Each loop iterates through all cells in the column, collecting values from non-empty cells. For example, if a column contains two empty cells, then the array variable colVals will end up with eight elements. Immediately following the For/Each loop a For/Next loop writes the values in the array variable colVals back to the column starting with a row index that ensures the values are written in continuous cells, and that the loop finishes in row 11. This process is repeated for each column with an empty cell or cells (see Figure 9.20 to see the result).

The ImageMap worksheet after vacancies are filled by moving values down.

The ImageMap worksheet after vacancies are filled by moving values down.

Private Sub MoveMap(mapRange() As Range) Dim I As Integer Dim wsMap As Worksheet

Dim mapCol As Range, firstEmptyCell As Range

Dim colVals() As Integer

Dim rngDel As Range, c As Range

Private Sub MoveMap(mapRange() As Range) Dim I As Integer Dim wsMap As Worksheet

Dim mapCol As Range, firstEmptyCell As Range

Dim colVals() As Integer

Dim rngDel As Range, c As Range

'Clear scored ranges.

Set wsMap = Worksheets("ImageMap") For I = 0 To UBound(mapRange)

Set rngDel = wsMap.Range(mapRange(I).Address) rngDel.ClearContents Next I I = 0

Loop through columns and collect all non-zero values in each column then clear column and write values back in consecutive cells.

For Each mapCol In wsMap.Range("ImageMap").Columns Set firstEmptyCell = mapCol.Find(What:="") If Not firstEmptyCell Is Nothing Then

For Each c In wsMap.Range(mapCol.Address) If c.Value <> "" Then

ReDim Preserve colVals(I) colVals(I) = c.Value I = I + 1 End If

Next mapCol.ClearContents

Next End Sub

Empty cells at the top of the image map are filled with a call to the FillMap() sub procedure. Integer values between 1 and 7 are randomly added to any empty cells found in the image map.

Private Sub FillMap()

Dim mapRange As Range Dim c As Range

Randomize

'Fill empty cells in image map with random integer 'between 1 and 7.

Set mapRange = Worksheets("ImageMap").Range("ImageMap") For Each c In mapRange If c.Value = "" Then c.Value = Int(Rnd * 7) + 1 End If

Next End Sub

Private Sub Delay(pauseTime As Single) Dim curTime As Single curTime = Timer Do

DoEvents

Loop While (curTime + pauseTime) > Timer End Sub

Biorhythm Awareness

Biorhythm Awareness

Who else wants to take advantage of biorhythm awareness to avoid premature death, escape life threatening diseases, eliminate most of your life altering mistakes and banish catastrophic events from your life.

Get My Free Ebook


Responses

Post a comment