VB6.0實現(xiàn)圖片旋轉(zhuǎn)
使用過
ACDSEE的朋友一定對它的
JPG圖片旋轉(zhuǎn)功能記憶猶新,其實我們利用
VB6的先進功能,可以對任意格式的圖片文件(包括JPG、GIF、
BMP、ICO等)進行45度、180度旋轉(zhuǎn),確實可以和ACDSEE一較高下。
啟動vb6建立一個標(biāo)準(zhǔn)exe工程,首先添加兩個圖片框(picture1和picture2),添加三個
命令按鈕command1(caption=“正常顯示”)、command2(caption=“180度倒立”)、command3(caption=“45度旋轉(zhuǎn)”),雙擊窗體,寫入以下代碼:
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度旋轉(zhuǎn)
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()‘正常復(fù)制
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旋轉(zhuǎn)
Picture2.Cls
Callbmp_rotate(Picture1,Picture2,3.14/4)
EndSub
PrivateSubForm_Load()
onErrorResumeNext
Me.Caption=App.Title"添加應(yīng)用程序標(biāo)題
Me.Left=(Screen.Width-Me.Width)/2
Me.Top=(Screen.Height-Me.Height)/2"窗體具中
Picture1.ScaleMode=3
Picture2.ScaleMode=3
EndSub
我只會做到下面的代碼了.其中:
Dir1-目錄列表控件
Drive1-驅(qū)動器列表控件
File1-文件列表控件
Image1-圖像控件
Text1-文本框控件
Option1-單選控件(Caption為"通過單擊瀏覽")
Option2-單選控件(Caption為"通過雙擊瀏覽")
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
On Error GoTo DriErr
Dir1.Path = Drive1.Drive
Exit Sub
DriErr:
If Err.Number = 68 Then
If MsgBox("請問要重試還是取消?", vbRetryCancel + vbCritical, "
硬盤不存在或光驅(qū)沒有插入磁盤!") = vbRetry Then
Resume 0
Else
Drive1.Drive = "C:"
Resume Next
End If
End If
End Sub
Private Sub File1_Click()
If Option2.Value = True Then Exit Sub
Dim picFile As String
If Right(Dir1.Path, 1) = "\" Then
picFile = Dir1.Path + File1.FileName
Else
picFile = Dir1.Path + "\" + File1.FileName
End If
Image1.Picture = LoadPicture(picFile)
Text1.Text = picFile
End Sub
Private Sub File1_DblClick()
If Option1.Value = True Then Exit Sub
Dim picFile As String
If Right(Dir1.Path, 1) = "\" Then
picFile = Dir1.Path + File1.FileName
Else
picFile = Dir1.Path + "\" + File1.FileName
End If
Image1.Picture = LoadPicture(picFile)
Text1.Text = picFile
End Sub