//TH-Header
//*****************************************************************************************
// Copyright (c)  2014  KURANT Project
// All rights reserved.
//
// $FileName    : thtoolbar.pkg
// $ProjectName : The Hammer 2.0
// $Authors     : Wil van Antwerpen, Michael Kurz, Sergey V. Natarov, Bernhard Ponemayr
// $Created     : 01.25.2014  01:08
// $Type        : LGPL
//
// Contents: 
//  Button bar object.
//*****************************************************************************************
//TH-RevisionStart
//
// 28.02.2003 20:35  Changed the Target of New, Open...    BP     APBP
//                   Buttons to oClientArea to avoid
//                   error messages if button's called
//                   while focus on a toolpanel. The
//                   other buttons are only active if
//                   applicable.
//TH-RevisionEnd


Use cToolbar.pkg
Use Todo.dg
Use TodoLst.dg
Use cFileOpenPopupmenu.pkg

Register_Procedure CANewFile
Register_Procedure CAOpenFile
Register_Procedure CAOpenFile_Pkg
Register_Procedure CAOpenFile_DD
// Added for MultipleFile Open 28.05.2003 BP
Register_Procedure CAOpenMultipleFiles
Register_Procedure CASaveFile
Register_Procedure CAPrintFile
Register_Procedure CASaveFileAs
Register_Procedure Properties
Register_Procedure CABuildRun
Register_Procedure CABuildCompile
Register_Procedure CABuildDebugRun
Register_Procedure FloatUndo
Register_Procedure FloatRedo
Register_Procedure CASaveAllFiles
Register_Function  CAFileNameCur Returns String
Register_Object    oToolBar

Class cRecords Is an Array
    Procedure Construct_Object
        Forward Send Construct_Object
    End_Procedure
    Procedure Add_Item Integer iData
        Set Value Item (Item_Count(Self)) To iData
    End_Procedure
End_Class

Class cTodoList Is a cPopUpMenu
    Procedure Construct_Object
        Forward Send Construct_Object
        Property Integer Selected_Item Public (-1)
        Object oRecords Is an cRecords
        End_Object
    End_Procedure

    Procedure DoAction Integer iNr
        Set Selected_Item To iNr
        Forward Send DoAction iNr
    End_Procedure
End_Class

Register_Object oPopupMenu
Procedure OnSelect
    Integer iItem iRec
    Get Selected_Item Of (oPopUpMenu(Self)) To iItem
    Get Value Of (oRecords(oPopupMenu(Self))) Item iItem To iRec

    If (iRec) Begin
        Clear THTodo
        Move iRec To THTodo.Recnum
        Find Eq THTodo by Recnum
        If (found) Begin
            If (Trim(THTodo.File)<>"") Send CAOpenFile To (oClientArea(Self)) (Trim(THTODO.File))
        End
    End
End_Procedure
Procedure OnList
    Send popup To (oTodoLst(Self))
End_Procedure

Object oPopupMenu Is a cTodoList

    Procedure Add_Item Integer iMsg String sValue Integer iRec
        Forward Send Add_Item iMsg sValue
        Send Add_Item To (oRecords(Self)) iRec
    End_Procedure

    Procedure Fill_Menu
        Integer iCnt
        Send Delete_Data
        Send Delete_Data To (oRecords(Self))
        Clear THTODO
        Move 0 To iCnt
        Indicate found True
        Move gsUserName  To THTODO.User
        Move "FILE"      To THTODO.Type
        While (found)
            Find Gt THTODO by Index.1 // USER,FILE,TYPE,TITLE
            [found] Indicate found as THTODO.User Eq gsUserName
            [found] Indicate found as THTODO.Type Eq "FILE"
            [found] Begin
                Send Add_Item msg_OnSelect (Trim(THTODO.Title)+" ("+String(THTODO.SDATE)+")") THTodo.Recnum
                Set Status_Help Item iCnt To (Trim(THTODO.Descr))
                Increment iCnt
            End
        Loop
        If (iCnt) Send Add_Item msg_none "" 0
        Send Add_Item msg_OnList "Open ToDo List..." 0
    End_Procedure

    Procedure DoPopup
        // Problem: need to display the menu underneath the button
        Integer iVoid iLeft iTop iBottom

        String sRect
        Pointer lpsRect
        ZeroType tRect To sRect
        GetAddress Of sRect To lpsRect

        Send Windows_Message Of (oToolbar(Self)) TB_GETITEMRECT 23 lpsRect // get bounding rectangle of the button

        GetBuff From sRect At tRect.Bottom To iBottom
        Put iBottom To sRect At tRect.Top

        Move (ClientToScreen(window_handle(oToolbar(Self)), lpsRect)) To iVoid // convert Client to Screen coordinates

        GetBuff From sRect At tRect.Left To iLeft
        GetBuff From sRect At tRect.top To iTop

        Set GuiLocation To iTop iLeft
        Send Fill_Menu
        Send Popup
    End_Procedure
