Refreshing form

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

Put Command1_Click in the Form_Paint event.

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.

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 !!!!

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.

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)

Paul,

You might need to use some picturebox.cls's about the place to clean up.

I'd also be interested to see your algoritms for drawing hexagonal and octagonal grids, when you get them working...

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.

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

HEY!

My thread title got censored!!
I think I'm being watched, best be careful lest I get banned from VB-world. :(

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

---

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

---

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. :D

Still it saves me writing it.

Paul / Iain,

I've been bored today, so I was messing with this.
My map now draws with a variable grid size, and both
orientations of Hex and Oct (horizontal and vertical).

You're both welcome to the code if you want it.


:)

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

---

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

Through further amounts of boredom, I've developed my version of this map thingy a little more. It now does dotted grids as well as line grids and highlights 'selected' cells on the grid when you click them.

Paul - I sent you the project on spec via e-mail.

Iain (and anyone else) - you're welcome to a copy, as always, if you want it.


L8r.

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.