Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0799: Bestehende Region in beliebigem Winkel drehen

VB 5/6-Tipp 0799: Bestehende Region in beliebigem Winkel drehen

 von Zardoz

Schwierigkeitsgrad:

Verwendete API-Aufrufe: CombineRgn, CreateEllipticRgn, CreateRectRgn, DeleteObject, ExtCreateRegion, GetRegionData, GetRgnBox, OffsetRgn, PaintRgn

Download: Download des Beispielprojektes [3,59 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: Vertikale Scrollbar "VScroll1"
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Beschriftungsfeld "Label1"
Option Explicit

Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function PaintRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long

Private Const RGN_DIFF As Long = 4

Private SW As Single, SH As Single

Private Sub Form_Load()
  ' Einstellungen
  
  With Me
    .ScaleMode = vbPixels
    .Caption = "Bestehende Region in beliebigem Winkel drehen"
    .WindowState = vbMaximized
  End With
  
  With Picture1
    .ScaleMode = vbPixels
    .Move 4, 4, 500, 500
    SW = .ScaleWidth
    SH = .ScaleHeight
    .AutoRedraw = True
    .FillColor = RGB(255, 200, 0)
    .FillStyle = vbFSSolid
  End With
  
  With VScroll1
    .Move 4 + Picture1.Width, 4, 24, Picture1.Height
    .TabStop = False
    .Min = 0
    .Max = 360
    .LargeChange = 15
    .Value = 180
  End With
  
  With Label1
    .Left = VScroll1.Left + VScroll1.Width + 20
    .FontSize = 14
    .FontBold = True
    .AutoSize = True
  End With
  
  Call VScroll1_Scroll

End Sub

Private Sub VScroll1_Change()
  ' Event weiterreichen
  
  Call VScroll1_Scroll

End Sub

Private Sub VScroll1_Scroll()
  ' Region erzeugen und drehen
  
  Dim Rgn1 As Long, Rgn2 As Long, Winkel As Single
  Dim XM As Single, YM As Single
  Dim Rad1 As Single, Rad2 As Single
  
  With VScroll1
    Winkel = 360 - .Value
    Label1.Top = .Top + 16 + (.Height - 51) * .Value / .Max
  End With
  Label1.Caption = Winkel & " °"

  ' Grafik löschen
  Picture1.Line (0, 0)-(SW, SH), RGB(0, 0, 128), BF
  ' Region erstellen
  XM = SW / 2
  YM = SH / 2
  Rad1 = 180
  Rad2 = 75
  Rgn1 = CreateEllipticRgn(XM - Rad1, YM - Rad2, _
    XM + Rad1, YM + Rad2)
  Rgn2 = CreateRectRgn(XM + 90, YM - 25, XM + 120, YM + 25)
  Call CombineRgn(Rgn1, Rgn1, Rgn2, RGN_DIFF)
  ' Region drehen
  Call RotateRegion(Rgn1, Winkel)
  ' Region zeichnen
  Call PaintRgn(Picture1.hdc, Rgn1)
  ' Speicher aufräumen
  Call DeleteObject(Rgn1)
  Call DeleteObject(Rgn2)

End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------
' Bestehende Region in beliebigem Winkel drehen
' Copyright © 2011 by Zardoz

Option Explicit

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Type XFORM
  eM11 As Single
  eM12 As Single
  eM21 As Single
  eM22 As Single
  eDx As Single
  eDy As Single
End Type

Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function ExtCreateRegion Lib "gdi32" (lpXform As XFORM, ByVal nCount As Long, ByRef lpRgnData As Any) As Long
Private Declare Function GetRegionData Lib "gdi32" (ByVal hRgn As Long, ByVal dwCount As Long, ByRef lpRgnData As Any) As Long
Private Declare Function GetRgnBox Lib "gdi32" (ByVal hRgn As Long, lpRect As RECT) As Long
Private Declare Function OffsetRgn Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long

Private Const Pi As Single = 3.141593

Public Sub RotateRegion(Region As Long, ByVal Winkel As Single)
  
  Dim Wnk As Single, N As Long, R1 As RECT
  Dim Matrix As XFORM
  Dim Buffer() As Byte
  
  ' Winkel in Bogenmaß umrechnen
  Wnk = (2 - Winkel / 180) * Pi
  ' Regionkoordinaten holen
  Call GetRgnBox(Region, R1)
  ' Matrix belegen
  With Matrix
    .eM11 = Cos(Wnk)
    .eM12 = Sin(Wnk)
    .eM21 = -.eM12
    .eM22 = .eM11
    .eDx = (R1.Left + R1.Right + 1) / 2
    .eDy = (R1.Top + R1.Bottom + 1) / 2
    Call OffsetRgn(Region, -.eDx, -.eDy)
  End With
  ' Anzahl Bytes abfragen
  N = GetRegionData(Region, 0, ByVal 0)
  ' Array anlegen
  ReDim Buffer(N - 1)
  ' Regiondaten in Array einlesen
  Call GetRegionData(Region, N, Buffer(0))
  ' Alte Region löschen
  Call DeleteObject(Region)
  ' Neue Region erstellen
  Region = ExtCreateRegion(Matrix, N, Buffer(0))
  
End Sub
'---------- Ende Modul "Module1" alias Module1.bas ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------