Combos FWPPC 8.10

Post Reply
Mike Serra
Posts: 287
Joined: Fri Apr 14, 2006 5:52 pm
Location: Córdoba (España)

Combos FWPPC 8.10

Post by Mike Serra »

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

#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.
Top
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:
Contact Antonio Linares

Post by Antonio Linares »

Mike,

Aqui tienes un ejemplo:

Code: Select all

#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
regards, saludos

Antonio Linares
www.fivetechsoft.com
Top
Mike Serra
Posts: 287
Joined: Fri Apr 14, 2006 5:52 pm
Location: Córdoba (España)

Post by Mike Serra »

Ups! :shock:

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

@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
Top
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:
Contact Antonio Linares

Post by Antonio Linares »

Mike,

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

combobox.prg fwppc

Code: Select all

// 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.

//----------------------------------------------------------------------------//
regards, saludos

Antonio Linares
www.fivetechsoft.com
Top
Mike Serra
Posts: 287
Joined: Fri Apr 14, 2006 5:52 pm
Location: Córdoba (España)

Post by Mike Serra »

Buenas Tardes Antonio,

Lo he incluido y al final lo he dejado asi:

Code: Select all


#include "FWCE.ch" 
#include "FiveWin.ch" 
#include "Constant.ch" 

#define GWL_STYLE          -16 

#define COMBO_BASE       0x140 

#define CB_ADDSTRING     ( COMBO_BASE + 3 ) 
#define CB_DELETESTRING  ( COMBO_BASE +  4 ) 
#define CB_GETCURSEL     ( COMBO_BASE +  7 ) 
#define CB_INSERTSTRING  ( COMBO_BASE + 10 ) 
#define CB_RESETCONTENT  ( COMBO_BASE + 11 ) 
#define CB_FINDSTRING    ( COMBO_BASE + 12 ) 
#define CB_SETCURSEL     ( COMBO_BASE + 14 ) 
#define CB_SHOWDROPDOWN  ( COMBO_BASE + 15 ) 
#define CB_GETDROPPEDSTATE  ( COMBO_BASE + 23 ) 
#define CB_ERR              -1 

#define CB_SETMINVISIBLE     5889 // 0x1701 
#define CB_GETMINVISIBLE     5890 // 0x1702 

#define SYS_COLOR_INDEX_FLAG  0x40000000 

#define COLOR_WINDOW         nOr( 5, SYS_COLOR_INDEX_FLAG ) 
#define COLOR_WINDOWTEXT     nOr( 8, SYS_COLOR_INDEX_FLAG ) 

#define MB_ICONEXCLAMATION  48   // 0x0030 

#define GW_CHILD             5 
#define GW_HWNDNEXT          2 

//----------------------------------------------------------------------------// 



function Main() 
   local oDlg, cValue :="One"
   DEFINE DIALOG oDlg TITLE "Combos" SIZE 200, 100 
   @ 1, 1 COMBOBOX cValue ITEMS { "One", "Two", "Three" } OF oDlg 
   ACTIVATE DIALOG oDlg CENTERED 
return nil 



