Tipp 0534 Sinuskurven zeichnen
Autor/Einsender:
Datum:
  Detlev Schubert
14.07.2007
Entwicklungsumgebung:   VB 6
Sinuskurven darzustellen gehört mit zu den Grundlagen der Programmierung. Mit wenigen Zeilen Code lassen sich diese Wellenlinien zeichnen und grafisch darstellen. Mit wenigen Handgriffen lässt sich dieser Tipp beispielsweise für die Darstellung des Biorhythmus umbauen.
Ein weiterer kleiner Nebeneffekt, der Tipp zeigt auch noch, wie sich mit nur einer Codezeile die Zahl Pi darstellen lässt.
 
Sub Skala(Ziel As Object)
  Dim Breite As Integer
  Dim Mitte As Integer
  Dim MaxH As Integer
  Dim m As Integer, x As Integer
  Dim H As Integer, F As Integer
  Dim Y As Integer, XX As Integer

  Breite = CInt(Ziel.ScaleWidth)
  Mitte = CInt(Ziel.ScaleHeight \ 2)
  MaxH = Mitte - 10
  Ziel.DrawWidth = 1
  For m = 0 To Breite \ 10
    x = m * 10
    H = 20
    F = 12
    Y = Mitte - 10
    If (x / 10 Mod 10 = 0) And x <= Breite Then
      H = 30
      F = 1
      Y = Mitte - 15

      Ziel.CurrentY = Y - Ziel.TextHeight(x \ 10)
      XX = x - (Ziel.TextWidth(x \ 10)) / 2
      If XX < 0 Then XX = 0

      Ziel.CurrentX = XX
      Ziel.ForeColor = 0
      Ziel.Print x \ 10
    End If
    Ziel.Line (x, Y)-Step(0, H), QBColor(F)
  Next
  Ziel.PSet (0, Mitte)
  Ziel.Line -Step(Breite * 10, 0), QBColor(0)
End Sub

Sub Sinuskurve(Ziel As Object, Optional Anfg As Integer = 0, _
    Optional Abst As Integer = 10, Optional Farbe As Long = 0)
  Dim Pi As Double
  Dim Wf As Double

  Dim x As Integer
  Dim m As Double
  Dim Breite As Integer
  Dim Mitte As Integer
  Dim MaxH As Integer

  Pi = 4 * Atn(1)

  Wf = (Pi / Abst) * 2
  Breite = CInt(Ziel.ScaleWidth)
  Mitte = CInt(Ziel.ScaleHeight \ 2)
  MaxH = Mitte - 10

  Ziel.ForeColor = QBColor(Farbe)
  Ziel.PSet (0, Mitte)
  Ziel.DrawWidth = 1

  For m = 0 To Breite
    x = m * 10
    Ziel.Line -(Anfg + x, Mitte - MaxH * (Sin(Wf * _
         (((m) Mod (Abst))))))
  Next

End Sub

Private Sub Form_Load()
  HScroll1_Change 0
End Sub

Private Sub HScroll1_Change(Index As Integer)
  Label1(Index) = HScroll1(Index).Value
  Picture1.Cls
  Sinuskurve Picture1, , Val(Label1(0)), 9
  Sinuskurve Picture1, , Val(Label1(1)), 12
  Sinuskurve Picture1, , Val(Label1(2)), 2
  Skala Picture1
End Sub

Private Sub HScroll1_Scroll(Index As Integer)
  Label1(Index) = HScroll1(Index).Value
End Sub
 
Weitere Links zum Thema
Kreise und Linien zeichnen

Windows-Version
95
98
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (3,2 kB) Downloads bisher: [ 419 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Samstag, 16. Juli 2011