#include "FiveWin.ch"
#include "Constant.ch"
#define GWL_STYLE -16
#ifndef __CLIPPER__
#define COMBO_BASE 320
#else
#define COMBO_BASE WM_USER
#endif
#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_DIR 0x0145
#define CBS_OWNERDRAWVARIABLE 0x0020
#define CB_SETMINVISIBLE 5889 // 0x1701
#define CB_GETMINVISIBLE 5890 // 0x1702
#define CB_SETITEMHEIGHT 0x0153
#define CB_GETITEMHEIGHT 0x0154
#define CB_GETDROPPEDWIDTH 0x015f
#define CB_SETDROPPEDWIDTH 0x0160
#define COLOR_WINDOW 5
#define COLOR_WINDOWTEXT 8
#define GW_CHILD 5
#define GW_HWNDNEXT 2
#define WS_EX_LEFT 0x00000000
#define WS_EX_LEFTSCROLLBAR 0x00004000
//----------------------------------------------------------------------------//
CLASS TComboBox FROM TControl
DATA aItems, aBitmaps
DATA nItemHt
DATA lOwnerDraw, nBmpHeight, nBmpWidth
DATA nAt
DATA bDrawItem, bCloseUp, bOwnerDraw
DATA cError AS String
DATA oGet
DATA cSearchKey // Holds current search key for incremental search.
DATA lIncSearch INIT .F. // incremental search
DATA lCaseSensitive INIT .F.
DATA oResetTimer
DATA nOldClrPane // Old background color, if color changed with focus
// Directory Cbx FWH1707
DATA lDir INIT .f. //READONLY
DATA lSelDir INIT .f.
DATA cDir READONLY
DATA nDirStyle INIT 0 READONLY
DATA oSayDir
// Directory Cbx end
DATA hSelectionHeight, hItemHeight, hDropWidth PROTECTED
CLASSDATA lClrFocus INIT .F. // change GET color when focused
CLASSDATA nClrFocus INIT nRGB( 235, 235, 145 ) // color to use when GET is focused and lClrFocus is .T.
CLASSDATA aProperties ;
INIT { "aItems", "cTitle", "cVarName", "l3D", "nClrText",;
"nClrPane", "nAlign", "nTop", "nLeft",;
"nWidth", "nHeight", "oFont", "Cargo" }
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, cVarName, nHGet, ;
nSelHt, nItmHt, nListWidth, cDir, nAttr, oSayDir, bOwnerDraw ) CONSTRUCTOR
METHOD ReDefine( nId, bSetGet, aItems, oWnd, nHelpId, bValid, ;
bChange, nClrFore, nClrBack, cMsg, lUpdate, ;
bWhen, acBitmaps, bDrawItem, nStyle, cPict, ;
bEChange, cVarName, nHGet, ;
nSelHt, nItmHt, nListWidth, cDir, nAttr, oSayDir, bOwnerDraw ) CONSTRUCTOR
METHOD Add( cItem, nAt )
METHOD GenLocals()
METHOD cGenPrg( lDlgUnits )
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 DropDown()
METHOD CtlColor( hWndChild, hDCChild )
METHOD Default()
METHOD DefControl( oControl )
METHOD Del( nAt )
METHOD Destroy()
METHOD DrawItem( nIdCtl, nPStruct )
METHOD End() INLINE ::Hide(), If( ! Empty( ::oGet:hWnd ), ::oGet:End(),), ::Super:End()
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 GetKeyChar( nKey )
METHOD GetMinVisible() INLINE If( IsAppThemed(), ;
::SendMsg( CB_GETMINVISIBLE, 0, 0 ), 0 )
METHOD GotFocus()
METHOD HandleEvent( nMsg, nWParam, nLParam )
METHOD Initiate( hDlg )
METHOD Insert( cItem, nAt )
METHOD IsClosed() INLINE ::State() == 0
METHOD IsOpen() INLINE ::State() == 1
METHOD KeyChar( nKey, nFlags )
METHOD KeyDown( nKey, nFlags )
METHOD LostFocus( hWndGetFocus )
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( lChanged ) INLINE Eval( ::bSetGet,;
If( ValType( Eval( ::bSetGet ) ) == "N", 0, "" ) ),;
::nAt := 0, ::SendMsg( CB_RESETCONTENT ),;
if( ( lChanged != NIL .and. lChanged ) .or. ( lChanged == NIL ), ::Change(), )
METHOD Select( nItem ) INLINE ::nAt := nItem,;
::SendMsg( CB_SETCURSEL, nItem - 1, 0 )
METHOD Set( cNewItem )
METHOD SetBitmaps( acBitmaps )
METHOD SetColorFocus( nClrFocus )
METHOD SetItems( aItems, lChanged ) INLINE ::Reset( lChanged ), ::aItems := aItems,;
::Default(),;
if( ( lChanged != NIL .and. lChanged ) .or. ( lChanged == NIL ), ::Change(), )
// By default, 30 is the minimum number of visible items in XP Visual Themes
METHOD SetMinVisible( nItems ) INLINE ;
If( IsAppThemed(), ( ::SendMsg( CB_SETMINVISIBLE, nItems, 0 ) == 1 ), .f. )
METHOD ShowToolTip()
METHOD VarGet()
METHOD State() INLINE ::SendMsg( CB_GETDROPPEDSTATE, 0 )
METHOD HGet( nHeight )
// >> FWH 17.07
METHOD nSelectionHeight( nNew ) SETGET
METHOD nItemHeight( nNew ) SETGET
METHOD nDropWidth( nNew ) SETGET
METHOD GetSelText() INLINE If( ::lDir, COMBOSELTEXT( ::hWnd ), ::aItems[ ::nAt ] )
METHOD SetDir( cDir, nType )
METHOD SetFont( oFont ) INLINE ( ::Super:SetFont( oFont ), ::nSelectionHeight := ::hSelectionHeight, ::nItemHeight := ::hItemHeight )
// << FWH 17.07
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, cVarName, nHGet, ;
nSelHt, nItmHt, nListWidth, cDir, nAttr, oSayDir, bOwnerDraw ) 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
::uOriginalValue = Eval( ::bSetGet )
::oWnd = oWnd
::lUnicode = ::oWnd:lUnicode
::cSearchKey := ""
if ::lIncSearch
// ::oResetTimer = TTimer():New( 500, {|| ::cSearchKey := "" } )
endif
if acBitmaps != nil
::SetBitmaps( acBitmaps )
elseif !Empty( bOwnerDraw )
::lOwnerDraw = .t.
::bOwnerDraw := bOwnerDraw
else
::lOwnerDraw = .f.
/*
// FWH 17.07
if !Empty( nHGet )
::nBmpHeight := nHGet
endif
*/
endif
if ::lOwnerDraw .and. !lAnd( nStyle, CBS_OWNERDRAWVARIABLE )
nStyle = nOr( nStyle, CBS_OWNERDRAWFIXED )
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 ) )
//::nExStyle = nOr( WS_EX_LEFT, WS_EX_LEFTSCROLLBAR )
::nId = ::GetNewId()
::nHelpId = nHelpId
::bValid = bValid
::lDrag = lDesign
::lCaptured = .f.
::cMsg = cMsg
::lUpdate = lUpdate
::bWhen = bWhen
::bDrawItem = bDrawItem
::SetColor( nClrFore, nClrBack )
if oFont == nil
::GetFont()
else
::SetFont( oFont )
endif
::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.> )
// FWH 17.07
if cDir != nil
::cDir := cDir
::lDir := .t.
::nDirStyle := nAttr
::oSayDir := oSayDir
endif
if nHGet != nil
::hSelectionHeight := nHGet
::hItemHeight := nHGet
else
::hSelectionHeight := nSelHt
::hItemHeight := nItmHt
endif
::hDropWidth := nListWidth
// FWH17.07 end
if ! Empty( oWnd:hWnd )
::Create( "COMBOBOX" )
::Default()
::SetFont( ::oFont )
oWnd:AddControl( Self )
else
oWnd:DefControl( Self )
endif
DEFAULT cVarName := "oCbx" + ::GetCtrlIndex()
::cVarName = cVarName
::oGet:hWnd = GetWindow( ::hWnd, GW_CHILD )
if ! Empty( ::oGet:hWnd )
::oGet:Link()
::oGet:bLostFocus = ;
{ | hCtlFocus, nAt, cItem| cItem := ::GetText(), ;
nAt := ::SendMsg( CB_FINDSTRING, 0, Trim( cItem ) ) + 1,;
Eval( ::bSetGet, cItem ),;
::Select( nAt ),;
::SetText( cItem ),;
If( ::bValid != nil .and. ;
GetParent( hCtlFocus ) == GetParent( ::hWnd ),;
If( ! Eval( ::bValid, ::oGet, Self ),;
::PostMsg( WM_SETFOCUS ),),) }
::oGet:bKeyChar = { | nKey | ::GetKeyChar( nKey ) }
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, cVarName, nHGet, ;
nSelHt, nItmHt, nListWidth, cDir, nAttr, oSayDir, bOwnerDraw ) CLASS TComboBox
DEFAULT oWnd := GetWndDefault()
(cVarname,nAttr,oSayDir)
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
::uOriginalValue = Eval( ::bSetGet )
::oWnd = oWnd
::nHelpId = nHelpId
::bValid = bValid
::nAt = 0
::lDrag = .f.
::lCaptured = .f.
::cMsg = cMsg
::lUpdate = lUpdate
::bWhen = bWhen
::bDrawItem = bDrawItem
::nStyle = nStyle
::cSearchKey = ""
if ::lIncSearch
// ::oResetTimer = TTimer():New( 500, {|| ::cSearchKey := "" } )
endif
::lUnicode = ::oWnd:lUnicode
if acBitmaps != nil
::SetBitmaps( acBitmaps )
elseif !Empty( bOwnerDraw )
::lOwnerDraw = .t.
::bOwnerDraw = bOwnerDraw
DEFAULT nSelHt := 20
SetOwnerDrawItemHeight( nSelHt )
else
::lOwnerDraw = .F.
endif
::SetColor( nClrFore, nClrBack )
// ::GetFont() Fix for FWH 14.11
::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.> )
::oGet:bKeyChar = { | nKey | ::GetKeyChar( nKey ) }
oWnd:DefControl( Self )
// FWH 17.07
if cDir != nil
::cDir := cDir
::lDir := .t.
endif
if nHGet != nil
::hSelectionHeight := nHGet
::hItemHeight := nHGet
else
::hSelectionHeight := nSelHt
::hItemHeight := nItmHt
endif
::hDropWidth := nListWidth
// FWH17.07 end
return Self
//----------------------------------------------------------------------------//
METHOD HGet( nHeight ) CLASS TComboBox
/*
// FWH17.07
if !Empty( nHeight ) .and. nHeight > ::oFont:nHeight
::nBmpHeight := nHeight
::nStyle := nOr( ::nStyle, CBS_OWNERDRAWVARIABLE )
endif
*/
// FWH 17.07
::nSelectionHeight := nHeight
::nItemHeight := nHeight
return nil
//----------------------------------------------------------------------------//
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, cItem )
return nil
//----------------------------------------------------------------------------//
METHOD GenLocals() CLASS TComboBox
local cCode := ", " + ::cVarName
cCode += ", " + "c" + SubStr( ::cVarName, 2 )
cCode += " := " + If( ! Empty( ::GetText() ),;
'PadR( "' + ::GetText() + '", 20 )',;
'""' )
return cCode
//----------------------------------------------------------------------------//
METHOD cGenPrg( lDlgUnits ) CLASS TComboBox
local cCode := ""
local n
local nFactorX, nFactorY
local cTop, cLeft, cWidth, cHeight
DEFAULT lDlgUnits := .F.
if ::oWnd:IsKindOf( "TDIALOG" )
lDlgUnits := .T.
endif
nFactorX = If( lDlgUnits, 4 / nLoWord( GetDlgBaseUnits() ), 1 )
nFactorY = If( lDlgUnits, 8 / nHiWord( GetDlgBaseUnits() ), 1 )
::CoorsUpdate()
cTop = LTrim( Str( Int( ::nTop * nFactorX ) ) )
cLeft = LTrim( Str( Int( ::nLeft * nFactorY ) ) )
cWidth = LTrim( Str( Int( ::nWidth * nFactorY ) ) )
cHeight = LTrim( Str( Int( ::nHeight * nFactorX ) ) )
cCode += CRLF + " @ " + Str( ::nTop, 3 ) + ", " + Str( ::nLeft, 3 ) + ;
" COMBOBOX " + ::cVarName + " VAR " + "c" + ;
SubStr( ::cVarName, 2 ) + " ITEMS {" + ;
If( Len( ::aItems ) > 0, " ", "" )
for n = 1 to Len( ::aItems )
if n > 1
cCode += ", "
endif
cCode += '"' + ::aItems[ n ] + '"'
next
(cTop,cLeft,cWidth,cHeight)
cCode += If( Len( ::aItems ) > 0, " ", "" ) + "} ;" + CRLF + ;
" SIZE " + Str( ::nRight - ::nLeft + 1, 3 ) + ", " + ;
Str( ::nBottom - ::nTop + 1, 3 ) + " PIXEL OF " + ;
::oWnd:cVarName + CRLF
return cCode
//----------------------------------------------------------------------------//
METHOD Change() CLASS TComboBox
local cItem := ::GetText() // Current Value
local nAt, cDir
nAt = ::SendMsg( CB_GETCURSEL ) + 1
if nAt == ::nAt .and. ! Empty( Eval( ::bSetGet ) )
return nil
endif
::nAt := nAt
if ::nAt != 0 .and. ( ::nAt <= Len( ::aItems ) .or. ::lDir )
if ValType( Eval( ::bSetGet ) ) == "N"
Eval( ::bSetGet, ::nAt )
else
Eval( ::bSetGet, ( cItem := ::GetSelText() ) )
// Directory CBX FWH 1707
if !Empty( ::oSayDir ) .and. cItem = "["
cDir := ::oSayDir:GetText()
cItem := SubStr( cItem, 2, Len( cItem ) - 2 )
if cItem = "-"
cItem := SubStr( cItem, 2, 1 )
cDir := cItem + ":\"
else
if cItem == ".."
if RAt( "\", cDir ) > 3
cDir := cFilePath( cDir )
else
cDir := Left( cDir, 3 )
endif
else
cDir += "\" + cItem
endif
endif
::SetDir( cDir + "\*.*" )
//::SendMsg( CB_SHOWDROPDOWN, 1, 0 )
endif
// Directory CBX FWH 1707: end
endif
endif
if ! Empty( ::oGet:hWnd )
::oGet:VarPut( Eval( ::bSetGet ) )
::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
if ::lCaseSensitive .and. ::WinStyle( CBS_DROPDOWN ) // 2014-11-09
nAt = AScan( ::aItems, { | cItem | AllTrim( cItem ) == AllTrim( cNewItem ) } )
else
nAt = AScan( ::aItems,;
{ | cItem | Upper( AllTrim( cItem ) ) == ;
Upper( AllTrim( cNewItem ) ) } )
endif
endif
if ValType( cNewItem ) == "N" .or. nAt != 0
::Select( nAt )
else
cNewItem = cValToChar( cNewItem )
::SetText( cNewItem )
endif
Eval( ::bSetGet, cNewItem )
return nil
//----------------------------------------------------------------------------//
METHOD LostFocus( hWndGetFocus ) CLASS TComboBox
local nAt := ::SendMsg( CB_GETCURSEL )
::Super:LostFocus( hWndGetFocus )
if nAt != CB_ERR
::nAt = nAt + 1
if ValType( Eval( ::bSetGet ) ) == "N"
Eval( ::bSetGet, nAt + 1 )
else
if Empty( ::oGet:hWnd )
Eval( ::bSetGet, ::GetSelText() )
else
Eval( ::bSetGet, ::GetText() )
endif
endif
else
Eval( ::bSetGet, ::GetText() )
endif
if ::lClrFocus
if ::nOldClrPane != nil
if GetParent( hWndGetFocus ) != ::hWnd
::SetColor( ::nClrText, ::nOldClrPane )
endif
endif
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, 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, cItem )
endif
return nil
//----------------------------------------------------------------------------//
METHOD GotFocus() CLASS TComboBox
::cSearchKey := ""
if ::lClrFocus
::nOldClrPane = ::nClrPane
::SetColor( ::nClrText,;
If( ValType( ::nClrFocus ) == "B",;
Eval( ::nClrFocus ), ::nClrFocus ) )
if ::oGet != nil
::oGet:SetColor( ::nClrText,;
If( ValType( ::nClrFocus ) == "B",;
Eval( ::nClrFocus ), ::nClrFocus ) )
::oGet:bLostFocus = { || ::LostFocus() }
endif
endif
return ::Super:GotFocus()
//----------------------------------------------------------------------------//
METHOD KeyChar( nKey, nFlags ) CLASS TComboBox
local nNewAT := 0, nOldAT := ::nAT, uItem
(nFlags)
if Len( ::aItems ) == 0
return 0
endif
if ::lIncSearch
// ::oResetTimer:Deactivate()
do case
case nKey = 32 // VK_DELETE (DO NOT WORK!)
if Empty( ::oGet:hWnd )
::cSearchKey = ""
nNewAt = 1
uItem = ::aItems[ nNewAt ]
else
::cSearchKey += " "
endif
case nKey = VK_BACK
::cSearchKey = Left( ::cSearchKey, Len( ::cSearchKey ) - 1 )
case nKey = 190
nKey = 0
::cSearchKey += "."
case ! Empty( ::oGet:hWnd ) .and. nKey = VK_TAB
if ! GetKeyState( VK_SHIFT )
::oWnd:GoNextCtrl( ::hWnd )
else
::oWnd:GoPrevCtrl( ::hWnd )
endif
return 0
otherwise
if ::lCaseSensitive
::cSearchKey += Chr( nKey )
else
::cSearchKey += Upper( Chr( nKey ) )
endif
endcase
if Empty( uItem )
if nNewAt == 0
if ::lCaseSensitive
nNewAt = AScan( ::aItems, { | x | SubStr( x, 1, Len( ::cSearchKey ) ) == ::cSearchKey } )
else
nNewAt = AScan( ::aItems, { | x | SubStr( Upper( x ), 1, Len( ::cSearchKey ) ) == ::cSearchKey } )
endif
if Empty( ::oGet:hWnd )
uItem = ::aItems[ If( nNewAt > 0, nNewAt, Max( ::nAT, 1 ) ) ]
else
uItem = If( nNewAt > 0, ::aItems[ nNewAt ], ::cSearchKey )
//MsgInfo( uItem )
endif
else
uItem = ::aItems[ Max( nNewAt, 1) ]
endif
endif
::Set( If( ValType( Eval( ::bSetGet ) ) == "N", AScan( ::aItems, uItem ), uItem ) )
if ! Empty( ::oGet:hWnd )
::oGet:SetPos( Len( ::cSearchKey ) + 1 )
endif
endif
if ::bChange != nil
if ! Empty( ::oGet:hWnd ) .or. ( nNewAT != nOldAt .and. nNewAt != 0 )
Eval( ::bChange, Self, ::VarGet() )
endif
endif
if nKey == VK_RETURN
return ::oWnd:GoNextCtrl( ::hWnd )
endif
return If( ::lIncSearch, 0, nil )
//----------------------------------------------------------------------------//
METHOD KeyDown( nKey, nFlags ) CLASS TComboBox
if nKey == VK_ESCAPE .and. ::IsOpen()
::Close()
return 1
endif
return ::Super:KeyDown( nKey, nFlags )
//----------------------------------------------------------------------------//
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 GetKeyChar( nKey ) CLASS TComboBox
local nAt, cText
local cSearch
if ( nKey == VK_TAB .and. ! GetKeyState( VK_SHIFT ) ) .or. nKey == VK_RETURN
::oWnd:GoNextCtrl( ::hWnd )
return 0
else
if nKey == VK_TAB .and. GetKeyState( VK_SHIFT )
::oWnd:GoPrevCtrl( ::hWnd )
return 0
endif
endif
/*
// UPTO FWH 14.09
if ( nKey >= Asc( "A" ) .and. nKey <= Asc( "Z" ) ) .or. ;
( nKey >= Asc( "a" ) .and. nKey <= Asc( "z" ) ) .or. ;
( nKey >= Asc( "0" ) .and. nKey <= Asc( "9" ) ) .or. ;
Chr( nKey ) $ "+-/=?$*&%$() " .or. nKey == VK_BACK
if nKey == VK_BACK
cText = SubStr( ::oGet:GetText(), 1, ::oGet:oGet:pos - 1 )
else
cText = SubStr( ::oGet:GetText(), 1, ::oGet:oGet:pos - 1 ) + Chr( nKey )
endif
if ! Empty( cText )
if ( nAt := AScan( ::aItems, { | c | Upper( Left( c, Len( cText ) ) ) == ;
Upper( cText ) } ) ) != 0
::oGet:SetText( ::aItems[ nAt ] )
if ::oGet:oGet:buffer != nil
::oGet:oGet:buffer = PadR( ::aItems[ nAt ], Len( ::oGet:oGet:buffer ) )
endif
if nKey != VK_BACK
::oGet:SetPos( ::oGet:oGet:pos + 1 )
else
::oGet:SetPos( ::oGet:oGet:pos )
endif
return 0
endif
else
::oGet:SetText( "" )
if ::oGet:oGet:buffer != nil
::oGet:oGet:buffer = Space( Len( ::oGet:oGet:buffer ) )
endif
::oGet:oGet:pos = 0
::oGet:SetPos( 0 )
endif
endif
*/
// Substituted instead of commented block above 2014-11-09
if ::lIncSearch .and. ( nKey >= VK_SPACE .or. nKey == VK_BACK )
cText = Left( ::oGet:GetText(), ::oGet:oGet:pos - 1 )
cSearch = If( nKey == VK_BACK, cText, cText + Chr( nKey ) )
if ! Empty( cSearch )
nAt = AScan( ::aItems, { | c | Upper( Left( c, Len( cSearch ) ) ) == ;
Upper( cSearch ) } )
if nAt > 0
if ::lCaseSensitive
cText = cSearch + SubStr( ::aItems[ nAt ], Len( cSearch ) + 1 )
else
cText = ::aItems[ nAt ]
endif
::oGet:SetText( cText )
if ::oGet:oGet:buffer != nil
::oGet:oGet:buffer = PadR( cText, Len( ::oGet:oGet:buffer ) )
endif
::oGet:SetPos( Len( cSearch ) + 1 )
return 0 // Key handled
else
::oGet:SetText( cText )
if ::oGet:oGet:buffer != nil
::oGet:oGet:buffer = PadR( cText, Len( ::oGet:oGet:buffer ) )
endif
::oGet:SetPos( Len( cText ) + 1 )
return nil // Key to be handled by ::oGet
endif
else
::oGet:SetText( "" )
if ::oGet:oGet:buffer != nil
::oGet:oGet:buffer = Space( Len( ::oGet:oGet:buffer ) )
endif
::oGet:oGet:pos = 0
::oGet:SetPos( 0 )
endif
endif
return nKey
//----------------------------------------------------------------------------//
METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TComboBox
if nMsg == FM_CLOSEUP
return ::CloseUp()
endif
if nMsg == FM_DROPDOWN
return ::DropDown()
endif
return ::Super:HandleEvent( nMsg, nWParam, nLParam )
//----------------------------------------------------------------------------//
METHOD DropDown() CLASS TCombobox
if ! ::lOwnerDraw
if ::nItemHt == nil
::nItemHt := ::SendMsg( CB_GETITEMHEIGHT, 0, 0 )
endif
if FW_TouchFriendly() .and. ( IsEventByTouch() .or. ! FW_IsMousePresent() )
if DeviceTouchSpace() > ::nItemHt
::SendMsg( CB_SETITEMHEIGHT, 0, DeviceTouchSpace() )
endif
else
::SendMsg( CB_SETITEMHEIGHT, 0, ::nItemHt )
endif
endif
return 0
//----------------------------------------------------------------------------//
METHOD Initiate( hDlg ) CLASS TComboBox
::Super:Initiate( hDlg )
::Default()
if ::oGet != nil
::oGet:hWnd = GetWindow( ::hWnd, GW_CHILD )
::oGet:SetText( ::VarGet() )
if ::oGet:hWnd != 0
::oGet:Link()
endif
if ::oGet:bKeyChar == nil
/*
// UPTO FWH14.09
::oGet:bKeyChar = { | nKey | Eval( ::bSetGet, ::oGet:GetText() + ;
If( nKey != VK_TAB, Chr( nKey ), "" ) ),;
::SetText( ::oGet:GetText() + Chr( nKey ) ),;
If( nKey == VK_TAB .and. ! GetKeyState( VK_SHIFT ),;
oWndFromHwnd( ::oWnd:GoNextCtrl( ::hWnd ) ):SetFocus(),),;
nKey }
*/
// Substituted on 2014-11-09
::oGet:bKeyChar = { | nKey | ::GetKeyChar( nKey ) }
endif
::oGet:bLostFocus = ;
{ | hCtlFocus, nAt, cItem | (nAt), cItem := ::oGet:GetText(),;
Eval( ::bSetGet, cItem ),;
If( ::bValid != nil .and. ;
GetParent( hCtlFocus ) == GetParent( ::hWnd ),;
If( ! Eval( ::bValid, ::oGet, Self ),;
::PostMsg( WM_SETFOCUS ),),) }
if ::oGet:hWnd != 0
::oGet:SetFont( ::oFont )
endif
endif
::Refresh()
return nil
//----------------------------------------------------------------------------//
METHOD CtlColor( hWndChild, hDCChild ) CLASS TComboBox
(hWndChild)
if lAnd( GetWindowLong( ::hWnd, GWL_STYLE ), CBS_DROPDOWN )
SetTextColor( hDCChild, ::nClrText )
SetBkColor( hDCChild, ::nClrPane )
DEFAULT ::oBrush := TBrush():New( , ::nClrPane )
return ::oBrush:hBrush
endif
return nil
//----------------------------------------------------------------------------//
METHOD Default() CLASS TComboBox
local cStart := Eval( ::bSetGet )
if ! Empty( ::hWnd ) .and. ::nStyle == CBS_DROPDOWNLIST
::nStyle := GetWindowLong( ::hWnd, GWL_STYLE )
endif
if cStart == nil
Eval( ::bSetGet, If( Len( ::aItems ) > 0, ::aItems[ 1 ], "" ) )
cStart = If( Len( ::aItems ) > 0, ::aItems[ 1 ], "" )
endif
AEval( ::aItems, { | cItem, nAt | ::SendMsg( CB_ADDSTRING, nAt, cItem ) } ) // " " required by 64 bits
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
// FWH 17.07 >>
if ::hSelectionHeight != nil
::nSelectionHeight := ::hSelectionHeight
endif
if ::hItemHeight != nil
::nItemHeight := ::hItemHeight
endif
if ::nDropWidth != nil
::nDropWidth := ::hDropWidth
endif
if ::lDir
::SetDir( ::cDir )
endif
// FWH1707 <<
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, aBmp
::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
*/
// FWH2003: any image file
aBmp := ::ReadImage( acBitmaps[ n ] )
::aBitmaps[ n ] := aBmp[ 1 ]
DeleteObject( aBmp[ 2 ] )
next
::nBmpHeight = nBmpHeight( ::aBitmaps[ 1 ] )
::nBmpWidth = nBmpWidth( ::aBitmaps[ 1 ] )
SetOwnerDrawItemHeight( ::nBmpHeight )
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:Destroy()
endif
if ::lIncSearch
// ::oResetTimer:End()
endif
return ::Super:Destroy()
//----------------------------------------------------------------------------//
METHOD DrawItem( nIdCtl, nPStruct ) CLASS TComboBox
local uVal //, hItemStruct // why not used?
// local nOldH := ::nBmpHeight // why not used?
if ::bOwnerDraw == nil
if ::oPopup != nil
return ::Super:DrawItem( nIdCtl, nPStruct )
endif
uVal := LbxDrawItem( nPStruct, ::aBitmaps, ::aItems, ::nBmpWidth, ::bDrawItem )
else
uVal := Eval( ::bOwnerDraw, Self, nIdCtl, TDrawItemStruct():New( nPStruct ), nPStruct )
endif
return uVal
//----------------------------------------------------------------------------//
METHOD VarGet() CLASS TComboBox
local cRet, nAt := ::SendMsg( CB_GETCURSEL )
if nAt != CB_ERR
::nAt = nAt + 1
// cRet := If( Empty( ::oGet:hWnd ), ::aItems[ nAt + 1 ], ::oGet:GetText() )
cRet := If( Empty( ::oGet:hWnd ), ::GetSelText(), ::oGet:GetText() )
else
cRet := ::GetText()
endif
return cRet
//----------------------------------------------------------------------------//
METHOD lValid() CLASS TComboBox
local lRet := .t.
if ValType( ::bValid ) == "B"
lRet = Eval( ::bValid, ::oGet, Self )
endif
return lRet
//----------------------------------------------------------------------------//
METHOD SetColorFocus( nClrFocus ) CLASS TComboBox
local nOldClrFocus := ::nClrFocus
::lClrFocus = .T.
if nClrFocus != nil
::nClrFocus = nClrFocus
endif
return nOldClrFocus
//----------------------------------------------------------------------------//
METHOD ShowToolTip() CLASS TComboBox
local nOldBottom
nOldBottom = ::nBottom
::nBottom = ::nTop + GetTextHeight( ::hWnd ) + 8
::Super:ShowToolTip()
::nBottom = nOldBottom
return nil
//----------------------------------------------------------------------------//
METHOD nSelectionHeight( nNew ) CLASS TComboBox
if PCOUNT() == 0
return If( ::hWnd == nil, ::hSelectionHeight, ::SendMsg( CB_GETITEMHEIGHT, -1, 0 ) )
endif
if ::hWnd != nil
if nNew == nil
::Super:SetFont( ::oFont ) // reset selection and itemheight
if ::hItemHeight != nil
::nItemHeight := ::hItemHeight
endif
else
::hSelectionHeight := nNew
::SendMsg( CB_SETITEMHEIGHT, -1, nNew )
endif
endif
return ::nSelectionHeight
//----------------------------------------------------------------------------//
METHOD nItemHeight( nNew ) CLASS TComboBox
if PCOUNT() == 0
return If( ::hWnd == nil, ::hItemHeight, ::SendMsg( CB_GETITEMHEIGHT, -1, 0 ) )
endif
if ::hWnd != nil
if nNew == nil
::Super:SetFont( ::oFont ) // reset selection and itemheight
if ::hSelectionHeight != nil
::nSelectionHeight := ::hSelectionHeight
endif
else
::hItemHeight := nNew
::SendMsg( CB_SETITEMHEIGHT, 0, nNew )
endif
endif
return ::nItemHeight
//----------------------------------------------------------------------------//
METHOD nDropWidth( nNew ) CLASS TComboBox
if PCOUNT() == 0
return If( ::hWnd == 0, ::hDropWidth, ::SendMsg( CB_GETDROPPEDWIDTH, 0, 0 ) )
endif
if ::hWnd != nil .and. nNew != nil
::hDropWidth := nNew
::SendMsg( CB_SETDROPPEDWIDTH, nNew, 0 )
if ::hSelectionHeight != nil
::nSelectionHeight := ::hSelectionHeight
endif
endif
return ::nDropWidth
//----------------------------------------------------------------------------//
METHOD SetDir( cDir, nType ) CLASS TComboBox
DEFAULT nType := ::nDirStyle
::nDirStyle := nType
::aItems := {}
::cDir := cDir
DlgDirListComboBox( ::oWnd:hWnd, ::cDir, ::nID, If( ::oSayDir == nil, 0, ::oSayDir:nID ), ::nDirStyle ) // winapi\nonclient.c
::Select( 1 )
Eval( ::bSetGet, ::GetSelText() )
return nil
//----------------------------------------------------------------------------//
function SetCbxColorFocus( nClrFocus )
return TComboBox():SetColorFocus( nClrFocus )
//----------------------------------------------------------------------------//
//----------------------------------------------------------------------------//
CLASS TDrawItemStruct
DATA CtlType, CtlID, itemID, itemAction, itemState, hwndItem, hDC, aRect, itemData READONLY
ACCESS nTop INLINE ::aRect[ 1 ]
ACCESS nLeft INLINE ::aRect[ 2 ]
ACCESS nBottom INLINE ::aRect[ 3 ]
ACCESS nRight INLINE ::aRect[ 4 ]
ACCESS nHeight INLINE ::nBottom - ::nTop
ACCESS nWidth INLINE ::nRight - ::nLeft
METHOD New( nPStruct ) CONSTRUCTOR
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nPStruct ) CLASS TDrawItemStruct
local aData := GetDrawItemStruct( nPStruct )
::CtlType := aData[ 1 ]
::CtlID := aData[ 2 ]
::itemID := aData[ 3 ]
::itemAction := aData[ 4 ]
::itemState := aData[ 5 ]
::hwndItem := aData[ 6 ]
::hDC := aData[ 7 ]
::aRect := { aData[ 8 ], aData[ 9 ], aData[ 10 ], aData[ 11 ] }
::itemData := aData[ 13 ]
return Self
//----------------------------------------------------------------------------//
