auxmoney - Geld leihen für das Studiumauxmoney - Geld leihen für das Studium

auxmoney - Geld leihen für den Umzugauxmoney - Geld leihen für den Umzug

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: 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

Mehr Tipps: Konfetti-Grafikausgabe auf Formular

Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt