to Dasharm to Crusty: пример работает быстро, поворачивается и двигается в нужном напрвлении

<------------------------------------------------------------------------------->

'В модуль:

Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

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&)

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWid As Long, ByVal nHt As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long

Const SRCCOPY = &HCC0020

Public Const Pi = 3.14159265359

Public Sub BmpRotate(pic1 As PictureBox, pic2 As PictureBox, ByVal theta!)

' Поворот изображениея в picture box.

' pic1 - picture box с картинкой, которую будем вращать.

' pic2 - picture box, получающий результирующую картинку

' theta - угол вращения

'

Dim c1x As Long, c1y As Long

Dim c2x As Long, c2y As Long

Dim pic1hDC As Long, pic2hDC As Long

Dim a As Single

Dim p1x As Long, p1y As Long

Dim p2x As Long, p2y As Long

Dim n As Long, r As Long

pic1.ScaleMode = 3

pic2.ScaleMode = 3

c1x = pic1.ScaleWidth \ 2

c1y = pic1.ScaleHeight \ 2

c2x = pic2.ScaleWidth \ 2

c2y = pic2.ScaleHeight \ 2

If c2x < c2y Then n = c2y Else n = c2x

n = n - 1

pic1hDC = pic1.hdc

pic2hDC = pic2.hdc

For p2x = 0 To n

For p2y = 0 To n

If p2x = 0 Then a = Pi / 2 Else a = 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)

If c0& <> -1 Then xret& = SetPixel(pic2hDC, c2x + p2x, c2y + p2y, c0&)

If c1& <> -1 Then xret& = SetPixel(pic2hDC, c2x - p2x, c2y - p2y, c1&)

If c2& <> -1 Then xret& = SetPixel(pic2hDC, c2x + p2y, c2y - p2x, c2&)

If c3& <> -1 Then xret& = SetPixel(pic2hDC, c2x - p2y, c2y + p2x, c3&)

Next

t% = DoEvents()

Next

End Sub

'В форму:

Dim gradus

Private Sub Command1_Click()

BmpRotate pic1, pic2, Text1.Text

End Sub

Private Sub Timer1_Timer()

gradus = gradus + 10

End Sub

Private Sub Form_Click()

MsgBox pic1.hdc

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = vbKeyLeft Then gradus = gradus + 3.49065850398889E-02: Me.Cls: Print gradus / 1.74532925199444E+31

If KeyCode = vbKeyRight Then gradus = gradus - 3.49065850398889E-02: Me.Cls: Print gradus / 1.74532925199444E+31

If KeyCode = vbKeyUp Then pic2.Top = pic2.Top - 20 * Cos(gradus): pic2.Left = pic2.Left - 20 * Sin(gradus)

BmpRotate pic1, pic2, gradus

End Sub

Private Sub Form_Load()

gradus = 0

End Sub

Ответить