Code: Select all
#include "FWCE.ch"
#include "FiveWin.ch"
#include "Constant.ch"
#define GWL_STYLE -16
#define COMBO_BASE 0x140
#define CB_ADDSTRING ( COMBO_BASE + 3 )
#define CB_DELETESTRING ( COMBO_BASE + 4 )
#define CB_GETCURSEL ( COMBO_BASE + 7 )
#define CB_INSERTSTRING ( COMBO_BASE + 10 )
#define CB_RESETCONTENT ( COMBO_BASE + 11 )
#define CB_FINDSTRING ( COMBO_BASE + 12 )
#define CB_SETCURSEL ( COMBO_BASE + 14 )
#define CB_SHOWDROPDOWN ( COMBO_BASE + 15 )
#define CB_GETDROPPEDSTATE ( COMBO_BASE + 23 )
#define CB_ERR -1
#define CB_SETMINVISIBLE 5889 // 0x1701
#define CB_GETMINVISIBLE 5890 // 0x1702
#define SYS_COLOR_INDEX_FLAG 0x40000000
#define COLOR_WINDOW nOr( 5, SYS_COLOR_INDEX_FLAG )
#define COLOR_WINDOWTEXT nOr( 8, SYS_COLOR_INDEX_FLAG )
#define MB_ICONEXCLAMATION 48 // 0x0030
#define GW_CHILD 5
#define GW_HWNDNEXT 2
//----------------------------------------------------------------------------//
function Main()
local oDlg, cValue :="One"
DEFINE DIALOG oDlg TITLE "Combos" SIZE 200, 100
@ 1, 1 COMBOBOX cValue ITEMS { "One", "Two", "Three" } OF oDlg
ACTIVATE DIALOG oDlg CENTERED
return nil
CLASS TComboBox FROM TControl
DATA aItems, aBitmaps
DATA lOwnerDraw, nBmpHeight, nBmpWidth
DATA nAt
DATA bDrawItem, bCloseUp
DATA cError AS String
DATA oGet
METHOD New( nRow, nCol, bSetGet, aItems, nWidth, nHeight, oWnd, nHelpId,;
bChange, bValid, nClrText, nClrBack, lPixel, oFont,;
cMsg, lUpdate, bWhen, lDesign, acBitmaps, bDrawItem, nStyle,;
cPict, bEChange ) CONSTRUCTOR
METHOD ReDefine( nId, bSetGet, aItems, oWnd, nHelpId, bValid, ;
bChange, nClrText, nClrBack, cMsg, lUpdate,;
bWhen, acBitmaps, bDrawItem, nStyle, cPict, bEChange ) CONSTRUCTOR
METHOD Add( cItem, nAt )
METHOD cToChar() INLINE Super:cToChar( "COMBOBOX" )
METHOD Change()
METHOD Close() INLINE ::SendMsg( CB_SHOWDROPDOWN, 0 )
METHOD CloseUp() INLINE If( ::bCloseUp != nil, Eval( ::bCloseUp, Self ),)
METHOD Default()
METHOD DefControl( oControl )
METHOD Del( nAt )
METHOD Destroy()
METHOD DrawItem( nIdCtl, nPStruct )
METHOD FillMeasure( nPInfo ) INLINE LbxMeasure( nPInfo, ::nBmpHeight )
METHOD FindString( cItem, nFrom ) INLINE ;
nFrom := If( nFrom == nil, 0, nFrom ),;
::SendMsg( CB_FINDSTRING, nFrom, cItem ) + 1
METHOD Find( cItem, nFrom ) INLINE ::FindString( cItem, nFrom ) != 0
METHOD GetDlgCode( nLastKey )
METHOD GetMinVisible() INLINE If( IsAppThemed(), ;
::SendMsg( CB_GETMINVISIBLE, 0, 0 ), 0 )
METHOD Initiate( hDlg )
METHOD Insert( cItem, nAt )
METHOD KeyChar( nKey, nFlags )
METHOD LostFocus()
METHOD lValid()
METHOD Modify( cItem, nAt )
METHOD MouseMove( nRow, nCol, nKeyFlags )
METHOD Open() INLINE ::SendMsg( CB_SHOWDROPDOWN, 1 )
METHOD Refresh() INLINE ::Set( Eval( ::bSetGet ) ), Super:Refresh()
METHOD Reset() INLINE Eval( ::bSetGet,;
If( ValType( Eval( ::bSetGet ) ) == "N", 0, "" ) ),;
::nAt := 0, ::SendMsg( CB_RESETCONTENT ),;
::Change()
METHOD Select( nItem ) INLINE ::nAt := nItem,;
::SendMsg( CB_SETCURSEL, Max( 0, nItem - 1 ), 0 )
METHOD Set( cNewItem )
METHOD SetBitmaps( acBitmaps )
METHOD SetItems( aItems ) INLINE ::Reset(), ::aItems := aItems,;
::Default(), ::Change()
// By default, 30 is the minimum number of visible items in XP Visual Themes
#ifndef __CLIPPER__
METHOD SetMinVisible( nItems ) INLINE ;
If( IsAppThemed(), ( ::SendMsg( CB_SETMINVISIBLE, nItems, 0 ) == 1 ), .f. )
#endif
METHOD ShowToolTip()
METHOD VarGet()
METHOD State() INLINE ::SendMsg( CB_GETDROPPEDSTATE, 0 )
METHOD IsClosed() INLINE ::State() == 0
METHOD IsOpen() INLINE ::State() == 1
METHOD LButtonDown() INLINE ::Open()
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nRow, nCol, bSetGet, aItems, nWidth, nHeight, oWnd, nHelpId,;
bChange, bValid, nClrFore, nClrBack, lPixel, oFont,;
cMsg, lUpdate, bWhen, lDesign, acBitmaps, bDrawItem, nStyle,;
cPict, bEChange ) CLASS TComboBox
if nClrFore == nil
nClrBack := GetSysColor( COLOR_WINDOW )
endif
DEFAULT nRow := 0, nCol := 0, bSetGet := { || nil },;
oWnd := GetWndDefault(),;
oFont := oWnd:oFont,;
aItems := {}, nWidth := 40, nHeight := 60,;
nClrFore := GetSysColor( COLOR_WINDOWTEXT ),;
lPixel := .f., lUpdate := .f., lDesign := .f.,;
nStyle := CBS_DROPDOWNLIST
::cCaption = ""
::nTop = nRow * If( lPixel, 1, CMB_CHARPIX_H )
::nLeft = nCol * If( lPixel, 1, CMB_CHARPIX_W )
::nBottom = ::nTop + nHeight - 1
::nRight = ::nLeft + nWidth - 1
::nAt = 0
::aItems = aItems
::bChange = bChange
::bSetGet = bSetGet
::oWnd = oWnd
::oFont = oFont
if acBitmaps != nil
::SetBitmaps( acBitmaps )
else
::lOwnerDraw = .f.
endif
::nStyle = nOR( If( nStyle == CBS_DROPDOWN, 0, LBS_NOTIFY ), WS_TABSTOP,;
nStyle,;
LBS_DISABLENOSCROLL, WS_CHILD, WS_VISIBLE, WS_BORDER,;
WS_VSCROLL, If( lDesign, WS_CLIPSIBLINGS, 0 ),;
If( ::lOwnerDraw, CBS_OWNERDRAWFIXED, 0 ) )
::nId = ::GetNewId()
::nHelpId = nHelpId
::bValid = bValid
::lDrag = lDesign
::lCaptured = .f.
::cMsg = cMsg
::lUpdate = lUpdate
::bWhen = bWhen
::bDrawItem = bDrawItem
::SetColor( nClrFore, nClrBack )
if nStyle == CBS_DROPDOWN
::oGet := TGet():ReDefine( nil, ; // ID not used
::bSetGet, ; // bSETGET(uVar)
Self, ; // oDlg
::nHelpID, ; // Help Context ID
cPict, ; // Picture
nil, ; // Valid is handled by the CBx
::nClrText,;
::nClrPane,;
::oFont, ; // <oFont>
nil, ; // <oCursor>
cMsg, ; // cMsg
nil, ; // <.update.>
nil, ; // <{uWhen}>
bEChange, ; // {|nKey,nFlags,Self| <uEChange>}
.F. ) // <.readonly.> )
endif
if ! Empty( oWnd:hWnd )
::Create( "COMBOBOX" )
::nHeight = nHeight
::nWidth = nWidth
::Default()
if oFont != nil
::SetFont( oFont )
endif
oWnd:AddControl( Self )
else
oWnd:DefControl( Self )
endif
if ::oGet != nil
::oGet:hWnd = GetWindow( ::hWnd, GW_CHILD )
::oGet:Link()
::oGet:bLostFocus = ;
{| hCtlFocus, nAt, cItem| cItem := GetWindowText( ::hWnd ), ;
nAt := ::SendMsg( CB_FINDSTRING, 0, Trim( cItem )) + 1,;
Eval( ::bSetGet, cItem ),;
::Select( nAt ),;
SetWindowText( ::hWnd, cItem ),;
If( ::bValid != nil .and. ;
GetParent( hCtlFocus ) == GetParent( ::hWnd ),;
If( ! Eval( ::bValid ),;
PostMessage( ::hWnd, WM_SETFOCUS ),),) }
endif
if lDesign
::CheckDots()
endif
return Self
//----------------------------------------------------------------------------//
METHOD ReDefine( nId, bSetGet, aItems, oWnd, nHelpId, bValid, ;
bChange, nClrFore, nClrBack, cMsg, lUpdate, ;
bWhen, acBitmaps, bDrawItem, nStyle, cPict, ;
bEChange ) CLASS TComboBox
if nClrFore == nil
nClrBack := GetSysColor( COLOR_WINDOW )
endif
DEFAULT aItems := {},;
nClrFore := GetSysColor( COLOR_WINDOWTEXT ),;
lUpdate := .f., ;
nStyle := CBS_DROPDOWNLIST
::nId = nId
::hWnd = 0
::aItems = aItems
::bChange = bChange
::bSetGet = bSetGet
::oWnd = oWnd
::nHelpId = nHelpId
::bValid = bValid
::nAt = 0
::lDrag = .f.
::lCaptured = .f.
::cMsg = cMsg
::lUpdate = lUpdate
::bWhen = bWhen
::bDrawItem = bDrawItem
::nStyle = nStyle
if acBitmaps != nil
::SetBitmaps( acBitmaps )
else
::lOwnerDraw = .f.
endif
::SetColor( nClrFore, nClrBack )
if nAnd( ::nStyle, CBS_DROPDOWNLIST ) == CBS_DROPDOWN
::oGet := TGet():ReDefine( nil, ; // ID not used
::bSetGet, ; // bSETGET(uVar)
Self, ; // oDlg
::nHelpID, ; // Help Context ID
cPict, ; // Picture
nil, ; // Valid is handled by the CBx
::nClrText,;
::nClrPane,;
::oFont, ; // <oFont>
nil, ; // <oCursor>
cMsg, ; // cMsg
nil, ; // <.update.>
nil, ; // <{uWhen}>
bEChange, ; // {|nKey,nFlags,Self| <uEChange>}
.F. ) // <.readonly.> )
endif
oWnd:DefControl( Self )
return Self
//----------------------------------------------------------------------------//
METHOD Add( cItem, nAt ) CLASS TComboBox
DEFAULT nAt := 0
if nAt == 0
AAdd( ::aItems, cItem )
else
ASize( ::aItems, Len( ::aItems ) + 1 )
AIns( ::aItems, nAt )
::aItems[ nAt ] = cItem
endif
::SendMsg( CB_ADDSTRING, nAt, Ansitowide( cItem ) )
return nil
//----------------------------------------------------------------------------//
METHOD Change() CLASS TComboBox
local cItem := GetWindowText( ::hWnd ) // Current Value
local nAt
nAt = ::SendMsg( CB_GETCURSEL ) + 1
if nAt == ::nAt .and. ! Empty( Eval( ::bSetGet ) )
return nil
endif
::nAt := nAt
if ::nAt != 0 .and. ::nAt <= Len( ::aItems )
if ValType( Eval( ::bSetGet ) ) == "N"
Eval( ::bSetGet, ::nAt )
else
Eval( ::bSetGet, ::aItems[ ::nAt ] )
endif
endif
if ::oGet != nil // Always not nil for dropdown
::oGet:VarPut( Eval( ::bSetGet ) ) // udate variable before calling bChange
::oGet:Refresh()
endif
if ::bChange != nil
Eval( ::bChange, Self, cItem )
endif
return nil
//----------------------------------------------------------------------------//
METHOD DefControl( oControl ) CLASS TComboBox
if ::aControls == nil
::aControls = {}
endif
AAdd( ::AControls, oControl )
return nil
//----------------------------------------------------------------------------//
METHOD Set( cNewItem ) CLASS TComboBox
local nAt
if ValType( cNewItem ) == "N"
nAt = cNewItem
if nAt == 0
nAt = 1
endif
else
nAt = AScan( ::aItems,;
{ | cItem | Upper( AllTrim( cItem ) ) == ;
Upper( AllTrim( cNewItem ) ) } )
endif
if ValType( cNewItem ) == "N" .or. nAt != 0
::Select( nAt )
Eval( ::bSetGet, cNewItem )
else
cNewItem := cValToChar( cNewItem )
Eval( ::bSetGet, cNewItem )
SetWindowText( ::hWnd , cNewItem )
endif
return nil
//----------------------------------------------------------------------------//
METHOD KeyChar( nKey, nFlags ) CLASS TComboBox
local lAccept
do case
case nKey == VK_TAB .or. nKey == VK_RETURN
if ::bChange != nil
lAccept = Eval( ::bChange, nKey, nFlags, Self )
if ValType( lAccept ) == "L" .and. lAccept
::oWnd:GoNextCtrl( ::hWnd )
endif
else
::oWnd:GoNextCtrl( ::hWnd )
endif
if nKey == VK_RETURN // Execute DEFPUSHBUTTON Action
Super:KeyChar( nKey, nFlags )
endif
return 0
otherwise
return Super:KeyChar( nKey, nFlags )
endcase
return nil
//----------------------------------------------------------------------------//
METHOD LostFocus() CLASS TComboBox
local nAt := ::SendMsg( CB_GETCURSEL )
Super:LostFocus()
if nAt != CB_ERR
::nAt = nAt + 1
if ValType( Eval( ::bSetGet ) ) == "N"
Eval( ::bSetGet, nAt + 1 )
else
Eval( ::bSetGet, ::aItems[ nAt + 1 ] )
endif
else
Eval( ::bSetGet, GetWindowText( ::hWnd ) )
endif
return nil
//----------------------------------------------------------------------------//
METHOD Modify( cItem, nAt ) CLASS TComboBox
DEFAULT nAt := 0
if nAt != 0
::aItems[ nAt ] = cItem
::SendMsg( CB_DELETESTRING, nAt - 1 )
::SendMsg( CB_INSERTSTRING, nAt - 1, ansitowide( cItem ) )
endif
return nil
//----------------------------------------------------------------------------//
METHOD Insert( cItem, nAt ) CLASS TComboBox
DEFAULT nAt := 0
if nAt != 0
ASize( ::aItems, Len( ::aItems ) + 1 )
AIns( ::aItems, nAt )
::aItems[ nAt ] = cItem
::SendMsg( CB_INSERTSTRING, nAt - 1, ansitowide( cItem ) )
endif
return nil
//----------------------------------------------------------------------------//
METHOD Del( nAt ) CLASS TComboBox
DEFAULT nAt := 0
if nAt != 0
ADel( ::aItems, nAt )
ASize( ::aItems, Len( ::aItems ) - 1 )
::SendMsg( CB_DELETESTRING, nAt - 1 )
endif
return nil
//----------------------------------------------------------------------------//
METHOD GetDlgCode( nLastKey ) CLASS TComboBox
if Len( ::oWnd:aControls ) == 1
return DLGC_WANTALLKEYS
endif
::oWnd:nLastKey = nLastKey
return DLGC_WANTALLKEYS
//----------------------------------------------------------------------------//
METHOD Initiate( hDlg ) CLASS TComboBox
Super:Initiate( hDlg )
::Default()
if ::oGet != nil
::oGet:hWnd = GetWindow( ::hWnd, GW_CHILD )
::oGet:Link()
::oGet:bLostFocus = ;
{| hCtlFocus, nAt, cItem| cItem := GetWindowText( ::hWnd ), ;
nAt := ::SendMsg( CB_FINDSTRING, 0, Trim( cItem )) + 1,;
Eval( ::bSetGet, cItem ),;
::Select( nAt ),;
SetWindowText( ::hWnd, cItem ),;
If( ::bValid != nil .and. ;
GetParent( hCtlFocus ) == GetParent( ::hWnd ),;
If( ! Eval( ::bValid ),;
PostMessage( ::hWnd, WM_SETFOCUS ),),) }
endif
::Refresh()
return nil
//----------------------------------------------------------------------------//
METHOD Default() CLASS TComboBox
local cStart := Eval( ::bSetGet )
if ! Empty( ::hWnd ) .and. ::nStyle == CBS_DROPDOWNLIST
::nStyle := GetWindowLong( ::hWnd, GWL_STYLE )
endif
if Empty( cStart )
Eval( ::bSetGet, If( Len( ::aItems ) > 0, ::aItems[ 1 ], "" ) )
cStart = If( Len( ::aItems ) > 0, ::aItems[ 1 ], "" )
endif
AEval( ::aItems, { | cItem, nAt | ::SendMsg( CB_ADDSTRING, nAt, ansitowide( cItem ) ) } )
if ValType( cStart ) != "N"
::nAt = AScan( ::aItems, { | cItem | Upper( AllTrim( cItem ) ) == ;
Upper( AllTrim( cStart ) ) } )
else
::nAt = cStart
endif
::nAt = If( ::nAt > 0, ::nAt, 1 )
if cStart == nil
::Select( ::nAt )
else
::Set( cStart )
endif
return nil
//----------------------------------------------------------------------------//
METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TComboBox
local nResult := Super:MouseMove( nRow, nCol, nKeyFlags )
return If( ::lDrag, nResult, nil ) // We want standard behavior !!!
//----------------------------------------------------------------------------//
METHOD SetBitmaps( acBitmaps ) CLASS TComboBox
local n
::lOwnerDraw = .t.
if acBitmaps != nil
::aBitmaps = Array( Len( acBitmaps ) )
for n = 1 to Len( acBitmaps )
if File( acBitmaps[ n ] )
::aBitmaps[ n ] = ReadBitmap( 0, acBitmaps[ n ] )
else
::aBitmaps[ n ] = LoadBitmap( GetResources(), acBitmaps[ n ] )
endif
next
::nBmpHeight = nBmpHeight( ::aBitmaps[ 1 ] )
::nBmpWidth = nBmpWidth( ::aBitmaps[ 1 ] )
endif
return nil
//----------------------------------------------------------------------------//
METHOD Destroy() CLASS TComboBox
local n
if ::aBitmaps != nil
for n = 1 to Len( ::aBitmaps )
DeleteObject( ::aBitmaps[ n ] )
next
endif
if ::oGet != nil
::oGet:End()
endif
return Super:Destroy()
//----------------------------------------------------------------------------//
METHOD DrawItem( nIdCtl, nPStruct ) CLASS TComboBox
return LbxDrawItem( nPStruct, ::aBitmaps, ::aItems, ::nBmpWidth, ::bDrawItem )
//----------------------------------------------------------------------------//
METHOD VarGet() CLASS TComboBox
local cRet, nAt := ::SendMsg( CB_GETCURSEL )
if nAt != CB_ERR
::nAt = nAt + 1
cRet := ::aItems[ nAt + 1 ]
else
cRet := GetWindowText( ::hWnd )
endif
return cRet
//----------------------------------------------------------------------------//
METHOD lValid() CLASS TComboBox
local lRet := .t.
if ValType( ::bValid ) == "B"
lRet = Eval( ::bValid, ::oGet )
endif
return lRet
//----------------------------------------------------------------------------//
METHOD ShowToolTip() CLASS TComboBox
local nOldBottom
nOldBottom = ::nBottom
::nBottom = ::nTop + GetTextHeight( ::hWnd ) + 8
Super:ShowToolTip()
::nBottom = nOldBottom
return nil
//----------------------------------------------------------------------------//
static function IsAppThemed()
return .f.
Lo unico que he modificado es que la función FW_ANSITOWIDE no la encontraba y la he sustituido por ANSITOWIDE.
De esta forma, la unica diferencia que veo con antes (aunque he visto que la clase internamente tiene _) es que sale por defecto en azul el combo y que se expande menos posiciones.