CLASS TComboBox FROM TControl 

   DATA   aItems, aBitmaps 
   DATA   lOwnerDraw, nBmpHeight, nBmpWidth 
   DATA   nAt 
   DATA   bDrawItem, bCloseUp 
   DATA   cError AS String 
   DATA   oGet 

   METHOD New( nRow, nCol, bSetGet, aItems, nWidth, nHeight, oWnd, nHelpId,; 
               bChange, bValid, nClrText, nClrBack, lPixel, oFont,; 
               cMsg, lUpdate, bWhen, lDesign, acBitmaps, bDrawItem, nStyle,; 
               cPict, bEChange ) CONSTRUCTOR 

   METHOD ReDefine( nId, bSetGet, aItems, oWnd, nHelpId, bValid, ; 
               bChange, nClrText, nClrBack, cMsg, lUpdate,; 
               bWhen, acBitmaps, bDrawItem, nStyle, cPict, bEChange ) CONSTRUCTOR 

   METHOD Add( cItem, nAt ) 

   METHOD cToChar() INLINE  Super:cToChar( "COMBOBOX" ) 

   METHOD Change() 

   METHOD Close() INLINE ::SendMsg( CB_SHOWDROPDOWN, 0 ) 

   METHOD CloseUp() INLINE If( ::bCloseUp != nil, Eval( ::bCloseUp, Self ),) 

   METHOD Default() 

   METHOD DefControl( oControl ) 

   METHOD Del( nAt ) 

   METHOD Destroy() 

   METHOD DrawItem( nIdCtl, nPStruct ) 

   METHOD FillMeasure( nPInfo ) INLINE  LbxMeasure( nPInfo, ::nBmpHeight ) 

   METHOD FindString( cItem, nFrom ) INLINE ; 
                              nFrom := If( nFrom == nil, 0, nFrom ),; 
                              ::SendMsg( CB_FINDSTRING, nFrom, cItem ) + 1 

   METHOD Find( cItem, nFrom ) INLINE ::FindString( cItem, nFrom ) != 0 

   METHOD GetDlgCode( nLastKey ) 

   METHOD GetMinVisible() INLINE If( IsAppThemed(), ; 
                                    ::SendMsg( CB_GETMINVISIBLE, 0, 0 ), 0 ) 

   METHOD Initiate( hDlg ) 

   METHOD Insert( cItem, nAt ) 

   METHOD KeyChar( nKey, nFlags ) 
    
   METHOD LostFocus() 

   METHOD lValid() 

   METHOD Modify( cItem, nAt ) 

   METHOD MouseMove( nRow, nCol, nKeyFlags ) 

   METHOD Open() INLINE ::SendMsg( CB_SHOWDROPDOWN, 1 ) 

   METHOD Refresh() INLINE  ::Set( Eval( ::bSetGet ) ), Super:Refresh() 

   METHOD Reset() INLINE Eval( ::bSetGet,; 
                         If( ValType( Eval( ::bSetGet ) ) == "N", 0, "" ) ),; 
                         ::nAt := 0, ::SendMsg( CB_RESETCONTENT ),; 
                         ::Change() 

   METHOD Select( nItem ) INLINE ::nAt := nItem,; 
                                 ::SendMsg( CB_SETCURSEL, Max( 0, nItem - 1 ), 0 ) 

   METHOD Set( cNewItem ) 

   METHOD SetBitmaps( acBitmaps ) 

   METHOD SetItems( aItems ) INLINE ::Reset(), ::aItems := aItems,; 
                                    ::Default(), ::Change() 

   // By default, 30 is the minimum number of visible items in XP Visual Themes 
   #ifndef __CLIPPER__ 
      METHOD SetMinVisible( nItems ) INLINE ; 
         If( IsAppThemed(), ( ::SendMsg( CB_SETMINVISIBLE, nItems, 0 ) == 1 ), .f. ) 
   #endif 

   METHOD ShowToolTip() 

   METHOD VarGet() 
   METHOD State() INLINE ::SendMsg( CB_GETDROPPEDSTATE, 0 ) 
   METHOD IsClosed() INLINE ::State() == 0 
   METHOD IsOpen() INLINE ::State() == 1 

   METHOD LButtonDown() INLINE ::Open() 

ENDCLASS 

//----------------------------------------------------------------------------// 

