另一種VB映像旋轉的方法

來源:互聯網
上載者:User

    一般來說,大家都會使用PlgBlt進行映像旋轉,其實系統還提供了另一種旋轉方式——座標轉換,為了示範使用座標轉換進行圖象旋轉的方法,我編了一個通用的圖象旋轉類,代碼如下:

     '建立一個CDC.cls的名檔案,將下面代碼粘貼進去即可。

'* ******************************************************* *<br />'* 程式名稱:CDC.cls<br />'* 程式功能:利用座標轉換旋轉圖形<br />'* 作者:lyserver<br />'* ******************************************************* *<br />Option Explicit<br />'資料類型定義<br />Private Type POINTAPI<br /> X As Long<br /> Y As Long<br />End Type<br />Private Type RECT<br /> Left As Long<br /> Top As Long<br /> Right As Long<br /> Bottom As Long<br />End Type<br />Private Type BITMAP '14 bytes<br /> bmType As Long<br /> bmWidth As Long<br /> bmHeight As Long<br /> bmWidthBytes As Long<br /> bmPlanes As Integer<br /> bmBitsPixel As Integer<br /> bmBits As Long<br />End Type<br />Private Type XFORM<br /> eM11 As Single<br /> eM12 As Single<br /> eM21 As Single<br /> eM22 As Single<br /> eDx As Single<br /> eDy As Single<br />End Type<br />'API聲明<br />Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long<br />Private Declare Function CopyRect Lib "user32" (lpDestRect As RECT, lpSourceRect As RECT) As Long<br />Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long<br />Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long<br />Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long<br />Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long<br />Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long<br />Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long<br />Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long<br />Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long<br />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<br />Private Declare Function SetGraphicsMode Lib "gdi32" (ByVal hDC As Long, ByVal iMode As Long) As Long<br />Private Const GM_ADVANCED = 2<br />Private Declare Function GetWorldTransform Lib "gdi32" (ByVal hDC As Long, lpXform As XFORM) As Long<br />Private Declare Function SetWorldTransform Lib "gdi32" (ByVal hDC As Long, lpXform As XFORM) As Long<br />Private Declare Function DPtoLP Lib "gdi32" (ByVal hDC As Long, ByVal lpPoint As Long, ByVal nCount As Long) As Long</p><p>'自訂常量<br />Private Const PI As Single = 3.14159265358979</p><p>'自訂模組層級變數<br />Dim m_hSrcDC As Long<br />Dim m_hSrcBmp As Long, m_hOldSrcBmp As Long<br />Dim m_rcSrc As RECT</p><p>'綁定指定的圖片<br />Public Function Bind(ByVal Pic As StdPicture) As Boolean<br /> Dim bm As BITMAP<br /> Dim hBitmap As Long<br /> Dim clrBackground As Long<br /> Dim maxWidth(1) As Long, maxHeight(1) As Long<br /> Dim fRadian As Double, fSin As Double, fCos As Double<br /> Dim hDesktopDC As Long</p><p> '釋放記憶體資源<br /> Call Class_Terminate<br /> '如果Pic為Nothing,直接退出<br /> If TypeName(Pic) = "Nothing" Then Exit Function<br /> '獲得源映像資訊<br /> If GetObjectAPI(Pic.Handle, Len(bm), bm) = 0 Then Exit Function<br /> SetRect m_rcSrc, 0, 0, bm.bmWidth, bm.bmHeight<br /> '獲得案頭DC<br /> hDesktopDC = GetDC(0)<br /> '建立記憶體DC<br /> m_hSrcDC = CreateCompatibleDC(hDesktopDC)<br /> '建立記憶體位元影像<br /> m_hSrcBmp = CreateCompatibleBitmap(hDesktopDC, m_rcSrc.Right, m_rcSrc.Bottom)<br /> m_hOldSrcBmp = SelectObject(m_hSrcDC, m_hSrcBmp)<br /> '釋放案頭DC<br /> ReleaseDC 0, hDesktopDC<br /> '繪製源映像<br /> Pic.Render CLng(m_hSrcDC), 0, 0, CLng(m_rcSrc.Right), CLng(m_rcSrc.Bottom), 0, Pic.Height, Pic.Width, -Pic.Height, 0<br /> '設定傳回值<br /> Bind = True<br />End Function</p><p>'在指定的DC上旋轉映像<br />Public Sub Rotate(ByVal hDC As Long, Optional ByVal lAngle As Long = 0)<br /> Static myXFORM As XFORM<br /> Static rcDraw As RECT<br /> Static startPt As POINTAPI<br /> Static lGraphicsMode As Long, lMapMode As Long<br /> Static fRadian As Single, fSin As Single, fCos As Single</p><p> '如果DC非法則退出<br /> If (m_hSrcDC = 0) Or (hDC = 0) Then Exit Sub</p><p> '修改繪圖模式和座標<br /> lGraphicsMode = SetGraphicsMode(hDC, GM_ADVANCED)<br /> fRadian = PI * lAngle / 180 '角度轉換為弧度<br /> fSin = Sin(fRadian)<br /> fCos = Cos(fRadian)<br /> myXFORM.eM11 = Round(fCos, 4)<br /> myXFORM.eM12 = Round(fSin, 4)<br /> myXFORM.eM21 = Round(-fSin, 4)<br /> myXFORM.eM22 = Round(fCos, 4)<br /> myXFORM.eDx = 0<br /> myXFORM.eDy = 0<br /> Call SetWorldTransform(hDC, myXFORM)<br /> '轉換裝置座標為邏輯座標<br /> rcDraw.Top = 0<br /> rcDraw.Left = 0<br /> rcDraw.Right = m_rcSrc.Right<br /> rcDraw.Bottom = m_rcSrc.Bottom<br /> Call DPtoLP(hDC, ByVal VarPtr(rcDraw), 2)<br /> '計算旋轉後的起始座標<br /> startPt.X = (rcDraw.Right - m_rcSrc.Right) / 2<br /> startPt.Y = (rcDraw.Bottom - m_rcSrc.Bottom) / 2<br /> '在旋轉後的DC複製映像<br /> BitBlt hDC, startPt.X, startPt.Y, m_rcSrc.Right, m_rcSrc.Bottom, m_hSrcDC, 0, 0, vbSrcCopy<br /> '恢複繪圖模式和座標<br /> 'SetWorldTransform hDC, m_oldXFORM<br /> 'SetGraphicsMode hDC, lGraphicsMode<br />End Sub</p><p>'釋放記憶體資源<br />Private Sub Class_Terminate()<br /> If m_hSrcBmp <> 0 Then<br /> DeleteObject SelectObject(m_hSrcDC, m_hOldSrcBmp)<br /> End If<br /> DeleteDC m_hSrcDC<br />End Sub</p><p>二?調用代碼:</p><p>Option Explicit<br />Dim m_lDegree As Long<br />Dim m_DC As CDC</p><p>Private Sub Form_Load()<br /> Set m_DC = New CDC<br /> m_DC.Bind LoadPicture("c:/temp/temp1.jpg") '綁定到1幅400*300的映像上<br />End Sub</p><p>Private Sub Form_Unload(Cancel As Integer)<br /> Set m_DC = Nothing<br />End Sub</p><p>Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)<br /> If Button = 1 Then<br /> m_lDegree = CalcAngle(X, Y, True) '初始化角度<br /> End If<br />End Sub</p><p>Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)<br /> If Button = 1 Then '隨滑鼠旋轉映像<br /> m_lDegree = CalcAngle(X, Y)<br /> m_DC.Rotate Picture1.hDC, m_lDegree<br /> End If<br />End Sub</p><p>Private Sub Picture1_Paint()<br /> m_DC.Rotate Picture1.hDC, m_lDegree<br />End Sub</p><p>'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><br />' 計算滑鼠移動的角度<br />' 由於數學全忘了,此函數從http://www.tenlin.com/read.php/161.htm中的VC代碼改編而來<br />Public Function CalcAngle(ByVal X As Single, ByVal Y As Single, Optional ByVal bReset As Boolean) As Long<br /> Static old_X As Single, old_Y As Single<br /> Dim tmp_X As Single, tmp_Y As Single, dist As Double<br /> Const PI As Single = 3.14159265358979</p><p> '重設原來的滑鼠位置<br /> If bReset Or (old_X = 0 And old_Y = 0) Then<br /> old_X = X<br /> old_Y = Y<br /> Exit Function<br /> End If</p><p> '計算滑鼠移動的距離<br /> tmp_X = (X - old_X) ^ 2<br /> tmp_Y = (Y - old_Y) ^ 2<br /> dist = Sqr(tmp_X + tmp_Y)<br /> '計算滑鼠移動的角度<br /> tmp_X = Abs(X - old_X)<br /> tmp_Y = Abs(Y - old_Y)<br /> If Y > old_Y Then<br /> If X > old_X Then<br /> CalcAngle = Cos(tmp_X / dist) * 180 / PI + 90<br /> ElseIf X = old_X Then<br /> CalcAngle = 180<br /> Else<br /> CalcAngle = -Atn(tmp_Y / tmp_X) * 108 / PI + 90<br /> End If<br /> ElseIf Y < old_Y Then<br /> If X > old_X Then<br /> CalcAngle = Sin(tmp_X / dist) * 180 / PI<br /> ElseIf X = old_X Then<br /> CalcAngle = 0<br /> Else<br /> CalcAngle = -Atn(tmp_X / tmp_Y) * 180 / PI<br /> End If<br /> Else<br /> If X > old_X Then<br /> CalcAngle = 90<br /> ElseIf X = old_X Then<br /> CalcAngle = 0<br /> Else<br /> CalcAngle = -90<br /> End If<br /> End If<br /> old_X = X<br /> old_Y = Y<br />End Function<br />'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>></p><p>

 

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.