[RESOLVED] Drawing Polygon, Runtime

[Mythrandil]

Hey all

Im having some trouble with some seemingly simple code

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
If Design Then
        Points(UBound(Points)).X = X
        Points(UBound(Points)).Y = Y
        
        Dim handle As Long
        Dim temp1 As Long
        
        Picture1.Cls
        handle = Picture1.hdc
        temp1 = Polygon(handle, Points(0), (UBound(Points) + 1))
        
        ReDim Preserve Points(UBound(Points) + 1) As POINTAPI
    
    End If
 
end sub

The code is fairly self explanatory but just incase: if the form is in design mode the user can click on the picture box area to form points of a polygon, after each click the polygon is redrawn.

Tracing the code shows no obvious errors, the array is fills up perfectly with coords and the polkygon api returns values of 1 which is non zero which suggests no errors. However nothing on the picture box is drawn!

Thanks in advance

[Andrew G]

You don't really need API's to draw polygons. Try this

Private Type Point
    X As Long
    Y As Long
End Type
Dim Pnt() As Point
Private Sub Form_Load()
ReDim Preserve Pnt(0)
Picture1.AutoRedraw = True
Timer1.Interval = 1
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ReDim Preserve Pnt(UBound(Pnt) + 1)
If Button = 1 Then
    Pnt(UBound(Pnt)).X = X
    Pnt(UBound(Pnt)).Y = Y
ElseIf Button = 2 Then
    Pnt(UBound(Pnt)).X = Pnt(1).X
    Pnt(UBound(Pnt)).Y = Pnt(1).Y
End If
End Sub
 
Private Sub Timer1_Timer()
If UBound(Pnt) < 1 Then Exit Sub
Picture1.Cls
 
Picture1.Line (Pnt(1).X, Pnt(1).Y)-(Pnt(1).X, Pnt(1).Y)
 
For p = 2 To UBound(Pnt) Step 1
    Picture1.Line -(Pnt(p).X, Pnt(p).Y)
Next
End Sub

[Mythrandil]

Hey thanks for taking the time to reply.

It was actually a silly mistake!

My picture1 was scaled in twips so i was passing massive numbers to polygon which was being drawn off-screen. Changed to pixels and its working great.

[Keith_VB6]

Hi Mythrandil,

I'm glad you got it to work. Here's a slightly modified version that might help you anyways.

Option Explicit
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As pointApi, ByVal nCount As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As pointApi) As Long
 
Dim points() As pointApi
Dim lastPos As pointApi
Dim pointsCount As Integer
 
Private Type pointApi
    x As Long
    y As Long
End Type
 
 
Private Sub Picture1_DblClick()
    'start a new polygon
    pointsCount = 0
    
    'save the last polygon so it won't be cleared
    Picture1.Picture = Picture1.Image
End Sub
 
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
 
    If Button = vbLeftButton Then 'this can be changed to Design=true
        pointsCount = pointsCount + 1
        ReDim Preserve points(pointsCount) As pointApi
        
        points(pointsCount).x = x
        points(pointsCount).y = y
                
        Picture1.Cls
        
        If pointsCount > 1 Then
            Call Polygon(Picture1.hdc, points(1), pointsCount)
        Else
            'first point
            Call MoveToEx(Picture1.hdc, x, y, lastPos)
            Picture1.PSet (x, y)
        End If
    End If
 
End Sub

[Mythrandil]

Thanks for the help,

I'll deffinetly implement some of your code, however rather than saving pictures i intend to have an array of all polygons so the user can choose to delete objects at their will, as its a simple matter of removing the points and repainting the picture box ^^

[Keith_VB6]

You're welcome. Since you were storing the points into an array, I figuired you were making more than just a basic paint program. Good luck.

[Mythrandil]

/edit *deleted*

ok i shudn't be let loose on computers whn im this stressed. was silly mistake again, defined points as integers instead of longs ~_~

sorry about bump