Vb.net 多点绘制多边形
我正在尝试从用户输入的字符串中绘制多边形:Vb.net 多点绘制多边形,vb.net,drawing,Vb.net,Drawing,我正在尝试从用户输入的字符串中绘制多边形: e、 (0),(10),(20),(0)…n 已按如下方式解析字符串: Dim I As Integer, A0 As String, A1 As String(), X1 As Double, Y1 As Double, X2 As Double, Y2 As Double Dim MyChar() As Char = {"(", ")"} For I = 1 To sites.Length - 1 Step 1
e、 (0),(10),(20),(0)…n 已按如下方式解析字符串:
Dim I As Integer, A0 As String, A1 As String(), X1 As Double, Y1 As Double, X2 As Double, Y2 As Double
Dim MyChar() As Char = {"(", ")"}
For I = 1 To sites.Length - 1 Step 1
A0 = sites(I - 1)
A0 = A0.TrimStart(MyChar)
A0 = A0.TrimEnd(MyChar)
A1 = A0.Split(" ")
X1 = Val(A1(0))
Y1 = Val(A1(1))
A0 = sites(I)
A0 = A0.TrimStart(MyChar)
A0 = A0.TrimEnd(MyChar)
A1 = A0.Split(" ")
X2 = Val(A1(0))
Y2 = Val(A1(1))
现在我想在每次迭代中从x1,y1和x2,y2画一条线,这样它就完成了多边形下一步
我不会画线。请帮助使用从数组中获取参数的drawline方法/draw polygon方法。您可以使用GDI+进行此操作。首先,你需要一些可以借鉴的东西。您可以直接在控件上绘制,也可以在位图上绘制,我将在这里向您展示。 为了使用用户输入的点,应将其转换为绘图点对象。比如说
Dim P1 as New Point(X1, Y1)
假设您有3个点,然后可以使用Graphics.DrawPolygon方法绘制多边形。为此,您需要创建一个新的图形对象。首先创建位图。为了调整位图的大小,应根据点确定最小和最大X/Y值。假设您这样做了,并将值存储在MinX、MaxX、MinY、MaxY变量中。通过以下方式创建位图:
Dim bmp As New Bitmap(MaxX-MinX, MaxY-MinY)
然后创建图形对象(提供绘图功能)
创建一个点数组,其中包含先前从userinput创建的所有点。假设你有三个点P1,P2,P3:
Dim Points() as Point = {P1, P2, P3}
然后使用图形对象绘制多边形
g.DrawPolygon(Pens.Black, Points)
因为g是非托管的,所以需要将其处理掉,否则会造成内存泄漏
g.Dispose
这也适用于我们创建的位图(bmp),但您希望继续使用它,因此不要在此处处理它。等你不再需要的时候再做。例如,现在可以在picturebox中显示位图
PictureBox1.Image = bmp
我认为您可以使用它,并根据需要进行扩展。您可以使用@Jens解决方案,下面是如何使用简单的绘制线方法在一系列点之间绘制线的另一个示例。这种方法假设点是按顺序输入的,而不是随机输入的,否则,将得到相互交叉的线。您应该考虑通过创建返回一个点而不重复解析代码的函数来增强原始解析方法。
'settings for drawing
Dim g As Graphics = e.Graphics
Dim blackPen As New Pen(Color.Black, 3)
'assume the user will enter points as (x,y) pair
'and each pair will go into a separate array cell
Dim sites() As String = {"(0,0)", "(0,300)", "(250,300)", "(250,0)"}
Dim I As Integer
'Get the x,y coordinates of the point from the input string
'You should turn this to a function that returns a point later
Dim A0 As String, A1 As String(), X1 As Double, Y1 As Double, X2 As Double, Y2 As Double
Dim MyChar() As Char = {"(", ")"}
A0 = sites(0)
A0 = A0.TrimStart(MyChar)
A0 = A0.TrimEnd(MyChar)
A1 = A0.Split(",")
X1 = Val(A1(0))
Y1 = Val(A1(1))
point1 = New Point(X1, Y1)
For I = 1 To sites.Length - 1 Step 1
A0 = sites(I)
A0 = A0.TrimStart(MyChar)
A0 = A0.TrimEnd(MyChar)
A1 = A0.Split(",")
X2 = Val(A1(0))
Y2 = Val(A1(1))
point2 = New Point(X2, Y2)
'draw line between points p1,p2
e.Graphics.DrawLine(Pens.Black, point1, point2)
'change the start point. Assumes that the points are in order
point1 = New Point(X2, Y2)
Next I
'settings for drawing
Dim g As Graphics = e.Graphics
Dim blackPen As New Pen(Color.Black, 3)
'assume the user will enter points as (x,y) pair
'and each pair will go into a separate array cell
Dim sites() As String = {"(0,0)", "(0,300)", "(250,300)", "(250,0)"}
Dim I As Integer
'Get the x,y coordinates of the point from the input string
'You should turn this to a function that returns a point later
Dim A0 As String, A1 As String(), X1 As Double, Y1 As Double, X2 As Double, Y2 As Double
Dim MyChar() As Char = {"(", ")"}
A0 = sites(0)
A0 = A0.TrimStart(MyChar)
A0 = A0.TrimEnd(MyChar)
A1 = A0.Split(",")
X1 = Val(A1(0))
Y1 = Val(A1(1))
point1 = New Point(X1, Y1)
For I = 1 To sites.Length - 1 Step 1
A0 = sites(I)
A0 = A0.TrimStart(MyChar)
A0 = A0.TrimEnd(MyChar)
A1 = A0.Split(",")
X2 = Val(A1(0))
Y2 = Val(A1(1))
point2 = New Point(X2, Y2)
'draw line between points p1,p2
e.Graphics.DrawLine(Pens.Black, point1, point2)
'change the start point. Assumes that the points are in order
point1 = New Point(X2, Y2)
Next I
'---------------------------------------------------------------------------------------
' Module : bsPolygonButton (User Control)
' DateTime : 08/11/2003
' Author : Drew (aka The Bad One)
' Purpose : To provide a button control that takes the shape of a polygon
' of almost any number of sides.
'---------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------
' Updates
'---------------------------------------------------------------------------------------
'
'---------------------------------------------------------------------------------------
Option Explicit
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush 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
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Private Declare Function TranslateColor Lib "olepro32.dll" Alias "OleTranslateColor" (ByVal clr As OLE_COLOR, ByVal palet As Long, col As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type COORD
X As Long
Y As Long
End Type
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Const WINDING = 2
Private Const DT_CALCRECT = &H400
Private Const DT_CENTER = &H1
Private Const DT_NOCLIP = &H100
Private Const DT_VCENTER = &H4
Private m_iSides As Integer
Const m_def_iSides = 6
'Default Property Values:
Const m_def_ShowFocus = True
Const m_def_CaptionColour = vbButtonText
Const m_def_ButtonColour = &HFC2FF
Const m_def_LightestColour = &H86E1FF
Const m_def_LightColour = &H57D6FF
Const m_def_DarkColour = &H99CC&
Const m_def_DarkestColour = &H769D&
Const m_def_iRotation = 90
'Property Variables:
Dim m_ShowFocus As Boolean
Dim m_CaptionColour As OLE_COLOR
Dim m_ButtonColour As OLE_COLOR
Dim m_Fount As Font
Dim m_LightestColour As OLE_COLOR
Dim m_LightColour As OLE_COLOR
Dim m_DarkColour As OLE_COLOR
Dim m_DarkestColour As OLE_COLOR
Dim m_Caption As String
Dim m_iRotation As Integer
'Event Declarations:
Event Click()
Event KeyUp(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event DblClick()
Const Pi# = 3.1415927
Const CLR_INVALID = &HFFFF
Dim hRegion As Long
Dim booGotFocus As Boolean
'---------------------------------------------------------------------------------------
' Procedure : bsPolygonButton.Sides
' DateTime : 08/11/2003
' Author : Drew (aka The Bad One)
' Purpose : Gets/sets the number of sides the button has.
' Assuming : Number of sides is between 3 and 100, inclusive.
'---------------------------------------------------------------------------------------
'
Public Property Get Sides() As Integer
Sides = m_iSides
End Property
Public Property Let Sides(ByVal iSides As Integer)
If m_iSides < 3 Then
m_iSides = 3
ElseIf m_iSides > 100 Then
m_iSides = 100
End If
m_iSides = iSides
Call UserControl.PropertyChanged("Sides")
DrawControl
End Property
'---------------------------------------------------------------------------------------
' Procedure : bsPolygonButton.DrawControl
' DateTime : 09/11/2003
' Author : Drew (aka The Bad One)
' Purpose : Draws the whole control (pressed if necessary).
' Assuming : nothing
'---------------------------------------------------------------------------------------
'
Private Sub DrawControl(Optional booPressed As Boolean)
Dim X(0 To 1) As Single, Y(0 To 1) As Single
Dim rctControl As RECT, lpOld As POINTAPI
Dim I As Integer, iCounter As Integer
Dim hBrush As Long
Dim PolyCoord(100) As COORD
SetWindowRgn UserControl.hWnd, 0, True
ScaleMode = vbPixels
AutoRedraw = True
' Clear the control (button colour)
' -------------------------------------------------------------------
SetRect rctControl, 0, 0, ScaleWidth, ScaleHeight
hBrush = CreateSolidBrush(TranslateColour(m_ButtonColour))
FillRect UserControl.hdc, rctControl, hBrush
DeleteObject hBrush
' Remember, X coordinate = Sin(angle) * X radius + X centre, and
' Y coordinate = Cos(angle) * Y radius + Y centre
' Draw text
' -------------------------------------------------------------------
Set Font = m_Fount
DrawText hdc, m_Caption, Len(m_Caption), rctControl, DT_CALCRECT
If UserControl.Enabled Then
ForeColor = TranslateColour(m_CaptionColour)
OffsetRect rctControl, ScaleWidth / 2 - rctControl.Right / 2, _
ScaleHeight / 2 - rctControl.Bottom / 2
If booPressed Then
OffsetRect rctControl, 1, 1
End If
DrawText hdc, m_Caption, Len(m_Caption), rctControl, DT_CENTER + DT_VCENTER + DT_NOCLIP
Else
ForeColor = TranslateColour(m_LightColour)
OffsetRect rctControl, ScaleWidth / 2 - rctControl.Right / 2 + 1, _
ScaleHeight / 2 - rctControl.Bottom / 2 + 1
DrawText hdc, m_Caption, Len(m_Caption), rctControl, DT_CENTER + DT_VCENTER + DT_NOCLIP
ForeColor = TranslateColour(m_DarkColour)
OffsetRect rctControl, -1, -1
DrawText hdc, m_Caption, Len(m_Caption), rctControl, DT_CENTER + DT_VCENTER + DT_NOCLIP
End If
' Draw focus rectangle
' -------------------------------------------------------------------
If booGotFocus And m_ShowFocus Then
DrawFocusRect hdc, rctControl
End If
' Draw the edges
' -------------------------------------------------------------------
For I = 0 To 360 Step 360 / m_iSides
X(0) = Sin(DegreesToRadians(I + m_iRotation)) * ((ScaleWidth - 1) / 2) + ((ScaleWidth - 1) / 2)
Y(0) = Cos(DegreesToRadians(I + m_iRotation)) * ((ScaleHeight - 1) / 2) + ((ScaleHeight - 1) / 2)
X(1) = Sin(DegreesToRadians(I + m_iRotation + 360 / m_iSides)) * ((ScaleWidth - 1) / 2) + ((ScaleWidth - 1) / 2)
Y(1) = Cos(DegreesToRadians(I + m_iRotation + 360 / m_iSides)) * ((ScaleHeight - 1) / 2) + ((ScaleHeight - 1) / 2)
' first line
DrawWidth = 2
If booPressed Then
ForeColor = TranslateColour(m_DarkestColour)
Else
If (ScaleHeight - (X(1) / ScaleWidth) * ScaleHeight <= Y(1)) Then
ForeColor = TranslateColour(m_DarkColour)
Else
If ScaleHeight - (X(0) / ScaleWidth) * ScaleHeight <= Y(0) Then
ForeColor = TranslateColour(m_DarkColour)
Else
ForeColor = TranslateColour(m_LightestColour)
End If
End If
End If
MoveToEx hdc, X(0), Y(0), lpOld
LineTo hdc, X(1), Y(1)
' second line
DrawWidth = 1
If booPressed Then
ForeColor = TranslateColour(m_DarkColour)
Else
If (ScaleHeight - (X(1) / ScaleWidth) * ScaleHeight <= Y(1)) Then
ForeColor = TranslateColour(m_DarkestColour)
Else
If ScaleHeight - (X(0) / ScaleWidth) * ScaleHeight <= Y(0) Then
ForeColor = TranslateColour(m_DarkestColour)
Else
ForeColor = TranslateColour(m_LightColour)
End If
End If
End If
MoveToEx hdc, X(0) + 1, Y(0) + 1, lpOld
LineTo hdc, X(1) + 1, Y(1) + 1
Next
' Create polygon region
' -------------------------------------------------------------------
For I = 0 To 360 Step 360 / m_iSides
PolyCoord(iCounter).X = Sin(DegreesToRadians(I + m_iRotation)) * ((ScaleWidth + 1) / 2) + ((ScaleWidth + 1) / 2)
PolyCoord(iCounter).Y = Cos(DegreesToRadians(I + m_iRotation)) * ((ScaleHeight + 1) / 2) + ((ScaleHeight + 1) / 2)
iCounter = iCounter + 1
Next
hRegion = CreatePolygonRgn(PolyCoord(0), m_iSides, WINDING)
SetWindowRgn UserControl.hWnd, hRegion, True
' Because we've set AutoRedraw to True...
Refresh
End Sub
Private Sub UserControl_Click()
RaiseEvent Click
End Sub
Private Sub UserControl_DblClick()
RaiseEvent DblClick
End Sub
Private Sub UserControl_ExitFocus()
booGotFocus = False
DrawControl
End Sub
Private Sub UserControl_GotFocus()
booGotFocus = True
DrawControl
End Sub
Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub UserControl_KeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
End Sub
Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
DrawControl True '(PtInRegion(hRegion, X, Y) <> 0)
End If
End Sub
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
DrawControl True
End If
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
DrawControl
End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : bsPolygonButton.UserControl_ReadProperties
' DateTime : 08/11/2003
' Author : Drew (aka The Bad One)
' Purpose : Reads the stored values for the properties.
' Assuming : nothing
'---------------------------------------------------------------------------------------
'
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_iSides = PropBag.ReadProperty("Sides", m_def_iSides)
m_iRotation = PropBag.ReadProperty("Rotation", m_def_iRotation)
m_LightestColour = PropBag.ReadProperty("LightestColour", m_def_LightestColour)
m_LightColour = PropBag.ReadProperty("LightColour", m_def_LightColour)
m_DarkColour = PropBag.ReadProperty("DarkColour", m_def_DarkColour)
m_DarkestColour = PropBag.ReadProperty("DarkestColour", m_def_DarkestColour)
m_Caption = PropBag.ReadProperty("Caption", UserControl.Extender.Name)
m_ButtonColour = PropBag.ReadProperty("ButtonColour", m_def_ButtonColour)
Set m_Fount = PropBag.ReadProperty("Fount", Ambient.Font)
m_CaptionColour = PropBag.ReadProperty("CaptionColour", m_def_CaptionColour)
UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
m_ShowFocus = PropBag.ReadProperty("ShowFocus", m_def_ShowFocus)
End Sub
Private Sub UserControl_Resize()
DrawControl
End Sub
'---------------------------------------------------------------------------------------
' Procedure : bsPolygonButton.Rotation
' DateTime : 08/11/2003
' Author : Drew (aka The Bad One)
' Purpose : Allows the user to specify by how much the polygon is
' "rotated".
' Assuming : nothing
'---------------------------------------------------------------------------------------
'
Public Property Get Rotation() As Integer
Rotation = m_iRotation
End Property
'---------------------------------------------------------------------------------------
' Procedure : bsPolygonButton.Rotation
' DateTime : 08/11/2003
' Author : Drew (aka The Bad One)
' Purpose : Allows the user to specify by how much the polygon is
' "rotated".
' Assuming : nothing
'---------------------------------------------------------------------------------------
'
Public Property Let Rotation(ByVal New_Rotation As Integer)
New_Rotation = New_Rotation Mod 360
If New_Rotation < 0 Then
New_Rotation = 360 - New_Rotation
End If
m_iRotation = New_Rotation
PropertyChanged "Rotation"
DrawControl
End Property
'---------------------------------------------------------------------------------------
' Procedure : bsPolygonButton.UserControl_InitProperties
' DateTime : 08/11/2003
' Author : Drew (aka The Bad One)
' Purpose : Sets the default values for the properties.
' Assuming : nothing
'---------------------------------------------------------------------------------------
'
Private Sub UserControl_InitProperties()
m_iRotation = m_def_iRotation
m_iSides = m_def_iSides
m_LightestColour = m_def_LightestColour
m_LightColour = m_def_LightColour
m_DarkColour = m_def_DarkColour
m_DarkestColour = m_def_DarkestColour
m_Caption = Extender.Name
m_ButtonColour = m_def_ButtonColour
Set m_Fount = Ambient.Font
m_CaptionColour = m_def_CaptionColour
m_ShowFocus = m_def_ShowFocus
End Sub
'---------------------------------------------------------------------------------------
' Procedure : bsPolygonButton.UserControl_Terminate
' DateTime : 09/11/2003
' Author : Drew (aka The Bad One)
' Purpose : Removes the region from memory, before the control is destroyed.
' Assuming : nothing
'---------------------------------------------------------------------------------------
'
Private Sub UserControl_Terminate()
DeleteObject hRegion
End Sub
'---------------------------------------------------------------------------------------
' Procedure : bsPolygonButton.UserControl_WriteProperties
' DateTime : 08/11/2003
' Author : Drew (aka The Bad One)
' Purpose : "Saves" the properties for later use.
' Assuming : nothing
'---------------------------------------------------------------------------------------
'
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("Sides", m_iSides, m_def_iSides)
Call PropBag.WriteProperty("Rotation", m_iRotation, m_def_iRotation)
Call PropBag.WriteProperty("LightestColour", m_LightestColour, m_def_LightestColour)
Call PropBag.WriteProperty("LightColour", m_LightColour, m_def_LightColour)
Call PropBag.WriteProperty("DarkColour", m_DarkColour, m_def_DarkColour)
Call PropBag.WriteProperty("DarkestColour", m_DarkestColour, m_def_DarkestColour)
Call PropBag.WriteProperty("Caption", m_Caption, UserControl.Extender.Name)
Call PropBag.WriteProperty("ButtonColour", m_ButtonColour, m_def_ButtonColour)
Call PropBag.WriteProperty("Fount", m_Fount, Ambient.Font)
Call PropBag.WriteProperty("CaptionColour", m_CaptionColour, m_def_CaptionColour)
Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
Call PropBag.WriteProperty("ShowFocus", m_ShowFocus, m_def_ShowFocus)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get LightestColour() As OLE_COLOR
LightestColour = m_LightestColour
End Property
Public Property Let LightestColour(ByVal New_LightestColour As OLE_COLOR)
m_LightestColour = New_LightestColour
PropertyChanged "LightestColour"
DrawControl
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get LightColour() As OLE_COLOR
LightColour = m_LightColour
End Property
Public Property Let LightColour(ByVal New_LightColour As OLE_COLOR)
m_LightColour = New_LightColour
PropertyChanged "LightColour"
DrawControl
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get DarkColour() As OLE_COLOR
DarkColour = m_DarkColour
End Property
Public Property Let DarkColour(ByVal New_DarkColour As OLE_COLOR)
m_DarkColour = New_DarkColour
PropertyChanged "DarkColour"
DrawControl
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get DarkestColour() As OLE_COLOR
DarkestColour = m_DarkestColour
End Property
Public Property Let DarkestColour(ByVal New_DarkestColour As OLE_COLOR)
m_DarkestColour = New_DarkestColour
PropertyChanged "DarkestColour"
DrawControl
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,usercontrol.extender.name
Public Property Get Caption() As String
Caption = m_Caption
End Property
Public Property Let Caption(ByVal New_Caption As String)
m_Caption = New_Caption
PropertyChanged "Caption"
DrawControl
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,vbbuttonface
Public Property Get ButtonColour() As OLE_COLOR
ButtonColour = m_ButtonColour
End Property
Public Property Let ButtonColour(ByVal New_ButtonColour As OLE_COLOR)
m_ButtonColour = New_ButtonColour
PropertyChanged "ButtonColour"
DrawControl
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=6,0,0,0
Public Property Get Fount() As Font
Set Fount = m_Fount
End Property
Public Property Set Fount(ByVal New_Fount As Font)
Set m_Fount = New_Fount
PropertyChanged "Fount"
DrawControl
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,vbbuttontext
Public Property Get CaptionColour() As OLE_COLOR
CaptionColour = m_CaptionColour
End Property
Public Property Let CaptionColour(ByVal New_CaptionColour As OLE_COLOR)
m_CaptionColour = New_CaptionColour
PropertyChanged "CaptionColour"
DrawControl
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
Enabled = UserControl.Enabled
End Property
Public Property Let Enabled(ByVal New_Enabled As Boolean)
UserControl.Enabled() = New_Enabled
PropertyChanged "Enabled"
DrawControl
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,True
Public Property Get ShowFocus() As Boolean
ShowFocus = m_ShowFocus
End Property
Public Property Let ShowFocus(ByVal New_ShowFocus As Boolean)
m_ShowFocus = New_ShowFocus
PropertyChanged "ShowFocus"
End Property
'---------------------------------------------------------------------------------------
' Procedure : bsPolygonButton.ShowAbout
' DateTime : 09/11/2003
' Author : Drew (aka The Bad One)
' Purpose : Shows the About screen.
' Assuming : nothing
'---------------------------------------------------------------------------------------
'
'Public Sub ShowAbout()
' frmAbout.Show vbModal
'End Sub
'---------------------------------------------------------------------------------------
' Procedure : modUseful.DegreesToRadians
' DateTime : 08/11/2003
' Author : Drew (aka The Bad One)
' Purpose : Converts a value in degrees to radians, as used by Visual Basic.
' Assuming : nothing
'---------------------------------------------------------------------------------------
'
Function DegreesToRadians(ByVal sngAngle As Single) As Single
DegreesToRadians = sngAngle * (Pi / 180)
End Function
'---------------------------------------------------------------------------------------
' Procedure : TranslateColour
' DateTime : 12/10/2003
' Author : Drew (aka The Bad One)
' Purpose : Used to convert Automation colours to a Windows (long) colour.
'---------------------------------------------------------------------------------------
'
Function TranslateColour(ByVal oClr As OLE_COLOR, Optional hPal As Long = 0) As Long
If TranslateColor(oClr, hPal, TranslateColour) Then
TranslateColour = CLR_INVALID
End If
End Function