Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0442: Punkte eines Array rotieren

VB 5/6-Tipp 0442: Punkte eines Array rotieren

 von Michael Gieser

Schwierigkeitsgrad:

Verwendete API-Aufrufe: Polygon

Download: Download des Beispielprojektes [2,25 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Horizontale Scrollbar "hscAng"
' Steuerelement: Beschriftungsfeld "lblCap2"
' Steuerelement: Beschriftungsfeld "lblCasp"
Private Declare Function Polygon Lib "gdi32" ( _
    ByVal hdc As Long, lpPoint As PointAPI, _
    ByVal nCount As Long) As Long

Private Const Pi As Double = 3.14159265358979

Private Type PointAPI
  X As Long
  Y As Long
End Type

Private Sub Form_Load()
    hscAng_Change
End Sub

Private Sub hscAng_Change()
    Dim VBVek() As PointAPI
    Dim Mitte As PointAPI
    
    Mitte.X = Me.ScaleWidth / 2
    Mitte.Y = Me.ScaleHeight / 2
    
    'Pfeil
    ReDim VBVek(8) As PointAPI
    VBVek(0).X = Mitte.X + 40
    VBVek(0).Y = Mitte.Y + 2
    VBVek(1).X = Mitte.X - 21
    VBVek(1).Y = Mitte.Y + 2
    VBVek(2).X = Mitte.X
    VBVek(2).Y = Mitte.Y + 30
    VBVek(3).X = Mitte.X - 5
    VBVek(3).Y = Mitte.Y + 30
    VBVek(4).X = Mitte.X - 30
    VBVek(4).Y = Mitte.Y
    VBVek(5).X = Mitte.X - 5
    VBVek(5).Y = Mitte.Y - 30
    VBVek(6).X = Mitte.X
    VBVek(6).Y = Mitte.Y - 30
    VBVek(7).X = Mitte.X - 21
    VBVek(7).Y = Mitte.Y - 2
    VBVek(8).X = Mitte.X + 40
    VBVek(8).Y = Mitte.Y - 2
    'puuhhh  ;)
    
    RotPunkte VBVek(), VBVek(), Mitte, hscAng.Value
    
    Me.Cls
    Polygon Me.hdc, VBVek(0), UBound(VBVek) + 1
    
    'Zahlen
    For I = 0 To UBound(VBVek)
      Me.CurrentX = VBVek(I).X - 2
      Me.CurrentY = VBVek(I).Y - 3
      Me.ForeColor = vbYellow
      Me.Print I
      Me.ForeColor = &H404000
    Next I
End Sub

Private Sub hscAng_Scroll()
    hscAng_Change
End Sub

'Der eigentliche Sub
Private Sub RotPunkte(Punkte() As PointAPI, _
    ZielPunkte() As PointAPI, MittelPunkt As PointAPI, _
    ByVal Winkel As Single)

    Dim I As Integer, tmpRadWinkel As Single
    Dim tmpVX As Single, tmpVY As Single
    
    tmpRadWinkel = Winkel * (Pi / 180)
    For I = 0 To UBound(Punkte)
      tmpVX = Punkte(I).X - MittelPunkt.X
      tmpVY = Punkte(I).Y - MittelPunkt.Y
      ZielPunkte(I).X = Int(MittelPunkt.X + tmpVX * Cos(tmpRadWinkel) + tmpVY * Sin(tmpRadWinkel))
      ZielPunkte(I).Y = Int(MittelPunkt.Y - tmpVX * Sin(tmpRadWinkel) + tmpVY * Cos(tmpRadWinkel))
    Next I
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------