1. 首頁
  2. 問答
  3. 畫多邊形與多點

畫多邊形與多點

2013-12-10 151 views
0

我試圖從用戶輸入的字符串繪製多邊形：
例如（00），（10 10），（20 20），（0,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在每次迭代所以它完成我無法畫線多邊形
下一步
。請幫助使用從數組中獲取參數的繪製線方法/繪製多邊形方法。

來源

2013-12-10 Riz

回答

0

您可以使用@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

來源

2013-12-10 12:34:32 NoChance

1

您可以使用GDI +這一點。首先你需要一些東西來畫畫。你可以直接在控件上繪圖，或者你可以繪製一個位圖，我將在這裏給你看。 爲了用積分用戶輸入，你應該把它們轉換成Drawing.Point對象。例如

Dim P1 as New Point(X1, Y1)

假設你有3分，你可以使用Graphics.DrawPolygon方法繪製多邊形。爲此，您需要創建一個新的Graphics對象。首先你創建位圖。你應該確定從點的最小和最大X/Y值，以大小的位圖。比方說，你這樣做，並存儲在MINX，MAXX，MINY，美星變量的值。通過創建位圖：

Dim bmp As New Bitmap(MaxX-MinX, MaxY-MinY)

然後創建一個圖形對象（即提供的繪圖函數）

Dim g As Graphics = Graphics.FromImage(bmp)

創建點的數組包含了所有先前從userinput創建點。假設您有三個點P1，P2，P3：

Dim Points() as Point = {P1, P2, P3}

然後使用您的圖形對象繪製多邊形。

g.DrawPolygon(Pens.Black, Points)

因爲g是非託管的，所以需要對其進行處理或者創建內存泄漏。

g.Dispose

這也適用於位圖（BMP），我們創造，但你想繼續使用這個，所以不要在這裏處理它。當你不再需要它時再做。例如，您現在可以在一個picturebox中顯示位圖。

PictureBox1.Image = bmp

我認爲你可以使用它並根據需要進行擴展。

來源

2013-12-10 07:05:25 Jens

0 
'--------------------------------------------------------------------------------------- 
' 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

來源

2014-07-31 01:36:27 seaeagle23

相關問題

 相關問題