VB 如何实现对图片框的任意角度矩形裁剪?
如题所示。一般对图片框的裁剪都是规规矩矩的矩形裁剪,现在想将矩形裁剪框任意角度旋转后再行裁剪保存,能办到吗?如何才能办到? vb 图片裁剪?任意角度
[解决办法]
给你个完整的,你自己研究研究吧
Option Explicit
Private Type xForm
eM11 As Single
eM12 As Single
eM21 As Single
eM22 As Single
eDx As Single
eDy As Single
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
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 RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFO
bmiheader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0
Private Type COORD
x As Long
y As Long
End Type
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Type PointAPI
x As Long
y As Long
End Type
Private Const GM_ADVANCED As Long = &H2
Private Const COLOR_BTNSHADOW As Long = &H10
Private Const MWT_IDENTITY = 1
Private Const MWT_LEFTMULTIPLY = 2
Private Const MWT_RIGHTMULTIPLY = 3
Private Const BLACK_PEN As Long = &H7
Private Const PS_DOT As Long = &H2
Private Const PS_SOLID As Long = &H0
Private Const MM_LOENGLISH = 4
Private Const NULL_BRUSH As Long = &H5
Private Const HOLLOW_BRUSH = NULL_BRUSH
Private Declare Function ModifyWorldTransform Lib "gdi32" (ByVal hdc As Long, _
lpXform As xForm, ByVal iMode As Long) As Long
Private Declare Function SetWorldTransform Lib "gdi32" (ByVal hdc As Long, ByRef lpXform As xForm) As Long
Private Declare Function SetGraphicsMode Lib "gdi32" (ByVal hdc As Long, ByVal iMode As Long) As Long
Private Declare Function GetWorldTransform Lib "gdi32" (ByVal hdc As Long, ByRef lpXform As xForm) As Long
Private Declare Function GetStockObject Lib "GDI32.dll" (ByVal nIndex As Long) As Long
Private Declare Function DPtoLP Lib "GDI32.dll" (ByVal hdc As Long, ByRef lpPoint As Any, ByVal nCount As Long) As Long
Private Declare Function GetClientRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (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 CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function CreateCompatibleDC 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 DeleteDC Lib "GDI32.dll" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Dim NewMatrix(0 To 2) As xForm, OldMatrix As xForm
Dim newx As Single, newy As Single, xsize As Single
Dim bmi As BITMAPINFO, BgBuffer As Long, bmiheader As BITMAPINFOHEADER
Dim MyDc As Long, srcPic As StdPicture, srcHdc As Long
Dim srcBmp As BITMAP
Sub TransformAndDraw()
Dim R As RECT, OldMode As Long
OldMode = SetGraphicsMode(MyDc, GM_ADVANCED)
BitBlt MyDc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, MyDc, 0, 0, vbBlackness
Call GetWorldTransform(MyDc, OldMatrix)
Call SetWorldTransform(MyDc, NewMatrix(0))
Call ModifyWorldTransform(MyDc, NewMatrix(1), MWT_RIGHTMULTIPLY)
Call ModifyWorldTransform(MyDc, NewMatrix(2), MWT_RIGHTMULTIPLY)
StretchBlt MyDc, bmi.bmiheader.biWidth / 2 - srcBmp.bmWidth * xsize * 0.5, _
bmi.bmiheader.biHeight / 2 - srcBmp.bmHeight * xsize * 0.5, srcBmp.bmWidth * xsize, _
srcBmp.bmHeight * xsize, srcHdc, 0, 0, srcBmp.bmWidth, srcBmp.bmHeight, vbSrcCopy
' Clean up
Call SetWorldTransform(MyDc, OldMatrix)
Call SetGraphicsMode(MyDc, OldMode)
BitBlt Me.hdc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, MyDc, 0, 0, vbSrcCopy
End Sub
Private Sub Command1_Click()
Dim Mat As xForm
Const PI = 3.1415926535
Dim A As Double
Dim R As RECT, OldMode As Long
OldMode = SetGraphicsMode(MyDc, GM_ADVANCED)
BitBlt MyDc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, MyDc, 0, 0, vbBlackness
Call GetWorldTransform(MyDc, OldMatrix)
xsize = 1
A = 10 / 180 * PI
With Mat
.eDx = 0
.eDy = -30
.eM11 = 0.3
.eM12 = 0
.eM21 = 0
.eM22 = 0.3
End With
Call SetWorldTransform(MyDc, Mat) ' NewMatrix(0))
'
' Call ModifyWorldTransform(MyDc, NewMatrix(1), MWT_RIGHTMULTIPLY)
' Call ModifyWorldTransform(MyDc, NewMatrix(2), MWT_RIGHTMULTIPLY)
StretchBlt MyDc, bmi.bmiheader.biWidth / 2 - srcBmp.bmWidth * xsize * 0.5, _
bmi.bmiheader.biHeight / 2 - srcBmp.bmHeight * xsize * 0.5, srcBmp.bmWidth * xsize, _
srcBmp.bmHeight * xsize, srcHdc, 0, 0, srcBmp.bmWidth, srcBmp.bmHeight, vbSrcCopy
' Clean up
Call SetWorldTransform(MyDc, OldMatrix)
Call SetGraphicsMode(MyDc, OldMode)
BitBlt Me.hdc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, MyDc, 0, 0, vbSrcCopy
End Sub
Private Sub Form_Load()
Dim delay As Double
Me.WindowState = 2
Me.BackColor = 0
Me.Show
Me.ScaleMode = vbPixels
MyDc = CreateCompatibleDC(0)
bmi.bmiheader.biSize = Len(bmiheader)
bmi.bmiheader.biWidth = Me.ScaleWidth
bmi.bmiheader.biHeight = Me.ScaleHeight
bmi.bmiheader.biPlanes = 1
bmi.bmiheader.biBitCount = 32
bmi.bmiheader.biCompression = BI_RGB
bmi.bmiheader.biSizeImage = bmi.bmiheader.biWidth * bmi.bmiheader.biHeight * 4
BgBuffer = CreateDIBSection(MyDc, bmi, DIB_RGB_COLORS, 0&, 0&, 0&)
SelectObject MyDc, BgBuffer
srcHdc = CreateCompatibleDC(0)
Set srcPic = New StdPicture
Set srcPic = LoadPicture(App.Path & "\test.jpg")
SelectObject srcHdc, srcPic.handle
Call GetObject(srcPic, Len(srcBmp), srcBmp)
xsize = 1
With NewMatrix(0)
.eM11 = 1
.eM12 = 0
.eM21 = 0
.eM22 = 1
.eDx = bmi.bmiheader.biWidth / 2 - Cos(0) * bmi.bmiheader.biWidth / 2 + Sin(0) * bmi.bmiheader.biHeight / 2
.eDy = bmi.bmiheader.biHeight / 2 - Cos(0) * bmi.bmiheader.biHeight / 2 - Sin(0) * bmi.bmiheader.biWidth / 2
End With
With NewMatrix(1)
.eM11 = 1
.eM12 = 0
.eM21 = 0
.eM22 = Sin(Atn(1) * 2)
.eDx = 0
.eDy = bmi.bmiheader.biHeight / 2 - Sin(Atn(1) * 2) * bmi.bmiheader.biHeight / 2
End With
With NewMatrix(2)
.eM11 = 1
.eM12 = 0
.eM21 = 0
.eM22 = 1
.eDx = bmi.bmiheader.biWidth / 2 - Cos(0) * bmi.bmiheader.biWidth / 2
.eDy = 0
End With
delay = Timer + 1
While Timer < delay
DoEvents
Wend
VScroll9_Change
End Sub
Private Sub Form_Unload(Cancel As Integer)
DeleteDC MyDc
DeleteDC srcHdc
DeleteObject BgBuffer
Unload Me
End Sub
Private Sub VScroll1_Change()
Dim x As Single
x = CSng(VScroll1) * (8 * Atn(1)) / 32767 - Atn(1) * 4
With NewMatrix(0)
.eM11 = Cos(x)
.eM12 = Sin(x)
.eM21 = -Sin(x)
.eM22 = Cos(x)
.eDx = bmi.bmiheader.biWidth / 2 - Cos(x) * bmi.bmiheader.biWidth / 2 + Sin(x) * bmi.bmiheader.biHeight / 2
.eDy = bmi.bmiheader.biHeight / 2 - Cos(x) * bmi.bmiheader.biHeight / 2 - Sin(x) * bmi.bmiheader.biWidth / 2
End With
TransformAndDraw
End Sub
Private Sub VScroll1_Scroll()
VScroll1_Change
End Sub
Private Sub VScroll2_Change()
Dim x As Single
x = CSng(VScroll2) * (8 * Atn(1)) / 32767 - Atn(1) * 4
With NewMatrix(1)
.eM11 = 1
.eM12 = 0
.eM21 = 0
.eM22 = Sin(x)
.eDx = 0
.eDy = bmi.bmiheader.biHeight / 2 - Sin(x) * bmi.bmiheader.biHeight / 2
End With
TransformAndDraw
End Sub
Private Sub VScroll2_Scroll()
VScroll2_Change
End Sub
Private Sub VScroll3_Change()
Dim x As Single
x = CSng(VScroll3) * (8 * Atn(1)) / 32767 - Atn(1) * 4
With NewMatrix(2)
.eM11 = Cos(x)
.eM12 = 0
.eM21 = 0
.eM22 = 1
.eDx = bmi.bmiheader.biWidth / 2 - Cos(x) * bmi.bmiheader.biWidth / 2
.eDy = 0
End With
TransformAndDraw
End Sub
Private Sub VScroll3_Scroll()
VScroll3_Change
End Sub
Private Sub VScroll9_Change()
xsize = CSng(VScroll9) * 5 / 32767 + 0.001
TransformAndDraw
End Sub
Private Sub VScroll9_Scroll()
VScroll9_Change
End Sub