Ver Mensaje Individual
  #7 (permalink)  
Antiguo 13/09/2004, 10:04
Avatar de Beakdan
Beakdan
 
Fecha de Ingreso: diciembre-2001
Ubicación: Monterrey, Nuevo León
Mensajes: 433
Antigüedad: 23 años, 2 meses
Puntos: 7
Continúa...
Código:
Private Sub LoadUnloadLabels()
'Puesto que con VB no se tiene un método para
'dibujar texto en una coordenada específica,
'usamos labels para obtener esta funcionalidad.
'Cargamos y descargamos los label según se requieran

Dim nLabels     As Long
Dim i           As Long

    nLabels = CLng(Text1(4).Text) + CLng(Text1(5).Text) + 7
    If Label1.UBound > nLabels Then
        For i = (nLabels + 1) To Label1.UBound
            Unload Label1(i)
        Next i
    End If
    
    If Label1.UBound < nLabels Then
        For i = (Label1.UBound + 1) To nLabels
            Load Label1(i)
            With Label1(i)
                .Alignment = vbLeftJustify
                .Caption = ""
                .ForeColor = vbHighlight
                .Visible = True
            End With
        Next i
    End If
End Sub

Private Sub DrawGrid()
Dim i               As Long
Dim iCtrl           As Long
Dim x               As Long
Dim y               As Long
Dim lXDivition      As Long
Dim lYDivition      As Long

    'Al cambiar la propiedad autoredraw a True,
    'le indicamos a visual basic que esta parte del
    'gráfico se mantendrá en memoria. Luego cambiamos
    'la propiedad nuevamente a false. De este modo, evitamos
    'tener que dibujar la rejilla cada vez dibujamos
    'la curva de la ecuación
    
    Me.AutoRedraw = True
    Me.Cls
    
    iCtrl = 6
    
    'espaciado entre líneas verticales
    lXDivition = (Me.ScaleWidth - (FormPad * 2)) \ CStr(Text1(4).Text)
    m_lXValReal = CStr(Text1(2).Text) / lXDivition
    
    'espaciado entre líneas horizontales
    lYDivition = (Me.ScaleHeight - (FormPad * 3)) \ CStr(Text1(5).Text)
    m_lYValReal = CStr(Text1(3).Text) / lYDivition

    'Necesitamos encontrar la posición del punto
    'de origen de la escala de usuario en coordenadas de pantalla
    m_lXOrigin = (((0 - CLng(Text1(0).Text)) / CSng(Text1(2).Text)) * lXDivition) + FormPad
    m_lYOrigin = Me.ScaleHeight - (((0 - CLng(Text1(1).Text)) / CSng(Text1(3).Text)) * lYDivition) - (FormPad * 2)
    
    Me.ForeColor = vb3DShadow
    Me.DrawStyle = vbDot
    
    'Lineas verticales del gráfico
    For i = 0 To CStr(Text1(4).Text)
        'calculamos la posición en X
        x = FormPad + (i * lXDivition)
        'Trazamos la línea
        Me.Line (x, 0)-(x, Me.ScaleHeight)
        
        With Label1(iCtrl)
            'ocultamos el control antes de actualizar sus
            'propiedades. Esto acelera un poco el proceso.
            .Visible = False
            If m_lYOrigin < 0 Then
                .Top = 1
            ElseIf m_lYOrigin > (Me.ScaleHeight - ((FormPad * 2) + 1)) Then
                .Top = Me.ScaleHeight - ((FormPad * 2) - 1)
            Else
                .Top = m_lYOrigin + 1
            End If
            .Left = x + 1
            .Caption = Format(CLng(Text1(0).Text) + (i * Text1(2)), "###,##0.000")
            .Visible = True
        End With
        iCtrl = iCtrl + 1
    Next i
    
    'Lineas horizontales del gráfico
    For i = 0 To CStr(Text1(5).Text)
        'calculamos la posición en y
        y = Me.ScaleHeight - ((FormPad * 2) + (i * lYDivition))
        'Trazamos la línea
        Me.Line (0, y)-(Me.ScaleWidth, y)
        With Label1(iCtrl)
            .Visible = False
            .Top = y + 1
            If m_lXOrigin < 0 Then
                .Left = 1
            ElseIf m_lXOrigin > (Me.ScaleWidth - (.Width + 1)) Then
                .Left = Me.ScaleWidth - (.Width + 1)
            Else
                .Left = m_lXOrigin + 1
            End If
            .Caption = Format(CLng(Text1(1).Text) + (i * Text1(3)), "###,##0.000")
            .Visible = True
        End With
        iCtrl = iCtrl + 1
    Next i
    
    'trazamos los ejes
    Me.DrawStyle = vbSolid
    Me.ForeColor = vbHighlight
    If (m_lYOrigin >= 0) And (m_lYOrigin <= Me.ScaleHeight) Then
        Me.Line (0, m_lYOrigin)-(Me.ScaleWidth, m_lYOrigin)
    End If
    
    If (m_lXOrigin >= 0) And (m_lXOrigin <= Me.ScaleWidth) Then
        Me.Line (m_lXOrigin, 0)-(m_lXOrigin, Me.ScaleHeight)
    End If
    
    Me.AutoRedraw = False
