| |
Visual-Basic EinsteigerSinuskurve 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 | |
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
| |
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 | |
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.
| |
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 | |
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 | |
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 | |
| 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 |
|
|
TOP! Unser Nr. 1
Neu! sevDataGrid 3.0
Mehrspaltige Listen, mit oder ohne DB-Anbindung. Autom. Sortierung, Editieren von Spalteninhalten oder das interaktive Hinzufügen von Datenzeilen sind ebenso möglich wie das Erstellen eines Web-Reports. Weitere InfosTipp des Monats TOP Entwickler-Paket
TOP-Preis!!
Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR...
Jetzt nur 599,00 EURWeitere Infos
|