Page 1 of 1

Topography Map in VB6 Tutorial on how to do a topography map in VB6 Rate Topic: -----

#1 Nayana  Icon User is offline

  • DIC Hawk - 나야나 नयन:
  • member icon

Reputation: 31
  • View blog
  • Posts: 824
  • Joined: 14-November 07

Post icon  Posted 18 February 2008 - 03:57 AM

Introduction

I'm writing this tutorial in response to a random forum question that looked mildly interesting.

The purpose of this tutorial is to introduce a few concepts, such as:
  • Teach beginners a few things about VB6
  • Show how to automatically resize controls to fit a form
  • Do a simple grid drawing operation

I will also say that I do not condone the use of VB6 in a professional environment, nor even in a higher education facility. But for a complete beginner it does make it easier to learn a few basic programming concepts.

OK, firstly, we need to make a new project and put a few things on a form.


Getting Started

When Visual Basic 6 loads, we start off with the following dialog:
Attached Image
As Standard EXE is already selected, we can just click Open.

Next, we want to add a command button and picture box to the form. Do so as in the picture below and name the command button as cmdGenerate, and call the picture box picGraph. Set the caption property of cmdGenerate to "Generate Data" or whatever else takes your fancy.
Attached Image


Resizing Stuff

Well, that didn't take long. Now we have a really ugly form, and it's time to write some code.

First we'll write the code that automatically resizes the Picture Box so that it always fills up the form.

Double-click on the picture box, and your screen should look like this:
Attached Image

