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

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

Class cRDCHeaderGroupImage is a cCommandLinkButton
    Procedure Construct_Object
        Forward Send Construct_Object

        Set Size to 18 19
        Set Focus_Mode to NonFocusable
        Set peImageAlign to Button_ImageList_Align_Top
#IF (!@ > 190)
        Set pbAutoResizeIcons to True
#ENDIF
    End_Procedure

    Procedure OnClick
        Broadcast Send Prompt of (Parent(Self))
    End_Procedure

    Procedure Set Bitmap String sBitmapName
        Forward Set psImage to sBitmapName
    End_Procedure

    Procedure End_Construct_Object
        Set pbShield to False
        Forward Send End_Construct_Object
    End_Procedure

End_Class

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

    Procedure Construct_Object
        Forward Send Construct_Object

        { Visibility=Private }
        Property String private.psImage
        { Visibility=Private }
        Property String private.psLabel

    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

    { MethodType=Property Category=Label }
    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 }
    // Don't display but allow to use old "Label" syntax to set the value of the oInfo_tb object (header text)
    Procedure Set Label String sLabel
        Set psLabel to sLabel
    End_Procedure

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

End_Class

Register_Procedure NavigatePrevious
Register_Procedure NavigateNext

{ DesignerClass=cDTContainer3D }
{ CompositeClass=cCommandLinkButton }
{ OverrideProperty=Border_style InitialValue=Border_Normal }
{ OverrideProperty=Bitmap DesignTime=False }
{ OverrideProperty=Bitmap_Style DesignTime=False }
{ OverrideProperty=Transparent_State DesignTime=False }
Class cRDCHeaderGroup is a _cRDCHeaderGroup

    Procedure Construct_Object
        Forward Send Construct_Object

        Set peAnchors to anTopLeftRight
        Set pbAcceptDropFiles to True
        Set Border_Style to Border_Normal

        { Visibility=Private }
        Property Integer private.piColorOrg
        { Visibility=Private }
        Property Boolean private.pbIsHeaderGroup True // Don't touch!
        { Visibility=Private }
        Property String private.psToolTip ""

        { Category=Appearance }
        Property Integer piImageColOffset 4
        Property Integer piImageRowOffset 0
        { Category=Appearance }
        Property String psNote ""
        { Category=Appearance }
        Property Boolean pbLargeImageSize True
        { Visibility=Private }
        Property Integer private.piLargeImageSize 24
        { Visibility=Private }
        Property Integer private.piSmallImageSize 16
        { Category=Appearance }
        Property Boolean pbUseHotspotColor False
        { Category=Appearance }
        Property Integer piHeaderHotspotColor clAqua
        { Category=Label }
        Property String private.psLabel ""
        { Category=Label }
        Property Integer piLabelColor clGreenGrey
        { Category=Label }
        Property Boolean pbLabelFontItalics False
        { Category=Label }
        Property Integer piLabelLargeFontHeight 12
        { Category=Label }
        Property Integer piLabelSmallFontHeight 10
        { Category=Label }
        Property Boolean pbUseLargeFontHeight False

        { Category=Label }
        Property Integer piLabelFontPointWeight fw_Bold
        { Category=Label }
        Property Integer piLabelColOffset 28
        { Category=Label }
        Property Integer piLabelRowOffset 4
        { Category=Appearance }
        Property Boolean pbCreateTooltipItem True

        Set pbAcceptDropFiles to True

        Send Define_ToolTip_Support_Mixin

        // For the Studio to render the header image
        Set Bitmap to "Default32x32.bmp"
        // This doesn't work... I wonder if there's a way to "trick" the Studio
        // to render some text in the header when in design mode?
        Set Label to "HEADER TEXT"

        On_Key kLeftArrow  Send NavigatePrevious
        On_Key kUpArrow    Send NavigatePrevious
        On_Key kRightArrow Send NavigateNext
        On_Key kDownArrow  Send NavigateNext
        On_Key kSwitch     Send Switch_Next_Area
    End_Procedure

    Import_Class_Protocol ToolTip_Support_Mixin

    { MethodType=Property Category=Appearance }
    Procedure Set psImage String sImage
        Set Bitmap to ""
        Forward Set psImage to sImage
    End_Procedure

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

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

    { Visibility=Public Category=Appearance }
    Procedure Set psToolTip String sToolTip
        Set private.psToolTip to sToolTip
    End_Procedure

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

    Procedure End_Construct_Object
        String sNote sLabel
        Boolean bUseLargeFontHeight bLargeImageSize bCreateTooltipItem
        Integer iFontHeight iImageSize iLabelRowOffset iLabelColOffset iSize iTextOffset

        Forward Send End_Construct_Object

        Get piLabelColOffset to iLabelColOffset
        Get pbUseLargeFontHeight to bUseLargeFontHeight
        If (bUseLargeFontHeight = True) Begin
            Get piLabelLargeFontHeight to iFontHeight
            Move 8 to iLabelRowOffset
        End
        Else Begin
            Get piLabelSmallFontHeight to iFontHeight
            Move 6 to iLabelRowOffset
        End

        Get pbLargeImageSize to bLargeImageSize
        If (bLargeImageSize = True) Begin
            Get private.piLargeImageSize to iImageSize
        End
        Else Begin
            Get private.piSmallImageSize to iImageSize
            Move (iLabelColOffset - 6) to iLabelColOffset
        End

        Object oHeaderGroupImage is a cRDCHeaderGroupImage
            Set piImageSize to iImageSize
            Set Location to (piImageRowOffset(Self)) (piImageColOffset(Self))
            Set psImage to (private.psImage(Self))
            Set peImageAlign to Button_ImageList_Align_Center
            Set psToolTip to (private.psToolTip(Self))
        End_Object

        Object oHeaderGroupInfo_tb is a TextBox
            Set Size to 12 100
            Set Location to (piLabelRowOffset(Self)) iLabelColOffset
            Set FontWeight to (piLabelFontPointWeight(Self))
            Set FontItalics to (pbLabelFontItalics(Self))
            Set FontPointHeight to iFontHeight
            Set Label to (private.psLabel(Self))
            Set TextColor to (piLabelColor(Self))
            Set psToolTip to (private.psToolTip(Self))
            Get Size to iSize
        End_Object

        // ToDo: The positioning logic for placing the info image to the right of the header text is flawed.
        // How can it be improved?
        Get pbCreateTooltipItem to bCreateTooltipItem
        If (bCreateTooltipItem = True and private.psToolTip(Self) <> "") Begin
            Get private.psLabel to sLabel
            Get Text_Extent sLabel to iTextOffset
            Move (Low(iTextOffset) -0)  to iTextOffset
            Object oHeaderGroupTooltip_tb is a TextBox
                Set Size to 10 10
                If (bUseLargeFontHeight = True) Begin
