/*
 * Proyecto: Xailer
 * Fichero: ButtonMod.prg
 * Clase TButtonMod
 *
 * Copyright 2020 Ignacio Ortiz de Zúñiga
 * Copyright 2020 https://Xailer.com
 * All rights reserved
*/

#include "Xailer.ch"

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

CLASS XButtonMod FROM TStdControl

PUBLISHED:
   PROPERTY oMenu       AS TPopupMenu  EDITOR PE_Component
   PROPERTY nWidth      INIT 110
   PROPERTY nHeight     INIT 32

   PROPERTY lDefault     INIT .F.
   PROPERTY lLegacyBehavior INIT .F.
   PROPERTY lCancel      INIT .F. WRITE INLINE IIf( Value, ::nModalResult := mrCANCEL, ), ::FlCancel := Value
   PROPERTY nModalResult INIT mrNONE VALUES mrNONE, mrOK, mrCANCEL, mrABORT, ;
                                            mrRETRY, mrIGNORE, mrYES, mrNO, ;
                                            mrCLOSE, mrHELP, mrTRYAGAIN, mrCONTINUE, ;
                                            mrALL, mrNOTOALL, mrYESTOALL

   PROPERTY nBorderRadius     INIT 0 WRITE INLINE ::FnBorderRadius := Value, ::Refresh()
   PROPERTY nClrPane          INIT clActiveBorder EDITOR PE_Color
   PROPERTY nClrText          INIT clBlack EDITOR PE_Color
   PROPERTY nClrBorder        INIT clWindowFrame ;
                              WRITE INLINE ( ::FnClrBorder := Value, ::Refresh() ) ;
                              EDITOR PE_Color
   PROPERTY nClrTextDisabled  INIT cl3DDkShadow ;
                              WRITE INLINE ( ::FnClrTextDisabled := Value, ::Refresh() );
                              EDITOR PE_Color
   PROPERTY nLineSpacing      INIT 100
   PROPERTY nOpacity     INIT 0
   PROPERTY lTabStop     INIT .T.
   PROPERTY lTransparent INIT .F.
   PROPERTY lFlat        INIT .F.
   PROPERTY nAlignment   INIT taCENTER WRITE INLINE ( ::Refresh(), ::FnAlignment := Value )  VALUES taLEFT, taRIGHT, taCENTER
   PROPERTY nVAlignment  INIT vaCENTER WRITE INLINE ( ::Refresh(), ::FnVAlignment := Value ) VALUES vaTOP, vaBOTTOM, vaCENTER
   PROPERTY nOrientation INIT orLEFT VALUES orLEFT, orTOP, orRIGHT, orBOTTOM ;
                         WRITE INLINE ( ::Refresh(), ::FnOrientation := Value )
   PROPERTY lMultiLine   INIT .F. ;
                         WRITE INLINE ( ::Refresh(), ::FlMultiLine := Value )

   PROPERTY nBmpWidth      INIT 1
   PROPERTY nBmpHeight     INIT 1
   PROPERTY oImageList     WRITE METHOD SetImageList AS TImageList ;
                           EDITOR PE_ImageList

   PROPERTY nBmpMargin     INIT 2

   EVENT OnClick( oSender )             // --> Nil
   EVENT OnMenuClick( oSender, oMenu )  // --> Nil .OR. .F.
   EVENT OnCustomDraw( hDC, aRect )

PUBLIC:
   PROPERTY oBrush  // propiedades no aplicables
   PROPERTY nImage      INIT 1 WRITE INLINE ::FnImage := Value, ::Refresh()

   METHOD New( oParent )
   METHOD Create( oParent )
   METHOD XAClick()     VIRTUAL
   METHOD Click()
   METHOD Free()

PROTECTED:
   PROPERTY l3D         INIT .F.
   PROPERTY lBorder     INIT .F.
   DATA nCtlStyle       INIT nOr( WS_CHILD, WS_CLIPCHILDREN, WS_CLIPSIBLINGS, WS_TABSTOP )
   DATA lIsHot          INIT .F.
   DATA lPushed         INIT .F.
   DATA lOnMenu         INIT .F.
   DATA oPrevCtrl

RESERVED:
   PROPERTY nBmpAlignment  READ INLINE ::nOrientation ;
                           WRITE INLINE ( ::nOrientation := IIF( Value == taLEFT, orLEFT, orRIGHT ),;
                                          LogDebug( "Property TButtonMod:nBmpAlignment deprecated. Use nOrientation" ) )
   PROPERTY oBitmaps       WRITE METHOD SetBitmaps READ INLINE ::oImageList

   DATA lPaintDisable   INIT .T.

   METHOD WMPaint()
   METHOD WMMouseMove( nWParam, nLParam, hWnd )
   METHOD WMKeyDown( nFlags, nLParam, hWnd )
   METHOD WMKeyUp( nFlags, nLParam, hWnd )
   METHOD WMLButtonDown( nWParam, nLParam, hWnd )
   METHOD WMLButtonUp( nWParam, nLParam, hWnd )

   METHOD WMEraseBkgnd()         INLINE 1
   METHOD WMPrintClient()        EXTERN XButtonMod_WMPaint()
   METHOD WMMouseLeave()         INLINE ::lPushed := .F., ::lIsHot := .F., ::lOnMenu := .F., ::Refresh()
   METHOD WMKillFocus( hCtl )    INLINE (::Super:WMKillFocus( hCtl ), ::Refresh( .F. ))
   METHOD WMSetFocus( hCtl )     INLINE (::Super:WMSetFocus( hCtl ),  ::Refresh( .F. ))

   METHOD SetBitmaps( oBitmaps )
   METHOD SetImageList( oValue )

ENDCLASS

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

