|
-
Jul 5th, 2000, 06:24 AM
#1
Thread Starter
Fanatic Member
grrrrrrr
Ok, here's the problem.
I have a picture box on a form, on form startup and resize faint grid lines are drawn onto the picture box to make it look like graph paper.
Because I'm using the line method rather that lots of line controls I can't set the AutoRedraw to true. All works fine except if the form is partially or completely covered, when the grid lines vanish leaving the white picture box.
I can put up with this to a degree but I want to have the lines redrawn on focus of my app. Gotfocus and Activate don't do work (I tried making a call to the line draw the same way as the resize but nothing happens)
why??????
here's the code!
Code:
Option Explicit
Const L_Space = 15
Private Sub Command1_Click()
Dim HorLoop As Long
Dim VerLoop As Long
Dim ZeroCounter As Integer
ZeroCounter = 0
'vertical lines
For HorLoop = Pallette1.Left To Pallette1.Width + Pallette1.Left
ZeroCounter = ZeroCounter + 1
If ZeroCounter Mod L_Space = 0 Then
frmMap.Line (HorLoop, Pallette1.Top + 2)-(HorLoop, Pallette1.Height + Pallette1.Top - 2), RGB(200, 200, 200)
End If
Next
ZeroCounter = 0
' horizontal lines
For VerLoop = Pallette1.Top To Pallette1.Height + Pallette1.Top
ZeroCounter = ZeroCounter + 1
If ZeroCounter Mod L_Space = 0 Then
frmMap.Line (Pallette1.Left + 2, VerLoop)-(Pallette1.Width + Pallette1.Left - 2, VerLoop), RGB(200, 200, 200)
End If
Next
End Sub
Private Sub Form_Resize()
On Error Resume Next
Pallette1.Height = frmMap.ScaleHeight - 50
Pallette1.Width = frmMap.ScaleWidth - 30
Command1.Top = Pallette1.Top + Pallette1.Height + 20
Command2.Top = Pallette1.Top + Pallette1.Height + 20
Command3.Top = Pallette1.Top + Pallette1.Height + 20
VScroll1.Left = Pallette1.Left + Pallette1.Width '+ 1
VScroll1.Height = Pallette1.Height
HScroll1.Top = Pallette1.Top + Pallette1.Height '+ 1
HScroll1.Width = Pallette1.Width
DoEvents
Call Command1_Click
End Sub
Paul Dwyer 
Network Engineer
Aussie In Tokyo
Using Powerbasic 6 & VB6 SP4 (Please also add your VB Version to your signature!)
-
Jul 5th, 2000, 07:01 AM
#2
Hyperactive Member
-
Jul 5th, 2000, 07:06 AM
#3
Fanatic Member
Doh! Judd got there first. Never mind.
The activate and got_focus events are not firing, because the form already has the focus and is activated. Why, becuse VB is crap.
Seriously though. Becuase it is the only form in the project, it can't lose the focus to another, and it is already activated.
Iain, thats with an i by the way!
-
Jul 5th, 2000, 07:29 AM
#4
Thread Starter
Fanatic Member
Close, but no cigar...
here's the exe (24k, the code you have) http://www.ozemail.com.au/~devore/Map_Designer.exe
it doesn't redraw the lines !!!!
Paul Dwyer 
Network Engineer
Aussie In Tokyo
Using Powerbasic 6 & VB6 SP4 (Please also add your VB Version to your signature!)
-
Jul 5th, 2000, 07:44 AM
#5
Fanatic Member
That code you posted, doesn't look anything like the program you put up.
The code doesn't draw any lines. Well it sort of does on the form, but not on the picture box.
Iain, thats with an i by the way!
-
Jul 5th, 2000, 08:03 AM
#6
Hyperactive Member
My Code - which works!
Code:
Option Explicit
Const L_Space = 15
Private Sub Command1_Click()
Dim HorLoop As Long
Dim VerLoop As Long
Dim ZeroCounter As Integer
ZeroCounter = 0
'vertical lines
For HorLoop = Pallette1.Left To Pallette1.Width ' + Pallette1.Left
ZeroCounter = ZeroCounter + 1
If ZeroCounter Mod L_Space = 0 Then
Pallette1.Line (HorLoop, Pallette1.Top)-(HorLoop, Pallette1.Height + Pallette1.Top), RGB(200, 200, 200)
End If
Next
ZeroCounter = 0
' horizontal lines
For VerLoop = Pallette1.Top To Pallette1.Height ' + Pallette1.Top
ZeroCounter = ZeroCounter + 1
If ZeroCounter Mod L_Space = 0 Then
Pallette1.Line (Pallette1.Left, VerLoop)-(Pallette1.Width + Pallette1.Left, VerLoop), RGB(200, 200, 200)
End If
Next
End Sub
Private Sub Form_Paint()
Call Command1_Click
End Sub
Private Sub Form_Resize()
On Error Resume Next
Pallette1.Height = frmMap.ScaleHeight - 50
Pallette1.Width = frmMap.ScaleWidth - 30
Command1.Top = Pallette1.Top + Pallette1.Height + 20
Command2.Top = Pallette1.Top + Pallette1.Height + 20
Command3.Top = Pallette1.Top + Pallette1.Height + 20
VScroll1.Left = Pallette1.Left + Pallette1.Width '+ 1
VScroll1.Height = Pallette1.Height
HScroll1.Top = Pallette1.Top + Pallette1.Height '+ 1
HScroll1.Width = Pallette1.Width
DoEvents
Call Command1_Click
End Sub
AutoRedraw = True on both form AND picturebox (works ok on picturebox only, but better with both on)
      
