// **************************************************************************** //
// **                                                                        ** //
// ** Class   : cRebar                                                       ** //
// **                                                                        ** //
// ** Purpose : Wrapper class for rebar common control                       ** //
// **                                                                        ** //
// ** Author  : Ulbe Stellema                                                ** //
// **           Data Access Worldwide                                        ** //
// **                                                                        ** //
// ** Date    : March 1, 2000                                                ** //
// **                                                                        ** //
// **************************************************************************** //

Use cPopupMenu.h
Use Font_dlg.pkg
Use cCollection.pkg
Use cPopupMenu.pkg
Use cMenu.pkg
Use cRebarBand.pkg

Register_Function BarHeight Returns Integer

Class cRebar Is A cWinControl

  // Procedure : Construct_Object
  // Purpose   : Object constructor
  Procedure Construct_Object
    Send InitCommonControlsEx (ICC_COOL_CLASSES + ICC_BAR_CLASSES + ICC_USEREX_CLASSES)

    Set External_Class_Name "DFRebar" To "ReBarWindow32"

    Forward Send Construct_Object

    Property Integer Private.ImageListObject 0
    Property Integer Private.BarHeight       0

    Property Integer Private.BackColor       -1
    Property Integer Private.TextColor       -1

    // Style properties:
    Property Integer pbAutoSize          True
    Property Integer pbBandBorders       True
    Property Integer pbDoubleClickToggle False
    Property Integer pbFixedOrder        False
    Property Integer pbVariableHeight    True

    Property Boolean pbSaveLocation      True
    Property Boolean pbInMDIPanel        True

    Property Handle phoBands

    Object oBands Is A cCollection
    End_Object // oBands

    Set phoBands To (oBands(Self))
  End_Procedure // Construct_Object

  // Procedure : End_Construct_Object
  // Purpose   : End object constructor
  Procedure End_Construct_Object
    Handle hoObject

    Move Self To hoObject
    If (pbInMDIPanel(Self)) Delegate Set ToolBar_Id To hoObject
    Forward Send End_Construct_Object
  End_Procedure // End_Construct_Object

  // Procedure : Destroy_Object
  // Purpose   : Object destructor
  Procedure Destroy_Object
    If (pbInMDIPanel(Self)) Delegate Set ToolBar_Id To 0
    Forward Send Destroy_Object
  End_Procedure // Destroy_Object

  // Procedure : Private.RegisterBand
  // Purpose   : Registers a rebar band in the oBands collection
  Procedure Private.RegisterBand Handle hoObject
    If (Object_Id(phoBands(Self))) Send DoAppendObject To (phoBands(Self)) hoObject
  End_Procedure // Private.RegisterBand

  // Procedure : Private.UnregisterBand
  // Purpose   : Un-registers a rebar band in the oBands collection
  Procedure Private.UnregisterBand Handle hoObject
    If (Object_Id(phoBands(Self))) Send DoRemoveObject To (phoBands(Self)) hoObject
  End_Procedure // Private.UnregisterBand

  // Procedure : Private.AddAllBands
  // Purpose   : Adds all bands to the rebar
  Procedure Private.AddAllBands
    Integer iBands iCounter
    Boolean bAdded
    Handle hoBands

    Move (phoBands(Self)) To hoBands
    Move (CountOfObjects(hoBands)) To iBands
    For iCounter From 0 To (iBands - 1)
      Get Private.pbAdded Of (ObjectFromIndex(Self,iCounter)) To bAdded
      If (Not(bAdded)) Send Private.InsertBand To (ObjectFromIndex(Self,iCounter)) -1
    Loop // For iCounter From 0 To (iBands - 1)
  End_Procedure // Private.AddAllBands

  // Procedure : Notify
  // Purpose   : Handle WM_NOTIFY
  Procedure Notify Integer wParam Integer lParam Returns Integer
    Integer iResult iCode iMask iObject
    String sNMHDR

    ZeroType NMHDR To sNMHDR
    Move (CopyMemory(AddressOf(sNMHDR),lParam,NMHDR_Size)) To iResult
    GetBuff From sNMHDR At NMHDR.code To iCode

    Case Begin
      Case (iCode = RBN_AUTOSIZE)
        ZeroType NMRBAUTOSIZE To sNMHDR
        Move (CopyMemory(AddressOf(sNMHDR),lParam,NMRBAUTOSIZE_Size)) To iResult
        Send OnAutoSize
        Case Break

      Case (iCode = RBN_BEGINDRAG)
        ZeroType NMREBAR To sNMHDR
        Move (CopyMemory(AddressOf(sNMHDR),lParam,NMREBAR_Size)) To iResult
        GetBuff From sNMHDR At NMREBAR.dwMask To iMask
        If (iMask Iand RBNM_LPARAM) GetBuff From sNMHDR At NMREBAR.lParam To iObject
        If (iMask Iand RBNM_ID) GetBuff From sNMHDR At NMREBAR.wID To iObject
        Send OnBeginDrag To iObject
        Case Break

      Case (iCode = RBN_ENDDRAG)
        ZeroType NMREBAR To sNMHDR
        Move (CopyMemory(AddressOf(sNMHDR),lParam,NMREBAR_Size)) To iResult
        GetBuff From sNMHDR At NMREBAR.dwMask To iMask
        If (iMask Iand RBNM_LPARAM) GetBuff From sNMHDR At NMREBAR.lParam To iObject
        If (iMask Iand RBNM_ID) GetBuff From sNMHDR At NMREBAR.wID To iObject
        Send OnEndDrag To iObject
        Case Break

      Case (iCode = RBN_DELETEDBAND)
        ZeroType NMREBAR To sNMHDR
        Move (CopyMemory(AddressOf(sNMHDR),lParam,NMREBAR_Size)) To iResult
        GetBuff From sNMHDR At NMREBAR.dwMask To iMask
        If (iMask Iand RBNM_LPARAM) GetBuff From sNMHDR At NMREBAR.lParam To iObject
        If (iMask Iand RBNM_ID) GetBuff From sNMHDR At NMREBAR.wID To iObject
        Send OnDeleteBand iObject
        Case Break

      Case (iCode = RBN_DELETINGBAND)
        ZeroType NMREBAR To sNMHDR
        Move (CopyMemory(AddressOf(sNMHDR),lParam,NMREBAR_Size)) To iResult
        GetBuff From sNMHDR At NMREBAR.dwMask To iMask
        If (iMask Iand RBNM_LPARAM) GetBuff From sNMHDR At NMREBAR.lParam To iObject
        If (iMask Iand RBNM_ID) GetBuff From sNMHDR At NMREBAR.wID To iObject
        Send OnDeletingBand iObject
        Case Break

      Case (iCode = RBN_CHEVRONPUSHED)
        ZeroType NMREBARCHEVRON To sNMHDR
        Move (CopyMemory(AddressOf(sNMHDR),lParam,NMREBARCHEVRON_Size)) To iResult
        GetBuff From sNMHDR At NMREBARCHEVRON.wID To iObject
        GetBuff From sNMHDR At NMREBARCHEVRON.lParamNM To iMask
        Send OnChevronPushed To iObject // iMask
        Case Break

      Case (iCode = RBN_CHILDSIZE)
        ZeroType NMREBARCHILDSIZE To sNMHDR
        Move (CopyMemory(AddressOf(sNMHDR),lParam,NMREBARCHILDSIZE_Size)) To iResult
        GetBuff From sNMHDR At NMREBARCHILDSIZE.wID To iObject
        If iObject Send OnChangeSize To iObject
        Else Send OnChangeSize
        Case Break

      Case (iCode = RBN_HEIGHTCHANGE)
        Send OnHeightChange
        Case Break

      Case (iCode = RBN_LAYOUTCHANGED)
        Send OnLayoutChanged
        Case Break

    Case End
    Procedure_Return 0
  End_Procedure // Notify

  // Procedure : InitCommonControlsEx
  // Purpose   : Initializes common controls
  Procedure InitCommonControlsEx Integer iICC
    String sInitCommonControlsEx
    Integer iResult

    ZeroType INITCOMMONCONTROLSEX To sInitCommonControlsEx
    Put INITCOMMONCONTROLSEX_Size To sInitCommonControlsEx At INITCOMMONCONTROLSEX.dwSize
    Put iICC                      To sInitCommonControlsEx At INITCOMMONCONTROLSEX.dwICC
    Move (InitCommonControlsEx(AddressOf(sInitCommonControlsEx))) To iResult
  End_Procedure // InitCommonControlsEx

  // Procedure : Page_Object
  // Purpose   : Initialization code
  Procedure Page_Object Integer iState
    Integer hWindow hoClient

    Get Window_Handle To hWindow
    If (iState And hWindow=0) Begin
      Send PreInitializeWindow // if init is required before creating control

      Forward Send Page_Object iState

      // Add child object(s) to focus tree
      Broadcast Recursive No_Stop Send Add_Focus Self

      Send InitializeWindow
    End // If (iState And hWindow=0) Begin
    Else Forward Send Page_Object iState

    If (iState And pbInMDIPanel(Self)) Begin
      Get Client_Id To hoClient
      Send Private.Adjust_MDI_Margins To hoClient (BarHeight(Self)+4) 0 amTop // (If(Vertical(Self),amLEFT,amTOP))
      Set Private.BarHeight To (BarHeight(Self)+4)
      Send OnResize To hoClient
    End // If (iState And pbInMDIPanel(Self)) Begin
  End_Procedure // Page_Object

  // Procedure : PreInitializeWindow
  // Purpose   : Sets window styles
  Procedure PreInitializeWindow
    Set Extended_Window_Style To WS_EX_TOOLWINDOW True
    Set Window_Style To WS_CHILD True
    Set Window_Style To WS_VISIBLE True
    Set Window_Style To WS_CLIPSIBLINGS True
    Set Window_Style To WS_CLIPCHILDREN True
    Set Window_Style To WS_BORDER True

    If (pbAutoSize(Self))          Set Window_Style To RBS_AUTOSIZE True
    If (pbBandBorders(Self))       Set Window_Style To RBS_BANDBORDERS True
    If (pbDoubleClickToggle(Self)) Set Window_Style To RBS_DBLCLKTOGGLE True
    If (pbFixedOrder(Self))        Set Window_Style To RBS_FIXEDORDER True
    If (pbVariableHeight(Self))    Set Window_Style To RBS_VARHEIGHT True

    Set Window_Style To CCS_NODIVIDER True
    Set Window_Style To CCS_NOPARENTALIGN True
    //Set Window_Style To CCS_VERT True // This creates a vertical rebar
  End_Procedure // PreInitializeWindow

  // Procedure : InitializeWindow
  // Purpose   : Initialization
  Procedure InitializeWindow
    Integer hoImageList

    // Set initial properties
    If (Private.BackColor(Self) <> -1) Set piBackColor To (Private.BackColor(Self))
    If (Private.TextColor(Self) <> -1) Set piTextColor To (Private.TextColor(Self))

    // Get the imagelist
    Move (Private.ImageListObject(Self)) To hoImageList
    Set phoImageList To hoImageList

    // Load preferences
    If (pbSaveLocation(Self)) Send LoadPreferences
    Send Private.AddAllBands
  End_Procedure // InitializeWindow

  // Function  : LocalObjectName
  // Purpose   : Returns object name from fully qualified name
  Function LocalObjectName Integer iObject Returns String
    String sName

    Move (Name(iObject)) To sName
    While (Pos(".",sName))
      Move (Right(sName,Length(sName)-Pos(".",sName))) To sName
    Loop
    Function_Return sName
  End_Function // LocalObjectName

  // Procedure : Release_Focus
  // Purpose   : Saves preferences and informs client area the object is removed
  Procedure Release_Focus Returns Integer
    Integer iResult
    Handle hoClient

    If (pbSaveLocation(Self)) Send SavePreferences
    If (pbInMDIPanel(Self)) Begin
      Delegate Get Client_Id To hoClient
      If hoClient Send Remove_Border_Object To hoClient Self amTop
    End // If (pbInMDIPanel(Self)) Begin

    Forward Get msg_Release_Focus To iResult
    Procedure_Return iResult
  End_Procedure // Release_Focus

  // Procedure : Set GUISize
  // Purpose   : This message is send when the container object is resized.
  Procedure Set GUISize Integer iX Integer iY
    Integer iResult iSize

    Delegate Get Client_Size To iSize
    Forward Set GUISize To (BarHeight(Self)+4) (Low(iSize))
    If (Window_Handle(Self)) Move (InvalidateRect(Window_Handle(Self),0,1)) To iResult
  End_Procedure // Set GUISize

  // **** Properties ****

  // Function : phoImageList
  // Purpose  : Returns the imagelist object from the rebar control
  Function phoImageList Returns Handle
    Function_Return (Private.ImageListObject(Self))
  End_Function // phoImageList

  // Procedure : Set phoImageList
  // Purpose   : Sets the imagelist object for the rebar control
  Procedure Set phoImageList Integer iImageList
    Integer iMask iResult
    Handle hWindow hImageList
    Pointer pRebarInfo
    String sRebarInfo

    // Set the private property
    Set Private.ImageListObject To iImageList

    If iImageList Begin
      Get Window_Handle Of iImageList To hImageList
      If hImageList Move RBIM_IMAGELIST To iMask
    End // If iImageList Begin

    Get Window_Handle To hWindow
    ZeroType REBARINFO To sRebarInfo
    Put REBARINFO_Size To sRebarInfo At REBARINFO.cbSize
    Put iMask          To sRebarInfo At REBARINFO.fMask
    Put hImageList     To sRebarInfo At REBARINFO.himl
    GetAddress Of sRebarInfo To pRebarInfo
    Move (SendMessage(hWindow,RB_SETBARINFO,0,pRebarInfo)) To iResult
  End_Procedure // Set phoImageList

  // Function : piBackColor
  // Purpose  : Retrieves a rebar control's default background color
  Function piBackColor Returns Integer
    Function_Return (Private.BackColor(Self))
  End_Function // piBackColor

  // Procedure : Set piBackColor
  // Purpose   : Sets a rebar control's default background color
  Procedure Set piBackColor Integer iColor
    Integer iResult
    Handle hWindow

    Set Private.BackColor To iColor

    Get Window_Handle To hWindow
    If hWindow Move (SendMessage(hWindow,RB_SETBKCOLOR,0,iColor)) To iResult
  End_Procedure // Set piBackColor

  // Function : piTextColor
  // Purpose  : Retrieves a rebar control's default text color.
  Function piTextColor Returns Integer
    Function_Return (Private.TextColor(Self))
  End_Function // piTextColor

  // Procedure : Set piTextColor
  // Purpose   : Sets a rebar control's default text color.
  Procedure Set piTextColor Integer iColor
    Integer iResult
    Handle hWindow

    Set Private.TextColor To iColor

    Get Window_Handle To hWindow
    If hWindow Move (SendMessage(hWindow,RB_SETTEXTCOLOR,0,iColor)) To iResult
  End_Procedure // piTextColor

  // **** Events ****

  // Procedure : OnAutoSize
  // Purpose   : Changes client margins
  Procedure OnAutoSize
    Integer iHeight
    Handle hoClient

    Delegate Get Client_Id To hoClient
    If (pbAutoSize(Self) And pbInMDIPanel(Self) And hoClient) Begin
      // Get old barheight
      Get Private.BarHeight To iHeight
      If (iHeight - 4 <> BarHeight(Self)) Begin
        // Change margins
        If (Active_State(hoClient)) Begin
          Send Private.Adjust_MDI_Margins To hoClient (-iHeight) 0 amTop
          Send Private.Adjust_MDI_Margins To hoClient (BarHeight(Self) + 4) 0 amTop
          Set Private.BarHeight To (BarHeight(Self) + 4)
          Send OnResize To hoClient
        End // If (Active_State(hoClient)) Begin
      End // If (iHeight - 4 <> BarHeight(Self)) Begin
    End // If (pbAutoSize(Self) And (pbInMDIPanel(Self)) Begin
  End_Procedure // OnAutoSize

  // Procedure : OnHeightChange
  // Purpose   : Changes client margins
  Procedure OnHeightChange
    Integer iHeight
    Handle hoClient

    Delegate Get Client_Id To hoClient
    If (Not(pbAutoSize(Self)) And pbInMDIPanel(Self) And hoClient) Begin
      // Get old barheight
      Get Private.BarHeight To iHeight
      If (iHeight - 4 <> BarHeight(Self)) Begin
        // Change margins
        If (Active_State(hoClient)) Begin
          Send Private.Adjust_MDI_Margins To hoClient (-iHeight) 0 amTop
          Send Private.Adjust_MDI_Margins To hoClient (BarHeight(Self) + 4) 0 amTop
          Set Private.BarHeight To (BarHeight(Self) + 4)
          Send OnResize To hoClient
        End // If (Active_State(hoClient)) Begin
      End // If (iHeight - 4 <> BarHeight(Self)) Begin
    End // If (Not(pbAutoSize(Self)) And pbInMDIPanel(Self) And hoClient) Begin
  End_Procedure // OnHeightChange

  Procedure OnLayoutChanged
  End_Procedure // OnLayoutChanged

  Procedure OnBeginDrag
  End_Procedure // OnBeginDrag

  Procedure OnEndDrag
  End_Procedure // OnEndDrag

  Procedure OnChangeSize
  End_Procedure // OnChangeSize

  Procedure OnDeleteBand Integer iObject
  End_Procedure // OnDeleteBand

  Procedure OnDeletingBand
  End_Procedure // OnDeletingBand

  // **** Methods ****

  // Function : BarHeight
  // Purpose  : Retrieves the height of the rebar control.
  Function BarHeight Returns Integer
    Integer iResult
    Handle hWindow

    Get Window_Handle To hWindow
    Move (SendMessage(hWindow,RB_GETBARHEIGHT,0,0)) To iResult
    Function_Return iResult
  End_Function // BarHeight

  // Function : RowCount
  // Purpose  : Retrieves the number of rows of bands in a rebar control.
  Function RowCount Returns Integer
    Integer iResult
    Handle hWindow

    Get Window_Handle To hWindow
    Move (SendMessage(hWindow,RB_GETROWCOUNT,0,0)) To iResult
    Function_Return iResult
  End_Function // RowCount

  // Function : BandCount
  // Purpose  : Retrieves the count of bands currently in the rebar control.
  Function BandCount Returns Integer
    Integer iResult
    Handle hWindow

    Get Window_Handle To hWindow
    Move (SendMessage(hWindow,RB_GETBANDCOUNT,0,0)) To iResult
    Function_Return iResult
  End_Function // BandCount

  // Function  : ObjectFromIndex
  // Purpose   : Returns object id for passed zero based index
  Function ObjectFromIndex Integer iItem Returns Handle
    Function_Return (ObjectFromIndex(phoBands(Self),iItem))
  End_Function // ObjectFromIndex

  // Function  : IndexFromObject
  // Purpose   : Returns zero based index for passed object id
  Function IndexFromObject Handle hoObject Returns Integer
    Function_Return (IndexFromObject(phoBands(Self),hoObject))
  End_Function // IndexFromObject

  // Procedure : SavePreferences
  // Purpose   : Saves preferences to registry
  Procedure SavePreferences
    Integer iResult iBands iCounter iObject
    String sBandInfo sBarInfo sBands

    Move (BandCount(Self)) To iBands
    For iCounter From 0 To (iBands-1)
      ZeroType REBARBANDINFO To sBandInfo
      Put REBARBANDINFO_Size To sBandInfo At REBARBANDINFO.cbSize
      Put (RBBIM_ID)         To sBandInfo At REBARBANDINFO.fMask
      Move (SendMessage(Window_Handle(Self),RB_GETBANDINFO,iCounter,AddressOf(sBandInfo))) To iResult
      If (iResult) Begin
        GetBuff From sBandInfo At REBARBANDINFO.wID To iObject
        ZeroType BANDINFO To sBandInfo
        Put_String (LocalObjectName(Self,iObject)) To sBandInfo At BANDINFO.Name
        Put (piBandLength(iObject))                To sBandInfo At BANDINFO.Length
        Put (pbHidden(iObject))                    To sBandInfo At BANDINFO.Hidden
        Put (pbBreak(iObject))                     To sBandInfo At BANDINFO.Break
        Move (sBands+sBandInfo) To sBands
      End // If (iResult) Begin
    Loop // For iCounter From 0 To (iBands-1)

    ZeroType BARINFO To sBarInfo
    Put iBands           To sBarInfo At BARINFO.nBands
    Put (Length(sBands)) To sBarInfo At BARINFO.structSize
    If ghoApplication Send WriteBinary Of ghoApplication "Rebar" "Rebar" (AddressOf(sBarInfo)) BARINFO_Size
    If ghoApplication Send WriteBinary Of ghoApplication "Rebar" "Bands" (AddressOf(sBands)) (Length(sBands))
  End_Procedure // SavePreferences

  // Procedure : LoadPreferences
  // Purpose   : Loads preferences from registry
  Procedure LoadPreferences
    Integer iResult iBands iCounter iLength iObject
    String sBarInfo sBandInfo sBands sObject
    Boolean bHidden bBreak
    Address pBandInfo

    If (ValueExists(ghoApplication,"Rebar","Rebar") And ValueExists(ghoApplication,"Rebar","Bands")) Begin
      ZeroType BARINFO To sBarInfo
      If ghoApplication Get ReadBinary Of ghoApplication "Rebar" "Rebar" (AddressOf(sBarInfo)) BARINFO_Size To iResult
      GetBuff From sBarInfo At BARINFO.nBands     To iBands
      GetBuff From sBarInfo At BARINFO.structSize To iLength
      Move (Repeat(Character(0),iLength)) To sBands
      If ghoApplication Get ReadBinary Of ghoApplication "Rebar" "Bands" (AddressOf(sBands)) iLength To iResult
      For iCounter From 0 To (iBands-1)
        ZeroType BANDINFO To sBandInfo
        Move (AddressOf(sBands)) To pBandInfo
        Move (pBandInfo+(iCounter*BANDINFO_Size)) To pBandInfo
        Move (CopyMemory(AddressOf(sBandInfo),pBandInfo,BANDINFO_Size)) To iResult
        GetBuff_String From sBandInfo At BANDINFO.Name To sObject
        GetBuff From sBandInfo At BANDINFO.Length To iLength
        GetBuff From sBandInfo At BANDINFO.Hidden To bHidden
        GetBuff From sBandInfo At BANDINFO.Break  To bBreak
        Move (Eval( "("-CString(sObject)-"(Self))" )) To iObject
        If (iObject) Begin
          Send Private.InsertBand To iObject -1
          Set pbHidden Of iObject To bHidden
          Set piBandLength Of iObject To iLength
          Set pbBreak Of iObject To bBreak
        End // If (iObject) Begin
      Loop // For iCounter From 0 To (iBands-1)
    End // If (ValueExists(ghoApplication,"Rebar","Rebar") And ValueExists(ghoApplication,"Rebar","Bands")) Begin
    //Else Send Private.AddAllBands
  End_Procedure // LoadPreferences

End_Class // cRebar