//****************************************************************************
// $Module type: Package
// $Module name: cRDCCheckbox.pkg
//
// $Author     : Nils Svedmyr, RDC Tools International.
// Copyright (c) 2016 RDC Tools International
// E-mail      : support@rdctools.com
// Web-site    : http://www.rdctools.com
//
// Created     : 2016-01-05 @ 19:04 (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

// 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

Register_Function private.phoCheckBox Returns Handle

Class _CheckBoxTextBox is a TextBox

    Procedure Mouse_Down integer iWindowNumber integer iPosition
        Handle hoParent
        Get private.phoCheckBox to hoParent
        Forward Send Mouse_Down iWindowNumber iPosition
        If (hoParent <> 0) Begin
            Send DoToggle of hoParent
        End
    End_Procedure
End_Class

Register_Procedure OnChangeEvent
Register_Procedure Set private.Checked_State
Register_Function private.Checked_State Returns Boolean
Class _NewCheckBox is a CheckBox

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

    Procedure OnChange
        Boolean bState
        Handle hoCheckBox

        Forward Send OnChange
        Get private.phoCheckBox to hoCheckBox
        Get Checked_State to bState
        Set private.Checked_State to bState
        If (Desktop <> Self and hoCheckBox <> 0) Begin
            Send OnChangeEvent
        End
    End_Procedure

    // Fix for a bug when using manifest files & running Vista and above.
    // The bug being that the focus rectangle doesn't show.
    Procedure Page Integer iPageObject
        Handle hWnd
        Integer iRet iState

        Forward Send Page iPageObject

        If (iPageObject) Begin
            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
    End_Procedure

End_Class

// Intermediate class - don't use.
Class _cCheckBoxContainer is a Container

    Register_Object oInfo_tb

    Procedure Construct_Object
        Forward Send Construct_Object

        { Visibility=Private }
        Property String private.psImage
        { Visibility=Private }
        Property String private.psLabel
        { Visibility=Private }
        Property String private.psToolTip
        { Visibility=Private }
        Property Boolean private.Checked_State
        { Visibility=Private }
        Property Boolean private.Auto_Size_State True
        { Visibility=Private }
        Property Integer private.iHeight
        { Visibility=Private }
        Property Integer private.iWidth
        { Visibility=Private }
        Property Integer private.iRowPos
        { Visibility=Private }
        Property Integer private.iColPos
        { Visibility=Private }
        Property Handle private.phoCheckBox
        { Visibility=Private }
        Property Integer private.peAnchors
        
        { Category=Appearance }
        Property Boolean pbCreateInfoItem True

        Set Border_Style to Border_None
    End_Procedure

    Procedure End_Construct_Object
        Handle hoCheckBox
        Integer iRowPos iColPos iSize eAnchorMode
        String sLabel sToolTip
        Boolean bCreateInfoItem

        Forward Send End_Construct_Object

        Get pbCreateInfoItem to bCreateInfoItem
        Get CreateNamed (RefClass(_NewCheckBox)) "oRDCCheckboxChild" to hoCheckBox
        Set private.phoCheckBox to hoCheckBox
        Set Auto_Size_State of hoCheckBox to (private.Auto_Size_State(Self))
        Get private.psLabel to sLabel
        Set Label of hoCheckBox to sLabel
        Send Autosize of hoCheckBox sLabel
        Set Checked_State of hoCheckBox to (private.Checked_State(Self))
        Get Size of hoCheckBox to iSize

        Set Location of hoCheckBox to (private.iRowPos(Self)) (private.iColPos(Self))
        Get private.iRowPos to iRowPos
        Get private.iColPos to iColPos
        Get private.psToolTip to sToolTip
        Set Status_Help of hoCheckBox to sToolTip

        If (bCreateInfoItem = True and sToolTip <> "") Begin
            Object oInfo_tb is a TextBox
                Set Size to 10 10
                Set Location to iRowPos (Low(iSize) + iColPos)
                Set psToolTip to sToolTip
                Set Bitmap to "ActionAbout.bmp"
            End_Object
        End
        Else Begin
            Set psToolTip of hoCheckBox to sToolTip
        End

    End_Procedure

    Procedure OnChangeEvent
    End_Procedure

    { MethodType=Property Category={Appearance}
    Procedure Set Size Integer iHeight Integer iWidth
        Forward Set Size to iHeight iWidth
        If (iHeight <> 1 and iWidth <> 1) Begin
            Set private.iHeight to iHeight
            Set private.iWidth  to iWidth
        End
    End_Procedure

    { MethodType=Property Category=Appearance}
    Procedure Set Location Integer iRowPos Integer iColPos
        Forward Set Location to iRowPos iColPos
        If (iRowPos <> 0 and iColPos <> 0) Begin
            Set private.iRowPos to iRowPos
            Set private.iColPos to iColPos
        End
    End_Procedure

    { MethodType=Property Category=Appearance }
    Procedure Set psImage String sImage
        Set private.psImage to sImage
    End_Procedure

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

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

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

    { Visibility=Public Category=Appearance}
    Procedure Set Label String sLabel
        Set psLabel to sLabel
    End_Procedure

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

    { Visibility=Public Category=Appearance}
    Procedure Set Checked_State Boolean bState
        Handle hoCheckBox
        Set private.Checked_State to bState
        Get private.phoCheckBox to hoCheckBox
        If (hoCheckBox <> 0) Begin
            Set Checked_State of hoCheckBox to bState
        End
    End_Procedure

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

    { Visibility=Private }
    Procedure Set Auto_Size_State Boolean bState
        Set private.Auto_Size_State to bState
    End_Procedure

    { Visibility=Private }
    Function Auto_Size_State Returns Boolean
        Function_Return (private.Auto_Size_State(Self))
    End_Function

    { Visibility=Private }
    Procedure Set peAnchors Integer eAnchorMode
        Forward Set peAnchors to eAnchorMode
        Set private.peAnchors to eAnchorMode
    End_Procedure

    { Visibility=Private }
    Function peAnchors Returns Integer
        Function_Return (private.peAnchors(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

End_Class

{ DesignerClass=cDTCheckBox }
{ HelpTopic=CheckBox }
{ OverrideProperty=Size DesignTime=True }
{ OverrideProperty=Location DesignTime=True }
{ OverrideProperty=Checked_State DesignTime=True }
{ OverrideProperty=psLabel DesignTime=True }
Class cRDCCheckBox is a _cCheckBoxContainer
    Procedure Construct_Object
        Forward Send Construct_Object
        On_Key kSwitch Send Switch_Next_Area
    End_Procedure

    { MethodType=Property }
    Procedure Set Checked_State Boolean bState
        Forward Set Checked_State to bState
    End_Procedure

    { MethodType=Property InitialValue=False Category=Appearance PropertyType=Boolean }
    Function Checked_State Returns Boolean
        Function_Return (private.Checked_State(Self))
    End_Function

    { Visibility=Public Category=Appearance}
    Procedure Set Label String sLabel
        Set psLabel to sLabel
    End_Procedure

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

    Procedure Set psToolTip String sToolTip
        String sStatusHelp

        Get Status_Help to sStatusHelp
        If (sStatusHelp = "") Begin
            Set Status_Help to sToolTip
        End

        Forward Set psToolTip to sToolTip
    End_Procedure

End_Class