METHOD New( nRow, nCol, bSetGet, aItems, nWidth, nHeight, oWnd, nHelpId,; 
            bChange, bValid, nClrFore, nClrBack, lPixel, oFont,; 
            cMsg, lUpdate, bWhen, lDesign, acBitmaps, bDrawItem, nStyle,; 
            cPict, bEChange ) CLASS TComboBox 

   if nClrFore == nil 
      nClrBack := GetSysColor( COLOR_WINDOW ) 
   endif 

   DEFAULT nRow     := 0, nCol := 0, bSetGet := { || nil },; 
           oWnd     := GetWndDefault(),; 
           oFont    := oWnd:oFont,; 
           aItems   := {}, nWidth := 40, nHeight := 60,; 
           nClrFore := GetSysColor( COLOR_WINDOWTEXT ),; 
           lPixel   := .f., lUpdate := .f., lDesign := .f.,; 
           nStyle   := CBS_DROPDOWNLIST 

   ::cCaption  = "" 
   ::nTop      = nRow * If( lPixel, 1, CMB_CHARPIX_H ) 
   ::nLeft     = nCol * If( lPixel, 1, CMB_CHARPIX_W ) 
   ::nBottom   = ::nTop  + nHeight - 1 
   ::nRight    = ::nLeft + nWidth  - 1 
   ::nAt       = 0 
   ::aItems    = aItems 
   ::bChange   = bChange 
   ::bSetGet   = bSetGet 
   ::oWnd      = oWnd 
   ::oFont     = oFont 

   if acBitmaps != nil 
      ::SetBitmaps( acBitmaps ) 
   else 
      ::lOwnerDraw = .f. 
   endif 

   ::nStyle    = nOR( If( nStyle == CBS_DROPDOWN, 0, LBS_NOTIFY ), WS_TABSTOP,; 
                      nStyle,; 
                      LBS_DISABLENOSCROLL, WS_CHILD, WS_VISIBLE, WS_BORDER,; 
                      WS_VSCROLL, If( lDesign, WS_CLIPSIBLINGS, 0 ),; 
                      If( ::lOwnerDraw, CBS_OWNERDRAWFIXED, 0 ) ) 

   ::nId       = ::GetNewId() 
   ::nHelpId   = nHelpId 
   ::bValid    = bValid 
   ::lDrag     = lDesign 
   ::lCaptured = .f. 
   ::cMsg      = cMsg 
   ::lUpdate   = lUpdate 
   ::bWhen     = bWhen 
   ::bDrawItem = bDrawItem 

   ::SetColor( nClrFore, nClrBack ) 

   if nStyle == CBS_DROPDOWN 
      ::oGet := TGet():ReDefine( nil,    ;  // ID not used 
                              ::bSetGet, ;  // bSETGET(uVar) 
                              Self,      ;  // oDlg 
                              ::nHelpID, ;  // Help Context ID 
                              cPict,     ;  // Picture 
                              nil,       ;  // Valid is handled by the CBx 
                              ::nClrText,; 
                              ::nClrPane,; 
                              ::oFont,   ;  // <oFont> 
                              nil,       ;  // <oCursor> 
                              cMsg,      ;  // cMsg 
                              nil,       ;  // <.update.> 
                              nil,       ;  // <{uWhen}> 
                              bEChange,  ;  // {|nKey,nFlags,Self| <uEChange>} 
                              .F.        )  // <.readonly.> ) 
   endif 

   if ! Empty( oWnd:hWnd ) 
      ::Create( "COMBOBOX" ) 
      ::nHeight = nHeight 
      ::nWidth = nWidth 
      ::Default() 
      if oFont != nil 
         ::SetFont( oFont ) 
      endif 
      oWnd:AddControl( Self ) 
   else 
      oWnd:DefControl( Self ) 
   endif 

   if ::oGet != nil 
      ::oGet:hWnd = GetWindow( ::hWnd, GW_CHILD ) 
      ::oGet:Link() 
      ::oGet:bLostFocus = ; 
      {| hCtlFocus, nAt, cItem| cItem := GetWindowText( ::hWnd ), ; 
      nAt := ::SendMsg( CB_FINDSTRING, 0, Trim( cItem )) + 1,; 
      Eval( ::bSetGet, cItem ),; 
      ::Select( nAt ),; 
      SetWindowText( ::hWnd, cItem ),; 
      If( ::bValid != nil .and. ; 
      GetParent( hCtlFocus ) == GetParent( ::hWnd ),; 
      If( ! Eval( ::bValid ),; 
      PostMessage( ::hWnd, WM_SETFOCUS ),),) } 
  endif 

   if lDesign 
      ::CheckDots() 
   endif 

return Self 

//----------------------------------------------------------------------------// 

