FiveTech Software tech support forums

by **Mike Serra** » Tue Dec 23, 2008 9:58 am

Buenos días foro, tengo un problema con combos desde código incrustado en un dialogo. El único ejemplo que hay en samples es combos.prg pero faltaba el combos.ch, he cogido un combos.ch que tenía por ahi con esta estructura:

Code: Select all Expand view: #define ID_SIMPLE 110 #define ID_DROPDOWN 120 #define ID_DROPDOWNLIST 130 #define ID_SELECTION 140

suponiendo que esto está bien, cuando compilo el combos.prg, los elementos de los combos NO me aparecen aunque si los selecciono si cambian.

Reitero si me podeis poner un ejemplo manejando combos en dialogos, pero NO desde recursos.

Muchas Gracias a todos.

by **Antonio Linares** » Tue Dec 23, 2008 11:25 am

Mike,

Aqui tienes un ejemplo:

Code: Select all Expand view: #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 CENTERED return nil

by **Mike Serra** » Tue Dec 23, 2008 12:11 pm

Ups!

Me sale exactamente igual que en el ejemplo. Me pinta el combo se despliega pero está vacío

Estoy compilando con FWPPC 8.10, este es mi buildce.bat

Code: Select all Expand view: @ECHO OFF CLS ECHO ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ 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 :SINTAX if NOT EXIST %1.prg GOTO :NOEXIST ECHO Compiling... IF "%FWDIR%" == "" set FWDIR="c:\software\fwppc810\fwppc" set hdir=c:\software\fwppc810\harbour_ce set hdirc=%hdir%\bin set hdirl=%hdir%\lib set fwppc=c:\software\fwppc810\fwppc set vcdir=c:\software\fwppc810\vce set 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.log IF ERRORLEVEL 1 GOTO COMPILEERROR @type clip.log %vcdir%\bin\clarm -W3 -c /DARM /DUNICODE /I%hdir%\include /I%fwppc%\include %1.c :ENDCOMPILE IF EXIST %1.rc %vcdir%\bin\rc -r -d_CE %1 echo %1.obj > msvc.tmp echo %fwppc%\lib\FiveCE.lib %fwppc%\lib\FiveCEC.lib >> msvc.tmp echo %hdirl%\hbrtl.lib >> msvc.tmp echo %hdirl%\hbvm.lib >> msvc.tmp echo %hdirl%\gtgui.lib >> msvc.tmp echo %hdirl%\hblang.lib >> msvc.tmp echo %hdirl%\hbmacro.lib >> msvc.tmp echo %hdirl%\hbrdd.lib >> msvc.tmp echo %hdirl%\rddntx.lib >> msvc.tmp echo %hdirl%\rddcdx.lib >> msvc.tmp echo %hdirl%\rddfpt.lib >> msvc.tmp echo %hdirl%\hbsix.lib >> msvc.tmp echo %hdirl%\hbdebug.lib >> msvc.tmp echo %hdirl%\hbcommon.lib >> msvc.tmp echo %hdirl%\hbpp.lib >> msvc.tmp echo %hdirl%\hbcpage.lib >> msvc.tmp echo %hdirl%\hbw32.lib >> msvc.tmp rem echo %hdirl%\tip.lib >> msvc.tmp echo %hdirl%\hbpcre.lib >> msvc.tmp echo %vcdir%\lib\arm\coredll.lib >> msvc.tmp echo %vcdir%\lib\arm\corelibc.lib >> msvc.tmp echo %vcdir%\lib\arm\aygshell.lib >> msvc.tmp echo %vcdir%\lib\arm\ws2.lib >> msvc.tmp echo %vcdir%\lib\arm\mfcce400.lib >> msvc.tmp echo %vcdir%\lib\arm\ole32.lib >> msvc.tmp echo %vcdir%\lib\arm\oleaut32.lib >> msvc.tmp echo %vcdir%\lib\arm\olece400.lib >> msvc.tmp echo %vcdir%\lib\arm\uuid.lib >> msvc.tmp echo %vcdir%\lib\arm\ceshell.lib >> msvc.tmp echo %vcdir%\lib\arm\commctrl.lib >> msvc.tmp echo %vcdir%\lib\arm\wininet.lib >> msvc.tmp IF EXIST %1.res echo %1.res >> msvc.tmp %vcdir%\bin\link @msvc.tmp /nologo /SUBSYSTEM:WINDOWSCE,4.20 /MACHINE:ARM /ARMPADCODE:NO IF ERRORLEVEL 1 GOTO LINKERROR ECHO * Application successfully built * copy %1.exe %emulator_shared_folder% cecopy %1.exe dev:\samples GOTO EXIT ECHO rem delete temporary files @del %1.c @del %1.obj @del %1.ppo @del msvc.tmp :COMPILEERROR @type clip.log ECHO * Compile errors * GOTO EXIT :LINKERROR ECHO * Linking errors * GOTO EXIT :SINTAX ECHO SYNTAX: Build [Program] {-- No especifiques la extensi¢n PRG ECHO {-- Don't specify .PRG extension GOTO EXIT

¿Que puede ser?

Muchas Gracias

by **Antonio Linares** » Tue Dec 23, 2008 3:52 pm

Mike,

Añade esta clase entera al final de mi ejemplo y vuelve a construirlo, gracias

combobox.prg fwppc

Code: Select all Expand view: // 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() 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, 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 ) 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, FW_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, FW_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, 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 ) 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. //----------------------------------------------------------------------------//

by **Mike Serra** » Tue Dec 23, 2008 4:27 pm

Buenas Tardes Antonio,

Lo he incluido y al final lo he dejado asi:

Code: Select all Expand view: #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 varios cambios) es que sale por defecto en azul el combo y que se expande menos posiciones.

Muchas Gracias

by **Antonio Linares** » Tue Dec 23, 2008 6:04 pm

Mike,

El tamano lo puedes establecer con:

@ ..., ... COMBOBOX ... SIZE nAncho, nAlto

Entonces, te ha funcionado bien ?

by **fleal** » Wed Jun 24, 2009 8:45 pm

Ya hize los cambios y lo curioso es que algunos combos si los abre y otros no.
Veo en el foro que han tenido problemas con los combos y el nuevo windows mobile 6.1

Por eso preguntaba si alguien tiene el último build y el windows mobile. Que pueda decirme si los combos funcionan correctamente.

Gracias
Fernando

FiveTech Software tech support forums

Combos FWPPC 8.10

Combos FWPPC 8.10

Re: Combos FWPPC 8.10

Who is online