Strange Problem with ActiveX (Harbour Exception)

Ollie · Post by **Ollie** » Mon Oct 15, 2007 7:51 am

I have modified some code from Jairo to use List & Label in my program.

When I compile and run it on its own - it works perfectly.

When I link the PRG into my main program and call TESTLL() , it gives the following error:

Window title: Harbour Exception
Called from ACTXINVOKE(0)
Called from TACTIVEX:DO(415)
Called from DEFINEDATA(304)
Called from LLPRINTER(156)
Called from EVAL(48)
Called from TMENU:COMMAND(0)
etc.
with only an OK button.
When you click OK, it says My.EXE has encounted a problem and needs to close. We are sorry for the incovenience. etc.

Any idea why?

Code: Select all

// Modified by Ollie from the original by:
// Probando Combit List & Label 12
// Modificado por Jairo Centeno
// 14 de Marzo 2007

#include "FiveWin.ch"
#include "ListLabel.ch"

#ifndef __XPP__
   #define  HKEY_CLASSES_ROOT       2147483648
#else
   #define  HKEY_CLASSES_ROOT       1
#endif

//Global oActiveX, oWindow, hJob, nRet//, cTempPath //, cFileName
//Global oWindow
//Global oActiveX, hJob, nRet //, cTempPath //, cFileName

FUNCTION TESTLL()
   LOCAL oMainWindow

   USE ARTICLE NEW

   DEFINE WINDOW oMainWindow TITLE "FiveWin ActiveX Support" MENU BuildMenu()

   //oActiveX = TActiveX():New( oWindow, "L12.List-Label12_Ctrl_32.1" )

   //USE ARTICLE NEW
   // ARTICLE->( dbGoTop() )

   //oWindow:oClient = oActiveX // To fill the entire window surface

   ACTIVATE WINDOW oMainWindow VALID MsgYesNo( "Exit ?" )

   dbCloseArea()

   RETURN NIL

//-------------------------------------------------------------------
STATIC FUNCTION BuildMenu()
//-------------------------------------------------------------------
   LOCAL oMenu

   MENU oMenu
   MENUITEM "&Information"
   MENU
   MENUITEM "&Designer" ACTION LLDesigner( "ARTICLE", "article.lst" ) //MsgAbout( "FiveWin", "FiveTech" )
   SEPARATOR
   MENUITEM "&Print" ACTION LLPrinter( "ARTICLE", "article.lst" )
   SEPARATOR
   MENUITEM "&Exit" ACTION oWindow:End()  //dbCloseAll(),
   ENDMENU
   ENDMENU

   RETURN oMenu

//List & Label specific print and design routines start
//     here
//-------------------------------------------------------------------
FUNCTION LLDesigner( cAlias, cReportName )
//-------------------------------------------------------------------
   LOCAL cTempPath := "C:\WINDOWS\TEMP"
   LOCAL aField, aType, aLen, aDec
   LOCAL oWnd := GetWndDefault()
   PUBLIC oActiveX, hJob, nRet

   //storage arrays for field info
   aField := Array( ( cAlias ) ->( FCount() ) )
   aType  := Array( ( cAlias ) ->( FCount() ) )
   aLen   := Array( ( cAlias ) ->( FCount() ) )
   aDec   := Array( ( cAlias ) ->( FCount() ) )

   //USE ( cAlias ) NEW
   ( cAlias ) ->( dbGoTop() )

   oActiveX = TActiveX():New(, "L12.List-Label12_Ctrl_32.1" )

   //Read field info from database
   AFields( aField, aType, aLen, aDec )

   //open List & Label job, retrieve job handle
   hJob := 1
   //LlJobOpen(-1)

   //Enable multiple table lines
   oActiveX:Do( "LlSetOption", LL_OPTION_MULTIPLETABLELINES, 1 )

   //call file open dialog
   //oActiveX:Do("LlSelectFileDlgTitleEx", oWindow:hWnd, "Select File", LL_PROJECT_LIST, @cReportName )
   //Ollie: I replaced  oWindow:hWnd with GETFOCUS() - Retrieves the handle of the window that has focus

   //if nRet != LL_ERR_USER_ABORTED

   //clear DLL-internal field buffer
   oActiveX:Do( "LlDefineFieldStart" )

   //Define Fields
   DefineData( cAlias, .T. ) //, aField, aType, aLen, aDec )

   //start designer
   oActiveX:Do( "LlSetPrinterDefaultsDir", cTempPath )
   oActiveX:Do( "LlDefineLayout", oWnd:hWnd /* GETFOCUS() Ollie: was oWindow:hWnd */, "Designer", LL_PROJECT_LIST, cReportName )
   //endif

   oActiveX := NIL
   RELEASE oActiveX, hJob, nRet
   RETURN NIL