Dan
Outside of a dog, a book is a man's best friend.
Inside of a dog, it's too dark to read.
-
Jul 5th, 2000, 08:56 AM
#7
Hyperactive Member
-
Jul 5th, 2000, 09:26 AM
#8
Thread Starter
Fanatic Member
Thanks
Thanks Judd
It took me a while to see that you had changed the object calling the line method. all works now, I've modified the code to:
Code:
Private Sub Command1_Click()
Dim HorLoop As Long
Dim VerLoop As Long
Dim ZeroCounter As Integer
For HorLoop = 0 To Pallette1.Width ' + Pallette1.Left
ZeroCounter = ZeroCounter + 1
If ZeroCounter Mod L_Space = 0 Then
Pallette1.Line (HorLoop, 0)-(HorLoop, Pallette1.Height), RGB(200, 200, 200)
End If
Next
ZeroCounter = 0
' horizontal lines
For VerLoop = 0 To Pallette1.Height ' + Pallette1.Top
ZeroCounter = ZeroCounter + 1
If ZeroCounter Mod L_Space = 0 Then
Pallette1.Line (0, VerLoop)-(Pallette1.Width, VerLoop), RGB(200, 200, 200)
End If
Next
End Sub
because I'm not sure that the picture box will stay in the top left corner and if you move it the lines don't start at the right place.
hex and oct are still just ideas, it's likely you'll hear from me here again about that 
lian17, yes I realised that. I origionally started with just a white square shape control but decided to change it for a picture box later. whaich is part of the reason this problem came up.
Paul Dwyer 
Network Engineer
Aussie In Tokyo
Using Powerbasic 6 & VB6 SP4 (Please also add your VB Version to your signature!)
-
Jul 5th, 2000, 09:31 AM
#9
hi paul!
i hope i got your problem correctly. you can of course use AutoRedraw to get everything properly in your startup and resize code.
before you start drawing set autoredraw to true, do a cls, draw whatever you want with whatever methods you want and when finished set autoredraw to false. this sets whatever you have drawn to the picturebox's background picture, that gets automaticly redrawn and can be accessed via the Image property.
hope i could help
Sascha
-
Jul 5th, 2000, 09:32 AM
#10
Thread Starter
Fanatic Member
HEY!
My thread title got censored!!
I think I'm being watched, best be careful lest I get banned from VB-world. 
Paul Dwyer 
Network Engineer
Aussie In Tokyo
Using Powerbasic 6 & VB6 SP4 (Please also add your VB Version to your signature!)
-
Jul 5th, 2000, 10:27 AM
#11
Fanatic Member
I've got an algorithim that will draw you a grid of Hexagons.
It is not perfect, as they are hardly regular hexagons, but i am working on that.
Code:
Option Explicit
'the lenegth of each side of the hexagon
Const SIDE_LENGTH = 300
''
Private Sub Command1_Click()
Dim i As Integer
Dim j As Integer
Dim iLoopEnd As Integer
Dim jLoopend As Integer
Dim iChangeXBy As Double
Dim iChangeYBy As Double
Picture1.AutoRedraw = True
iChangeXBy = Sqr(2 * (SIDE_LENGTH ^ 2)) / 2
iChangeYBy = Sqr((SIDE_LENGTH ^ 2) - (iChangeXBy ^ 2))
iLoopEnd = Picture1.Height \ iChangeYBy
jLoopend = Picture1.Width \ iChangeXBy
''Picture1.AutoRedraw = True
Picture1.CurrentX = 0
Picture1.CurrentY = iChangeYBy
'Draw /\/\/\ bits
For i = 1 To iLoopEnd
For j = 1 To jLoopend
If i Mod 2 <> 0 Then
Picture1.Line (Picture1.CurrentX, Picture1.CurrentY)-(Picture1.CurrentX + iChangeXBy, Picture1.CurrentY - iChangeYBy)
Picture1.Line (Picture1.CurrentX, Picture1.CurrentY)-(Picture1.CurrentX + iChangeXBy, Picture1.CurrentY + iChangeXBy)
Else
Picture1.Line (Picture1.CurrentX, Picture1.CurrentY)-(Picture1.CurrentX + iChangeXBy, Picture1.CurrentY + iChangeYBy)
Picture1.Line (Picture1.CurrentX, Picture1.CurrentY)-(Picture1.CurrentX + iChangeXBy, Picture1.CurrentY - iChangeYBy)
End If
Next j
Picture1.CurrentX = 0
If i Mod 2 <> 0 Then
Picture1.CurrentY = Picture1.CurrentY + SIDE_LENGTH
Else
Picture1.CurrentY = Picture1.CurrentY + SIDE_LENGTH + iChangeYBy * 2
End If
Next i
Picture1.CurrentX = 0
Picture1.CurrentY = iChangeYBy
'draw the | bits
For i = 1 To iLoopEnd
For j = 1 To jLoopend
Picture1.Line (Picture1.CurrentX, Picture1.CurrentY)-(Picture1.CurrentX, Picture1.CurrentY + SIDE_LENGTH)
Picture1.CurrentX = Picture1.CurrentX + 2 * iChangeXBy
Picture1.CurrentY = Picture1.CurrentY - SIDE_LENGTH
Next j
Picture1.CurrentY = Picture1.CurrentY + SIDE_LENGTH + iChangeYBy
If i Mod 2 <> 0 Then
Picture1.CurrentX = iChangeXBy
Else
Picture1.CurrentX = 0
End If
Next i
End Sub
Iain, thats with an i by the way!
-
Jul 5th, 2000, 10:33 AM
#12
Hyperactive Member
My 'cheaty' method...
Code:
Option Explicit
Const L_Space = 200
Const pi = 3.14159265358979
Public MapType As Integer '1:Square 2:Hex 3:Oct
Private Sub Command1_Click()
Dim HorLoop As Long
Dim VerLoop As Long
Dim ZeroCounter As Integer
picMap.Cls
ZeroCounter = 0
'vertical lines
For HorLoop = picMap.Left To picMap.Width ' + picMap.Left
ZeroCounter = ZeroCounter + 1
If ZeroCounter Mod L_Space = 0 Then
picMap.Line (HorLoop, picMap.Top)-(HorLoop, picMap.Height + picMap.Top), RGB(200, 200, 200)
End If
Next
ZeroCounter = 0
' horizontal lines
For VerLoop = picMap.Top To picMap.Height ' + picMap.Top
ZeroCounter = ZeroCounter + 1
If ZeroCounter Mod L_Space = 0 Then
picMap.Line (picMap.Left, VerLoop)-(picMap.Width + picMap.Left, VerLoop), RGB(200, 200, 200)
End If
Next
MapType = 1
End Sub
Private Sub Command2_Click()
Dim x As Long
Dim y As Long
Dim bIn As Boolean
picMap.Cls
x = 0: y = 0: bIn = False
Do While x < picMap.Width
If bIn Then
y = 0 + (Sqr(3) * L_Space / 2)
Else
y = 0
End If
Do While y < picMap.Height
Call DrawHex(x, y)
y = y + (Sqr(3) * L_Space)
Loop
x = x + (1.5 * L_Space)
bIn = Not bIn
Loop
MapType = 2
End Sub
Private Sub Command3_Click()
Dim x As Long
Dim y As Long
Dim bIn As Boolean
picMap.Cls
x = 0: y = 0: bIn = False
Do While x < picMap.Width
If bIn Then
y = 0
Else
y = 0
End If
Do While y < picMap.Height
Call DrawOct(x, y)
y = y + ((1 + Sqr(2)) * L_Space)
Loop
x = x + ((1 + Sqr(2)) * L_Space)
bIn = Not bIn
Loop
MapType = 3
End Sub
Private Sub Form_Paint()
Select Case MapType
Case 1
Call Command1_Click
Case 2
Call Command2_Click
Case 3
Call Command3_Click
End Select
End Sub
Private Sub Form_Resize()
On Error Resume Next
picMap.Height = frmMap.ScaleHeight - 600
picMap.Width = frmMap.ScaleWidth - VScroll1.Width
Command1.Top = picMap.Top + picMap.Height + HScroll1.Height + 50
Command2.Top = picMap.Top + picMap.Height + HScroll1.Height + 50
Command3.Top = picMap.Top + picMap.Height + HScroll1.Height + 50
VScroll1.Left = picMap.Left + picMap.Width '+ 1
VScroll1.Height = picMap.Height
HScroll1.Top = picMap.Top + picMap.Height '+ 1
HScroll1.Width = picMap.Width
DoEvents
Call Form_Paint
End Sub
Private Sub DrawHex(ByVal x As Long, ByVal y As Long)
Const angle = 30 * (pi / 180)
'Line 1
picMap.Line (x, y)-(x + L_Space, y), RGB(200, 200, 200)
x = x + L_Space
'Line 2
picMap.Line (x, y)-(x + (L_Space * Sin(angle)), y + (L_Space * Cos(angle))), RGB(200, 200, 200)
x = x + (L_Space * Sin(angle)): y = y + (L_Space * Cos(angle))
'Line 3
picMap.Line (x, y)-(x - (L_Space * Sin(angle)), y + (L_Space * Cos(angle))), RGB(200, 200, 200)
x = x - (L_Space * Sin(angle)): y = y + (L_Space * Cos(angle))
'Line 4
picMap.Line (x, y)-(x - L_Space, y), RGB(200, 200, 200)
x = x - L_Space
'Line 5
picMap.Line (x, y)-(x - (L_Space * Sin(angle)), y - (L_Space * Cos(angle))), RGB(200, 200, 200)
x = x - (L_Space * Sin(angle)): y = y - (L_Space * Cos(angle))
'Line 6
picMap.Line (x, y)-(x + (L_Space * Sin(angle)), y - (L_Space * Cos(angle))), RGB(200, 200, 200)
End Sub
Private Sub DrawOct(ByVal x As Long, ByVal y As Long)
Const angle = 45 * (pi / 180)
'Line 1
picMap.Line (x, y)-(x + L_Space, y), RGB(200, 200, 200)
x = x + L_Space
'Line 2
picMap.Line (x, y)-(x + (L_Space * Sin(angle)), y + (L_Space * Cos(angle))), RGB(200, 200, 200)
x = x + (L_Space * Sin(angle)): y = y + (L_Space * Cos(angle))
'Line 3
picMap.Line (x, y)-(x, y + L_Space), RGB(200, 200, 200)
y = y + L_Space
'Line 4
picMap.Line (x, y)-(x - (L_Space * Sin(angle)), y + (L_Space * Cos(angle))), RGB(200, 200, 200)
x = x - (L_Space * Sin(angle)): y = y + (L_Space * Cos(angle))
'Line 5
picMap.Line (x, y)-(x - L_Space, y), RGB(200, 200, 200)
x = x - L_Space
'Line 6
picMap.Line (x, y)-(x - (L_Space * Sin(angle)), y - (L_Space * Cos(angle))), RGB(200, 200, 200)
x = x - (L_Space * Sin(angle)): y = y - (L_Space * Cos(angle))
'Line 7
picMap.Line (x, y)-(x, y - L_Space), RGB(200, 200, 200)
y = y - L_Space
'Line 8
picMap.Line (x, y)-(x + (L_Space * Sin(angle)), y - (L_Space * Cos(angle))), RGB(200, 200, 200)
End Sub
      