End Sub

'Esta función devuelve un código de error. El resultado de la evaluación se guarda en
'una variable pasada pro referencia (al estilo de las funciones de la API). De este
'modo, es mucho más fácil decidir que hacer según el error que ocurra.
'Por ahora, sólo manejamos la posibilidad de división por cero, pero tratándose
'de ecuaciones mátemáticas, pueden ocurrir muchos más.
Private Function Solve( _
        ByVal sEquation As String, _
        ByVal lXVal As Double, _
        ByRef lResult As Long) As EnumErrorSolve
        
Dim SC           As New ScriptControl
'Dim sEquation    As String
Dim dResult      As Double

On Error GoTo ErrorTrap

    'Establecemos el lenguaje con el que operara el SC
    'Si indicásemos que será JScript, las ecuaciones tendrían
    'que introducirse con la sintaxis de JScript.
    'Por ejemplo:
    'VBScript ->    ((2 * X) ^ 2) / (X - 1)
    'JScript  ->    Math.Pow(2 * X), 2) / (X - 1)
    SC.Language = "VBScript"
    'Exp
    'Remplazamos la "X" en la ecuación por el valor numérico
    'Hacemos la comparación en modo textual, así reemplazamos ya sea
    'una X mayúscula o minúscula.
    'Sim embargo esto ocasiona que expresiones como Exp() no
    'puedan ser evaluadas. Tendrás que corregir eso.
    sEquation = Replace(sEquation, "X", CStr(lXVal), , , vbTextCompare)
    
    'evaluamos
    dResult = SC.Eval(sEquation)
    
    'Convertimos el resultado a coordenadas de pantalla,
    'y devolvemos el valor.
    lResult = m_lYOrigin - CLng(dResult / m_lYValReal)
    
    Exit Function
    
ErrorTrap:

    Select Case Err.Number
        Case 5  'Argumento Inválido. Por ejemplo: Sqr(-1)
            lResult = ErrorSolve
            Solve = ESArgInvalid
            Err.Clear
        Case 6  'overflow
            lResult = ErrorSolve
            Solve = ESOverFlow
            Err.Clear
        Case 11 'División por cero
            'Es muy probable que al evaluar alguna ecuación se produzca
            'una división por cero. Aquí interceptamos el error.
            'Esto parece funcionar sólo en el archivo compilado...
            lResult = ErrorSolve
            Solve = ESInfinit
            Err.Clear
    End Select
End Function

Private Sub Form_Resize()
    'Esta verificación la hacemos para evitar que salte un error.
    'Ya que el formulario se redimensiona antes de que los controles a
    'usar hayan sido creados.
    If m_bAllowChange Then
        DrawGrid
    End If
End Sub

Private Sub Text1_Change(Index As Integer)
    If m_bAllowChange Then
        If IsNumeric(Text1(Index).Text) Then
            If Index > 1 Then
                If CSng(Text1(Index).Text) <> 0 Then
                    LoadUnloadLabels
                    DrawGrid
                End If
            Else
                LoadUnloadLabels
                DrawGrid
            End If
        End If
    End If
End Sub

Private Sub Timer1_Timer()
'¿Para qué es este timer? Visual Basic no permitirá que
'descargue dinámicamente los controles que utilizamos
'si la rutina que los descarga es invocada desde ciertos
'eventos. Puesto que para mostrar las funciones de ejemplo
'necesito redimensionar el array de Labels cuando el usuario
'hace click en el combo1, VB fallará catastróficamente.
'Entonces, en lugar de hacerlo con el evento del combo,
'lo hacemos con el timer unos milisegundos después
'del onclick del combo...
    
    Timer1.Enabled = False
    LoadUnloadLabels
    DrawGrid
End Sub
En lo personal, prefiero usar las funciones GDI de la API, porque son definitivamente más rápidas. En cuanto al control, es desesperantemente lento (comparado con el archivo que antes te había pasado), pero hace el trabajo, y es fácil de usar y comprender.
En el programa incluyo algunas ecuaciones que te pueden servir de ejemplo para que veas como introducir tus propias funciones. Ah, y seguramente te llegarán a saltar errores, al evaluar una función puede ocurrir un overflow, o que metan mal la función. Sólo he puesto intercepción de errores para división por cero y operador incorrecto...
Bueno, luego me dices como te fue con esto. Saludos.
P.D. Te dejo un screenshot del programa después de graficar las ecuaciones de una circunferencia y de una elipse...
screenshot