vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
vb@rchiv Offline-Reader - exklusiv auf der vb@rchiv CD Vol.4  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück

 Sie sind aktuell nicht angemeldet.Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Visual-Basic Einsteiger
Sinuskurve drehen 
Autor: FrankVB
Datum: 29.08.15 08:43

Hallo Gemeinde,

ich blicke es einfach nicht...

Ich zeichne Linien z.B. von Punkt 150/150 nach 425/440 - das ist ja kein Problem.
Mit dem folgenden Code bekomme ich auch eine Sinus-Kurve hin, die von X=150 bis X=440 geht.
Nun soll die Sinuskurve aber genau so verlaufen wie die Linie und hier breche ich mir die Finger.

Private Sub DrawSinus(ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, _
  ByVal y2 As Long, _
                      intFrequence As Integer, lngAmplitude As Long)
    Const Pi As Long = 3.141592654
    Dim i               As Long
    Dim x               As Long
    Dim y               As Long
 
    For i = x1 To x2
        x = i
        If i = x1 Then
            y = y1
            picPaint.Line (x, lngAmplitude \ 2)-(x, y + lngAmplitude / 2)
        Else
            y = Sin(i / x2 * 360 * intFrequence * Pi / 180) * (lngAmplitude \ 2 _
              - 6)
            picPaint.Line -(x, y + lngAmplitude / 2)
        End If
    Next i
End Sub
Meine Frage ist also: Wie dreht man bei bekannten Anfangs- und Endpunkt eine Sinuskurve?
Kann mir hier jemand auf die Sprünge helfen?

besten Dank schon jetzt für Eure Hilfe,
Viele Grüße,
Frank
Themenbaum einblendenGesamtübersicht  |  Zum Thema  |  Suchen

Re: Sinuskurve drehen 
Autor: Manfred X
Datum: 29.08.15 09:51

Hallo!

Du kannst die X,Y Punkte der Sinuskurve durch eine
Rotationsmatrix umrechnen. Dafür benötigst Du den
Zentralpunkt der Drehung und die
Drehwinkel, die den Anfangs-/Endpunkten der Linie entsprechen.
https://en.wikipedia.org/wiki/Rotation_matrix





Themenbaum einblendenGesamtübersicht  |  Zum Thema  |  Suchen

Re: Sinuskurve drehen 
Autor: FrankVB
Datum: 29.08.15 13:25

Hallo Manfred,

besten Dank für die schnelle Antwort und den Link.

Matrizenrechnen war noch nie meine Stärke und sowas in vb realisieren - ich befürchte, das übersteigt meinen Horizont.

Ein Code-Schnipsel wäre daher ein Ausweg...

Danke schon jezt,
Frank
Themenbaum einblendenGesamtübersicht  |  Zum Thema  |  Suchen

Re: Sinuskurve drehen 
Autor: Manfred X
Datum: 30.08.15 10:56


Der einfachste Weg, um eine Drehung durchzuführen ist wohl:
1. Setze die Scale-Werte der Picturebox so, daß der Drehmittelpunkt
zum Nullpunkt des Koordinatensystems wird.
2. Bestimme den Drehwinkel über die ATN-Funktion aus dem Quotienten
der Y-AchsenLänge und X-AchsenLänge der Linie.
3. Ermittle Deine zu zeichnenden Punkte unrotiert gemäß den Scale-Koordinaten
der Picturebox.
4. Rechne die X,Y-Position jedes zu zeichnenden Punktes über die im obigen Link
vorfindlichen beiden 2D-Rotationsformeln gemäß Drehwinkel um und zeichne.




Themenbaum einblendenGesamtübersicht  |  Zum Thema  |  Suchen

Re: Sinuskurve drehen 
Autor: Zardoz
Datum: 30.08.15 17:32

Hallo Frank,
probier' mal das:
Controls: Picturebox
' © 2015 by Zardoz
 
Private Type XFORM
  eM11 As Single
  eM12 As Single
  eM21 As Single
  eM22 As Single
  eDx As Single
  eDy As Single
End Type
 
Private Declare Function GetWorldTransform Lib "gdi32" (ByVal hdc As Long, _
  lpXform As XFORM) As Long
Private Declare Function SetGraphicsMode Lib "gdi32" (ByVal hdc As Long, ByVal _
iMode As Long) As Long
Private Declare Function SetWorldTransform Lib "gdi32" (ByVal hdc As Long, _
lpXform As XFORM) As Long
 
