Code: Select all | Expand
#define ID_SIMPLE 110#define ID_DROPDOWN 120#define ID_DROPDOWNLIST 130#define ID_SELECTION 140
Code: Select all | Expand
#include "FWCE.ch"function Main() local oDlg, cValue DEFINE DIALOG oDlg TITLE "Combos" ; SIZE 200, 100 @ 1, 1 COMBOBOX cValue ITEMS { "One", "Two", "Three" } OF oDlg ACTIVATE DIALOG oDlg CENTEREDreturn nil
Code: Select all | Expand
@ECHO OFFCLSECHO ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ECHO ³ FiveWin for Pocket PC - October 2008 Harbour development power ³ÜECHO ³ (c) FiveTech, 1993-2008 for Microsoft Windows Pocket PC ³ÛECHO ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙÛECHO ÿ ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßif A%1 == A GOTO :SINTAXif NOT EXIST %1.prg GOTO :NOEXISTECHO Compiling...IF "%FWDIR%" == "" set FWDIR="c:\software\fwppc810\fwppc"set hdir=c:\software\fwppc810\harbour_ceset hdirc=%hdir%\binset hdirl=%hdir%\libset fwppc=c:\software\fwppc810\fwppcset vcdir=c:\software\fwppc810\vceset include=%vcdir%\include\arm;%hdir%\include;%include%set lib=%vcdir%\lib;%hdir%\lib;%lib%set emulator_shared_folder=c:\pocketpc%hdirc%\harbour %1 /n /i..\include;%hdir%\include /p %2 %3 > clip.logIF ERRORLEVEL 1 GOTO COMPILEERROR@type clip.log%vcdir%\bin\clarm -W3 -c /DARM /DUNICODE /I%hdir%\include /I%fwppc%\include %1.c:ENDCOMPILEIF EXIST %1.rc %vcdir%\bin\rc -r -d_CE %1echo %1.obj > msvc.tmpecho %fwppc%\lib\FiveCE.lib %fwppc%\lib\FiveCEC.lib >> msvc.tmpecho %hdirl%\hbrtl.lib >> msvc.tmpecho %hdirl%\hbvm.lib >> msvc.tmpecho %hdirl%\gtgui.lib >> msvc.tmpecho %hdirl%\hblang.lib >> msvc.tmpecho %hdirl%\hbmacro.lib >> msvc.tmpecho %hdirl%\hbrdd.lib >> msvc.tmpecho %hdirl%\rddntx.lib >> msvc.tmpecho %hdirl%\rddcdx.lib >> msvc.tmpecho %hdirl%\rddfpt.lib >> msvc.tmpecho %hdirl%\hbsix.lib >> msvc.tmpecho %hdirl%\hbdebug.lib >> msvc.tmpecho %hdirl%\hbcommon.lib >> msvc.tmpecho %hdirl%\hbpp.lib >> msvc.tmpecho %hdirl%\hbcpage.lib >> msvc.tmpecho %hdirl%\hbw32.lib >> msvc.tmprem echo %hdirl%\tip.lib >> msvc.tmpecho %hdirl%\hbpcre.lib >> msvc.tmpecho %vcdir%\lib\arm\coredll.lib >> msvc.tmpecho %vcdir%\lib\arm\corelibc.lib >> msvc.tmpecho %vcdir%\lib\arm\aygshell.lib >> msvc.tmpecho %vcdir%\lib\arm\ws2.lib >> msvc.tmpecho %vcdir%\lib\arm\mfcce400.lib >> msvc.tmpecho %vcdir%\lib\arm\ole32.lib >> msvc.tmpecho %vcdir%\lib\arm\oleaut32.lib >> msvc.tmpecho %vcdir%\lib\arm\olece400.lib >> msvc.tmpecho %vcdir%\lib\arm\uuid.lib >> msvc.tmpecho %vcdir%\lib\arm\ceshell.lib >> msvc.tmpecho %vcdir%\lib\arm\commctrl.lib >> msvc.tmpecho %vcdir%\lib\arm\wininet.lib >> msvc.tmpIF EXIST %1.res echo %1.res >> msvc.tmp%vcdir%\bin\link @msvc.tmp /nologo /SUBSYSTEM:WINDOWSCE,4.20 /MACHINE:ARM /ARMPADCODE:NOIF ERRORLEVEL 1 GOTO LINKERRORECHO * Application successfully built *copy %1.exe %emulator_shared_folder%cecopy %1.exe dev:\samplesGOTO EXITECHOrem delete temporary files@del %1.c@del %1.obj@del %1.ppo@del msvc.tmp:COMPILEERROR@type clip.logECHO * Compile errors *GOTO EXIT:LINKERRORECHO * Linking errors *GOTO EXIT:SINTAXECHO SYNTAX: Build [Program] {-- No especifiques la extensi¢n PRGECHO {-- Don't specify .PRG extensionGOTO EXITCode: Select all | Expand
// FWPPC Class TComboBox (C) FiveTech Software 2005#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//----------------------------------------------------------------------------//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() endifreturn 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, FW_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 ) endifreturn 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 ) endifreturn 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 ) ) endifreturn 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, FW_AnsiToWide( cItem ) ) endifreturn 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, FW_AnsiToWide( cItem ) ) endifreturn 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 ) endifreturn 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, FW_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 ) endifreturn 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 ] ) endifreturn 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() endifreturn Super:Destroy()//----------------------------------------------------------------------------//METHOD DrawItem( nIdCtl, nPStruct ) CLASS TComboBoxreturn 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 ) endifreturn cRet//----------------------------------------------------------------------------//METHOD lValid() CLASS TComboBox local lRet := .t. if ValType( ::bValid ) == "B" lRet = Eval( ::bValid, ::oGet ) endifreturn lRet//----------------------------------------------------------------------------//METHOD ShowToolTip() CLASS TComboBox local nOldBottom nOldBottom = ::nBottom ::nBottom = ::nTop + GetTextHeight( ::hWnd ) + 8 Super:ShowToolTip() ::nBottom = nOldBottomreturn nil//----------------------------------------------------------------------------//static function IsAppThemed()return .f.//----------------------------------------------------------------------------//Code: Select all | Expand
#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.