/*
 * TRadioMenu
 *
 * RadioMenu.prg
 * Clase TRadioMenu()
 *
 * Copyright 2003, 2007 Ignacio Ortiz de Zúñiga
 * Copyright 2003, 2007 Xailer.com
 * All rights reserved
 *
 */

#include "Xailer.ch"


//--------------------------------------------------------------------------

CLASS XRadioMenuMod FROM TStdControl

PUBLISHED:
   PROPERTY nWidth       INIT 100
   PROPERTY nHeight      INIT 100
   PROPERTY nClrPane     INIT clBtnFace   EDITOR PE_Color
   PROPERTY nClrColorization  INIT clSystem     WRITE INLINE ( ::FnClrColorization := Value, ::Refresh() ) EDITOR PE_Color
   PROPERTY nClrTextDisabled  INIT cl3DDkShadow WRITE INLINE ( ::FnClrTextDisabled := Value, ::Refresh() ) EDITOR PE_Color

   PROPERTY nBorderStyle INIT bvNONE
   PROPERTY nBorderSides

   PROPERTY aItems       INIT {} WRITE METHOD SetItems   EDITOR PE_StringList
   PROPERTY nIndex       INIT 1  WRITE INLINE ::FnIndex := Value, ::Refresh()
   PROPERTY nSpacing     INIT 10
   PROPERTY nMargin      INIT 2
   PROPERTY nColumns     INIT 0
   PROPERTY nOrientation INIT orVERTICAL VALUES orVERTICAL, orHORIZONTAL
   PROPERTY lTabStop     INIT .T.
   PROPERTY lTransparent INIT .T.
   PROPERTY nOpacity     INIT 0

   EVENT OnChange( oSender, nIndex, nOldIndex )   // --> Nil
   EVENT OnClick( oSender )            // --> Nil

PROTECTED:
   DATA nCtlStyle        INIT nOr( WS_CHILD, WS_CLIPCHILDREN, WS_CLIPSIBLINGS, WS_TABSTOP )
   PROPERTY cText
   PROPERTY l3D
   PROPERTY lBorder

   DATA nHot             INIT 0
   DATA nPush            INIT 0

PUBLIC:
   METHOD Create( oParent ) CONSTRUCTOR

RESERVED:
   METHOD Click( cKey )
   METHOD Change( nIndex )
   METHOD SetItems( aItems )
   METHOD WMEraseBkgnd() INLINE 1
   METHOD WMPaint()           EXTERN XRadioMenuMod_WMPaint
   METHOD WMNCHitTest()       EXTERN XRadioMenu_WMNCHitTest
   METHOD WMKeyDown( nFlags, nLParam, hWnd )
   METHOD WMLButtonDown()
   METHOD WMMouseLeave()      INLINE IIf( ::nHot > 0, ( ::nHot := 0, ::Refresh( .F. ) ), )
   METHOD WMKillFocus( hCtl ) INLINE ( ::Super:WMKillFocus( hCtl ), ::Refresh( .F. ) )
   METHOD WMSetFocus( hCtl )  INLINE ( ::Super:WMSetFocus( hCtl ), ::Refresh( .F. ) )
   METHOD WMLButtonUp()       INLINE ::nPush := 0, ::Refresh()
   METHOD XAClick() VIRTUAL

ENDCLASS

//--------------------------------------------------------------------------

METHOD Create( oParent ) CLASS XRadioMenuMod

   ::Super:Create( oParent )
   ::SetItems( ::FaItems )

RETURN Self

//--------------------------------------------------------------------------

METHOD Change( nIndex ) CLASS XRadioMenuMod

   LOCAL nOldIndex := ::FnIndex

   UPDATE ::nIndex TO nIndex

RETURN ::OnChange( ::FnIndex, nOldIndex )

//--------------------------------------------------------------------------

METHOD SetItems( aItems ) CLASS XRadioMenuMod

   LOCAL aKeys := {}, nAt

   ::FaItems := aItems
   ::Refresh()
   IF ::oForm != Nil
      ::oForm:DelShortCut( Self )
      AEval( aItems, {| cItem | IIf( ( nAt := At( "&", cItem ) ) > 0, AAdd( aKeys, Substr( cItem, nAt + 1, 1 ) ), ) } )
      IF ! Empty( aKeys )
         ::oForm:AddShortCut( Self, aKeys )
      ENDIF
   ENDIF

RETURN Nil

//--------------------------------------------------------------------------

METHOD Click( cKey ) CLASS XRadioMenuMod

   LOCAL n, nAt

   IF ! Empty( cKey )
      cKey := Upper( cKey )
      FOR n := 1 TO Len( ::FaItems )
         IF ( nAt := At( "&", ::FaItems[ n ] ) ) > 0 .AND. Upper( Substr( ::FaItems[ n ], nAt + 1, 1 ) ) == cKey
            ::Change( n )
            EXIT
         ENDIF
      NEXT
   ENDIF

RETURN ::OnClick()

//--------------------------------------------------------------------------

METHOD WMKeyDown( nFlags, nLParam, hWnd ) CLASS XRadioMenuMod

   DO CASE
      CASE nFlags == VK_UP .OR. nFlags == VK_LEFT
         IF ::nIndex > 1
            ::Change( ::nIndex - 1 )
         ENDIF
         RETURN 0
      CASE nFlags == VK_DOWN .or. nFlags == VK_RIGHT
         IF ::nIndex < Len( ::aItems )
            ::Change( ::nIndex + 1 )
         ENDIF
         RETURN 0
   ENDCASE

RETURN ::Super:WMKeyDown( nFlags, nLParam, hWnd )

//--------------------------------------------------------------------------