//-------------------------------------------------------------------
FUNCTION LLPrinter( cAlias, cReportName )
//-------------------------------------------------------------------

   LOCAL cTempPath := "C:\WINDOWS\TEMP"
   LOCAL aField, aType, aLen, aDec, nCount, nAkt
      LOCAL oWnd := GetWndDefault()
   PUBLIC oActiveX, hJob, nRet

   //storage arrays for field info
   aField := Array( ( cAlias ) ->( FCount() ) )
   aType  := Array( ( cAlias ) ->( FCount() ) )
   aLen   := Array( ( cAlias ) ->( FCount() ) )
   aDec   := Array( ( cAlias ) ->( FCount() ) )

   cTempPath := "C:\WINDOWS\TEMP"

   //USE ( cAlias ) NEW
   ( cAlias ) ->( dbGoTop() )

   oActiveX = TActiveX():New(, "L12.List-Label12_Ctrl_32.1" )

   nRet := 0

   //Read field info from database
   AFields( aField, aType, aLen, aDec )

   //open List & Label job, retrieve job handle
   hJob := 1
   //hJob := LlJobOpen(-1)

   //Enable multiple table lines
   oActiveX:Do( "LlSetOption", LL_OPTION_MULTIPLETABLELINES, 1 )

   //call file open dialog
//     nRet:= oActiveX:Do( "LlSelectFileDlgTitle", oWindow:hWnd, "Select File", LL_PROJECT_LIST, @cReportName )

//    if nRet != LL_ERR_USER_ABORTED

   nCount := ( cAlias ) ->( RECCOUNT() )
   nAkt := 0

   //clear DLL-internal field buffer
   oActiveX:Do( "LlDefineFieldStart" )

   //Define Fields
   DefineData( cAlias, .T. ) //, aField, aType, aLen, aDec )

   //start List & Label print job
   oActiveX:Do( "LlSetPrinterDefaultsDir", cTempPath )

   //nRet := oActiveX:Do( "LlPrintWithBoxStart", LL_PROJECT_LIST, cReportName, LL_PRINT_PREVIEW, LL_BOXTYPE_STDWAIT, oWindow:hWnd , "Preview" )
   nRet := oActiveX:Do( "LlPrintWithBoxStart", LL_PROJECT_LIST, cReportName, LL_PRINT_PREVIEW, LL_BOXTYPE_STDWAIT,;
   oWnd:hWnd /*GETFOCUS() Ollie: was oWindow:hWnd */ , "Preview" )

   oActiveX:Do( "LlPreviewSetTempPath", cTempPath )

   //Print header for first page
   oActiveX:Do( "LlPrint" )
   //  nRet := LlPrint(hJob)  //No utilizar nRet aqui, porque revienta error

   //outer loop: repeat for each page
   DO WHILE ( nCount > 0 ) .AND. ( nRet = 0 ) .AND. ( ! ( cAlias ) ->( EOF() ) )

      //inner loop: repeat for each record
      DO WHILE ( nCount > 0 ) .AND. ( nRet = 0 ) .AND. ( ! ( cAlias ) ->( EOF() ) )

         //define fields
         DefineData( cAlias, .T., aField, aType, aLen, aDec )

         //print table line
         nRet := oActiveX:Do( "LlPrintFields" )

         //move to next record
         ( cAlias ) ->( DBSkip( 1 ) )
         nAkt := nAkt + 1

         //update meter info
         oActiveX:Do( "LlPrintSetBoxText", "Printing", ( ( 100 * nAkt ) / nCount ) )

      ENDDO

      //on pagebreak print new header and repeat last data
      DO WHILE nRet = LL_WRN_REPEAT_DATA
         oActiveX:Do( "LlPrint" )
         nRet := oActiveX:Do( "LlPrintFields" )
      ENDDO
   ENDDO

   //print footer of last page
   nRet := oActiveX:Do( "LlPrintFieldsEnd" )

   //Page break for last footer, if necessary
   DO WHILE nRet = LL_WRN_REPEAT_DATA
      nRet := oActiveX:Do( "LlPrintFieldsEnd" )
   END DO

   //end List & Label print job
   oActiveX:Do( "LlPrintEnd", 0 )

   //display preview if no error occurred
   IF nRet = 0
      //oActiveX:Do( "LlPreviewDisplay", cReportName, cTempPath, oWindow:hWnd )
      oActiveX:Do( "LlPreviewDisplay", cReportName, cTempPath, oWnd:hWnd /*GETFOCUS() Ollie: was oWindow:hWnd */ )

      //delete temporary preview files
      oActiveX:Do( "LlPreviewDeleteFiles", cReportName, cTempPath )
   ENDIF

