/* * Xailer source code: * * UpDown.prg * Control Spinner * * Copyright 2003, 2007 Jose Lalin * Copyright 2003, 2007 Xailer.com * All rights reserved * */ #include "Xailer.ch" #include "CommCtrl.api" //-------------------------------------------------------------------------- CLASS XUpDown FROM TControl PUBLISHED: PROPERTY nWidth INIT 16 PROPERTY nHeight INIT 20 PROPERTY nMin INIT 0 READ INLINE ::GetRange()[1] WRITE INLINE ::SetRange( Value, ::FnMax ) PROPERTY nMax INIT 0 READ INLINE ::GetRange()[2] WRITE INLINE ::SetRange( ::FnMin, Value ) PROPERTY aAccels INIT {} WRITE INLINE ::FaAccels := Value, ::SetAccels() PROPERTY nAccelTime INIT 5 READ INLINE ::GetAccel()[1] WRITE INLINE ::SetAccel( Value, ::FnIncrement ) PROPERTY nIncrement INIT 1 READ INLINE ::GetAccel()[2] WRITE INLINE ::SetAccel( ::FnAccelTime, Value ) PROPERTY nBase INIT 10 READ GetBase WRITE SetBase PROPERTY nBuddyAlign INIT alRIGHT WRITE METHOD SetBuddyAlign VALUES alNONE, alLEFT, alRIGHT PROPERTY lAutoBuddy INIT .F. WRITE METHOD SetAutoBuddy PROPERTY lWrap INIT .F. WRITE METHOD SetWrap PROPERTY nOrientation INIT orVERTICAL WRITE METHOD SetOrientation VALUES orHORIZONTAL, orVERTICAL PROPERTY lSyncBuddy INIT .T. WRITE METHOD SetSyncBuddy PROPERTY lArrowKeys INIT .T. WRITE METHOD SetArrowKeys PROPERTY lNoThousands INIT .F. WRITE METHOD SetNoThousands PROPERTY lHotTrack INIT .T. WRITE METHOD SetHotTrack PROPERTY oBuddy WRITE METHOD SetBuddy EDITOR PE_Control AS TControl EVENT OnChange( oSender, nPos, nDelta ) // --> Nil PUBLIC: PROPERTY nValue INIT 0 READ METHOD GetPos WRITE METHOD SetPos PROPERTY nAccelCount INIT 0 READ INLINE Len( ::aAccels ) // mantenida sólo por compatibilidad hacia atras PROTECTED: DATA cWinClassName INIT UPDOWN_CLASS PROPERTY cText PROPERTY lParentFont PROPERTY nClrPane PROPERTY nClrText PROPERTY oBrush PROPERTY oFont PUBLIC: METHOD Create( oParent ) CONSTRUCTOR RESERVED: PROPERTY nAlign PROPERTY nAnchors METHOD SetPos( nPos ) METHOD GetPos() METHOD GetBuddy() INLINE GetControlFromHandle( ::SendMsg( UDM_GETBUDDY, 0, 0 ) ) METHOD SetBuddy( oBuddy ) METHOD GetBase() INLINE ::SendMsg( UDM_GETBASE, 0, 0 ) METHOD SetBase( nBase ) INLINE ::FnBase := nBase, ::SendMsg( UDM_SETBASE, nBase, 0 ) METHOD GetRange() METHOD SetRange( nMin, nMax ) INLINE ::FnMin := nMin, ::FnMax := nMax, ; ::SendMsg( UDM_SETRANGE32, nMin, nMax ) METHOD GetAccel() METHOD SetAccel( nSec, nInc ) METHOD GetAccels() METHOD SetAccels() METHOD SetBuddyAlign( nBuddyAlign ) METHOD SetAutoBuddy( lAutoBuddy ) METHOD SetWrap( lWrap ) METHOD SetOrientation( nOrientation ) METHOD SetSyncBuddy( lSyncBuddy ) METHOD SetArrowKeys( lArrowKeys ) METHOD SetNoThousands( lNoThousands ) METHOD SetHotTrack( lHotTrack ) METHOD Notify( nWParam, nLParam ) METHOD WMEraseBkgnd() INLINE 1 METHOD WMPaint() EXTERN XControl_EraseAndPaint() ENDCLASS //-------------------------------------------------------------------------- METHOD Create( oParent ) CLASS XUpDown InitCommonControls( ICC_UPDOWN_CLASS ) ::SetBuddyAlign() ::SetAutoBuddy() ::SetWrap() ::SetOrientation() ::SetSyncBuddy() ::SetArrowKeys() ::SetNoThousands() ::SetHotTrack() ::Super:Create( oParent ) IF ::oBuddy != Nil ::SetBuddy( ::oBuddy ) ::FnValue := Val( ::oBuddy:cText ) ENDIF ::SetRange( ::FnMin, ::FnMax ) ::SetPos( ::FnValue ) ::SetAccel( ::FnAccelTime, ::FnIncrement ) RETURN Self //-------------------------------------------------------------------------- METHOD SetBuddy( oBuddy ) CLASS XUpDown LOCAL nWidth /* IOZ: 05/01/2012 El mensaje UDM_SETBUDDY resetea el ancho del control a 16. Se corrige después de su llamada. */ UPDATE ::FoBuddy TO oBuddy IF ! Empty( ::Handle ) IF ::FoBuddy == Nil ::SendMsg( UDM_SETBUDDY, 0 ) ELSE nWidth := ::nWidth IF ::nBuddyAlign != alNONE ::FoBuddy:nWidth += ::nWidth - IIf( Empty( ::SendMsg( UDM_GETBUDDY, 0, 0 ) ), 1, 0 ) ENDIF ::SendMsg( UDM_SETBUDDY, ::FoBuddy:Handle ) ::nWidth := nWidth ENDIF ENDIF RETURN ::FoBuddy //-------------------------------------------------------------------------- METHOD SetBuddyAlign( nBuddyAlign ) CLASS XUpDown UPDATE ::FnBuddyAlign TO nBuddyAlign IF ::FnBuddyAlign == alLEFT ::ReplaceStyle( UDS_ALIGNRIGHT, UDS_ALIGNLEFT ) ELSEIF ::FnBuddyAlign == alRIGHT ::ReplaceStyle( UDS_ALIGNLEFT, UDS_ALIGNRIGHT ) ELSE ::ChangeCtlStyle( UDS_ALIGNLEFT, .F. ) ::ChangeCtlStyle( UDS_ALIGNRIGHT, .F. ) ENDIF RETURN ::FnBuddyAlign //-------------------------------------------------------------------------- METHOD SetAutoBuddy( lAutoBuddy ) CLASS XUpDown UPDATE ::FlAutoBuddy TO lAutoBuddy ::ChangeCtlStyle( UDS_AUTOBUDDY, ::FlAutoBuddy ) RETURN ::FlAutoBuddy //-------------------------------------------------------------------------- METHOD SetWrap( lWrap ) CLASS XUpDown UPDATE ::FlWrap TO lWrap ::ChangeCtlStyle( UDS_WRAP, ::FlWrap ) RETURN ::FlWrap //-------------------------------------------------------------------------- METHOD SetOrientation( nOrientation ) CLASS XUpDown /* NOTA: No esta documentado UDS_VERT pero viendo la secuencia de los estilos hay que probar en otras plataformas si UDS_VERT == 0x0060 [jlalin] */ IF nOrientation != Nil .AND. nOrientation != ::FnOrientation ::FnOrientation := nOrientation IF ::FnOrientation == orHORIZONTAL ::ReplaceStyle( 0, UDS_HORZ ) // UDS_VERT ::SetBounds( ::nLeft, ::nTop, ::nWidth, ::nHeight ) ELSEIF ::FnOrientation == orVERTICAL ::ReplaceStyle( UDS_HORZ, 0 ) ::SetBounds( ::nTop, ::nLeft, ::nHeight, ::nWidth ) ENDIF ::Refresh() ENDIF RETURN ::FnOrientation //-------------------------------------------------------------------------- METHOD SetSyncBuddy( lSyncBuddy ) CLASS XUpDown UPDATE ::FlSyncBuddy TO lSyncBuddy ::ChangeCtlStyle( UDS_SETBUDDYINT, ::FlSyncBuddy ) RETURN ::FlSyncBuddy //-------------------------------------------------------------------------- METHOD SetArrowKeys( lArrowKeys ) CLASS XUpDown UPDATE ::FlArrowKeys TO lArrowKeys ::ChangeCtlStyle( UDS_ARROWKEYS, ::FlArrowKeys ) RETURN ::FlSyncBuddy //-------------------------------------------------------------------------- METHOD SetNoThousands( lNoThousands ) CLASS XUpDown UPDATE ::FlNoThousands TO lNoThousands ::ChangeCtlStyle( UDS_NOTHOUSANDS, ::FlNoThousands ) RETURN ::FlNoThousands //-------------------------------------------------------------------------- METHOD SetHotTrack( lHotTrack ) CLASS XUpDown UPDATE ::FlHotTrack TO lHotTrack ::ChangeCtlStyle( UDS_HOTTRACK, ::FlHotTrack ) RETURN ::FlHotTrack //-------------------------------------------------------------------------- METHOD SetPos( nPos ) CLASS XUpDown IF ::oBuddy != Nil .AND. ( ! ::oBuddy:lEnabled .OR. ( ::oBuddy:IsDerivedFrom( "TEdit" ) .AND. ::oBuddy:lReadOnly ) ) RETURN Nil ENDIF ::SendMsg( UDM_SETPOS32, 0, nPos ) ::FnValue := nPos RETURN nil //-------------------------------------------------------------------------- #pragma BEGINDUMP #define _WIN32_IE 0x0500 #include #include #include //-------------------------------------------------------------------------- HB_FUNC_STATIC( XUPDOWN_NOTIFY ) { LPNMUPDOWN lpud = (LPNMUPDOWN) hb_parnl( 2 ); PHB_ITEM Self = hb_stackSelfItem(); switch( lpud->hdr.code ) { case UDN_DELTAPOS: XA_ObjSendNL2( Self, "OnChange", lpud->iPos, lpud->iDelta ); hb_retl( hb_parl( -1 ) ); break; default: hb_retl( FALSE ); break; } } //-------------------------------------------------------------------------- HB_FUNC_STATIC( XUPDOWN_GETRANGE ) { PHB_ITEM Self = hb_stackSelfItem(); HWND hwnd = GetHandleOf( Self ); INT iMax; INT iMin; if ( hwnd ) SendMessage( hwnd, UDM_GETRANGE32, (WPARAM) &iMin, (LPARAM) &iMax ); else { iMin = XA_ObjGetNL( Self, "FnMin" ); iMax = XA_ObjGetNL( Self, "FnMax" ); } hb_reta( 2 ); hb_storvnl( iMin, -1, 1 ); hb_storvnl( iMax, -1, 2 ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( XUPDOWN_GETACCEL ) { PHB_ITEM Self = hb_stackSelfItem(); HWND hwnd = GetHandleOf( Self ); WORD wAccels; UDACCEL uda; uda.nSec = XA_ObjGetNL( Self, "FnAccelTime" ); uda.nInc = XA_ObjGetNL( Self, "FnIncrement" ); wAccels = SendMessage( hwnd, UDM_GETACCEL, 1, (LPARAM) &uda ); if( wAccels ) { hb_storvnl( uda.nSec, -1, 1 ); hb_storvnl( uda.nInc, -1, 2 ); } hb_reta( 2 ); hb_storvnl( uda.nSec, -1, 1 ); hb_storvnl( uda.nInc, -1, 2 ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( XUPDOWN_SETACCEL ) { PHB_ITEM Self = hb_stackSelfItem(); HWND hwnd = GetHandleOf( Self ); UDACCEL uda; uda.nSec = hb_parnl( 1 ); uda.nInc = hb_parnl( 2 ); XA_ObjSendNL( Self, "_FnAccelTime", uda.nSec ); XA_ObjSendNL( Self, "_FnIncrement", uda.nInc ); hb_retl( SendMessage( hwnd, UDM_SETACCEL, 1, (LPARAM) &uda ) ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( XUPDOWN_SETACCELS ) { PHB_ITEM Self = hb_stackSelfItem(); HWND hwnd = GetHandleOf( Self ); PHB_ITEM pAccels = XA_ObjGetItemCopy( Self, "aAccels" ); WORD wLen = hb_arrayLen( pAccels ); BOOL bSuccess = FALSE; if( wLen ) { LPUDACCEL uda = (LPUDACCEL) hb_xgrab( wLen * sizeof( UDACCEL ) ); WORD i; for( i = 0; i < wLen; i++ ) { PHB_ITEM pSub = hb_itemArrayGet( pAccels, i + 1 ); if( HB_IS_ARRAY( pSub ) ) { uda[ i ].nSec = hb_arrayGetNL( pSub, 1 ); uda[ i ].nInc = hb_arrayGetNL( pSub, 2 ); bSuccess = TRUE; } hb_itemRelease( pSub ); } if( bSuccess ) hb_retl( SendMessage( hwnd, UDM_SETACCEL, wLen, (LPARAM) uda ) ); hb_xfree( uda ); } else hb_retl( FALSE ); hb_itemRelease( pAccels ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( XUPDOWN_GETACCELS ) { PHB_ITEM Self = hb_stackSelfItem(); HWND hwnd = GetHandleOf( Self ); WORD wAccels; wAccels = SendMessage( hwnd, UDM_GETACCEL, 0, 0 ); if( wAccels ) { PHB_ITEM pArray = hb_itemArrayNew( wAccels ); LPUDACCEL uda = hb_xgrab( wAccels * sizeof( UDACCEL ) ); WORD i; SendMessage( hwnd, UDM_GETACCEL, wAccels, (LPARAM) uda ); for( i = 0; i < wAccels; i++ ) { PHB_ITEM pSub = hb_itemArrayNew( 2 ); PHB_ITEM pSec = hb_itemPutNL( NULL, uda[ i ].nSec ); PHB_ITEM pInc = hb_itemPutNL( NULL, uda[ i ].nInc ); hb_itemArrayPut( pSub, 1, pSec ); hb_itemArrayPut( pSub, 2, pInc ); hb_itemRelease( pSec ); hb_itemRelease( pInc ); hb_itemArrayPut( pArray, i + 1, pSub ); hb_itemRelease( pSub ); } hb_itemReturnForward( pArray ); hb_itemRelease( pArray ); hb_xfree( uda ); } else hb_reta( 0 ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( XUPDOWN_GETPOS ) { PHB_ITEM Self = hb_stackSelfItem(); HWND hwnd = GetHandleOf( Self ); BOOL bError; LRESULT lPos; lPos = SendMessage( hwnd, UDM_GETPOS32, 0, (LPARAM) &bError ); if( ! bError ) { XA_ObjSendNL( Self, "_FnValue", lPos ); hb_retnl( (LONG) lPos ); } else hb_retnl( XA_ObjGetNL( Self, "FnValue" ) ); } #pragma ENDDUMP //--------------------------------------------------------------------------