METHOD ReDefine( nId, bSetGet, aItems, oWnd, nHelpId, bValid, ; 
                 bChange, nClrFore, nClrBack, cMsg, lUpdate, ; 
                 bWhen, acBitmaps, bDrawItem, nStyle, cPict, ; 
                 bEChange ) CLASS TComboBox 

   if nClrFore == nil 
      nClrBack := GetSysColor( COLOR_WINDOW ) 
   endif 

   DEFAULT aItems   := {},; 
           nClrFore := GetSysColor( COLOR_WINDOWTEXT ),; 
           lUpdate  := .f., ; 
           nStyle   := CBS_DROPDOWNLIST 

   ::nId       = nId 
   ::hWnd      = 0 
   ::aItems    = aItems 
   ::bChange   = bChange 
   ::bSetGet   = bSetGet 
   ::oWnd      = oWnd 
   ::nHelpId   = nHelpId 
   ::bValid    = bValid 
   ::nAt       = 0 
   ::lDrag     = .f. 
   ::lCaptured = .f. 
   ::cMsg      = cMsg 
   ::lUpdate   = lUpdate 
   ::bWhen     = bWhen 
   ::bDrawItem = bDrawItem 
   ::nStyle    = nStyle 

   if acBitmaps != nil 
      ::SetBitmaps( acBitmaps ) 
   else 
      ::lOwnerDraw = .f. 
   endif 

   ::SetColor( nClrFore, nClrBack ) 

   if nAnd( ::nStyle, CBS_DROPDOWNLIST ) == CBS_DROPDOWN 
      ::oGet := TGet():ReDefine( nil,    ;  // ID not used 
                              ::bSetGet, ;  // bSETGET(uVar) 
                              Self,      ;  // oDlg 
                              ::nHelpID, ;  // Help Context ID 
                              cPict,     ;  // Picture 
                              nil,       ;  // Valid is handled by the CBx 
                              ::nClrText,; 
                              ::nClrPane,; 
                              ::oFont,   ;  // <oFont> 
                              nil,       ;  // <oCursor> 
                              cMsg,      ;  // cMsg 
                              nil,       ;  // <.update.> 
                              nil,       ;  // <{uWhen}> 
                              bEChange,  ;  // {|nKey,nFlags,Self| <uEChange>} 
                              .F.        )  // <.readonly.> ) 
     endif 

   oWnd:DefControl( Self ) 

return Self 

//----------------------------------------------------------------------------// 

METHOD Add( cItem, nAt ) CLASS TComboBox 

   DEFAULT nAt := 0 

   if nAt == 0 
      AAdd( ::aItems, cItem ) 
   else 
      ASize( ::aItems, Len( ::aItems ) + 1 ) 
      AIns( ::aItems, nAt ) 
      ::aItems[ nAt ] = cItem 
   endif 

   ::SendMsg( CB_ADDSTRING, nAt, Ansitowide( cItem ) ) 

return nil 

//----------------------------------------------------------------------------// 

METHOD Change() CLASS TComboBox 

   local cItem := GetWindowText( ::hWnd ) // Current Value 
   local nAt 

   nAt = ::SendMsg( CB_GETCURSEL ) + 1 

   if nAt == ::nAt .and. ! Empty( Eval( ::bSetGet ) ) 
      return nil 
   endif 

   ::nAt := nAt 

   if ::nAt != 0 .and. ::nAt <= Len( ::aItems ) 
      if ValType( Eval( ::bSetGet ) ) == "N" 
         Eval( ::bSetGet, ::nAt ) 
      else 
         Eval( ::bSetGet, ::aItems[ ::nAt ] ) 
      endif 
   endif 

   if ::oGet != nil                        // Always not nil for dropdown 
      ::oGet:VarPut( Eval( ::bSetGet ) )   // udate variable before calling bChange 
      ::oGet:Refresh() 
   endif 

   if ::bChange != nil 
      Eval( ::bChange, Self, cItem ) 
   endif 

return nil 

//----------------------------------------------------------------------------// 

METHOD DefControl( oControl ) CLASS TComboBox 

   if ::aControls == nil 
      ::aControls = {} 
   endif 

   AAdd( ::AControls, oControl ) 

return nil 

//----------------------------------------------------------------------------// 

METHOD Set( cNewItem ) CLASS TComboBox 

   local nAt 

   if ValType( cNewItem ) == "N" 
      nAt = cNewItem 
      if nAt == 0 
         nAt = 1 
      endif 
   else 
      nAt = AScan( ::aItems,; 
                   { | cItem | Upper( AllTrim( cItem ) ) == ; 
                               Upper( AllTrim( cNewItem ) ) } ) 
   endif 

   if ValType( cNewItem ) == "N" .or. nAt != 0 
      ::Select( nAt ) 
      Eval( ::bSetGet, cNewItem ) 
   else 
      cNewItem := cValToChar( cNewItem ) 
      Eval( ::bSetGet, cNewItem ) 
      SetWindowText( ::hWnd , cNewItem ) 
   endif 

return nil 

//----------------------------------------------------------------------------// 