End_Object

Object oFileOpenPopupMenu Is a cFileOpenPopupMenu
End_Object   // oFileOpenPopupMenu


Class cTHImageList Is a cImageList
    Procedure Construct_Object
        Forward Send Construct_Object
        Property Integer piImageListType Public ILC_COLORDDB
        Set piImageHeight   To 24
        Set piImageWidth    To 24
        Set piMaxImages     To 25
    End_Procedure
    Procedure DoCreate
       Integer cx cy dwFlags icInitial iGrowBy iColor

       Get piImageHeight To cy
       Get piImageWidth  To cx
       Get piMaxImages   To iGrowBy
       Get piImageListType To iColor

       Move (iColor+ILC_MASK) To dwFlags

       Set phImageList To (ImageList_Create(cx, cy, dwFlags, 0, iGrowBy))
    End_Procedure
End_Class

Object oToolBar Is a cToolBar
    Set pbShowLabels    To True // display the psLabel property on the button
    Set pbList          To True // show the psLapel property to the right of the image
    Set FontWeight      To 800

    Object oImages Is a cTHImageList
        Set piMaxImages To 25
        Set piImageHeight To 24
        Set piImageWidth  To 24
        Procedure OnCreate
            Integer iVoid
            Get AddTransparentImage "TBIconsXP.bmp" clFuchsia To iVoid // 0
        End_Procedure
    End_Object

    Set phoImageList    To (oImages(Self))
    Set phoImageListHot To (oImages(Self))
    Set phoToolbar Of oFileOpenPopupMenu To (oToolBar(Self))

    // 28.02.2003 20:35  Changed the Target of New, Open...    BP     APBP
    //                   Buttons to oClientArea to avoid
    //                   error messages if button's called
    //                   while focus on a toolpanel. The
    //                   other buttons are only active if
    //                   applicable.

    Object oNew Is a cToolbarButton
        Set pbAutoSize To True
        Set psTooltip To 'New File'
        Set psStatusHelp To 'Creates new source file'
        Set piImage To 0
        Procedure OnClick
            Send CANewFile To (oClientArea(Self))
        End_Procedure
    End_Object

    Object oOpen Is a cToolbarButton
        Set peStyle To bsDropDown
        Set pbAutoSize To True
        Set psTooltip To 'Open File'
        Set psStatusHelp To 'Opens source file'
        Set piImage To 1
        Procedure OnClick
            // the button (not drop-down arrow) has been clicked
            // Changed for MultipleFile Open 28.01.2003 BP
            Send CAOpenMultipleFiles To (oClientArea(Self))
        End_Procedure

        Procedure OnDropDown
            // the drop-down arrow has been clicked
            Send DoPopup Of oFileOpenPopupMenu
        End_Procedure
    End_Object

    Object oOpenPkg Is a cToolbarButton
        Set pbAutoSize To True
        Set psTooltip To 'Open Pkg File'
        Set psStatusHelp To 'Opens Package file'
        Set piImage To 2
        Procedure OnClick
            Send CAOpenFile_Pkg To (oClientArea(Self))
        End_Procedure
    End_Object

    Object oOpenDD Is a cToolbarButton
        Set pbAutoSize To True
        Set psTooltip To 'Open DD File'
        Set psStatusHelp To 'Opens Data Dictionary file'
        Set piImage To 3
        Procedure OnClick
            Send CAOpenFile_DD To (oClientArea(Self))
        End_Procedure
    End_Object

    Object oSave Is a cToolbarButton
        Set pbAutoSize To True
        Set psTooltip To 'Save File'
        Set psStatusHelp To 'Saves source file'
        Set piImage To 4
        Procedure OnClick
            Send DoSendToFocus msg_CASaveFile
        End_Procedure
    End_Object

    Object oSaveAll Is a cToolbarButton
        Set pbAutoSize To True
        Set psTooltip To 'Save All Files'
        Set psStatusHelp To 'Saves all opened files'
        Set piImage To 5
        Procedure OnClick
            Send DoSendToFocus msg_CASaveAllFiles
        End_Procedure
    End_Object

    Object oPrint Is a cToolbarButton
        Set pbAutoSize To True
        Set psTooltip To 'Print the file'
        Set psStatusHelp To 'Outputs the source file to printer'
        Set piImage To 17
        Procedure OnClick
            Send CAPrintFile To (oClientArea(Self))
        End_Procedure
    End_Object

    Object oSeparator Is a cToolbarButton
        Set peStyle To bsSeparator
    End_Object

    Object oCut Is a cToolbarButton
        Set pbAutoSize To True
        Set psTooltip To 'Cut selection'
        Set psStatusHelp To 'Cuts the selection and puts it on the Clipboard'
        Set piImage To 6
        Procedure OnClick
            Send DoSendToFocus msg_cut