Then click on the drop-down donated by the blue arrow (pretty isn't it?) scroll down, and select Resize

Our screen should now look like this:
Attached Image

Now put the following code into the picGraph_Resize function, so it looks like this:
Private Sub picGraph_Resize()
	Dim needRefresh As Boolean
	Dim width As Integer
	Dim height As Integer
	
	If (picGraph.width + picGraph.Left) > Me.ScaleWidth Or (picGraph.height + picGraph.Top) > Me.ScaleHeight Then
		needRefresh = True
	End If
	
	width = Me.ScaleWidth - picGraph.Left
	height = Me.ScaleHeight - picGraph.Top
	
	If width < 0 Then width = 0
	If height < 0 Then height = 0
	
	picGraph.width = width
	picGraph.height = height
	
	If needRefresh Then
		picGraph.Refresh
	End If
End Sub



I'll break this down, and explain why we are doing certain things.

If (picGraph.width + picGraph.Left) > Me.ScaleWidth Or (picGraph.height + picGraph.Top) > Me.ScaleHeight
This rather complex line of code is just checking if either the width or height of the picGraph picture box is about to become smaller. This is because when a picture box becomes smaller, the Paint event is not called. We are just checking if it needs to be called.

width = Me.ScaleWidth - picGraph.Left
height = Me.ScaleHeight - picGraph.Top
Here we are setting the new width and height. The Me refers to the owner form, and the ScaleWidth (and height) are a sadistic feature of VB6, but basically it lets us know how much space is available inside the form. The arithmetic here should be fairly easy to comprehend.

If width < 0 Then width = 0
If height < 0 Then height = 0
Here we are checking if the new width and height are smaller than 0. Because if they are, the program will crash. We don't like that happening, which is why we check :)

Anyhow, we now have a form that resizes its picture box control, but still does nothing else.


Pretty Data

OK, so no program is useful without its data. Or pretty even. First we need an array to store all our data.

We'll make an empty array, and a boolean that states whether data is available or not.

Add the following code to the TOP of the form:
Dim Values() As Double
Dim dataReady As Boolean



Values is going to hold all our data, and dataReady will be set to True when there is data available.

Now we want to generate some data.

Go back to the form view, to do this, choose Object from the View menu.
Attached Image

Now double click on the command button cmdGenerate. And put the following code inside
	Dim rows As Integer
	Dim cols As Integer
	
	rows = Rnd * 10 + 5
	cols = Rnd * 10 + 5
	
	ReDim Values(rows, cols)
	
	Dim row As Integer
	Dim col As Integer
	
	For row = 1 To rows
		For col = 1 To cols
			Values(row, col) = Rnd * 4 - 1
		Next
	Next
	
	dataReady = True
	picGraph.Refresh



rows = Rnd * 10 + 5
Here, we are creating a random number of rows (between 5 and 15). Rnd is a VB6 function that generates a random number between 0 and 1. We multiply it by 10, which makes a number from 0 to 9. We add, 5, and then the number will be from 5 to 14. (the highest number rnd makes is 0.99999) or something like that.

Because Row is an Integer, assigning a decimal value to it, just chops of the numbers after the decimal point without rounding at all.

ReDim Values(rows, cols)
Here we are making a 2 dimensional array. We can access it in future like so: Values(1, 4) or something of similar ilk.

	For row = 1 To rows
		For col = 1 To cols


Here we are iterating through all the new elements of our array. Going through each row, then going through each column inside each row.

Values(row, col) = Rnd * 4 - 1
Here we are assigning a value to our data array. The random number generated here will be in the range of -1 though 2.999.

dataReady = True
Here we simply let the rest of the program know that there is data available.

picGraph.Refresh now we ask picGraph to redraw itself.

---

So far we have created the data, but you might ask. Where are the pretty pictures???

Just wait, they're coming.

---

OK, our pictures need to have colour! So let's add this function that assigns different colours depending on the value of an element:

Private Function getColour(value As Double) As Long
	If value >= 1.8 Then
		getColour = vbYellow
	ElseIf value >= 1.5 Then
		getColour = vbGreen
	ElseIf value >= 0 Then
		getColour = vbBlue
	Else
		getColour = vbMagenta
	End If
End Function



I think that is pretty self explanatory. Basically, we pass a value to the function, and it returns a colour (in the form of a Long Integer).


Drawing Pretty Data

Let's create a function:
Sub drawGraph(Values() As Double, pbox As PictureBox)
	Dim cellHeight As Double
	Dim cellWidth As Double
	Dim rows As Integer
	Dim cols As Integer
	
	rows = UBound(Values, 1)
	cols = UBound(Values, 2)
	
	cellHeight = pbox.height / rows
	cellWidth = pbox.width / cols
	
	Dim row As Integer
	Dim col As Integer
	
	Dim x As Integer
	Dim y As Integer
	
	For row = 1 To rows
		For col = 1 To cols
			x = (col - 1) * cellWidth
			y = (row - 1) * cellHeight
			pbox.Line (x, y)-(x + cellWidth, y + cellHeight), getColour(Values(row, col)), BF
		Next
	Next
End Sub



We are still not finished, because we need to call this function to get it to draw something. That can come next, but first let's explain what this function does.

	Dim cellHeight As Double
	Dim cellWidth As Double
	Dim rows As Integer
	Dim cols As Integer


These are just general variable declarations. In this case, cellHeight is going to be the height of a cell. rows: the number of rows.

	rows = UBound(Values, 1)
	cols = UBound(Values, 2)


Here we calculate the number of rows and cols we are going to have. This is gained from the size of the data array we made back in cmdGenerate_Click().

	cellHeight = pbox.height / rows
	cellWidth = pbox.width / cols


Calculating the width and height each cell (rectangle) is going to be.

	For row = 1 To rows
		For col = 1 To cols


Once again, iterating through all the cells (just like in cmdGenerate_Click()).

			x = (col - 1) * cellWidth
			y = (row - 1) * cellHeight



Here, we find out our x and y. For the first column, x will be 0. (Because 1-1 == 0, and 0 * anything == 0). Same goes for y.

The cellWidth which we have calculated previously will be multiplied by (col - 1), which gives us our evenly placed rectangles. Same for cellHeight.

And finally, we draw the box:
pbox.Line (x, y)-(x + cellWidth, y + cellHeight), getColour(Values(row, col)), BF
This is a more complex one.

Basically we are drawing a diagonal line from x, y
to x + cellWidth, y + cellHeight.
Then we assign it a colour using the value: getColour(Values(row, col)).
And finally make it a filled box: , BF.

Now all we have to do is make sure this function gets called. So we need to add code, to when the picGraph picture box is ready to be repainted.

Go back to the Object View like so:
Attached Image

Double click on the picture box (picGraph).

Now select the Paint from the dropdown menu (once again denoted by the friendly blue arrow):
Attached Image

And make the code like this:
Private Sub picGraph_Paint()
	If dataReady Then
		drawGraph Values, picGraph
	End If
End Sub


Basically, we just test if data is ready, and if it is, we pass the values, and the picture box through to our function which does the drawing.

We now have a complete program that works.

Just run the program, and click the "Generate Data" button. You should get something that looks like this:
Attached Image

This can be resized at will, and the squares inside will also be resized.

Hope you learnt something today.

Quote

Please feel free to give any feedback on this tutorial. If I didn't explain something well enough, I am happy to elaborate. Negative or positive feedback are both welcome.


Complete code listing:
Option Explicit

Dim Values() As Double
Dim dataReady As Boolean

Private Sub cmdGenerate_Click()
	Dim rows As Integer
	Dim cols As Integer
	
	rows = Rnd * 10 + 5
	cols = Rnd * 10 + 5
	
	ReDim Values(rows, cols)
	
	Dim row As Integer
	Dim col As Integer
	
	For row = 1 To rows
		For col = 1 To cols
			Values(row, col) = Rnd * 4 - 1
		Next
	Next
	
	dataReady = True
	picGraph.Refresh
End Sub

Private Sub Form_Resize()
	Dim needRefresh As Boolean
	Dim width As Integer
	Dim height As Integer
	
	If (picGraph.width + picGraph.Left) > Me.ScaleWidth Or (picGraph.height + picGraph.Top) > Me.ScaleHeight Then
		needRefresh = True
	End If
	
	width = Me.ScaleWidth - picGraph.Left
	height = Me.ScaleHeight - picGraph.Top
	
	If width < 0 Then width = 0
	If height < 0 Then height = 0
	
	picGraph.width = width
	picGraph.height = height
	
	If needRefresh Then
		picGraph.Refresh
	End If
End Sub

Private Sub picGraph_Paint()
	If dataReady Then
		drawGraph Values, picGraph
	End If
End Sub

Sub drawGraph(Values() As Double, pbox As PictureBox)
	Dim cellHeight As Double
	Dim cellWidth As Double
	Dim rows As Integer
	Dim cols As Integer
	
	rows = UBound(Values, 1)
	cols = UBound(Values, 2)
	
	cellHeight = pbox.height / rows
	cellWidth = pbox.width / cols
	
	Values(4, 4) = 5
	Values(3, 3) = -1
	
	Dim row As Integer
	Dim col As Integer
	
	Dim x As Integer
	Dim y As Integer
	
	For row = 1 To rows
		For col = 1 To cols
			x = (col - 1) * cellWidth
			y = (row - 1) * cellHeight
			pbox.Line (x, y)-(x + cellWidth, y + cellHeight), getColour(Values(row, col)), BF
		Next
	Next
End Sub

Private Function getColour(value As Double) As Long
	If value >= 1.8 Then
		getColour = vbYellow
	ElseIf value >= 1.5 Then
		getColour = vbGreen
	ElseIf value >= 0 Then
		getColour = vbBlue
	Else
		getColour = vbMagenta
	End If
End Function



Is This A Good Question/Topic? 0
  • +

Replies To: Topography Map in VB6

#2 Rickster0  Icon User is offline

  • D.I.C Head
  • member icon

Reputation: 16
  • View blog
  • Posts: 236
  • Joined: 08-July 08

Posted 01 November 2008 - 04:41 PM

this is great if only i knew how to do the exact same in VB.net
Was This Post Helpful? 0
  • +
  • -

#3 maceng  Icon User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 6
  • Joined: 12-February 08

Posted 17 December 2008 - 01:35 PM

First, thanks for this great tutorial. Ive been trying to make a program for showing the distribution of stresses along a plaque (like heat across a steel plate)

Just a few questions:

1) Is this portion of code necessary and if so, whats for?

Values(4, 4) = 5
Values(3, 3) = -1

2) What is the meaning of the function or command UBound? Can you please explain?

rows = UBound(Values, 1)
cols = UBound(Values, 2)

3) Finally, Ive been trying to moodify it so I can assign a color depending on the position of the
rectangle (given by x and y), to not avail. Can you please help me in this regard?

Sorry in advance for the trouble, but Ill greatly appreciate it. Thanks.
Was This Post Helpful? 0
  • +
  • -

Page 1 of 1