Focus error on this new project

Re: Focus error on this new project

Postby Marc Venken » Tue Dec 14, 2021 2:46 pm

Hello,

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 :wink:

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

Marc Venken
Using: FWH 23.04 with Harbour
User avatar
Marc Venken
 
Posts: 1434
Joined: Tue Jun 14, 2016 7:51 am
Location: Belgium

Re: Focus error on this new project

Postby Marc Venken » Tue Jan 11, 2022 10:14 pm

João,

You applied these codes in the sample above. Can you please tell me the purpose ?


SkinButtons() // For other looking design, but windows related? I saw a post that this can have a conflict when a Dialog is reused?

FW_SetUnicode( .T. )

WndCenter( oWnd:hWnd )

tGet():lDisColors := .F. // WHEN( .F. ) COR.
tGet():nClrTextDis := CLR_HBLUE
tGet():nClrPaneDis := CLR_SOFTYELLOW


IF Set( _SET_INSERT, ! Set( _SET_INSERT ) )
Set( _SET_INSERT, ! Set( _SET_INSERT ) )
ENDIF

I have this code also in my program, but is it still needed anno 2022 ? I think it was onces needed for XBrowser, but not anymore...

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
Marc Venken
Using: FWH 23.04 with Harbour
User avatar
Marc Venken
 
Posts: 1434
Joined: Tue Jun 14, 2016 7:51 am
Location: Belgium

Previous

Return to FiveWin for Harbour/xHarbour

Who is online

Users browsing this forum: No registered users and 98 guests