Diagramme im MDI-Formular Balken, Kreis und Torte

Private Function, Public, Circle
Prozeduren im Formular "Start"
Private Sub cmdAnzeig_Click()
 If optBalken.Value = True Then OptionButton auswählen, um weitere Formulare zu
  frmBalken.laden1 öffnen.
 ElseIf optKreis.Value = True Then
  frmKreis.laden2
 Else
  frmTorte.laden3
 End If
End Sub
Private Sub Form_Load()
 Width = 4485
 Height = 3300
 Left = 250
 Top = 250
 txtHard.Text = 50 In die Textboxen werden Werte geladen.
 txtSoft.Text = 40
 txtSchul.Text = 30
 txtServ.Text = 20
 txtZub.Text = 10
End Sub
Prozeduren im Formular "Balken"
Dim H!, So!, Sc!, Se!, Zu!
Private Sub Form_Paint()
 Call zeichneBalken Zeichnet die Balken durch Aufruf eines Moduls.
End Sub
Private Sub Form_Resize()
On Error Resume Next On Error = wichtig, damit das Programm beim Verkleinern
 ScaleHeight = -110 des Formulars nicht abstürtzt.
 ScaleWidth = 100
 ScaleTop = 103
 ScaleLeft = -15
 Call laden1
 Refresh
End Sub
Public Sub laden1()
 H = Val(frmStart.txtHard.Text) Die Variablen erhalten die Werte aus den Textboxen.
 So = Val(frmStart.txtSoft.Text)
 Sc = Val(frmStart.txtSchul.Text)
 Se = Val(frmStart.txtServ.Text)
 Zu = Val(frmStart.txtZub.Text)
 
 Call Balken(H, So, Sc, Se, Zu) Modul "Balken" rufen.
End Sub
Private Sub Form_Load()
 Width = 4485
 Height = 3300
 Left = 5000
 Top = 250
 Refresh
End Sub
Prozeduren im Formular "Kreis"
Dim H!, So!, Sc!, Se!, Zu!
Private Sub Form_Resize()
On Error Resume Next On Error = wichtig, damit das Programm beim Verkleinern
 Scale (-150, 150)-(150, -150) des Formulars nicht abstürtzt.
 
 Call laden2
 Refresh
End Sub
Public Sub laden2()
Dim H!, So!, Sc!, Se!, Zu!
 
 H = Val(frmStart.txtHard.Text) Die Variablen erhalten die Werte aus den Textboxen.
 So = Val(frmStart.txtSoft.Text)
 Sc = Val(frmStart.txtSchul.Text)
 Se = Val(frmStart.txtServ.Text)
 Zu = Val(frmStart.txtZub.Text)
 
 Call Kreis(H, So, Sc, Se, Zu) Modul "Kreis" rufen.
End Sub
Private Sub Form_Load()
 Width = 4485
 Height = 3300
 Left = 250
 Top = 4000
 
 Refresh
End Sub
Prozeduren im Formular "Torte"
Dim H!, So!, Sc!, Se!, Zu!
Private Sub Form_Resize()
On Error Resume Next On Error = wichtig, damit das Programm beim Verkleinern
 Scale (-150, 150)-(150, -150) des Formulars nicht abstürtzt.
 Call laden3
 Refresh
End Sub
Public Sub laden3()
Dim H!, So!, Sc!, Se!, Zu!
 
 H = Val(frmStart.txtHard.Text) Die Variablen erhalten die Werte aus den Textboxen.
 So = Val(frmStart.txtSoft.Text)
 Sc = Val(frmStart.txtSchul.Text)
 Se = Val(frmStart.txtServ.Text)
 Zu = Val(frmStart.txtZub.Text)
 
 Call Torte(H, So, Sc, Se, Zu) Modul "Torte" rufen.
End Sub
Private Sub Form_Load()
 Width = 4485
 Height = 3300
 Left = 5000
 Top = 4000
 
 Refresh
