View Single Post
 
Old 02-07-2017, 01:13 PM
mms mms is offline
Ultimate Contributor
 
Join Date: Jul 2002
Location: Hamilton, Ontario
Posts: 1,859
Default

Antialiasing is easy with GDI+ (one line of code)

Following is complete code for sample project.
Copy/Paste into your project and add 1 PictureBox and 2 CommandButtons

Form Code
Code:
Option Explicit


Dim stat As Long
Dim gdiplusToken As Long


Private Sub Form_Load()

    Form1.Caption = "GDI+"
    Form1.width = Screen.TwipsPerPixelX * 600
    Form1.height = Screen.TwipsPerPixelY * 465
    Form1.ScaleMode = vbPixels

    Picture1.Appearance = 0
    Picture1.Left = 20
    Picture1.Top = 20
    Picture1.height = Form1.ScaleHeight - Command1.height - 40 - 20
    Picture1.width = Form1.ScaleWidth - 40
    Picture1.AutoRedraw = True

    Command1.width = Picture1.width / 2 - 10
    Command1.height = 25
    Command1.Left = Picture1.Left
    Command1.Top = Picture1.Top + Picture1.height + 20
    Command1.Caption = "Draw Square && Circle"
    Command1.ZOrder (0)
    
    Command2.width = Picture1.width / 2 - 10
    Command1.height = 25
    Command2.Left = (Picture1.Left + Picture1.width) / 2 + 20
    Command2.Top = Picture1.Top + Picture1.height + 20
    Command2.Caption = "Draw Square && Circle (Antialiased)"
    Command2.ZOrder (0)

    ' Initialize Windows GDI+
    Dim GdiplusStartupInput As GdiplusStartupInput
    GdiplusStartupInput.GdiplusVersion = 1
    GdiplusStartupInput.DebugEventCallback = 0
    GdiplusStartupInput.SuppressBackgroundThread = False
    GdiplusStartupInput.SuppressExternalCodecs = False

    stat = GdiplusStartup(gdiplusToken, GdiplusStartupInput, 0)
    If stat <> Ok Then
        MsgBox "Error loading GDI+!", vbCritical
        Call GdiplusShutdown(gdiplusToken)
    End If

End Sub


Private Sub Form_Unload(Cancel As Integer)
    
    ' Clean up resources used by Windows GDI+
    Call GdiplusShutdown(gdiplusToken)
    
End Sub


Private Sub Command1_Click()

    Picture1.Cls

    Dim graphics As Long
    stat = GdipCreateFromHDC(Picture1.hdc, graphics)


    Dim redPen As Long
    stat = GdipCreatePen1(&HFFFF0000, 1, UnitPixel, redPen)

    stat = GdipDrawRectangle(graphics, redPen, 20, 70, 50, 50)
    stat = GdipDrawEllipse(graphics, redPen, 90, 70, 50, 50)

    ' Cleanup
    stat = GdipDeletePen(redPen)
    stat = GdipDeleteGraphics(graphics)
    
    Picture1.Refresh
    
End Sub


Private Sub Command2_Click()

    Picture1.Cls

    Dim graphics As Long
    stat = GdipCreateFromHDC(Picture1.hdc, graphics)
    stat = GdipSetSmoothingMode(graphics, SmoothingModeHighQuality)

    Dim redPen As Long
    stat = GdipCreatePen1(&HFFFF0000, 1, UnitPixel, redPen)

    stat = GdipDrawRectangle(graphics, redPen, 220, 70, 50, 50)
    stat = GdipDrawEllipse(graphics, redPen, 290, 70, 50, 50)

    ' Cleanup
    stat = GdipDeletePen(redPen)
    stat = GdipDeleteGraphics(graphics)
    
    Picture1.Refresh
    
End Sub
Module Code
Code:
Option Explicit


'-----------------------------------------------
' GDI+ Structs/Types
'-----------------------------------------------

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


'-----------------------------------------------
' GDI+ Enums
'-----------------------------------------------

Public Enum GpStatus
    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
End Enum

Public Enum GpUnit
    UnitWorld
    UnitDisplay
    UnitPixel
    UnitPoint
    UnitInch
    UnitDocument
    UnitMillimeter
End Enum

Public Enum QualityMode
    QualityModeInvalid = -1
    QualityModeDefault = 0
    QualityModeLow = 1
    QualityModeHigh = 2
End Enum

Public Enum SmoothingMode
    SmoothingModeInvalid = QualityModeInvalid
    SmoothingModeDefault = QualityModeDefault
    SmoothingModeHighSpeed = QualityModeLow
    SmoothingModeHighQuality = QualityModeHigh
    SmoothingModeNone
    SmoothingModeAntiAlias
End Enum


'-----------------------------------------------
' APIs
'-----------------------------------------------

Public Declare Function GdiplusStartup Lib "gdiplus" _
    (token As Long, inputbuf As GdiplusStartupInput, _
     Optional ByVal outputbuf As Long = 0) As GpStatus
Public Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal token As Long)

' Graphics Functions
Public Declare Function GdipCreateFromHDC Lib "gdiplus" _
    (ByVal hdc As Long, graphics As Long) As GpStatus
Public Declare Function GdipDeleteGraphics Lib "gdiplus" _
    (ByVal graphics As Long) As GpStatus
Public Declare Function GdipSetSmoothingMode Lib "gdiplus" _
    (ByVal graphics As Long, ByVal SmoothingMd As SmoothingMode) As GpStatus
Public Declare Function GdipDrawRectangle Lib "gdiplus" _
    (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 GpStatus
Public Declare Function GdipDrawEllipse Lib "gdiplus" _
    (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 GpStatus

' Pen Functions
Public Declare Function GdipCreatePen1 Lib "gdiplus" _
    (ByVal color As Long, ByVal width As Single, ByVal unit As GpUnit, pen As Long) As GpStatus
Public Declare Function GdipDeletePen Lib "gdiplus" _
    (ByVal pen As Long) As GpStatus

Last edited by mms; 02-07-2017 at 01:23 PM.
Reply With Quote