' Ternas pitagoricas.bas
' Angel Bugarin Silva. QB64 Febrero 2025.
' https://sites.google.com/site/abugarins/, abugarins@gmail.com
'
' Una terna pitagorica es un conjunto ordenado de tres numeros enteros positivos a, b, c
' que son solucion de la ecuacion diafontica cuadratica a2 + b2 = c2.
' Este programa genera ternas pitagoricas a partir de dos numeros enteros dados.
On Error GoTo Erro
Option _Explicit
Screen _NewImage(1260, 940, 32)
_FullScreen
Const ColorLinea = _RGB32(255, 255, 255)
Dim X As Integer, Y As Integer, Aux As Integer, I As Integer, J As Integer
Dim A As Double, B As Double, C As Double
Dim Tmp As String, Lx As Integer, Mb As String, Mc As String
Cls
Line (200, 300)-(200, 800), ColorLinea
Line (200, 800)-(1200, 800), ColorLinea
Line (200, 300)-(1200, 800), ColorLinea
X = 0
While X <= 0
Locate 4, 4
Input "1- Introduce un numero entero positivo (0=fin):", X
If X = 0 Then End
Wend
Y = 0
While Y <= 0
Locate 6, 4
Input "2- Introduce otro numero entero positivo:", Y
If Y = 0 Then End
If Y = X Then
Locate 8, 4
Print "Ha de ser distinto al otro.";
Beep
Y = 0
End If
Wend
If X < Y Then
Aux = X
X = Y
Y = Aux
End If
A = 2 * (X * Y)
B = (X * X) - (Y * Y)
C = (X * X) + (Y * Y)
Tmp = _Trim$(Str$(C))
Lx = Len(Tmp)
J = Lx / 3
Mb = " " + String$(Lx + J, "#") + ","
Mc = ""
For I = 1 To 3
Mc = Mc + Mb
Next I
'Comprobacion.
If Not (((A * A) + (B * B)) = (C * C)) Then
Locate 10, 4
Print "* * * * TERNA ERRONEA * * * * "; A; " "; B; " "; C; " "
End If
'Catetos
If A < B Then
Locate 8, 4
Print "Terna pitagorica:";
Print Using Mc; A; B; C;
Locate 37, 10
Print Using Mb; A;
Locate 52, 70
Print Using Mb; B;
Else
Locate 8, 4
Print "Terna pitagorica:";
Print Using Mc; B; A; C;
Locate 37, 10
Print Using Mb; B;
Locate 52, 70
Print Using Mb; A;
End If
'Hipotenusa
Locate 31, 80
Print Using Mb; C;
Locate 55, 4
Line Input Tmp
Run
End
Erro:
Print
Beep
Print ">>> ERROR "; Err; "("; _ErrorMessage$; ") en linea "; _ErrorLine; " <<<";
Beep
End
Crear cuenta
Comentarios sobre la versión: Versión 1.0 (0)
No hay comentarios