Congratulations Silvio, excellent example. I modified it a little for my taste. Some things, I didn't understand, so I can't help much. Very good.
Code: Select all | Expand
// Cambiado por: kapiabafwh@gmail.com - 17/11/2020 - Covid-19.#Include "fivewin.ch"#Include "constant.ch"#Include "ttitle.ch"#Include "Combos.ch"#Define CLR_LGREEN nRGB
( 190,
215,
190 )STATIC cSeek :=
''STATIC oSeek
STATIC nField
STATIC cIniFile
REQUEST HB_Lang_IT
REQUEST HB_CODEPAGE_ITWIN
ANNOUNCE RDDSYS
REQUEST OrdKeyNo, OrdKeyCount, OrdCreate, OrdKeyGoto
REQUEST DBFCDX, DBFFPT
FUNCTION Main
() FIELD FIRST, LAST, CITY, STATE, CUST
LOCAL cDbf :=
"Cust" LOCAL aBrowse := ARRAY
( 10 ) LOCAL BEDIT
HB_LangSelect
( "IT" ) HB_SetCodePage
( "ITWIN" ) SET CENTURY
ON SET DATE ITALIAN
SET EPOCH
TO YEAR( DATE
() ) -
30 RDDSetDefault
( 'DBFCDX' ) // ??? Para que sirve, Silvio? cIniFile := cFilePath
( GetModuleFileName
( GetInstance
() ) ) +
"tabledb.ini" USE CUSTOMER
NEW ALIAS CUST
INDEX ON FIRST TAG FIRST
TO TMFIRST MEMORY
INDEX ON LAST TAG LAST
TO TMPLAST MEMORY
INDEX ON CITY TAG CITY
TO TMPCITY MEMORY
INDEX ON STATE TAG STATE
TO TMPSTATE MEMORY
GO TOP
// { field, header, picture, size, justify, sortorder } aBrowse :=
{ { "CUST->FIRST",
"First",,
120,
}, ;
{ "CUST->LAST",
"Last", ,
120,
}, ;
{ "CUST->STREET",
"Street", ,
180,
}, ;
{ "CUST->CITY",
"City", ,
150,
}, ;
{ "CUST->STATE",
"State", ,
50,
} } bedit :=
{ ||
MsgInfo( "modify" ) } TableDb
( aBrowse, cDbf,
"Customers table",
"Cust", bedit
)RETURN NILFUNCTION TableDb
( aBrowse, cDbf, cTitle, cPrefix, bedit
) LOCAL oTabella, oBar, oCol, I, oImg, oTitle
LOCAL oBrw, oSay1, oSay2
LOCAL oFont, oFontSmall, oBold
LOCAL oCursorBtn := TCursor
():
New( ,
'HAND' ) LOCAL nBottom :=
28 LOCAL nRight :=
99.9 LOCAL nWidth :=
Max( nRight * DLG_CHARPIX_W,
180 ) LOCAL nHeight := nBottom * DLG_CHARPIX_H
LOCAL aBtnBrow := array
( 4 ) LOCAL aBtnNav := array
( 4 ) LOCAL cSearch := SPACE
( 20 ) LOCAL aGet := ARRAY
( 5 ) LOCAL cField :=
"" LOCAL aHdrs :=
{} //Headers LOCAL aColumns :=
{} LOCAL n
// da personalizzare // LOCAL cImage := "C:\Work\fwh\bitmaps\contact.bmp" LOCAL cImage :=
"C:\FWH1701\bitmaps\browse.bmp" LOCAL cTitle1 :=
"Customers" // LOCAL cTitle2 := "Insert the customer to search" LOCAL cTitle2 :=
"Busqueda Incremental:" LOCAL cSelected :=
";" IF File
( "CUSTSEL.TXT" ) cSelected := MEMOREAD
( "CUSTSEL.TXT" ) ENDIF IF Empty
( cSelected
) cSelected :=
";" ENDIF nField :=
1 //header FOR n =
1 TO Len
( aBrowse
) AAdd
( aHdrs, aBrowse
[n
][2] ) AAdd
( aColumns, aBrowse
[n
][1] ) NEXT SetGetColorFocus
( CLR_LGREEN
) SetBalloon
( .T.
) // Balloon shape required for tooltips SkinButtons
() // Botoes Coloridos nas novas versoes DEFINE FONT oFont
NAME 'Tahoma' SIZE 0,
-16 DEFINE FONT oFontSmall
NAME 'Tahoma' SIZE 0,
-14 DEFINE FONT oBold
NAME 'Tahoma' SIZE 0,
-14 BOLD
DEFINE DIALOG oTabella
TITLE cTitle
SIZE nWidth, nHeight
FONT oFont ;
PIXEL TRUEPIXEL RESIZABLE
COLOR CLR_BLACK, nRgb
( 245,
244,
234 ) @
0,
0 TITLE oTitle
SIZE oTabella:
nwidth,
60 OF oTabella SHADOW NOSHADOW ;
GRADIENT
{ { 0.5, RGB
(0xfa,0xfc,0xfd
), RGB
(0xe6,0xf0,0xfa
) }, ;
{ 0.5, RGB
(0xdc,0xe6,0xf4
), RGB
(0xdd,0xe9,0xf7
) } } @
10,
12 TITLETEXT
OF oTitle
TEXT cTitle1
FONT oBold
COLOR CLR_GRAY
@
28,
12 TITLETEXT
OF oTitle
TEXT cTitle2
FONT oFont
COLOR CLR_HGRAY
@
10,
12 TITLEIMG oImg
OF oTitle BITMAP cImage
SIZE 50,
50 TRANSPARENT
@
66,
3 SAY oSay1
PROMPT "Busqueda:" FONT oBold
SIZE 120,
20 PIXEL ;
OF oTabella TRANSPARENT COLORS CLR_CYAN, CLR_WHITE
UPDATE // IN @
42,
180 SAY oSay2
PROMPT "Por:" FONT oBold
SIZE 55,
20 PIXEL OF oTabella ;
TRANSPARENT COLORS CLR_CYAN, CLR_WHITE
UPDATE DEFINE BUTTONBAR oBar
OF oTabella
SIZE 70,
70 BOTTOM NOBORDER
2007 //2010 oBar:
bClrGrad :=
{ | lPressed |
If( ! lPressed, ;
{ { 1, nRgb
( 233,
229,
206 ),nRgb
( 233,
229,
206 ) } }, ;
{ { 1, nRgb
( 245,
244,
234 ), nRgb
( 245,
244,
234 ) } } ) } DEFINE BUTTON OF oBar
PROMPT "New" ;
ACTION If( oBrw:
bEdit ==
nil, oBrw:
Edit( .T.
), oBrw:
EditSource( .T.
) ) DEFINE BUTTON OF oBar
PROMPT "Modify" GROUP ;
ACTION If( oBrw:
bEdit ==
nil, oBrw:
Edit(), oBrw:
EditSource() ) DEFINE BUTTON OF oBar
PROMPT "Delete" ;
ACTION ( If( MsgNoYes
( "Delete Record?" ), oBrw:
Delete(),
nil ), oBrw:
SetFocus() ) DEFINE BUTTON OF oBar
PROMPT "Print" ;
ACTION If( Empty
( oBrw:
bPrint ), oBrw:
Report(), oBrw:
Print() ) DEFINE BUTTON OF oBar
PROMPT "Exit" GROUP
ACTION( oTabella:
End() ) @
100,
5 XBROWSE oBrw ;
SIZE 385,
130 PIXEL;
OF oTabella ;
ALIAS cDbf COLUMNS aBrowse NOBORDER FOOTERS
FOR i :=
1 TO LEN
( oBrw:
aCols ) oCol := oBrw:
aCols[ i
] oCol:
bClrSelFocus :=
{ ||
{ CLR_BLACK, nRGB
( 202,
224,
252 ) } } NEXT WITH OBJECT oBrw
WITH OBJECT oBrw:
InsCol( 1 ) :
nwidth :=
30 :
bEditValue :=
{ || AScan
( oBrw:
aSelected, oBrw:
BookMark ) >
0 } :
SetCheck( nil, .T.
) :
nHeadBmpNo :=
{ ||
If( Len
( oBrw:
aSelected ) == oBrw:
nLen,
1,
2 ) } :
bFooter :=
{ || ltrim
( Str
( Len
(oBrw:
aSelected ) ) ) } :
bLClickHeader :=
{ || oBrw:
SelectRow( If( Len
( oBrw:
aSelected ) == oBrw:
nLen,
0,
4 ) ), oBrw:
Refresh() } End
:
bLClicked :=
{ |r, c, f, oBrw|
If( oBrw:
MouseColPos( c
) ==
1 , ;
If( ( f := AScan
( oBrw:
aSelected, oBrw:
BookMark ) ) ==
0, ;
AAdd
( oBrw:
aSelected, oBrw:
BookMark ), ;
ADel
( oBrw:
aSelected, f, .T.
) ),
Nil ), ;
oBrw:
RefreshCurrent() } WITH OBJECT oBrw:
aCols[ 2 ] :
bFooter :=
{ || Ltrim
( Str
( oBrw:
KeyNo() ) ) +
" / " + LTrim
( Str
( oBrw:
KeyCount() ) ) +
" customers" } END
:
bChange :=
{ |o| o:
RefreshFooters() } :
bKeyChar :=
{ |k|
If( k == VK_SPACE,
( oBrw:
oCol( 1 ):
CheckToggle(), oBrw:
RefreshCurrent(),
0 ),
nil ) } :
bLDblClick :=
{ || oBrw:
oCol( 1 ):
CheckToggle(), oBrw:
RefreshCurrent() } :
bClrStd :=
{ ||
{ CLR_BLACK,
If( oBrw:
oCol( 1 ):
Value, 0x80ffff, CLR_WHITE
) } } :
l2007 := .F.
:
lColDividerComplete := .T.
:
lRecordSelector := .T.
:
lHScroll := .F.
:
nHeaderHeight :=
30 :
nRowHeight :=
30 :
nFooterHeight :=
30 :
nStretchCol := -
1 :
lDrawBorder := .T.
// :lIncrFilter := .t. // :lSeekWild := .f. :
lAllowColHiding := .F.
:
nRecSelColor := nRgb
( 245,
244,
234 ) :
bClrHeader :=
{||
{ ,nRgb
( 233,
229,
206 ) } } :
bClrFooter :=
{||
{ ,nRgb
( 245,
244,
234 ) } } :
nColDividerStyle := LINESTYLE_LIGHTGRAY
:
nRowDividerStyle := LINESTYLE_LIGHTGRAY
END
IF Set
( _SET_INSERT, ! Set
( _SET_INSERT
) ) Set
( _SET_INSERT, ! Set
( _SET_INSERT
) ) ENDIF @
40,
45 GET aGet
[1] VAR cSearch
SIZE 250,
25 PIXEL OF oTabella ;
ON CHANGE ( oBrw:
cSeek := AllTrim
( cSearch
) ) UPDATE // EN:( IN ) @
40,
195 COMBOBOX aGet
[2] VAR nField
ITEMS aHdrs
SIZE 130,
90 PIXEL ;
OF oTabella
STYLE CBS_DROPDOWN HEIGHTGET
20 UPDATE ;
ON CHANGE ( RETORNE_FOCUS
( aGet
) ) // NEW aGet
[1]:
bKeyDown :=
{ | nKey | KeyChar
( oBrw, nKey, nField, cDbf, acolumns
[nField
], aGet
[1] ) } oBrw:
CreateFromCode() @
40, oBrw:
nWidth -
20 BTNBMP aBtnBrow
[1] ;
FLAT
SIZE 30,
30 OF oTabella
PIXEL ;
COLOR nRgb
( 203,
225,
252 ), nRgb
( 238,
236,
219 ) ;
BITMAP
"C:\FWH1701\bitmaps\new3.bmp" NOROUND ;
tooltip
"Clear the search" ;
ACTION ( ( cDbf
)->
( DbClearFilter
() ) , ;
( cDbf
)->
( Dbgotop
() ) , ;
oBrw:
refresh() , ;
cSearch := space
( 60 ) , ;
aGet
[1]:
SetText( cSearch
) , ;
aGet
[1]:
refresh() , ;
cSeek :=
'' , ;
oBrw:
cSeek := AllTrim
( cSearch
) , ;
aGet
[1]:
setfocus() ) @ oBrw:
nBottom +
2, oBrw:
nWidth -
50 BTNBMP aBtnBrow
[2] ;
FLAT
SIZE 30,
30 OF oTabella
PIXEL ;
COLOR nRgb
( 238,
236,
219 ), nRgb
( 238,
236,
219 ) ;
BITMAP
"c:\fwh1701\bitmaps\new3.bmp" NOROUND ;
ACTION oBrw:
KeyDown( VK_UP,
0 ) @ oBrw:
nBottom +
2, oBrw:
nWidth -
35 BTNBMP aBtnBrow
[3] ;
FLAT
SIZE 30,
30 OF oTabella
PIXEL ;
COLOR nRgb
( 238,
236,
219 ), nRgb
( 238,
236,
219 ) ;
BITMAP
"c:\fwh1701\bitmaps\new3.bmp" NOROUND ;
ACTION oBrw:
KeyDown( VK_DOWN,
0 ) @ oBrw:
nBottom +
2, oBrw:
nWidth -
20 BTNBMP aBtnBrow
[4] ;
FLAT
SIZE 30,
30 OF oTabella
PIXEL ;
COLOR nRgb
( 238,
236,
219 ), nRgb
( 238,
236,
219 ) ;
BITMAP
"c:\fwh1701\bitmaps\new3.bmp" NOROUND ;
ACTION ::
ShowPopUp( { |oBtn| MenuContextual
( oBtn,oBrw,cPrefix +
"Aux",cDbf,aGet
) } ) FOR n =
1 TO 4 aBtnBrow
[n
]:
bClrGrad =
{ | lInvert |
If( ! lInvert, ;
{ { 1, RGB
( 225,
225,
225 ), RGB
( 225,
225,
225 ) } }, ;
{ { 1, RGB
( 229,
241,
251 ), RGB
( 229,
241,
251 ) } } ) } aBtnBrow
[n
]:
nClrBorder := nRgb
( 218,
214,
179 ) aBtnBrow
[n
]:
oCursor := oCursorBtn
NEXT // No comprendo esto. Mucho trabajo por nada. oTabella:
bResized := < ||
LOCAL oRect := oTabella:
GetCliRect() oTitle:
nWidth := oRect:
nRight oBrw:
nWidth := oRect:
nRight -
10 oBrw:
nHeight := oRect:
nbottom -
210 oImg:
aImgs[2] := oRect:
nRight -
60 aGet
[1]:
nTop := oTitle:
nBottom +
5 aGet
[1]:
nLeft := oRect:
nLeft +
90 oSay1:
nTop := oTitle:
nBottom +
7 oSay1:
nLeft := oRect:
nLeft +
10 oSay2:
nTop := oTitle:
nBottom +
7 oSay2:
nLeft := oRect:
nLeft +
350 // 360 // EN/IN/POR // Controle del GET aGet
[2]:
nTop := oTitle:
nBottom +
5 aGet
[2]:
nLeft := oRect:
nLeft +
385 // 380 aBtnBrow
[1]:
nTop := oTitle:
nBottom +
5 aBtnBrow
[1]:
nLeft := oRect:
nRight -
37 aBtnBrow
[2]:
nTop := oBrw:
nBottom +
5 aBtnBrow
[2]:
nLeft := oRect:
nRight -
112 aBtnBrow
[3]:
nTop := oBrw:
nBottom +
5 aBtnBrow
[3]:
nLeft := oRect:
nRight -
75 aBtnBrow
[4]:
nTop := oBrw:
nBottom +
5 aBtnBrow
[4]:
nLeft := oRect:
nRight -
37 RETURN nil >
oTabella:
aMinMaxInfo :=
{ nil,
nil,
nil,
nil,
650,
350,
nil,
nil } oBrw:
bSeek :=
nil ACTIVATE DIALOG oTabella
CENTER ;
ON INIT ( otabella:
resize(), EVAL
( oTabella:
bResized ) ) IF Set
( _SET_INSERT, ! Set
( _SET_INSERT
) ) Set
( _SET_INSERT, ! Set
( _SET_INSERT
) ) ENDIF oFont:
End() oFontSmall:
End() oBold:
End()RETURN nilFUNCTION RETORNE_FOCUS
( aGet
) aGet
[1]:
Refresh() XFOCUS
( aGet
[1] )RETURN( .T.
)//-------------------------------------------------------------------------//// As vezes simples SetFocus( oObj ) nao faz um objeto ganhar foco// neste caso pode apelar para estas duas funcoes a seguir// Forcar foco para um objeto especifico - Ednaldo Rolim... yes!//-------------------------------------------------------------------------//FUNCTION xFocus
( oObj
) xSetFocus
( oObj
) xSetFocus
( oObj
)RETURN( .T.
)FUNCTION xSetFocus
( oObj
) LOCAL _oWnd := oObj:
oWnd, _oTempo :=
"" DEFINE TIMER _oTempo
INTERVAL 10 OF _oWnd ;
ACTION ( oObj:
SetFocus(), _oTempo:
End() ) ACTIVATE TIMER _oTempo
RETURN( .T.
)FUNCTION ChangeBrowse
( oBrw, oControl
) LOCAL aItems :=
{} AEval
( oBrw:
aCols,
{ |o|
If( o:
lHide,,AAdd
( aItems, o:
cHeader ) ) } ) oControl
[2]:
setItems( aItems
) oControl
[2]:
refresh()RETURN nilFUNCTION SelectColumns
( oBrowse
) LOCAL oDlg, oBrw, oFont, oBold, oBar
LOCAL aSave := aCopy
( oBrowse:
aCols ) LOCAL cSaveState := oBrowse:
SaveState() DEFINE FONT oFont
NAME 'Tahoma' SIZE 0, -
16 DEFINE FONT oBold
NAME 'Tahoma' SIZE 0, -
14 BOLD
DEFINE DIALOG oDlg
SIZE 400,
400 PIXEL TRUEPIXEL ;
TITLE "Position Columns";
COLOR CLR_BLACK, nRgb
( 245,
244,
234 ) DEFINE BUTTONBAR oBar
OF oDlg
SIZE 64,
70 2010 BOTTOM NOBORDER
DEFINE BUTTON OF oBar
PROMPT "Exit" FILE
"NO_DLG";
ACTION ( oDlg:
end( IDCANCEL
) ) DEFINE BUTTON OF oBar
PROMPT "ok" FILE
"OK_DLG";
ACTION ( oDlg:
end( IDOK
) ) BTNRIGHT
oBar:
bClrGrad :=
{ | lPressed |
If( ! lPressed, ;
{ { 1, nRgb
( 233,
229,
206 ),nRgb
( 233,
229,
206 ) } }, ;
{ { 1, nRgb
( 245,
244,
234 ), nRgb
( 245,
244,
234 ) } } ) } @
10,
20 XBROWSE oBrw
SIZE -
10, -
90 PIXEL OF oDlg ;
DATASOURCE oBrowse:
aCols ;
COLUMNS
"cHeader",
"lHide";
HEADERS
"Columns",
"" ;
COLSIZES
100,
40 ;
NOBORDER
FONT oFont
WITH OBJECT oBrw
:
l2007 := .F.
:
nStretchCol := STRETCHCOL_WIDEST
:
lDrawBorder := .T.
:
bClrHeader :=
{||
{ ,nRgb
( 233,
229,
206 ) } } :
bClrFooter :=
{||
{ ,nRgb
( 245,
244,
234 ) } } :
nColDividerStyle := LINESTYLE_LIGHTGRAY
:
lRecordSelector := .F.
:
lHScroll := .F.
WITH OBJECT :
aCols[ 2 ] :
bEditValue :=
{ |x|
If( x ==
nil, !oBrw:
aRow:
lHide, oBrw:
aRow:
lHide := !x
) } :
SetCheck( nil, .T.
) :
nHeadBmpNo :=
2 END
:
CreateFromCode() END
ACTIVATE DIALOG oDlg
CENTERED ;
ON INIT ( oDlg:
resize() ) RELEASE oFont, oBold
IF oDlg:
nresult == IDOK
oBrowse:
refresh() ENDIFRETURN nil#define EM_GETSEL
176STATIC FUNCTION KeyChar
( oBrw, nKey, n, cdbf, cField, oControl, oSayCounter
) LOCAL nPos, cText
//If nKey == VK_BACK .and. ! Empty( cSeek ) IF nKey == VK_BACK .AND. cSeek !=
nil .AND. Len
( cSeek
) >
0 ( oBrw:
cAlias )->
( IncrFilter
( oBrw,
Left( cSeek, Len
( cSeek
) -
1 ),n,cdbf,cField,oControl
) ) nPos = nLoWord
( oControl:
SendMsg( EM_GETSEL
) ) +
1 IF nPos <
1 RETURN 0 ENDIF cText = oControl:
GetText() cText := HB_UTF8LEFT
( cText, nPos -
2 ) + HB_UTF8SUBSTR
( cText, nPos
) oControl:
SetText( cText
) oControl:
oGet:
buffer = oControl:
GetText() oControl:
oGet:
pos := oControl:
nPos := --nPos
oControl:
SetPos( nPos
) oControl:
setfocus() //get RETURN 0 // elseIf nKey > 31 ELSEIF nKey >
31 .AND. nKey !=
Asc( '*' ) .AND. nKey !=
Asc( '?' ) ( oBrw:
cAlias )->
( IncrFilter
( oBrw, cSeek + Chr
( nKey
),n,cdbf,cField,oControl
) ) oControl:
setfocus() //get RETURN 0 ENDIFRETURN nilSTATIC FUNCTION IncrFilter
( oBrw, cPattern, n, cdbf, cField, oControl, oSayCounter
) LOCAL cFilter :=
"", lFound := .F.
LOCAL nRecNo, cSaveFilt, lStay
LOCAL cField_name := alltrim
( cField
) ( cdbf
)->
( OrdSetFocus
( n
) ) IF ValType
( cPattern
) ==
'C' IF Empty
( cPattern
) cSeek :=
"" // // oSeek:SetText( cSeek ) // oSeek:cText( cSeek ) // oSeek:REFRESH() // SET FILTER
TO .NOT. DELETED
() GO TOP
oBrw:
Refresh() lFound := .T.
ELSE cFilter :=
'WildMatch( "*' + Upper
( cPattern
) +
'*", Upper( ' + cField_name +
')) .AND. .NOT. DELETED()' cSaveFilt := DBFILTER
() nRecNo := RECNO
() lStay := &cFilter
SET FILTER
TO &cFilter
GO TOP
IF OrdKeyCount
() ==
0 SET FILTER
TO &cSaveFilt
GO TOP
DBGOTO
( nRecNo
) ELSE ( cdbf
)->
( OrdSetFocus
( n
) ) cSeek := cPattern
// oSeek:cText( cSeek ) // oSeek:REFRESH() IF lStay
DBGOTO
( nRecNo
) oBrw:
Refresh() ELSE oBrw:
Refresh( .T.
) ENDIF lFound := .T.
ENDIF ENDIF ENDIFRETURN lFound
FUNCTION MenuContextual
( oControl, oBrw, cIniEntry, cDbf, aGet
) LOCAL oMenu
MENU oMenu
POPUP MENUITEM "Seleziona la linea corrente" ;
ACTION NIL MENUITEM "Seleziona tutto" MENUITEM "Esporta" Action NIL MENUITEM "Colonne" ACTION ( SelectColumns
( oBrw
), ;
ChangeBrowse
( oBrw, aGet
) ) ENDMENURETURN oMenu
Regards, saludos.
