Diagramme im MDI-Formular Balken, Kreis und Torte
| Diagramme im MDI-Formular Balken, Kreis und Torte via 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. |
| 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 | |
| Ab hier ohne weiteres Abfangen von Fehlern, da dieses durch die Zeichnung von "mehreren Lagen" (60) der Torte weitaus komplizierter (als beim "Kreis") wäre. | |
| For i = -30 To 30 | |
| frmTorte.FillColor = RGB(52, 177, 58) | |
| 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 | |
Mehr Tipps: Konfetti-Grafikausgabe auf Formular
Sponsoren und Investoren sind jederzeit herzlich willkommen! Wenn Sie die Information(en) auf diesen Seiten interessant fanden, freuen wir uns über Ihren Förderbeitrag. Empfehlen Sie uns auch gerne in Ihren Netzwerken. Herzlichen Dank!
Nutzen Sie unsere Suchfunktion:
Nach oben
Sitemap
Impressum
Datenschutz
Hinweis: Diese Webseite kann Werbeanzeigen und Werbeeinblendungen oder eingebundene Links von Diensten und Inhalten Dritter enthalten. Beachten Sie dazu unsere Datenschutzerklärung.