[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
código-fonte aberto
Oi pessoal (especialmente o Saldanha que começou a publicar código-fonte de
seus programas)
Devido a concorrência do meu amigo Saldanha na programação, terei de dar a
tacada de volta, abro portanto o código-fonte mais esperado do ano: cálculo
se um número é primo e se não, qual sua decomposição em primos (código para
visual basic 5, não testado em outras versões do vb. Direito de cópia
permanece com o autor ... blábláblá)
Sub Optimize()
'==============================================================
'Processo do Optimização da resposta
'==============================================================
If Text2.Text = "É primo" Then Exit Sub
Dim i, XCopy, Answ, Count, where, where2, what
XCopy = Text2.Text
UpMe:
where = InStr(1, XCopy, ";")
what = Left(XCopy, where)
'While InStr(1, XCopy, what) = 1
While Left(XCopy, Len(what)) = what
Count = Count + 1
XCopy = Right(XCopy, Len(XCopy) - Len(what))
Wend
Answ = Answ & Left(what, Len(what) - 1) & "^" & Count & ";"
Count = 0
If Not XCopy = "" Then GoTo UpMe
Text2.Text = Answ
While InStr(1, Text2, "^1;")
where = InStr(1, Text2, "^1;") - 1
Text2 = Mid(Text2, 1, where) & Mid(Text2, where + 3, Len(Text2) -
where - 2)
Wend
End Sub
'==============================================================
'Decompõe um número em seus fatores primos
'==============================================================
Private Sub Command1_Click()
If Len(Text1) > 4 Then
Answ = MsgBox("Este cálculo pode demorar vários minutos ou até
horas. Deseja continuar?", vbOKCancel, "Cuidado...")
If Answ = 2 Then Exit Sub
ElseIf Len(Text1) = 0 Then Exit Sub
End If
On Error GoTo MyErr
Dim X, i, XCopy, CCopy, si, hwtims
XCopy = Text1
CCopy = Text1
For i = 2 To Text1 / 2
HeyMan:
If XCopy = 0 Or XCopy = 1 Then GoTo NextI
XCopy = XCopy / i
If InStr(XCopy, ",") = 0 Then
X = X & i & ";"
CCopy = XCopy
GoTo HeyMan
Else
XCopy = CCopy
End If
Next i
NextI:
Text2 = X
If X = "" Then Text2 = "É primo"
Text2.Visible = True
Optimize
Exit Sub
MyErr:
MsgBox "Há um erro. Verifique seus números"
Exit Sub
End Sub
Como podes ver, Saldanha, tenho lá umas cartas na manga. Aliás, obrigado
pela dica do MuPAD, tem me ajudado bastante. Infelizmente não mexo com C,
ainda.
Quem sabe vc. publica mais C que eu publico mais códigos do vb...
Paremos de brigar. Esta é uma lista pacífica...
Abraço,
Benjamin Hinrichs