Поворот изображения в ракурсе. Программирование

   Статья для программистов. Как в VB6 сделать поворот изображения в ракурсе.
   Посмотреть пример поворота можно в этом клипе - http://youtu.be/t8QZsydeA5o
   Поворот в ракурсе имитирует поворот цилиндра, отображённого на плоскость - прямоугольные зоны изображения последовательно копируются со сдвигом в указанную сторону, и одновременно изменяется их поперечный размер. Данный приём, также, как и копирование кругами http://proza.ru/2019/10/20/1299 может оказаться полезным для создания мультипликации.

КОПИРОВАНИЕ В РАКУРСЕ
                Для изменения ракурса выделенной кликами области
  нужно зафиксировать координаты этой области, кликнув кнопку Copy,
  а в текстовом окне поставить русскую букву о строчное - для поворота
  изображения вправо или влево. Для поворота влево перед буквой о нужно
  поставить знак минус. Число от 5 до 99-ти (по умолчанию 10), стоящее
  после буквы, определяет расквантовку и плавность поворота.
        Для поворота вверх или вниз ставится русская заглавная буква О.
        Поворот проводится кликом кнопки Paste.  При изменении ракурса
  лица рекомендуется дополнительно поворачивать нос и губы.

Обращение к подпрограмме при клике по кнопке "Paste":
  If InStr(Text1, "о") > 0 Then Call R4oPaste: Picture1.SetFocus: Exit Sub
  If InStr(Text1, "О") > 0 Then Call R4oPaste: Picture1.SetFocus: Exit Sub

Задаём массив, используемый в ракурс-повороте:
Public IJo(100) As Integer 'для ракурса

Public Sub R4oPaste() 'PaintPicture copy -ракурс поворот области
Dim I As Integer, J As Integer, DX As Integer, DY As Integer, M As Integer, K As Integer
Dim Io As Integer, Im As Integer, Jo As Integer, Jm As Integer, Mo As Integer
Dim SS As String, U As Single, W As Integer, H As Integer, IJ As Integer, DU As Single, A As Single
  Io = XX2: Im = XX1: If Io > Im Then Im = XX2: Io = XX1
  Jo = YY2: Jm = YY1: If Jo > Jm Then Jm = YY2: Jo = YY1
  W = Im - Io + 1: H = Jm - Jo + 1:
  Form1.Picture1.Picture = Form1.Picture1.Image
   SS = Form1.Text1: I = InStr(SS, "о"): M = 1: If I = 0 Then I = InStr(SS, "О"): M = 2
   N = 1: If InStr(SS, "-") > 0 Then N = 2
   K = Val(Mid(SS, I + 1)): If K < 5 Then K = 10
   If K > 99 Then K = 99
   DU = 3.14159 / K: U = 0
   For I = 1 To K + 1: A = (1 - Cos(U)) / 2
     If M = 1 Then IJo(I) = Io + A * W Else IJo(I) = Jo + A * H
   U = U + DU: Next I
   'Form1.Picture1.CurrentY = 0: Form1.Picture1.CurrentX = 0 'test
   'For I = 1 To K + 1: Form1.Picture1.Print I; IJo(I): Next I: Exit Sub 'test
   If N = 1 And M = 1 Then 'вправо
   For I = 1 To K - 1: IJ = IJo(I + 1): W = IJo(I + 2) - IJo(I + 1): If W = 0 Then W = 1
Form1.Picture1.PaintPicture Form1.Picture1, IJ, Jo, W, H, IJo(I), Jo, IJo(I + 1) - IJo(I) + 1, H
   Next I: End If '==========
   If N = 2 And M = 1 Then 'влево
   For I = 2 To K: IJ = IJo(I - 1): W = IJo(I) - IJo(I - 1): If W = 0 Then W = 1
Form1.Picture1.PaintPicture Form1.Picture1, IJ, Jo, W, H, IJo(I), Jo, IJo(I + 1) - IJo(I) + 1, H
   Next I: End If '==========
   If N = 1 And M = 2 Then 'вниз
   For I = 1 To K - 1: IJ = IJo(I + 1): H = IJo(I + 2) - IJo(I + 1): If H = 0 Then H = 1
Form1.Picture1.PaintPicture Form1.Picture1, Io, IJ, W, H, Io, IJo(I), W, IJo(I + 1) - IJo(I) + 1
   Next I: End If '==========
   If N = 2 And M = 2 Then 'вверх
   For I = 2 To K: IJ = IJo(I - 1): H = IJo(I) - IJo(I - 1): If H = 0 Then H = 1
Form1.Picture1.PaintPicture Form1.Picture1, Io, IJ, W, H, Io, IJo(I), W, IJo(I + 1) - IJo(I) + 1
   Next I: End If '==========
End Sub


Рецензии