!Viper! писал(а):Как это не прискорбно, но никак. по крайней мере я такого способа не знаю. надо брать другой контрол
tyomitch писал(а):А, солидный дядька вернулся?
Rostik, где незасвеченный айпишник надыбал?
Private Sub Rotate3()
picTwo.Cls
picOne.ScaleMode = vbPixels
picTwo.ScaleMode = vbPixels
'угол поворота в радианах
Dim da As Double: da = HScroll1.Value * pi / 180
'матрица преобразования
Dim XF As XFORM
XF.eM11 = Cos(da)
XF.eM12 = Sin(da)
XF.eM21 = -Sin(da)
XF.eM22 = Cos(da)
'устанавливаем расширенный графический режим
SetGraphicsMode picTwo.hdc, GM_ADVANCED
'поворачиваем мир на нужный угол
Dim r As Long: r = SetWorldTransform(picTwo.hdc, XF) 'возвращает 0, что указывает на ошибку
'копируем изображение
BitBlt picTwo.hdc, (picTwo.ScaleWidth - picOne.ScaleWidth) / 2, (picTwo.ScaleHeight - picOne.ScaleHeight) / 2, picOne.ScaleWidth, picOne.ScaleHeight, picOne.hdc, 0, 0, vbSrcCopy
End Sub
Private Sub Rotate4()
picOne.ScaleMode = vbPixels
picTwo.ScaleMode = vbPixels
Dim da As Double: da = HScroll1.Value * pi / 180
'создаем контекст устройства памяти
Dim memDC As Long: memDC = CreateCompatibleDC(picTwo.hdc)
Dim memBmp As Long: memBmp = CreateCompatibleBitmap(picTwo.hdc, picTwo.ScaleWidth, picTwo.ScaleHeight)
Dim oldBmp As Long: oldBmp = SelectObject(memDC, memBmp)
Dim nX As Integer, nY As Integer
Dim nX1 As Integer, nY1 As Integer
Dim dX2 As Double, dY2 As Double
Dim dX3 As Double, dY3 As Double
For nX = 0 To picTwo.ScaleWidth
nX1 = nX - picTwo.ScaleWidth \ 2
For nY = 0 To picTwo.ScaleHeight
nY1 = nY - picTwo.ScaleHeight \ 2
'поворачиваем картинку на угол da
dX2 = nX1 * Cos(-da) + nY1 * Sin(-da)
dY2 = nY1 * Cos(-da) - nX1 * Sin(-da)
'получаем центр нашего исходного picture box
dX3 = dX2 + picOne.ScaleWidth \ 2
dY3 = dY2 + picOne.ScaleHeight \ 2
'If data point is in picOne, set its color in picTwo
If dX3 > 0 And dX3 < picOne.ScaleWidth - 1 _
And dY3 > 0 And dY3 < picOne.ScaleHeight - 1 Then
'устанавливаем пиксели в памяти
SetPixelV memDC, nX, nY, GetPixel(picOne.hdc, CLng(dX3), CLng(dY3))
End If
Next nY
Next nX
'копируем картинку в PictureBox
BitBlt picTwo.hdc, 0, 0, picTwo.ScaleWidth, picTwo.ScaleHeight, memDC, 0, 0, vbSrcCopy
'удаляем созданные объекты
SelectObject memDC, oldBmp
DeleteObject memBmp
DeleteDC memDC
End Sub
Private Sub Rotate3()
picTwo.Cls
picOne.ScaleMode = vbPixels
picTwo.ScaleMode = vbPixels
'угол поворота в радианах
Dim da As Double: da = HScroll1.Value * pi / 180
'матрица преобразования
Dim XF As XFORM
XF.eDx = picTwo.ScaleWidth / 2
XF.eDy = picTwo.ScaleHeight / 2
XF.eM11 = Cos(-da)
XF.eM12 = Sin(-da)
XF.eM21 = -Sin(-da)
XF.eM22 = Cos(-da)
'устанавливаем расширенный графический режим
SetGraphicsMode picTwo.hdc, GM_ADVANCED
'смещаем и поворачиваем мир на нужную величину
SetWorldTransform picTwo.hdc, XF
'копируем изображение
BitBlt picTwo.hdc, -picOne.ScaleWidth \ 2, -picOne.ScaleHeight \ 2, picOne.ScaleWidth, picOne.ScaleHeight, picOne.hdc, 0, 0, vbSrcCopy
End Sub
Sasha_karasov писал(а):А не скажете формулу для вращения точки на угол A
GSerg писал(а):SetWorldTransform не работает на Win95/98/Me.
Делайте выводы.
!Viper! писал(а):Обещанный анализ версии от A.A.G.
...
З.Ы. Скорость вращаения зависит и от размера картинки - картинка A.A.G меньше чем у Rostic_Utra(2)
Сейчас этот форум просматривают: AhrefsBot, Google-бот и гости: 85