//****************************************************************************
// $Module type: Package
// $Module name: cRDCSlideButton.pkg
//
// $Author     : Nils Svedmyr, RDC Tools International.
// Copyright (c) 2018 RDC Tools International
// E-mail      : support@rdctools.com
// Web-site    : http://www.rdctools.com
//
// Created     : 2018-01-04 @ 16:47 (Military date format - Year-Month-Day)
//
// The code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
// without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
// This is free software; you can redistribute it and/or modify it under the terms of the
// GNU Lesser General Public License - see the "GNU Lesser General Public License.txt"
// in the help folder for more details.
//
//****************************************************************************
Use Windows.pkg
Use cCommandLinkButton.pkg

#IFNDEF clGreenGrey
Define clGreenGrey      for (RGB(64, 84, 93))
Define clGreenGreyLight for (RGB(7, 117, 104))
#ENDIF

Enum_List
    Define RDCSlideButtonSmallImage  for 16
    Define RDCSlideButtonMediumImage for 24
End_Enum_List                  

// Used by the "Page" message below to show
// a rectangle around ComboForm and Checkbox objects.
#IFNDEF WM_CHANGEUISTATE
    Define WM_CHANGEUISTATE for |CI$0127
    Define WM_UPDATEUISTATE for |CI$0128
    Define WM_QUERYUISTATE  for |CI$0129
    Define UIS_SET          for 1
    Define UIS_CLEAR        for 2
    Define UIS_INITIALIZE   for 3
    Define UISF_HIDEFOCUS   for |CI$1
    Define UISF_HIDEACCEL   for |CI$2
    Define UISF_ACTIVE      for |CI$4
#ENDIF

Class cRDCSlideButtonImage is a cCommandLinkButton
    Procedure Construct_Object
        Forward Send Construct_Object

        { Visibility=Private }
        Property Handle private.phoParent 0

    End_Procedure

    Procedure Mouse_Up Integer iWindowNumber Integer iPosition
        Forward Send Mouse_Up iWindowNumber iPosition
        Send OnChange of (private.phoParent(Self))
        Send Activate of (private.phoParent(Self))
    End_Procedure

    Procedure End_Construct_Object
        Forward Send End_Construct_Object
    End_Procedure

End_Class

Class cRDCSlideTextbox is a CheckBox

    Procedure Construct_Object
        Forward Send Construct_Object

        Set Auto_Size_State to True
    End_Procedure

    Procedure End_Construct_Object
        Forward Send End_Construct_Object
    End_Procedure

    Procedure OnChange
        Delegate Send OnChange
    End_Procedure

    Procedure Page Integer iState
        Integer iStyle iRet
        Handle hWnd

        If (iState = 1) Begin
            Get Form_Style iStyle to iStyle
            Set Form_Style 0 to (iStyle ior BS_USERBUTTON)
            Forward Send Page iState
            Get Window_Handle to hWnd
            If (hWnd) Begin
                Move (SendMessage(hWnd, WM_QUERYUISTATE, 0, 0)) to iRet
                If (iRet iand UISF_HIDEFOCUS) Begin
                    Move (UIS_CLEAR + (UISF_HIDEFOCUS * 65536)) to iState
                    Move (SendMessage(hWnd, WM_UPDATEUISTATE, iState, 0)) to iRet
                End
            End
        End
        Else Begin
            Forward Send Page iState
        End
    End_Procedure

End_Class

// Intermediate class - don't use.
Class _cRDCSlideButton is a Container3d

    Procedure Construct_Object
        Forward Send Construct_Object

        { Visibility=Private }
        Property String private.psLabel
        { Visibility=Private }
        Property String private.psToolTip
        { Visibility=Private }
        Property String private.Status_Help

        Set Border_Style to Border_None
    End_Procedure

    Procedure End_Construct_Object
        Forward Send End_Construct_Object

    End_Procedure

    // We support both the "Set Label" & "Set psLabel" interface.
    { MethodType=Property }
    Procedure Set psLabel String sLabel
        Set private.psLabel to sLabel
    End_Procedure

    Function psLabel Returns String
        Function_Return (private.psLabel(Self))
    End_Function

    { Visibility=Private }
    Procedure Set Label String sLabel
        Set psLabel to sLabel
    End_Procedure

    { Visibility=Private }
    Function Label Returns String
        Function_Return (private.psLabel(Self))
    End_Function

    Procedure Set psToolTip String sToolTip
        Set private.psToolTip to sToolTip
    End_Procedure

    Function psToolTip Returns String
        Function_Return (private.psToolTip(Self))
    End_Function             
    
    Procedure Set Status_Help String sStatusHelp
        Set private.Status_Help to sStatusHelp
    End_Procedure

    Function Status_Help Returns String
        Function_Return (private.Status_Help(Self))
    End_Function             
    
