I changed arrays to DBFs in TFolderEx.
Tested a normal Folder as well with same result
Only the last defined DBSELECTARE( .. is used.
Both tables using the same area,
Maybe any working sample ?
Using ARRAYS in the early release it was OK.
Page 1 uses the last defined DBSELECTAREA("VKEY") from page 2
I added DBSELECTAREA("ASCKEY") at the end of page 2
After that, page 1 was OK and page 2 wrong.
DBSELECTAREA("ASCKEY")
DBGOTOP()
BROWSE() // shows the real table
// Displays wrong values ( see picture below ) !!!
@ 30, 25 XBROWSE oBrw1 SIZE 232, 178 PIXEL OF oFld:aDialogs[ 1 ]
Each row shows the same values because of a wrong used area.
Only 1 DBF used in page 1. xbrowse and DBF disabled in page 2, page 1 is OK
Download ( complete )
http://www.pflegeplus.com/fw_downloadss/foldex1.zip
The sample-source :
- Code: Select all Expand view
#include "FiveWin.ch"
#include "xBrowse.ch"
STATIC c_path, c_Path1
STATIC cACHAR1, cACHAR2, cACHAR3, cACHAR4, nRPos := 1, nCPos := 1
STATIC nDStyle, nDColorF, nDColorB, nDGradPos, lDDirect, cDBrush, cDImage, nDTColor
STATIC nFStyle, nFColorF, nFColorB, nFGradPos, lFDirect, cFBrush, cFImage, nFTColor
STATIC oBrw1, oBrw2, oFont1, oFont2, oFont3
STATIC nBColor1, nBColor2, nBTColor1, nBTColor2
REQUEST DBFCDX
FUNCTION MAIN()
LOCAL oBtn1, oDlg, oSay1
LOCAL nSWidth := GetSysMetrics(0), nSHeight := GetSysMetrics(1)
LOCAL oFld
LOCAL nSaveFld := 1
LOCAL aBitmaps
SetBalloon( .T. ) // Balloon shape required for tooltips
nDStyle := 2
nDColorF := 16443068
nDColorB := 10899511
nDGradPos := 0.2
lDDirect := .F. // Vertical .F. = Horizontal
cDBrush := "Paper.bmp"
cDImage := "Backgrd.bmp"
nDTColor := 255
nFStyle := 2
nFColorF := 10899511
nFColorB := 16443068
nFGradPos := 0.2
lFDirect := .T. // Vertical
cFBrush := "Paper.bmp"
cFImage := "Backgrd.bmp"
nFTColor := 0
nBColor1 := 16443068
nBColor2 := 12895487
nBTColor1 := 0
nBTColor2 := 0
RddSetDefault("DBFCDX")
c_path := cFilePath(GetModuleFileName( GetInstance() ) )
c_path1 := c_path + "IMAGES\"
NET_USE (c_Path + "ASCKEYS.DBF", "ASCKEY", 3,.T.)
NET_USE (c_Path + "VKEYS.DBF", "VKEY", 3,.T.)
DBSELECTAREA("ASCKEY")
oFont1 := TFont():New("Arial",0,-14,.F.,.T.,0,0,0,.T. )
oFont2 := TFont():New("Arial",0,-16,.F.,.T.,0,0,0,.T. )
oFont3 := TFont():New("Arial",0,-30,.F.,.T.,0,0,0,.F. )
aBitmaps := { c_path1 + "Image.Bmp",;
c_path1 + "Image.bmp" }
DEFINE DIALOG oDlg from 0,0 to 560, 740 pixel TITLE "ASC-Viewr 2.2"
// normal Folder
// -----------------
// @ 5, 18 FOLDER oFld PROMPT "&ASC-Table", "&V_KEY-table", "&Exit" ;
// OF oDlg SIZE 335, 230 PIXEL
// -------- Disable this area, to test NORMAL folder ---------
@ 5, 18 FOLDEREX SIZE 335, 230 oFld PIXEL ADJUST ROUND 5 ;
PROMPT "&ASC-Table", "&V_KEY-table", "&Exit" OF oDlg ;
BITMAPS aBitmaps;
ON CHANGE ( nSaveFld := oFld:nOption, ;
If( nOption == 3, If( MsgYesNo( "Do you want exit??" ), ;
oDlg:End(), ( ::SetOption( nOldOption ), ::Refresh() ) ), ) ) ;
ON PAINT TAB PaintTab( Self, nOption );
ON PAINT TEXT( If( nOption == ::nOption .and. nOption == 2, 8388608, 0 ) );
TOP OPTION 1 ALIGN 0, 0, 0
oFld:lTransparent := .T.
oFld:nFolderHeight := 30
oFld:nSeparator := 10
oFld:bClrText := {| o, n | 128 }
oFld:oFont := oFont2
// ---------------------------------------------
F_BACKGRD( oFld, 2, nFColorF, nFColorB, nFGradPos, lFDirect, cFBrush, cFImage, 670, 460 )
PAGE1(oFld)
PAGE2(oFld)
@ 245, 310 BTNBMP oBtn1 OF oDlg ;
SIZE 45, 25 PIXEL;
NOBORDER ;
PROMPT "E&xit " ;
ACTION oDlg:End() ;
FILENAME c_path1 + "Exit.Bmp" ;
FONT oFont2 2007 ;
LEFT
oBtn1:lTransparent := .t.
oBtn1:cToolTip = { "Exit " + CRLF + "ASC-Viewer","Exit", 1, CLR_BLACK, 14089979 }
oBtn1:SetColor( 0, )
ACTIVATE DIALOG oDlg CENTERED ;
ON INIT WD_BACKGRD( oDlg, nDStyle, nDColorF, nDColorB, nDGradPos, lDDirect, cDBrush, cDImage )
RETURN NIL
// ------------------
FUNCTION PAGE1( oFld )
LOCAL hBrush := CreateSolidBrush( 255 )
DBSELECTAREA("ASCKEY")
DBGOTOP()
@ 30, 25 XBROWSE oBrw1 SIZE 232, 178 PIXEL OF oFld:aDialogs[ 1 ]
WITH OBJECT oBrw1
:nMarqueeStyle := MARQSTYLE_SOLIDCELL
:nColDividerStyle := LINESTYLE_BLACK
:nRowDividerStyle := LINESTYLE_BLACK
:bClrSelFocus = { || { 0, 16512957 } }
:bClrSel = { || { 16777215, 255 } }
:nRecSelColor = 15512898
:lHScroll := .F.
:lVScroll := .T.
:lFooter := .F.
:nRowHeight := 25
:lColChangeNotify := .T.
:lExcelCellWise := .T.
:lColChangeNotify := .t.
:bChange := { || ( nRPos := oBrw1:KeyNo(), ;
nCPos := oBrw1:SelectedCol():nCreationOrder ) }
:CreateFromCode()
END
// 1
oCol := oBrw1:AddCol()
oCol:bStrData := { || (1)->CHAR1 }
oCol:bOnPostEdit = { | oCol, xVal, nKey | IIF ( nKey == VK_RETURN .and. NET_RLOCK( 5, 5 ), ;
( (1)->CHAR1 := xVal, ;
NET_ULOCK(), oBrw1:Refresh() ), NIL) }
// 2
oCol := oBrw1:AddCol()
oCol:bStrData := { || (1)->VALUE1 }
oCol:bOnPostEdit = { | oCol, xVal, nKey | IIF ( nKey == VK_RETURN .and. NET_RLOCK( 5, 5 ), ;
( (1)->VALUE1 := xVal, ;
NET_ULOCK(), oBrw1:Refresh() ), NIL) }
// 3
oCol := oBrw1:AddCol()
oCol:bStrData := { || (1)->CHAR2 }
oCol:bOnPostEdit = { | oCol, xVal, nKey | IIF ( nKey == VK_RETURN .and. NET_RLOCK( 5, 5 ), ;
( (1)->CHAR2 := xVal, ;
NET_ULOCK(), oBrw1:Refresh() ), NIL) }
// 4
oCol := oBrw1:AddCol()
oCol:bStrData := { || (1)->VALUE2 }
oCol:bOnPostEdit = { | oCol, xVal, nKey | IIF ( nKey == VK_RETURN .and. NET_RLOCK( 5, 5 ), ;
( (1)->VALUE2 := xVal, ;
NET_ULOCK(), oBrw1:Refresh() ), NIL) }
// 5
oCol := oBrw1:AddCol()
oCol:bStrData := { || (1)->CHAR3 }
oCol:bOnPostEdit = { | oCol, xVal, nKey | IIF ( nKey == VK_RETURN .and. NET_RLOCK( 5, 5 ), ;
( (1)->CHAR3 := xVal, ;
NET_ULOCK(), oBrw1:Refresh() ), NIL) }
// 6
oCol := oBrw1:AddCol()
oCol:bStrData := { || (1)->VALUE3 }
oCol:bOnPostEdit = { | oCol, xVal, nKey | IIF ( nKey == VK_RETURN .and. NET_RLOCK( 5, 5 ), ;
( (1)->VALUE3 := xVal, ;
NET_ULOCK(), oBrw1:Refresh() ), NIL) }
// 7
oCol := oBrw1:AddCol()
oCol:bStrData := { || (1)->CHAR4 }
oCol:bOnPostEdit = { | oCol, xVal, nKey | IIF ( nKey == VK_RETURN .and. NET_RLOCK( 5, 5 ), ;
( (1)->CHAR4 := xVal, ;
NET_ULOCK(), oBrw1:Refresh() ), NIL) }
// 8
oCol := oBrw1:AddCol()
oCol:bStrData := { || (1)->VALUE4 }
oCol:bOnPostEdit = { | oCol, xVal, nKey | IIF ( nKey == VK_RETURN .and. NET_RLOCK( 5, 5 ), ;
( (1)->VALUE4 := xVal, ;
NET_ULOCK(), oBrw1:Refresh() ), NIL) }
i := 1
FOR i := 1 TO LEN( oBrw1:aCols )
WITH OBJECT oBrw1:aCols[i]
oBrw1:aCols[i]:oHeaderFont := oFont2
oBrw1:aCols[i]:bClrHeader := { || { 128,0 } }
oBrw1:aCols[i]:oDataFont := oFont2
oBrw1:aCols[i]:nWidth := 50
IF I = 1 .or. I = 3 .or. I = 5 .or. I = 7
oBrw1:aCols[i]:nEditType = EDIT_GET
oBrw1:aCols[i]:cEditPicture := 'X'
oBrw1:aCols[i]:cHeader := "KEY"
oBrw1:aCols[i]:bClrstd := {|| { nBTColor1, nBColor1 } }
ELSE
oBrw1:aCols[i]:nEditType = EDIT_GET
oBrw1:aCols[i]:cEditPicture := 'XXX'
oBrw1:aCols[i]:cHeader := "ASC"
oBrw1:aCols[i]:bClrstd := {|| { nBTColor2, nBColor2 } }
ENDIF
oBrw1:aCols[i]:nHeadStrAlign := AL_CENTER
oBrw1:aCols[i]:nDataStrAlign := AL_CENTER
END
NEXT
RETURN NIL
// ------------------
FUNCTION PAGE2( oFld )
DBSELECTAREA("VKEY")
DBGOTOP()
@ 30, 25 XBROWSE oBrw2 SIZE 262, 178 PIXEL OF oFld:aDialogs[ 2 ]
WITH OBJECT oBrw2
:nMarqueeStyle := MARQSTYLE_SOLIDCELL
:nColDividerStyle := LINESTYLE_BLACK
:nRowDividerStyle := LINESTYLE_BLACK
:bClrSelFocus = { || { 0, 16512957 } }
:bClrSel = { || { 16777215, 255 } }
:nRecSelColor = 15512898
:lHScroll := .F.
:lVScroll := .T.
:lFooter := .F.
:nRowHeight := 25
:lColChangeNotify := .T.
:lExcelCellWise := .T.
:lColChangeNotify := .t.
:bChange := { || ( nRPos := oBrw1:KeyNo(), ;
nCPos := oBrw1:SelectedCol():nCreationOrder ) }
:CreateFromCode()
END
// 1
oCol := oBrw2:AddCol()
oCol:bStrData := { || (2)->KEY1 }
oCol:bOnPostEdit = { | oCol, xVal, nKey | IIF ( nKey == VK_RETURN .and. NET_RLOCK( 5, 5 ), ;
( (2)->KEY1 := xVal, ;
NET_ULOCK(), oBrw2:Refresh() ), NIL) }
// 2
oCol := oBrw2:AddCol()
oCol:bStrData := { || (2)->VALUE1 }
oCol:bOnPostEdit = { | oCol, xVal, nKey | IIF ( nKey == VK_RETURN .and. NET_RLOCK( 5, 5 ), ;
( (2)->VALUE1 := xVal, ;
NET_ULOCK(), oBrw2:Refresh() ), NIL) }
// 3
oCol := oBrw2:AddCol()
oCol:bStrData := { || (2)->KEY2 }
oCol:bOnPostEdit = { | oCol, xVal, nKey | IIF ( nKey == VK_RETURN .and. NET_RLOCK( 5, 5 ), ;
( (2)->KEY2 := xVal, ;
NET_ULOCK(), oBrw2:Refresh() ), NIL) }
// 4
oCol := oBrw2:AddCol()
oCol:bStrData := { || (2)->VALUE2 }
oCol:bOnPostEdit = { | oCol, xVal, nKey | IIF ( nKey == VK_RETURN .and. NET_RLOCK( 5, 5 ), ;
( (2)->VALUE2 := xVal, ;
NET_ULOCK(), oBrw2:Refresh() ), NIL) }
// 5
oCol := oBrw2:AddCol()
oCol:bStrData := { || (2)->KEY3 }
oCol:bOnPostEdit = { | oCol, xVal, nKey | IIF ( nKey == VK_RETURN .and. NET_RLOCK( 5, 5 ), ;
( (2)->KEY3 := xVal, ;
NET_ULOCK(), oBrw2:Refresh() ), NIL) }
// 6
oCol := oBrw2:AddCol()
oCol:bStrData := { || (2)->VALUE3 }
oCol:bOnPostEdit = { | oCol, xVal, nKey | IIF ( nKey == VK_RETURN .and. NET_RLOCK( 5, 5 ), ;
( (2)->VALUE3 := xVal, ;
NET_ULOCK(), oBrw2:Refresh() ), NIL) }
i := 1
FOR i := 1 TO LEN( oBrw2:aCols )
WITH OBJECT oBrw2:aCols[i]
oBrw2:aCols[i]:oHeaderFont := oFont2
oBrw2:aCols[i]:bClrHeader := { || { 128,0 } }
oBrw2:aCols[i]:oDataFont := oFont2
oBrw2:aCols[i]:nEditType = EDIT_GET
IF I = 1 .or. I = 3 .or. I = 5
oBrw2:aCols[i]:nWidth := 105
oBrw2:aCols[i]:cEditPicture := '!!!!!!!!!!'
oBrw2:aCols[i]:cHeader := "VK_"
oBrw2:aCols[i]:bClrstd := {|| { nBTColor1, nBColor1 } }
ELSE
oBrw2:aCols[i]:nWidth := 50
oBrw2:aCols[i]:cEditPicture := 'XXX'
oBrw2:aCols[i]:cHeader := "ASC"
oBrw2:aCols[i]:bClrstd := {|| { nBTColor2, nBColor2 } }
oBrw2:aCols[i]:nDataStrAlign := AL_CENTER
ENDIF
oBrw2:aCols[i]:nHeadStrAlign := AL_CENTER
END
NEXT
RETURN NIL
// -------- WINDOW and DIALOG - Background ---------------
FUNCTION WD_BACKGRD( oDlg, nDStyle, nColor1, nColor2, nMove, lDirect, cBrush, cImage )
LOCAL hDC, oBrush, oRect, oTmp, oImage, aGrad := {}, nHeight, nWidth
IF nDStyle = 1 // COLOR
DEFINE BRUSH oBrush COLOR nColor1
ENDIF
IF nDStyle = 2 // GRADIENT Brush
aGrad := { { nMove, nColor1, nColor2 }, { nMove, nColor2, nColor1 } }
hDC = CREATECOMPATIBLEDC( oDlg:GetDC() )
hBmp = CREATECOMPATIBLEBITMAP( oDlg:hDC, oDlg:nWidth, oDlg:nHeight )
hBmpOld = SELECTOBJECT( hDC, hBmp )
GRADIENTFILL( hDC, 0, 0, oDlg:nHeight, oDlg:nWidth, aGrad, lDirect )
oBrush = TBrush():New( ,,,, hBmp )
AEVAL( oDlg:aControls, { | oCtl | If( oCtl:lTransparent, oCtl:SetBrush( oDlg:oBrush ), ) } )
ENDIF
IF nDStyle = 3 // BMP-BRUSH
DEFINE BRUSH oBrush FILE c_path1 + cBrush
ENDIF
IF nDStyle = 4 // Image ADJUSTED
DEFINE IMAGE oImage FILE c_path1 + cImage
oBrush := TBrush():new( ,,,, ResizeBmp( oImage:hBitmap, oDlg:nWidth, oDlg:nHeight, .T. ) )
oImage:End()
ENDIF
oDlg:SetBrush( oBrush )
oBrush:End()
IF nDStyle = 2
SELECTOBJECT( hDC, hBmpOld )
DELETEDC( hDC )
oDlg:ReleaseDC()
ENDIF
RETURN( NIL )
// -------- FOLDER - Backgrounds ---------------
FUNCTION F_BACKGRD( oFld, nStyle, nColor1, nColor2, nMove, lDirect, ;
cBrush, cImage, nWidth, nHeight )
LOCAL n, oDlg, hDC, oBrush, oImage, lFound := .T., aGrad := {}
FOR n := 1 to Len( oFld:aDialogs )
oDlg := oFld:aDialogs[ n ]
hDC = CreateCompatibleDC( oDlg:GetDC() )
IF nFStyle = 1
DEFINE BRUSH oBrush COLOR nColor1
ENDIF
IF nFStyle = 2 // GRADIENT
aGrad := { { nMove, nColor1, nColor2 }, { nMove, nColor2, nColor1 } }
hBmp = CreateCompatibleBitmap( oDlg:hDC, nWidth, nHeight )
hBmpOld = SelectObject( hDC, hBmp )
GradientFill( hDC, 0, 0, nHeight, nWidth, aGrad, lDirect )
oBrush = TBrush():New( ,,,, hBmp )
AEVAL( oDlg:aControls, { | oCtl | If( oCtl:lTransparent, oCtl:SetBrush( oDlg:oBrush ), ) } )
ENDIF
IF nFStyle = 3
IF FILE( c_path1 + cBrush )
DEFINE BRUSH oBrush FILENAME c_path1 + cBrush
ELSE
MsgAlert( "File : " + c_path1 + cBrush + CRLF + ;
"does not exist to create" + CRLF + ;
"Brush-Background !", "ATTENTION" )
lFound := .F.
ENDIF
ENDIF
IF nFStyle = 4 // Image ADJUSTED
IF FILE( c_path1 + cImage )
DEFINE IMAGE oImage FILE c_path1 + cImage
oBrush := TBrush():new( ,,,, ResizeBmp( oImage:hBitmap, nWidth, nHeight , .T. ) )
oImage:End()
ELSE
MsgAlert( "File : " + c_path1 + cImage + CRLF + ;
"does not exist to create" + CRLF + ;
"Image-Background !", "ATTENTION" )
lFound := .F.
ENDIF
ENDIF
IF lFound = .T.
oDlg:SetBrush( oBrush )
RELEASE BRUSH oBrush
DeleteDC( hDC )
ENDIF
NEXT
RETURN( NIL )
// ------------------------
FUNCTION PaintTab( o, nOption )
IF nOption == o:nOver .OR. nOption == o:nOption
o:SetAlphaLevel( nOption, 255 )
ELSE
o:SetAlphaLevel( nOption, 50 )
ENDIF
RETURN o:SetFldColors( o, nOption )
// ---------- NET - FUNCTIONS ----------------------------
FUNCTION NET_USE ( cDBName1, cAlias, nTrials, Net)
LOCAL lReturn := .T.
LOCAL lOpen := .F.
LOCAL Close := 1
nTrcount := nTrials
YesNo := .F.
// SHARED all Users
// EXCLUSIVE 1 User
IF File( cDBName1 )
nTrials := nTrcount
DO WHILE !lOpen
Close := 2
DO WHILE .T.
IF !net
USE &cDBName1 ALIAS &cAlias NEW EXCLUSIVE
ELSE
USE &cDBName1 ALIAS &cAlias NEW SHARED
ENDIF
IF !NetErr()
lReturn := .T.
lOpen := .T.
nTrials := 0
ELSE
IF Net = .T.
Status := "SHARED"
ELSE
Status := "EXCLUSIVE"
ENDIF
IF nTrcount = nTrials
xName := WNetGetUser()
IF MsgYesNo( "Open " + Status + " of " + upper(cDBName1) + " not possible !" + ;
" try again ?", "Network-error -> &xName !" )
nTrials := nTrcount
YesNo := .T.
ELSE
nTrials := 0
YesNo := .F.
ENDIF
ENDIF
IF YesNo = .T.
nTrials --
IF nTrials > 0 .AND. nTime > 0
NET_WAIT ( nTrcount, nTrials, nTime)
ENDIF
IF nTrials = 0
nTrials := nTrcount
ENDIF
ELSE
lReturn := .F.
lOpen := .T.
nTrials := 0
ENDIF
ENDIF
IF nTrials = 0
lOpen := .T.
EXIT
ENDIF
ENDDO
ENDDO
ELSE
nMsgBox ("File -> " + cDBName1 + " is missing !", "Attention !")
SET RESOURCES to
set _3DLOOK OFF
FreeLibrary()
Close database
QUIT
ENDIF
RETURN lReturn
//-------------------------------------------------------
FUNCTION NET_RLOCK( ntrials, ntime )
LOCAL lReturn := .F.
LOCAL ntrcount := 0
LOCAL nZSek := 0
ntrcount := ntrials
DO WHILE !lReturn
DO WHILE ntrials > 0
IF !RLock()
ntrials --
IF ntrials > 0 .AND. ntime > 0
NET_WAIT ( ntrcount, ntrials, ntime )
ENDIF
ELSE
lReturn := .T.
EXIT
ENDIF
ENDDO
IF ntrials = 0
IF MsgYesNo( "Not possible, to lock the record !" + ;
" Try again ?", "Network Error !" )
lOpen :=.T.
ntrials := ntrcount
ELSE
lReturn := .F.
lOpen := .F.
EXIT
ENDIF
ENDIF
ENDDO
IF lReturn = .F.
nMsgBox ("Files are not saved !!!", "Attention !")
ENDIF
RETURN lReturn
//-------------------------------------------------------
FUNCTION NET_ULOCK ()
LOCAL lReturn := .F.
LOCAL ntrcount := 0
LOCAL nZSek := 0
IF len(fieldname(1)) > 0 && DB offen ?
UNLOCK && ja
ENDIF
RETURN lReturn
// ----------------------
FUNCTION NET_CLOSE(ntrials, ntime, net)
LOCAL lReturn := .T.
LOCAL lOpen := .F.
LOCAL close := 1
ntrcount := ntrials
JaNein := .F.
JaNein := .F.
cDBName1 := DBF()
DO WHILE !lOpen
close := 1
DO WHILE ntrials > 0
USE
IF NetErr()
ntrials --
IF MsgYesNo( "Close of file : " + upper(cDBName1) + " not possible !" + ;
" Try again ?", "Network-Error !" )
lOpen :=.T.
ntrials := ntrcount
IF ntrials > 0 .AND. ntime > 0
NET_WAIT ( ntrcount, ntrials, ntime)
ENDIF
ELSE
lReturn := .F.
lOpen := .T.
ntrials := 0
ENDIF
ELSE
geschloss := .T.
lReturn := .T.
lOpen := .T.
ntrials := 0
ENDIF
ENDDO
ENDDO
RETURN lReturn
// --------------------------------------------
FUNCTION NET_WAIT ( ntrcount, ntrials, ntime )
local oMeter, oText1
MsgMeter( { | oMeter, oText1 | ;
SHOW_WAIT(ntrcount, ntrials, ntime, oMeter, oText1) } , ;
"rest trials : " + ltrim(str(ntrials)) + ". trial..." )
RETURN nil
//----------------------------------------------------------------------------//
STATIC FUNCTION SHOW_WAIT(ntrcount, ntrials, ntime, oMeter, oText1)
oMeter:nTotal = ntrcount
nZSek := Seconds()
oText1:SetText( "rest of trials : " + ltrim(str(ntrials)))
oMeter:Set( ntrials )
SysRefresh()
DO WHILE Seconds() < nZSek + ntime
ENDDO
RETURN nil
Best Regards
Uwe