//  ENDIF //LL_ERR_USER_ABORTED

   oActiveX := NIL
   RELEASE oActiveX, hJob, nRet
   RETURN NIL


STATIC FUNCTION DefineData( cAlias, bAsField ) //, aField, aType, aLen, aDec )
//-------------------------------------------------------------------

//Is called by the program to define the variables according
//    to the new record. bAsField distinguishes between field and
//    variable declaration to List & Label

   LOCAL FldType, FldContent, DateBuffer, lExpr, I := 1
   LOCAL aField, aType, aLen, aDec

   //storage arrays for field info
   aField := Array( ( cAlias ) ->( FCount() ) )
   aType  := Array( ( cAlias ) ->( FCount() ) )
   aLen   := Array( ( cAlias ) ->( FCount() ) )
   aDec   := Array( ( cAlias ) ->( FCount() ) )

   //Read field info from database
   AFields( aField, aType, aLen, aDec )

   //convert FiveWin field types to List & Label field types

   FOR I = 1 to ( cAlias ) ->( Fcount() )

      DateBuffer = Replicate( chr( 0 ), 255 )

      DO CASE
      CASE aType[ I ] == "N"
         FldType = LL_NUMERIC
         FldContent = Str( ( cAlias ) ->( FieldGet( I ) ) )
      CASE aType[ I ] == "D"
         FldType = LL_DATE

         //Convert to Julian Date
         //Create function tree
         lExpr = oActiveX:Do( "LlExprParse", "CTOD( (cAlias)->(FieldGet(i)) )", .F. )
//                  lExpr = oActiveX:Do("LlExprParse", "DTOC( (cAlias)->(FieldGet(i)) )", .F. )
         //lExpr = LlExprParse(hJob,"DateToJulian(DATE("+chr(34)+DTOC( FieldGet(i) )+chr(34)+"))", .F.)

         //Evaluate expression
         oActiveX:Do( "LlExprEvaluate", lExpr, @DateBuffer )

         //Free expression
         oActiveX:Do( "LlExprFree", lExpr )

         FldContent = DateBuffer
         
      CASE aType[ I ] == "L"
         FldType = LL_BOOLEAN
         IF ( cAlias ) ->( FieldGet( I ) ) = .F.
            FldContent = "FALSE"
         ELSE
            FldContent = "TRUE"
         ENDIF
      CASE aType[ I ] == "C"
         FldType = LL_TEXT
         FldContent = Trim( ( cAlias ) ->( FieldGet( I ) ) )
         
         //for (cAlias) number generate EAN128-barcode
         IF I = 1
            DO CASE
               //Distinguish between field and variable declaration
            CASE bAsField == .F.
               oActiveX:Do( "LlDefineVariableExt", "(cAlias)NO_EAN128", Trim( ( cAlias ) ->( FieldGet( I ) ) ), LL_BARCODE_EAN128 )
            CASE bAsField == .T.
               oActiveX:Do( "LlDefineFieldExt", "(cAlias)NO_EAN128", Trim( ( cAlias ) ->( FieldGet( I ) ) ), LL_BARCODE_EAN128 )
            END CASE
         ENDIF

      CASE aType[ I ] == "M"
         FldType = LL_TEXT
         FldContent = ( cAlias ) ->( FieldGet( I ) )
      END CASE
      
      //pass data to List & Label
      DO CASE
      CASE bAsField == .F.
         oActiveX:Do( "LlDefineVariableExt", aField[ I ], FldContent, FldType )
      CASE bAsField == .T.
         oActiveX:Do( "LlDefineFieldExt", aField[ I ], FldContent, FldType )
      END CASE
      
   NEXT I
   
   RETURN NIL
   
   
   
