Attribute VB_Name = "ModSelector"
Option Explicit

Private Type SRECT
   Left As Long
   TOp As Long
   Right As Long
   Bottom As Long
End Type
Private Type COORDS
   x As Long
   y As Long
End Type

Private Declare Function SetRect Lib "user32.dll" _
   (ByRef lpRect As SRECT, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long

Private Declare Function CreateEllipticRgnIndirect Lib "gdi32.dll" _
   (ByRef lpRect As SRECT) As Long

Private Declare Function CreatePolygonRgn Lib "gdi32.dll" _
   (ByRef lpPoint As COORDS, ByVal NCount As Long, ByVal nPolyFillMode As Long) As Long

Private Declare Function CreateRectRgnIndirect Lib "gdi32.dll" _
   (ByRef lpRect As SRECT) As Long

Private Declare Function CreateRoundRectRgn Lib "gdi32.dll" _
   (ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long, ByVal x3 As Long, ByVal y3 As Long) As Long

'Private Declare Function SelectObject Lib "gdi32.dll" _
'   (ByVal hDC As Long, ByVal hObject As Long) As Long
   

Private Declare Function GetStockObject Lib "gdi32.dll" _
   (ByVal nIndex As Long) As Long

Private Const BLACK_BRUSH As Long = 4
Private Const WINDING As Long = 2
Private Const ALTERNATE As Long = 1

' Used in Form1 @ optCopyMove
Public Declare Function CreateSolidBrush Lib "gdi32.dll" _
   (ByVal crColor As Long) As Long
   
Public Declare Function FillRgn Lib "gdi32.dll" _
   (ByVal hDC As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long

Public Declare Function BitBlt Lib "gdi32.dll" _
   (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long



Private hRgn As Long  ' For masks

Public hRgnPic As Long  ' For picDRAW Move

Public aSelect As Boolean
Public aSelectFixed As Boolean
Public aSelectForm As Boolean
Public SelectType As Long
Public prevX As Single, prevY As Single
Public aMoveLINSEL As Boolean

Public NClicksSEL As Long
Public RCLicks As Long

Public minx As Long, maxx As Long
Public miny As Long, maxy As Long

Public LasPoly() As COORDS
Private ShapeWidth As Long, ShapeHeight As Long

Public Sub RectangleMask(frm As Form)
'Private Declare Function SetRect Lib "user32.dll" _
'   (ByRef lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
'Private Declare Function CreateRectRgnIndirect Lib "gdi32.dll" _
'   (ByRef lpRect As RECT) As Long
'Private Declare Function FillRgn Lib "gdi32.dll" _
'   (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
'Private Declare Function GetStockObject Lib "gdi32.dll" _
'   (ByVal nIndex As Long) As Long

Dim r As SRECT
Dim SHLeft As Long, SHTop As Long
'Dim MBrush As Long
   ShapeWidth = frm.SHP(0).Width
   ShapeHeight = frm.SHP(0).Height
   
   SHLeft = frm.SHP(0).Left
   SHTop = frm.SHP(0).TOp
   
   If hRgnPic <> 0 Then DeleteObject hRgnPic
   SetRect r, SHLeft, SHTop, SHLeft + ShapeWidth, SHTop + ShapeHeight
   hRgnPic = CreateRectRgnIndirect(r)
   
   With frm.picMask
      .Width = ShapeWidth
      .Height = ShapeHeight
   End With
   frm.picMask.Picture = LoadPicture
   With frm.picCopy
      .Width = ShapeWidth
      .Height = ShapeHeight
   End With
   frm.picCopy.Picture = LoadPicture

   SetRect r, 0, 0, ShapeWidth, ShapeHeight
   hRgn = CreateRectRgnIndirect(r)
   FillRgn frm.picMask.hDC, hRgn, GetStockObject(BLACK_BRUSH)
   frm.picMask.Picture = frm.picMask.Image
   DeleteObject hRgn

'If frm.optCopyMove(1) Then ' ie Move
'MBrush = CreateSolidBrush(RightColor)
'FillRgn frm.picDRAW.hdc, hRgnPic, MBrush
'frm.picDRAW.Picture = frm.picDRAW.Image
'End If
End Sub

'Public Sub SquareMask(frm As Form)
'' Not used
''Private Declare Function CreateRectRgnIndirect Lib "gdi32.dll" _
''   (ByRef lpRect As RECT) As Long
'Dim r As SRECT
'Dim SHLeft As Long, SHTop As Long
'
'   ShapeWidth = frm.SHP(0).Width
'   ShapeHeight = frm.SHP(0).Height
'
'   If ShapeWidth >= ShapeHeight Then
'      SHLeft = frm.SHP(0).Left + (ShapeWidth - ShapeHeight) \ 2
'      SHTop = frm.SHP(0).Top
'      ShapeWidth = ShapeHeight
'   Else
'      SHTop = frm.SHP(0).Top + (ShapeHeight - ShapeWidth) \ 2
'      SHLeft = frm.SHP(0).Left
'      ShapeHeight = ShapeWidth
'   End If
'
'   If hRgnPic <> 0 Then DeleteObject hRgnPic
'   SetRect r, SHLeft, SHTop, SHLeft + ShapeWidth, SHTop + ShapeHeight
'   hRgnPic = CreateRectRgnIndirect(r)
'
'   With frm.picMask
'      .Width = ShapeWidth
'      .Height = ShapeHeight
'   End With
'   frm.picMask.Picture = LoadPicture
'   With frm.picCopy
'      .Width = ShapeWidth
'      .Height = ShapeHeight
'   End With
'   frm.picCopy.Picture = LoadPicture
'
'   SetRect r, 0, 0, ShapeWidth, ShapeHeight
'   hRgn = CreateRectRgnIndirect(r)
'   FillRgn frm.picMask.hDC, hRgn, GetStockObject(BLACK_BRUSH)
'   frm.picMask.Picture = frm.picMask.Image
'   DeleteObject hRgn
'End Sub

Public Sub OvalMask(frm As Form)
'Private Declare Function CreateEllipticRgnIndirect Lib "gdi32.dll" _
'   (ByRef lpRect As RECT) As Long
Dim r As SRECT
Dim SHLeft As Long, SHTop As Long
   
   ShapeWidth = frm.SHP(0).Width
   ShapeHeight = frm.SHP(0).Height

   SHLeft = frm.SHP(0).Left
   SHTop = frm.SHP(0).TOp
   
   If hRgnPic <> 0 Then DeleteObject hRgnPic
   SetRect r, SHLeft, SHTop, SHLeft + ShapeWidth, SHTop + ShapeHeight
   hRgnPic = CreateEllipticRgnIndirect(r)
   
   With frm.picMask
      .Width = ShapeWidth
      .Height = ShapeHeight
   End With
   frm.picMask.Picture = LoadPicture
   With frm.picCopy
      .Width = ShapeWidth
      .Height = ShapeHeight
   End With
   frm.picCopy.Picture = LoadPicture
   
   SetRect r, 0, 0, ShapeWidth + 1, ShapeHeight + 1
   hRgn = CreateEllipticRgnIndirect(r)
   FillRgn frm.picMask.hDC, hRgn, GetStockObject(BLACK_BRUSH)
   frm.picMask.Picture = frm.picMask.Image
   DeleteObject hRgn
End Sub

'Public Sub CircleMask(frm As Form)
'' Not used
''Private Declare Function CreateEllipticRgnIndirect Lib "gdi32.dll" _
''   (ByRef lpRect As RECT) As Long
'Dim r As SRECT
'Dim SHLeft As Long, SHTop As Long
'
'   ShapeWidth = frm.SHP(0).Width
'   ShapeHeight = frm.SHP(0).Height
'
'   If ShapeWidth >= ShapeHeight Then
'      SHLeft = frm.SHP(0).Left + (ShapeWidth - ShapeHeight) \ 2
'      SHTop = frm.SHP(0).Top
'      ShapeWidth = ShapeHeight
'   Else
'      SHTop = frm.SHP(0).Top + (ShapeHeight - ShapeWidth) \ 2
'      SHLeft = frm.SHP(0).Left
'      ShapeHeight = ShapeWidth
'   End If
'
'   If hRgnPic <> 0 Then DeleteObject hRgnPic
'   SetRect r, SHLeft, SHTop, SHLeft + ShapeWidth, SHTop + ShapeHeight
'   hRgnPic = CreateEllipticRgnIndirect(r)
'
'   With frm.picMask
'      .Width = ShapeWidth
'      .Height = ShapeHeight
'   End With
'   frm.picMask.Picture = LoadPicture
'   With frm.picCopy
'      .Width = ShapeWidth
'      .Height = ShapeHeight
'   End With
'   frm.picCopy.Picture = LoadPicture
'
'   SetRect r, 0, 0, ShapeWidth + 1, ShapeHeight + 1
'   hRgn = CreateEllipticRgnIndirect(r)
'   FillRgn frm.picMask.hDC, hRgn, GetStockObject(BLACK_BRUSH)
'   frm.picMask.Picture = frm.picMask.Image
'   DeleteObject hRgn
'End Sub

Public Sub RoundRectangleMask(frm As Form)
'Private Declare Function CreateRoundRectRgn Lib "gdi32.dll" _
'   (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Dim ER As Long
Dim SHLeft As Long, SHTop As Long
   
   ShapeWidth = frm.SHP(0).Width
   ShapeHeight = frm.SHP(0).Height
   
   SHLeft = frm.SHP(0).Left
   SHTop = frm.SHP(0).TOp
   
   If ShapeWidth >= ShapeHeight Then
      ER = ShapeWidth \ 5
   Else
      ER = ShapeHeight \ 5
   End If
   
   If hRgnPic <> 0 Then DeleteObject hRgnPic
   hRgnPic = CreateRoundRectRgn(SHLeft, SHTop, SHLeft + ShapeWidth, SHTop + ShapeHeight, ER, ER)
   
   With frm.picMask
      .Width = ShapeWidth
      .Height = ShapeHeight
   End With
   frm.picMask.Picture = LoadPicture
   With frm.picCopy
      .Width = ShapeWidth
      .Height = ShapeHeight
   End With
   frm.picCopy.Picture = LoadPicture

   hRgn = CreateRoundRectRgn(0, 0, ShapeWidth + 1, ShapeHeight + 1, ER, ER)
   FillRgn frm.picMask.hDC, hRgn, GetStockObject(BLACK_BRUSH)
   frm.picMask.Picture = frm.picMask.Image
   DeleteObject hRgn
End Sub

'Public Sub RoundSquareMask(frm As Form)
'' Not used
''Private Declare Function CreateRoundRectRgn Lib "gdi32.dll" _
''   (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
'Dim ER As Long
'Dim SHLeft As Long, SHTop As Long
'
'   ShapeWidth = frm.SHP(0).Width
'   ShapeHeight = frm.SHP(0).Height
'
'   If ShapeWidth >= ShapeHeight Then
'      SHLeft = frm.SHP(0).Left + (ShapeWidth - ShapeHeight) \ 2
'      SHTop = frm.SHP(0).Top
'      ShapeWidth = ShapeHeight
'   Else
'      SHTop = frm.SHP(0).Top + (ShapeHeight - ShapeWidth) \ 2
'      SHLeft = frm.SHP(0).Left
'      ShapeHeight = ShapeWidth
'   End If
'   ER = ShapeWidth \ 4
'
'   If hRgnPic <> 0 Then DeleteObject hRgnPic
'   hRgnPic = CreateRoundRectRgn(SHLeft, SHTop, SHLeft + ShapeWidth, SHTop + ShapeHeight, ER, ER)
'
'   With frm.picMask
'      .Width = ShapeWidth
'      .Height = ShapeHeight
'   End With
'   frm.picMask.Picture = LoadPicture
'   With frm.picCopy
'      .Width = ShapeWidth
'      .Height = ShapeHeight
'   End With
'   frm.picCopy.Picture = LoadPicture
'
'   hRgn = CreateRoundRectRgn(0, 0, ShapeWidth + 1, ShapeHeight + 1, ER, ER)
'   FillRgn frm.picMask.hDC, hRgn, GetStockObject(BLACK_BRUSH)
'   frm.picMask.Picture = frm.picMask.Image
'   DeleteObject hRgn
'End Sub

Public Sub LasPolyMask(frm As Form)
'Private Declare Function CreatePolygonRgn Lib "gdi32.dll" _
'   (ByRef lpPoint As COORDS, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Dim k As Long
Dim NCoords As Long
Dim Wid As Long
Dim Hit As Long
   
   NCoords = frm.LIN().Count
   FindMaxMins frm, NCoords
   Wid = maxx - minx
   Hit = maxy - miny
   With frm.picMask
      .Width = Wid
      .Height = Hit
   End With
   frm.picMask.Picture = LoadPicture
   With frm.picCopy
      .Width = Wid
      .Height = Hit
   End With
   frm.picCopy.Picture = LoadPicture
   
   ReDim LasPoly(NCoords)
   
   For k = 1 To NCoords
      LasPoly(k).x = frm.LIN(k).x1
      LasPoly(k).y = frm.LIN(k).y1
   Next k
   
   Select Case SelectType
   Case 6, 8 ' WINDING Lasso & Polygon, ignore inner loops
      hRgnPic = CreatePolygonRgn(LasPoly(1), NCoords, WINDING)
   Case 7, 9 ' ALTERNATE Lasso & Polygon, use inner loops
      hRgnPic = CreatePolygonRgn(LasPoly(1), NCoords, ALTERNATE)
   End Select
   
   For k = 1 To NCoords
      LasPoly(k).x = LasPoly(k).x - minx
      LasPoly(k).y = LasPoly(k).y - miny
   Next k
   
   Select Case SelectType
   Case 6, 8 ' WINDING Lasso & Polygon, ignore inner loops
      hRgn = CreatePolygonRgn(LasPoly(1), NCoords, WINDING)
   Case 7, 9 ' ALTERNATE Lasso & Polygon, use inner loops
      hRgn = CreatePolygonRgn(LasPoly(1), NCoords, ALTERNATE)
   End Select
   FillRgn frm.picMask.hDC, hRgn, GetStockObject(BLACK_BRUSH)
   frm.picMask.Picture = frm.picMask.Image
   DeleteObject hRgn
   Erase LasPoly
End Sub

Public Sub FindMaxMins(frm As Form, NCount As Long)
' For Lasso & Polygon
Dim k As Long
   minx = 10000
   maxx = -10000
   miny = 10000
   maxy = -10000
   With frm
      For k = 1 To NCount
         If .LIN(k).x1 < minx Then minx = .LIN(k).x1
         If .LIN(k).y1 < miny Then miny = .LIN(k).y1
         If .LIN(k).x1 > maxx Then maxx = .LIN(k).x1
         If .LIN(k).y1 > maxy Then maxy = .LIN(k).y1
      Next k
   End With
End Sub

Public Sub ClearLasPoly()
   ReDim LasPoly(1)
End Sub

Public Sub ClearLINS(frm As Form)
Dim k As Long
   If frm.LIN.Count > 1 Then
      For k = 2 To frm.LIN.Count
         Unload frm.LIN(k)
         Unload frm.LIN2(k)
      Next k
   End If
End Sub

Public Sub CopySHP0toSHP1(frm As Form)
   With frm.SHP(1)
      .Shape = frm.SHP(0).Shape
      .Left = frm.SHP(0).Left
      .TOp = frm.SHP(0).TOp
      .Width = frm.SHP(0).Width
      .Height = frm.SHP(0).Height
      .Visible = True
   End With
End Sub

Public Sub CopyshpSEL0to1(frm As Form)
   With frm.shpSEL(1)
      .Shape = frm.shpSEL(0).Shape
      .Left = frm.shpSEL(0).Left
      .TOp = frm.shpSEL(0).TOp
      .Width = frm.shpSEL(0).Width
      .Height = frm.shpSEL(0).Height
      .Visible = True
   End With
End Sub

Public Sub CopyLINtoLIN2(frm As Form, n As Long)
   With frm.LIN2(n)
      .x1 = frm.LIN(n).x1
      .y1 = frm.LIN(n).y1
      .x2 = frm.LIN(n).x2
      .y2 = frm.LIN(n).y2
'      .BorderColor = &HFFFFFF
'      .BorderStyle = 3
'      .DrawMode = 15
      .Visible = True
   End With
End Sub


Public Sub ClearOps(frm As Form)
   With frm
      .optCopyMove(0).Value = False
      .optCopyMove(1).Value = False
      .optCopyMove(0).Enabled = False
      .optCopyMove(1).Enabled = False
      .SHP(0).Visible = False
      .SHP(1).Visible = False
      .shpSEL(0).Visible = False
      .shpSEL(1).Visible = False
      ClearLINS frm
      .LIN(1).Visible = False
      .LIN2(1).Visible = False
      .picSelect.Picture = LoadPicture
      .picSelect.Width = 4
      .picSelect.Height = 4
      .picSelect.Visible = False

   End With
   ClearLasPoly
   NClicksSEL = 0
   aSelectForm = False
   aMouseDown = False
End Sub

Public Sub Make_picCopy(frm As Form, SX As Long, SY As Long, SW As Long, SH As Long)
   With frm
      ' Trim
      .picCopy.Width = .picCopy.Width - 1
      .picCopy.Height = .picCopy.Height - 1
      .picMask.Width = .picMask.Width - 1
      .picMask.Height = .picMask.Height - 1

      Select Case SelectType
      Case 0, 2, 4 ' SHP()  ' Rect, Ellipse, Rounded rect
         SX = .SHP(0).Left + 1
         SY = .SHP(0).TOp + 1
         SW = .SHP(0).Width
         SH = .SHP(0).Height
         
      Case 6 To 9  ' Lassos, Polygons
         SX = minx
         SY = miny
         SW = maxx - minx
         SH = maxy - miny
      End Select
      
      ' Copies picDraw selection, with black surround, to picCopy
      BitBlt .picCopy.hDC, 0, 0, .picCopy.Width, .picCopy.Height, _
         .picMask.hDC, 0, 0, vbNotSrcCopy
      BitBlt .picCopy.hDC, 0, 0, .picCopy.Width, .picCopy.Height, _
         .picDRAW.hDC, SX, SY, vbSrcAnd
      .picCopy.Picture = .picCopy.Image
   End With
End Sub
   

Public Sub Process_picSelect(frm As Form)
   With frm
      BitBlt .picSelect.hDC, 0, 0, .picSelect.Width, .picSelect.Height, _
         .picDRAW.hDC, .picSelect.Left, .picSelect.TOp, vbSrcCopy
      
      BitBlt .picSelect.hDC, 0, 0, .picSelect.Width, .picSelect.Height, _
         .picMask.hDC, 0, 0, vbSrcAnd
   
      BitBlt .picSelect.hDC, 0, 0, .picSelect.Width, .picSelect.Height, _
         .picCopy.hDC, 0, 0, vbSrcPaint
   
      .picSelect.Picture = .picSelect.Image
   End With
End Sub




