Free Style Line Direction

Category: Drawing

Date: 02-16-2022

Return to Index


 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 10
#Compile Exe
#Dim All
%Unicode = 1
#Include "Win32API.inc"
 
Enum Equates Singular
   IDC_Graphic = 500
   IDC_Clear
   IDC_Calculate
   IDC_Result
End Enum
 
Global hDlg As Dword, LastX, LastY As Long
 
Function PBMain() As Long
   Dialog New Pixels, 0, "Free-Style Line Direction",300,300,300,270, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, %IDC_Calculate, "Result", 60,10,40,20
   Control Add Button, hDlg, %IDC_Clear, "Clear", 10,10,40,20
   Control Add Label, hDlg, %IDC_Result, " Draw a free-style line, Press Result",110,10,180,25, %WS_Border Or %SS_CenterImage
   Control Add Graphic, hDlg, %IDC_Graphic,"", 0,60,300,200, %WS_Border
   Graphic Attach hDlg, %IDC_Graphic
   Graphic Width 1
   Graphic Set Mix %R2_CopyPen
   Graphic Box (100-50,100-50)-(100+50,100+50),,%Black
   Graphic Box (100-2,100-2)-(100+2,100+2),,%Black,%Black
   Graphic Width 10
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local x,y,i,j,UL,UR As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         LastX = -1
      Case %WM_LButtonDown
         SetCapture hDlg    'start capturing, so can detect LButtonUp when it occurs
 
      Case %WM_MouseMove
         If GetCapture() = hDlg Then   'app has capture    'why?
            x = Lo(Integer,Cb.LParam)
            y = Hi(Integer,Cb.LParam)-60
            If LastX = -1 Then LastX = x : LastY = y
            Graphic Line (LastX,LastY)-(x,y), %Red
            LastX = x : LastY = y
         End If
      Case %WM_LButtonUp
         ReleaseCapture
         LastX = -1
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDC_Clear
               Graphic Clear
               Graphic Width 1
               Graphic Box (100-50,100-50)-(100+50,100+50),,%Black
               Graphic Box (100-2,100-2)-(100+2,100+2),,%Black,%Black
               Graphic Width 10
               Control Set Text hDlg, %IDC_Result, ""
            Case %IDC_Calculate
               CalculateWeight UL, UR
               If UL = UR Then
                   Control Set Text hDlg, %IDC_Result, Str$(UL) + ":" + Trim$(Str$(UR)) + "   Flat/Vertical line"
               ElseIf UL > UR Then
                   Control Set Text hDlg, %IDC_Result, Str$(UL) + ":" + Trim$(Str$(UR)) + "   UpperLeft to LowerRight"
               Else
                   Control Set Text hDlg, %IDC_Result, Str$(UL) + ":" + Trim$(Str$(UR)) + "   UpperRight to LowerLeft"
               End If
         End Select
   End Select
End Function
 
Sub CalculateWeight(UL As Long, UR As Long)
   Local x,y,iColor As Long
   'get weight of upper left A
   For x = 100-50 To 100
      For y = 100-50 To 100
         Graphic Get Pixel (x,y) To iColor
         If iColor = %Red Then
            Incr UL
         Else
            Graphic Set Pixel (x,y), %Green
         End If
      Next y
   Next x
   'get weight of upper right B
   For x = 100 To 100+50
      For y = 100-50 To 100
         Graphic Get Pixel (x,y) To iColor
         If iColor = %Red Then
            Incr UR
         Else
            Graphic Set Pixel (x,y), %Blue
         End If
      Next y
   Next x
   Graphi
 
'gbs_01411
'Date: 10-17-2014


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