/*
-----
DLLFUNCTION GetTempPathA( buffsize, @buffer ) ;
         USING STDCALL ;
          FROM KERNEL32.DLL


FUNCTION MyGetTempPath()

LOCAL nBuffSize := 261
LOCAL sBuffer := Replicate(chr(0),261)

GetTempPathA(nBuffsize, @sBuffer)

return sBuffer
-----
*/
// La utilizo para ampliar parámetros (uParam6)
//----------------------------------------------------------------------------//
CLASS TActiveX FROM TControl
   
   CLASSDATA lRegistered AS LOGICAL
   
   DATA   hActiveX
   DATA   cProgID
   DATA   cString
   DATA   aProperties, aMethods, aEvents
   DATA   bOnEvent
   
   METHOD New( oWindow, cProgID ) CONSTRUCTOR

   METHOD ReDefine( nId, oWindow, cProgID ) CONSTRUCTOR

   METHOD Do( cMethodName, uParam1, uParam2, uParam3, uParam4, uParam5, uParam6 )
   
   METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
   
   METHOD EraseBkGnd( hDC ) INLINE 1
   
   METHOD GetProp( cPropName ) INLINE ;
   ActXGetProperty( ActXPdisp( ::hActiveX ), cPropName )
   
   METHOD Initiate( hDlg )
   
   METHOD OnEvent( nEvent, aParams )
   
   METHOD ReadTypes()
   
   METHOD ReSize( nFlags, nWidth, nHeight ) INLINE ;
   ActXSetLocation( ::hActiveX, 0, 0, nWidth, nHeight )

   METHOD SetProp( cPropName, uParam1 ) INLINE ;
   ActXSetProperty( ActXPdisp( ::hActiveX ), cPropName, uParam1 )
   
ENDCLASS

//----------------------------------------------------------------------------//
METHOD New( oWnd, cProgID ) CLASS TActiveX

   DEFAULT oWnd := GetWndDefault()
   
   ::nTop    = 0
   ::nLeft   = 0
   ::nBottom = 200
   ::nRight  = 200
   ::oWnd    = oWnd
   ::nId     = ::GetNewId()
   ::nStyle  = nOR( WS_CHILD, WS_VISIBLE )
   ::cProgID = cProgID
   ::cString = ActXString( cProgID )
   
   ::Register()
   
   if ! Empty( oWnd:hWnd )
      ::Create()
      oWnd:AddControl( Self )
      ::hActiveX = CreateActiveX( ::hWnd, cProgID, Self )
      ::ReadTypes()
   else
      oWnd:DefControl( Self )
   endif

   return Self
   
//----------------------------------------------------------------------------//
   
METHOD Do( cMethodName, uParam1, uParam2, uParam3, uParam4, uParam5, uParam6 ) CLASS TActiveX
   
   local uRet
   
   do case
   case PCount() == 1
      uRet = ActXInvoke( ActXPdisp( ::hActiveX ), cMethodName )
      
   case PCount() == 2
      uRet = ActXInvoke( ActXPdisp( ::hActiveX ), cMethodName, uParam1 )
      
   case PCount() == 3
      uRet = ActXInvoke( ActXPdisp( ::hActiveX ), cMethodName, uParam1, uParam2 )
      
   case PCount() == 4
      uRet = ActXInvoke( ActXPdisp( ::hActiveX ), cMethodName, uParam1, uParam2, ;
                         uParam3 )
   case PCount() == 5
      uRet = ActXInvoke( ActXPdisp( ::hActiveX ), cMethodName, uParam1, uParam2, ;
                         uParam3, uParam4 )
   case PCount() == 6
      uRet = ActXInvoke( ActXPdisp( ::hActiveX ), cMethodName, uParam1, uParam2, ;
                         uParam3, uParam4, uParam5  )
   case PCount() == 7
      uRet = ActXInvoke( ActXPdisp( ::hActiveX ), cMethodName, uParam1, uParam2, ;
                         uParam3, uParam4, uParam5, uParam6 )
   endcase
   
   return uRet
   
