要求添加个按钮
功能： 点击让
Picture1里的图片顺时针旋转90度，请大家帮帮忙啊 救救急。Dim tempPicture As IPictureDispPrivate Sub Command1_Click()
Dim path As String
path = "E:\project\TEMP\000.jpg" '图片不一定是JPG格式
' Picture1.Picture = LoadPicture(path)
Set tempPicture = LoadPicture(path)
PictureToCenter tempPicture, Picture1End SubPublic Sub PictureToCenter(Pic As Picture, PicBox As PictureBox)
Dim PicH As Long, PicW As Long
Dim PicBoxW As Long, PicBoxH As Long
Dim PicRate As Single, PicBoxRate As Single
Dim NewH As Long, NewW As Long
If Not Pic Is Nothing Then
PicBoxH = PicBox.ScaleHeight
PicBoxW = PicBox.ScaleWidth
PicBoxRate = PicBoxW / PicBoxH
PicW = PicBox.ScaleX(Pic.Width, vbHimetric, vbTwips)
PicH = PicBox.ScaleY(Pic.Height, vbHimetric, vbTwips)
PicRate = PicW / PicH
' PicBox.Picture = Nothing
PicBox.Cls
If PicH <= PicBoxH And PicW <= PicBoxW Then
PicBox.PaintPicture Pic, (PicBoxW - PicW) / 2, (PicBoxH - PicH) / 2
Exit Sub
End If
If PicBoxRate < PicRate Then
NewH = PicBoxW / PicRate
PicBox.PaintPicture Pic, 0, (PicBoxH - NewH) / 2, PicBoxW, NewH
Else
NewW = PicBoxH * PicRate
PicBox.PaintPicture Pic, (PicBoxW - NewW) / 2, 0, NewW, PicBoxH
End If
' PicBox.Picture = Pic
End If
End Sub
功能： 点击让
Picture1里的图片顺时针旋转90度，请大家帮帮忙啊 救救急。Dim tempPicture As IPictureDispPrivate Sub Command1_Click()
Dim path As String
path = "E:\project\TEMP\000.jpg" '图片不一定是JPG格式
' Picture1.Picture = LoadPicture(path)
Set tempPicture = LoadPicture(path)
PictureToCenter tempPicture, Picture1End SubPublic Sub PictureToCenter(Pic As Picture, PicBox As PictureBox)
Dim PicH As Long, PicW As Long
Dim PicBoxW As Long, PicBoxH As Long
Dim PicRate As Single, PicBoxRate As Single
Dim NewH As Long, NewW As Long
If Not Pic Is Nothing Then
PicBoxH = PicBox.ScaleHeight
PicBoxW = PicBox.ScaleWidth
PicBoxRate = PicBoxW / PicBoxH
PicW = PicBox.ScaleX(Pic.Width, vbHimetric, vbTwips)
PicH = PicBox.ScaleY(Pic.Height, vbHimetric, vbTwips)
PicRate = PicW / PicH
' PicBox.Picture = Nothing
PicBox.Cls
If PicH <= PicBoxH And PicW <= PicBoxW Then
PicBox.PaintPicture Pic, (PicBoxW - PicW) / 2, (PicBoxH - PicH) / 2
Exit Sub
End If
If PicBoxRate < PicRate Then
NewH = PicBoxW / PicRate
PicBox.PaintPicture Pic, 0, (PicBoxH - NewH) / 2, PicBoxW, NewH
Else
NewW = PicBoxH * PicRate
PicBox.PaintPicture Pic, (PicBoxW - NewW) / 2, 0, NewW, PicBoxH
End If
' PicBox.Picture = Pic
End If
End Sub
新天
使用过ACDSEE的朋友一定对它的JPG图片旋转功能记忆犹新，其实我们利用VB6的先进功能，可以对任意格式的图片文件（包括JPG、GIF、BMP、ICO等）进行45度、180度旋转，确实可以和ACDSEE一较高下。
启动vb6建立一个标准exe工程，首先添加两个图片框（picture1和picture2），添加三个命令按钮command1（caption=“正常显示”）、command2（caption=“180度倒立”）、command3（caption=“45度旋转”），双击窗体，写入以下代码：
PrivateConstSRCCOPY=&HCC0020
PrivateConstPi=3.14
PrivateDeclareFunctionSetPixelLib"gdi32"(ByValhdcAsLong, ByValxAsLong,ByValyAsLong,ByValcrColorAsLong)AsLong
PrivateDeclareFunctionGetPixelLib"gdi32"(ByValhdcAsLong, ByValxAsLong,ByValyAsLong)AsLong
PrivateDeclareFunctionStretchBltLib"gdi32"(ByValhdcAsLong, ByValxAsLong,ByValyAsLong,ByValnWidthAsLong,ByValnHeightAsLong, ByValhSrcDCAsLong,ByValxSrcAsLong,ByValySrcAsLong,ByValnSrcWidth AsLong,ByValnSrcHeightAsLong,ByValdwRopAsLong)AsLong
privateSubbmp_rotate(pic1AsPictureBox,pic2AsPictureBox,ByValtheta)‘45度旋转
Dimc1xAsInteger,c1yAsInteger
Dimc2xAsInteger,c2yAsInteger
DimaAsSingle
Dimp1xAsInteger,p1yAsInteger
Dimp2xAsInteger,p2yAsInteger
DimnAsInteger,rAsInteger
c1x=pic1.ScaleWidth\2
c1y=pic1.ScaleHeight\2
c2x=pic2.ScaleWidth\2
c2y=pic2.ScaleHeight\2
Ifc2x<c2yThenn=c2yElsen=c2x
n=n-1
pic1hDC=pic1.hdc
pic2hDC=pic2.hdc
Forp2x=0Ton
Forp2y=0Ton
Ifp2x=0Thena=Pi/2Elsea=Atn(p2y/p2x)
r=Sqr(1&*p2x*p2x+1&*p2y*p2y)
p1x=r*Cos(a+theta)
p1y=r*Sin(a+theta)
c0&=GetPixel(pic1hDC,c1x+p1x,c1y+p1y)
c1&=GetPixel(pic1hDC,c1x-p1x,c1y-p1y)
c2&=GetPixel(pic1hDC,c1x+p1y,c1y-p1x)
c3&=GetPixel(pic1hDC,c1x-p1y,c1y+p1x)
Ifc0&<>-1ThenSetPixelpic2hDC,c2x+p2x,c2y+p2y,c0
Ifc1&<>-1ThenSetPixelpic2hDC,c2x-p2x,c2y-p2y,c1
Ifc2&<>-1ThenSetPixelpic2hDC,c2x+p2y,c2y-p2x,c2
Ifc3&<>-1ThenSetPixelpic2hDC,c2x-p2y,c2y+p2x,c3
Next
Next
EndSub
PrivateSubCommand1_Click()‘正常复制
Picture2.Cls
px=Picture1.ScaleWidth
py=Picture1.ScaleHeight
StretchBltPicture2.hdc,px,0,-px,py,Picture1.hdc,0,0,px,py,SRCCOPY
EndSub
PrivateSubCommand2_Click()‘180度倒立
Picture2.Cls
px=Picture1.ScaleWidth
py=Picture1.ScaleHeight
StretchBltPicture2.hdc,0,py,px,-py,Picture1.hdc,0,0,px,py,SRCCOPY
EndSub
PrivateSubCommand3_Click()‘45旋转
Picture2.Cls
Callbmp_rotate(Picture1,Picture2,3.14/4)
EndSub
PrivateSubForm_Load()
OnErrorResumeNext
Me.Caption=App.Title"添加应用程序标题
Me.Left=(Screen.Width-Me.Width)/2
Me.Top=(Screen.Height-Me.Height)/2"窗体具中
Picture1.ScaleMode=3
Picture2.ScaleMode=3
EndSub