Private Const GM_ADVANCED = 2
Private Const GM_COMPATIBLE = 1
 
Private Const Pi As Single = 3.141593
 
Private Sub Form_Activate()
 
  Dim x1!, y1!, x2!, y2!, Amplitude!, Frequence%
 
  Me.ScaleMode = vbPixels
  Me.WindowState = vbMaximized
  DoEvents
  With Picture1
    .ScaleMode = vbPixels
    .Move 0, 0, 1000, 700
    .BackColor = vbBlack
    .AutoRedraw = True
  End With
 
  x1 = 50
  y1 = 600
  x2 = 700
  y2 = 100
  Amplitude = 220
  Frequence = 3
  Call DrawSinus(x1, y1, x2, y2, Frequence, Amplitude)
 
End Sub
 
Private Sub DrawSinus(ByVal x1 As Single, ByVal y1 As Single, _
  ByVal x2 As Single, ByVal y2 As Single, _
  ByVal Frequence As Single, ByVal Amplitude As Single)
 
  Dim XP!, YP!, Wnk!, DX!, DY!, S!
  Dim OldMatrix As XFORM
  Dim NewMatrix As XFORM
 
  DX = x2 - x1
  DY = y2 - y1
  Wnk = AtnExt(DX, DY)
  S = Sqr(DX * DX + DY * DY)
 
  With NewMatrix
    .eM11 = Cos(Wnk)
    .eM12 = Sin(Wnk)
    .eM21 = -.eM12
    .eM22 = .eM11
    .eDx = x1
    .eDy = y1
  End With
 
  With Picture1
    Call GetWorldTransform(.hdc, OldMatrix)
    Call SetGraphicsMode(.hdc, GM_ADVANCED)
    Call SetWorldTransform(.hdc, NewMatrix)
 
    .CurrentX = 0
    .CurrentY = 0
 
    For XP = 0 To S - 1
 
      Wnk = XP / S * 2 * Pi * Frequence
      YP = -Amplitude / 2 * Sin(Wnk)
      Picture1.Line -(XP, YP), vbWhite
 
    Next XP
 
    Call SetWorldTransform(.hdc, OldMatrix)
    Call SetGraphicsMode(.hdc, GM_COMPATIBLE)
  End With
 
End Sub
 
Private Function AtnExt(ByVal DX As Single, ByVal DY As Single) As Single
  ' erweiterte Atn-Funktion
 
  Dim Wnk!, ArcTan!
 
  If DX = 0 Then
    ArcTan = 0
  Else
    ArcTan = Atn(Abs(DY / DX))
  End If
 
  If DX = 0 Then
    If DY = 0 Then
      Wnk = 0
    ElseIf DY > 0 Then
      Wnk = Pi / 2
    Else
      Wnk = 3 * Pi / 2
    End If
  ElseIf DX > 0 Then
    If DY < 0 Then
      Wnk = 2 * Pi - ArcTan
    Else
      Wnk = ArcTan
    End If
  Else
    If DY < 0 Then
      Wnk = ArcTan + Pi
    Else
      Wnk = Pi - ArcTan
    End If
  End If
  AtnExt = Wnk
 
End Function

Gruss,

Zardoz

Themenbaum einblendenGesamtübersicht  |  Zum Thema  |  Suchen

Re: Sinuskurve drehen 
Autor: FrankVB
Datum: 31.08.15 23:27

Hallo Zardoz,

vielen Dank für das Beispiel.

Kann es erst ab Donnerstag ausprobioeren, bin hier aber guter Hoffnung ;o))

Ich mlede mich noch mal, wenn ich soweit bin.

Bis dahin: D A N K E S C H Ö N ! ! !

Frank
Themenbaum einblendenGesamtübersicht  |  Zum Thema  |  Suchen

Re: Sinuskurve drehen 
Autor: FrankVB
Datum: 04.09.15 17:05

Hallo Zardoz,

so, habe den Code getestet, Spitze, das Drehen funktioniert einwandfrei.

Vielen lieben Dank,
Frank
Themenbaum einblendenGesamtübersicht  |  Zum Thema  |  Suchen

Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.

Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  GesamtübersichtSuchen 

nach obenzurück
 
   

Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel