vb@rchiv · Tipps & Tricks · Der Silberne Schnitt

Rubrik: Variablen/Strings · Algorithmen/Mathematik | VB-Versionen: VB6, VBA

22.07.16

Der Silberne Schnitt Mit diesem Quellcode berechnen Sie die drei Längen A, B, und die Gesamtlänge A + B des Silbernen Schnitts.
Autor: Bernd Theilacker	Bewertung:	Views: 5.956
www.oggisoft.de	System: Win7, Win8, Win10, Win11	Beispielprojekt

Der Silberne Schnitt. Mit diesem Quellcode berechnen Sie die drei Längen A, B und die Gesamtlänge A+B. Sie benötigen dafür 3 Textboxen und 2 CommandButtons. Tippen Sie anschließend nur in ein Textfeld eine Zahl ein und drücken Sie auf "Enter". Die beiden anderen Längen werden nun berechnet. (Der Goldene- und der Silberne Schnitt werden mit dem August-Update als weiteres Zusatzfenster in den OGGISOFT-Calculator implementiert. Dieser Taschenrechner wird ausschließlich in VB6 programmiert.)

Private Sub Form_Load()
  Me.Caption = "Der Silberne Schnitt - OGGISOFT"
  Command1.Default = True
  Command1.Caption = "Berechnen"
  Command2.Caption = "Neu"
End Sub

Private Sub Command1_Click()
  Dim dA As Double     ' größerer teil
  Dim dB As Double     ' kleinerer teil
  Dim dAB As Double    ' gesamtlänge
  Dim dDelta As Double ' silberner schnitt
 
  ' silberner schnitt (2a+b)/a=a/b=1+v2  v=steht für das Wurzelzeichen
  dDelta = 1 + Sqr(2)     ' 2,41421356237309
 
   If Text1.Text <> "" Then
     dA = CDbl(Text1.Text)
     dB = dA / dDelta
     dAB = dA + dB
  ElseIf Text2.Text <> "" Then
    dB = CDbl(Text2.Text)
    dA = dDelta * dB
    dAB = dA + dB
  ElseIf Text3.Text <> "" Then
    dAB = CDbl(Text3.Text)
    dB = dAB / (dDelta + 1)
    dA = dB * dDelta
  Else
    MsgBox "Bitte eine Zahl in ein Textfeld eintragen!", vbInformation, "Bedienungshinweis"
    Text1.SetFocus
    Exit Sub
  End If
 
  Text1.Text = CStr(dA)
  Text2.Text = CStr(dB)
  Text3.Text = CStr(dAB)
End Sub

Private Sub Command2_Click()
  Text1.Text = ""
  Text2.Text = ""
  Text3.Text = ""
  Text1.SetFocus
End Sub