//                    Set Location to (piLabelRowOffset(Self)) iTextOffset //(Low(iSize) + (iTextOffset))
                    Set Location to (piLabelRowOffset(Self)) (Low(iSize) + (iLabelColOffset * 2) + 10)
                End
                Else Begin
//                    Set Location to (piLabelRowOffset(Self)) iTextOffset
                    Set Location to (piLabelRowOffset(Self)) (Low(iSize) + iLabelColOffset + 25)
                End
                Set psToolTip to (private.psToolTip(Self))
                Set Bitmap to "ActionAbout.bmp"
            End_Object
        End

        Get psNote to sNote
        If (Trim(sNote) <> "") Begin
            Object oHeaderGroupNote_tb is a TextBox
                Set Size to 12 100
                Set Location to (Hi(iSize) + iLabelRowOffset) (iLabelColOffset + 8)
                Set Label to ("-" * String(sNote))
                Set TextColor to (piLabelColor(Self))
                Set FontPointHeight to 9
                Set psToolTip to (private.psToolTip(Self))
            End_Object
        End

    End_Procedure

    Function Popup_State Returns Boolean
        Boolean bIsPopup
        Get Popup_State of (Parent(Self)) to bIsPopup
        Function_Return bIsPopup
    End_Function

    Procedure OnEnterArea Handle hoFrom
        Integer iColor
        Forward Send OnEnterArea hoFrom
        // Not ideal, but works most of the time.
        //       When navigating to i.e a popup we don't want
        //       the coloring to appear. Else there will be 2
        //       cRDCHeaderGroup's with the highlight color...
        // Is there a better way?
        If (hoFrom <> Desktop and hoFrom < Parent(Self)) Begin
            Procedure_Return
        End
        If (pbUseHotspotColor(Self) = True) Begin
            Get Color to iColor
            Set private.piColorOrg to iColor
            Get piHeaderHotspotColor to iColor
            Set Color to iColor
            Broadcast Recursive Set Color to iColor
        End
    End_Procedure

    Procedure OnExitArea Handle hoFrom
        Integer iColor
        Forward Send OnExitArea hoFrom
        If (pbUseHotspotColor(Self) = True) Begin
            Get private.piColorOrg to iColor
            Set Color to iColor
            Broadcast Recursive Set Color to iColor
        End
    End_Procedure

    // Public access message to change the group header text color at runtime.
    Procedure Set Label_Color Integer iColor
        Set TextColor of (oHeaderGroupInfo_tb(Self)) to iColor
    End_Procedure

    Procedure NavigatePrevious
        Integer iMulti ivoid iLastErr
        Handle hWnd
        Boolean bErr

        Move Err to bErr
        Move LastErr to iLastErr

        Send Ignore_Error of Error_Object_Id DFERR_BAD_MESSAGE
        Get Select_Mode of (Focus(Self)) to iMulti
        Send Trap_Error of Error_Object_Id DFERR_BAD_MESSAGE
        If (Err) Begin
            Move bErr to Err
            Move iLastErr to LastErr
            Procedure_Return
        End

        Move bErr to Err
        Move iLastErr to LastErr
        If (iMulti = Multi_Select) Begin
            Send Previous
        End
        Else Begin
            Get Form_Window_Handle of (Focus(Self)) to hWnd
            Move (Sendmessage(hWnd, WM_KEYDOWN, Ascii(VK_LEFT), 0)) to iVoid
        End
    End_Procedure

    Procedure NavigateNext
        Integer iMulti iVoid iLastErr
        Handle hWnd
        Boolean bErr

        Move Err to bErr
        Move LastErr to iLastErr

        Send Ignore_Error of Error_Object_Id DFERR_BAD_MESSAGE
        Get Select_Mode of (Focus(Self)) to iMulti
        Send Trap_Error of Error_Object_Id DFERR_BAD_MESSAGE
        If (Err) Begin
            Move bErr to Err
            Move iLastErr to LastErr
            Procedure_Return
        End

        Move bErr to Err
        Move iLastErr to LastErr
        If (iMulti = Multi_Select) Begin
            Send Next
        End
        Else Begin
            Get Form_Window_Handle of (Focus(Self)) to hWnd
            Move (Sendmessage(hWnd, WM_KEYDOWN, Ascii(VK_LEFT), 0)) to iVoid
        End

    End_Procedure

    { Visibility=Private }
    Procedure Enable_Window Integer iState
        Handle hWnd
        Get Window_Handle to hWnd
        If hWnd Begin
            Move (EnableWindow(hWnd, iState)) to hWnd
        End
    End_Procedure

    { Visibility=Private }
    Procedure Page_Object Integer iState
        Handle hWnd
        Get Window_Handle to hWnd
        Forward Send Page_Object iState
        If (hWnd = 0 and iState) Begin
            Send Shadow_Display
        End
    End_Procedure

    { MethodType=Event Visibility=Private }
    Procedure Shadow_Display
        Send Enable_Window (not(Object_Shadow_State(Self)))
    End_Procedure

    Function Explicit_Shadow_State Returns Boolean
        Function_Return (Private.Explicit_Shadow_State(Self))
    End_Function

    // For some reason we need to augment this event to allow
    // files to be dropped on a cRDCHeaderGroup object; else nothing will
    // happen.
    Procedure OnFileDropped String sFilename Boolean bLast
        Delegate Send OnFileDropped sFilename bLast
    End_Procedure

End_Class

// We don't want the broadcast of setting color to set the background
// color for forms that are within a cRDCHeaderGroup object.
// If the Form is not within a cRDCHeaderGroup the Form class should
// behave as it always has. But if you don't like this; just comment
// it out.
//Procedure Set Color for Form Integer eColor
//    Boolean bIsHeaderGroup bErr bEnabled_State
//    Integer iLastErr
//
//    Move Err to bErr
//    Move LastErr to iLastErr
//
//    Send Ignore_Error of Error_Object_Id DFERR_BAD_MESSAGE
//    Delegate Get private.pbIsHeaderGroup to bIsHeaderGroup
//    Send Trap_Error of Error_Object_Id DFERR_BAD_MESSAGE
//    Move bErr to Err
//    Move iLastErr to LastErr
//    If (bIsHeaderGroup = False) Begin
//        Forward Set Color to eColor
//    End
//End_Procedure