' No APIs are declared public. This is to prevent possibly, differently
' declared APIs, or different versions of the same API, from conflciting
' with any APIs you declared in your project. Same rule for UDTs.
' Note: I did take liberties, changing parameter types, in several APIs throughout
' Used to determine operating system
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As Any) As Long
Private Type OSVERSIONINFOEX
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' up to here is OSVERSIONINFO vs EX
wServicePackMajor As Integer ' 8 bytes larger than OSVERSIONINFO
wServicePackMinor As Integer
wSuiteMask As Integer
wProductType As Byte
wReserved As Byte
End Type
' APIs used to manage the 32bpp DIB
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Sub FillMemory Lib "kernel32.dll" Alias "RtlFillMemory" (ByRef Destination As Any, ByVal Length As Long, ByVal Fill As Byte)
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32.dll" (ByVal hDC As Long, ByRef pBitmapInfo As Any, ByVal un As Long, ByRef Pointer As Long, ByVal Handle As Long, ByVal dw As Long) As Long
Private Declare Function AlphaBlend Lib "MSIMG32.dll" (ByVal hdcDest As Long, ByVal nXOriginDest As Long, ByVal nYOriginDest As Long, ByVal nWidthDest As Long, ByVal nHeightDest As Long, ByVal hdcSrc As Long, ByVal nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal lBlendFunction As Long) As Long
Private Declare Function SetStretchBltMode Lib "gdi32.dll" (ByVal hDC As Long, ByVal nStretchMode As Long) As Long
Private Declare Function GetObjectType Lib "gdi32.dll" (ByVal hgdiobj As Long) As Long
Private Declare Function GetCurrentObject Lib "gdi32.dll" (ByVal hDC As Long, ByVal uObjectType As Long) As Long
Private Declare Function GetIconInfo Lib "user32.dll" (ByVal hIcon As Long, ByRef piconinfo As ICONINFO) As Long
Private Declare Function BitBlt Lib "gdi32.dll" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function SetDIBitsToDevice Lib "gdi32.dll" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal dX As Long, ByVal dY As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, ByRef Bits As Any, ByRef BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function GetDIBits Lib "gdi32.dll" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, ByRef lpBits As Any, ByRef lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function OffsetRgn Lib "gdi32.dll" (ByVal hRgn As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Const STRETCH_HALFTONE As Long = &H4&
Private Const OBJ_BITMAP As Long = &H7&
Private Const OBJ_METAFILE As Long = &H9&
Private Const OBJ_ENHMETAFILE As Long = &HD&
' APIs used to create files
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetFileSize Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpFileSizeHigh As Long) As Long
Private Declare Function ReadFile Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, ByRef lpOverlapped As Any) As Long
Private Declare Function SetFilePointer Lib "kernel32.dll" (ByVal hFile As Long, ByVal lDistanceToMove As Long, ByRef lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
AgsclRedMask = 3 ' uses only the Red sample value: RGB = Red / 3
AgsclGreenMask = 4 ' uses only the Green sample value: RGB = Green / 3
AgsclBlueMask = 5 ' uses only the Blue sample value: RGB = Blue / 3
AgsclRedGreenMask = 6 ' uses Red & Green sample value: RGB = (Red+Green) / 2
AgsclBlueGreenMask = 7 ' uses Blue & Green sample value: RGB = (Blue+Green) / 2
AgsclNone = -1
End Enum
Public Enum AeFilterMethods
AfilterDefault = 0 ' paletted PNGs will use AfilterNone while others will use AfilterPaeth
AfilterNone = 1 ' no byte preparation used; else preps bytes using one of the following
AfilterAdjLeft = 2 ' see AcPNGwriter.EncodeFilter_Sub
AfilterAdjTop = 3 ' see AcPNGwriter.EncodeFilter_Up
AfilterAdjAvg = 4 ' see AcPNGwriter.EncodeFilter_Avg
AfilterPaeth = 5 ' see AcPNGwriter.EncodeFilter_Paeth
AfilterAdaptive = 6 ' this is a best guess of the above 4 (can be different for each DIB scanline)
End Enum
Public Enum AeRegionStyles ' See CreateRegion
AregionBounds = 0
AregionEnclosed = 1
AregionShaped = 2
End Enum
Public Enum AeConstants ' See SourceIconSizes
ATRUE_COLOR = &HFF000000
AHIGH_COLOR = &HFFFF00
ATRUE_COLOR_ALPHA = &HFFFFFFFF
End Enum
'Private m_PNGprops As AcPNGwriter ' used for more advanced PNG creation options
Private m_StretchQuality As Boolean ' if true will use BiLinear or better interpolation
Private m_Handle As Long ' handle to 32bpp DIB
Private m_Pointer As Long ' pointer to DIB bits
Private m_Height As Long ' height of DIB
Private m_Width As Long ' width of DIB
Private m_hDC As Long ' DC if self-managing one
Private m_prevObj As Long ' object deselected from DC when needed
Private m_osCAP As Long ' See Class_Initialize
Private m_Format As AeImageFormat ' type of source image
Private m_ManageDC As Boolean ' does class manage its own DC
Private m_AlphaImage As Boolean ' does the DIB contain alpha/transparency
Private m_GDItoken As Long
Private m_ImageByteCache() As Byte ' should you want the DIB class to cache original bytes
' ^^ N/A if image is loaded by handle, stdPicture, or resource
Public Function LoadPicture_File(ByVal FileName As String, Optional ByVal iconCx As Long, Optional ByVal iconCy As Long, Optional ByVal SaveFormat As Boolean, Optional ByVal iconBitDepth As Long = 32) As Boolean
' PURPOSE: Convert passed image file into a 32bpp image
' Parameters.
' FileName :: full path of file. Validation occurs before we continue
' iconCx :: desired width of icon if file is an icon file. Default is 32x32
' iconCy :: desired height of icon if file is an icon file. Default is 32x32
' SaveFormat :: if true, then the image will be cached as a byte array only
' if the image was successfully loaded. Call GetOrginalFormat to retrieve them.
' iconBitDepth :: the desired bit depth of an icon if the resource is an icon file
' Why would you want to save the bytes? If this is being used in a usercontrol,
' saving the bytes will almost always be less size than saving the 32bit DIB.
' Additionally, these classes have the ability to get different sizes from
' the original source (i.e., WMF, icon, cursors) if available, but if the
' 32bit DIB is saved, it is a constant size. The potential of different sizes
' could allow better resizing of the image vs stretching the DIB.
On Error Resume Next
Dim hFile As Long
hFile = AiparseGetFileHandle(FileName, True, ((m_osCAP And 24) = 8))
If hFile = INVALID_HANDLE_VALUE Then Exit Function
If GetFileSize(hFile, 0&) > 56 Then
' no image file/stream can be less than 57 bytes and still be an image
Public Function Render(ByVal destinationDC As Long, Optional ByVal destX As Long, Optional ByVal destY As Long, Optional ByVal destWidth As Long, Optional ByVal destHeight As Long, Optional ByVal SrcX As Long, Optional ByVal SrcY As Long, Optional ByVal srcWidth As Long, Optional ByVal srcHeight As Long, Optional ByVal Opacity As Long = 100&, Optional ByVal Blend As Boolean = True, Optional ByVal SetHalfTone As Boolean = True, Optional ByRef destHostDIB As Ac32bppDIB, Optional ByVal grayScale As AeGrayScaleFormulas = AgsclNone) As Boolean
' PURPOSE: Render an existing 32bpp DIB to a target DC
' Parameters.
' destinationDC :: target DC to draw to
' destX, destY :: the top/left coordinates to draw to, default is 0,0
' destWidth, destHeight :: the width and height to draw to, default is the image's width & height
' srcX, srcY :: the left & top offset within the DIB
' srcWidth, srcHeight :: the amount of DIB to be rendered
' Opacity :: how opaque to draw the image, default is 100% opaque
' Blend :: no longer used, reserved
' SetHalfTone :: if True, then the destination DC's stretch mode will be modified to
' produce better quality results. This option is not available on Win9x systems.
' Tip: When AlphaBlending to another DIB set to False
' When AlphaBlending to CompatibleBitmap (DDB) or visible DC set to True
' destHostDIB :: When rendering from DIB class to DIB class, pass the destination
' DIB class to ensure alpha blending occurs correctly on systems that do not
' support GDI+ or AlphaBlend APIs
' grayscale :: one of several formulas to grayscale while rendering (optional)
Dim lBlendFunc As Long, tDC As Long, hOldImage As Long
Dim lStretchMode As Long
Dim aResizedBytes() As Byte, aMirrorBytes() As Byte
Dim bStretching As Boolean
Dim bMirroring As Boolean
Dim bCanUseAlphaBlend As Boolean
' validate a few things
If m_Handle = 0& Then
Exit Function
ElseIf destinationDC = 0& Then
Exit Function
ElseIf srcWidth < 0& Then ' AlphaBlend is not compatible with negative width/height
Exit Function ' negative values used in APIs like StretchBlt for mirroring
ElseIf srcHeight < 0& Then
Exit Function
End If
If Opacity = 0& Then
Render = True
Exit Function ' pointless if image is 100% transparent
Else
Opacity = Abs(Opacity) Mod 100
If Opacity = 0& Then Opacity = 100&
End If
' validate optional parameters for source image
If srcWidth = 0& Then srcWidth = m_Width
If srcHeight = 0& Then srcHeight = m_Height
If SrcX < 0& Then SrcX = 0& ' source X,Y cannot be negative
If SrcY < 0& Then SrcY = 0& ' but the dest X,Y can be
' AlphaBlend requires that the source rectangle fit within the image
If SrcX + srcWidth > m_Width Then srcWidth = m_Width - SrcX
If SrcY + srcHeight > m_Height Then srcHeight = m_Height - SrcY
' validate optional parameters for destination image
If destWidth = 0& Then
destWidth = m_Width
Else
If destWidth < 0& Then bMirroring = True ' rules out AlphaBlend usage
End If
bStretching = Not (Abs(destWidth) = srcWidth) ' rules out AlphaBlend usage if Bilinear interpolation requested
If destHeight = 0& Then
destHeight = m_Height
Else
If destHeight < 0& Then bMirroring = True ' rules out AlphaBlend usage
End If
If Not bStretching Then bStretching = Not (Abs(destHeight) = srcHeight) ' rules out AlphaBlend usage if Bilinear interpolation requested
If Me.isAlphaBlendFriendly Then ' Win98 or better with AlphaBlend enabled
If Not bMirroring Then ' Not mirroring, can use AlphaBlend
If grayScale = AgsclNone Then
If bStretching Then
bCanUseAlphaBlend = Not m_StretchQuality ' no Bilinear interpolation, can use AlphaBlend
Else
bCanUseAlphaBlend = True
End If
End If
End If
End If
If Me.isGDIplusEnabled = True And bCanUseAlphaBlend = False Then
' we will use GDI+ to render when higher quality interpolation is desired or system is not AlphaBlend friendly
If Me.isAlphaBlendFriendly Then SetStretchBltMode destinationDC, lStretchMode
End If
End If
' remove the image from the DC if necessary
If Not hOldImage = 0& Then SelectObject m_hDC, hOldImage
If Not tDC = 0& Then ' if we created a DC, let's destroy it now
DeleteDC m_hDC
m_hDC = 0&
End If
End If
End Function
Private Function LoadPictureEx(FileHandle As Long, FileName As String, aStream() As Byte, cx As Long, cy As Long, streamOffset As Long, streamLength As Long, SaveFormat As Boolean, bitDepth As Long) As Boolean
' PURPOSE: Marshal passed file/array to image classes for conversion to 32bpp image
' For parameter information, see LoadPicture_File & LoadPicture_Stream
Me.DestroyDIB
' various image parsers, in order of precedence
' All 4 recognize transparency
Dim cPNG As AcPNGparser ' very fast to abort if not a PNG file
Dim bReturn As Boolean ' function return value
Dim rtnRead As Long
' validate passed desired icon sizes
If cx < 0& Then cx = 0&
If cy < 0& Then cy = 0&
If bitDepth < 0& Then
bitDepth = 32
ElseIf bitDepth > 32 Then
bitDepth = 32
End If
Set cPNG = New AcPNGparser ' see if image is a PNG; aborts quickly if not
Private Function pvResize(ByVal destDC As Long, rSizedBytes() As Byte, rMirror() As Byte, Optional tHost As Ac32bppDIB, Optional ByVal SrcX As Long, Optional ByVal scrY As Long, Optional ByVal srcWidth As Long, Optional ByVal srcHeight As Long, Optional ByVal destX As Long, Optional ByVal destY As Long, Optional destWidth As Long, Optional destHeight As Long) As Boolean
' Function resizes an alpha image, maintaining premultiplied pixels & alpha values
' Code originally by Carles P.V. but significantly modified for this project.
' Parameters:
' destDC :: DC being rendered to, may be null
' rSizedbytes() : array to hold resized alpha section; not used if tHost is not Nothing
' tHost : when resizing to another DIB class, the destination DIB class
' srcX,Y : the coordinates of the source image to start resizing from
' srcWidth,srcHeight : the width/height of the source image to resize from
' destX,Y : the coordinates of the destination image to resize to
' destWidth,destHeight : the width/height of the destination image to resize to
If srcWidth = 0& Then srcWidth = m_Width
If srcHeight = 0& Then srcHeight = m_Height
Dim aNewBits() As Byte, dSA As SafeArray ' new size, overlay of DIB pointer
Dim aOldBits() As Byte, tSA As SafeArray ' old size, overlay of DIB pointer
Dim xLUdbl() As Double ' look o resize to
' destWidtto
'l Dim xLUdbl()magbm xLUdbl()mcecttttb Varl destX As Lon)pLib "a DC is created each time X As Lon)pLibHe resiiiiiiii ' newcreatestX, g' new st, streamLengVarl'llPile isu, GDI+ w