End_Class

{ DesignerClass=cDTCheckBox }
{ HelpTopic=CheckBox }
{ OverrideProperty=Bitmap DesignTime=False }
{ OverrideProperty=Bitmap_Style DesignTime=False }
Class cRDCSlideButton is a _cRDCSlideButton

    Procedure Construct_Object
        Forward Send Construct_Object

        { Visibility=Private }
        Property Handle private.phoButton 0
        { Visibility=Private }
        Property String private.psImage    
        
        { Visibility=Private }
        Property Boolean private.Checked_State False
        { Visibility=Private }
        Property Boolean private.Auto_Size_State True
        { Visibility=Private }
        Property Integer private.piButtonHeight 15
        { Visibility=Private }
        Property Integer private.piButtonWidth  14
        { Visibility=Private }
        Property Integer private.piButtonLocationOffset -5
        { Visibility=Public Category="Appearance" }
        Property String psToggleOnImage  "ToggleOn.ico"
        { Visibility=Public Category="Appearance" }
        Property String psToggleOffImage "ToggleOff.ico"
        { Visibility=Public Category="Appearance" }
        { EnumList="RDCSlideButtonSmallImage, RDCSlideButtonMediumImage" }
        { InitialValue=RDCSlideButtonMediumImage }
        Property Integer piImageSize RDCSlideButtonMediumImage

        On_Key kSwitch Send Switch_Next_Area
    End_Procedure

    // We support two syntaxes "Checked_State" and "pbChecked"
    Procedure Set Checked_State Boolean bState
        Set private.Checked_State to (not(bState))
        Send OnChange
    End_Procedure

    Procedure Set pbChecked Boolean bState
        Set private.Checked_State to bState
        Send OnChange
    End_Procedure

    Function Checked_State Returns Boolean
        Function_Return (private.Checked_State(Self))
    End_Function

    Function pbChecked Returns Boolean
        Function_Return (private.Checked_State(Self))
    End_Function

    // This adjustment is so that the Studio layout is the same as when the
    // program has been compiled and run.
    Procedure Set Location Integer iRowPos Integer iColPos
        If (iColPos > 4) Begin
            Move (iColPos -4) to iColPos
        End

        Forward Set Location to iRowPos iColPos
    End_Procedure

    // This slight adjustment is needed so the control doesn't
    // "bump into" an object to the right of it that is located really close.
//    Procedure Set Size Integer iHeight Integer iWidth
//        If (iWidth > 5) Begin
//            Move (iWidth -5) to iWidth
//        End
//
//        Forward Set Size to iHeight iWidth
//    End_Procedure

    Procedure OnChange
        Handle hoButton
        Boolean bChecked
        String sImage

        Get private.Checked_State to bChecked
        Set private.Checked_State to (not(bChecked))
        Get psCurrentImage to sImage
        Get private.phoButton to hoButton
        If (hoButton <> 0) Begin
            Set psImage of hoButton to sImage
            If (Desktop <> Self) Begin
                Send OnChangeEvent
            End
        End
    End_Procedure

    Function psCurrentImage Returns String
        Boolean bChecked
        String sImage

        Get private.Checked_State to bChecked
        If (bChecked = True) Begin
            Get psToggleOnImage to sImage
        End
        Else Begin
            Get psToggleOffImage to sImage
        End
        Function_Return sImage
    End_Function

    Procedure OnClick
        Send OnChange
    End_Procedure

    Procedure OnChangeEvent
    End_Procedure

    Procedure DoToggle
        Boolean bChecked
        Get Checked_State to bChecked
        Set Checked_State to (not(bChecked))
    End_Procedure

    Procedure End_Construct_Object
        Integer iSize iLoc iHeight iWidth iOffset iTextOffset iIconIndex iImageSize
        Handle ho hoParent
        String sImage sLabel

        Forward Send End_Construct_Object
        
        Get piImageSize to iImageSize
        Case Begin
            Case (iImageSize = RDCSlideButtonSmallImage)
                Set private.piButtonHeight         to 14
                Set private.piButtonWidth          to 14 
                Set private.piButtonLocationOffset to -5
                Case Break
            Case (iImageSize = RDCSlideButtonMediumImage)
                Set private.piButtonHeight         to 16
                Set private.piButtonWidth          to 20 
                Set private.piButtonLocationOffset to -6
                Case Break
        Case End               

        Move Self to hoParent
        Get Label of hoParent to sLabel
        Get Text_Extent sLabel to iTextOffset
        Get Size     to iSize
        Get Location to iLoc
        Get psCurrentImage to sImage
        Get private.piButtonHeight to iHeight
        Get private.piButtonWidth  to iWidth
        Set Size to (Hi(iSize)) (Low(iSize) + iWidth -7)
        Get private.piButtonLocationOffset to iOffset
        Get GetCorrectIconIndex  to iIconIndex
        Move (iOffset + iIconIndex -1) to iOffset

        Get CreateNamed (RefClass(cRDCSlideButtonImage)) "oRDCSlideButtonImage" to ho
            Set Size                of ho to iHeight iWidth
            Set Location            of ho to iOffset 0
            Set psToolTip           of ho to (private.psToolTip(hoParent))
            If (private.Status_Help(hoParent) = "") Begin
                Set Status_Help     of ho to (private.psToolTip(hoParent))
            End                                                
            Else Begin
                Set Status_Help     of ho to (private.Status_Help(hoParent))
            End
            Set psImage             of ho to sImage
