!****************************************************************************
!*
!*    PROGRAM: Select.f90
!*
!*    PURPOSE: Contains library routines for selecting a region
!*
!*    FUNCTIONS:
!*
!*        StartSelection(HWND, POINT, LPRECT, int) - begin selection area
!*        UpdateSelection(HWND, POINT, LPRECT, int) - update selection area
!*        EndSelection(POINT, LPRECT) - end selection area
!*        ClearSelection(HWND, LPRECT, int) - clear selection area
!*
!*******************************************************************************/

use dfwina
!include 'select.fi'
end

!****************************************************************************
!*   FUNCTION: LibMain(HANDLE, DWORD, LPVOID)
!*
!*   PURPOSE:  LibMain is called by Windows when
!*             the DLL is initialized, Thread Attached, and other times.
!*             Refer to SDK documentation, as to the different ways this
!*             may be called.
!*
!*             The LibMain function should perform additional initialization
!*             tasks required by the DLL.  In this example, no initialization
!*             tasks are required.  LibMain should return a value of 1 if
!*             the initialization is successful.
!*
!*******************************************************************************/

integer*4 function DllMain (hInst, ul_reason_being_called, lpReserved)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_DllMain@12' :: DllMain
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'DllMain' :: DllMain
!DEC$ ENDIF
use dfwina
integer*4 hInst
integer*4 ul_reason_being_called
integer*4 lpReserved

hInst               =  hInst
ul_reason_being_called  =  ul_reason_being_called
lpReserved      =  lpReserved

   DllMain = 1
   return
end


!****************************************************************************
!*
!*    FUNCTION: StartSelection(HWND, POINT, LPRECT, int)
!*
!*    PURPOSE: Begin selection of region
!*
!****************************************************************************/

integer*4 function StartSelection (hWnd, ptCurrent, lpSelectRect, fFlags)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_StartSelection@16':: StartSelection
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'StartSelection' :: StartSelection
!DEC$ ENDIF
!DEC$ ATTRIBUTES REFERENCE :: ptcurrent
!DEC$ ATTRIBUTES REFERENCE :: lpSelectRect
!DEC$ ATTRIBUTES DLLEXPORT :: StartSelection
use dfwina
use selectin

interface
integer*4 function ClearSelection (hWnd, lpSelRect,fFlags)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_ClearSelection@12':: ClearSelection
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'ClearSelection' :: ClearSelection
!DEC$ ENDIF
!DEC$ ATTRIBUTES REFERENCE :: lpSelRect
!DEC$ ATTRIBUTES DLLEXPORT :: ClearSelection
use dfwinty
integer*4       hWnd
type (T_RECT)   lpSelRect
integer*4       fFlags
end function ClearSelection
end interface

integer*4 hWnd
type (T_POINTS)  ptCurrent
type (T_RECT)  lpSelectRect
integer*4 fFlags


   if ((lpSelectRect%left .ne. lpSelectRect%right) .or.(lpSelectRect%top .ne. lpSelectRect%bottom)) then
      i = ClearSelection(hWnd, lpSelectRect, fFlags)
   end if

   lpSelectRect%right   = ptCurrent%x
   lpSelectRect%bottom  = ptCurrent%y

! If you are extending the box, then invert the current rectangle

   if (IAND(fFlags,SL_SPECIAL) == SL_EXTEND) then
      i = ClearSelection(hWnd, lpSelectRect, fFlags)
   else
      lpSelectRect%left = ptCurrent%x
      lpSelectRect%top = ptCurrent%y
   end if
   i = SetCapture(hWnd)
   StartSelection = 1
   return
end

!****************************************************************************
!*
!*    FUNCTION: UpdateSelection(HWND, POINT, LPRECT, int) - update selection area
!*
!*    PURPOSE: Update selection
!*
!****************************************************************************/

integer*4 function UpdateSelection (hWnd,ptCurrent,lpSelectRect,fFlags)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_UpdateSelection@16':: UpdateSelection
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'UpdateSelection' :: UpdateSelection
!DEC$ ENDIF
!DEC$ ATTRIBUTES REFERENCE :: ptCurrent
!DEC$ ATTRIBUTES REFERENCE :: lpSelectRect
!DEC$ ATTRIBUTES DLLEXPORT :: UpdateSelection
use dfwina
use selectin

integer*4 hWnd
type (T_POINTS)  ptCurrent
type (T_RECT)  lpSelectRect
 integer*4 fFlags

integer*4   hDC
integer*2   OldROP

   hDC = GetDC(hWnd)
   select case (IAND(fFlags,SL_TYPE))

      case (SL_BOX)
         OldROP = INT2(SetROP2(hDC, R2_NOTXORPEN))
         i = MoveToEx(hDC, lpSelectRect%left, lpSelectRect%top, NULL_POINT)
         i = LineTo(hDC, lpSelectRect%right, lpSelectRect%top)
         i = LineTo(hDC, lpSelectRect%right, lpSelectRect%bottom)
         i  = LineTo(hDC, lpSelectRect%left, lpSelectRect%bottom)
         i = LineTo(hDC, lpSelectRect%left, lpSelectRect%top)
         i = LineTo(hDC, ptCurrent%x, lpSelectRect%top)
         i = LineTo(hDC, ptCurrent%x, ptCurrent%y)
         i = LineTo(hDC, lpSelectRect%left, ptCurrent%y)
         i = LineTo(hDC, lpSelectRect%left, lpSelectRect%top)
         i = SetROP2(hDC, INT(OldROP))

      case (SL_BLOCK)
         i = PatBlt(hDC, lpSelectRect%left, lpSelectRect%bottom, lpSelectRect%right - lpSelectRect%left,&
                              ptCurrent%y - lpSelectRect%bottom,  DSTINVERT)
         i = PatBlt(hDC, lpSelectRect%right,lpSelectRect%top,ptCurrent%x - lpSelectRect%right,ptCurrent%y - lpSelectRect%top,&
                DSTINVERT)
   end select
   lpSelectRect%right = ptCurrent%x
   lpSelectRect%bottom = ptCurrent%y
   i  = ReleaseDC(hWnd, hDC)
   UpdateSelection = 1
   return
end

