'also look there for explanation/additional info and more of his great work.
'I did my best to encapsulate everything into one single class and make calling
'its powerful functions as easy as possible. information hiding at its best.
'by using enums, the functions become self explanatory.
'decent error checking, to be improved (for example don't quit your prog until
'your loop of one degree rotation steps has finished...).
'even loading and saving pics with the standard dialog is handled.
'this could be made even faster if abandoning undo and reset function:
'I kept robert's original structure of 3 seperate copies in memory for each image:
'1 - original pic
'2 - current pic
'3 - undo pic
'if you need only parts of it, rip out the unneeded routines to keep the .exe small.
'/// D E C L A R A T I O N S ///////////////////////////////////////////////////
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
'To fill BITMAP structure
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" _
(ByVal hObject As Long, ByVal Lenbmp As Long, dimbmp As Any) As Long
' APIs for getting DIB bits to PalBGR
Private Declare Function GetDIBits Lib "gdi32" _
(ByVal hDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" _
(ByVal hDC As Long) As Long
Private Declare Function CreateBitmap Lib "Gdi32.dll" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function CreateCompatibleBitmap Lib "Gdi32.dll" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SetBkColor Lib "Gdi32.dll" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function BitBlt Lib "Gdi32.dll" (ByVal hDCDest As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hDCSrc As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteObject Lib "Gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" _
(ByVal hDC As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long
' For transferring drawing in an integer array to Form or PicBox
Private Declare Function StretchDIBits Lib "gdi32" (ByVal hDC As Long, _
ByVal X As Long, ByVal Y As Long, _
ByVal DesW As Long, ByVal DesH As Long, _
ByVal SrcX As Long, ByVal SrcY As Long, _
ByVal PICWW As Long, ByVal PICHH As Long, _
lpBits As Any, lpBitsInfo As BITMAPINFO, _
ByVal wUsage As Long, ByVal dwRop As Long) As Long
'For calling machine code
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpMCode As Long, _
ByVal Long1 As Long, ByVal Long2 As Single, _
ByVal Long3 As Single, ByVal Long4 As Long) As Long
'/// T Y P E S /////////////////////////////////////////////////////////////////
Private Type BITMAP
bmType As Long ' Type of bitmap
bmWidth As Long ' Pixel width
bmHeight As Long ' Pixel height
bmWidthBytes As Long ' Byte width = 3 x Pixel width
bmPlanes As Integer ' Color depth of bitmap
bmBitsPixel As Integer ' Bits per pixel, must be 16 or 24
bmBits As Long ' This is the pointer to the bitmap data !!!
End Type
'NB PICTURE STORED IN MEMORY UPSIDE DOWN
'WITH INCREASING MEMORY GOING UP THE PICTURE
'bmp.bmBits points to the bottom left of the picture
' Structures for StretchDIBits
Private Type BITMAPINFOHEADER ' 40 bytes
biSize As Long
biwidth As Long
biheight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type BITMAPINFO
bmiH As BITMAPINFOHEADER
'bmiH As RGBTRIPLE 'NB Palette NOT NEEDED for 16,24 & 32-bit
End Type
'MCode Structure for parameter passing to machine code functions
Private Type MCodeStruc
PICW As Long
PICH As Long
PtrPalBGR As Long
PtrPalLineCopy As Long
Increment As Long
QBLongColor As Long
OpCode As Long
End Type
'/// E N U M S /////////////////////////////////////////////////////////////////
Private Enum eASMBinary
PICROTATE = 1002
End Enum
'/// V A R S ///////////////////////////////////////////////////////////////////
Private bm As BITMAPINFO 'Info about pic (colordepth etc)
Private PalLineCopy(1, 1) As Byte 'For copying 1 line of PalBGR()
Private PicRotateMC() As Byte 'Array to hold machine code for Rotations
Private PIC As PictureBox 'Pointer to picbox to manipulate
Private PICW As Long, PICH As Long 'Picbox Width & Height (pixels)
Private PalBGR() As Byte 'To hold 3 full palettes (12 x PICW x PICH)
Private PalSize As Long 'Size of 1 palette (4 x PICW x PICH)
'finally made these private again as dimming in each subfunction costs time.
Private MCODE As MCodeStruc
Private ptrStruc As Long, ptMC As Long
'new private to switch autodrawing off, so that large filter arrays dont redraw after each step
Private m_AutoDraw As Boolean
Private Const BITSPIXEL = 12
Public Sub TransparentBlt(ByVal hDCDst As Long, ByVal DstX As Long, ByVal DstY As Long, ByVal hDCSrc As Long, ByVal SrcX As Long, ByVal SrcY, ByVal SrcW As Long, ByVal SrcH, TransColor As Long)
'Parameter:
'hDCDst- Device context into which image must be
'drawn transparently
'hDCSrc- Device context of source to be made transparent
'in color TransColor
'SrcX, SrcY, SrcW, SrcH - Rectangular region within
'hDCSrc to be made transparent in terms of hDCDst,
MsgBox "You must assign a picturebox to the class first!", vbInformation, "clsASM"
Else
NoPicAssigned = False
End If
End Function
Public Function ASM_Rotate(ByVal Angle As Integer, Optional ByVal AntiAlias As Boolean = False, Optional ByVal SourcePic As Boolean = True, Optional ByVal colorX As Long = -1, Optional ByVal centerX As Variant, Optional ByVal centerY As Variant)
