//****************************************************************************
// $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
Use Dfclient.pkg

#IFNDEF clBlueGrey
Define clBlueGrey      for (RGB(64, 84, 93))
Define clBlueGreyLight for (RGB(7, 117, 104))
#ENDIF

Class cRDCHeaderDbGroupImage 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 _cRDCHeaderDbGroup is a dbContainer3d

    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 cRDCHeaderDbGroup is a _cRDCHeaderDbGroup

    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 clBlueGrey
        { 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

        Set pbAcceptDropFiles to True

        Send Define_ToolTip_Support_Mixin

        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
        Boolean bUseLargeFontHeight bLargeImageSize
        Integer iFontHeight iImageSize iLabelColOffset

        Forward Send End_Construct_Object

        Get piLabelColOffset to iLabelColOffset
        Get pbUseLargeFontHeight to bUseLargeFontHeight
        If (bUseLargeFontHeight = True) Begin
            Get piLabelLargeFontHeight to iFontHeight
        End
        Else Begin
            Get piLabelSmallFontHeight to iFontHeight
        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 cRDCHeaderDbGroupImage
            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 //(piLabelColOffset(Self))
            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))
        End_Object

        Get psNote to sNote
        If (Trim(sNote) <> "") Begin
            Object oHeaderGroupNote_tb is a TextBox
                Set Size to 12 100
                Set Location to (piLabelRowOffset(Self) + 9) (iLabelColOffset + 8) //(piLabelColOffset(Self) + 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
        // ToDo: 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