//----------------------------------------------------------------------------//
   
METHOD ReDefine( nId, oWnd, cProgID ) CLASS TActiveX
   
   ::nId     = nId
   ::oWnd    = oWnd
   ::cProgID = cProgID
   ::cString = ActXString( cProgID )
   
   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )
   
   oWnd:DefControl( Self )
   
   return Self

//----------------------------------------------------------------------------//

METHOD Initiate( hDlg ) CLASS TActiveX
   
   Super:Initiate( hDlg )
   
   ::hActiveX = CreateActiveX( ::hWnd, ::cProgID, Self )
   ::ReadTypes()
   
   return nil
   
//----------------------------------------------------------------------------//
   
METHOD OnEvent( nEvent, aParams ) CLASS TActiveX
   
   local nAt := AScan( ::aEvents, { | aEvent | aEvent[ 2 ] == nEvent } )
   local cEvent := If( nAt != 0, ::aEvents[ nAt ][ 1 ], "" )
   
   if ! Empty( ::bOnEvent )
      Eval( ::bOnEvent, If( ! Empty( cEvent ), cEvent, nEvent ), aParams )
   endif
   
   return nil
   
//----------------------------------------------------------------------------//
   
METHOD ReadTypes() CLASS TActiveX
   
   local oReg := TReg32():New( HKEY_CLASSES_ROOT, "CLSID\" + ::cString + ;
         "\InprocServer32" )
   local cTypeLib := oReg:Get( "" )
   
   oReg:Close()
   
   if ! Empty( cTypeLib ) .and. File( cTypeLib )
      ::aEvents = ActXEvents( cTypeLib, ::hActiveX )
   endif
   
   return nil
   
//----------------------------------------------------------------------------//

Post by **Antonio Linares** » Mon Oct 15, 2007 8:09 am

Ollie,

Jairo has included a modified Class TActiveX in his sample. Are you including it also in your PRG ?

Are you using Harbour, xHarbour or xHB commercial ?

Ollie · Post by **Ollie** » Mon Oct 15, 2007 8:25 am

Jairo has included a modified Class TActiveX in his sample. Are you including it also in your PRG ?

YES. The code given here is all in a file called TESTLL.PRG - I link the whole file as it is into my program.

Are you using Harbour, xHarbour or xHB commercial ?

xHarbour

Post by **Antonio Linares** » Mon Oct 15, 2007 8:44 am

Ollie,

Please place a MsgInfo() at the bottom of method New() to be sure that the modified class TActiveX is the one that gets linked:

MsgInfo( "here" )

return Self

Ollie · Post by **Ollie** » Mon Oct 15, 2007 8:58 am

I did that. It is executing the right method - The MSG "here" comes up.

(And then the error occurs)

Post by **Antonio Linares** » Mon Oct 15, 2007 9:56 am

Ollie,

Please place several traces to find what is the offending code:

oActiveX = TActiveX():New(, "L12.List-Label12_Ctrl_32.1" )

MsgInfo( oActiveX:hActiveX )

//Read field info from database
AFields( aField, aType, aLen, aDec )

//open List & Label job, retrieve job handle
hJob := 1
//LlJobOpen(-1)

//Enable multiple table lines
oActiveX:Do( "LlSetOption", LL_OPTION_MULTIPLETABLELINES, 1 )
MsgInfo( "after LlSetOption" )
...

Ollie · Post by **Ollie** » Mon Oct 15, 2007 3:27 pm

I feel stupid for not having tried that first.

I found the problem was relating to the line:

AFields( aField, aType, aLen, aDec )

It gave NIL values.

I replaced it with (cAlias)->(AFields( aField, aType, aLen, aDec ) )

and problem solved.

Thanks Antonio for your prompt response. (I've been struggling with this for some time now.) THANKS AGAIN.

Post by **Antonio Linares** » Mon Oct 15, 2007 4:04 pm

Ollie,

glad to know it is solved