METHOD KeyChar( nKey, nFlags ) CLASS TComboBox 

   local lAccept 

   do case 
      case nKey == VK_TAB .or. nKey == VK_RETURN 
           if ::bChange != nil 
              lAccept = Eval( ::bChange, nKey, nFlags, Self ) 
              if ValType( lAccept ) == "L" .and. lAccept 
                 ::oWnd:GoNextCtrl( ::hWnd ) 
              endif 
           else 
              ::oWnd:GoNextCtrl( ::hWnd ) 
           endif 

           if nKey == VK_RETURN  // Execute DEFPUSHBUTTON Action 
              Super:KeyChar( nKey, nFlags ) 
           endif 

           return 0 

      otherwise 
           return Super:KeyChar( nKey, nFlags ) 
   endcase 
    
return nil    

//----------------------------------------------------------------------------// 

METHOD LostFocus() CLASS TComboBox 

   local nAt := ::SendMsg( CB_GETCURSEL ) 

   Super:LostFocus() 

   if nAt != CB_ERR 
      ::nAt = nAt + 1 
      if ValType( Eval( ::bSetGet ) ) == "N" 
         Eval( ::bSetGet, nAt + 1 ) 
      else 
         Eval( ::bSetGet, ::aItems[ nAt + 1 ] ) 
      endif 
   else 
      Eval( ::bSetGet, GetWindowText( ::hWnd ) ) 
   endif 

return nil 

//----------------------------------------------------------------------------// 

METHOD Modify( cItem, nAt ) CLASS TComboBox 

   DEFAULT nAt := 0 

   if nAt != 0 
      ::aItems[ nAt ] = cItem 
      ::SendMsg( CB_DELETESTRING, nAt - 1 ) 
      ::SendMsg( CB_INSERTSTRING, nAt - 1, ansitowide( cItem ) ) 
   endif 

return nil 

//----------------------------------------------------------------------------// 

METHOD Insert( cItem, nAt ) CLASS TComboBox 

   DEFAULT nAt := 0 

   if nAt != 0 
      ASize( ::aItems, Len( ::aItems ) + 1 ) 
      AIns( ::aItems, nAt ) 
      ::aItems[ nAt ] = cItem 
      ::SendMsg( CB_INSERTSTRING, nAt - 1, ansitowide( cItem ) ) 
   endif 

return nil 

//----------------------------------------------------------------------------// 

METHOD Del( nAt ) CLASS TComboBox 

   DEFAULT nAt := 0 

   if nAt != 0 
      ADel( ::aItems, nAt ) 
      ASize( ::aItems, Len( ::aItems ) - 1 ) 
      ::SendMsg( CB_DELETESTRING, nAt - 1 ) 
   endif 

return nil 

//----------------------------------------------------------------------------// 

METHOD GetDlgCode( nLastKey ) CLASS TComboBox 

   if Len( ::oWnd:aControls ) == 1 
      return DLGC_WANTALLKEYS 
   endif 

   ::oWnd:nLastKey = nLastKey 

   return DLGC_WANTALLKEYS 

//----------------------------------------------------------------------------// 

METHOD Initiate( hDlg ) CLASS TComboBox 

   Super:Initiate( hDlg ) 

   ::Default() 

   if ::oGet != nil 
      ::oGet:hWnd = GetWindow( ::hWnd, GW_CHILD ) 
      ::oGet:Link() 

      ::oGet:bLostFocus = ; 
      {| hCtlFocus, nAt, cItem| cItem := GetWindowText( ::hWnd ), ; 
      nAt := ::SendMsg( CB_FINDSTRING, 0, Trim( cItem )) + 1,; 
      Eval( ::bSetGet, cItem ),; 
      ::Select( nAt ),; 
      SetWindowText( ::hWnd, cItem ),; 
      If( ::bValid != nil .and. ; 
      GetParent( hCtlFocus ) == GetParent( ::hWnd ),; 
      If( ! Eval( ::bValid ),; 
      PostMessage( ::hWnd, WM_SETFOCUS ),),) } 
   endif 

   ::Refresh() 

return nil 

//----------------------------------------------------------------------------// 

