Code: Select all | Expand
#include 'fivewin.ch'
#include 'xbrowse.ch'
#include 'constant.ch'
#define DLG_nColorDlg RGB(245,245,235)
#define DLG_nColortitle1 RGB(219,230,244)
#define DLG_nColortitle2 RGB(207,221,239)
#define DLG_nColorBar1 RGB(250,250,245)
#define DLG_nColorBar2 RGB(245,245,235)
#define DLG_nColorBtn1 RGB(245,245,235)
#define DLG_nColorBtn2 RGB(250,250,245)
#define DLG_nColorBtnB RGB(195,195,185)
#define BRW_nColor RGB( 235, 243, 245)
#define CLR_LBLUE RGB( 217, 236, 255 )
#define DBFLOCK_DEFAULT 0
#define DBFLOCK_CLIP 1
#define DBFLOCK_CL53 2
#define DBFLOCK_VFP 3
#define DBFLOCK_CL53EXT 4
#define DBFLOCK_XHB64 5
REQUEST DBFCDX
REQUEST DBFFPT
REQUEST HB_LANG_IT
REQUEST HB_CODEPAGE_ITWIN
*-------------------------------------------------------------------------------------
INIT PROCEDURE Inizio
*-------------------------------------------------------------------------------------
HB_LANGSELECT("IT")
HB_CDPSELECT("ITWIN")
SET AUTOPEN OFF
SET DBFLOCKSCHEME TO DBFLOCK_VFP
SET DATE FORMAT TO "dd/mm/yy"
SET CENTURY ON
SET DELETED ON
SET SOFTSEEK OFF
SET EXCLUSIVE OFF
SET OPTIMIZE ON
SET CONFIRM ON
SET EPOCH TO year(date()) - 50
SET DECIMAL TO 2
SET HARDCOMMIT ON
SET TIME FORMAT TO "hh:mm:ss"
SetGetColorFocus( CLR_LBLUE )
SetBalloon( .T. )
SetDialogEsc( .T. )
TMultiGet():lClrFocus := .T.
TMultiGet():nClrFocus := CLR_LBLUE
RETURN
*------------------------------------------------------------------------------------
Function test()
*------------------------------------------------------------------------------------
LOCAL oDlg AS OBJECT
LOCAL oBrw AS OBJECT
LOCAL oFontNormal AS OBJECT
LOCAL oFontBold AS OBJECT
LOCAL oDbf AS OBJECT
LOCAL oSay AS OBJECT
LOCAL nBottom AS NUMERIC
LOCAL nRight AS NUMERIC
LOCAL nWd AS NUMERIC
LOCAL nHt AS NUMERIC
LOCAL nRow AS NUMERIC
LOCAL nCol AS NUMERIC
LOCAL aCols AS ARRAY
LOCAL aSay AS ARRAY
LOCAL aGet AS ARRAY
LOCAL aDat AS ARRAY
LOCAL aXarray AS ARRAY
LOCAL aCh AS ARRAY
LOCAL aFilter AS ARRAY
*------------------------------------------------------------------------------------
*- Preparazione font
*------------------------------------------------------------------------------------
oFontNormal := TFont():New( "TAHOMA", 0, 14, , )
oFontBold := TFont():New( "TAHOMA", 0, 14, , .T. )
*------------------------------------------------------------------------------------
*- Apertura base dati : Clienti
*------------------------------------------------------------------------------------
oDbf := TCustomer():New()
oDbf:setorder(1)
oDbf:Gotop()
*------------------------------------------------------------------------------------
*- Input
*------------------------------------------------------------------------------------
nBottom := 32.4
nRight := 95
nHt := nBottom * DLG_CHARPIX_H
nWd := Max( nRight * DLG_CHARPIX_W, 180 )
aGet := array(20)
aSay := array(20)
aDat := array(20)
aCh := array(5)
aFilter := array(5)
aXarray := {}
AADD( aXarray, { .F., "City" })
AADD( aXarray, { .F., "State" })
AADD( aXarray, { .F., "Married" })
AADD( aXarray, { .F., "Age" })
AADD( aXarray, { .F., "Salary" })
DEFINE DIALOG oDlg ;
SIZE nWd, nHt ;
PIXEL ;
TRUEPIXEL ;
FONT oFontNormal;
COLOR CLR_BLACK, DLG_nColorDlg ;
STYLE nOR( DS_MODALFRAME,;
WS_POPUP,;
WS_CAPTION,;
WS_SYSMENU,;
WS_MINIMIZEBOX )
*------------------------------------------------------------------------------------
*- Browse
*------------------------------------------------------------------------------------
aCols := {}
AADD(aCols, { "FIRST" , "First" , "" , 80 , })
AADD(aCols, { "LAST" , "Last" , "" , 80 , })
AADD(aCols, { "STREET" , "Address" , "" , 100 , })
AADD(aCols, { "AGE" , "Age" , "" , 50 , AL_CENTER})
AADD(aCols, { "MARRIED", "Married" , "" , 50 , })
AADD(aCols, { "SALARY" , "Salary" , "@E € 999,999,999.99", 90 , })
AADD(aCols, { "STATE" , "State" , "" , 60 , })
AADD(aCols, { "CITY" , "City" , "" , 90 , })
@ 30 , 10 XBROWSE oBrw ;
OF oDlg ;
SIZE -10 , 390 ;
PIXEL ;
DATASOURCE oDbf ;
COLUMNS aCols ;
AUTOSORT ;
FONT oFontNormal ;
NOBORDER ;
CELL ;
LINES ;
UPDATE
WITH OBJECT oBrw
:nRowHeight := 25
:l2007 := .F.
:l2015 := .T.
:lRecordSelector := .F.
:nColDividerStyle := LINESTYLE_LIGHTGRAY
:nRowDividerStyle := LINESTYLE_LIGHTGRAY
:nStretchCol := STRETCHCOL_WIDEST
:nMarqueeStyle := MARQSTYLE_HIGHLROW
:lDrawBorder := .T.
:nClrBorder := DLG_nColorBtnB
:bRecSelHeader := ""
:bClrStd := { || { CLR_BLACK, If( oBrw:KeyNo % 2 == 0, CLR_WHITE, BRW_nColor ) } }
:CreateFromCode()
END
*------------------------------------------------------------------------------------
*- Filter by
*------------------------------------------------------------------------------------
nCol := 10
nRow := oDlg:nBottom - 35
aFilter := {"","","","",""}
@ nRow , nCol SAY oSay ;
VAR "Filter by";
OF oDlg ;
SIZE 80 , 20;
PIXEL ;
COLOR CLR_BLACK, DLG_nColorBar1;
FONT oFontBold;
TRANSPARENT ;
VCENTER
nCol += 100
*------------------------------------------------------------------------------------
*- Attivazione filtro su : City
*------------------------------------------------------------------------------------
aCh[1] := aXarray[ 1 , 1 ]
@ nRow , nCol CHECKBOX aDat[1] ;
VAR aCh[1] ;
Prompt aXarray[ 1 , 2 ] ;
OF oDlg ;
SIZE 90 , 20 ;
PIXEL ;
COLOR CLR_BLACK, DLG_nColorBar1;
FONT oFontBold ;
ON CHANGE ChangeSizeBrw( aCh, oBrw, oDlg, oFontNormal, oFontBold, oDbf, aGet, aSay, aFilter )
aDat[1]:lTransparent := .T.
nCol += 100
*------------------------------------------------------------------------------------
*- Attivazione filtro su : State
*------------------------------------------------------------------------------------
aCh[2] := aXarray[ 2 , 1 ]
@ nRow , nCol CHECKBOX aDat[2] ;
VAR aCh[2] ;
OF oDlg ;
Prompt aXarray[ 2 , 2 ] ;
SIZE 90 , 20 ;
PIXEL ;
COLOR CLR_BLACK, DLG_nColorBar1;
FONT oFontBold ;
ON CHANGE ChangeSizeBrw( aCh, oBrw, oDlg, oFontNormal, oFontBold, oDbf, aGet, aSay, aFilter )
aDat[2]:lTransparent := .T.
nCol += 100
*------------------------------------------------------------------------------------
*- Attivazione filtro su : Married
*------------------------------------------------------------------------------------
aCh[3] := aXarray[ 3 , 1 ]
@ nRow , nCol CHECKBOX aDat[3] ;
VAR aCh[3] ;
OF oDlg ;
Prompt aXarray[ 3 , 2 ];
SIZE 90 , 20 ;
PIXEL ;
COLOR CLR_BLACK, DLG_nColorBar1;
FONT oFontBold ;
ON CHANGE ChangeSizeBrw( aCh, oBrw, oDlg, oFontNormal, oFontBold, oDbf, aGet, aSay, aFilter )
aDat[3]:lTransparent := .T.
nCol += 100
*------------------------------------------------------------------------------------
*- Attivazione filtro su : Age
*------------------------------------------------------------------------------------
aCh[4] := aXarray[ 4 , 1 ]
@ nRow , nCol CHECKBOX aDat[4] ;
VAR aCh[4] ;
OF oDlg ;
Prompt aXarray[ 4 , 2 ] ;
SIZE 90 , 20;
PIXEL ;
COLOR CLR_BLACK, DLG_nColorBar1;
FONT oFontBold ;
ON CHANGE ChangeSizeBrw( aCh, oBrw, oDlg, oFontNormal, oFontBold, oDbf, aGet, aSay, aFilter )
aDat[4]:lTransparent := .T.
nCol += 100
*------------------------------------------------------------------------------------
*- Attivazione filtro su : Salary
*------------------------------------------------------------------------------------
aCh[5] := aXarray[ 5 , 1 ]
@ nRow , nCol CHECKBOX aDat[5];
VAR aCh[5] ;
OF oDlg ;
Prompt aXarray[ 5 , 2 ] ;
SIZE 90 , 20 ;
PIXEL ;
COLOR CLR_BLACK, DLG_nColorBar1;
FONT oFontBold ;
ON CHANGE ChangeSizeBrw( aCh, oBrw, oDlg, oFontNormal, oFontBold, oDbf, aGet, aSay, aFilter )
aDat[5]:lTransparent := .T.
ACTIVATE DIALOG oDlg CENTERED
*------------------------------------------------------------------------------------
*- Rilascio fonts
*------------------------------------------------------------------------------------
RELEASE FONT oFontNormal
RELEASE FONT oFontBold
*------------------------------------------------------------------------------------
*- Chiusura base dati
*------------------------------------------------------------------------------------
oDbf:Close()
return nil
*-------------------------------------------------------------------------------------
EXIT PROCEDURE Fine
*-------------------------------------------------------------------------------------
RETURN
*---------------------------------------------------------------------------------------------------------------
STATIC Function ChangeSizeBrw( aCh, oBrw, oDlg, oFontNormal, oFontBold, oDbf, aGet, aSay, aFilter )
*---------------------------------------------------------------------------------------------------------------
LOCAL nChecked AS NUMERIC
LOCAL nHeight AS NUMERIC
LOCAL n AS NUMERIC
LOCAL nDecrement AS NUMERIC
LOCAL nRowp AS NUMERIC
LOCAL nPosCntr AS NUMERIC
LOCAL aOldVal AS ARRAY
nChecked := 0
nHeight := 420
aOldVal := {space(30), space(30), 1, space(2), 0}
FOR n := 1 TO 5
IF valtype( aGet[n]) = 'O' .and. aCh[n]
IF upper(alltrim(aGet[n]:ClassName())) == "TRADMENU"
aOldVal[n] := aGet[n]:nOption()
ELSE
aOldVal[n] := aGet[n]:VarGet()
ENDIF
ENDIF
IF valtype( aGet[n]) = 'O'
aGet[n]:end()
aGet[n] := NIL
ENDIF
IF valtype( aSay[n]) = 'O'
aSay[n]:end()
aSay[n] := NIL
ENDIF
aFilter[n] := ""
IF aCh[n]
nChecked ++
ENDIF
NEXT
IF valtype( aSay[6] ) = 'O'
aSay[6]:end()
aSay[6] := NIL
ENDIF
nDecrement := nChecked * 40
nHeight := nHeight - nDecrement
nRowp := nHeight + 40
oBrw:nHeight := nHeight
IF aCh[1]
nRowp := GetCity( oDlg, nRowp, oFontNormal, oFontBold, oDbf, oBrw, aGet, aSay, 1, aFilter, aOldVal )
ENDIF
IF aCh[2]
nRowp := GetState( oDlg, nRowp, oFontNormal, oFontBold, oDbf, oBrw, aGet, aSay, 2, aFilter, aOldVal )
ENDIF
IF aCh[3]
nRowp := GetMarried( oDlg, nRowp, oFontNormal, oFontBold, oDbf, oBrw, aGet, aSay, 3, aFilter, aOldVal )
ENDIF
IF aCh[4]
nRowp := GetAge( oDlg, nRowp, oFontNormal, oFontBold, oDbf, oBrw, aGet, aSay, 4, aFilter, aOldVal )
ENDIF
IF aCh[5]
nRowp := GetSalary( oDlg, nRowp, oFontNormal, oFontBold, oDbf, oBrw, aGet, aSay, 5, aFilter, aOldVal )
ENDIF
RefreshFilter(oDbf, oBrw, aFilter, oDlg)
Return NIL
*------------------------------------------------------------------------------------------------------------------
STATIC Function GetCity( oDlg, nRow, oFontNormal, oFontBold, oDbf, oBrw, aGet, aSay, nGet, aFilter, aOldVal)
*------------------------------------------------------------------------------------------------------------------
LOCAL cCity AS CHARACTER
LOCAL nCol AS NUMERIC
cCity := aOldVal[nGet]
IF empty(cCity)
aFilter[nGet] := ""
ELSE
aFilter[nGet] := "'" + upper( alltrim( cCity ) ) + "' $ UPPER(CITY)"
ENDIF
nCol := 10
@ nRow , nCol SAY aSay[nGet] ;
VAR "City :" ;
OF oDlg ;
SIZE 80 , 20 ;
PIXEL ;
FONT oFontBold ;
TRANSPARENT ;
VCENTER
nCol += 100
@ nRow , nCol GET aGet[nGet] ;
VAR cCity ;
OF oDlg ;
SIZE 200 , 20 ;
PIXEL ;
FONT oFontNormal ;
ACTION MsgInfo("Cities List", "Avviso") ;
ON CHANGE ( aFilter[nGet] := IF( empty(cCity) ,;
"" ,;
"'" + upper( alltrim( cCity ) ) + "' $ UPPER(CITY)") ,;
RefreshFilter(oDbf, oBrw, aFilter, oDlg) ) ;
UPDATE
aGet[nGet]:SetFocus()
return nRow + 40
*------------------------------------------------------------------------------------------------------------------
Static Function GetState(oDlg, nRow, oFontNormal, oFontBold, oDbf, oBrw, aGet, aSay, nGet, aFilter, aOldVal)
*------------------------------------------------------------------------------------------------------------------
LOCAL oState AS OBJECT
LOCAL aState AS ARRAY
LOCAL cState AS CHARACTER
LOCAL cDesc AS CHARACTER
LOCAL nCol AS NUMERIC
cDesc := space(25)
cState := aOldVal[nGet]
IF empty(cState)
aFilter[nGet] := ""
ELSE
aFilter[nGet] := "'" + upper( alltrim( cState ) ) + "' $ UPPER(STATE)"
ENDIF
nCol := 10
*--------------------------------------------------------------------------
*- Preprazione array dei codici stato e descrizione
*--------------------------------------------------------------------------
oState := TState():New()
aState := {}
Do while .not. oState:eof()
aadd( aState, {oState:code, oState:name} )
oState:skip()
enddo
oState:close()
@ nRow , nCol SAY aSay[nGet] ;
Prompt "State :" ;
of oDlg ;
SIZE 80 , 20 ;
PIXEL ;
FONT oFontBold ;
UPDATE ;
TRANSPARENT ;
VCENTER
nCol += 100
@ nRow , nCol COMBOBOX aGet[nGet] ;
VAR cState;
of oDlg ;
ITEMS ArrTranspose( aState )[1] ;
SIZE 80 , 90 ;
PIXEL ;
FONT oFontNormal ;
WHEN ( cDesc := IF( empty(cState),;
space(25) ,;
alltrim(aState[aGet[nGet]:nAt][2]) ),;
aSay[6]:Refresh() , .T. ) ;
ON CHANGE ( aFilter[nGet] := IF( empty(cState) ,;
"" ,;
"'" + upper( alltrim( cState ) ) + "' $ UPPER(STATE)") ,;
RefreshFilter(oDbf, oBrw, aFilter, oDlg) ) ;
UPDATE
nCol += 100
@ nRow , nCol SAY aSay[6] ;
Prompt cDesc ;
of oDlg ;
SIZE 200 , 20 ;
PIXEL ;
FONT oFontBold ;
COLOR CLR_BLACK, CLR_WHITE;
UPDATE ;
VCENTER ;
BORDER
aGet[nGet]:SetFocus()
return nRow + 40
*--------------------------------------------------------------------------------------------------------------------
STATIC Function GetMarried(oDlg, nRow, oFontNormal, oFontBold, oDbf, oBrw, aGet, aSay, nGet, aFilter, aOldVal)
*--------------------------------------------------------------------------------------------------------------------
LOCAL nRadio AS NUMERIC
LOCAL nCol AS NUMERIC
nRadio := aOldVal[nGet]
GiveMarried(nRadio, aFilter, nGet)
nCol := 10
@ nRow , nCol SAY aSay[nGet] ;
PROMPT "Married :" ;
of oDlg ;
SIZE 80 , 20 ;
PIXEL ;
FONT oFontBold;
TRANSPARENT ;
VCENTER
nCol += 100
@ nRow , nCol RADIO aGet[nGet] ;
VAR nRadio ;
OF oDlg ;
ON CHANGE ( GiveMarried(nRadio, aFilter, nGet) ,;
RefreshFilter(oDbf, oBrw, aFilter, oDlg) )
@ nRow, 110 RADIOITEM "All" ;
RADIOMENU aGet[nGet];
OF oDlg ;
PIXEL ;
SIZE 85 , 20
@ nRow, 200 RADIOITEM "Married" ;
RADIOMENU aGet[nGet];
OF oDlg ;
PIXEL ;
SIZE 85 , 20
@ nRow, 300 RADIOITEM "Not Married" ;
RADIOMENU aGet[nGet] ;
OF oDlg ;
PIXEL ;
SIZE 80 , 20
aGet[nGet]:aItems[ nRadio ]:SetCheck( .T. )
return nRow + 40
*-------------------------------------------------------------------------------------
STATIC Function GiveMarried(nRadio, aFilter, nGet)
*-------------------------------------------------------------------------------------
DEFAULT nRadio := 1
Do case
Case nRadio = 1
aFilter[nGet] := "( MARRIED = .T. .or. MARRIED = .F. )"
Case nRadio = 2
aFilter[nGet] := "( MARRIED = .T. )"
Case nRadio = 3
aFilter[nGet] := "( MARRIED = .F. )"
Endcase
return NIL
*-----------------------------------------------------------------------------------------------------------------
STATIC Function GetAge (oDlg, nRow, oFontNormal, oFontBold, oDbf, oBrw, aGet, aSay, nGet, aFilter, aOldVal)
*-----------------------------------------------------------------------------------------------------------------
LOCAL aAge AS ARRAY
LOCAL cAge AS NUMERIC
LOCAL n AS NUMERIC
LOCAL nCol AS NUMERIC
cAge := aOldVal[nGet]
IF empty(cAge)
aFilter[nGet] := ""
ELSE
aFilter[nGet] := "AGE <= " + ALLTRIM(STR(VAL(cAge)))
ENDIF
nCol := 10
aAge := {}
For n := 0 TO 120
aadd( aAge , alltrim(str(n)) )
next
@ nRow , nCol SAY aSay[nGet] ;
PROMPT "Age <= :" ;
OF oDlg ;
SIZE 80 , 20 ;
PIXEL ;
FONT oFontBold ;
TRANSPARENT ;
VCENTER
nCol += 100
@ nRow , nCol COMBOBOX aGet[nGet] ;
VAR cAge ;
OF oDlg ;
ITEMS aAge ;
SIZE 60 , 120 ;
PIXEL ;
FONT oFontNormal ;
ON CHANGE ( aFilter[nGet] := IF( empty(cAge),;
"" ,;
"AGE <= " + ALLTRIM(STR(VAL(cAge)))) ,;
RefreshFilter(oDbf, oBrw, aFilter, oDlg) ) ;
UPDATE
aGet[nGet]:SetFocus()
return nRow + 40
*-------------------------------------------------------------------------------------------------------------------
STATIC Function GetSalary(oDlg, nRow, oFontNormal, oFontBold, oDbf, oBrw, aGet, aSay, nGet, aFilter, aOldVal)
*-------------------------------------------------------------------------------------------------------------------
LOCAL nSalary AS NUMERIC
LOCAL nCol AS NUMERIC
nSalary := aOldVal[nGet]
IF empty(nSalary)
aFilter[nGet] := ""
ELSE
aFilter[nGet] := "SALARY <= " + alltrim( str( nSalary ) )
ENDIF
nCol := 10
@ nRow , nCol SAY aSay[nGet] ;
PROMPT "Salary <= :" ;
OF oDlg ;
SIZE 80 , 20 ;
PIXEL ;
FONT oFontBold;
TRANSPARENT ;
VCENTER
nCol += 100
@ nRow , nCol GET aGet[nGet] ;
VAR nSalary ;
OF oDlg ;
SIZE 200 , 20 ;
PIXEL ;
RIGHT ;
PICTURE "@E € 999,999,999.99";
FONT oFontNormal;
ON CHANGE ( aFilter[nGet] := IF( empty(nSalary),;
"" ,;
"SALARY <= " + alltrim(str(nSalary))) ,;
RefreshFilter(oDbf, oBrw, aFilter, oDlg) );
UPDATE
aGet[nGet]:SetFocus()
return nRow + 40
*-------------------------------------------------------------------------------------
STATIC Function RefreshFilter(oDbf, oBrw, aFilter, oDlg)
*-------------------------------------------------------------------------------------
LOCAL cFilter AS CHARACTER
LOCAL nI1 AS NUMERIC
cFilter := ""
FOR nI1 := 1 TO LEN(aFilter)
IF empty(aFilter[nI1])
LOOP
ENDIF
IF EMPTY(cFilter)
cFilter += alltrim(aFilter[nI1])
ELSE
cFilter += " .AND. " + alltrim(aFilter[nI1])
ENDIF
NEXT
IF .not. empty( cFilter )
oDbf:SetFilter( cFilter )
ELSE
oDbf:ClearFilter( )
ENDIF
oDlg:aEvalWhen()
oDbf:GoTop()
oBrw:Refresh()
return .T.
*-------------------------------------------------------------------------------------
CLASS TXData from TDatabase
*-------------------------------------------------------------------------------------
DATA cDbfPath AS CHARACTER init ".\"
ENDCLASS
*-------------------------------------------------------------------------------------
CLASS TCustomer from TXData
*-------------------------------------------------------------------------------------
METHOD New()
ENDCLASS
*-------------------------------------------------------------------------------------
METHOD New( lShared ) CLASS TCustomer
*-------------------------------------------------------------------------------------
Default lShared := .T.
::super:New(NIL, ::cDbfPath + "Customer" ,"DBFCDX", lShared)
if ::use()
::setOrder(1)
::gotop()
endif
RETURN Self
*-------------------------------------------------------------------------------------
CLASS TState from TXData
*-------------------------------------------------------------------------------------
METHOD New()
ENDCLASS
*-------------------------------------------------------------------------------------
METHOD New( lShared ) CLASS TState
*-------------------------------------------------------------------------------------
Default lShared := .T.
::super:New(NIL, ::cDbfPath + "States" ,"DBFCDX", lShared)
if ::use()
::setOrder(1)
::gotop()
endif
RETURN Self