#IF (!@ > 190)
            Set pbAutoResizeIcons   of ho to True
#ENDIF
            Set piImageSize         of ho to (piImageSize(Self))
            Set Focus_Mode          of ho to NonFocusable
            Set private.phoParent   of ho to hoParent
        Set private.phoButton to ho

        Get CreateNamed (RefClass(cRDCSlideTextbox)) "cRDCSlideTextbox" to ho
            Set Size                of ho to (Hi(iSize)) (Low(iSize) + iWidth)
            Set Location            of ho to 2 iWidth
            Set Label               of ho to sLabel
            Set psToolTip           of ho to (private.psToolTip(Parent(ho)))
            If (private.Status_Help(hoParent) = "") Begin
                Set Status_Help     of ho to (private.psToolTip(hoParent))
            End
            Else Begin
                Set Status_Help     of ho to (private.Status_Help(hoParent))
            End

        Get psCurrentImage to sImage
        Set psImage of ho to sImage
        Send OnChangeEvent
    End_Procedure

    // Returns: DPI setting as an integer.
    //  Normal DPI setting: iDPI=96  is "Normal setting" 100%
    //                      iDPI=120 is "Medium setting" 125%
    //                      iDPI= 144 is "Large setting" 150%
    Function GetCurrentDPI Returns Integer
        Handle hDC
        Integer iPixelsX
        Move (GetDC(0)) to hDC
        Move (GetDeviceCaps(hDC, LOGPIXELSX)) to iPixelsX
        Move (ReleaseDC(0, hDC)) to hDC
        Function_Return iPixelsX
    End_Function

    Function GetCorrectIconSize Returns Integer
        Integer iPixelsX iIndex iSize
        Integer[] iaSizes

        Move 16 to iaSizes[0]
        Move 24 to iaSizes[1]
        Move 32 to iaSizes[2]
        Move 48 to iaSizes[3]
        Move 64 to iaSizes[4]

        Get piImageSize to iSize  // the "100%" size
        Move (SearchArray(iSize,iaSizes)) to iIndex
        Move (0 max iIndex) to iIndex
        Get GetCurrentDPI to iPixelsX
        // Use a Case Statement here. Wherever we jump in we will continue onwards, regardless of whether
        // we match the remaining Case statements or not. So list our Cases in reverse order, meaning we
        // will increment iIndex as many times as we need here.
        Case Begin
            Case (iPixelsX > 144)
                Increment iIndex
            Case (iPixelsX = 144)
                Increment iIndex
            Case (iPixelsX = 120)
                Increment iIndex
        Case End
        Move (iIndex min 4) to iIndex
        Function_Return iaSizes[iIndex]
    End_Function

    Function GetCorrectIconIndex Returns Integer
        Integer iPixelsX iIndex iSize
        Integer[] iaSizes

        Move 16 to iaSizes[0]
        Move 24 to iaSizes[1]
        Move 32 to iaSizes[2]
        Move 48 to iaSizes[3]
        Move 64 to iaSizes[4]

        Get piImageSize to iSize  // the "100%" size
        Move (SearchArray(iSize,iaSizes)) to iIndex
        Move (0 max iIndex) to iIndex
        Get GetCurrentDPI to iPixelsX
        // Use a Case Statement here. Wherever we jump in we will continue onwards, regardless of whether
        // we match the remaining Case statements or not. So list our Cases in reverse order, meaning we
        // will increment iIndex as many times as we need here.
        Case Begin
            Case (iPixelsX > 144)
                Increment iIndex
            Case (iPixelsX = 144)
                Increment iIndex
            Case (iPixelsX = 120)
                Increment iIndex
        Case End
        Move (iIndex min 4) to iIndex
        Function_Return iIndex
    End_Function

End_Class