Rotate Bitmap II

Category: Rotation

Date: 03-28-2012

Return to Index


 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Resource "gbsnippets.pbr"
 
Type gbPoint
   x  As Long      'new x position
   y As Long       'new y position
   col As Long     'color of pixel
End Type
 
   %IDC_Graphic = 501
   %IDC_Label   = 502
   %IDC_Button0 = 503
   %IDC_Button1 = 504
   %IDC_Button2 = 505
   %IDC_Button3 = 506
 
   Global hDlg As Dword, theta As Single
 
Function PBMain() As Long
   Dialog New Pixels, 0, "Rotate Image",300,300,375,300, %WS_SysMenu, 0 To hDlg
   Control Add Label, hDlg, %IDC_Label, "<timer>", 10,10,125,20
   Control Add Button, hDlg, %IDC_Button0,"Reset", 10,40,50,20
   Control Add Button, hDlg, %IDC_Button1,"1", 10,70,50,20
   Control Add Button, hDlg, %IDC_Button2,"2", 10,100,50,20
   Control Add Graphic, hDlg, %IDC_Graphic,"", 80,10,200,200, %WS_Border
   Graphic Attach hDlg, %IDC_Graphic, Redraw
   Graphic Render "cowgirl", (50,50)-(149,149)
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local T as Quad, i As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         theta = 0.1
      Case %WM_MouseWheel
         Select Case Hi(Integer,Cb.WParam)    'note the use of Integer
            Case > 0 : theta = theta + 0.2 : RotateImage_GetPixelB
            Case < 0 : theta = theta - 0.2 : RotateImage_GetPixelB
         End Select
 
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDC_Button0 : Graphic Attach hDlg, %IDC_Graphic : Graphic Clear
               Graphic Render "cowgirl", (50,50)-(149,149)    'same size (could resize)
            Case %IDC_Button1 : Tix T : RotateImage_GetPixelA : Tix End T : Control Set Text hDlg, %IDC_Label, Format$(T, "###,###,###")
               '            Case %IDC_Button2 : Tix T : RotateImage_GetPixelB : Tix End T : Control Set Text hDlg, %IDC_Label, Format$(T, "###,###,###")
               '            Case %IDC_Button3 : Tix T : RotateImage_GetPixelC : Tix End T : Control Set Text hDlg, %IDC_Label, Format$(T, "###,###,###")
         End Select
   End Select
End Function
 
Sub RotateImage_GetPixelA  'slower
   Local c,i,j,w,h,x,y,XCenter,YCenter, bW, bH, oldX, oldY As Long
   Dim D(200,200) As gbPoint
   theta = 0.5  :  XCenter = 100 : YCenter = 100
 
   'capture source image into array D()
   Graphic Attach hDlg, %IDC_Graphic, Redraw
   For x = 50 to 149
      For y = 50 To 149
         Graphic Get Pixel (x,y) To D(x,y).col
      Next y
   Next x
 
   Graphic Clear
   bW = 100*ABS(cos(theta)) + Y*ABS(sin(theta))
   bH = 100*ABS(cos(theta)) + X*ABS(sin(theta))
 
   For x = (200-bw)/2 To bw
      For y = (200-bh)/2 To bh
         oldx = XCenter + (x - XCenter) * Cos(-theta) - (y - YCenter) * Sin(-theta)
         oldy = YCenter + (x - XCenter) * Sin(-theta) + (y - YCenter) * Cos(-theta)
         Graphic Set Pixel (D(x,y).x,D(x,y).y), D(x,y).Col
      Next y
   Next x
   Graphic Redraw
End Sub
 
Sub RotateImage_GetPixelB  'faster
   Local w,h,x,y,XCenter,YCenter As Long, sintheta, costheta As Single, bmp$
   Dim D(200,200) As gbPoint
   XCenter = 100 : YCenter = 100
   sintheta = sin(theta) : costheta = cos(theta)
   Graphic Attach hDlg, %IDC_Graphic, Redraw
   Graphic Render "cowgirl", (50,50)-(149,149)
   Graphic Get Bits To bmp$
   w = CVL(bmp$,1) : h = CVL(bmp$,5)
   For x = 50 to 149
      For y = 50 to 149
         D(x,y).x = XCenter + (x - XCenter) * Costheta - (y - YCenter) * Sintheta
         D(x,y).y = YCenter + (x - XCenter) * Sintheta + (y - YCenter) * Costheta
         D(x,y).Col = CVL(bmp$, (y*w+x)*4+8 )
      Next y
   Next x
   Graphic Clear : Graphic Get Bits To bmp$
   For x = 50 to 149
      For y = 50 to 149
         Mid$(bmp$,(D(x,y).y * w + D(x,y).x)*4+8,4) = Mkl$(D(x,y).col)
      Next y
   Next x
   Graphic Set Bits bmp$ : Graphic Redraw
End Sub
 
'gbs_00930
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm