Draw Boxes at Angle

Date: 02-16-2022

Return to Index

 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 10
#Compile Exe  "demo.exe"
#Dim All
 
#Debug Error On
#Debug Display On
 
%Unicode=1
#Include "Win32API.inc"   'Jose Roca Includes
%Color = %Blue
 
Type BoxType
   count As Long
   x1 As Single
   y1 As Single
   x2 As Single
   y2 As Single
   x3 As Single
   y3 As Single
   x4 As Single
   y4 As Single
End Type
 
Enum Equates Singular
   IDC_Graphic = 500
   IDC_Filled
   IDC_Clear
End Enum
 
Global hDlg,hGraphic As Dword, BoxRC As Rect
Global BoxDrawInWork, OldGraphicProc,Vertical,Filled,VH As Long
 
Function PBMain() As Long
   Dialog New Pixels, 0, "gbBox",300,300,300,200, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, %IDC_Clear, "Clear",10,7,50,20
   Control Add CheckBox, hDlg, %IDC_Filled, "Filled",100,7,50,20
'   Control Add CheckBox, hDlg, %IDC_VH,"Vert/Horz", 100,7,70,20
   Control Add Graphic, hDlg, %IDC_Graphic,"", 0,30,10,10, %WS_Visible Or %WS_Border Or %SS_Notify
   Control Handle hDlg, %IDC_Graphic To hGraphic
   OldGraphicProc = SetWindowLong(hGraphic, %GWL_WndProc, CodePtr(NewGraphicProc))  'subclass
   Graphic Attach hDlg, %IDC_Graphic, ReDraw
   Graphic Color %Color, %rgb_LightGray
   Graphic Clear
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case Cb.Msg
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDC_Clear    : Reset BoxRC   : DrawBox
            Case %IDC_Filled   : Filled Xor= 1   : DrawBox
         End Select
      Case %WM_Destroy
         SetWindowLong hGraphic, %GWL_WNDPROC, OldGraphicProc
      Case %WM_Size
         ResizeWindow
   End Select
End Function
 
Sub ResizeWindow
   Local w,h,vw,vh As Long
   Dialog Get Client hDlg To w,h
   Control Set Size hDlg, %IDC_Graphic, w,h-30
End Sub
 
Function NewGraphicProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Local pt As Point,rc As Rect, i,iResult,ddx,ddy As Long
   Select Case Msg
       Case %WM_LButtonUp
          BoxDrawInWork = 0
          ReleaseCapture
       Case %WM_LButtonDown
          BoxDrawInWork = 1
          SetFocus
          SetCapture hGraphic
          BoxRC.nLeft = Lo(Integer,LParam) : BoxRC.nRight = BoxRC.nLeft
          BoxRC.nTop = Hi(Integer, LParam) : BoxRC.nBottom = BoxRC.nTop
       Case %WM_MouseMove
          If BoxDrawInWork Then
             BoxRC.nRight = Lo(Integer,LParam)
             BoxRC.nBottom = Hi(Integer, LParam)
             DrawBox
          End If
   End Select
   Function = CallWindowProc(OldGraphicProc, hWnd, Msg, wParam, lParam)
End Function
 
Sub DrawBox
   Local a,b,c,d,e,f,dist As Single, Box As BoxType, unit,rx,ry As Single
   Graphic Clear
   'just to make typing easier in the equations
   a = BoxRC.nLeft   :  b = BoxRC.nTop
   c = BoxRC.nRight  :  d = BoxRC.nBottom
   rx = a-c   : ry = b-d
   dist = Sqr(rx*rx + ry*ry)
   rx /= dist : ry /= dist
   unit = 1/4 * dist
   Box.count = 4
   Box.x1 = a+unit*ry   : Box.y1 = b-unit*rx
   Box.x2 = c+unit*ry   : Box.y2 = d-unit*rx
   Box.x3 = c-unit*ry   : Box.y3 = d+unit*rx
   Box.x4 = a-unit*ry   : Box.y4 = b+unit*rx
   Graphic Polygon Box, %Color, IIf(Filled,%Color,-2)
   Graphic ReDraw
End Sub
 
'gbs_01409
'Date: 10-17-2014

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