Date: 02-16-2022
Return to Index
created by gbSnippets
'... this code in work. PBWin9 version working, PBWin10 version not working.
'Compiler Comments:
'This code is written to compile in PBWin10. To compile in PBWin9, split pt
'into pt.x and pt.y as arguments wherever the PtinRect() API is used (2 places).
' iColorA = P(xstart-xcenter/2-1,ystart-ycenter/2-1)
' iColorB = P(xstart-xcenter/2+1,ystart-ycenter/2-1)
' iColorC = P(xstart-xcenter/2-1,ystart-ycenter/2+1)
' iColorD = P(xstart-xcenter/2+1,ystart-ycenter/2+1)
PixelPTR_source = PixelPTR_source - (ImageW -1)*4 : iColorA = @PixelPTR_Source
PixelPTR_source = PixelPTR_source + 8 : iColorB = @PixelPTR_Source
PixelPTR_source = PixelPTR_source + (2*ImageW)*4 : iColorC = @PixelPTR_Source
PixelPTR_source = PixelPTR_source - 8 : iColorD = @PixelPTR_Source
RComp = (GetRValue(iColor) + GetRValue(iColorA) + GetRValue(iColorB) + GetRValue(iColorC) + GetRValue(iColorD) ) / 5
GComp = (GetGValue(iColor) + GetGValue(iColorA) + GetGValue(iColorB) + GetGValue(iColorC) + GetGValue(iColorD) ) / 5
BComp = (GetBValue(iColor) + GetBValue(iColorA) + GetBValue(iColorB) + GetBValue(iColorC) + GetBValue(iColorD) ) / 5
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "win32api.inc"
#Resource "gbsnippets.pbr"
%IDC_Graphic = 501
%IDC_LabelA = 502
%IDC_LabelB = 503
%IDC_Button1 = 504
%IDC_Button2 = 505
Global hDlg,hBMP As Dword, ImageH, ImageW As Long, trc As Rect
Global ContainerW, ContainerH, XCenter, YCenter As Long
Global P() As Long
Function PBMain() As Long
Dialog New Pixels, 0, "Rotate Image",300,300,375,300, %WS_SysMenu, 0 To hDlg
Control Add Label, hDlg, %IDC_LabelA, "<timer results>", 10,10,100,20
Control Add Label, hDlg, %IDC_LabelB, "", 10,260,200,20
Control Add Button, hDlg, %IDC_Button1,"Pointer", 10,70,80,20
Control Add Button, hDlg, %IDC_Button2,"Interpolation", 10,100,80,20
Control Add Graphic, hDlg, %IDC_Graphic,"", 125,10,200,200
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local T As Quad, i,x,y,w,h As Long, bmp$
Static theta As Single
Select Case Cb.Msg
Case %WM_InitDialog
'put Resource image into memory bitmap - get WxH of the image
Graphic Bitmap Load "cowgirl", 0, 0 To hBMP
Graphic Attach hBMP, 0
Graphic Get Client To ImageW,ImageH
'put color values of original image into an array
ReDim P(ImageW,ImageH)
Graphic Get Bits To bmp$
w = CVL(bmp$,1) : h = CVL(bmp$,5)
For x = 0 to w
For y = 0 to h
P(x,y) = CVL(bmp$, (y*w+x)*4+8 )
Next y
Next x
'get size of graphic control (must be big enough to hold rotated image)
Graphic Attach hDlg, %IDC_Graphic
Graphic Get Client To ContainerW, ContainerH 'HxW of graphic control
XCenter = ContainerW/2 : YCenter = ContainerH/2 'center of rotation in graphic control
theta = 0.3
trc.nleft = 0 : trc.nright = ImageW-1 : trc.ntop = 0 : trc.nbottom = ImageH-1 'orig image boundaries
Case %WM_LButtonDblClk
Graphic Attach hDlg, %IDC_Graphic
Graphic Clear
Case %WM_MouseWheel
Select Case Hi(Integer,Cb.WParam) 'note the use of Integer
Case > 0 : theta = theta + 0.2 : Graphic Attach hDlg, %IDC_Graphic,ReDraw : Graphic Clear : RotateImageA(theta)
Case < 0 : theta = theta - 0.2 : Graphic Attach hDlg, %IDC_Graphic,ReDraw : Graphic Clear : RotateImageA(theta)
End Select
Case %WM_Command
Select Case Cb.Ctl
Case %IDC_Button1 : Tix T : RotateImageA(theta) : Tix End T : Control Set Text hDlg, %IDC_LabelA, Format$(T, "###,###,###")
Case %IDC_Button2 : Tix T : RotateImageB(theta) : Tix End T : Control Set Text hDlg, %IDC_LabelA, Format$(T, "###,###,###")
End Select
End Select
End Function
Sub RotateImageA(theta As Single)
Local x1,x2,y1,y2,x,y As Long, sintheta, costheta As Single
Local BoundW, BoundH, XStart, YStart, iColor As Long
Local bmp_source$, bmp_target$, pt as Point
Local PixelPTR_source, PixelPTR_target As Long PTR, iSource, iTarget As Long
'pre-calculate some values
sintheta = Sin(theta) : costheta = Cos(theta)
'get size of rectangle that will bound the rotated image
BoundW = ImageW*Abs(Costheta) + ImageH*Abs(Sintheta)
BoundH = ImageH*Abs(Costheta) + ImageW*Abs(Sintheta)
'calculate coordinates of the bounding box (enclosing the rotated points)
x1 =(ContainerW-BoundW)/2 : y1 =(ContainerH-BoundH)/2
x2 = x1 + BoundW - 1 : y2 = y1 + BoundH - 1
'work with bit strings from each image
Graphic Attach hBMP, 0, Redraw : Graphic Get Bits To bmp_source$
Graphic Attach hDlg, %IDC_Graphic, Redraw : Graphic Get Bits To bmp_target$
PixelPTR_source = StrPtr(bmp_source$) + 8 : iSource = PixelPTR_source
PixelPTR_target = StrPtr(bmp_target$) + 8 : iTarget = PixelPTR_target
For x = x1 To x2
For y = y1 To y2
XStart = XCenter + (x - XCenter) * Costheta - (y - YCenter) * Sintheta 'unrotated x
YStart = YCenter + (x - XCenter) * Sintheta + (y - YCenter) * Costheta 'unrotated y
PixelPTR_source = iSource + ((YStart-YCenter/2)*ImageW+(XStart-XCenter/2))*4
PixelPTR_target = iTarget + (y * ContainerW + x ) * 4
pt.x = XStart-XCenter/2 : pt.y = YStart-YCenter/2
@PixelPTR_target = IIf(PtInRect(trc, pt) , @PixelPTR_source, Bgr(%RGB_Moccasin))
Next y
Next x
Graphic Set Bits bmp_target$
Graphic Box (x1-1,y1-1)-(x2+1,y2+1),, %Red
Graphic ReDraw
Control Set Text hDlg, %IDC_LabelB, str$(ImageW) + str$(ImageH) + str$(ContainerW) + str$(ContainerH) + str$(BoundW) + str$(BoundH) + str$(x1) + str$(y1) + str$(x2) + str$(y2)
End Sub
Sub RotateImageB(theta As Single)
Local x1,x2,y1,y2,x,y As Long, sintheta, costheta As Single
Local BoundW, BoundH, XStart, YStart, iColor As Long
Local bmp_source$, bmp_target$, pt As Point
Local PixelPTR_source, PixelPTR_target As Long PTR, iSource, iTarget As Long
Local iCA,iCB,iCC,iCD,iCE,iCF,iCG,iCH, RComp, GComp, BComp As Long
'pre-calculate some values
sintheta = Sin(theta) : costheta = Cos(theta)
'get size of rectangle that will bound the rotated image
BoundW = ImageW*Abs(Costheta) + ImageH*Abs(Sintheta)
BoundH = ImageH*Abs(Costheta) + ImageW*Abs(Sintheta)
'calculate coordinates of the bounding box (enclosing the rotated points)
x1 =(ContainerW-BoundW)/2 : y1 =(ContainerH-BoundH)/2
x2 = x1 + BoundW - 1 : y2 = y1 + BoundH - 1
'work with bit strings from each image
Graphic Attach hBMP, 0, Redraw : Graphic Get Bits To bmp_source$
Graphic Attach hDlg, %IDC_Graphic, Redraw : Graphic Get Bits To bmp_target$
PixelPTR_source = StrPtr(bmp_source$) + 8 : iSource = PixelPTR_source
PixelPTR_target = StrPtr(bmp_target$) + 8 : iTarget = PixelPTR_target
For x = x1 To x2
For y = y1 To y2
XStart = XCenter + (x - XCenter) * Costheta - (y - YCenter) * Sintheta 'unrotated x
YStart = YCenter + (x - XCenter) * Sintheta + (y - YCenter) * Costheta 'unrotated y
PixelPTR_source = iSource + ((YStart-YCenter/2)*ImageW+(XStart-XCenter/2))*4
'sample 4 nearby pixels, which frame the selected pixel
iColor = @PixelPTR_Source
PixelPTR_source = PixelPTR_source - (ImageW -1)*4 : iCA = @PixelPTR_Source
PixelPTR_source = PixelPTR_source + 4 : iCB = @PixelPTR_Source
PixelPTR_source = PixelPTR_source + 4 : iCC = @PixelPTR_Source
PixelPTR_source = PixelPTR_source + (2*ImageW)*4 : iCD = @PixelPTR_Source
PixelPTR_source = PixelPTR_source - 4 : iCE = @PixelPTR_Source
PixelPTR_source = PixelPTR_source - 4 : iCF = @PixelPTR_Source
'get average of R, G, B components
RComp = (GetRValue(iColor) + GetRValue(iCA) + GetRValue(iCB) + GetRValue(iCC) + GetRValue(iCD) + GetRValue(iCE) + GetRValue(iCF) ) / 7
GComp = (GetGValue(iColor) + GetGValue(iCA) + GetGValue(iCB) + GetGValue(iCC) + GetGValue(iCD) + GetGValue(iCE) + GetGValue(iCF) ) / 7
BComp = (GetBValue(iColor) + GetBValue(iCA) + GetBValue(iCB) + GetBValue(iCC) + GetBValue(iCD) + GetBValue(iCE) + GetBValue(iCF) ) / 7
PixelPTR_target = iTarget + (y * ContainerW + x ) * 4
pt.x = XStart-XCenter/2 : pt.y = YStart-YCenter/2
@PixelPTR_target = IIf(PtInRect(trc, pt) , RGB(RComp,GComp,BComp), Bgr(%RGB_Moccasin))
Next y
Next x
Graphic Set Bits bmp_target$
Graphic Box (x1-1,y1-1)-(x2+1,y2+1),, %Red
Graphic ReDraw
Control Set Text hDlg, %IDC_LabelB, str$(ImageW) + str$(ImageH) + str$(ContainerW) + str$(ContainerH) + str$(BoundW) + str$(BoundH) + str$(x1) + str$(y1) + str$(x2) + str$(y2)
End Sub
'gbs_00914
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm