(17-10-22, 01:07 AM)Alhootti1 كتب : السلام عليكم
تفضل يا أخي Anes
وضعت الكود في مثال
2.12.0.0
كود :
Partial Friend Class ucTooth
Inherits System.Windows.Forms.UserControl
Shadows Event Click(ByVal Sender As Object, ByVal e As EventArgs)
Public Enum UniBoxSymbols
symNone = 32
symHorz = &H2500S
symDownAndRight = &H250CS
symDownAndLeft = &H2510S
symUpAndRight = &H2514S
symUpAndLeft = &H2518S
End Enum
Public BorderColor As Color
Public CrTop As Color
Public CrRight, CrCenter, Nr, CrLeft, CrBottom As Integer
Public BraceSymbol As UniBoxSymbols
Public CenterSymbol As String = ""
Public Sub New()
MyBase.New()
InitializeComponent()
ReLoadForm(False)
End Sub
Private _scaleMode As ScaleModeConstants = ScaleModeConstants.VbTwips
Public Enum ScaleModeConstants : int16
VbCentimeters = 7
VbCharacters = 4
VbContainerPosition = 9
VbContainerSize = 10
VbHimetric = 8
VbInches = 5
VbMilimeters = 6
VbPixels = 3
VbPoints = 2
VbTwips = 1
VbUser = 0
End Enum
Private Sub UserControl_Initialize()
Me.setAutoRedraw(True)
Me.setDrawWidth(2)
Me.setFillStyle(btnSupport.UpgradeStubs.VBRUN_FillStyleConstants.getvbFSSolid())
Font = Font.Clone(name:="Arial") : Font = Font.Clone(size:=10) : Font = Font.Clone(bold:=True)
ResetAllFillColorsToWhite()
End Sub
Private Sub UserControl_Resize(ByVal eventSender As Object, ByVal eventArgs As EventArgs) Handles MyBase.Resize
Refresh()
End Sub
Private Sub UserControl_Click(ByVal eventSender As Object, ByVal eventArgs As EventArgs) Handles MyBase.Click
RaiseEvent Click(Me, Nothing)
End Sub
Public Sub ResetAllFillColorsToWhite()
CrCenter = ColorTranslator.ToOle(Color.White) : CrLeft = ColorTranslator.ToOle(Color.White) : CrTop = Color.White : CrRight = ColorTranslator.ToOle(Color.White) : CrBottom = ColorTranslator.ToOle(Color.White)
End Sub
Public Overrides Sub Refresh()
Refresh() : Dim Size_Renamed As Integer = ClientRectangle.Width * 15 : Dim Offs As Integer = Size_Renamed \ 4 + 1
Me.setFillColor(Color.White) : ForeColor = BorderColor
Using g As Graphics = Me.CreateGraphics()
Dim p As Pen = New Pen(Color.Black)
p.DashStyle = DashStyle.Solid
g.DrawRectangle(p, 0, 0, CInt((Size_Renamed - 2) / 15), CInt((Size_Renamed - 2) / 15))
End Using
Using g2 As Graphics = Me.CreateGraphics()
Dim p2 As Pen = New Pen(Color.Black)
p2.DashStyle = DashStyle.Solid
g2.DrawLine(p2, 0, 0, CInt((Size_Renamed - 1) / 15), CInt((Size_Renamed - 1) / 15))
End Using
Using g3 As Graphics = Me.CreateGraphics()
Dim p3 As Pen = New Pen(Color.Black)
p3.DashStyle = DashStyle.Solid
g3.DrawLine(p3, 0, CInt((Size_Renamed - 1) / 15), CInt((Size_Renamed - 1) / 15), 0)
End Using 'Diagonals
Me.setFillColor(ColorTranslator.FromOle(CrCenter))
Using g4 As Graphics = Me.CreateGraphics()
Dim p4 As Pen = New Pen(Color.Black)
p4.DashStyle = DashStyle.Solid
g4.DrawRectangle(p4, CInt(Offs / 15), CInt(Offs / 15), CInt((Size_Renamed - Offs - Offs) / 15), CInt((Size_Renamed - Offs - Offs) / 15))
End Using 'CenterSquare
Me.setFillColor(ColorTranslator.FromOle(CrLeft)) : Using g5 As Graphics = CreateGraphics()
g5.ReleaseHdc()
End Using
Me.setFillColor(CrTop) : Using g6 As Graphics = CreateGraphics()
g6.ReleaseHdc()
End Using
Me.setFillColor(ColorTranslator.FromOle(CrRight)) : Using g7 As Graphics = CreateGraphics()
g7.ReleaseHdc()
End Using
Me.setFillColor(ColorTranslator.FromOle(CrBottom)) : Using g8 As Graphics = CreateGraphics()
g8.ReleaseHdc()
End Using
TextOutCentered(CStr(Nr), 10, Color.Black, Size_Renamed \ 2 + 10) 'print the Tooth-Nr-Caption at the bottom
TextOutCentered(Strings.ChrW(BraceSymbol).ToString(), 20 * Size_Renamed / 31, Color.Blue) 'print the BraceSymbolChar (a ChrW translation of the Enums UnicodePoint)
TextOutCentered(CenterSymbol, 20 * Size_Renamed / 31, Color.Magenta) 'print the CenterSymbolChar
MyBase.Refresh()
End Sub
Private Sub TextOutCentered(ByVal S As String, ByVal FontSize As Double, ByVal FontColor As Color, Optional ByVal yOffs As Integer = 0)
ForeColor = FontColor : Font = Font.Clone(size:=FontSize)
If S = Strings.ChrW(UniBoxSymbols.symHorz).ToString() Then S = New String(S, 2) 'double the Horz-Char (to cover the entire width)
Dim TW, TH As Integer
CalcTextExtent(S, TW, TH) 'we also need to use a matching unicode-capable TextExtent-measuring
Dim x As Integer = (ClientRectangle.Width * 15 - TW) \ 2
Dim y As Integer = yOffs + (ClientRectangle.Width * 15 - TH) \ 2
Using g As Graphics = CreateGraphics()
Dim gh As GCHandle = GCHandle.Alloc(S, GCHandleType.Pinned)
Dim tmpPtr As IntPtr = gh.AddrOfPinnedObject()
btnSupport.SafeNative.gdi32.TextOutW(g.GetHdc().ToInt32(), x, y, tmpPtr.ToInt32(), Strings.Len(S))
gh.Free()
g.ReleaseHdc()
End Using 'use TextOutW instead of Print, to be Unicode-Aware
End Sub
Private Sub CalcTextExtent(ByVal S As String, ByRef dx As Integer, ByRef dy As Integer)
Dim Ext(1) As Integer : Using g As Graphics = CreateGraphics()
Dim gh As GCHandle = GCHandle.Alloc(S, GCHandleType.Pinned)
Dim tmpPtr As IntPtr = gh.AddrOfPinnedObject()
btnSupport.SafeNative.gdi32.GetTextExtentPoint32W(g.GetHdc().ToInt32(), tmpPtr.ToInt32(), Strings.Len(S), Ext(0))
gh.Free()
g.ReleaseHdc()
End Using
dx = Ext(0) : dy = Ext(1)
End Sub
End Classكود :
Partial Friend Class Form1
Inherits System.Windows.Forms.Form
Public Sub New()
MyBase.New()
Dim mustCallFormLoad As Boolean = False
If m_vb6FormDefInstance Is Nothing Then
If m_InitializingDefInstance Then
m_vb6FormDefInstance = Me
Else
Try
If Not (System.Reflection.Assembly.GetExecutingAssembly().EntryPoint Is Nothing) AndAlso System.Reflection.Assembly.GetExecutingAssembly().EntryPoint.DeclaringType Is Me.GetType() Then
m_vb6FormDefInstance = Me
End If
Finally
mustCallFormLoad = True
End Try
End If
End If
isInitializingComponent = True
InitializeComponent()
isInitializingComponent = False
ReLoadForm(False)
If mustCallFormLoad And Not (m_vb6FormDefInstance Is Nothing) Then
m_vb6FormDefInstance.Form_Load()
End If
End Sub
Public Shared myActiveForm As Form
Private Sub Form1_Activated(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Activated
If Not (myActiveForm Is eventSender) Then
myActiveForm = eventSender
End If
End Sub
Private SelTooth, T As ucTooth
Private i As Integer
Private Shared Function FindBaseObject(ByVal controlArray As Array) As Object
For Each obj As Object In controlArray
If obj IsNot Nothing AndAlso Not (TypeOf obj Is ToolStripSeparator) Then
Return obj
End If
Next
Return Nothing
End Function
Public Shared Sub LoadControl(ByVal controlContainer As Control, ByVal controlName As String, ByVal index As Integer)
Dim fieldInfo As FieldInfo = controlContainer.[GetType]().GetField(controlName)
If (fieldInfo IsNot Nothing) AndAlso fieldInfo.FieldType.IsArray Then
Dim controlArray As Array = CType(fieldInfo.GetValue(controlContainer), Array)
Dim baseControl As Object = FindBaseObject(controlArray)
If baseControl IsNot Nothing Then
If index > controlArray.Length - 1 Then
Dim redimAux As Array = Array.CreateInstance(controlArray.[GetType]().GetElementType(), index + 1)
Array.Copy(controlArray, redimAux, Math.Min(controlArray.Length, redimAux.Length))
controlArray = redimAux
End If
If controlArray.GetValue(index) IsNot Nothing Then
Throw New Exception("Object already loaded")
End If
fieldInfo.SetValue(controlContainer, controlArray)
End If
Else
Throw New Exception("Cannot load this component")
End If
End Sub
Private Sub Form_Load()
For i = 11 To 85
Select Case i
Case 11 To 18, 21 To 28, 31 To 38, 41 To 48, 51 To 55, 61 To 65, 71 To 75, 81 To 85
If i > 11 Then LoadControl(Me, "ucT", i)
ucT(i).Nr = i : ucT(i).Visible = True
End Select
Next
ucT(11).CrCenter = ColorTranslator.ToOle(Color.Lime) : ucT(12).CrCenter = ColorTranslator.ToOle(Color.Red)
ucT(21).CrCenter = ColorTranslator.ToOle(Color.Lime) : ucT(22).CrCenter = ColorTranslator.ToOle(Color.Red)
ucT(21).CrLeft = ColorTranslator.ToOle(Color.Lime) : ucT(22).CrLeft = ColorTranslator.ToOle(Color.Red)
ucT(31).CenterSymbol = "X"
ucT(41).CenterSymbol = "$"
ucT(51).BraceSymbol = ucTooth.UniBoxSymbols.symDownAndLeft
For i = 52 To 54 : ucT(i).BraceSymbol = ucTooth.UniBoxSymbols.symHorz : Next
ucT(55).BraceSymbol = ucTooth.UniBoxSymbols.symDownAndRight
ucT(61).BraceSymbol = ucTooth.UniBoxSymbols.symUpAndRight
For i = 62 To 64 : ucT(i).BraceSymbol = ucTooth.UniBoxSymbols.symHorz : Next
ucT(65).BraceSymbol = ucTooth.UniBoxSymbols.symUpAndLeft
SetBraceColorEdges(85, 81, Color.Cyan, False)
SetBraceColorEdges(71, 75, Color.Cyan, True)
RefreshAllTeeth()
End Sub
Private Sub SetBraceColorEdges(ByVal idxFrom As Integer, ByVal idxTo As Integer, ByVal Color As Color, ByVal Top_Renamed As Boolean)
ucT(idxFrom).CrLeft = ColorTranslator.ToOle(Color)
For i = idxFrom To idxTo Step IIf(idxFrom < idxTo, 1, -1)
If Top_Renamed Then ucT(i).CrTop = Color Else ucT(i).CrBottom = ColorTranslator.ToOle(Color)
Next
ucT(idxTo).CrRight = ColorTranslator.ToOle(Color)
End Sub
Public Sub RefreshAllTeeth()
For i_2 As Integer = 0 To ucT.Length - 1
If Not (ucT(i_2) Is Nothing) Then : ucT(i_2).Refresh() : End If
Next
End Sub
Private isInitializingComponent As Boolean
Private Sub Form_Resize(ByVal eventSender As Object, ByVal eventArgs As EventArgs) Handles MyBase.Resize
If isInitializingComponent Then
Exit Sub
End If
Dim y0, x0, sc As Double
Dim dy As Integer
Dim dx, cx As Integer
Const TopOffs As Integer = 40
For i_2 As Integer = 0 To ucT.Length - 1
If Not (ucT(i_2) Is Nothing) Then : dx = ClientRectangle.Width * 15 \ 19
ucT(ucT(i_2).Nr).SetBounds(x0 / 15, y0 / 15, dx / 15, dy / 15)
End If
Next
RefreshAllTeeth()
End Sub
Private Sub ucT_Click(ByVal Sender As Object, ByVal e As EventArgs) Handles _ucT_11.Click
Dim Index As Integer = Array.IndexOf(Me.ucT, Sender)
If Not (SelTooth Is Nothing) Then SelTooth.BorderColor = Color.Black
SelTooth = ucT(Index)
SelTooth.BorderColor = Color.Blue
'Setup Textboxes:
Text1(0).Text = ucT(Index).CenterSymbol
Text1(1).Text = CStr(ucT(Index).CrCenter)
Text1(2).Text = CStr(ucT(Index).CrBottom)
Text1(3).Text = CStr(ucT(Index).CrLeft)
Text1(4).Text = CStr(ucT(Index).CrRight)
Text1(5).Text = CStr(ucT(Index).Nr)
RefreshAllTeeth()
Text = "Currently selected Tooth: " & SelTooth.Nr
Dim Menue As String = "", PopUp As String = ""
With SelTooth
PopUp = PopUp & "CrLeft Blue,1;"
PopUp = PopUp & "Top Blue,2;"
PopUp = PopUp & "Top Green,3;"
PopUp = PopUp & "Top X,4;"
PopUp = PopUp & "Center Symbol #,5;"
PopUp = PopUp & "Center Symbol $,6"
PopUp = PopUp & "Center Symbol $,7"
'add more
Menue = CStr(mnuTooth(Me.Handle.ToInt32(), PopUp))
Select Case Menue
Case 1
Text1(1).Text = CStr(255) 'Top Red
Case 2
Text1(1).Text = ColorTranslator.ToOle(Color.Blue).ToString() 'Top Blue
Case 3
Text1(1).Text = ColorTranslator.ToOle(Color.Lime).ToString() 'Top Green
Case 4
' '-----------------------
Case 5
Text1(0).Text = "#"
Case 6
Text1(0).Text = "$"
End Select
End With
'now pass the Color from the Textbox...
ucT(Index).CrCenter = CInt(Text1(1).Text)
ucT(Index).CenterSymbol = Text1(0).Text
'Update the selected Tooth with selected color(s) / Symbols
RefreshAllTeeth()
End Sub
End Class