Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0720: Gedrehte Ellipsen mit GDI+ zeichnen

 von 

Beschreibung 

Dieser Tipp zeigt verschiedene Möglichkeiten, eine gedrehte Ellipse mit GDI+ zu zeichnen. Die Ellipse wird dabei je nach Funktion unterschiedlich parametrisiert:

EllipseAxes: Muttelpunkt, Drehwinkel (Grad) sowie große und kleine Halbachse
EllipseRect: Rechteck (wie bei der üblichen Ellipse-API) und Drehwinkel.
EllipseFocuses: Brennpunkte und große Halbachse.

Schwierigkeitsgrad:

Schwierigkeitsgrad 1

Verwendete API-Aufrufe:

GdipCreateFromHDC, GdipCreateMatrix, GdipCreatePen1, GdipDeleteGraphics, GdipDeleteMatrix, GdipDeletePen, GdipDrawEllipse, GdipGraphicsClear, GdipRotateMatrix, GdipSetWorldTransform, GdipTranslateMatrix, GdiplusShutdown, GdiplusStartup

Download:

Download des Beispielprojektes [3,3 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 prjGedrehteEllipseMitGDIPlus.vbp ---
'--- Anfang Formular "frmGedrehteEllipseMitGDIPlus" alias frmGedrehteEllipseMitGDIPlus.frm  ---
Option Explicit

' Global:
Private Declare Function GdiplusStartup Lib "gdiplus.dll" ( _
                         ByRef token As Long, _
                         ByRef inputX As GdiplusStartupInput, _
                         ByVal Output As Long) As Status
                         
Private Declare Sub GdiplusShutdown Lib "gdiplus.dll" ( _
                    ByVal token As Long)
                    
' Graphics:
Private Declare Function GdipCreateFromHDC Lib "gdiplus.dll" ( _
                         ByVal hdc As Long, _
                         ByRef graphics As Long) As Status
                         
Private Declare Function GdipDeleteGraphics Lib "gdiplus.dll" ( _
                         ByVal graphics As Long) As Status
                         
Private Declare Function GdipGraphicsClear Lib "gdiplus.dll" ( _
                         ByVal graphics As Long, _
                         ByVal color As Long) As Status
                         
Private Declare Function GdipSetWorldTransform Lib "gdiplus.dll" ( _
                         ByVal graphics As Long, _
                         ByVal Matrix As Long) As Status
                         
Private Declare Function GdipDrawEllipse Lib "gdiplus.dll" ( _
                         ByVal graphics As Long, _
                         ByVal Pen As Long, _
                         ByVal X As Single, _
                         ByVal Y As Single, _
                         ByVal Width As Single, _
                         ByVal Height As Single) As Status
                         
' Pens:
Private Declare Function GdipCreatePen1 Lib "gdiplus.dll" ( _
                         ByVal color As Long, _
                         ByVal Width As Single, _
                         ByVal Unit As Unit, _
                         ByRef Pen As Long) As Status
                         
Private Declare Function GdipDeletePen Lib "gdiplus.dll" ( _
                         ByVal Pen As Long) As Status
                         
' Matrices:
Private Declare Function GdipCreateMatrix Lib "gdiplus.dll" ( _
                         ByRef Matrix As Long) As Status
                         
Private Declare Function GdipDeleteMatrix Lib "gdiplus.dll" ( _
                         ByVal Matrix As Long) As Status
                         
Private Declare Function GdipTranslateMatrix Lib "gdiplus.dll" ( _
                         ByVal Matrix As Long, _
                         ByVal offsetX As Single, _
                         ByVal offsetY As Single, _
                         ByVal order As MatrixOrder) As Status
                         
Private Declare Function GdipRotateMatrix Lib "gdiplus.dll" ( _
                         ByVal Matrix As Long, _
                         ByVal angle As Single, _
                         ByVal order As MatrixOrder) As Status
                         
Private Enum Status
    Ok = 0
    GenericError = 1
    InvalidParameter = 2
    OutOfMemory = 3
    ObjectBusy = 4
    InsufficientBuffer = 5
    NotImplemented = 6
    Win32Error = 7
    WrongState = 8
    Aborted = 9
    FileNotFound = 10
    ValueOverflow = 11
    AccessDenied = 12
    UnknownImageFormat = 13
    FontFamilyNotFound = 14
    FontStyleNotFound = 15
    NotTrueTypeFont = 16
    UnsupportedGdiplusVersion = 17
    GdiplusNotInitialized = 18
    PropertyNotFound = 19
    PropertyNotSupported = 20
    ProfileNotFound = 21
End Enum

Private Enum Unit
    UnitWorld = 0
    UnitDisplay = 1
    UnitPixel = 2
    UnitPoint = 3
    UnitInch = 4
    UnitDocument = 5
    UnitMillimeter = 6
End Enum

Private Enum MatrixOrder
    MatrixOrderPrepend = 0
    MatrixOrderAppend = 1
End Enum

Private Type GdiplusStartupInput
    GdiplusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End Type

Private Type PointF
    X As Single
    Y As Single
End Type

Private Type SizeF
    Width As Single
    Height As Single
End Type

Private Type RectF
    X As Single
    Y As Single
    Width As Single
    Height As Single
End Type

' Mathematical constants:
Private Const mPi As Double = 3.14159265358979
Private Const mDegree As Double = 180 / mPi

' ARGB colors:
Private Const mBlue As Long = &HFF0000FF
Private Const mGreen As Long = &HCC00FF00
Private Const mRed As Long = &H99FF0000
Private mInstance As Long
Private mGraphics As Long

Private Sub EllipseAxes(ByVal Pen As Long, ByRef Center As PointF, ByVal a _
    As Single, ByVal b As Single, Optional ByVal Rotation As Single = 0)
    
    Dim Matrix As Long
    
    GdipCreateMatrix Matrix
    GdipTranslateMatrix Matrix, Center.X, Center.Y, MatrixOrderPrepend
    GdipRotateMatrix Matrix, Rotation, MatrixOrderPrepend
    GdipSetWorldTransform mGraphics, Matrix
    GdipDrawEllipse mGraphics, Pen, -a, -b, 2 * a, 2 * b
    GdipDeleteMatrix Matrix
    
End Sub

Private Sub EllipseRect(ByVal Pen As Long, ByRef Rectangle As RectF, _
    Optional ByVal Rotation As Single = 0)
    
    Dim HalfSize As SizeF
    Dim Center As PointF
    
    HalfSize.Width = Rectangle.Width / 2
    HalfSize.Height = Rectangle.Height / 2
    Center.X = Rectangle.X + HalfSize.Width
    Center.Y = Rectangle.Y + HalfSize.Height
    EllipseAxes Pen, Center, HalfSize.Width, HalfSize.Height, Rotation
End Sub

Private Sub EllipseFocuses(ByVal Pen As Long, ByRef F1 As PointF, ByRef F2 _
    As PointF, ByVal a As Single)
    
    Dim Distance As PointF
    Dim e As Single
    Dim b As Single
    Dim Center As PointF
    Dim Rotation As Single
    
    With Distance
    
        .X = F2.X - F1.X
        .Y = F2.Y - F1.Y
        e = Sqr((.X * .X) + (.Y * .Y)) / 2
        
    End With
    
    If e > a Then Exit Sub
    
    b = Sqr((a * a) - (e * e))
    Center.X = F1.X + (Distance.X / 2)
    Center.Y = F1.Y + (Distance.Y / 2)
    
    If e Then Rotation = ArcSin(Distance.Y / (2 * e)) * mDegree
    
    EllipseAxes Pen, Center, a, b, Rotation
End Sub

Private Function ArcSin(ByVal X As Single) As Single
    Select Case X
    Case 1
        ArcSin = mPi / 2
    Case -1
        ArcSin = (3 * mPi) / 2
    Case Else
        ArcSin = Atn(X / Sqr(1 - (X * X)))
    End Select
End Function

Private Sub Form_Load()
    Dim Data As GdiplusStartupInput
    
    Data.GdiplusVersion = 1
    
    If GdiplusStartup(mInstance, Data, 0) Then
        MsgBox "GDI+ could not be initialized", vbCritical
        Exit Sub
    End If
End Sub

Private Sub Form_Paint()
    Dim Pen As Long
    Dim Rectangle As RectF
    Dim Center As PointF
    Dim F1 As PointF
    Dim F2 As PointF
    
    GdipCreatePen1 mBlue, 5, UnitPixel, Pen
    Center.X = 200
    Center.Y = 300
    EllipseAxes Pen, Center, 200, 160, -40
    GdipDeletePen Pen
    GdipCreatePen1 mGreen, 10, UnitPixel, Pen
    Rectangle.X = 100
    Rectangle.Y = 100
    Rectangle.Width = 400
    Rectangle.Height = 250
    EllipseRect Pen, Rectangle, 80
    GdipDeletePen Pen
    GdipCreatePen1 mRed, 15, UnitPixel, Pen
    F1.X = 100
    F1.Y = 20
    F2.X = 300
    F2.Y = 300
    EllipseFocuses Pen, F1, F2, 180
    GdipDeletePen Pen
End Sub

Private Sub Form_Resize()
    If GdipCreateFromHDC(Me.hdc, mGraphics) Then
        MsgBox "Graphics object could not be created", vbCritical
        Exit Sub
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If mGraphics Then
        If GdipDeleteGraphics(mGraphics) Then MsgBox "Graphics object " & _
            "could not be deleted", vbCritical
            
    End If
    
    GdiplusShutdown mInstance
End Sub


'--- Ende Formular "frmGedrehteEllipseMitGDIPlus" alias frmGedrehteEllipseMitGDIPlus.frm  ---
'---- Ende Projektdatei prjGedrehteEllipseMitGDIPlus.vbp ----

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.