End Sub
Prozeduren im MDI-Formular
Nicht vergessen: Das MDI-Formular als Startformular zuweisen!  (Kontextmenü: Formulare: Eigenschaften von Projekt...)
Private Sub MDIForm_Load()
 Width = 10000 MDI-Formulargröße.
 Height = 8500
 frmStart.Show
 frmStart.Left = 250 Startposition der MDI-Form.
 frmStart.Top = 250
End Sub
Private Sub MDIForm_Resize()
 Me.Arrange 2 Alle Kindfenster werden nebeneinander angeordnet.
End Sub
Private Sub nebeneinander_Click()
 Me.Arrange 2 Alle Kindfenster werden nebeneinander angeordnet.
End Sub
Private Sub überlappend_Click()
 Me.Arrange 0 Alle Kindfenster werden überlappend angeordnet.
End Sub
Private Sub untereinander_Click()
 Me.Arrange 1 Alle Kindfenster werden untereinander angeordnet.
End Sub
Private Sub Beenden_Click()
 End
 Unload Me Programmende.
End Sub
Prozeduren im Modul "Balken"
Public Sub Balken(bH, bSo, bSc, bSe, bZu) Übernahme der Variablen aus Formular "Balken".
Dim pH!, pSo!, pSc!, pSe!, pZu!, gesamt! Umwandlung der Variablen.
 gesamt = bH + bSo + bSc + bSe + bZu
 If gesamt > 0 Then
   pH = proz1(gesamt, bH)
   pSo = proz1(gesamt, bSo)
   pSc = proz1(gesamt, bSc)
   pSe = proz1(gesamt, bSe)
   pZu = proz1(gesamt, bZu)
   frmBalken.Cls
   frmBalken.AutoRedraw = True
   Call zeichneBalken
Fehler brauchen nur abgefangen zu werden, wenn alle
 Else TextBoxen leer sind:
   MsgBox "Geben Sie die Werte ein" Wenn die Textboxen 1 bis 5 leer sind.
   frmStart.Show
   frmStart.txtHard.SetFocus
 End If
 frmBalken.Line (15, 0)-(5, pH), RGB(52, 177, 58), BF
 frmBalken.Line (20, 0)-(30, pSo), RGB(66, 79, 164), BF
 frmBalken.Line (45, 0)-(35, pSc), RGB(173, 56, 162), BF
 frmBalken.Line (60, 0)-(50, pSe), RGB(169, 166, 61), BF
 frmBalken.Line (75, 0)-(65, pZu), RGB(30, 123, 189), BF
End Sub
Private Function proz1(ByVal ins As Single, ByVal teil As Single)
 proz1 = teil / ins * 100 Prozentualen Anteil ausrechnen.
End Function
Public Sub zeichneBalken() Balken zeichnen.
Dim i%
 frmBalken.Line (0, 0)-(0, 100)
 frmBalken.Line (0, 0)-(80, 0)
 For i = 0 To 100 Step 10
   frmBalken.Line (-1, i)-(100, i)
   frmBalken.CurrentX = -10
   frmBalken.CurrentY = i + 3
   frmBalken.Print i & " %"
 Next i
 frmBalken.CurrentX = 5
 frmBalken.CurrentY = 0
 frmBalken.Print "Hardw."
 frmBalken.CurrentX = 20
 frmBalken.CurrentY = 0
 frmBalken.Print "Softw."
 frmBalken.CurrentX = 35
 frmBalken.CurrentY = 0
 frmBalken.Print "Schul."
 frmBalken.CurrentX = 51
 frmBalken.CurrentY = 0
 frmBalken.Print "Serv."
 frmBalken.CurrentX = 66
 frmBalken.CurrentY = 0
 frmBalken.Print "Zub."
