#include "fivewin.ch"
REQUEST DBFCDX
//----------------------------------------------------------------------------//
function Main()
SET DATE ITALIAN
SET CENTURY ON
SET DELETED ON
RDDSETDEFAULT( "DBFCDX" )
SetGetColorFocus()
Sample1()
return nil
//----------------------------------------------------------------------------//
static function Sample1()
local oDlg, oBrw, oFont, oBold
local n
USE CLIENTS NEW SHARED
DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-12
DEFINE FONT oBold NAME "TAHOMA" SIZE 0,-12 BOLD
DEFINE DIALOG oDlg SIZE 800,500 PIXEL TRUEPIXEL ;
FONT oFont TITLE FWVERSION + " : Bar Get"
@ 110,20 XBROWSE oBrw SIZE -20,-20 PIXEL OF oDlg ;
DATASOURCE "CLIENTS" AUTOCOLS CELL LINES NOBORDER
for n := 1 to Len( oBrw:aCols )
WITH OBJECT oBrw:aCols[ n ]
if FieldType( n ) != 'L'
:uBarGetVal := uValBlank( fieldGet( n ) )
if FieldType( n ) == 'N'
:cBarGetPic := NumPict( FieldLen( n ), FieldDec( n ) )
endif
endif
END
next
oBrw:lGetBar := .t.
WITH OBJECT oBrw
:nHeaderHeight := 40 // optional
:oHeaderFonts := oBold
:bClrEdits := { || { CLR_BLACK, CLR_YELLOW } }
:AutoFit()
:CreateFromCode()
:bLDblClick := {|| See_Clients(@oBrw) }
END
@ 10,20 SAY "Gets under Headers. Entered values can be used" + ;
"for filtering or any othe purpose" + CRLF + ;
"Usage: oCol:uBarGetVal := Space( 10 ); oBrw:lGetBar := .t." ;
SIZE oDlg:nWidth - 40,40 PIXEL OF oDlg CENTER
@ 60, 20 BTNBMP PROMPT { || If( oBrw:lGetBar, "Hide GetBar", "ShowGetBar" ) } ;
SIZE 100,40 PIXEL OF oDlg FLAT ;
ACTION ( oBrw:lGetBar := ! oBrw:lGetBar, oBrw:Refresh() )
@ 60,140 BTNBMP PROMPT "Set Filter" ;
SIZE 100,40 PIXEL OF oDlg FLAT ;
ACTION ( oBrw:cAlias )->( SetFilter( oBrw ) )
@ 60,250 BTNBMP PROMPT "Clear Filter" ;
SIZE 100,40 PIXEL OF oDlg FLAT ;
ACTION ( oBrw:cAlias )->( DBCLEARFILTER(), oBrw:Refresh(), oBrw:SetFocus() )
ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont, oBold
return nil
//----------------------------------------------------------------------------//
static function SetFilter( oBrw )
local cFilter := ""
local n, oCol, uVal, cType
for n := 1 to Len( oBrw:aCols )
oCol := oBrw:aCols[ n ]
if ! Empty( uVal := oCol:uBarGetVal )
if !Empty( cFilter )
cFilter += " .AND. "
endif
cType := ValType( uVal )
do case
case cType == 'C'
uVal := Upper( AllTrim( uVal ) )
cFilter += '"' + uVal + '" $ UPPER( ' + FieldName( n ) + " )"
otherwise
cFilter += FieldName( n ) + " == " + cValToChar( uVal )
endcase
endif
next
if Empty( cFilter )
if ! Empty( DBFILTER() )
DBCLEARFILTER()
oBrw:Refresh()
endif
else
if !( DBFILTER() == cFilter )
SET FILTER TO &cFilter
GO TOP
oBrw:Refresh()
endif
endif
oBrw:SetFocus()
return nil
//----------------------------------------------------------------------------//
//-----------------------------------------------------------------/
// See a client in detail
STATIC PROCEDURE See_Clients(oBrw)
LOCAL numReg:= CLIENTS->(RECNO())
register_Client(2, numReg, @oBrw)
oBrw:REFRESH()
CLIENTS->(DBGOTO(numReg)) //requiered since I change location on register_Clients
// Why is Clients closed????
oBrw:REFRESH()
RETURN
//-----------------------------------------------------------------/
// Register a client
STATIC PROCEDURE Register_Client(nWhich, numReg, oBrw)
LOCAL oDlg, oGet[3], oDbfC, oDbfS
LOCAL cName, cAdd, dDate
DATABASE oDbfC
oDbfC:LOAD()
oDbfC:GOTO(numreg) // test
USE SALES NEW SHARED
DATABASE oDbfS
oDbfS:LOAD()
oDbfS:GOTOP() //just a test, we will not skip this one
dDate:= oDbfS:Date
SELECT Clients
cName:=oDbfC:Name
cAdd:=oDbfC:Adress
DEFINE DIALOG oDlg FROM 6, 7 TO 21, 72 TITLE "Client Management"
@ 1, 2 SAY "Name:" OF oDlg
@ 1, 8 GET oGet[1] VAR cName OF oDlg READONLY
@ 2, 2 SAY "Address:" OF oDlg
@ 2, 8 GET oGet[2] VAR cAdd OF oDlg READONLY
@ 3, 2 SAY "Date:" OF oDlg
@ 3, 8 GET oGet[3] VAR dDate OF oDlg READONLY
@ 4, 3 BUTTON "&Previous" OF oDlg SIZE 50, 12 ;
ACTION ( DbSkip( -1 ), oGet[1]:cText:=clients->Name, oGet[2]:cText:=clients->Adress )
@ 4, 14 BUTTON "&Next" OF oDlg SIZE 50, 12;
ACTION ( DbSkip( 1 ),;
If( EoF(), MsgInfo( "End of file" ),),;
If( EoF(), DbGoBottom(),), oGet[1]:cText:=clients->Name, oGet[2]:cText:=clients->Adress)
@ 4, 26 BUTTON "&End" OF oDlg SIZE 50, 12 ACTION ( Position(Numreg,@oBrw), oDlg:End())
ACTIVATE DIALOG oDlg
RELEASE ALL
UNLOCK ALL
RETURN
//-----------------------------------------------------------------/
// End Client Register
STATIC PROCEDURE Position(Numreg, oBrw)
SALES->(DBCLOSEAREA())
oBrw:REFRESH()
SELECT Clients
CLIENTS->(DBGOTO(NumReg)) //requiered since I change location somewhere here
RETURN
