I have been looking at the samples of Yunus and FDbu en took some code from them in the sample here. This way I have a starting point for the visual layout of the browses and get's/dialogs.
Now I start looking into the code for a good practice of :
Set relations
Ordscopes
Indexing with a nice visual of a wheel that is progressing
Some 'questions' are inside the code, is you have the time to look ))
TDatabase
Do -> while loops also with a nice visual wheel of progress bar.
I start the project with my own dbf's, so maybe a good idea to send a email adres to marc(at)maveco(dot)be so I could send the dbf's ?
For the bmp's insite this sample, I copied the yunus.res file to same exe name (res) that you use for this sample.
All tips, changes, suggestions highly appreciated
- Code: Select all Expand view RUN
// \SAMPLES\MARC2.PRG - 09/12/2021 - Modified by: Joao - Version 1.2
#include "fivewin.ch"
#include "Directry.ch"
#include "inkey.ch"
#include 'ord.ch'
#include "ribbon.ch"
#include 'xbrowse.ch'
#define MY_GREEN nRGB( 145, 214, 124)
#define MY_LIGHTGREEN nRGB( 236, 255, 224)
#define MY_LIGHTYELLOW nRGB( 255, 251, 142)
#define MY_LIGHTBLUE nRGB( 214, 229, 255)
#define MY_PAARS nRGB( 232, 201, 255)
#define MY_YELLOW nRGB( 255, 220, 96)
#Define CLR_BROWSE1 nRGB( 214, 229, 255 )
#Define CLR_BROWSE2 nRGB( 229, 237, 246 )
#Define CLR_BROWSECEL nRGB( 0, 75, 125 )
#Define CLR_BROWSEROW nRGB( 73, 118, 185 )
#Define CLR_BROWSEINDEX nRGB( 156, 156, 156 )
#Define CLR_LGREEN nRGB( 190, 215, 190 )
#Define CLR_SOFTYELLOW nRGB( 255, 251, 225 )
#Define CLR_PINK nRGB( 255, 128, 128 )
#Define CLR_NBLUE nRGB( 128, 128, 192 )
#Define CLR_MSPURPLE nRGB( 0, 120, 215 )
#Define CLR_MSRED nRGB( 232, 17, 35 )
#Define CLR_MSGRAY nRGB( 229, 229, 229 )
#define CLR_LIGHTBLUE nRGB( 214, 229, 255)
ANNOUNCE RDDSYS
REQUEST OrdKeyNo, OrdKeyCount, OrdCreate, OrdKeyGoto
REQUEST DBFCDX, DBFFPT
STATIC oWnd, oDlg, oFont, cClrBack, oBold
STATIC oDlgRB[ 3 ]
STATIC SERVER_PATH, LOCAL_PATH, oFld, CDRIVE, cLocal
STATIC lServer := .F.
// ADDED BY MARC
STATIC oKlant , oRec
static nClrTxtBrw := CLR_BLACK
static nClrBackBrw := CLR_WHITE
static lPijama := .T.
FUNCTION Main()
LOCAL sys_versie := "Dec 2021 - 02/12"
LOCAL cErrorLogFileName := "MyLog.log"
LOCAL oFol, oDlg, oRBar, oMenu, oMenuWnd, oBrush1, oGr, oGr1, oGr2, oGr3, ;
oGr9, oSay1, oBmp, oFont1, oCursor, oBtn2, oBtn3, oBtn4
LOCAL aBitmaps := { "..\bitmaps\alphabmp\facebook.bmp",;
"..\bitmaps\alphabmp\windows.bmp",;
"..\bitmaps\alphabmp\game.bmp",;
"..\bitmaps\alphabmp\viddler.bmp",;
"..\bitmaps\alphabmp\mail.bmp",;
"..\bitmaps\alphabmp\call.bmp",;
"..\bitmaps\alphabmp\settings2.bmp",;
"..\bitmaps\alphabmp\exit.bmp" }
RDDSETDEFAULT("DBFCDX")
SET CENTURY ON
SET DATE BRITISH
SET TIME FORMAT TO "HH:MM:SS"
SET EPOCH TO YEAR( DATE() ) - 30
SET SOFTSEEK OFF
SET WRAP ON
SETCANCEL( .F. )
SET CONFIRM OFF
SET DELETED ON
SET _3DLOOK ON
SET UNIQUE OFF
SET ESCAPE OFF
SET EXACT ON
SET EXCLUSIVE OFF
SET MULTIPLE OFF
SERVER_PATH := "\\CAROLIEN-PC\MARC\"
LOCAL_PATH := CURDRIVE()+":\MARC\"
//LOCAL_PATH := CURDRIVE()+":\fwharb\samples\"
cDrive := "C:\MARC\" // DEZE MOET
cLocal := "C:\MARC\" // DEZE MOET
If .NOT. lIsDir( LOCAL_PATH )
LMkdir( LOCAL_PATH )
Endif
FW_SetUnicode( .T. )
SetBalloon( .T. ) // Balloon shape required for tooltips
SkinButtons()
SetGetColorFocus( MY_LIGHTGREEN )
SETKEY( VK_F12, { | nKey | DBFTONEN() } ) // ?? Quick way of showing me the open dbf's etc.
xbrNumFormat( "E", .T. ) // "E" for European, "A" for American and others // .t. for showing thousand separators
DEFINE FONT oFont1 NAME "Arial" SIZE 0, - 15 // BOLD
DEFINE CURSOR oCursor HAND
DEFINE BRUSH oBrush1 COLOR nRGB( 223, 233, 244 )
DEFINE WINDOW oWnd TITLE "Maveco Bedrijfskleding " + FWVERSION ;
FROM 0, 0 TO 1030, 1920 pixel MDI MENU oMenu BRUSH oBrush1
DEFINE RIBBONBAR oRBar WINDOW oWnd PROMPT "Klanten", "Leveranciers", "Ingeven Documenten";
HEIGHT 130 TOPMARGIN 25
// Databases =============================
ADD GROUP oGr RIBBON oRBar TO OPTION 1 PROMPT "Databases" width 130 ;
BITMAP "bitmaps\fivetech.BMP"
@ 02, 05 ADD BUTTON oBtn2 GROUP oGr BITMAP "bitmaps\cut16.BMP" ;
SIZE 75, 20 PROMPT "Customers" MOSTLEFT round ;
action ( Marc_FolderEx(oWnd) )
@ 24, 05 ADD BUTTON oBtn3 GROUP oGr BITMAP "bitmaps\copy16.BMP" ;
SIZE 75, 20 PROMPT "Leveranciers" MOSTLEFT round;
action ( Marc_FolderEx(oFld) )
@ 46, 05 ADD BUTTON oBtn4 GROUP oGr BITMAP "bitmaps\paste16.BMP" ;
SIZE 75, 20 PROMPT "Artikels" MOSTLEFT round
// Documents =============================
ADD GROUP oGr2 RIBBON oRBar TO OPTION 1 PROMPT "Documents" width 130 ;
BITMAP "bitmaps\fivetech.BMP"
@ 02, 05 ADD BUTTON oBtn2 GROUP oGr2 BITMAP "bitmaps\cut16.BMP" ;
SIZE 75, 20 PROMPT "Invoices" MOSTLEFT round ;
action ( Marc_Folder_Documents(oWnd) )
ADD GROUP oGr9 RIBBON oRBar TO OPTION 1 PROMPT "Exit" width 70 ;
BITMAP "bitmap\fivetech.bmp"
// Exit =============================
@ 15, 20 ADD BUTTON oBtn4 GROUP oGr9 BITMAP "bitmaps\32x32\quit.BMP" ;
SIZE 34, 52 PROMPT "Exit" action( oWnd:End() )
SET MESSAGE OF oWnd TO "Version : " + sys_versie ;
CENTERED CLOCK KEYBOARD 2007
WndCenter( oWnd:hWnd )
ACTIVATE WINDOW oWnd MAXIMIZED
oBrush1:End()
oRBar:End()
RETURN NIL
FUNCTION MyErrorAction( cErrorLogFileName, oError )
LOCAL cErrScreen := ""
MsgInfo( "Er is een fout opgetreden in het programma. Gelieve het programma opnieuw te starten" )
RETURN NIL
FUNCTION lookup_klant( cKlant )
// This will be a lookup function for customersdata
msginfo( cKlant )
RETURN NIL
FUNCTION dbftonen() // ?? This is showing me in debug mode what file are open
LOCAL n, j, nTarget
LOCAL cErrorlog := ""
cErrorLog += CRLF + "DataBases in use" + CRLF + "================" + CRLF
FOR n = 1 TO 255
IF ! Empty( Alias( n ) )
cErrorLog += CRLF + Str( n, 3 ) + ": " + If( Select() == n, "=> ", " " ) + ;
( Alias( n ) )->( dbInfo( DBI_FULLPATH ) ) + Space( 2 ) + "RddName: " + ;
( Alias( n ) )->( rddName() ) + CRLF
cErrorLog += " =======================================================" + CRLF
cErrorLog += " RecNo RecCount BOF EOF" + CRLF
cErrorLog += " " + Transform( ( Alias( n ) )->( RecNo() ), "9999999" ) + ;
" " + Transform( ( Alias( n ) )->( RecCount() ), "9999999" ) + ;
" " + cValToChar( ( Alias( n ) )->( Bof() ) ) + ;
" " + cValToChar( ( Alias( n ) )->( Eof() ) ) + Transform( ( Alias( n ) )->( ordKeyCount() ), "9999999" ) + CRLF + CRLF
IF ( Alias( n ) )->( rddName() ) != "ARRAYRDD"
cErrorLog += " Indexes in use " + Space( 23 ) + "TagName" + CRLF + CRLF
FOR j = 1 TO 25
IF ! Empty( ( Alias( n ) )->( IndexKey( j ) ) )
cErrorLog += Space( 8 ) + ;
If( ( Alias( n ) )->( IndexOrd() ) == j, "=> ", " " ) + ;
PadR( ( Alias( n ) )->( IndexKey( j ) ), 35 ) + ;
( Alias( n ) )->( ordName( j ) ) + ;
CRLF
ENDIF
NEXT
cErrorLog += CRLF + " Alias Name : "+ Alias(n) + CRLF + CRLF
cErrorLog += CRLF + " Relations in use" + CRLF + CRLF
FOR j = 1 TO 8
IF ! Empty( ( nTarget := ( Alias( n ) )->( dbRSelect( j ) ) ) )
cErrorLog += Space( 3 ) + Str( j ) + ": " + ;
"TO " + ( Alias( n ) )->( dbRelation( j ) ) + ;
" INTO " + Alias( nTarget ) + CRLF
// uValue = ( Alias( n ) )->( DbRelation( j ) )
// cErrorLog += cValToChar( ordsetfocus( uValue ) ) + CRLF
ENDIF
NEXT
ENDIF
ENDIF
NEXT
MemoEdit( @cErrorlog, "Geopende Databases", 10, 60, 60, 150 )
RETURN NIL
FUNCTION NETOPEN( cFile, cIndex, lMode, cAlias, nSeconds, lNewArea, cDriver, ;
lReadOnly )
LOCAL nWaitTime, lContinue := .T., lSuccess := .F., TSEL := 0
DEFAULT lMode := .T. // shared mode
DEFAULT cIndex := ""
DEFAULT nSeconds := 3
DEFAULT cAlias := cFile
DEFAULT lNewArea := .T.
DEFAULT cDriver := "DBFCDX"
DEFAULT lReadOnly := .F.
SET DEFAULT TO LOCAL_PATH
nWaitTime := nSeconds
cFile := AllTrim( cFile ) + ".dbf"
IF lServer
cFile := server_path + cFile
IF .NOT. FILE( cFile )
MsgInfo( "Database not created correctly.", "Attention" )
RETURN( .F. )
ENDIF
ELSE
cFile := local_path + cFile
IF .NOT. FILE( cFile )
MsgInfo( "Database not created correctly. "+cFile, "Attention" )
RETURN( .F. )
ENDIF
ENDIF
// File exist ?
IF ! File( cFile )
Exit( "Bestand " + CFILE + ".DBF is afwezig" )
ENDIF
// verify driver is valid
IF AScan( rddList(), cDriver ) == 0
MSGSTOP( "Driver " + Cdriver + " afwezig" )
Exit()
ENDIF
// Indien reeds geopend, alles ok, select waar
IF Select( cAlias ) # 0
MsgInfo( "File : " + cAlias + " is reeds geopend" )
TSEL := Select( cAlias )
Select( TSEL )
lContinue := .T.
lNewArea := .F.
ENDIF
// while continuing to attempt open
WHILE lContinue // while .not. timed-out
SYSREFRESH()
WHILE nSeconds > 0 .AND. lContinue
SYSREFRESH()
// dbUseArea( lNewArea, cDriver, cFile, cAlias, ( .not. lMode ), lReadOnly )
dbUseArea( lNewArea, cDriver, cFile, cAlias, lMode, lReadOnly )
// check for success/failure
IF NetErr()
nSeconds--
lSuccess := .F.
ELSE
// open successful
nSeconds := 0
lSuccess := .T.
lContinue := .F.
ENDIF
ENDDO
IF .NOT. lSuccess
nSeconds := nWaitTime
MSGSTOP( "Bestand " + CFILE + " Alias : " + cAlias + " is geopend door een andere gebruiker" + CRLF + CRLF + "Gelieve even te wachten" )
lSuccess := .F.
lContinue := .T.
lNewArea := .T.
ENDIF
IF !Empty( cIndex )
&cAlias->( dbSetOrder( cIndex ) )
ENDIF
ENDDO
RETURN lSuccess
CLASS TSeek STATIC // From Xbrowse seek function ?
DATA oBrw
METHOD New( oBrw ) CONSTRUCTOR
METHOD SetText( c ) INLINE ::oBrw:RefreshFooters()
ENDCLASS
METHOD New( oBrw ) CLASS TSeek // From Xbrowse seek function ?
::oBrw := oBrw
RETURN Self
FUNCTION del_row( oBrw )
IF MsgYesNo( "Deze regel wissen" )
oBrw:delete()
ENDIF
RETURN NIL
FUNCTION Exit( cErrInfo )
cErrInfo += CRLF + "Gelieve deze fout te melden" + CRLF + CRLF + ;
"Het Programma zal nu eindigen"
CLOSE ALL
MSGSTOP( cErrInfo )
SET RESOURCES TO
ErrorLevel( 1 )
DbCommitAll()
DbUnLockAll()
DbCloseAll()
FreeResources()
Release All
SysRefresh()
HB_GCALL( .T. )
CLEAR MEMORY
PostQuitMessage( 0 )
QUIT
RETURN NIL
FUNCTION Marc_FolderEx( oWnd )
// Locals added by Marc
local oFont1,oBold,oFont,oFont3,oFonts,oFontXS
local cCol, oBrush
LOCAL aVelden := ARRAY(10) // oBrw[10]
LOCAL oBrw := ARRAY(10) // oBrw[10]
LOCAL hBmp := ReadBitmap( 0, "bitmaps\search.bmp" )
//
LOCAL oDlg, oFld, oBarDialog, cTitle, aGrad, oOk, oExit
LOCAL cDenominazione := "I LOVE FIVEWIN THE BEST OF THE WORLD! "
LOCAL cIndirizzo := "AVENUE ATLANTICA, 1200 - LEBLON - RIO DE JANEIRO."
LOCAL oSay := ARRAY(4)
LOCAL aGet := ARRAY(4)
LOCAL cCompl := REPLICATE( ".", 9 )
LOCAL oSilDrawLi
LOCAL SilDrawLi := REPLICATE( "_", 50 )
LOCAL EmailSilv := SPACE(50)
OpenDatabases("KLANTEN")
cTitle := "Marc Informatica Corporation: Systems Folders"
SET _3DLOOK ON
SetGetColorFocus( CLR_LGREEN ) // COR EM TODOS OS GETS DOS DIALOGOS.
tGet():lDisColors := .F. // WHEN( .F. ) COR.
tGet():nClrTextDis := CLR_HBLUE
tGet():nClrPaneDis := CLR_SOFTYELLOW
SetBalloon( .T. ) // Balloon shape required for tooltips
SkinButtons()
aGrad := { { 1, CLR_WHITE, CLR_LIGHTBLUE } }
DEFINE FONT oFont1 NAME "Ms Sans Serif" SIZE 0, - 8 BOLD
DEFINE FONT oBold NAME 'CALIBRI' SIZE 0, - 12 BOLD
DEFINE FONT oFont NAME "CALIBRI" SIZE 0, - 14
DEFINE FONT oFont3 NAME "Segoe UI" SIZE 0, - 12
DEFINE FONT oFontS NAME "Segoe UI" SIZE 0, - 09
DEFINE FONT oFontXS NAME "Segoe UI" SIZE 0, - 08
DEFINE BRUSH oBrush FILE "Bitmaps\BackGrnd\Stone.bmp"
DEFINE DIALOG oDlg FROM 60,0 to 750,1900 PIXEL TRUEPIXEL TITLE cTitle;
GRADIENT aGrad
oDlg:lHelpIcon := .F.
DEFINE BUTTONBAR oBarDialog OF oDlg SIZE 80, 80 2007 BOTTOM NOBORDER
@ 3, 3 FOLDEREX oFld SIZE oDlg:nWidth, oDlg:nHeight - oBarDialog:nheight ;
PROMPT "Basis", "Documenten", "Personen", "Facturen", "Statistics", ;
"Folder 6", "Folder 7", "Folder 8", "Folder 9", "Folder 10" ;
BITMAPS "..\bitmaps\alphabmp\Facebook.bmp", ;
"..\bitmaps\alphabmp\myspace.bmp", ;
"..\bitmaps\alphabmp\Twitter.bmp", ;
"..\bitmaps\alphabmp\mail.bmp", ;
"..\bitmaps\alphabmp\viddler.bmp" ;
FONT oFont PIXEL COLOR CLR_MSGRAY TAB HEIGHT 25 ROUND 5
oFld:aEnable = { .T., .T., .T., .T., .T., .F., .F., .F., .F., .F. }
oFld:SetOption( 1 )
oFld:Show()
// Marc, write the code here on the spot.
// FOLDER 1 -----------------------------------------------------------------------------------------------
aVelden[1] := { ;
{ "ID", "ID", NIL, 90 }, ;
{ "First", "First", NIL, 350 }, ;
{ "Last", "Last", NIL, 300 }, ;
{ "Street", "Street", NIL, 300 }, ;
{ "City", "City", NIL, 200 }, ;
{ "Zip", "Zip", NIL, 150 } }
@ 0, 0 XBROWSE oBrw[ 1 ] size - 05, - 20 PIXEL OF oFld:aDialogs[ 1 ] font oFont ;
DATASOURCE "customer" ;
COLUMNS aVelden[1] ;
AUTOSORT CELL LINES NOBORDER FOOTERS
StyleBrowse( oBrw[1] ) // Styling of Xbrowse (so the styles are the same for these browses
BargetBrowse(oBrw[1],{ "First", "Last", "Street", "City", "Zip" }) // Fields that will be possible to seek from the getbar
EditgetBrowse(oBrw[1],{ "First", "Last", "Street" }) // Fields that will be allowed to be edited (header is colored to show that
WITH OBJECT oBrw[ 1 ]
// Only specials for this specific xbrowse will be here
:bKeyDown := {| k | IF ( K == VK_DELETE, Del_row( oBrw[ 1 ] ), NIL ) }
END
oBrw[ 1 ]:CreateFromCode()
oBrw[ 1 ]:setfocus()
// FOLDER 2 -----------------------------------------------------------------------------------------------
aVelden[2] := { ;
{ "invnum", "Invoice", NIL, 90 }, ;
{ "date", "Date", NIL, 150 }, ;
{ "Code", "Code", NIL, 100 },;
{ "Client", "Name", NIL, 300 },;
{ "Total", "Total", NIL, 150 },;
{ "Paydate", "Paydate", NIL, 150 }}
@ 0, 0 XBROWSE oBrw[ 2 ] size - 05, - 20 PIXEL OF oFld:aDialogs[ 2 ] font oFont ;
DATASOURCE "invoices" ;
COLUMNS aVelden[2] ;
AUTOSORT CELL LINES NOBORDER FOOTERS
StyleBrowse(oBrw[2])
EditgetBrowse(oBrw[2],{ "Paydate" })
BargetBrowse(oBrw[2],{ "Invoice", "Date", "Name", "Total" })
WITH OBJECT oBrw[ 2 ]
:bKeyDown := {| k | IF ( K == VK_DELETE, Del_row( oBrw[ 2 ] ), NIL ) }
END
oBrw[ 2 ]:CreateFromCode()
oBrw[ 2 ]:setfocus()
// FOLDER 3 -----------------------------------------------------------------------------------------------
// FOLDER 4 -----------------------------------------------------------------------------------------------
@ 39.50, 10 SAY oSilDrawLi VAR SilDrawLi SIZE 150, 15 OF oFld:aDialogs[4] ;
UPDATE PIXEL FONT oFont COLORS CLR_MSPURPLE, CLR_WHITE TRANSPARENT
// etc
// END FOLDERS
@ 630, 150 BUTTON oOk PROMPT "Send &Marc" SIZE 120, 30 OF oDlg PIXEL ;
ACTION( oDlg:End() )
@ 630, 300 BUTTON oExit PROMPT "&Exit" SIZE 120, 30 OF oDlg PIXEL ;
ACTION( oDlg:End() ) DEFAULT CANCEL
SET FONT OF oOk TO oFont
SET FONT OF oExit TO oFont
ACTIVATE DIALOG oDlg CENTERED
IF Set( _SET_INSERT, ! Set( _SET_INSERT ) )
Set( _SET_INSERT, ! Set( _SET_INSERT ) )
ENDIF
oFont:End()
close all
RETURN NIL
Static Function StyleBrowse( oBrw )
if lPijama // Make stripes in the browse
oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
{ If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, nClrTxtBrw ),;
CLR_BROWSE1 }, ;
{ If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, nClrTxtBrw ),;
CLR_BROWSE2 } ) }
oBrw:bClrSel = { || { If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, nClrBackBrw ),;
CLR_BROWSEROW } }
else
oBrw:bClrStd := { || { If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, nClrTxtBrw ),;
nClrBackBrw } }
oBrw:bClrSel := { || { If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, nClrBackBrw ),;
MY_PAARS } }
endif
cClrBack := Eval( oBrw:bClrSelFocus )[ 2 ] // I don't know what this is doing
oBrw:SetChecks()
WITH OBJECT oBrw
:l2007 := .F.
:lFooter := .T.
:bRecSelHeader := {|| "Klant" }
:bRecSelData := {| o | o:KeyNo }
:bRecSelFooter := {| o | o:nLen }
:oRecSelFont := oFont // optional
:nRecSelWidth := "99999" // required size
:lColChangeNotify := .T.
:nMarqueeStyle := MARQSTYLE_HIGHLROW
:lHScroll := .F.
:lFullGrid := .T.
:lMultiSelect := .T.
:lRowDividerComplete := .T.
:lColDividerComplete := .T.
:nColDividerStyle := LINESTYLE_LIGHTGRAY
:nRowDividerStyle := LINESTYLE_LIGHTGRAY
:bClrSelFocus := {|| { CLR_WHITE, CLR_BROWSECEL } } // CUANDO TIENE EL FOCUS
:bClrRowFocus := {|| { CLR_WHITE, CLR_BROWSEROW } }
:nHeaderHeight := 23
:oHeaderFonts := oBold
:nHeadStrAligns := AL_CENTER
//:nFooterHeight := oBrw:nHeaderHeight
:nRowHeight := oBrw:nHeaderHeight
:nStretchCol := STRETCHCOL_WIDEST
:nFreeze := 1
if lPijama
:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) ) // Pink
else
:SetColor( nClrTxtBrw, nClrBackBrw )
endif
END
Return nil
Static Function BargetBrowse( oBrw,aBardata )
local cCol
LOCAL hBmp := ReadBitmap( 0, "bitmaps\search.bmp" )
oBrw:lGetBar := .T.
FOR EACH cCol in aBardata
WITH OBJECT oBrw:oCol( cCol )
:uBarGetVal := uValBlank( :Value )
:cBarGetPic := :cEditPicture
:bClrEdit := {|| { CLR_BLACK, MY_LIGHTYELLOW } }
:lBarGetOnKey := .T. // after having setfocus the oBrowse object, the end user can insert the characters directly into the get
:cBarGetBmp := hBmp // this for show the Bitmap on the get
:bBarGetAction := {|| ( oBrw:cAlias )->( MARC_SETFILTER( oBrw ) ) } // this for show the bitmap on the get and associated a action
// :bBarGetAction := {|| ( oBrw:cAlias )->( SETFILTER( oBrw ) ) } // this for show the bitmap on the get and associated a action
END
NEXT
Return nil
Static Function EditgetBrowse( oBrw,aEditdata )
local cCol
FOR EACH cCol in aEditdata
WITH OBJECT oBrw:oCol( cCol )
:nEditType := EDIT_GET
:bClrHeader := {|| { CLR_WHITE, CLR_BROWSEINDEX } }
END
NEXT
Return nil
function opendatabases(cOptie)
FIELD first
do case
case cOptie = "KLANTEN"
// Index creation will be done only once in real program !
netopen( "customer", "first" )
customer->(FW_CdxCreate())
netopen( "invoices", "code" )
invoices->(FW_CdxCreate())
// Set relation so only invoices from selected will be seen
select customer
set relation to upper(first) into invoices scoped
case cOptie = "INGEVEN"
oKlant:=TDatabase():Open( "customer", "customer", "DBFCDX", .T. )
oKlant:setorder("Last")
oKlant:Gotop()
//netopen( "customer", "first" )
//
oRec:=TDatabase():Open( "Invoices", "invoices", "DBFCDX", .T. )
oRec:setorder("code")
oRec:Gotop()
//netopen( "invoices", "code" )
endcase
// QUESTION : I also use ordscopy al lot in a other application. What is the best to do ?
return NIL
// QUESTION : The Marc_setfilter is working when I put a part of a name in the barget. When I leave it out (standart FW) it is not working
// this function is filtering the values that I put in the barget from xbrowse
FUNCTION MARC_SETFILTER( oBrw ) // SETFILTER()?? INTERN COMMAND.
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 ) + " )"
cFilter += '"' + uVal + '" $ UPPER( ' + oCol:CExpr + " )"
OTHERWISE
// cFilter += FieldName( n ) + " == " + cValToChar( uVal )
cFilter += oCol:cExpr + " == " + cValToChar( uVal )
ENDCASE
ENDIF
NEXT
// ******************************
// /
// msginfo(cFilter)
// msgGet( "title", "message", @cFilter )
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
/*
// Question :
I use this kind of scopes or filter like MARC_SETFILTER( oBrw )
to select information like invoices, (one to many relations)
mostly from Xbrowse
oBrwS:bGotFocus := { || SET_SCOPE_Products(),('nofoto')->(DBGOTOP()),oBrwT:Refresh() }
:bChange := { || SET_SCOPE_Products(),('nofoto')->(DBGOTOP()),oBrwT:Refresh(),oBrwP:Refresh() }
STATIC FUNCTION SET_SCOPE_Products()
LOCAL cNName := fotoinde->code
local cCode:=alltrim(upper(nofoto->id))
DBSELECTAREA( "nofoto" )
("nofoto")->( ORDSCOPE(0, cNName ) )
("nofoto")->(ORDSCOPE(1, cNName ) )
DBSELECTAREA( "att" )
("ATT")->(ORDSCOPE(0, cCode ) )
("ATT")->(ORDSCOPE(1, cCode ) )
ATT->(dbgotop())
RETURN NIL
*/
FUNCTION Marc_Folder_Documents( oWnd )
// Locals added by Marc
local oFont1,oBold,oFont,oFont3,oFonts,oFontXS
local cCol, oBrush, oKlantcode, oAdd, oDoccode, oDocDatum
local cKlantcode := space(10)
local cDoccode := space(10)
local cDocDatum := date()
LOCAL aVelden := ARRAY(10) // oBrw[10]
LOCAL oBrw := ARRAY(10) // oBrw[10]
LOCAL hBmp := ReadBitmap( 0, "bitmaps\search.bmp" )
//
LOCAL oDlg, oFld, oBarDialog, cTitle, aGrad, oOk, oExit
LOCAL cDenominazione := "I LOVE FIVEWIN THE BEST OF THE WORLD! "
LOCAL cIndirizzo := "AVENUE ATLANTICA, 1200 - LEBLON - RIO DE JANEIRO."
LOCAL oSay := ARRAY(4)
LOCAL aGet := ARRAY(4)
LOCAL cCompl := REPLICATE( ".", 9 )
LOCAL SilDrawLi := REPLICATE( "_", 50 )
LOCAL EmailSilv := SPACE(50)
OpenDatabases("INGEVEN")
cTitle := "Ingeven van documenten"
SET _3DLOOK ON
SetGetColorFocus( CLR_LGREEN ) // COR EM TODOS OS GETS DOS DIALOGOS.
tGet():lDisColors := .F. // WHEN( .F. ) COR.
tGet():nClrTextDis := CLR_HBLUE
tGet():nClrPaneDis := CLR_SOFTYELLOW
SetBalloon( .T. ) // Balloon shape required for tooltips
SkinButtons()
aGrad := { { 1, CLR_WHITE, CLR_LIGHTBLUE } }
DEFINE FONT oFont1 NAME "Ms Sans Serif" SIZE 0, - 8 BOLD
DEFINE FONT oBold NAME 'CALIBRI' SIZE 0, - 12 BOLD
DEFINE FONT oBoldLarge NAME 'CALIBRI' SIZE 0, - 20 BOLD
DEFINE FONT oFont NAME "CALIBRI" SIZE 0, - 14
DEFINE FONT oFont3 NAME "Segoe UI" SIZE 0, - 12
DEFINE FONT oFontS NAME "Segoe UI" SIZE 0, - 09
DEFINE FONT oFontXS NAME "Segoe UI" SIZE 0, - 08
DEFINE BRUSH oBrush FILE "Bitmaps\BackGrnd\Stone.bmp"
DEFINE DIALOG oDlg FROM 60,0 to 1000,1900 PIXEL TRUEPIXEL TITLE cTitle;
GRADIENT aGrad
oDlg:lHelpIcon := .F.
//DEFINE BUTTONBAR oBarDialog OF oDlg SIZE 80, 80 2007 BOTTOM NOBORDER
DEFINE BUTTONBAR oBarDialog OF oDlg SIZE 70,60 2007 NOBORDER
DEFINE BUTTON OF oBarDialog PROMPT "New" RESOURCE "add" ;
ACTION msginfo("New")
DEFINE BUTTON OF oBarDialog PROMPT "Edit" RESOURCE "edit" ;
ACTION oBrw[2]:EditSource()
DEFINE BUTTON OF oBarDialog PROMPT "Delete" RESOURCE "del"
DEFINE BUTTON OF oBarDialog PROMPT "Print" RESOURCE "report" ;
ACTION (oFld:SetOption( 4 ),oFld:Show())
// ACTION oBrw[2]:Report( "Clients report",, .F.)
DEFINE BUTTON OF oBarDialog PROMPT "Exit" RESOURCE "exit" ;
ACTION( oDlg:End() ) DEFAULT CANCEL
@ 65, 3 FOLDEREX oFld SIZE oDlg:nWidth, oDlg:nHeight - oBarDialog:nheight ;
PROMPT "Documenten","Historiek","Systeem","Print";
BITMAPS "..\bitmaps\alphabmp\Ubuntu.bmp", ;
"..\bitmaps\alphabmp\files.bmp", ;
"..\bitmaps\alphabmp\settings2.bmp", ;
"..\bitmaps\alphabmp\call.bmp" ;
FONT oFont PIXEL COLOR CLR_MSGRAY TAB HEIGHT 30 ROUND 5
oFld:aEnable = { .T., .T., .T.,.T. }
oFld:SetOption( 1 )
oFld:Show()
// Marc, write the code here on the spot.
// FOLDER 1 -----------------------------------------------------------------------------------------------
@ 05, 10 SAY "Doc" SIZE 20, 15 OF oFld:aDialogs[1] ;
PIXEL FONT oBold COLORS CLR_BLUE, CLR_WHITE TRANSPARENT
@ 03, 35 get oDoccode VAR cDoccode SIZE 50,15 PIXEL OF oFld:aDialogs[1] RIGHT
@ 05, 120 SAY "Klant" SIZE 20, 15 OF oFld:aDialogs[1] ;
PIXEL FONT oBold COLORS CLR_BLUE, CLR_WHITE TRANSPARENT
@ 03, 150 get oKlantcode VAR oKlantcode SIZE 50,15 PIXEL OF oFld:aDialogs[1] RIGHT
@ 05, 240 SAY "Datum" SIZE 20, 15 OF oFld:aDialogs[1] ;
PIXEL FONT oBold COLORS CLR_BLUE, CLR_WHITE TRANSPARENT
@ 03, 270 get oDocDatum SIZE 50,15 PIXEL OF oFld:aDialogs[1] RIGHT;
ACTION oDocDatum := Min( MsgDate( oDocDatum ), Date() )
@ 05, 350 SAY oRec:Client SIZE 40, 15 OF oFld:aDialogs[1] ;
UPDATE PIXEL FONT oBold COLORS CLR_BLUE, CLR_WHITE TRANSPARENT
//@ 03, 100 get oRec:INVNUM PICTURE "@!" SIZE 60,15 PIXEL OF oFld:aDialogs[1] RIGHT
// VALID ! ( Empty( oRec:InvNum ) .or. INVOICES->( Duplicate( oRec:InvNum, "INVNUM", oRec:RecNo ) ) )
/* From YUNUS
@ 020, nWd - 190 GET oRec:InvNum PICTURE "@!" SIZE 150,26 PIXEL OF oDlg ;
VALID ! ( Empty( oRec:InvNum ) .or. INVOICES->( Duplicate( oRec:InvNum, "INVNUM", oRec:RecNo ) ) )
@ 050, nWd - 190 GET oRec:Date SIZE 150,26 PIXEL OF oDlg RIGHT ;
ACTION oRec:Date := Min( MsgDate( oRec:Date ), Date() )
@ 80-60,150 GET oGetClient VAR oRec:Code SIZE 150,26 PIXEL OF oDlg ;
ACTION ( PopupBrowse( "CLIENTS", oGetClient ), ;
ReadClientInfo( oRec, oDlg ) ) ;
VALID ( ReadClientInfo( oRec, oDlg ) )
*/
// @ 05, 10 SAY oKlantcode VAR oKlant:Last SIZE 150, 15 OF oFld:aDialogs[1] ;
// @ 125-60, 60 SAY oRec:Client SIZE 200,24 PIXEL OF oDlg FONT oBold UPDATE
aVelden[1] := { ;
{ "invnum", "Invoice", NIL, 90 }, ;
{ "date", "Date", NIL, 150 }, ;
{ "Code", "Code", NIL, 100 },;
{ "Client", "Name", NIL, 300 },;
{ "Total", "Total", NIL, 150 },;
{ "Paydate", "Paydate", NIL, 150 }}
@ 20, 0 XBROWSE oBrw[ 2 ] size - 05, - 20 PIXEL OF oFld:aDialogs[ 1 ] font oFont ;
DATASOURCE "invoices" ;
COLUMNS aVelden[1] ;
AUTOSORT CELL LINES NOBORDER FOOTERS
StyleBrowse(oBrw[2])
EditgetBrowse(oBrw[2],{ "Paydate" })
BargetBrowse(oBrw[2],{ "Invoice", "Date", "Name", "Total" })
WITH OBJECT oBrw[ 2 ]
:bKeyDown := {| k | IF ( K == VK_DELETE, Del_row( oBrw[ 2 ] ), NIL ) }
END
oBrw[ 2 ]:CreateFromCode()
oBrw[ 2 ]:setfocus()
*/
// FOLDER 3 -----------------------------------------------------------------------------------------------
// FOLDER 4 -----------------------------------------------------------------------------------------------
// PRINT DOCUMNTS
@ 05, 10 SAY "Printing of documents" SIZE 200, 25 OF oFld:aDialogs[4] ;
PIXEL FONT oBoldLarge COLORS CLR_BLUE, CLR_WHITE TRANSPARENT
@ 100, 10 SAY "Magazijnbon" SIZE 50, 15 OF oFld:aDialogs[4] ;
PIXEL FONT oBold COLORS CLR_BLUE, CLR_WHITE TRANSPARENT
@ 130, 10 SAY "Verzendnota" SIZE 50, 15 OF oFld:aDialogs[4] ;
PIXEL FONT oBold COLORS CLR_BLUE, CLR_WHITE TRANSPARENT
// etc
// END FOLDERS
ACTIVATE DIALOG oDlg CENTERED
IF Set( _SET_INSERT, ! Set( _SET_INSERT ) )
Set( _SET_INSERT, ! Set( _SET_INSERT ) )
ENDIF
oFont:End()
close all
RETURN NIL
static function Duplicate( uVal, cOrder, nThisRec )
local nSaveRec := RECNO()
local cSaveOrd := OrdSetFocus()
local lExists := .f.
DEFAULT nThisRec := nSaveRec
OrdSetFocus( cOrder )
lExists := DBSEEK( uVal ) .and. RECNO() != nThisRec
if ! Empty( cSaveOrd )
OrdSetFocus( cSaveOrd )
endif
DBGOTO( nSaveRec )
return lExists