End Sub
Prozeduren im Modul "Kreis"
Public Sub Kreis(bH, bSo, bSc, bSe, bZu) Übernahme der Variablen aus Formular "Kreis".
Dim pH!, pSo!, pSc!, pSe!, pZu!, gesamt!, start!, ende! Umwandlung der Variablen.
Const pi As Double = 3.14159
gesamt = bH + bSo + bSc + bSe + bZu
 If gesamt > 0 Then
  pH = proz1(gesamt, bH)
  pSo = proz1(gesamt, bSo)
  pSc = proz1(gesamt, bSc)
  pSe = proz1(gesamt, bSe)
  pZu = proz1(gesamt, bZu)
  frmKreis.Cls Durch die Zeichnung eines Kreises gestaltet sich das
  frmKreis.FillStyle = 0 Abfangen der Fehler komplizierter:
 Else
  MsgBox "Geben Sie die Werte ein" Wenn die Textboxen 1 bis 5 leer sind.
  frmStart.Show
  frmStart.txtHard.SetFocus
 End If
-----------------------------------------------------------------------------------
If bH > 0 Then Wenn die erste Textbox größer Null ist.
   
 If bSo = 0 And bSc = 0 And bSe = 0 And bZu = 0 Then Wenn die Textboxen 2 - 4 leer sind, wird ein voller Kreis
   frmKreis.Circle (0, 0), 80, RGB(52, 177, 58) gezeichnet.
   Exit Sub
 End If
 
 start = 0.00001
 ende = ((360 / 100) * pH) * (pi / 180) Formel:  Grad / 100 * Wert * Pi / 180.
 frmKreis.FillColor = RGB(52, 177, 58)
 frmKreis.Circle (0, 0), 80, RGB(52, 177, 58), -start, -ende
End If
-----------------------------------------------------------------------------------
If bSo > 0 Then Wenn die zweite Textbox größer Null ist.
   
 If bH = 0 Then Wenn die erste Textbox leer ist.
   start = 0.00001
 Else
   start = ende
 End If
   If bH = 0 And bZu = 0 Then start = 0.000001 Wenn die Textboxen 1 + 5 leer sind.
     If bH = 0 And bSc = 0 And bSe = 0 And bZu = 0 Then  Wenn die Textboxen 1, 3, 4 + 5 leer sind.
       frmKreis.Circle (0, 0), 80, RGB(66, 79, 164)
       Exit Sub
     End If
 ende = ((360 / 100) * pSo) * (pi / 180) + start
 frmKreis.FillColor = RGB(66, 79, 164)
 frmKreis.Circle (0, 0), 80, RGB(66, 79, 164), -start, -ende
End If
-----------------------------------------------------------------------------------
If bSc > 0 Then Wenn die dritte Textbox größer Null ist.
   
 If bSo = 0 Then Wenn Textbox 2 leer ist.
   start = ende - 0.00001
 Else
   start = ende
 End If
    
   If bH = 0 And bSo = 0 Then start = 0.00001 Wenn die Textboxen 1 + 2 leer sind.
    
    If bH = 0 And bSo = 0 And bZu = 0 Then start = 0.000001 Wenn die Textboxen 1, 2 + 5 leer sind.
     If bH = 0 And bSo = 0 And bSe = 0 And bZu = 0 Then Wenn die Textboxen 1, 2, 4 + 5 leer sind.
       frmKreis.Circle (0, 0), 80, RGB(173, 56, 162)
       Exit Sub
     End If
 
 ende = ((360 / 100) * pSc) * (pi / 180) + start
 frmKreis.FillColor = RGB(173, 56, 162)
 frmKreis.Circle (0, 0), 80, RGB(173, 56, 162), -start, -ende
End If
-----------------------------------------------------------------------------------
If bSe > 0 Then Wenn die vierte Textbox größer Null ist.
 If bSc = 0 Then Wenn Textbox 3 leer ist.
   start = ende - 0.00001
 Else
   start = ende
 End If
       
   If bH = 0 And bSo = 0 And bSc = 0 Then start = 0.00001 Wenn die Textboxen 1 bis 3 leer sind.
     If bH = 0 And bSo = 0 And bSc = 0 And bZu = 0 Then Wenn die Textboxen 1, 2, 3 + 5 leer sind.
       frmKreis.Circle (0, 0), 80, RGB(169, 166, 61)
     Exit Sub
     End If
 ende = ((360 / 100) * pSe) * (pi / 180) + start
 frmKreis.FillColor = RGB(169, 166, 61)
 frmKreis.Circle (0, 0), 80, RGB(169, 166, 61), -start, -ende