METHOD New( oParent ) CLASS XButtonMod

   ::Super:New( oParent )

   IF Empty( ::FoImageList )
      ::FoImageList := TImageList():Create( Self )
   ENDIF

RETURN Self

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

METHOD Create( oParent ) CLASS XButtonMod

   ::Super:Create( oParent )

   IF Empty( ::FoImageList )
      ::FoImageList := TImageList():Create( Self )
   ENDIF

   IF ::lDefault
      ::oForm:oDefaultButton := Self
   ELSEIF ::lCancel
      ::oForm:oCancelButton := Self
   ENDIF

RETURN Self

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

METHOD Free() CLASS XButtonMod

   IF ! Empty( ::FoImagelist ) .AND. ::FoImagelist:oParent == Self
      ::FoImagelist:End()
   ENDIF

   ::FoImagelist := Nil

RETURN ::Super:Free()

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

METHOD SetImageList( oValue ) CLASS XButtonMod

   IF ::FoImageList != Nil .AND. ::FoImageList:oParent == Self
      ::FoImageList:Destroy()
   ENDIF

   ::FoImageList := oValue

RETURN oValue

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

METHOD SetBitmaps( oBitmaps ) CLASS XButtonMod

   LogDebug( "Property TButtonMod:oBitmaps deprecated. Use oImageList" )

   IF ::FoImageList != Nil .AND. ::FoImageList:oParent == Self
      ::FoImageList:Destroy()
      ::FoImagelist := NIL
   ENDIF

   IF oBitmaps != Nil
      IF ValType( oBitmaps ) != "O"
         IF Empty( ::FoImagelist )
            ::FoImagelist := TImageList():Create( Self, ::nBmpWidth, ::nBmpHeight )
         ENDIF
         IF Valtype( oBitmaps ) = "A"
            AEval( oBitmaps, {| oBmp | ::FoImageList:Add( oBmp, .F. ) } )
         ELSE
            ::FoImageList:Add( oBitmaps, .F. )
         ENDIF
      ELSE
         ::FoImagelist := oBitmaps
      ENDIF
   ENDIF

   ::Refresh()

RETURN Nil

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

METHOD Click() CLASS XButtonMod

   LOCAL lResult

   lResult := ::OnClick()

   IF ::nModalResult != 0
      IF ValType( lResult ) != "L" .OR. lResult
         ::oForm:nModalResult := ::nModalResult
         ::oForm:Close()
      ENDIF
   ENDIF

RETURN 0

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

METHOD WMMouseMove( nWParam, nLParam, hWnd ) CLASS XButtonMod

   LOCAL nY := LoWord( nLParam )

   IF !::lIsHot
      ::lIsHot  := .T.
      ::Refresh( .F. )
      TrackMouseEvent( ::Handle, TME_LEAVE )
   ENDIF

   ::lOnMenu := !Empty( ::oMenu ) .AND. ( nY >= ( ::nWidth - 22 ) )

RETURN ::Super:WMMouseMove( nWParam, nLParam, hWnd )

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

METHOD WMKeyDown( nFlags, nLParam, hWnd ) CLASS XButtonMod

   LOCAL lIntro

   lIntro := ( nFlags == VK_RETURN ) .AND. ;
             ( !Application:lUseReturn .OR. ::lDefault .OR. ::lLegacyBehavior )

   IF nFlags == VK_SPACE .OR. lIntro
      ::lPushed := .T.
      ::Refresh( .F. )
      RETURN 0
   ENDIF

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

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

METHOD WMKeyUp( nFlags, nLParam, hWnd ) CLASS XButtonMod

   LOCAL lIntro

   lIntro := ( nFlags == VK_RETURN ) .AND. ( !Application:lUseReturn .OR. ::lDefault )

   IF ::lPushed .AND. ( ( nFlags == VK_SPACE ) .OR. lIntro )
      ::Click()
      ::lPushed := .F.
      ::Refresh( .F. )
      RETURN 0
   ENDIF

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

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

METHOD WMLButtonDown( nWParam, nLParam, hWnd ) CLASS XButtonMod

   IF ::lCancel
      ::oPrevCtrl := GetControlFromHandle( GetFocus() )
      IF ::oPrevCtrl == Self
         ::oPrevCtrl := Nil
      ENDIF
   ENDIF

   IF GetFocus() != ::Handle
      ::SetFocus()
   ENDIF

   ::lPushed := .T.
   ::lIsHot := .T.

   ::Refresh()

RETURN ::Super:WMLButtonDown( nWParam, nLParam, hWnd )

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

METHOD WMLButtonUp( nWParam, nLParam, hWnd )  CLASS XButtonMod

   LOCAL x, y
   LOCAL lOk

   IF ::oPrevCtrl != Nil
      x := LoWord( nLParam )
      y := HiWord( nLParam )
      IF x < 0 .OR. x >= ::nWidth .OR. y < 0 .OR. y >= ::nHeight
         x := PrevWindowProc( ::Handle, WM_LBUTTONUP, nWParam, nLParam )
         IF ( lOk := ::oPrevCtrl:Valid( Self ) ) != Nil .AND. ! lOk
            ::oPrevCtrl:SetFocus( .T. )
         ENDIF
         ::oPrevCtrl := Nil
         RETURN x
      ENDIF
      ::oPrevCtrl := Nil
   ENDIF

   IF ::lPushed .AND. ::lIsHot
      IF !::lOnMenu
         ::Click()
      ELSE
         lOk := ::OnMenuClick( ::oMenu )
         IF lOk == NIL .OR. lOk
            ::ShowPopupMenu( ::oMenu, 0, ::nHeight )
         ENDIF
      ENDIF
   ENDIF

   ::lPushed := .F.
   ::Refresh()

RETURN ::Super:WMLButtonUp( nWParam, nLParam, hWnd )

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