Hola amigos, tengo un problema, necesito dibujar un arco doble relleno de un color diferente cada uno. Yo lo tenía resuelto con Circle sin relleno, pero
como sólo se puede hacer con la función Chord de API, pues me puse a ello. pero las coordenadas y forma de invocar Chord son diferentes a Circle, tengo un lio espantoso que no logro resolverlo. A ver si algún experto es el gdi puede echarme una mano.
Para que esté mas claro el problema, adjunto el código de lo que necesito, y funciona con Circle, para que el que me quiera ayudar sólo me ponga el equivalente con Chord. Doy las gracias de antemano a quiera ayudarme
El código es este:
Private Declare Function Chord Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, _
ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private brocha As Long
' Pi
Function Pi() As Double
Pi = Atn(1) * 4
End Function
' Seno en grados
Function SinD(ByVal Number As Double) As Double
SinD = Sin(Deg2Rad(Number))
End Function
' Grados a Radianes
Function Deg2Rad(ByVal Number As Double) As Double
Deg2Rad = Number * Pi / 180
End Function
' Radianes a Grados
Function Rad2Deg(ByVal Number As Double) As Double
Rad2Deg = Number * 180 / Pi
End Function
' Seno inverso
Function Asn(ByVal Number As Double) As Double
If Number = 1 Then
Asn = Pi / 2
ElseIf Number = -1 Then
Asn = -Pi / 2
Else
Asn = Atn(Number / Sqr(-Number * Number + 1))
End If
End Function
' Coseno inverso
Function Acs(ByVal Number As Double) As Double
If Number = 1 Then
Acs = 0
ElseIf Number = -1 Then
Acs = Pi
Else
Acs = Atn(-Number / Sqr(-Number * Number + 1)) + Pi / 2
End If
End Function
' Seno inverso en grados
Function AsnD(ByVal Number As Double) As Double
AsnD = Rad2Deg(Asn(Number))
End Function
' Coseno inverso en grados
Function AcsD(ByVal Number As Double) As Double
AcsD = Rad2Deg(Acs(Number))
End Function
Sub ArcoDoble()
Dim c1 As Double, h As Double, b1 As Double, Nesc As Single, flecha As Integer, radio As Single
On Error Resume Next
DrawWidth = 1
flecha = 400
ancho = 3200
escala = 0.05
Xref = 15 'Referencia inicio en X
Yref = 50 'Referencia inicio en Y
radio = ((ancho ^ 2) + (4 * (flecha ^ 2))) / (8 * flecha)
c1 = radio - 30
angulo = AsnD((ancho / 2) / radio)
Xrad = ((ancho / 2) * escala)
radio = (radio * escala)
flecha = (flecha * escala)
Yrad = radio - flecha
anRad1 = Deg2Rad(90 - angulo)
anRad2 = Deg2Rad(90 + angulo)
'Arco exterior con función Circle
Circle (Xrad + Xref, Yrad + Yref), radio, 0, anRad1, anRad2 'Dibuja el arco así <--- de anRad1 a anRad2
'Arco exterior con función Chord
Nesc = Form3_A.ScaleX(1, vbMillimeters, vbPixels) 'Convierte milimetros a pixels
brocha = CreateSolidBrush(vbRed) 'Relleno rojo
SelectObject Me.hdc, brocha 'Selecciona tipo de brocha
'Aquí necesito la función Chord que dibuje el arco igual que con Circle
'Chord Me.hdc, etc, ect , etc
'---------------------------------------------------------------------------------------------------
'Arco interior
h = c1 - (400 - (30 * 2)) 'flecha interior del arco, c1 es el radio interior del arco
angulo = AcsD(h / c1) 'ángulo total del arco
b1 = c1 * SinD(angulo) 'cuerda total del arco
h = ((ancho - (b1 * 2))) / 2 '1/2 de la cuerda
radio = (c1 * escala)
anRad1 = Deg2Rad(90 - angulo)
anRad2 = Deg2Rad(90 + angulo)
Circle (Xrad + Xref, Yrad + Yref), radio, 0, anRad1, anRad2 'Dibuja el arco así <--- de anRad1 a anRad2
'Arco interior con función Chord
brocha = CreateSolidBrush(vbWhite) 'Relleno blanco
SelectObject Me.hdc, brocha 'Selecciona tipo de brocha
'Aquí necesito la función Chord que dibuje el arco igual que con Circle
'Chord Me.hdc, etc, ect , etc
Me.Refresh
'Linea de cuerda interior esta no me haría falta
Line ((h * escala) + Xref, Yref - (30 * escala))-(Xref + ((b1 * 2) * escala) + (h * escala), Yref - (30 * escala))
DeleteObject brocha
End Sub
Private Sub Form_Load()
Me.ScaleMode = 6 'Milimetros
Me.Width = 11000
Me.Height = 6000
Me.AutoRedraw = True
Me.BackColor = &HFFFFFF
ArcoDoble
End Sub