//            Send CACut To (oClientArea(Self))
        End_Procedure
    End_Object

    Object oCopy Is a cToolbarButton
        Set pbAutoSize To True
        Set psTooltip To 'Copy selection'
        Set psStatusHelp To 'Copies the selection and puts it on the Clipboard'
        Set piImage To 7
        Procedure OnClick
//            Send CACopy To (oClientArea(Self))
            Send DoSendToFocus msg_copy
        End_Procedure
    End_Object

    Object oPaste Is a cToolbarButton
        Set pbAutoSize To True
        Set psTooltip To 'Paste from clipboard'
        Set psStatusHelp To 'Inserts Clipboard contents'
        Set piImage To 8
        Procedure OnClick
//            Send CAPaste To (oClientArea(Self))
            Send DoSendToFocus msg_paste
        End_Procedure
    End_Object

    Object oSeparator Is a cToolbarButton
        Set peStyle To bsSeparator
    End_Object

    Object oUndo Is a cToolbarButton
        Set pbAutoSize To True
        Set psTooltip To 'Undo'
        Set psStatusHelp To 'Undo changes'
        Set piImage To 9
        Procedure OnClick
            Send DoSendToFocus msg_FloatUndo
        End_Procedure
    End_Object

    Object oRedo Is a cToolbarButton
        Set pbAutoSize To True
        Set psTooltip To 'Redo'
        Set psStatusHelp To 'Redo changes'
        Set piImage To 10
        Procedure OnClick
            Send DoSendToFocus msg_FloatRedo
        End_Procedure
    End_Object

    Object oFind Is a cToolbarButton
        Set pbAutoSize To True
        Set psTooltip To 'Find'
        Set psStatusHelp To 'Find'
        Set piImage To 11
        Procedure OnClick
            Send DoSendToFocus msg_Find
        End_Procedure
    End_Object

    Object oReplace Is a cToolbarButton
        Set pbAutoSize To True
        Set psTooltip To 'Replace'
        Set psStatusHelp To 'Replace'
        Set piImage To 12
        Procedure OnClick
            Send DoSendToFocus msg_Replace
        End_Procedure
    End_Object

    Object oSeparator Is a cToolbarButton
        Set peStyle To bsSeparator
    End_Object

    Object oPreCompile Is a cToolbarButton
        Set pbAutoSize To True
        Set psTooltip To 'Compile current file'
        Set psStatusHelp To 'Compile/Precompile current file'
        Set piImage To 13
        Procedure OnClick
            Send DoSendToFocus msg_CACurrentCompile // CABuildCompile
        End_Procedure
    End_Object

    Object oCompileRun Is a cToolbarButton
        Set pbAutoSize To True
        Set psTooltip To 'Compile and run'
        Set psStatusHelp To 'Compile and run current application file'
        Set piImage To 14
        Procedure OnClick
            Send DoSendToFocus msg_CABuildRun
        End_Procedure
    End_Object

    Object oDebug Is a cToolbarButton
        Set pbAutoSize To True
        Set psTooltip To 'Debug'
        Set psStatusHelp To 'Debug'
        Set piImage To 15
        Procedure OnClick
            Send DoSendToFocus msg_CABuildDebugRun
        End_Procedure
    End_Object

    Object oExecute Is a cToolbarButton
        Set pbAutoSize To True
        Set psTooltip To 'Run'
        Set psStatusHelp To 'Run the current program file'
        Set piImage To 16
        Procedure OnClick
            Send CABuildExecute To (oClientArea(Self))
        End_Procedure
    End_Object

    Object oSeparator Is a cToolbarButton
        Set peStyle To bsSeparator
    End_Object

    Object oViews Is a cToolbarButton
        Set peStyle To bsDropDown
        // Disabled this as under Wine 1.0 in linux the label will be added to each
        // and every toolbarbutton.. very weird.
        //Set psLabel To " ToDo "
        Set pbAutoSize To True
        Set psTooltip To 'Project ToDo List'
        Set piImage To 18
        Procedure OnClick
            // the button (not drop-down arrow) has been clicked
            Send popup To (oTodoLst(Self))
        End_Procedure
        Procedure OnDropDown
            // the drop-down arrow has been clicked
            Send DoPopup Of oPopupMenu
        End_Procedure
    End_Object

    Procedure Set Shadow_State Integer iNr Integer iState
        Integer iObj
        String sFile
        If (iNr=TBItem_New)     Move (oNew(Self)) To iObj
        If (iNr=TBItem_Open)    Move (oOpen(Self)) To iObj
        If (iNr=TBItem_Open_Pkg) Move (oOpenPkg(Self)) To iObj
        If (iNr=TBItem_Open_DD)  Move (oOpenDD(Self)) To iObj
        If (iNr=TBItem_Save)    Move (oSave(Self)) To iObj
        If (iNr=TBItem_SaveAll) Move (oSaveAll(Self)) To iObj
        If (iNr=TBItem_Print)   Move (oPrint(Self)) To iObj
        If (iNr=TBItem_Cut)     Move (oCut(Self)) To iObj
        If (iNr=TBItem_Copy)    Move (oCopy(Self)) To iObj
        If (iNr=TBItem_Paste)   Move (oPaste(Self)) To iObj
        If (iNr=TBItem_Undo)    Move (oUndo(Self)) To iObj
        If (iNr=TBItem_Redo)    Move (oRedo(Self)) To iObj
        If (iNr=TBItem_Find)    Move (oFind(Self)) To iObj
        If (iNr=TBItem_Replace) Move (oReplace(Self)) To iObj
        If (iNr=TBItem_Compile) Move (oPreCompile(Self)) To iObj
        If (iNr=TBItem_Run)     Begin
            Move (oCompileRun(Self)) To iObj
            If (gsCurrentProgramFile<>"") Begin
                Move (FileFromPath(gsCurrentProgramFile)) To sFile
                Move (Left(sFile, Length(sFile)-4)) To sFile
                Set psTooltip Of iObj To ("Compile and run "+sFile)
            End
            Else Set psTooltip Of iObj To  "Compile and run"
        End
        If (iNr=TBItem_Debug)   Begin
            Move (oDebug(Self)) To iObj
            If (gsCurrentProgramFile<>"") Begin
                Move (FileFromPath(gsCurrentProgramFile)) To sFile
                Move (Left(sFile, Length(sFile)-4)) To sFile
                Set psTooltip Of iObj To ("Debug "+sFile)
            End
            Else Set psTooltip Of iObj To  "Debug"
        End
        If (iNr=TBItem_Execute) Begin
            Move (oExecute(Self)) To iObj
            If (gsCurrentProgramFile<>"") Begin
                Move (FileFromPath(gsCurrentProgramFile)) To sFile
                Move (Left(sFile, Length(sFile)-4)) To sFile
                Set psTooltip Of iObj To ("Run "+sFile)
            End
            Else Set psTooltip Of iObj To "Run"
        End
        Set pbEnabled Of iObj   To (Not(iState))
    End_Procedure

    Function Shadow_State Integer iNr Returns Integer
        Integer iObj iState
        If (iNr=TBItem_New)     Move (oNew(Self)) To iObj
        If (iNr=TBItem_Open)    Move (oOpen(Self)) To iObj
        If (iNr=TBItem_Open_Pkg) Move (oOpenPkg(Self)) To iObj
        If (iNr=TBItem_Open_DD)  Move (oOpenDD(Self)) To iObj
        If (iNr=TBItem_Save)    Move (oSave(Self)) To iObj
        If (iNr=TBItem_SaveAll) Move (oSaveAll(Self)) To iObj
        If (iNr=TBItem_Print)   Move (oPrint(Self)) To iObj
        If (iNr=TBItem_Cut)     Move (oCut(Self)) To iObj
        If (iNr=TBItem_Copy)    Move (oCopy(Self)) To iObj
        If (iNr=TBItem_Paste)   Move (oPaste(Self)) To iObj
        If (iNr=TBItem_Undo)    Move (oUndo(Self)) To iObj
        If (iNr=TBItem_Redo)    Move (oRedo(Self)) To iObj
        If (iNr=TBItem_Find)    Move (oFind(Self)) To iObj
        If (iNr=TBItem_Replace) Move (oReplace(Self)) To iObj
        If (iNr=TBItem_Compile) Move (oPreCompile(Self)) To iObj
        If (iNr=TBItem_Run)     Move (oCompileRun(Self)) To iObj
        If (iNr=TBItem_Debug)   Move (oDebug(Self)) To iObj
        If (iNr=TBItem_Execute) Move (oExecute(Self)) To iObj
        Get pbEnabled Of iObj   To iState
        Function_Return iState
    End_Function

    Set Shadow_State Item TBItem_Save       To True
    Set Shadow_State Item TBItem_SaveAll    To True
    Set Shadow_State Item TBItem_Print      To True
    Set Shadow_State Item TBItem_Cut        To True
    Set Shadow_State Item TBItem_Copy       To True
    Set Shadow_State Item TBItem_Paste      To True
    Set Shadow_State Item TBItem_Redo       To True
    Set Shadow_State Item TBItem_Undo       To True
    Set Shadow_State Item TBItem_Find       To True
    Set Shadow_State Item TBItem_Replace    To True
    Set Shadow_State Item TBItem_Compile    To True
    Set Shadow_State Item TBItem_Run        To True
    Set Shadow_State Item TBItem_Debug      To True
    Set Shadow_State Item TBItem_Execute    To True

End_Object

    // USed to shadow toolbar dynamically.
Procedure ShadowToolBarItem Integer iNr Integer iState
    Set Shadow_State Of (oToolBar(Self)) Item iNr To iState
End_Procedure

Function ShadowToolBarItem Integer iNr Returns Integer
    Function_Return (Shadow_State(oToolBar(Self),iNr))
End_Procedure