Polygon shaped userControls ??

[Billy Cole]

HELP...

I'm trying to create a polygon shaped ActiveX user Control
I've got it so that I can draw a polygon with any number of vertices on a user control, but I can't clip the user control to that polygon's size.

Please can you help with this and also how to fill it with a colour

PLEASE be gentle, as I'm new to VB

Cheers

[PaulLewis]

I have done a little research and this is what I've come up with so far. I have a few issues to work out like placing a border around my usercontrol but for now, this should get you going I hope

' module1.bas
Option Explicit

Public Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Public Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Public Declare Function PaintRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Public Declare Function FrameRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Public Const ALTERNATE = 1
Public Const WINDING = 2
Public Const RGN_AND = 1
Public Const RGN_COPY = 5
Public Const RGN_DIFF = 4
Public Const RGN_OR = 2
Public Const RGN_XOR = 3

Public Type POINTAPI
    X As Long
    Y As Long
End Type

Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

' usercontrol1.ctl
' I put a command button at 32,40 just for fun
' Also, set scalemode to vbPixel 

Option Explicit
Dim myPolygon(5) As POINTAPI
Dim region As Long
Dim region2 As Long
Private Sub Command1_Click()
  MsgBox "Hello"
End Sub
Private Sub UserControl_Initialize()
  Dim X As Double
  Dim Y As Double
  Dim angle As Double
  Dim c As Integer
  Dim pi As Double
  pi = Atn(1) * 4
    
  ' just creating an array of points which represent a hexagon
  For c = 0 To 5
    angle = pi / 3 * c
    X = Cos(angle) * 60 + 60
    Y = Sin(angle) * 60 + 60 * Sin(pi / 3)
    myPolygon(c).X = X
    myPolygon(c).Y = Y
  Next
' try this one for a round usercontrol
'    region = CreateRoundRectRgn(0, 0, 100, 100, 100, 100)
' use this one for a hexagon.
  region = CreatePolygonRgn(myPolygon(0), 6, ALTERNATE)
  region2 = SetWindowRgn(UserControl.hWnd, region, True)
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Debug.Print Now, X, Y
End Sub

Private Sub UserControl_Paint()
  ' this stuff aint working due to something I have not figured out yet
  ' the usercontrol is clipping or something so there might be a snag to it that I hadn't thought of.  
  Dim res As Long
  Dim hBrush As Long
  hBrush = CreateSolidBrush(QBColor(0))

  UserControl.FillColor = QBColor(0)
  res = PaintRgn(UserControl.hdc, region)
  res = FrameRgn(UserControl.hdc, region, hBrush, 20, 20)
  
  res = DeleteObject(hBrush)

End Sub

Private Sub UserControl_Terminate()
  Dim dl As Long
  dl = DeleteObject(region)
End Sub

That's it. Give it a try and see how you get on.

You can do the same thing with a form if you like, setting it's region to a polygon or to any region for that matter.

Hint: put a bitmap in the usercontrol that will fill up the area you know is going to be clipped. Then this will look pretty cool.

Let me know how you get on.

Cheers