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 Expand view RUN
// 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
//----------------------------------------------------------------------------//