End If
-----------------------------------------------------------------------------------
If bZu > 0 Then Wenn die fünfte Textbox größer Null ist.
   
 If bSe = 0 Then Wenn Textbox 4 leer ist.
   start = ende - 0.00001
 Else
   start = ende
 End If
           
   If bH = 0 And bSo = 0 And bSc = 0 And bSe = 0 Then Wenn die Textboxen 1 bis 4 leer sind, wird ein voller Kreis
     frmKreis.Circle (0, 0), 80, RGB(30, 123, 189) gezeichnet.
     Exit Sub
   End If
 ende = ((360 / 100) * pZu) * (pi / 180) + start - 0.0001
 frmKreis.FillColor = RGB(30, 123, 189)
 frmKreis.Circle (0, 0), 80, RGB(30, 123, 189), -start, -ende
End If
End Sub
Prozeduren im Modul "Torte"
Public Sub Torte(bH, bSo, bSc, bSe, bZu) Übernahme der Variablen aus Formular "Torte".
Dim pH!, pSo!, pSc!, pSe!, pZu!, gesamt!, i! Umwandlung der Variablen.
Const pi As Double = 3.14159
gesamt = bH + bSo + bSc + bSe + bZu
 If gesamt > 0 Then
   pH = ((360 / 100) * proz1(gesamt, bH)) * (pi / 180) Torten-Lösung: Dozent.
   pSo = ((360 / 100) * proz1(gesamt, bSo)) * (pi / 180)
   pSc = ((360 / 100) * proz1(gesamt, bSc)) * (pi / 180)
   pSe = ((360 / 100) * proz1(gesamt, bSe)) * (pi / 180)
   pZu = ((360 / 100) * proz1(gesamt, bZu)) * (pi / 180)
   frmTorte.Cls
   frmTorte.FillStyle = 0
 Else
   MsgBox "Geben Sie die Werte ein" Wenn die Textboxen 1 bis 5 leer sind.
   frmStart.Show
   frmStart.txtHard.SetFocus
 End If
 For i = -30 To 30 Ab hier ohne weiteres Abfangen von Fehlern, da dieses
    durch die Zeichnung von "mehreren Lagen" (60) der Torte
   frmTorte.FillColor = RGB(52, 177, 58) weitaus komplizierter (als beim "Kreis") wäre.
   frmTorte.Circle (0, i), 80, RGB(52, 177, 58), -0.00001, -pH, 0.5
   
   frmTorte.FillColor = RGB(66, 79, 164)
   frmTorte.Circle (0, i), 80, RGB(66, 79, 164), -pH, -(pH + pSo), 0.5
   
   frmTorte.FillColor = RGB(173, 56, 162)
   frmTorte.Circle (0, i), 80, RGB(173, 56, 162), -(pH + pSo), -(pH + pSo + pSc), 0.5
   
   frmTorte.FillColor = RGB(169, 166, 61)
   frmTorte.Circle (0, i), 80, RGB(169, 166, 61), -(pH + pSo + pSc), -(pH + pSo + pSc + pSe), 0.5
   
   frmTorte.FillColor = RGB(30, 123, 189)
   frmTorte.Circle (0, i), 80, RGB(30, 123, 189), -(pH + pSo + pSc + pSe), -(pH + pSo + pSc + pSe + pZu), 0.5
  
 Next i
End Sub
Private Function proz1(ByVal ins As Single, ByVal teil As Single)
 proz1 = teil / ins * 100 Prozentualen Anteil ausrechnen.
End Function

 Ranking-Hits zurück Sitemap
Designed by www.wbrnet.info