Graphikprogrammierung


Darstellung von Vektoren

Bildbeispiel, zur Erzeugung diese Bildes war der Cls-Befehl (siehe unten) deaktiviert
 
Option Explicit
Dim x!, y!, alf! '! ist Kennung für Typ Single
Const Pi = 3.141592654

Private Sub Form_Load()
   Randomize                 'Zufallsgenerator starten
   Form1.Width = Form1.Height 'Bildfeld quadratisch machen
   Scale (-5, 5)-(5, -5)     'Skalieren
End Sub


Private Sub Command1_Click()  'erzeugt einen Zufalls-Vektor
   Cls
   Koordinatensystem         'Anlage der Achsen
   x = Rnd * 6 - 3           'Variablenbereich
   y = Rnd * 6 - 3           '-3 bis +3
   Pfeil x, y, QBColor(6)     'Aufruf eines Unterprogramms mit Parametern
End Sub


Private Sub Koordinatensystem()
   Dim i%
   Line (0, -5)-(0, 5)       'y-Achse
   For i = -4 To 4
      Line (0, i)-(0.1, i)
      CurrentX = 0.2
      CurrentY = i + 0.1
      If i <> 0 Then Print i
   Next
   Line (-5, 0)-(5, 0)       'x-Achse
   For i = -4 To 4
      Line (i, 0)-(i, 0.1)
      CurrentX = i - 0.1
      CurrentY = 0.5
      If i <> 0 Then Print i
   Next
End Sub


Sub Pfeil(x!, y!, a As Long)
   Dim wi1!, wi2!, alf!
   DrawWidth = 2             'Pfeilschaft
   Line (0, 0)-(x, y), a
   DrawWidth = 1
   alf = Atn(y / x)          'Pfeilspitze, Winkelberechnung
   If x > 0 And y > 0 Then
      wi1 = alf + Pi - 0.3
      wi2 = alf + Pi + 0.3
   ElseIf x < 0 And y > 0 Then
      wi1 = 2 * Pi + alf - 0.3
      wi2 = 2 * Pi + alf + 0.3
   ElseIf x < 0 And y < 0 Then
      wi1 = alf - 0.3
      wi2 = alf + 0.3
   ElseIf x > 0 And y < 0 Then
      wi1 = alf + Pi - 0.3
      wi2 = alf + Pi + 0.3
   End If
   If wi1 > 2 * Pi Then wi1 = wi1 - 2 * Pi
   If wi2 > 2 * Pi Then wi2 = wi2 - 2 * Pi
   If wi1 < 0 Then wi1 = wi1 + 2 * Pi
   If wi2 < 0 Then wi2 = wi2 + 2 * Pi
   FillStyle = 0 : FillColor = a
   Circle (x, y), 0.5, a, -Abs(wi1), -Abs(wi2) 'Pfeilspitze malen
End Sub 


Kurbeltrieb

Auf dem Formular werden außer CommandButton1 ("Start") und CommandButton2 ("Stop") die zwei Shapes: Shape1 als gefülltes Rechteck als Kolben, Shape2, gefüllter Kreis als Kolbenbolzen angeordnet. Bei der Scale-Methode ist zu beachten, daß der Maßstab des Malhintergrundes (hier des Formulars) in x- und y-Richtung etwa gleich sein muß, damit nicht aus Kreisen Ellipsen werden.
 
Option Explicit
Dim t, r, lang, xv, yv, xn, i, j, xm   'alle Typ Variant
Dim Schluß

Private Sub Command1_Click()
   Schluß = False
   Scale (0, 4)-(12, -4)              'Bildfeld einrichten
   DrawWidth = 5
   xm = 3                             'y=0 Kurbeldaten
   r = 2
   lang = 5
   xv = xm + r                        'Startwerte oberer Totpunkt
   yv = 0
   xn = xv + Sqr(lang ^ 2 - yv ^ 2)
   Shape2.Move xn - 1, 1, 2, 2
   Shape1.Move xn - 0.15, 0.3
   Do
      t = t + 0.05                    'Zeitschritt
      If t = 6.28 Then t = 0
      Line (xv, yv)-(xn, 0), BackColor 'löschen
      Line (xm, 0)-(xv, yv), BackColor
      xv = xm + r * Cos(t)            'neue Position
      yv = r * Sin(t)
      xn = xv + Sqr(lang ^ 2 + yv ^ 2)
      Line (xv, yv)-(xn, 0), ForeColor 'neu malen
      Line (xm, 0)-(xv, yv), ForeColor
      Shape2.Move xn - 1, 1
      Shape1.Move xn - 0.15, 0.3
      For i = 1 To 1000               'Warteschleife
         j = Sin(i)
      Next
      DoEvents                        'Überwache Schlußtaste
   Loop Until Schluß                  'bei Schluß aufhören!
End Sub


Private Sub Command2_Click()
   Schluß = True
End Sub


Turm von Hanoi

Aufgabe: Sage, vermutlich von Programmierspielmätzen erfunden: Ein Turm aus 365 Diamantscheiben unterschiedlichen Durchmessers soll in Hanoi von buddhistischen Mönchen umgestapelt werden. Dabei darf immer genau eine Scheibe bewegt werden; es dürfen immer nur kleinere Scheiben auf größeren liegen. Außer dem Startplatz ist der Zielort gegeben und ein Hilfsort erlaubt. Die Welt soll solange bestehen, bis sie fertig sind. Die Arbeitszeit verdoppelt sich mit jeder zusätzlichen Scheibe.

Es folgt nur der Grundalgorithmus, im Originalprogramm werden die Ausführungszeiten für Scheiben, die mit der Line-Methode gemalt (und wieder gelöscht) werden, für Shapes, und zwei GDI-Routinen verglichen:
 
'Deklarationsteil
Dim Anzahl As Integer

'Rekursiv aufzurufende Sub
Private Sub Schiebe(Zahl As Integer, Ort1 As Integer, Ort2 As Integer, Ort3 As Integer)
   If Zahl = 1 Then
      Male Ort1, Ort2 'male Verschiebung von Ort1 nach Ort2
   Else
      Schiebe(Zahl-1,Ort1,Ort3, Ort2) 'Turm mit einer Scheibe weniger behandeln:
      Male Ort1, Ort2 von 1 nach 2,
      Schiebe(Zahl-1,Ort3, Ort2, Ort1) von 3 nach 1
   EndIf
End Sub


Private Sub Male (Ort1 As Integer, Ort 2 As Integer)
   'Verschiebung eines Ringes von oberster Position der Säule Ort1 zur Säule Ort2, bitte selbst erfinden!
End Sub


Sub Main()
   'Zahl der Ringe erfragen: Anzahl erhält einen Wert
   'Turm in Ausgangsposition (Ort1) malen
   Schiebe Anzahl, 1, 2, 3     'erster Aufruf, weitere löst Sub Schiebe selbst aus
End Sub 

Formentwurf: (Beispiel zum Vergleich unterschiedlicher Grafikroutinen) zeigt eine Pyramide in Endstellung