#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 sys_dbf:={}
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
RDDSETDEFAULT("DBFCDX")
FW_SetUnicode( .T. )
SetBalloon( .T. ) // Balloon shape required for tooltips
SkinButtons()
SetGetColorFocus( MY_LIGHTGREEN )
xbrNumFormat( "E", .T. ) // "E" for European, "A" for American and others // .t. for showing thousand separators
Forumsetup() // Make forumdatabases for testing
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) )
ADD GROUP oGr2 RIBBON oRBar TO OPTION 1 PROMPT "Documents" width 130 ;
BITMAP "bitmaps\fivetech.BMP"
// X-Browsers =============================
ADD GROUP oGr7 RIBBON oRBar TO OPTION 1 PROMPT "XBrowsers" width 130 ;
BITMAP "bitmaps\fivetech.BMP"
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
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 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 := ""
LOCAL cIndirizzo := ""
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 Test : Systems Folders and Xbrowse Builder"
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 "Basic", "Builder" ;
BITMAPS "..\bitmaps\alphabmp\Facebook.bmp", ;
"..\bitmaps\alphabmp\viddler.bmp" ;
FONT oFont PIXEL COLOR CLR_MSGRAY TAB HEIGHT 25 ROUND 5
oFld:aEnable = { .T., .T. }
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
WITH OBJECT oBrw[ 1 ]
:bKeyDown := {| k | IF ( K == VK_DELETE, Del_row( oBrw[ 1 ] ), NIL ) }
// Designing is here
END
oBrw[ 1 ]:CreateFromCode()
oBrw[ 1 ]:setfocus()
// FOLDER 2 -----------------------------------------------------------------------------------------------
oBrw[2] = getXBrowser("CUSTOMERS",oFld:aDialogs[2])
// This way the colors are painted correct
oBrw[2]:First:bClrStd := { || If( oBrw[2]:state:value = "IL",;
{nClrTxtBrw, MY_YELLOW } ,;
{nClrTxtBrw, If( oBrw[2]:KeyNo() % 2 == 0, CLR_BROWSE2, CLR_BROWSE1 )} )}
// FOLDER 3 -----------------------------------------------------------------------------------------------
// FOLDER 4 -----------------------------------------------------------------------------------------------
// END FOLDERS
ACTIVATE DIALOG oDlg CENTERED
oFont:End()
close all
RETURN NIL
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
function getXbrowser(cData,oTarget)
local aBrw:={}, aVeld:={}, aKop:={}, aSizes:={}, aFields:={}, oBrw
local aBrwget:={}, aBrwedit:={}
local aBrwCols:={}
local cDbf, cZoek:="", cIndex
Local nTop:=0, nLeft:=0, nBreed:=0, nHoogte:=0, cRelation:=""
local cVelden:="", cHeaders:="", cSizes:="", cBrwget:="", cBrwedit:=""
local cVeld, cFront, cBack, cExpres, lZoek:=.f.
FIELD brwnaam,klant_nr,document // Xbrowsers
cData = upper(cData)
// Get data from dbf
use brwsetup alias tempXb shared NEW
tempxb->(dbsetorder("code"))
select TempXB
set filter to brwnaam = cData
tempXB->(dbgotop())
cDbf = alltrim(tempXb->database)
cIndex = alltrim(tempXb->index)
cMaster = alltrim(tempXb->master)
nTop = tempXb->top
nLeft = tempXb->left
nBreed = tempXb->Breed
nHoogte = tempXb->hoogte
cRelation = alltrim(tempXb->relation)
close tempXb
// Haal de detaildata
use brwdetail alias tempXb shared NEW
tempxb->(dbsetorder("code"))
select tempXb
set filter to brwnaam = cData
tempXb->(dbgotop())
do while !tempXb->(eof())
if tempXb->sel_bar
aadd(aBrwGet,alltrim(tempXb->brnaam))
endif
if tempXb->sel_edit
aadd(aBrwEdit,alltrim(tempXb->brnaam))
endif
aadd(aVeld,alltrim(tempXb->veld))
aadd(aKop,alltrim(tempXb->brnaam))
aadd(aSizes,tempXb->size)
tempXb->(dbskip())
enddo
close tempXb
use (cdbf)
select (cDbf)
// This data is comming from a dbf in real live )))
//aadd(aBrwCols,{alltrim(tempXB->veld),alltrim(tempXb->colcond),alltrim(tempXb->colfront),alltrim(tempXb->colback)})
aadd(aBrwCols,{"State","if(customer->state = 'IL',.T.,.F.)","0","8634760"})
@ nTop,nLeft XBROWSE oBrw size nBreed,nHoogte PIXEL OF oTarget font oFont ;
DATASOURCE cDbf ;
COLUMNS aVeld ;
HEADERS aKop ;
COLSIZES aSizes ;
AUTOSORT CELL LINES NOBORDER FOOTERS
// Is nog een issue mee
oBrw:CreateFromCode()
StyleBrowse(oBrw, aBrwGet, aBrwEdit ,cData )
/* */
if len(aBrwCols) > 0
for i = 1 to len(aBrwCols)
cVeld = aBrwCols[i][1]
cExpres = aBrwCols[i][2]
cFront = val(aBrwCols[i][3])
cBack = val(aBrwCols[i][4])
cZoek = oBrw:&cVeld:value
lZoek = &cExpres // Execute expression with result .t. of .f.
oBrw:&cVeld:bClrStd := { || if ( lZoek , ;
{nClrTxtBrw, cBack } ,;
{nClrTxtBrw, If( oBrw:KeyNo() % 2 == 0, CLR_BROWSE2, CLR_BROWSE1 )} )}
next
endif
oBrw:refresh()
oBrw:setfocus()
return oBrw
Static Function StyleBrowse( oBrwSel, aBarget, aEditget, cNaam )
LOCAL hBmp := ReadBitmap( 0, "bitmaps\search.bmp" )
local cCol,cTemp
DEFAULT aBarget:={}
DEFAULT aEditget:={}
DEFAULT cNaam:=""
if lPijama // Make stripes in the browse
oBrwSel:bClrStd = { || If( oBrwSel:KeyNo() % 2 == 0, ;
{ If( ( oBrwSel:cAlias )->( Deleted() ), CLR_HRED, nClrTxtBrw ),;
CLR_BROWSE2 }, ;
{ If( ( oBrwSel:cAlias )->( Deleted() ), CLR_HRED, nClrTxtBrw ),;
CLR_BROWSE1 } ) }
oBrwSel:bClrSel = { || { If( ( oBrwSel:cAlias )->( Deleted() ), CLR_HRED, nClrBackBrw ),;
CLR_BROWSEROW } }
else
oBrwSel:bClrStd := { || { If( ( oBrwSel:cAlias )->( Deleted() ), CLR_HRED, nClrTxtBrw ),;
nClrBackBrw } }
oBrwSel:bClrSel := { || { If( ( oBrwSel:cAlias )->( Deleted() ), CLR_HRED, nClrBackBrw ),;
MY_PAARS } }
endif
cClrBack := Eval( oBrwSel:bClrSelFocus )[ 2 ] // I don't know what this is doing
oBrwSel:SetChecks()
//oBrwSel:bRClickHeaders := { || XbrColSelector( oBrwSel, cNaam ) } // Kies welke velden tezien zijn
WITH OBJECT oBrwSel
: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 := oBrwSel:nHeaderHeight
:nRowHeight := oBrwSel:nHeaderHeight
:nStretchCol := NIL // -2 // STRETCHCOL_WIDEST
:nFreeze := 1
if lPijama
:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) ) // Pink
else
:SetColor( nClrTxtBrw, nClrBackBrw )
endif
END
// Toon de Bargetdata (Gets boven Bar)
oBrwSel:lGetBar := .T. // Button to activate
if len(aBarget)>0
FOR EACH cCol in aBarget
WITH OBJECT oBrwSel: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 := {|| ( oBrwSel:cAlias )->( MARC_SETFILTER( oBrwSel ) ) } // this for show the bitmap on the get and associated a action
// // :bBarGetAction := {|| ( oBrwSel:cAlias )->( SETFILTER( oBrwSel ) ) } // this for show the bitmap on the get and associated a action
END
NEXT
endif
*/
if len(aEditget)>0
//xbrowser(aEditget) title oBrwSel:cAlias()
FOR EACH cCol in aEditget
//msginfo(cCol+oBrwSel:cAlias(),"Info")
WITH OBJECT oBrwSel:oCol( cCol )
:nEditType := EDIT_GET
:bClrHeader := {|| { CLR_WHITE, CLR_BROWSEINDEX } }
//msginfo(cCol+oBrwSel:cAlias(),"Info Done")
END
NEXT
endif
*/
Return nil
// I use a database, but this is"
// Just for the forum so there is a sample dbf
function forumsetup()
local aFields:={}, aF2:={}
cFile = "brwsetup.dbf"
IF .NOT. FILE( cFile )
aFields := { { "BRWNAAM", "C", 15, 0 },;
{ "TOP", "N", 4, 0 },;
{ "LEFT", "N", 4, 0 },;
{ "BREED", "N", 4, 0 },;
{ "HOOGTE", "N", 4, 0 },;
{ "DATABASE", "C", 15, 0 },;
{ "RELATION", "C", 200, 0 },;
{ "INDEX", "C", 15, 0 },;
{ "INFO", "C", 250, 0 },;
{ "MASTER", "C", 10, 0 } }
DbCreate( "brwsetup.dbf", aFields, "DBFCDX" )
use brwsetup NEW VIA "DBFCDX"
index on upper(brwnaam) tag code
append blank
brwsetup->brwnaam = "CUSTOMERS"
brwsetup->DATABASE = "CUSTOMER"
close brwsetup
endif
cFile = "brwdetail.dbf"
IF .NOT. FILE( cFile )
aF2 := { { "VELD", "C", 15, 0 },;
{ "BRNAAM", "C", 15, 0 },;
{ "SIZE", "N", 3, 0 },;
{ "SEL_BAR", "L", 1, 0 },;
{ "SEL_EDIT", "L", 1, 0 },;
{ "ORDER", "N", 4, 0 },;
{ "TOP", "N", 4, 0 },;
{ "LEFT", "N", 4, 0 },;
{ "BREED", "N", 4, 0 },;
{ "HOOGTE", "N", 4, 0 },;
{ "BRWNAAM", "C", 20, 0 },;
{ "PIC", "C", 20, 0 },;
{ "ALIGN", "N", 1, 0 },;
{ "DATABASE", "C", 15, 0 } }
DbCreate( "brwdetail.dbf", aF2, "DBFCDX" )
USE brwdetail NEW VIA "DBFCDX"
INDEX ON upper(brwnaam)+str(order) TAG CODE
append blank
brwdetail->veld = "ID"
brwdetail->brnaam = "ID"
brwdetail->size = 100
brwdetail->sel_bar = .T.
brwdetail->sel_edit = .f.
brwdetail->order = 1000
brwdetail->brwnaam = "CUSTOMERS"
append blank
brwdetail->veld = "FIRST"
brwdetail->brnaam = "First"
brwdetail->size = 250
brwdetail->sel_bar = .T.
brwdetail->sel_edit = .T.
brwdetail->order = 1010
brwdetail->brwnaam = "CUSTOMERS"
append blank
brwdetail->veld = "LAST"
brwdetail->brnaam = "Last"
brwdetail->size = 250
brwdetail->sel_bar = .T.
brwdetail->sel_edit = .T.
brwdetail->order = 1020
brwdetail->brwnaam = "CUSTOMERS"
append blank
brwdetail->veld = "STATE"
brwdetail->brnaam = "State"
brwdetail->size = 100
brwdetail->sel_bar = .T.
brwdetail->sel_edit = .T.
brwdetail->order = 1030
brwdetail->brwnaam = "CUSTOMERS"
close brwdetail
endif
return NIL
Posted: Sat Feb 05, 2022 9:17 pm