Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#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
http://www.garybeene.com/sw/gbsnippets.htm