TestMerg.prg errors with ADO

[Rick Lipkin]

To All

I have created a self contained sample derived from TestMerg.prg. I have tried it with .dbf as well as using MS Access ( ado ) and found the .dbf version had some painting problems but did not error like the ADO version.

Please compile this example and add a new Record by hitting the INS key and plug in the value "3" and hit OK .. this will create the enclosed error .. Using BCC582 and FWH 1203.

Let me know if anyone can confirm the error as well as any workarounds.

Thanks
Rick Lipkin


Ado Version

Code: Select all  Expand view

// TestMerg.prg

#include 'fivewin.ch'
#include 'xbrowse.ch'

//-----------------------------
Func Main()

local oDlg, oBrw, oCol, oFont, oBrush
local cFile,nStart,cDefa,oCn
Local xProvider,xSource,xPassword,xConnect
Local oRsGoals,cSql,oErr

cFILE := GetModuleFileName( GetInstance() )

// where .exe started from is default directory //

nSTART := RAT( "\", cFILE )
cDEFA  := SUBSTR(cFILE,1,nSTART-1)

REQUEST DBFCDX
rddsetdefault ( "DBFCDX" )

Set Deleted ON

SET DEFA to ( cDEFA )


xPROVIDER := "Microsoft.Jet.OLEDB.4.0"
xSOURCE   := cDEFA+"\Rick.mdb"
xPASSWORD := "Aug2012"
xCONNECT  := 'Provider='+xPROVIDER+';Data Source='+xSOURCE+';Jet OLEDB:Database Password='+xPASSWORD

If .not. File( cDefa+"\RICK.MDB" )

   // create the adox object
   Try
      catNewDB := CreateObject("ADOX.Catalog")
   Catch
      MsgInfo( "Could not Create ADOX object")
      Return(.f.)
   End try

   // create the table Rick.mdb
   Try
     catNewDB:Create('Provider='+xProvider+';Data Source='+xSource+';Jet OLEDB:Engine Type=5;Jet OLEDB:Database Password='+xPASSWORD )
   Catch
     MsgInfo( "Could not create the table "+xSource )
     Return(.f.)
   End Try

   Try
     oCn  := CREATEOBJECT( "ADODB.Connection" )
   Catch
     MsgInfo( "Could not create the ADO object for connection")
   End Try

   TRY
     oCn:Open( xCONNECT )
   CATCH oErr
     MsgInfo( "Could not open a Connection to Database "+xSource )
     RETURN(.F.)
   END TRY


   cSQL := "CREATE TABLE GOALS"
   cSQL += "( "
   cSQL += "[GOAL]   char(3) NULL, "
   cSQL += "[CAT]    char(3) NULL, "
   cSQL += "[OBJ1]   char(3) NULL, "
   cSQL += "[DESC]   char(50) NULL "
   cSQL += " )"

   // create the table Goals
   // with primary key

   Try
      oCn:Execute( cSQL )
   Catch
      MsgInfo( "Table GOALS Failed" )
      Return(.f.)
   End try

   oCn:Close()
   oCn := nil

Endif

oRsGoals := TOleAuto():New( "ADODB.Recordset" )
oRsGoals:CursorType     := 1        // opendkeyset
oRsGoals:CursorLocation := 3        // local cache
oRsGoals:LockType       := 3        // lockoportunistic

// check for very first user

cSQL := "SELECT * FROM GOALS order by Goal,Cat,Obj1"
TRY
   oRsGoals:Open( cSQL, xCONNECT )
CATCH oErr
   MsgInfo( "Error in Opening GOALS table" )
   RETURN(.F.)
END TRY

If oRsGoals:eof

   oRsGoals:AddNew()
   oRsGoals:Fields("Goal"):Value       := "1  "
   oRsGoals:Fields("Cat"):Value        := space(3)
   oRsGoals:Fields("Obj1"):Value       := space(3)
   oRsGoals:Fields("Desc"):Value       := "FIRST MAIN GOAL"
   oRsGoals:Update()

   oRsGoals:AddNew()
   oRsGoals:Fields("Goal"):Value       := "1  "
   oRsGoals:Fields("Cat"):Value        := "A  "
   oRsGoals:Fields("Obj1"):Value       := space(3)
   oRsGoals:Fields("Desc"):Value       := "FIRST MAIN CATEGORY"
   oRsGoals:Update()

   oRsGoals:AddNew()
   oRsGoals:Fields("Goal"):Value       := "1  "
   oRsGoals:Fields("Cat"):Value        := "A  "
   oRsGoals:Fields("Obj1"):Value       := "1  "
   oRsGoals:Fields("Desc"):Value       := "FIRST MAIN OBJECTIVE"
   oRsGoals:Update()

   oRsGoals:AddNew()
   oRsGoals:Fields("Goal"):Value       := "1  "
   oRsGoals:Fields("Cat"):Value        := "A  "
   oRsGoals:Fields("Obj1"):Value       := "2  "
   oRsGoals:Fields("Desc"):Value       := "SECOND MAIN OBJECTIVE"
   oRsGoals:Update()

   oRsGoals:AddNew()
   oRsGoals:Fields("Goal"):Value       := "1  "
   oRsGoals:Fields("Cat"):Value        := "A  "
   oRsGoals:Fields("Obj1"):Value       := "3  "
   oRsGoals:Fields("Desc"):Value       := "THIRD MAIN OBJECTIVE"
   oRsGoals:Update()

   oRsGoals:AddNew()
   oRsGoals:Fields("Goal"):Value       := "2  "
   oRsGoals:Fields("Cat"):Value        := "A  "
   oRsGoals:Fields("Obj1"):Value       := "   "
   oRsGoals:Fields("Desc"):Value       := "SECOND MAIN CATEGORY"
   oRsGoals:Update()

   oRsGoals:AddNew()
   oRsGoals:Fields("Goal"):Value       := "2  "
   oRsGoals:Fields("Cat"):Value        := "A  "
   oRsGoals:Fields("Obj1"):Value       := "1  "
   oRsGoals:Fields("Desc"):Value       := "FIRST MAIN OBJECTIVE"
   oRsGoals:Update()

   oRsGoals:AddNew()
   oRsGoals:Fields("Goal"):Value       := "2  "
   oRsGoals:Fields("Cat"):Value        := "A  "
   oRsGoals:Fields("Obj1"):Value       := "2  "
   oRsGoals:Fields("Desc"):Value       := "SECOND MAIN OBJECTIVE"
   oRsGoals:Update()

   oRsGoals:AddNew()
   oRsGoals:Fields("Goal"):Value       := "2  "
   oRsGoals:Fields("Cat"):Value        := "A  "
   oRsGoals:Fields("Obj1"):Value       := "3  "
   oRsGoals:Fields("Desc"):Value       := "THIRD MAIN OBJECTIVE"
   oRsGoals:Update()

Endif

oRsGoals:MoveFirst()

DEFINE BRUSH oBrush COLOR CLR_WHITE

DEFINE FONT oFont NAME 'TAHOMA' SIZE 0,-12
DEFINE DIALOG oDlg SIZE 560,680 PIXEL ;
      TITLE 'TXBrowse - Merged Cells' ;
      FONT oFont

@ 10,10 XBROWSE oBrw ;
      RECORDSET oRsGoals ;
      HEADERS 'Goal', 'Cat', 'Obj1', 'Desc' ;
      SIZE 260,320 PIXEL ;
      COLSIZES 40,40,40,250 ;
      JUSTIFY AL_CENTER ;
      OF oDlg ;
      FOOTERS AUTOCOLS LINES CELL


   // Other data not covered in the above command
 *  oBrw:bClrSelFocus    := { || { CLR_BLUE, nRGB( 230, 255, 230 ) } }
 *  oBrw:bClrStd         := { || If( oBrw:City:Value = 'Total', ;
 *                               { CLR_BLACK, nRGB( 230, 240, 255 ) }, ;
 *                               { CLR_BLACK, CLR_WHITE } ) }

   oBrw:lColDividerComplete := .f.
   oBrw:lKineticBrw         := .f.

   oBrw:oBrush := oBrush

   // Following two lines for vertical cell merging
   oBrw:Goal:lMergeVert   := .t.
   oBrw:Obj1:lMergeVert   := .t.

   oBrw:bKeyDown   := { |nKey| _Manual( nKey,oBrw,oRsGoals ) }

   oBrw:CreateFromCode()

   ACTIVATE DIALOG oDlg CENTERED;
   ON INIT oBrw:SetFocus()

  oRsGoals:Close()

   RELEASE FONT oFont
   RELEASE BRUSH oBrush

return nil

//---------------
Static Func _Manual( nKey,oBrw,oRsGoals )

If nKey = 45 // insert
   If _NewGoal(oRsGoals)
   Else
      Return( nil )
   Endif

   oBrw:ReFresh()
   oBrw:SetFocus()

Endif


Return(nil)

//------------
Static Func _NewGoal(oRsGoals)

Local oDlg1,cGoal,oGoal,oBtn1,lAdd

cGoal := space(3)
lAdd  := .f.

DEFINE DIALOG oDlg1 ;
       From 10,10 to 23,55 ;
       Title "Adding net Goals"

@ 1,1 Get oGoal var cGoal of oDlg1 PICTURE "999" ;
      Valid cGoal <> space(3) UPDATE


@ 3,3 BUTTON oBtn1 PROMPT "Ok"     of oDlg1 SIZE 37,25 ;
      ACTION (lAdd := .t.,oDlg1:End())

@ 3,10 BUTTON oBtn2 PROMPT "Cancel" of oDlg1 SIZE 37,25 ;
      ACTION oDlg1:End()
      oBtn2:lCancel := .t.

ACTIVATE DIALOG oDlg1

If lAdd = .t.

   oRsGoals:AddNew()
   oRsGoals:Fields("Goal"):Value := cGoal
   oRsGoals:Fields("Cat"):Value  := "   "
   oRsGoals:Fields("Obj1"):Value := "   "
   oRsGoals:Fields("Desc"):Value := "ADDED NEW GOAL"
   oRsGoals:Update()

Endif

Return(lAdd)

// end

Ado Error

Code: Select all  Expand view

Application
===========
   Path and name: C:\Fox\Protypes\XbMerge\TestMergAdo.Exe (32 bits)
   Size: 2,200,576 bytes
   Compiler version: xHarbour build 1.2.1 Intl. (SimpLex) (Rev. 9444)
   FiveWin  Version: FWHX 12.03
   Windows version: 5.1, Build 2600 Service Pack 3

   Time from start: 0 hours 0 mins 5 secs
   Error occurred at: 08/08/12, 17:59:39
   Error description: Error BASE/1132  Bound error: array access
   Args:
     [   1] = A   { ... }
     [   2] = N   10

Stack Calls
===========
   Called from: .\source\classes\XBROWSE.PRG => TXBRWCOLUMN:MERGEAREA( 11658 )
   Called from: .\source\classes\XBROWSE.PRG => TXBRWCOLUMN:PAINTCELL( 9929 )
   Called from: .\source\classes\XBROWSE.PRG => TXBRWCOLUMN:PAINTDATA( 9559 )
   Called from: .\source\classes\XBROWSE.PRG => TXBROWSE:PAINT( 1434 )
   Called from: .\source\classes\XBROWSE.PRG => TXBROWSE:DISPLAY( 1253 )
   Called from: .\source\classes\CONTROL.PRG => TCONTROL:HANDLEEVENT( 1666 )
   Called from: .\source\classes\XBROWSE.PRG => TXBROWSE:HANDLEEVENT( 11630 )
   Called from: .\source\classes\WINDOW.PRG => _FWH( 3159 )
   Called from:  => DIALOGBOXINDIRECT( 0 )
   Called from: .\source\classes\DIALOG.PRG => TDIALOG:ACTIVATE( 270 )
   Called from: .\source\function\ERRSYSW.PRG => ERRORDIALOG( 426 )
   Called from: .\source\function\ERRSYSW.PRG => (b)ERRORSYS( 31 )
   Called from: .\source\classes\XBROWSE.PRG => TXBRWCOLUMN:MERGEAREA( 11658 )
   Called from: .\source\classes\XBROWSE.PRG => TXBRWCOLUMN:PAINTCELL( 9929 )
   Called from: .\source\classes\XBROWSE.PRG => TXBRWCOLUMN:PAINTDATA( 9559 )
   Called from: .\source\classes\XBROWSE.PRG => TXBROWSE:PAINT( 1434 )
   Called from: .\source\classes\XBROWSE.PRG => TXBROWSE:DISPLAY( 1253 )
   Called from: .\source\classes\CONTROL.PRG => TCONTROL:HANDLEEVENT( 1666 )
   Called from: .\source\classes\XBROWSE.PRG => TXBROWSE:HANDLEEVENT( 11630 )
   Called from: .\source\classes\WINDOW.PRG => _FWH( 3159 )
   Called from:  => DIALOGBOXINDIRECT( 0 )
   Called from: .\source\classes\DIALOG.PRG => TDIALOG:ACTIVATE( 270 )
   Called from: testmergAdo.prg => MAIN( 210 )
 

.Dbf version that DOES NOT ERROR but has painting problems on Add

Code: Select all  Expand view

// TestMerg.prg

#include 'fivewin.ch'
#include 'xbrowse.ch'

//-----------------------------
Func Main()

local oDlg, oBrw, oCol, oFont, oBrush
local nTotal,dbf_stru,cFile,nStart,cDefa

cFILE := GetModuleFileName( GetInstance() )

// where .exe started from is default directory //

nSTART := RAT( "\", cFILE )
cDEFA  := SUBSTR(cFILE,1,nSTART-1)

REQUEST DBFCDX
rddsetdefault ( "DBFCDX" )

Set Deleted ON

SET DEFA to ( cDEFA )

If .not. File( cDefa+"\Rick.dbf" )

   dbf_Stru := {}
   aadd( dbf_stru,{ "Goal",   "C",  3,  0  } )
   aadd( dbf_stru,{ "Cat",    "C",  3,  0  } )
   aadd( dbf_stru,{ "Obj1",   "C",  3,  0  } )
   aadd( dbf_stru,{ "Desc",   "C",  50, 0 } )

   DBCREATE( cDefa+"\RICK.DBF", DBF_STRU )

   Select 1
   Use Rick via "DBFCDX" EXCL

   Append Blank
   Rick->Goal := "1  "
   Rick->Cat  := "   "
   Rick->Obj1 := "   "
   Rick->Desc := "FIRST MAIN GOAL"

   Append Blank
   Rick->Goal := "1  "
   Rick->Cat  := "A  "
   Rick->Obj1 := "   "
   Rick->Desc := "FIRST MAIN CATEGORY"

   Append Blank
   Rick->Goal := "1  "
   Rick->Cat  := "A  "
   Rick->Obj1 := "1  "
   Rick->Desc := "FIRST MAIN OBJECTIVE"

   Append Blank
   Rick->Goal := "1  "
   Rick->Cat  := "A  "
   Rick->Obj1 := "2  "
   Rick->Desc := "SECOND MAIN OBJECTIVE"

   Append Blank
   Rick->Goal := "1  "
   Rick->Cat  := "A  "
   Rick->Obj1 := "3  "
   Rick->Desc := "THIRD MAIN OBJECTIVE"

   Append Blank
   Rick->Goal := "2  "
   Rick->Cat  := "   "
   Rick->Obj1 := "   "
   Rick->Desc := "SECOND MAIN GOAL"

   Append Blank
   Rick->Goal := "2  "
   Rick->Cat  := "A  "
   Rick->Obj1 := "   "
   Rick->Desc := "SECOND MAIN CATEGORY"

   Append Blank
   Rick->Goal := "2  "
   Rick->Cat  := "A  "
   Rick->Obj1 := "1  "
   Rick->Desc := "SECOND MAIN OBJECTIVE"

   Append Blank
   Rick->Goal := "2  "
   Rick->Cat  := "A  "
   Rick->Obj1 := "2  "
   Rick->Desc := "SECOND MAIN OBJECTIVE"

   Append Blank
   Rick->Goal := "2  "
   Rick->Cat  := "A  "
   Rick->Obj1 := "3  "
   Rick->Desc := "THIRD MAIN OBJECTIVE"

   dBCommit()

   Index on Goal+Cat+Obj1 tag Goal

   Close Databases

Endif

Select 1
Use Rick.dbf via "DBFCDX" Excl
Set order to Tag Goal

Go Top

DEFINE BRUSH oBrush COLOR CLR_WHITE

DEFINE FONT oFont NAME 'TAHOMA' SIZE 0,-12
DEFINE DIALOG oDlg SIZE 560,680 PIXEL ;
      TITLE 'TXBrowse - Merged Cells' ;
      FONT oFont

@ 10,10 XBROWSE oBrw ;
      HEADERS 'Goal', 'Cat', 'Obj1', 'Desc' ;
      SIZE 260,320 PIXEL ;
      COLSIZES 40,40,40,250 ;
      JUSTIFY AL_CENTER ;
      OF oDlg ;
      ALIAS "RICK" ;
      FOOTERS AUTOCOLS LINES CELL


   // Other data not covered in the above command
 *  oBrw:bClrSelFocus    := { || { CLR_BLUE, nRGB( 230, 255, 230 ) } }
 *  oBrw:bClrStd         := { || If( oBrw:City:Value = 'Total', ;
 *                               { CLR_BLACK, nRGB( 230, 240, 255 ) }, ;
 *                               { CLR_BLACK, CLR_WHITE } ) }

   oBrw:lColDividerComplete := .f.
   oBrw:lKineticBrw         := .f.

   oBrw:oBrush := oBrush

   // Following two lines for vertical cell merging
   oBrw:Goal:lMergeVert   := .t.
   oBrw:Obj1:lMergeVert   := .t.

   oBrw:bKeyDown   := { |nKey| _Manual( nKey,oBrw,oDlg ) }

   oBrw:CreateFromCode()

   ACTIVATE DIALOG oDlg CENTERED;
   ON INIT oBrw:SetFocus()

   Close Databases

   RELEASE FONT oFont
   RELEASE BRUSH oBrush

return nil

//---------------
Static Func _Manual( nKey,oBrw,oDlg )

If nKey = 45 // insert
   If _NewGoal()
   Else
      Return( nil )
   Endif

   Select Rick
   Go Top

   oBrw:ReFresh()
   oBrw:SetFocus()

Endif


Return(nil)

//------------
Static Func _NewGoal()

Local oDlg1,cGoal,oGoal,oBtn1,lAdd

cGoal := space(3)
lAdd  := .f.

DEFINE DIALOG oDlg1 ;
       From 10,10 to 23,55 ;
       Title "Adding net Goals"

@ 1,1 Get oGoal var cGoal of oDlg1 PICTURE "999" ;
      Valid cGoal <> space(3) UPDATE


@ 3,3 BUTTON oBtn1 PROMPT "Ok"     of oDlg1 SIZE 37,25 ;
      ACTION (lAdd := .t.,oDlg1:End())

@ 3,10 BUTTON oBtn2 PROMPT "Cancel" of oDlg1 SIZE 37,25 ;
      ACTION oDlg1:End()
      oBtn2:lCancel := .t.

ACTIVATE DIALOG oDlg1

If lAdd = .t.
   Select Rick
   Rick->Goal := cGoal
   Rick->Cat  := "   "
   Rick->Obj1 := "   "
   Rick->Desc := "ADDED NEW GOAL"
   dBCommit()
Endif

Return(lAdd)

// end

[nageswaragunupudi]

In the function _Manual, before oBrw:Refresh(), please insert the following code:

Code: Select all  Expand view

oBrw:Goal:WorkMergeData()
oBrw:Obj1:WorkMergeData()

[Rick Lipkin]

Rao

Thank you .. that solved the error .. but when the new record is added .. the row does not seem to be painted properly even though I refreshed the browse.. see pic below.

The same problem happens with the .dbf version when a record is added.

Thanks
Rick Lipkin

[nageswaragunupudi]

if the field value of Goal of the new record is 2, then you will see it grouped under 2

[Rick Lipkin]

Rao

The number was 3 .. it created a new group. .. If I click on the line, it repaints otherwise it does not refresh

Rick