Salve, premetto che non sono assolutamente esperto in GDI+ e che uso routine fornite da programmatori molto più bravi di me.
Tempo fa ho trovato un piccolo modulo (che allego) che consente di tracciare le linee con uno smoothing veramente ottimo (Public Function GDIPlusDrawLineToDC).
Vorrei saperre se è possibile implementare a questo codice anche la funzione setROP2 che (per quanto ne so) dovrebbe funzionare come il Drawmode di VB6. In pratica ho bisogno di evidenziare con un colore diverso il punto di incrocio fra due righe.
Ringrazio tutti per l'attenzione.
Dario Barbieri
codice del modulo:
Option Explicit
'GDI+ startup object
Public Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
'GDI+ supports a variety of measurement units, but it's generally advisable to stick to pixels
Public Enum GpUnit
UnitWorld = 0
UnitDisplay = 1
UnitPixel = 2
UnitPoint = 3
UnitInch = 4
UnitDocument = 5
UnitMillimeter = 6
End Enum
#If False Then
Const UnitWorld = 0, UnitDisplay = 1, UnitPixel = 2, UnitPoint = 3, UnitInch = 4, UnitDocument = 5, UnitMillimeter = 6
#End If
'GDI+ supports alpha, so we cannot use VB's internal RGB() function; instead, we must use RGBQUADs
Public Type RGBQUAD
Blue As Byte
Green As Byte
Red As Byte
Alpha As Byte
End Type
'GDI+ supports various quality mode constants for many functions
Public Enum QualityMode
QualityModeInvalid = -1
QualityModeDefault = 0
QualityModeLow = 1 'Best performance
QualityModeHigh = 2 'Best rendering quality
End Enum
'Additionally, some functions support more detailed smoothing modes as well. Note that these wrap the generic QualityMode above
' for some values.
Public Enum SmoothingMode
SmoothingModeInvalid = QualityModeInvalid
SmoothingModeDefault = QualityModeDefault
SmoothingModeHighSpeed = QualityModeLow
SmoothingModeHighQuality = QualityModeHigh
SmoothingModeNone = 3
SmoothingModeAntiAlias = 4
End Enum
'GDI+ supports a variety of different linecaps. Anchor caps will center the cap at the end of the line.
Public Enum LineCap
LineCapFlat = 0
LineCapSquare = 1
LineCapRound = 2
LineCapTriangle = 3
LineCapNoAnchor = &H10
LineCapSquareAnchor = &H11
LineCapRoundAnchor = &H12
LineCapDiamondAnchor = &H13
LineCapArrowAnchor = &H14
LineCapCustom = &HFF
LineCapAnchorMask = &HF0
End Enum
#If False Then
Const LineCapFlat = 0, LineCapSquare = 1, LineCapRound = 2, LineCapTriangle = 3, LineCapNoAnchor = &H10, LineCapSquareAnchor = &H11
Const LineCapRoundAnchor = &H12, LineCapDiamondAnchor = &H13, LineCapArrowAnchor = &H14, LineCapCustom = &HFF, LineCapAnchorMask = &HF0
#End If
'The dash cap type has its own enumeration
Public Enum DashCap
DashCapFlat = 0
DashCapRound = 2
DashCapTriangle = 3
End Enum
#If False Then
Const DashCapFlat = 0, DashCapRound = 2, DashCapTriangle = 3
#End If
'Start-up and shutdown
Public Declare Function GdiplusStartup Lib "gdiplus" (ByRef token As Long, ByRef inputbuf As GdiplusStartupInput, Optional ByVal OutputBuffer As Long = 0&) As Long
Public Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
'Create and delete GDI+ graphics objects
Public Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, ByRef mGraphics As Long) As Long
Public Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal mGraphics As Long) As Long
'Assign various properties to a GDI+ graphics object
Public Declare Function GdipSetSmoothingMode Lib "gdiplus" (ByVal mGraphics As Long, ByVal mSmoothingMode As SmoothingMode) As Long
'Manage GDI+ pens and pen settings
Public Declare Function GdipCreatePen1 Lib "gdiplus" (ByVal mColor As Long, ByVal mWidth As Single, ByVal mUnit As GpUnit, mPen As Long) As Long
Public Declare Function GdipSetPenLineCap Lib "gdiplus" Alias "GdipSetPenLineCap197819" (ByVal mPen As Long, ByVal startCap As LineCap, ByVal endCap As LineCap, ByVal dCap As DashCap) As Long
Public Declare Function GdipDeletePen Lib "gdiplus" (ByVal mPen As Long) As Long
'Draw lines via GDI+
Public Declare Function GdipDrawLine Lib "gdiplus" (ByVal mGraphics As Long, ByVal mPen As Long, ByVal x1 As Single, ByVal y1 As Single, ByVal x2 As Single, ByVal y2 As Single) As Long
'As a convenience, we can automatically convert between system colors (such as "button face" or "inactive window") and literal RGB longs
Public Declare Function OleTranslateColor Lib "olepro32" (ByVal oColor As OLE_COLOR, ByVal HPALETTE As Long, ByRef cColorRef As Long) As Long
Public Type tmpLong
lngResult As Long
End Type
Public Enum rop2
R2_BLACK = 1
R2_NOTMERGEPEN = 2
R2_MASKNOTPEN = 3
R2_NOTCOPYPEN = 4
R2_MASKPENNOT = 5
R2_NOT = 6
R2_XORPEN = 7
R2_NOTMASKPEN = 8
R2_MASKPEN = 9
R2_NOTXORPEN = 10
R2_NOP = 11
R2_MERGENOTPEN = 12
R2_COPYPEN = 13
R2_MERGEPENNOT = 14
R2_MERGEPEN = 15
R2_WHITE = 16
End Enum
Public Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
Public Declare Function GetROP2 Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Public Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As Any) As Long
Public m_GDIPlusToken As Long
'At start-up, this function is called to determine whether or not we have GDI+ available on this machine.
Public Function isGDIPlusAvailable() As Boolean
Dim gdiCheck As GdiplusStartupInput
gdiCheck.GdiplusVersion = 1
'The GdiplusStartup function will return 0 if GDI+ was successfully enabled. Note that we cache the token it returns;
' this is used to free GDI+ when our program terminates.
isGDIPlusAvailable = CBool(GdiplusStartup(m_GDIPlusToken, gdiCheck) = 0)
End Function
'At shutdown, this function must be called to release our GDI+ instance
Public Function releaseGDIPlus()
GdiplusShutdown m_GDIPlusToken
End Function
'Use GDI+ to render a line, with optional color, opacity, and antialiasing
Public Function GDIPlusDrawLineToDC(ByVal dstDC As Long, ByVal x1 As Single, ByVal y1 As Single, ByVal x2 As Single, ByVal y2 As Single, ByVal eColor As Long, Optional ByVal cTransparency As Long = 255, Optional ByVal lineWidth As Single = 1, Optional ByVal useAA As Boolean = True, Optional ByVal customLinecap As LineCap = 0) As Boolean
'Create a GDI+ copy of the image and request matching AA behavior
Dim iGraphics As Long
GdipCreateFromHDC dstDC, iGraphics
If useAA Then GdipSetSmoothingMode iGraphics, SmoothingModeAntiAlias Else GdipSetSmoothingMode iGraphics, SmoothingModeNone
'Create a pen, which will be used to stroke the line
Dim iPen As Long
GdipCreatePen1 fillQuadWithVBRGB(eColor, cTransparency), lineWidth, UnitPixel, iPen
'If a custom line cap was specified, apply it now
If customLinecap > 0 Then GdipSetPenLineCap iPen, customLinecap, customLinecap, 0&
'Render the line
' Stop
GdipDrawLine iGraphics, iPen, x1, y1, x2, y2
'Release all created objects
GdipDeletePen iPen
GdipDeleteGraphics iGraphics
End Function
'GDI+ requires RGBQUAD colors with alpha in the 4th byte. This function returns an RGBQUAD (long-type) from a standard RGB()
' long and supplied alpha. It's not a very efficient conversion, but I find it instructive for beginners.
Private Function fillQuadWithVBRGB(ByVal vbRGB As Long, ByVal alphaValue As Byte) As Long
'The vbRGB constant may be an OLE color constant; if that happens, we want to convert it to a normal RGB quad first.
vbRGB = TranslateColor(vbRGB)
Dim dstQuad As RGBQUAD
dstQuad.Red = ExtractR(vbRGB)
dstQuad.Green = ExtractG(vbRGB)
dstQuad.Blue = ExtractB(vbRGB)
dstQuad.Alpha = alphaValue
Dim placeHolder As tmpLong
LSet placeHolder = dstQuad
fillQuadWithVBRGB = placeHolder.lngResult
End Function
'Helper functions for extracting individual red, green, and blue values from an RGB() Long
Public Function ExtractR(ByVal currentColor As Long) As Integer
ExtractR = currentColor Mod 256
End Function
Public Function ExtractG(ByVal currentColor As Long) As Integer
ExtractG = (currentColor \ 256) And 255
End Function
Public Function ExtractB(ByVal currentColor As Long) As Integer
ExtractB = (currentColor \ 65536) And 255
End Function
'Translate an OLE color (e.g. "vbButtonFace") to a standard RGB Long
Private Function TranslateColor(ByVal colorRef As Long) As Long
'OleTranslateColor returns -1 if it fails; if that happens, default to white
If OleTranslateColor(colorRef, 0, TranslateColor) Then
TranslateColor = RGB(255, 255, 255)
End If
End Function