Public Function turnthepic(pic1 As PictureBox, pic2 As PictureBox, i As Integer)
Dim arc As Double '弧度
Dim coutain_pic As Double
Dim x1, y1, x2, y2, x3, y3, x4, y4 As Double
pic2.Picture = pic1.Image
arc = i * pi / 180 '弧度
pic2.ScaleMode = vbPixels '"单位
pic1.ScaleMode = vbPixels '"单位
pic1.Picture = LoadPicture("")
coutain_pic = pic1.Height
pic1.Height = pic1.Width
pic1.Width = coutain_pic
For x1 = 0 To pic1.ScaleWidth
x2 = x1 - pic1.ScaleWidth \ 2
For y1 = 0 To pic1.ScaleHeight
y2 = y1 - pic1.ScaleHeight \ 2
x3 = x2 * Cos(-arc) + y2 * Sin(-arc)
y3 = y2 * Cos(-arc) - x2 * Sin(-arc)
x4 = x3 + pic2.ScaleWidth \ 2
y4 = y3 + pic2.ScaleHeight \ 2
If x4 > 0 And x4 < pic2.ScaleWidth - 1 And y4 > 0 And y4 < pic2.ScaleHeight - 1 Then
SetPixel pic1.hdc, x1, y1, GetPixel(pic2.hdc, x4, y4)
End If
Next y1
Next x1
pic1.ScaleMode = 1 '"单位
pic2.ScaleMode = 1 '"单位
End Function
pic1放要旋转的图片,pic2用来过度,i是要旋转的角度
Dim arc As Double '弧度
Dim coutain_pic As Double
Dim x1, y1, x2, y2, x3, y3, x4, y4 As Double
pic2.Picture = pic1.Image
arc = i * pi / 180 '弧度
pic2.ScaleMode = vbPixels '"单位
pic1.ScaleMode = vbPixels '"单位
pic1.Picture = LoadPicture("")
coutain_pic = pic1.Height
pic1.Height = pic1.Width
pic1.Width = coutain_pic
For x1 = 0 To pic1.ScaleWidth
x2 = x1 - pic1.ScaleWidth \ 2
For y1 = 0 To pic1.ScaleHeight
y2 = y1 - pic1.ScaleHeight \ 2
x3 = x2 * Cos(-arc) + y2 * Sin(-arc)
y3 = y2 * Cos(-arc) - x2 * Sin(-arc)
x4 = x3 + pic2.ScaleWidth \ 2
y4 = y3 + pic2.ScaleHeight \ 2
If x4 > 0 And x4 < pic2.ScaleWidth - 1 And y4 > 0 And y4 < pic2.ScaleHeight - 1 Then
SetPixel pic1.hdc, x1, y1, GetPixel(pic2.hdc, x4, y4)
End If
Next y1
Next x1
pic1.ScaleMode = 1 '"单位
pic2.ScaleMode = 1 '"单位
End Function
pic1放要旋转的图片,pic2用来过度,i是要旋转的角度
解决方案 »
- 能否在运行中发现系统没注册某个ocx或者dll时,立即释放资源文件注册好dll来解决错误?
- vb如何不解压文件读取压缩文件中的文件呢
- 小仙妹(kitegirl),你好!!
- 怎样建立Insert触发器
- 时钟怎么实现?
- 大家快救救我呀!在线等待!
- 巨分寻软件Spread 6.0
- 在线求一VB希尔排序算法
- 关于Me.TableAdapter.Fill(Me.JXCDBDataSet.)
- VB调用EXCEL时能不能可以像数据库一样查找,因为每次用cells().value比较实在太麻烦了,太慢了,能不能快速的查找,查找要同时满足几个条件,如cell(i,1).value=a;cells(i,3).value=b.能给我一个解决的办法吗?
- 想问个问题,和http://www.csdn.net/news/newstopic/6/6744.shtml这个新闻有关。
- Win2000下如何编程关机?
上面的代码毫不隐晦地说,速度太慢了。
难道你们都忘了我写的快速(不是最快)图象任意角度旋转代码了,悲伤ing....
http://www.csdn.net/Expert/TopicView1.asp?id=900205
--------------------------------------------------------------------
Made by Thirdapple's Studio(http://3rdapple.51.net/)
'作者:刘留
'网名:Thirdapple
'E-Mail地址:[email protected]
'个人主页: http://3rdapple.51.net/
'通信地址:四川省遂宁市遂宁中学初2003级三班
'你可以任意传播此代码,但是请不要删除上面的说明文字,如果你对此代码进行了改进,请给我来信,谢谢!
Function CircumvolvingBits(FromPicture As PictureBox, ToPicture As PictureBox, Angle As Long, Zoom As Boolean)
Const Pi = 3.14159265358979 '定义的Pi值,好象是越多越好,于是就定义了这么多位:)
Dim x As Long, y As Long
Dim X1 As Long, Y1 As Long
Dim X2 As Double, Y2 As Double
Dim X3 As Long, Y3 As Long '这里原来定义的是Double,但是老出问题,定义为Long就正常了
Dim bit2Width As Long
Dim bitWidth As Long
Dim hOldMap As Long
Dim Pic2Bits() As Byte
Dim PicBits() As Byte
Dim iBitmap As Long, iDC As Long
Dim i2Bitmap As Long, i2DC As Long
Dim bi24BitInfo As BITMAPINFO
Dim bi24Bit2Info As BITMAPINFO
Dim HuDu As Single
Dim Pcolor As Long
'清除图片框ToPicture
ToPicture.Cls
'将角度转换为弧度
FromPicture.ScaleMode = vbPixels
ToPicture.ScaleMode = vbPixels
HuDu = Angle * Pi / 180
If Zoom = True Then '如果要图片框随图片的旋转而伸缩的话
If Angle < 90 Then '以下的代码都是运用三角函数进行的处理
HuDu = Angle * Pi / 180
ToPicture.Width = FromPicture.Width * Cos(HuDu) + FromPicture.Height * Sin(HuDu)
ToPicture.Height = FromPicture.Height * Cos(HuDu) + FromPicture.Width * Sin(HuDu)
If Angle = 0 Then
HuDu = Angle * Pi / 180
ToPicture.Width = FromPicture.Width
ToPicture.Height = FromPicture.Height
End If
Else
If Angle = 90 Then
HuDu = Angle * Pi / 180
ToPicture.Width = FromPicture.Height
ToPicture.Height = FromPicture.Width
End If
If Angle < 180 And Angle > 90 Then
Angle = Angle - 90
HuDu = Angle * Pi / 180
ToPicture.Width = FromPicture.Height * Cos(HuDu) + FromPicture.Width * Sin(HuDu)
ToPicture.Height = FromPicture.Width * Cos(HuDu) + FromPicture.Height * Sin(HuDu)
Else
If Angle = 180 Then
HuDu = Angle * Pi / 180
ToPicture.Width = FromPicture.Width
ToPicture.Height = FromPicture.Height
End If
If Angle < 270 And Angle > 180 Then
Angle = Angle - 180
HuDu = Angle * Pi / 180
ToPicture.Width = FromPicture.Width * Cos(HuDu) + FromPicture.Height * Sin(HuDu)
ToPicture.Height = FromPicture.Height * Cos(HuDu) + FromPicture.Width * Sin(HuDu)
Else
If Angle = 270 Then
HuDu = Angle * Pi / 180
ToPicture.Width = FromPicture.Height
ToPicture.Height = FromPicture.Width
End If
If Angle < 360 And Angle > 270 Then
Angle = Angle - 270
HuDu = Angle * Pi / 180
ToPicture.Width = FromPicture.Height * Cos(HuDu) + FromPicture.Width * Sin(HuDu)
ToPicture.Height = FromPicture.Width * Cos(HuDu) + FromPicture.Height * Sin(HuDu)
End If
End If
End If
End If
End If
With bi24BitInfo.bmiHeader '定义一个DIB位图结构
.biBitCount = 32 '定义为32位的DIB位图(很方便,以前我用24位的走了不少弯路),32位DIB位图每个象素有四个字节,分别是R、G、B、Alpha
.biCompression = BI_RGB
.biPlanes = 1
.biSize = Len(bi24BitInfo.bmiHeader)
.biWidth = FromPicture.ScaleWidth
.biHeight = FromPicture.ScaleHeight
.biSizeImage = .biWidth * 4 * .biHeight
End With
iDC = CreateCompatibleDC(0) '创建位图hDC
iBitmap = CreateDIBSection(iDC, bi24BitInfo, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&) '创建位图
If iBitmap Then
hOldMap = SelectObject(iDC, iBitmap) '使i2DC与i2Bitmap建立关联
Else
DeleteObject iDC
Exit Function
End If
With bi24Bit2Info.bmiHeader '定义一个DIB位图结构
.biBitCount = 32 '定义为32位的DIB位图(很方便,以前我用24位的走了不少弯路),32位DIB位图每个象素有四个字节,分别是R、G、B、Alpha
.biCompression = BI_RGB
.biPlanes = 1
.biSize = Len(bi24BitInfo.bmiHeader)
.biWidth = ToPicture.ScaleWidth
.biHeight = ToPicture.ScaleHeight
.biSizeImage = .biWidth * 4 * .biHeight
End With
i2DC = CreateCompatibleDC(0) '创建位图hDC
i2Bitmap = CreateDIBSection(i2DC, bi24Bit2Info, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&) '创建位图
If i2Bitmap Then
hOldMap = SelectObject(i2DC, i2Bitmap) '使i2DC与i2Bitmap建立关联
Else
DeleteObject i2DC
Exit Function
End If
BitBlt iDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, FromPicture.hDC, 0, 0, vbSrcCopy '将FromPicture上的图象拷贝到iDC中
bitWidth = bi24BitInfo.bmiHeader.biWidth * 4 '横向的字节总数
ReDim PicBits(0 To bitWidth * bi24BitInfo.bmiHeader.biHeight) As Byte '重新定义动态数组
GetBitmapBits iBitmap, bi24BitInfo.bmiHeader.biSizeImage, PicBits(0) '将iBitmap读取到PicBits数组中
BitBlt i2DC, 0, 0, bi24Bit2Info.bmiHeader.biWidth, bi24Bit2Info.bmiHeader.biHeight, ToPicture.hDC, 0, 0, vbSrcCopy '将ToPicture上的图象拷贝到i2DC中
bit2Width = bi24Bit2Info.bmiHeader.biWidth * 4 '横向的字节总数
ReDim Pic2Bits(0 To bit2Width * bi24Bit2Info.bmiHeader.biHeight) As Byte '重新定义动态数组
GetBitmapBits i2Bitmap, bi24Bit2Info.bmiHeader.biSizeImage, Pic2Bits(0) '将i2Bitmap读取到Pic2Bits数组中
'逐点旋转象素,并逐点复制
For x = 1 To ToPicture.ScaleWidth - 1
X1 = x - ToPicture.ScaleWidth \ 2
For y = 1 To ToPicture.ScaleHeight - 1
Y1 = y - ToPicture.ScaleHeight \ 2
'旋转象素点
X2 = X1 * Cos(-HuDu) + Y1 * Sin(-HuDu)
Y2 = Y1 * Cos(-HuDu) - X1 * Sin(-HuDu)
X3 = X2 + FromPicture.ScaleWidth \ 2
Y3 = Y2 + FromPicture.ScaleHeight \ 2
'如果象素点在待旋转位图内
If X3 >= 1 And X3 <= FromPicture.ScaleWidth - 1 Then
If Y3 >= 1 And Y3 <= FromPicture.ScaleHeight - 1 Then
'逐点复制位图
If x * 4 + 2 + y * bit2Width <= bit2Width * bi24Bit2Info.bmiHeader.biHeight _
And x * 4 + y * bit2Width >= 0 _
And X3 * 4 + 2 + Y3 * bitWidth <= bitWidth * bi24BitInfo.bmiHeader.biHeight _
And X3 * 4 + Y3 * bitWidth >= 0 Then
Pic2Bits(x * 4 + y * bit2Width) = PicBits(X3 * 4 + Y3 * bitWidth)
Pic2Bits(x * 4 + 1 + y * bit2Width) = PicBits(X3 * 4 + 1 + Y3 * bitWidth)
Pic2Bits(x * 4 + 2 + y * bit2Width) = PicBits(X3 * 4 + 2 + Y3 * bitWidth)
End If
End If
End If
Next y
Next x
SetBitmapBits i2Bitmap, bi24Bit2Info.bmiHeader.biSizeImage, Pic2Bits(0) '将Pic2Bits赋与i2Bitmap
BitBlt ToPicture.hDC, 0, 0, bi24Bit2Info.bmiHeader.biWidth, bi24Bit2Info.bmiHeader.biHeight, i2DC, 0, 0, vbSrcCopy '将i2DC拷贝到ToPicture中
'释放对象
If hOldMap Then DeleteObject SelectObject(iDC, hOldMap)
If hOldMap Then DeleteObject SelectObject(i2DC, hOldMap)
DeleteObject iDC '
DeleteObject i2DC
ToPicture.Refresh
CircumvolvingBits = True '返回真值
End Function
'还是要打上“原创”的记号(如是转载请打上“转载”的记号)
--------------------------------------------------------------------
Made by Thirdapple's Studio(http://3rdapple.51.net/)
Public 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 LongPublic Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As LongPublic Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As LongPublic Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As LongPublic Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPublic 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 LongPublic Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As LongPublic Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As LongPublic Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End TypePublic 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 TypePublic Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
--------------------------------------------------------------------
Made by Thirdapple's Studio(http://3rdapple.51.net/)