Dan
Outside of a dog, a book is a man's best friend.
Inside of a dog, it's too dark to read.
-
Jul 5th, 2000, 10:43 AM
#13
Fanatic Member
Judd,
Very nice. I'm impressed.
Unfortunatley you have nicked my idea. That was the next bit of code
i was going to do, the call a draw hex method. Seeing as i am a bit crap at
maths, it is a good job you did it first. 
Still it saves me writing it.
Iain, thats with an i by the way!
-
Jul 5th, 2000, 11:51 AM
#14
Hyperactive Member
-
Jul 5th, 2000, 10:12 PM
#15
Thread Starter
Fanatic Member
Hahahaha, My My, haven't we all been busy bees! I wake up theis morning (Afternoon, I'm on leave ) and all this code has appeared.
Haven't tested yours yet because I wanted to have a bash at the hex myself, Next I'll do some performance checking to see how they work out.
But, Here it is!!!
Code:
'form header
Const HexWidth = 10
Public HalfWidth As Integer
Public HalfHex As Integer
Public FullHex As Integer
'sub
Pallette1.Cls
HalfHex = HexWidth * 0.86
FullHex = HalfHex * 2
HalfWidth = HexWidth \ 2
Dim Row As Long
Dim Tabular As Long
Dim HorLoop As Long
Dim Increment As Integer 'half offset counter
Dim Increment2 As Integer ' double offset counter
For Row = 0 To Pallette1.Height
If Row Mod FullHex = 0 Then
'Horizontal line
Pallette1.Line (HalfWidth, Row)-(HalfWidth + HexWidth, Row), RGB(200, 200, 200)
Increment = 3
Increment2 = 2
For HorLoop = 1 To 20
'Half Offset Row
Pallette1.Line (HalfWidth + (Increment * HexWidth), Row)-(HalfWidth + ((Increment + 1) * HexWidth), Row), RGB(200, 200, 200)
' double offset row
Pallette1.Line (HexWidth * Increment2, Row + HalfHex)-(HexWidth * (Increment2 + 1), Row + HalfHex), RGB(200, 200, 200)
' 60-30 lines
Pallette1.Line (HalfWidth + (Increment * HexWidth), Row)-(HexWidth * (Increment2 + 1), Row + HalfHex), RGB(200, 200, 200)
Pallette1.Line (HalfWidth + ((Increment + 1) * HexWidth), Row)-(HexWidth * (Increment2 + 3), Row + HalfHex), RGB(200, 200, 200)
Pallette1.Line (HexWidth * (Increment2 + 1), Row + HalfHex)-(HalfWidth + (Increment * HexWidth), Row + FullHex), RGB(200, 200, 200)
Pallette1.Line (HexWidth * Increment2, Row + HalfHex)-(HalfWidth + ((Increment + -2) * HexWidth), Row + FullHex), RGB(200, 200, 200)
Increment = Increment + 3
Increment2 = Increment2 + 3
Next
End If
Next
Paul Dwyer 
Network Engineer
Aussie In Tokyo
Using Powerbasic 6 & VB6 SP4 (Please also add your VB Version to your signature!)
-
Jul 5th, 2000, 11:07 PM
#16
Thread Starter
Fanatic Member
It works
Here's the latest version.
I tried the other sets of code that were up here and I'm yet to determine if Judd's is faster or not. Which is becoming an issue on the resize event. Performance drops, especially if the hexes are small.
I'm wondering whether to have a bitmap tile with about 30 hexes on it and blit them to screen, but that'd make transperancy for loading a map a real nightmare
Take a look, you can change the hex/sqr size on the fly now. The hex code is currently as above
http://www.ozemail.com.au/~devore/Map_Designer.exe
Paul Dwyer 
Network Engineer
Aussie In Tokyo
Using Powerbasic 6 & VB6 SP4 (Please also add your VB Version to your signature!)
-
Jul 6th, 2000, 11:57 AM
#17
Hyperactive Member
-
Jul 6th, 2000, 12:01 PM
#18
Fanatic Member
Judd,
I would love a copy if you are willing to send it.
I know what you mean about the bordeom thing as well. The number of crappy little apps i have produced out of sheer boredom is mind bogling.
Cheers mate.
Iain, thats with an i by the way!
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|