METHOD Default() CLASS TComboBox 

   local cStart := Eval( ::bSetGet ) 

   if ! Empty( ::hWnd ) .and. ::nStyle == CBS_DROPDOWNLIST 
      ::nStyle := GetWindowLong( ::hWnd, GWL_STYLE ) 
   endif 

   if Empty( cStart ) 
      Eval( ::bSetGet, If( Len( ::aItems ) > 0, ::aItems[ 1 ], "" ) ) 
      cStart = If( Len( ::aItems ) > 0, ::aItems[ 1 ], "" ) 
   endif 

   AEval( ::aItems, { | cItem, nAt | ::SendMsg( CB_ADDSTRING, nAt, ansitowide( cItem ) ) } ) 

   if ValType( cStart ) != "N" 
      ::nAt = AScan( ::aItems, { | cItem | Upper( AllTrim( cItem ) ) == ; 
                                           Upper( AllTrim( cStart ) ) } ) 
   else 
      ::nAt = cStart 
   endif 

   ::nAt = If( ::nAt > 0, ::nAt, 1 ) 

   if cStart == nil 
      ::Select( ::nAt ) 
   else 
      ::Set( cStart ) 
   endif 

return nil 

//----------------------------------------------------------------------------// 

METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TComboBox 

   local nResult := Super:MouseMove( nRow, nCol, nKeyFlags ) 

return If( ::lDrag, nResult, nil )    // We want standard behavior !!! 

//----------------------------------------------------------------------------// 

METHOD SetBitmaps( acBitmaps ) CLASS TComboBox 

   local n 

   ::lOwnerDraw = .t. 

   if acBitmaps != nil 
      ::aBitmaps = Array( Len( acBitmaps ) ) 
      for n = 1 to Len( acBitmaps ) 
         if File( acBitmaps[ n ] ) 
            ::aBitmaps[ n ] = ReadBitmap( 0, acBitmaps[ n ] ) 
         else 
            ::aBitmaps[ n ] = LoadBitmap( GetResources(), acBitmaps[ n ] ) 
         endif 
      next 
      ::nBmpHeight = nBmpHeight( ::aBitmaps[ 1 ] ) 
      ::nBmpWidth  = nBmpWidth( ::aBitmaps[ 1 ] ) 
   endif 

return nil 

//----------------------------------------------------------------------------// 

METHOD Destroy() CLASS TComboBox 

   local n 

   if ::aBitmaps != nil 
      for n = 1 to Len( ::aBitmaps ) 
         DeleteObject( ::aBitmaps[ n ] ) 
      next 
   endif 

   if ::oGet != nil 
      ::oGet:End() 
   endif 

return Super:Destroy() 

//----------------------------------------------------------------------------// 

METHOD DrawItem( nIdCtl, nPStruct ) CLASS TComboBox 

return LbxDrawItem( nPStruct, ::aBitmaps, ::aItems, ::nBmpWidth, ::bDrawItem ) 

//----------------------------------------------------------------------------// 

METHOD VarGet() CLASS TComboBox 

   local cRet, nAt := ::SendMsg( CB_GETCURSEL ) 

   if nAt != CB_ERR 
      ::nAt = nAt + 1 
      cRet :=  ::aItems[ nAt + 1 ] 
   else 
      cRet := GetWindowText( ::hWnd ) 
   endif 

return cRet 

//----------------------------------------------------------------------------// 

METHOD lValid() CLASS TComboBox 

   local lRet := .t. 

   if ValType( ::bValid ) == "B" 
      lRet = Eval( ::bValid, ::oGet  ) 
   endif 

return lRet 

//----------------------------------------------------------------------------// 

METHOD ShowToolTip() CLASS TComboBox 

   local nOldBottom 

   nOldBottom = ::nBottom 
   ::nBottom  = ::nTop + GetTextHeight( ::hWnd ) + 8 

   Super:ShowToolTip() 
   ::nBottom  = nOldBottom 

return nil 

//----------------------------------------------------------------------------// 

static function IsAppThemed() 

return .f.
Lo unico que he modificado es que la función FW_ANSITOWIDE no la encontraba y la he sustituido por ANSITOWIDE.

De esta forma, la unica diferencia que veo con antes (aunque he visto que la clase internamente tiene _) es que sale por defecto en azul el combo y que se expande menos posiciones.

Muchas Gracias
Top
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:
Contact Antonio Linares

Post by Antonio Linares »

Mike,

El tamano lo puedes establecer con:

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

Entonces, te ha funcionado bien ?
regards, saludos

Antonio Linares
www.fivetechsoft.com
Top
fleal
Posts: 234
Joined: Tue Oct 25, 2005 12:39 am
Location: México, DF

Re: Combos FWPPC 8.10

Post by fleal »

Ya hize _ 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
Top
Post Reply

Return to “FiveWin para Pocket PC”