diff --git a/harbour/contrib/ole2/Makefile b/harbour/contrib/ole2/Makefile deleted file mode 100644 index bcc7c1f5b2..0000000000 --- a/harbour/contrib/ole2/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -# $Id$ -# - -ROOT = ../../ - -C_SOURCES=\ - w32ole.c \ - -PRG_SOURCES=\ - win32ole.prg \ - -LIBNAME=hbole - -include $(TOP)$(ROOT)config/lib.cf diff --git a/harbour/contrib/ole2/make_b32.bat b/harbour/contrib/ole2/make_b32.bat deleted file mode 100644 index 538f689944..0000000000 --- a/harbour/contrib/ole2/make_b32.bat +++ /dev/null @@ -1,33 +0,0 @@ -@echo off -rem -rem $Id$ -rem - -if "%1" == "clean" goto CLEAN -if "%1" == "CLEAN" goto CLEAN - -:BUILD - - make -fmakefile.bc %1 %2 %3 > make_b32.log - if errorlevel 1 goto BUILD_ERR - -:BUILD_OK - - copy ..\..\lib\b32\hboleaut.lib ..\..\lib\*.* > nul - if exist ..\..\lib\b32\hboleaut.bak del ..\..\lib\b32\hboleaut.bak - goto EXIT - -:BUILD_ERR - - notepad make_b32.log - goto EXIT - -:CLEAN - if exist ..\..\lib\b32\hboleaut.lib del ..\..\lib\b32\hboleaut.lib - if exist ..\..\lib\b32\hboleaut.bak del ..\..\lib\b32\hboleaut.bak - if exist ..\..\obj\b32\win32ole.obj del ..\..\obj\b32\win32ole.obj - if exist ..\..\obj\b32\w32ole.obj del ..\..\obj\b32\w32ole.obj - - goto EXIT - -:EXIT \ No newline at end of file diff --git a/harbour/contrib/ole2/makefile.bc b/harbour/contrib/ole2/makefile.bc deleted file mode 100644 index 415f010bf9..0000000000 --- a/harbour/contrib/ole2/makefile.bc +++ /dev/null @@ -1,26 +0,0 @@ -# -# $Id$ -# - -# makefile for Borland C/C++ 32 bits -# Building of hboleaut.lib - Class TOleAuto for Windows - -INCLUDE_DIR = ..\..\include - -BIN_DIR = ..\..\bin\b32 -OBJ_DIR = ..\..\obj\b32 -LIB_DIR = ..\..\lib\b32 - -$(LIB_DIR)\hboleaut.lib : \ - $(OBJ_DIR)\win32ole.obj \ - $(OBJ_DIR)\w32ole.obj - -$(OBJ_DIR)\win32ole.obj : win32ole.c -$(OBJ_DIR)\w32ole.obj : w32ole.c - -.c.obj: - bcc32 $(CLIBFLAGS) $(C_USR) -c -O2 -DWIN32 -I$(INCLUDE_DIR) -o$@ $< - tlib $(LIB_DIR)\hboleaut.lib -+$@,, - -.prg.c: - $(BIN_DIR)\harbour.exe $< -q0 -w -es2 -gc0 -n -i$(INCLUDE_DIR) -o$@ diff --git a/harbour/contrib/ole2/w32ole.c b/harbour/contrib/ole2/w32ole.c deleted file mode 100644 index 77a585dac2..0000000000 --- a/harbour/contrib/ole2/w32ole.c +++ /dev/null @@ -1,2196 +0,0 @@ -/* - * $Id$ - */ - -/* - * Copyright 2002 José F. Giménez (JFG) - - * Ron Pinkas - - * - * www - http://www.xharbour.org - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). - * - * As a special exception, the xHarbour Project gives permission for - * additional uses of the text contained in its release of xHarbour. - * - * The exception is that, if you link the xHarbour libraries with other - * files to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the xHarbour library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the xHarbour - * Project under the name xHarbour. If you copy code from other - * xHarbour Project or Free Software Foundation releases into a copy of - * xHarbour, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. - * - * If you write modifications of your own for xHarbour, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. - * - */ - -#ifndef CINTERFACE - #define CINTERFACE 1 -#endif - -#define NONAMELESSUNION - -#include - -#include "hbvmopt.h" -#include "hbapi.h" -#include "hbstack.h" -#include "hbapierr.h" -#include "hbapiitm.h" -#include "hbapicls.h" -#include "hbvm.h" -#include "hbdate.h" -#include "hboo.ch" - -#include - -#include -#include -#include - -#ifndef __MINGW32__ - // Missing in Mingw V 2. - //#include -#endif - -#include - -#ifdef __MINGW32__ - // Missing in oleauto.h - WINOLEAUTAPI VarR8FromDec(DECIMAL *pdecIn, DOUBLE *pdblOut); -#endif - -#if ( defined(__DMC__) || defined(__MINGW32__) || ( defined(__WATCOMC__) && !defined(__FORCE_LONG_LONG__) ) ) - #define HB_LONG_LONG_OFF -#endif - -static void RetValue( void ); - -static HRESULT s_nOleError; -static HB_ITEM OleAuto; - -static PHB_DYNS s_pSym_TOleAuto = NULL; -static PHB_DYNS s_pSym_hObj = NULL; -static PHB_DYNS s_pSym_New = NULL; -static PHB_DYNS s_pSym_cClassName = NULL; - -static PHB_DYNS s_pSym_VTWrapper = NULL; -static PHB_DYNS s_pSym_VTArrayWrapper = NULL; -static PHB_DYNS s_pSym_vt = NULL; -static PHB_DYNS s_pSym_Value = NULL; - -static DISPPARAMS s_EmptyDispParams; - -static VARIANTARG RetVal, OleVal; - -static BOOL s_bInit = FALSE; - -// ----------------------------------------------------------------------- - -#define EG_OLEEXECPTION 1001 -#define HB_STRING_ALLOC( p, l ) hb_itemReSizeString( p, l ) -static void hb_itemPushForward( PHB_ITEM pItem ) -{ - hb_itemMove( hb_stackAllocItem(), pItem ); -} - -static void hb_vmRequestReset( void ) -{ - hb_stackSetActionRequest( 0 ); -} - -PHB_ITEM HB_EXPORT hb_itemPutCRawStatic( PHB_ITEM pItem, const char * szText, ULONG ulLen ) -{ - HB_TRACE(HB_TR_DEBUG, ("hb_itemPutCRawStatic(%p, %s, %lu)", pItem, szText, ulLen)); - - if( pItem ) - { - if( HB_IS_COMPLEX( pItem ) ) - hb_itemClear( pItem ); - } - else - pItem = hb_itemNew( NULL ); - - pItem->type = HB_IT_STRING; - pItem->item.asString.allocated = 0; - - if( szText == NULL ) - { - pItem->item.asString.value = ""; - pItem->item.asString.length = 0; - } - else - { - pItem->item.asString.value = ( char * ) szText; - pItem->item.asString.length = ulLen; - } - - return pItem; -} - -static void TraceLog( const char * sFile, const char * sTraceMsg, ... ) -{ - FILE *hFile; - - if( !sTraceMsg ) - { - return; - } - - if( sFile == NULL ) - { - hFile = fopen( "trace.log", "a" ); - } - else - { - hFile = fopen( sFile, "a" ); - } - - if( hFile ) - { - va_list ap; - - va_start( ap, sTraceMsg ); - vfprintf( hFile, sTraceMsg, ap ); - va_end( ap ); - - fclose( hFile ); - } -} - - - // ----------------------------------------------------------------------- - static EXCEPINFO excep; - - static DISPID lPropPut = DISPID_PROPERTYPUT; - static UINT uArgErr; - - HRESULT hb_oleVariantToItem( PHB_ITEM pItem, VARIANT *pVariant ); - static PHB_ITEM SafeArrayToArray( SAFEARRAY *parray, UINT iDim, long* rgIndices, VARTYPE vt ); - - //---------------------------------------------------------------------------// - HB_EXPORT BSTR hb_oleAnsiToSysString( const char * cString ) - { - int nConvertedLen = MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, cString, -1, NULL, 0 ); - - if( nConvertedLen ) - { - BSTR bstrString = SysAllocStringLen( NULL, nConvertedLen - 1 ); - - if( MultiByteToWideChar( CP_ACP, 0, cString, -1, bstrString, nConvertedLen ) ) - { - return bstrString; - } - else - { - SysFreeString( bstrString ); - } - } - - return NULL; - } - - //---------------------------------------------------------------------------// - HB_EXPORT LPWSTR hb_oleAnsiToWide( LPSTR cString ) - { - int nConvertedLen = MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, cString, -1, NULL, 0 ); - - if( nConvertedLen ) - { - LPWSTR wString = (LPWSTR) hb_xgrab( nConvertedLen * 2 + 1 ); - - if( MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, cString, -1, wString, nConvertedLen ) ) - { - return wString; - } - else - { - hb_xfree( wString ); - } - } - - return NULL; - } - - /* This code is executed only once when HVM clears static variables - * inside hb_vmQuite() - so it's executed after all EXIT functions - * and allow to use OLE in object destructors - */ - static HB_GARBAGE_FUNC( hb_oleRelease ) - { - HB_SYMBOL_UNUSED( Cargo ); - - if( s_bInit ) - { - OleUninitialize(); - s_bInit = FALSE; - } - } - - //---------------------------------------------------------------------------// - - HB_FUNC( __HB_OLE_INIT ) - { - if( s_pSym_TOleAuto == NULL ) - { - s_pSym_TOleAuto = hb_dynsymFind( "TOLEAUTO" ); - s_pSym_New = hb_dynsymFind( "NEW" ); - s_pSym_hObj = hb_dynsymFind( "HOBJ" ); - s_pSym_cClassName = hb_dynsymFind( "CCLASSNAME" ); - - s_pSym_VTWrapper = hb_dynsymFind( "VTWRAPPER" ); - s_pSym_VTArrayWrapper = hb_dynsymFind( "VTARRAYWRAPPER" ); - s_pSym_vt = hb_dynsymGetCase( "VT" ); - s_pSym_Value = hb_dynsymFind( "VALUE" ); - - s_EmptyDispParams.rgvarg = NULL; - s_EmptyDispParams.cArgs = 0; - s_EmptyDispParams.rgdispidNamedArgs = 0; - s_EmptyDispParams.cNamedArgs = 0; - - if( ! s_bInit ) - { - OleInitialize( NULL ); - hb_retptrGC( hb_gcAlloc( 1, hb_oleRelease ) ); - s_bInit = TRUE; - } - - VariantInit( &RetVal ); - VariantInit( &OleVal ); - } - } - -//---------------------------------------------------------------------------// - - HB_FUNC( ANSITOWIDE ) // ( cAnsiStr ) -> cWideStr - { - char *cString = hb_parc( 1 ); - - if( cString ) - { - BSTR wString = hb_oleAnsiToWide( cString ); - - if( wString ) - { - hb_retclen_buffer( (char *) wString, SysStringLen( wString ) ); - return; - } - } - - hb_ret(); - return; - } - - //---------------------------------------------------------------------------// - HB_EXPORT LPSTR hb_oleWideToAnsi( BSTR wString ) - { - int nConvertedLen = WideCharToMultiByte( CP_ACP, 0, wString, -1, NULL, 0, NULL, NULL ); - - if( nConvertedLen ) - { - char *cString = (char *) hb_xgrab( nConvertedLen ); - - if( WideCharToMultiByte( CP_ACP, 0, wString, -1, cString, nConvertedLen, NULL, NULL ) ) - { - return cString; - } - else - { - hb_xfree( cString ); - } - } - - //wprintf( L"\nWide: '%s'\n", wString ); - //printf( "\nAnsi: '%s'\n", cString ); - - return NULL; - } - - //---------------------------------------------------------------------------// - HB_FUNC( WIDETOANSI ) // ( cWideStr, nLen ) -> cAnsiStr - { - BSTR wString = ( BSTR ) hb_parc( 1 ); - - if( wString ) - { - char *cString = hb_oleWideToAnsi( wString ); - - if( cString ) - { - hb_retclenAdopt( cString, strlen( cString ) ); - return; - } - } - - hb_ret(); - return; - } - - //---------------------------------------------------------------------------// - HB_EXPORT void hb_oleItemToVariant( VARIANT *pVariant, PHB_ITEM pItem ) - { - BOOL bByRef; - VARIANT mVariant; - VARTYPE vt; - SAFEARRAYBOUND rgsabound; - void *pSource;// = NULL; - unsigned long i; - char *sString; - - if( HB_IS_BYREF( pItem ) ) - { - pItem = hb_itemUnRef( pItem ); - bByRef = TRUE; - } - else - { - bByRef = FALSE; - } - - VariantClear( pVariant ); - - switch( pItem->type ) - { - case HB_IT_NIL: - //pVariant->n1.n2.vt = VT_EMPTY; - break; - - case HB_IT_STRING: - case HB_IT_MEMO: - { - ULONG ulLen = hb_itemGetCLen( pItem ); - - sString = hb_itemGetCPtr( pItem ); - - // Check for hidden signature of SafeArrayToArray(). - if( (int) (pItem->item.asString.allocated - ulLen) >= 5 && - sString[ ulLen ] == 0x7A && sString[ ulLen + 1 ] == 0x7B && sString[ ulLen + 2 ] == 0x7C && sString[ ulLen + 3 ] == 0x7D ) - { - vt = (VARTYPE) sString[ ulLen + 4 ]; - goto ItemToVariant_StringArray; - } - - if( bByRef ) - { - hb_itemPutCRawStatic( pItem, (char *) hb_oleAnsiToSysString( sString ), ulLen * 2 + 1 ); - - pVariant->n1.n2.vt = VT_BYREF | VT_BSTR; - pVariant->n1.n2.n3.pbstrVal = (BSTR *) &( pItem->item.asString.value ); - //wprintf( L"*** BYREF >%s<\n", *pVariant->n1.n2.n3.bstrVal ); - } - else - { - pVariant->n1.n2.vt = VT_BSTR; - pVariant->n1.n2.n3.bstrVal = hb_oleAnsiToSysString( sString ); - //wprintf( L"*** >%s<\n", pVariant->n1.n2.n3.bstrVal ); - } - break; - } - - case HB_IT_LOGICAL: - if( bByRef ) - { - pVariant->n1.n2.vt = VT_BYREF | VT_BOOL; - pVariant->n1.n2.n3.pboolVal = (short *) &( pItem->item.asLogical.value ) ; - *pVariant->n1.n2.n3.pboolVal = hb_itemGetL( pItem ) ? VARIANT_TRUE : VARIANT_FALSE; - //pItem->type = HB_IT_LONG; - } - else - { - pVariant->n1.n2.vt = VT_BOOL; - pVariant->n1.n2.n3.boolVal = hb_itemGetL( pItem ) ? VARIANT_TRUE : VARIANT_FALSE; - } - break; - - case HB_IT_INTEGER: -#if HB_INT_MAX == INT16_MAX - if( bByRef ) - { - pVariant->n1.n2.vt = VT_BYREF | VT_I2; - pVariant->n1.n2.n3.piVal = &( pItem->item.asInteger.value ) ; - } - else - { - pVariant->n1.n2.vt = VT_I2; - pVariant->n1.n2.n3.iVal = hb_itemGetNI( pItem ); - } - break; -#else - if( bByRef ) - { - pVariant->n1.n2.vt = VT_BYREF | VT_I4; - pVariant->n1.n2.n3.plVal = (long *) &( pItem->item.asInteger.value ) ; - } - else - { - pVariant->n1.n2.vt = VT_I4; - pVariant->n1.n2.n3.lVal = hb_itemGetNL( pItem ); - } - break; -#endif - case HB_IT_LONG: -#if HB_LONG_MAX == INT32_MAX || defined( HB_LONG_LONG_OFF ) - if( bByRef ) - { - pVariant->n1.n2.vt = VT_BYREF | VT_I4; - pVariant->n1.n2.n3.plVal = (long *) &( pItem->item.asLong.value ) ; - } - else - { - pVariant->n1.n2.vt = VT_I4; - pVariant->n1.n2.n3.lVal = hb_itemGetNL( pItem ); - } -#else - if( bByRef ) - { - pVariant->n1.n2.vt = VT_BYREF | VT_I8; - pVariant->n1.n2.n3.pllVal = &( pItem->item.asLong.value ) ; - } - else - { - pVariant->n1.n2.vt = VT_I8; - pVariant->n1.n2.n3.llVal = hb_itemGetNLL( pItem ); - } -#endif - break; - - case HB_IT_DOUBLE: - if( bByRef ) - { - pVariant->n1.n2.vt = VT_BYREF | VT_R8; - pVariant->n1.n2.n3.pdblVal = &( pItem->item.asDouble.value ) ; - pItem->type = HB_IT_DOUBLE; - } - else - { - pVariant->n1.n2.vt = VT_R8; - pVariant->n1.n2.n3.dblVal = hb_itemGetND( pItem ); - } - break; - - case HB_IT_DATE: - if( pItem->item.asDate.value == 0 ) - { - pVariant->n1.n2.vt = VT_NULL; - } - else if( bByRef ) - { - pItem->item.asDouble.value = (double) ( pItem->item.asDate.value - 2415019 ); - pItem->type = HB_IT_DOUBLE; - - pVariant->n1.n2.vt = VT_BYREF | VT_DATE; - pVariant->n1.n2.n3.pdblVal = &( pItem->item.asDouble.value ) ; - } - else - { - pVariant->n1.n2.vt = VT_DATE; - pVariant->n1.n2.n3.dblVal = (double) ( pItem->item.asDate.value - 2415019 ); - } - break; - - case HB_IT_POINTER: - pVariant->n1.n2.vt = VT_PTR; - pVariant->n1.n2.n3.byref = hb_itemGetPtr( pItem ); - break; - - case HB_IT_ARRAY: - { - if( HB_IS_OBJECT( pItem ) ) - { - if( hb_clsIsParent( pItem->item.asArray.value->uiClass , "TOLEAUTO" ) ) - { - IDispatch *pDisp;// = NULL; - - hb_vmPushSymbol( s_pSym_hObj->pSymbol ); - hb_vmPush( pItem ); - hb_vmSend( 0 ); - - pDisp = (IDispatch *) hb_parnl( -1 ); - pDisp->lpVtbl->AddRef( pDisp ); - - //TraceLog( NULL, "Dispatch: in: %s(%i)%ld\n", pDisp, __FILE__, __LINE__ ); - - if( bByRef ) - { - pVariant->n1.n2.vt = ( VT_DISPATCH | VT_BYREF ); - // Hack!!! Using high 4 bytes of the union (llVal) - *( (IDispatch **) ( &pVariant->n1.n2.n3.lVal ) + 1 ) = pDisp; - pVariant->n1.n2.n3.ppdispVal = (IDispatch **) (&pVariant->n1.n2.n3.lVal ) + 1; - } - else - { - pVariant->n1.n2.vt = VT_DISPATCH; - pVariant->n1.n2.n3.pdispVal = pDisp; - } - } - // MUST be before "VTWRAPPER" - else if( hb_clsIsParent( pItem->item.asArray.value->uiClass , "VTARRAYWRAPPER" ) ) - { - // vt := oVTArray:vt - hb_vmPushSymbol( s_pSym_vt->pSymbol ); - hb_vmPush( pItem ); - hb_vmSend( 0 ); - - vt = (VARTYPE) hb_parnl(-1); - - // aArray := oVTArray:Value - hb_vmPushSymbol( s_pSym_Value->pSymbol ); - hb_vmPush( pItem ); - hb_vmSend( 0 ); - - // Intentionally not using hb_itemCopy() or hb_itemForwardValue() - pItem = hb_stackReturnItem(); - - if( ( vt == VT_I1 || vt == VT_UI1 ) && HB_IS_STRING( pItem ) ) - { - SAFEARRAY *parray; - - sString = hb_itemGetCPtr( pItem ); - - ItemToVariant_StringArray: - - rgsabound.cElements = hb_itemGetCLen( pItem ); - rgsabound.lLbound = 0; - - parray = SafeArrayCreate( vt, 1, &rgsabound ); - - if( bByRef ) - { - pVariant->n1.n2.vt = ( VT_ARRAY | VT_BYREF | vt ); - // Hack!!! Using high 4 bytes of the union (llVal) - *( (SAFEARRAY **) ( &pVariant->n1.n2.n3.lVal ) + 1 ) = parray; - pVariant->n1.n2.n3.pparray = (SAFEARRAY **) (&pVariant->n1.n2.n3.lVal ) + 1; - } - else - { - pVariant->n1.n2.vt = ( VT_ARRAY | vt ); - pVariant->n1.n2.n3.parray = parray; - } - - for( i = 0; i < rgsabound.cElements; i++ ) - { - SafeArrayPutElement( parray, (LONG *) &i, &( sString[i]) ); - } - - break; - } - - VariantInit( &mVariant ); - pSource = &mVariant.n1.n2.n3.cVal; - - goto ItemToVariant_ProcessArray; - } - else if( hb_clsIsParent( pItem->item.asArray.value->uiClass , "VTWRAPPER" ) ) - { - // vt := oVT:vt - hb_vmPushSymbol( s_pSym_vt->pSymbol ); - hb_vmPush( pItem ); - hb_vmSend( 0 ); - - pVariant->n1.n2.vt = (VARTYPE) hb_parnl(-1); - - //value := oVT:value - hb_vmPushSymbol( s_pSym_Value->pSymbol ); - hb_vmPush( pItem ); - hb_vmSend( 0 ); - - switch( pVariant->n1.n2.vt ) - { - case VT_UNKNOWN: - pVariant->n1.n2.n3.punkVal = (IUnknown *) hb_parptr( -1 ); - break; - - case ( VT_UNKNOWN | VT_BYREF ): - // Hack!!! Using high 4 bytes of the union (llVal) - *( (IUnknown **) ( &pVariant->n1.n2.n3.lVal ) + 1 ) = (IUnknown *) hb_parptr( -1 ); - pVariant->n1.n2.n3.ppunkVal = (IUnknown **) (&pVariant->n1.n2.n3.lVal ) + 1; - break; - - default: - TraceLog( NULL, "Unexpected VT type %p in: %s(%i)!\n", pVariant->n1.n2.vt, __FILE__, __LINE__ ); - } - - break; - } - else - { - TraceLog( NULL, "Class: '%s' not suported!\n", hb_objGetClsName( pItem ) ); - } - } - else - { - unsigned long i; - SAFEARRAY *parray; - - vt = VT_VARIANT; - VariantInit( &mVariant ); - pSource = &mVariant; - - ItemToVariant_ProcessArray: - - rgsabound.cElements = hb_arrayLen( pItem ); - rgsabound.lLbound = 0; - - //TraceLog( NULL, "ItemToVariant() Array len: %i type: %i ByRef: %i in: %s(%i) \n", rgsabound.cElements, vt, bByRef, __FILE__, __LINE__ ); - - parray = SafeArrayCreate( vt, 1, &rgsabound ); - - if( bByRef ) - { - pVariant->n1.n2.vt = ( VT_ARRAY | VT_BYREF | vt ); - // Hack!!! Using high 4 bytes of the union (llVal) - *( (SAFEARRAY **) ( &pVariant->n1.n2.n3.lVal ) + 1 ) = parray; - pVariant->n1.n2.n3.pparray = (SAFEARRAY **) (&pVariant->n1.n2.n3.lVal ) + 1; - } - else - { - pVariant->n1.n2.vt = ( VT_ARRAY | vt ); - pVariant->n1.n2.n3.parray = parray; - } - - for( i = 0; i < rgsabound.cElements; i++ ) - { - hb_oleItemToVariant( &mVariant, hb_arrayGetItemPtr( pItem, i + 1 ) ); - SafeArrayPutElement( parray, (LONG *) &i, pSource ); - VariantClear( &mVariant ); - } - } - } - break; - - default: - { - TraceLog( NULL, "Unexpected type %p in: %s(%i)!\n", pItem->type, __FILE__, __LINE__ ); - } - } - } - - //---------------------------------------------------------------------------// - static PHB_ITEM * GetParams( DISPPARAMS *pDispParams, int nOffset ) - { - VARIANTARG * pArgs = NULL; - int n, nArgs, nArg; - //BOOL bByRef; - PHB_ITEM *aPrgParams = NULL; - - nArgs = hb_pcount() - nOffset; - - if( nArgs > 0 ) - { - pArgs = ( VARIANTARG * ) hb_xgrab( sizeof( VARIANTARG ) * nArgs ); - aPrgParams = ( PHB_ITEM * ) hb_xgrab( sizeof( PHB_ITEM ) * nArgs ); - - //printf( "Args: %i\n", nArgs ); - - for( n = 0; n < nArgs; n++ ) - { - // Parameters are processed in reversed order. - nArg = nArgs - n; - VariantInit( &( pArgs[ n ] ) ); - - aPrgParams[ n ] = hb_stackItemFromBase( nArg + nOffset ); - - //TraceLog( NULL, "N: %i Arg: %i Type: %i %i ByRef: %i\n", n, nArg, pParam->type, aPrgParams[ n ]->type, bByRef ); - - hb_oleItemToVariant( &( pArgs[ n ] ), aPrgParams[ n ] ); - } - } - - pDispParams->rgvarg = pArgs; - pDispParams->cArgs = nArgs; - pDispParams->rgdispidNamedArgs = 0; - pDispParams->cNamedArgs = 0; - - return aPrgParams; - } - - //---------------------------------------------------------------------------// - static void FreeParams( DISPPARAMS *pDispParams, PHB_ITEM *aPrgParams ) - { - if( pDispParams->cArgs > 0 ) - { - IDispatch *pDisp = NULL; - int n; //, nParam; - char *sString; - VARIANT *pVariant; - PHB_ITEM pItem; - BOOL bByRef; - - for( n = 0; n < ( int ) pDispParams->cArgs; n++ ) - { - pVariant = &( pDispParams->rgvarg[ n ] ); - pItem = aPrgParams[ n ]; - - if( HB_IS_BYREF( pItem ) ) - { - bByRef = TRUE; - pItem = hb_itemUnRef( pItem ); - } - else - { - bByRef = FALSE; - } - - //nParam = pDispParams->cArgs - n; - - //TraceLog( NULL, "*** N: %i, Param: %i Type: %i\n", n, nParam, pVariant->n1.n2.vt); - - if( bByRef ) - { - switch( pVariant->n1.n2.vt ) - { - case VT_BYREF | VT_BSTR: - SysFreeString( *pVariant->n1.n2.n3.pbstrVal ); - sString = hb_oleWideToAnsi( *( pVariant->n1.n2.n3.pbstrVal ) ); - hb_itemPutCPtr( pItem, sString, strlen( sString ) ); - break; - - case VT_BSTR: - sString = hb_oleWideToAnsi( pVariant->n1.n2.n3.bstrVal ); - hb_itemPutCPtr( pItem, sString, strlen( sString ) ); - break; - - case VT_BYREF | VT_BOOL: - //( pItem )->type = HB_IT_LOGICAL; - hb_itemPutL( pItem, *pVariant->n1.n2.n3.pboolVal == VARIANT_FALSE ? FALSE : TRUE ); - break; - - case VT_BOOL: - hb_itemPutL( pItem, pVariant->n1.n2.n3.boolVal == VARIANT_FALSE ? FALSE : TRUE ); - break; - - case ( VT_BYREF | VT_DISPATCH ): - if( *pVariant->n1.n2.n3.ppdispVal == NULL ) - { - hb_itemClear( pItem ); - break; - } - else - { - pDisp = *pVariant->n1.n2.n3.ppdispVal; - } - // Intentionally fall through. - - case VT_DISPATCH: - if( pVariant->n1.n2.vt == VT_DISPATCH ) - { - if( pVariant->n1.n2.n3.pdispVal == NULL ) - { - hb_itemClear( pItem ); - break; - } - else - { - pDisp = pVariant->n1.n2.n3.pdispVal; - } - } - - OleAuto.type = HB_IT_NIL; - - if( s_pSym_TOleAuto ) - { - hb_vmPushSymbol( s_pSym_TOleAuto->pSymbol ); - hb_vmPushNil(); - hb_vmDo( 0 ); - - hb_itemForwardValue( &OleAuto, hb_stackReturnItem() ); - } - - if( s_pSym_New && OleAuto.type ) - { - // Implemented in :New() - //pDisp->lpVtbl->AddRef( pDisp ); - - //TOleAuto():New( nDispatch ) - hb_vmPushSymbol( s_pSym_New->pSymbol ); - hb_itemPushForward( &OleAuto ); - hb_vmPushLong( ( LONG ) pDisp ); - hb_vmSend( 1 ); - - hb_itemForwardValue( pItem, hb_stackReturnItem() ); - } - break; - - case VT_BYREF | VT_I2: - hb_itemPutNI( pItem, ( int ) *pVariant->n1.n2.n3.piVal ); - break; - - case VT_I2: - hb_itemPutNI( pItem, ( int ) pVariant->n1.n2.n3.iVal ); - break; - - case VT_BYREF | VT_I4: - hb_itemPutNL( pItem, ( LONG ) *pVariant->n1.n2.n3.plVal ); - break; - - case VT_I4: - hb_itemPutNL( pItem, ( LONG ) pVariant->n1.n2.n3.lVal ); - break; - - #ifndef HB_LONG_LONG_OFF - case VT_BYREF | VT_I8: - hb_itemPutNLL( pItem, ( LONGLONG ) *pVariant->n1.n2.n3.pllVal ); - break; - #endif - - #ifndef HB_LONG_LONG_OFF - case VT_I8: - hb_itemPutNLL( pItem, ( LONGLONG ) pVariant->n1.n2.n3.llVal ); - break; - #endif - - case VT_BYREF | VT_R8: - hb_itemPutND( pItem, *pVariant->n1.n2.n3.pdblVal ); - break; - - case VT_R8: - hb_itemPutND( pItem, pVariant->n1.n2.n3.dblVal ); - break; - - case VT_BYREF | VT_DATE: - hb_itemPutDL( pItem, (long) ( *( pVariant->n1.n2.n3.pdblVal ) ) + 2415019 ); - break; - - case VT_DATE: - hb_itemPutDL( pItem, (long) (pVariant->n1.n2.n3.dblVal) + 2415019 ); - break; - - case VT_BYREF | VT_EMPTY: - case VT_EMPTY: - hb_itemClear( pItem ); - break; - - case VT_BYREF | VT_VARIANT: - hb_oleItemToVariant( pVariant->n1.n2.n3.pvarVal, pItem ); - break; - - default: - if( (VARTYPE) ( pVariant->n1.n2.vt & ( VT_BYREF | VT_ARRAY ) ) == (VARTYPE) ( VT_BYREF | VT_ARRAY ) ) - { - VARTYPE vt; - PHB_ITEM pArray; - UINT iDims = SafeArrayGetDim( *pVariant->n1.n2.n3.pparray ); - long *rgIndices = (long *) hb_xgrab( sizeof(long) * iDims ); - - vt = pVariant->n1.n2.vt; - vt &= ~VT_ARRAY; - vt &= ~VT_BYREF; - - pArray = SafeArrayToArray( *pVariant->n1.n2.n3.pparray, iDims, rgIndices, vt ); - - hb_xfree( (void *) rgIndices ); - - hb_itemForwardValue( pItem, pArray ); - hb_itemRelease( pArray ); - } - else - { - TraceLog( NULL, "Unexpected type %p in: %s(%i)!\n", pVariant->n1.n2.vt, __FILE__, __LINE__ ); - } - } - } - else - { - if( pVariant->n1.n2.vt & VT_BYREF ) - { - TraceLog( NULL, "Unexpected type %p in: %s(%i)!\n", pVariant->n1.n2.vt, __FILE__, __LINE__ ); - } - } - - VariantClear( &(pDispParams->rgvarg[ n ] ) ); - } - - hb_xfree( ( LPVOID ) pDispParams->rgvarg ); - hb_xfree( ( LPVOID ) aPrgParams ); - } - } - - //---------------------------------------------------------------------------// - static PHB_ITEM SafeArrayToArray( SAFEARRAY *parray, UINT iDim, long* rgIndices, VARTYPE vt ) - { - long iFrom, iTo, iLen, i; - PHB_ITEM pArray = hb_itemNew( NULL );; - - if( parray == NULL ) - { - hb_arrayNew( pArray, 0 ); - return pArray; - } - - SafeArrayGetLBound( parray, iDim, &iFrom ); - SafeArrayGetUBound( parray, iDim, &iTo ); - - iLen = iTo - iFrom + 1; - - if( iDim > 1 ) - { - PHB_ITEM pSubArray; - - hb_arrayNew( pArray, iLen ); - - for( i = iFrom; i <= iTo; i++ ) - { - rgIndices[ iDim - 1 ] = i; - - //printf( " Sub: %i\n", i ); - - pSubArray = SafeArrayToArray( parray, iDim - 1, rgIndices, vt ); - hb_arraySetForward( pArray, i - iFrom + 1, pSubArray ); - hb_itemRelease( pSubArray ); - } - } - else - { - VARIANT mElem; - void *pTarget; - char *sArray = NULL; - - VariantInit( &mElem ); - - if( vt == VT_VARIANT ) - { - hb_arrayNew( pArray, iLen ); - - pTarget = &mElem; - } - else - { - if( vt == VT_I1 || vt == VT_UI1 ) - { - // Ugly hack, but needed to allocate our signature as hidden bytes! - hb_itemPutCL( pArray, NULL, 0 ); - HB_STRING_ALLOC( pArray, (ULONG)(iLen + 5) ); - pArray->item.asString.length = iLen; - - sArray = hb_itemGetCPtr( pArray ); - - sArray[ iLen ] = 0x7A; - sArray[ iLen + 1 ] = 0x7B; - sArray[ iLen + 2 ] = 0x7C; - sArray[ iLen + 3 ] = 0x7D; - sArray[ iLen + 4 ] = (char)(vt); - - pTarget = NULL; - } - else - { - hb_arrayNew( pArray, iLen ); - - pTarget = &mElem.n1.n2.n3.cVal; - } - } - - for( i = iFrom; i <= iTo; i++ ) - { - rgIndices[ iDim - 1 ] = i; - - if( vt != VT_VARIANT ) - { - // Get cleared on VariantClear() - don't place out of loop! - mElem.n1.n2.vt = vt; - - if( vt == VT_I1 || vt == VT_UI1 ) - { - SafeArrayGetElement( parray, rgIndices, &( sArray[ i - iFrom ] ) ); - - continue; - } - } - - if( SUCCEEDED( SafeArrayGetElement( parray, rgIndices, pTarget ) ) ) - { - //TraceLog( NULL, "Type: %p in: %s(%i)\n", mElem.n1.n2.vt, __FILE__, __LINE__ ); - - hb_oleVariantToItem( pArray->item.asArray.value->pItems + ( i - iFrom ), &mElem ); - - VariantClear( &mElem ); - } - } - } - - //TraceLog( NULL, "Return len: %i\n", pArray->item.asArray.value->ulLen ); - - // Wrap our array with VTArrayWrapper() class ( aArray := VTArrayWrapper( vt, aArray) ) - if( HB_IS_ARRAY( pArray ) && vt != VT_VARIANT ) - { - PHB_ITEM pVT = hb_itemPutNL( hb_itemNew( NULL ), (LONG) vt ); - - hb_vmPushSymbol( s_pSym_VTArrayWrapper->pSymbol ); - hb_vmPushNil(); - hb_itemPushForward( pVT ); - hb_itemPushForward( pArray ); - hb_vmDo( 2 ); - - hb_itemForwardValue( pArray, hb_stackReturnItem() ); - - hb_itemRelease( pVT ); - } - - return pArray; - } - - //---------------------------------------------------------------------------// - HRESULT hb_oleVariantToItem( PHB_ITEM pItem, VARIANT *pVariant ) - { - PHB_ITEM pOleAuto; - IUnknown *pUnk = NULL; - IDispatch *pDisp = NULL; - SAFEARRAY *parray;// = NULL; - - hb_itemClear( pItem ); - - // Don't "optimize" (VT_ARRAY | VT_VARIANT) must not match! - while( pVariant->n1.n2.vt == ( VT_BYREF | VT_VARIANT ) || pVariant->n1.n2.vt == VT_VARIANT || pVariant->n1.n2.vt == VT_BYREF ) - { - pVariant = pVariant->n1.n2.n3.pvarVal; - } - - switch( pVariant->n1.n2.vt ) - { - case VT_BSTR | VT_BYREF: - case VT_BSTR: - { - char *sString; - - if( pVariant->n1.n2.vt & VT_BYREF ) - { - sString = hb_oleWideToAnsi( *pVariant->n1.n2.n3.pbstrVal ); - } - else - { - sString = hb_oleWideToAnsi( pVariant->n1.n2.n3.bstrVal ); - } - - if( sString ) - { - hb_itemPutCPtr( pItem, sString, strlen( sString ) ); - } - else - { - hb_itemPutC( pItem, NULL ); - } - - break; - } - - case VT_BOOL | VT_BYREF: - hb_itemPutL( pItem, *pVariant->n1.n2.n3.pboolVal == VARIANT_FALSE ? FALSE : TRUE ); - break; - - case VT_BOOL: - hb_itemPutL( pItem, pVariant->n1.n2.n3.boolVal == VARIANT_FALSE ? FALSE : TRUE ); - break; - - case ( VT_UNKNOWN | VT_BYREF ): - pUnk = *pVariant->n1.n2.n3.ppunkVal; - // Intentionally fall through - - case VT_UNKNOWN: - if( pVariant->n1.n2.vt == VT_UNKNOWN ) - { - pUnk = pVariant->n1.n2.n3.punkVal; - } - - if( pUnk ) - { - IDispatch ** pDispPtr = &pDisp; - pUnk->lpVtbl->QueryInterface( pUnk, (REFIID) &IID_IDispatch, (void **) pDispPtr ); - } - // Intentionally fall through - - case ( VT_DISPATCH | VT_BYREF ): - if( pVariant->n1.n2.vt == ( VT_DISPATCH | VT_BYREF ) ) - { - pDisp = *pVariant->n1.n2.n3.ppdispVal; - } - // Intentionally fall through - - case VT_DISPATCH: - if( pVariant->n1.n2.vt == VT_DISPATCH ) - { - pDisp = pVariant->n1.n2.n3.pdispVal; - } - - if( pDisp == NULL ) - { - if( pUnk ) - { - PHB_ITEM pVT = hb_itemPutNL( hb_itemNew( NULL ), (LONG) pVariant->n1.n2.vt ); - PHB_ITEM pUnknown = hb_itemPutPtr( hb_itemNew( NULL ), (void *) pUnk ); - - hb_vmPushSymbol( s_pSym_VTWrapper->pSymbol ); - hb_vmPushNil(); - hb_itemPushForward( pVT ); - hb_itemPushForward( pUnknown ); - hb_vmDo( 2 ); - - if( pItem != hb_stackReturnItem() ) - { - hb_itemForwardValue( pItem, hb_stackReturnItem() ); - } - - hb_itemRelease( pVT ); - hb_itemRelease( pUnknown ); - } - - break; - } - - pOleAuto = hb_itemNew( NULL ); - - hb_vmPushSymbol( s_pSym_TOleAuto->pSymbol ); - hb_vmPushNil(); - hb_vmDo( 0 ); - - // Safety! - hb_vmRequestReset(); - - hb_itemForwardValue( pOleAuto, hb_stackReturnItem() ); - - if( pOleAuto->type ) - { - //TOleAuto():New( nDispatch ) - hb_vmPushSymbol( s_pSym_New->pSymbol ); - hb_itemPushForward( pOleAuto ); - hb_vmPushLong( ( LONG ) pDisp ); - hb_vmSend( 1 ); - - // If retrieved from IUnknown than doubly added! - if( pVariant->n1.n2.vt == VT_UNKNOWN || pVariant->n1.n2.vt == ( VT_UNKNOWN | VT_BYREF ) ) - { - pDisp->lpVtbl->Release( pDisp ); - } - - hb_itemRelease( pOleAuto ); - - // Safety! - hb_vmRequestReset(); - - if( pItem != hb_stackReturnItem() ) - { - hb_itemForwardValue( pItem, hb_stackReturnItem() ); - } - - //printf( "Dispatch: %ld %ld\n", ( LONG ) pDisp, (LONG) hb_stackReturnItem()->item.asArray.value ); - } - break; - - case VT_I1 | VT_BYREF: // Byte - case VT_UI1 | VT_BYREF: - hb_itemPutNI( pItem, ( short ) *pVariant->n1.n2.n3.pbVal ); - break; - - case VT_I1: // Byte - case VT_UI1: - hb_itemPutNI( pItem, ( short ) pVariant->n1.n2.n3.bVal ); - break; - - case VT_I2 | VT_BYREF: // Short (2 bytes) - case VT_UI2 | VT_BYREF: - hb_itemPutNI( pItem, ( short ) *pVariant->n1.n2.n3.piVal ); - break; - - case VT_I2: // Short (2 bytes) - case VT_UI2: - hb_itemPutNI( pItem, ( short ) pVariant->n1.n2.n3.iVal ); - break; - - case VT_I4 | VT_BYREF: // Long (4 bytes) - case VT_UI4 | VT_BYREF: - case VT_INT | VT_BYREF: - case VT_UINT | VT_BYREF: - hb_itemPutNL( pItem, ( LONG ) *pVariant->n1.n2.n3.plVal ); - break; - - case VT_I4: // Long (4 bytes) - case VT_UI4: - case VT_INT: - case VT_UINT: - hb_itemPutNL( pItem, ( LONG ) pVariant->n1.n2.n3.lVal ); - break; - - case VT_R4 | VT_BYREF: // Single - hb_itemPutND( pItem, *pVariant->n1.n2.n3.pfltVal ); - break; - - case VT_R4: // Single - hb_itemPutND( pItem, pVariant->n1.n2.n3.fltVal ); - break; - - case VT_R8 | VT_BYREF: // Double - hb_itemPutND( pItem, *pVariant->n1.n2.n3.pdblVal ); - break; - - case VT_R8: // Double - hb_itemPutND( pItem, pVariant->n1.n2.n3.dblVal ); - break; - - case VT_CY | VT_BYREF: // Currency - case VT_CY: // Currency - { - double tmp = 0; - - if( pVariant->n1.n2.vt & VT_BYREF ) - { - VarR8FromCy( *pVariant->n1.n2.n3.pcyVal, &tmp ); - } - else - { - VarR8FromCy( pVariant->n1.n2.n3.cyVal, &tmp ); - } - - hb_itemPutND( pItem, tmp ); - break; - } - - case VT_DECIMAL | VT_BYREF: // Decimal - case VT_DECIMAL: // Decimal - { - double tmp = 0; - - if( pVariant->n1.n2.vt & VT_BYREF ) - { - VarR8FromDec( pVariant->n1.n2.n3.pdecVal, &tmp ); - } - else - { - VarR8FromDec( &pVariant->n1.decVal, &tmp ); - } - - hb_itemPutND( pItem, tmp ); - break; - } - - case VT_DATE | VT_BYREF: - hb_itemPutDL( pItem, (long) ( *pVariant->n1.n2.n3.pdblVal ) + 2415019 ); - break; - - case VT_DATE: - hb_itemPutDL( pItem, (long) ( pVariant->n1.n2.n3.dblVal ) + 2415019 ); - break; - - case VT_EMPTY | VT_BYREF: - case VT_NULL | VT_BYREF: - case VT_EMPTY: - case VT_NULL: - break; - - /* - case VT_VARIANT: - hb_oleVariantToItem( pItem, pVariant->n1.n2.n3.pvarVal ); - break; - */ - - case VT_PTR: - hb_itemPutPtr( pItem, pVariant->n1.n2.n3.byref ); - break; - - default: - if( pVariant->n1.n2.vt & VT_ARRAY ) - { - UINT iDims; - long * rgIndices; - PHB_ITEM pArray; - VARTYPE vt; - - if( pVariant->n1.n2.vt & VT_BYREF ) - { - parray = *pVariant->n1.n2.n3.pparray; - } - else - { - parray = pVariant->n1.n2.n3.parray; - } - - if( parray ) - { - iDims = SafeArrayGetDim( parray ); - rgIndices = (long *) hb_xgrab( sizeof(long) * iDims ); - - vt = pVariant->n1.n2.vt; - vt &= ~VT_ARRAY; - vt &= ~VT_BYREF; - - //TraceLog( NULL, "Type: %p in: %s(%i)\n", vt, __FILE__, __LINE__ ); - - pArray = SafeArrayToArray( parray, iDims, rgIndices, vt ); - - hb_xfree( (void *) rgIndices ); - - hb_itemForwardValue( pItem, pArray ); - hb_itemRelease( pArray ); - } - else - { - hb_arrayNew( pItem, 0 ); - } - } - else - { - TraceLog( NULL, "Unexpected type %p in: %s(%i)!\n", pVariant->n1.n2.vt, __FILE__, __LINE__ ); - return E_FAIL; - } - } - - //VariantClear( pVariant ); - - return S_OK; - } - - //---------------------------------------------------------------------------// - static void RetValue( void ) - { - hb_oleVariantToItem( hb_stackReturnItem(), &RetVal ); - - VariantClear( &RetVal ); - - return; - } - - HB_FUNC( __OLEENUMNEXT ) - { - IEnumVARIANT *pEnumVariant = ( IEnumVARIANT * ) hb_parptr( 1 ); - ULONG *pcElementFetched = NULL; - - if( pEnumVariant->lpVtbl->Next( pEnumVariant, 1, &RetVal, pcElementFetched ) == S_OK ) - { - hb_oleVariantToItem( hb_stackReturnItem(), &RetVal ); - VariantClear( &RetVal ); - hb_storl( TRUE, 2 ); - } - else - hb_storl( FALSE, 2 ); - } - - HB_FUNC( __OLEENUMSTOP ) - { - IEnumVARIANT *pEnumVariant = ( IEnumVARIANT * ) hb_parptr( 1 ); - pEnumVariant->lpVtbl->Release( pEnumVariant ); - } - - //---------------------------------------------------------------------------// - HB_FUNC( OLESHOWEXCEPTION ) - { - if( (LONG) s_nOleError == DISP_E_EXCEPTION ) - { - LPSTR source, description; - - source = hb_oleWideToAnsi( excep.bstrSource ); - description = hb_oleWideToAnsi( excep.bstrDescription ); - - MessageBox( NULL, description, source, MB_ICONHAND ); - - hb_xfree( source ); - hb_xfree( description ); - } - } - - //---------------------------------------------------------------------------// - HB_FUNC( OLEEXCEPTIONSOURCE ) - { - if( (LONG) s_nOleError == DISP_E_EXCEPTION ) - { - LPSTR source; - - source = hb_oleWideToAnsi( excep.bstrSource ); - hb_retcAdopt( source ); - } - } - - //---------------------------------------------------------------------------// - HB_FUNC( OLEEXCEPTIONDESCRIPTION ) - { - if( (LONG) s_nOleError == DISP_E_EXCEPTION ) - { - LPSTR description; - - description = hb_oleWideToAnsi( excep.bstrDescription ); - hb_retcAdopt( description ); - } - } - - //---------------------------------------------------------------------------// - HB_FUNC( OLEERROR ) - { - hb_retnl( (LONG) s_nOleError ); - } - - //---------------------------------------------------------------------------// - static char * Ole2TxtError( void ) - { - switch( (LONG) s_nOleError ) - { - case S_OK: - return "S_OK"; - - case CO_E_CLASSSTRING: - return "CO_E_CLASSSTRING"; - - case OLE_E_WRONGCOMPOBJ: - return "OLE_E_WRONGCOMPOBJ"; - - case REGDB_E_CLASSNOTREG: - return "REGDB_E_CLASSNOTREG"; - - case REGDB_E_WRITEREGDB: - return "REGDB_E_WRITEREGDB"; - - case E_FAIL: - return "E_FAIL"; - - case E_OUTOFMEMORY: - return "E_OUTOFMEMORY"; - - case E_NOTIMPL: - return "E_NOTIMPL"; - - case E_INVALIDARG: - return "E_INVALIDARG"; - - case E_UNEXPECTED: - return "E_UNEXPECTED"; - - case DISP_E_UNKNOWNNAME: - return "DISP_E_UNKNOWNNAME"; - - case DISP_E_UNKNOWNLCID: - return "DISP_E_UNKNOWNLCID"; - - case DISP_E_BADPARAMCOUNT: - return "DISP_E_BADPARAMCOUNT"; - - case DISP_E_BADVARTYPE: - return "DISP_E_BADVARTYPE"; - - case DISP_E_EXCEPTION: - return "DISP_E_EXCEPTION"; - - case DISP_E_MEMBERNOTFOUND: - return "DISP_E_MEMBERNOTFOUND"; - - case DISP_E_NONAMEDARGS: - return "DISP_E_NONAMEDARGS"; - - case DISP_E_OVERFLOW: - return "DISP_E_OVERFLOW"; - - case DISP_E_PARAMNOTFOUND: - return "DISP_E_PARAMNOTFOUND"; - - case DISP_E_TYPEMISMATCH: - return "DISP_E_TYPEMISMATCH"; - - case DISP_E_UNKNOWNINTERFACE: - return "DISP_E_UNKNOWNINTERFACE"; - - case DISP_E_PARAMNOTOPTIONAL: - return "DISP_E_PARAMNOTOPTIONAL"; - - case CO_E_SERVER_EXEC_FAILURE: - return "CO_E_SERVER_EXEC_FAILURE"; - - case MK_E_UNAVAILABLE: - return "MK_E_UNAVAILABLE"; - - default: - TraceLog( NULL, "TOleAuto Error %p\n", s_nOleError ); - return "Unknown error"; - }; - } - - //---------------------------------------------------------------------------// - HB_FUNC( OLE2TXTERROR ) - { - hb_retc( Ole2TxtError() ); - } - - //---------------------------------------------------------------------------// - HB_FUNC( MESSAGEBOX ) - { - hb_retni( MessageBox( ( HWND ) hb_parnl( 1 ), hb_parcx( 2 ), hb_parcx( 3 ), hb_parni( 4 ) ) ); - } - - //---------------------------------------------------------------------------// - HB_FUNC( CREATEOLEOBJECT ) // ( cOleName | cCLSID [, cIID ] ) - { - BSTR bstrClassID; - IID ClassID, iid; - LPIID riid = (LPIID) &IID_IDispatch; - void *pDisp = NULL; // IDispatch - /* void * - * used intentionally to inform compiler that there is no - * strict-aliasing - */ - bstrClassID = hb_oleAnsiToSysString( hb_parcx( 1 ) ); - - if( hb_parcx( 1 )[ 0 ] == '{' ) - { - s_nOleError = CLSIDFromString( bstrClassID, (LPCLSID) &ClassID ); - } - else - { - s_nOleError = CLSIDFromProgID( bstrClassID, (LPCLSID) &ClassID ); - } - - SysFreeString( bstrClassID ); - - //TraceLog( NULL, "Result: %p\n", s_nOleError ); - - if( hb_pcount() == 2 ) - { - if( hb_parcx( 2 )[ 0 ] == '{' ) - { - bstrClassID = hb_oleAnsiToSysString( hb_parcx( 2 ) ); - s_nOleError = CLSIDFromString( bstrClassID, &iid ); - SysFreeString( bstrClassID ); - } - else - { - memcpy( ( LPVOID ) &iid, hb_parcx( 2 ), sizeof( iid ) ); - } - - riid = &iid; - } - - if( SUCCEEDED( s_nOleError ) ) - { - //TraceLog( NULL, "Class: %i\n", ClassID ); - s_nOleError = CoCreateInstance( (REFCLSID) &ClassID, NULL, CLSCTX_SERVER, (REFIID) riid, &pDisp ); - //TraceLog( NULL, "Result: %p\n", s_nOleError ); - } - - hb_retnl( ( LONG ) pDisp ); - } - - //---------------------------------------------------------------------------// - HB_FUNC( GETOLEOBJECT ) // ( cOleName | cCLSID [, cIID ] ) - { - BSTR bstrClassID; - IID ClassID, iid; - LPIID riid = (LPIID) &IID_IDispatch; - IUnknown *pUnk = NULL; - void *pDisp = NULL; // IDispatch - /* void * - * used intentionally to inform compiler that there is no - * strict-aliasing - */ - - bstrClassID = hb_oleAnsiToSysString( hb_parcx( 1 ) ); - - if( hb_parcx( 1 )[ 0 ] == '{' ) - { - s_nOleError = CLSIDFromString( bstrClassID, (LPCLSID) &ClassID ); - } - else - { - s_nOleError = CLSIDFromProgID( bstrClassID, (LPCLSID) &ClassID ); - } - - //s_nOleError = ProgIDFromCLSID( &ClassID, &pOleStr ); - //wprintf( L"Result %i ProgID: '%s'\n", s_nOleError, pOleStr ); - - SysFreeString( bstrClassID ); - - if( hb_pcount() == 2 ) - { - if( hb_parcx( 2 )[ 0 ] == '{' ) - { - bstrClassID = hb_oleAnsiToSysString( hb_parcx( 2 ) ); - s_nOleError = CLSIDFromString( bstrClassID, &iid ); - SysFreeString( bstrClassID ); - } - else - { - memcpy( ( LPVOID ) &iid, hb_parcx( 2 ), sizeof( iid ) ); - } - - riid = &iid; - } - - if( SUCCEEDED( s_nOleError ) ) - { - s_nOleError = GetActiveObject( (REFCLSID) &ClassID, NULL, &pUnk ); - - if( SUCCEEDED( s_nOleError ) ) - { - s_nOleError = pUnk->lpVtbl->QueryInterface( pUnk, (REFIID) riid, &pDisp ); - - pUnk->lpVtbl->Release( pUnk ); - - if( SUCCEEDED( s_nOleError ) ) - { - hb_retnl( ( LONG ) pDisp ); - } - } - } - } - - //---------------------------------------------------------------------------// - HB_FUNC( OLEADDREF ) // (hOleObject, szMethodName, uParams...) - { - IDispatch *pDisp = ( IDispatch * ) hb_parnl( 1 ); - - //TraceLog( NULL, "OleAddRef( %p )\n", pDisp ); - - s_nOleError = pDisp->lpVtbl->AddRef( pDisp ); - - hb_retnl( s_nOleError ); - } - - //---------------------------------------------------------------------------// - HB_FUNC( OLERELEASEOBJECT ) // (hOleObject, szMethodName, uParams...) - { - IDispatch *pDisp = ( IDispatch * ) hb_parnl( 1 ); - - //TraceLog( NULL, "OleReleaseObject( %p )\n", pDisp ); - - s_nOleError = pDisp->lpVtbl->Release( pDisp ); - - hb_retnl( s_nOleError ); - } - - //---------------------------------------------------------------------------// - static HRESULT OleSetProperty( IDispatch *pDisp, DISPID DispID, DISPPARAMS *pDispParams ) - { - pDispParams->rgdispidNamedArgs = &lPropPut; - pDispParams->cNamedArgs = 1; - - // 1 Based!!! - if( ( ISBYREF( 1 ) ) || ISARRAY( 1 ) ) - { - memset( (LPBYTE) &excep, 0, sizeof( excep ) ); - - s_nOleError = pDisp->lpVtbl->Invoke( pDisp, - DispID, - (REFIID) &IID_NULL, - LOCALE_SYSTEM_DEFAULT, - DISPATCH_PROPERTYPUTREF, - pDispParams, - NULL, // No return value - &excep, - &uArgErr ); - - if( SUCCEEDED( s_nOleError ) ) - { - return s_nOleError; - } - } - - memset( (LPBYTE) &excep, 0, sizeof( excep ) ); - - s_nOleError = pDisp->lpVtbl->Invoke( pDisp, - DispID, - (REFIID) &IID_NULL, - LOCALE_SYSTEM_DEFAULT, - DISPATCH_PROPERTYPUT, - pDispParams, - NULL, // No return value - &excep, - &uArgErr ); - - pDispParams->rgdispidNamedArgs = NULL; - pDispParams->cNamedArgs = 0; - - return s_nOleError; - } - - //---------------------------------------------------------------------------// - static HRESULT OleInvoke( IDispatch *pDisp, DISPID DispID, DISPPARAMS *pDispParams ) - { - memset( (LPBYTE) &excep, 0, sizeof( excep ) ); - - s_nOleError = pDisp->lpVtbl->Invoke( pDisp, - DispID, - (REFIID) &IID_NULL, - LOCALE_SYSTEM_DEFAULT, - DISPATCH_METHOD, - pDispParams, - &RetVal, - &excep, - &uArgErr ); - - return s_nOleError; - } - - //---------------------------------------------------------------------------// - static HRESULT OleGetProperty( IDispatch *pDisp, DISPID DispID, DISPPARAMS *pDispParams ) - { - memset( (LPBYTE) &excep, 0, sizeof( excep ) ); - - s_nOleError = pDisp->lpVtbl->Invoke( pDisp, - DispID, - (REFIID) &IID_NULL, - LOCALE_SYSTEM_DEFAULT, - DISPATCH_PROPERTYGET, - pDispParams, - &RetVal, - &excep, - &uArgErr ); - - //TraceLog( NULL, "OleGetValue: %p\n", s_nOleError ); - - return s_nOleError; - } - - //---------------------------------------------------------------------------// - static HRESULT OleGetValue( IDispatch *pDisp ) - { - VariantClear( &RetVal ); - - // Try to apply the requested message to the DEFAULT Property of the object if any. - if( SUCCEEDED( OleGetProperty( pDisp, DISPID_VALUE, &s_EmptyDispParams ) ) && ( RetVal.n1.n2.vt == VT_DISPATCH || RetVal.n1.n2.vt == ( VT_DISPATCH | VT_BYREF ) ) ) - { - VariantCopy( &OleVal, &RetVal ); - VariantClear( &RetVal ); - - return s_nOleError; - } - - return E_FAIL; - } - - //---------------------------------------------------------------------------// - static void OleThrowError( void ) - { - PHB_ITEM pReturn; - char *sDescription; - - hb_vmPushSymbol( s_pSym_cClassName->pSymbol ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - - if( s_nOleError == DISP_E_EXCEPTION ) - { - // Intentional to avoid report of memory leak if fatal error. - char *sTemp = hb_oleWideToAnsi( excep.bstrDescription ); - sDescription = (char *) malloc( strlen( sTemp ) + 1 ); - strcpy( sDescription, sTemp ); - hb_xfree( sTemp ); - } - else - { - sDescription = Ole2TxtError(); - } - - //TraceLog( NULL, "Desc: '%s'\n", sDescription ); - - pReturn = hb_errRT_SubstParams( hb_parcx( -1 ), EG_OLEEXECPTION, (ULONG) s_nOleError, sDescription, hb_itemGetSymbol( hb_stackBaseItem() )->szName ); - - if( s_nOleError == DISP_E_EXCEPTION ) - { - free( (void *) sDescription ); - } - - if( pReturn ) - { - hb_itemRelease( hb_itemReturn( pReturn ) ); - } - } - - //---------------------------------------------------------------------------// - HB_FUNC( TOLEAUTO_OLEVALUE ) - { - if( hb_pcount() == 0 ) - { - IDispatch *pDisp; - - hb_vmPushSymbol( s_pSym_hObj->pSymbol ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - - pDisp = ( IDispatch * ) hb_parnl( -1 ); - - VariantClear( &RetVal ); - - OleGetProperty( pDisp, DISPID_VALUE, &s_EmptyDispParams ); - //TraceLog( NULL, "GetDefault: %p\n", s_nOleError ); - - if( SUCCEEDED( s_nOleError ) ) - { - RetValue(); - } - else - { - OleThrowError(); - } - } - } - - //---------------------------------------------------------------------------// - HB_FUNC( TOLEAUTO__OLEVALUE ) - { - if( hb_pcount() >= 1 ) - { - IDispatch *pDisp; - DISPPARAMS DispParams; - PHB_ITEM *aPrgParams; - - hb_vmPushSymbol( s_pSym_hObj->pSymbol ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - - pDisp = ( IDispatch * ) hb_parnl( -1 ); - - VariantClear( &RetVal ); - - aPrgParams = GetParams( &DispParams, 0 ); - - OleSetProperty( pDisp, DISPID_VALUE, &DispParams ); - //TraceLog( NULL, "SetDefault: %p\n", s_nOleError ); - - FreeParams( &DispParams, aPrgParams ); - - if( SUCCEEDED( s_nOleError ) ) - { - hb_itemReturn( hb_stackItemFromBase( 1 ) ); - } - else - { - OleThrowError(); - } - } - } - - //---------------------------------------------------------------------------// - - HB_FUNC( TOLEAUTO_OLENEWENUMERATOR ) // (hOleObject, szMethodName, uParams...) - { - IDispatch *pDisp; - - hb_vmPushSymbol( s_pSym_hObj->pSymbol ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - - pDisp = ( IDispatch * ) hb_parnl( -1 ); - - VariantClear( &RetVal ); - - if( SUCCEEDED( OleGetProperty( pDisp, DISPID_NEWENUM, &s_EmptyDispParams ) ) || - SUCCEEDED( OleInvoke( pDisp, DISPID_NEWENUM, &s_EmptyDispParams ) ) ) - { - LPVOID pEnumVariant = NULL; /* IEnumVARIANT */ - - if( RetVal.n1.n2.vt == ( VT_UNKNOWN | VT_BYREF ) ) - { - s_nOleError = (*RetVal.n1.n2.n3.ppunkVal)->lpVtbl->QueryInterface( *RetVal.n1.n2.n3.ppunkVal, (REFIID) &IID_IEnumVARIANT, &pEnumVariant ); - } - else if( RetVal.n1.n2.vt == VT_UNKNOWN ) - { - s_nOleError = RetVal.n1.n2.n3.punkVal->lpVtbl->QueryInterface( RetVal.n1.n2.n3.punkVal, (REFIID) &IID_IEnumVARIANT, &pEnumVariant ); - } - else if( RetVal.n1.n2.vt == ( VT_DISPATCH | VT_BYREF ) ) - { - s_nOleError = (*RetVal.n1.n2.n3.ppdispVal)->lpVtbl->QueryInterface( *RetVal.n1.n2.n3.ppdispVal, (REFIID) &IID_IEnumVARIANT, &pEnumVariant ); - } - else if( RetVal.n1.n2.vt == VT_DISPATCH ) - { - s_nOleError = RetVal.n1.n2.n3.pdispVal->lpVtbl->QueryInterface( RetVal.n1.n2.n3.pdispVal, (REFIID) &IID_IEnumVARIANT, &pEnumVariant ); - } - else - { - s_nOleError = E_FAIL; - } - - VariantClear( &RetVal ); - - if( SUCCEEDED( s_nOleError ) ) - { - hb_retptr( pEnumVariant ); - } - else - { - hb_ret(); - } - } - else - { - OleThrowError(); - } - } - - //---------------------------------------------------------------------------// - static HRESULT OleGetID( IDispatch *pDisp, const char *szName, DISPID *pDispID, BOOL *pbSetFirst ) - { - BSTR bstrMessage; - - if( pbSetFirst ) - { - *pbSetFirst = FALSE; - } - - /* - if( strcmp( szName, "OLEVALUE" ) == 0 || strcmp( szName, "_OLEVALUE" ) == 0 ) - { - DispID = DISPID_VALUE; - s_nOleError = S_OK; - } - else*/ if( szName[0] == '_' && szName[1] && hb_pcount() >= 1 ) - { - bstrMessage = hb_oleAnsiToSysString( szName + 1 ); - s_nOleError = pDisp->lpVtbl->GetIDsOfNames( pDisp, (REFIID) &IID_NULL, (wchar_t **) &bstrMessage, 1, LOCALE_SYSTEM_DEFAULT, pDispID ); - SysFreeString( bstrMessage ); - //TraceLog( NULL, "1. ID of: '%s' -> %i Result: %p\n", hb_itemGetSymbol( hb_stackBaseItem() )->szName + 1, DispID, s_nOleError ); - - if( SUCCEEDED( s_nOleError ) ) - { - if( pbSetFirst ) - { - *pbSetFirst = TRUE; - } - } - } - else - { - s_nOleError = E_PENDING; - } - - if( FAILED( s_nOleError ) ) - { - // Try again without removing the assign prefix (_). - bstrMessage = hb_oleAnsiToSysString( szName ); - s_nOleError = pDisp->lpVtbl->GetIDsOfNames( pDisp, (REFIID) &IID_NULL, (wchar_t **) &bstrMessage, 1, 0, pDispID ); - SysFreeString( bstrMessage ); - //TraceLog( NULL, "2. ID of: '%s' -> %i Result: %p\n", szName, *pDispID, s_nOleError ); - } - - return s_nOleError; - } - - //---------------------------------------------------------------------------// - HB_FUNC( TOLEAUTO_INVOKE ) - { - IDispatch *pDisp; - char *szName = hb_parc(1); - DISPID DispID; - DISPPARAMS DispParams; - - hb_vmPushSymbol( s_pSym_hObj->pSymbol ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - - pDisp = ( IDispatch * ) hb_parnl( -1 ); - - if( szName && SUCCEEDED( OleGetID( pDisp, szName, &DispID, NULL ) ) ) - { - PHB_ITEM *aPrgParams = GetParams( &DispParams, 1 ); - - if( SUCCEEDED( OleInvoke( pDisp, DispID, &DispParams ) ) ) - { - RetValue(); - } - - FreeParams( &DispParams, aPrgParams ); - } - } - - //---------------------------------------------------------------------------// - HB_FUNC( TOLEAUTO_SET ) - { - IDispatch *pDisp; - char *szName = hb_parc(1); - DISPID DispID; - DISPPARAMS DispParams; - - hb_vmPushSymbol( s_pSym_hObj->pSymbol ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - pDisp = ( IDispatch * ) hb_parnl( -1 ); - - if( szName && SUCCEEDED( OleGetID( pDisp, szName, &DispID, NULL ) ) ) - { - PHB_ITEM *aPrgParams = GetParams( &DispParams, 1 ); - - if( SUCCEEDED( OleSetProperty( pDisp, DispID, &DispParams ) ) ) - { - RetValue(); - } - - FreeParams( &DispParams, aPrgParams ); - } - } - - //---------------------------------------------------------------------------// - HB_FUNC( TOLEAUTO_GET ) - { - IDispatch *pDisp; - char *szName = hb_parc(1); - DISPID DispID; - DISPPARAMS DispParams; - - hb_vmPushSymbol( s_pSym_hObj->pSymbol ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - pDisp = ( IDispatch * ) hb_parnl( -1 ); - - if( szName && SUCCEEDED( OleGetID( pDisp, szName, &DispID, NULL ) ) ) - { - PHB_ITEM *aPrgParams = GetParams( &DispParams, 1 ); - - if( SUCCEEDED( OleGetProperty( pDisp, DispID, &DispParams ) ) ) - { - RetValue(); - } - - FreeParams( &DispParams, aPrgParams ); - } - } - - //---------------------------------------------------------------------------// - HB_FUNC( TOLEAUTO_ONERROR ) - { - IDispatch *pDisp; - DISPID DispID; - DISPPARAMS DispParams; - BOOL bSetFirst = FALSE, bTryDefault = TRUE; - PHB_ITEM *aPrgParams = GetParams( &DispParams, 0 ); - - //TraceLog( NULL, "Class: '%s' Message: '%s', Params: %i Arg1: %i\n", hb_objGetClsName( hb_stackSelfItem() ), hb_itemGetSymbol( hb_stackBaseItem() )->szName, hb_pcount(), hb_parinfo(1) ); - - hb_vmPushSymbol( s_pSym_hObj->pSymbol ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - pDisp = ( IDispatch * ) hb_parnl( -1 ); - - OleGetID : - - if( SUCCEEDED( OleGetID( pDisp, hb_itemGetSymbol( hb_stackBaseItem() )->szName, &DispID, &bSetFirst ) ) ) - { - VariantClear( &RetVal ); - - if( bSetFirst ) - { - if( SUCCEEDED( OleSetProperty( pDisp, DispID, &DispParams ) ) ) - { - hb_itemReturn( hb_stackItemFromBase( 1 ) ); - } - - //TraceLog( NULL, "FIRST OleSetProperty %i\n", s_nOleError ); - } - else - { - s_nOleError = E_PENDING; - } - - if( FAILED( s_nOleError ) ) - { - if( SUCCEEDED( OleInvoke( pDisp, DispID, &DispParams ) ) ) - { - RetValue(); - } - - //TraceLog( NULL, "OleInvoke %i\n", s_nOleError ); - } - - if( FAILED( s_nOleError ) ) - { - if( SUCCEEDED( OleGetProperty( pDisp, DispID, &DispParams ) ) ) - { - RetValue(); - } - - //TraceLog( NULL, "OleGetProperty(%i) %i\n", DispParams.cArgs, s_nOleError ); - } - - if( FAILED( s_nOleError ) && bSetFirst == FALSE && hb_pcount() >= 1 ) - { - if( SUCCEEDED( OleSetProperty( pDisp, DispID, &DispParams ) ) ) - { - hb_itemReturn( hb_stackItemFromBase( 1 ) ); - } - - //TraceLog( NULL, "OleSetProperty %i\n", s_nOleError ); - } - } - - if( SUCCEEDED( s_nOleError ) ) - { - //TraceLog( NULL, "Invoke Succeeded!\n" ); - if( HB_IS_OBJECT( hb_stackReturnItem() ) && hb_clsIsParent( hb_stackReturnItem()->item.asArray.value->uiClass , "TOLEAUTO" ) ) - { - PHB_ITEM pReturn = hb_itemNew( NULL ); - PHB_ITEM pOleClassName = hb_itemNew( NULL ); - char *sOleClassName; - int iClassNameLen, iMsgNameLen; - - hb_itemForwardValue( pReturn, hb_stackReturnItem() ); - - hb_vmPushSymbol( s_pSym_cClassName->pSymbol ); - hb_vmPush( hb_stackSelfItem() ); - hb_vmSend( 0 ); - - iClassNameLen = hb_parclen( -1 ); - iMsgNameLen = strlen( hb_itemGetSymbol( hb_stackBaseItem() )->szName ); - - sOleClassName = (char *) hb_xgrab( iClassNameLen + 1 + iMsgNameLen + 1 ); - - strncpy( sOleClassName, hb_parc( - 1 ), iClassNameLen ); - sOleClassName[ iClassNameLen ] = ':'; - strcpy( sOleClassName + iClassNameLen + 1, hb_itemGetSymbol( hb_stackBaseItem() )->szName ); - - //TraceLog( NULL, "Class: '%s'\n", sOleClassName ); - - hb_itemPutCPtr( pOleClassName, sOleClassName, iClassNameLen + 1 + iMsgNameLen ); - - hb_vmPushSymbol( s_pSym_cClassName->pSymbol ); - hb_vmPush( pReturn ); - hb_itemPushForward( pOleClassName ); - hb_vmSend( 1 ); - - hb_itemReturnForward( pReturn ); - - hb_itemRelease( pReturn ); - hb_itemRelease( pOleClassName ); - } - } - else - { - // Try to apply the requested message to the DEFAULT Method of the object if any. - if( bTryDefault ) - { - if( SUCCEEDED( ( /* s_nOleError = */ OleGetValue( pDisp ) ) ) ) - { - bTryDefault = FALSE; - - //TraceLog( NULL, "Try using DISPID_VALUE\n" ); - pDisp = OleVal.n1.n2.n3.pdispVal; - goto OleGetID; - } - } - - //TraceLog( NULL, "Invoke Failed!\n" ); - OleThrowError(); - } - - FreeParams( &DispParams, aPrgParams ); - - // We are responsible to release the Default Interface which we retrieved - if( bTryDefault == FALSE && pDisp ) - { - pDisp->lpVtbl->Release( pDisp ); - } - } diff --git a/harbour/contrib/ole2/win32ole.prg b/harbour/contrib/ole2/win32ole.prg deleted file mode 100644 index dd31c87673..0000000000 --- a/harbour/contrib/ole2/win32ole.prg +++ /dev/null @@ -1,677 +0,0 @@ -/* - * $Id$ - */ - -/* - * Copyright 2002 José F. Giménez (JFG) - - * Ron Pinkas - - * - * www - http://www.xharbour.org - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). - * - * As a special exception, the xHarbour Project gives permission for - * additional uses of the text contained in its release of xHarbour. - * - * The exception is that, if you link the xHarbour libraries with other - * files to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the xHarbour library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the xHarbour - * Project under the name xHarbour. If you copy code from other - * xHarbour Project or Free Software Foundation releases into a copy of - * xHarbour, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. - * - * If you write modifications of your own for xHarbour, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. - * - */ - -#ifndef __PLATFORM__Windows - Function CreateObject() - Return NIL - - FUNCTION GetActiveObject() - Return NIL -#else - -#define HB_CLS_NOTOBJECT - -#include "common.ch" -#include "hbclass.ch" -#include "error.ch" - -#ifndef __XHARBOUR__ - -#define EG_OLEEXECPTION 1001 - -#xcommand TRY => BEGIN SEQUENCE WITH s_bBreak -#xcommand CATCH [] => RECOVER [USING ] <-oErr-> -#xcommand FINALLY => ALWAYS - -static s_bBreak := { |oErr| break( oErr ) } - -STATIC PROCEDURE THROW( oError ) - LOCAL lError := Eval( ErrorBlock(), oError ) - IF !HB_ISLOGICAL( lError ) .OR. lError - __ErrInHandler() - ENDIF - Break( oError ) -RETURN - -#endif - -//----------------------------------------------------------------------------// - -FUNCTION CreateObject( cString ) - -RETURN TOleAuto():New( cString ) - -//----------------------------------------------------------------------------// - -FUNCTION GetActiveObject( cString ) - -RETURN TOleAuto():GetActiveObject( cString ) - -//----------------------------------------------------------------------------// - -init PROCEDURE HB_OleInit() - - /* It's important to store value returned by __HB_OLE_INIT() in - * STATIC variable. When HVM will clear STATICs on HVM exit - * then it will execute destructor bound with this variable which - * calls OleUninitialize() - such method causes that OleUninitialize() - * will be called very lately after or user EXIT functions, ALWAYS - * blocks and .prg object destructors which may also use OLE. - */ - static s_ole - - s_ole := __HB_OLE_INIT() - -RETURN - -//----------------------------------------------------------------------------// - -CLASS VTWrapper - DATA vt - DATA Value - - METHOD New( vt, xVal ) CONSTRUCTOR -ENDCLASS - -//----------------------------------------------------------------------------// -METHOD New( vt, xVal ) CLASS VTWrapper - - ::vt := vt - ::Value := xVal - - //TraceLog( vt, ::vt, xVal, ::Value ) - -RETURN Self - -//----------------------------------------------------------------------------// -CLASS VTArrayWrapper FROM VTWrapper - - METHOD AsArray( nIndex, xValue ) OPERATOR "[]" - METHOD __enumStart( enum, lDescend ) - -ENDCLASS - -//----------------------------------------------------------------------------// -METHOD AsArray( nIndex, xValue ) CLASS VTArrayWrapper - -RETURN IIF( PCount() == 1, ::Value[nIndex], ::Value[nIndex] := xValue ) - -//----------------------------------------------------------------------------// -METHOD __enumStart( enum, lDescend ) CLASS VTarrayWrapper - - HB_SYMBOL_UNUSED( lDescend ) - - /* set base value for enumerator */ - (@enum):__enumBase( ::Value ) - -RETURN !Empty( ::Value ) - -//----------------------------------------------------------------------------// -CLASS TOleAuto - - DATA hObj - DATA cClassName - DATA pOleEnumerator - - METHOD New( uObj, cClass ) CONSTRUCTOR - METHOD GetActiveObject( cClass ) CONSTRUCTOR - - METHOD Invoke() - MESSAGE CallMethod METHOD Invoke() - - METHOD Set() - MESSAGE SetProperty METHOD Set() - - METHOD Get() - MESSAGE GetProperty METHOD Get() - - METHOD OleValue() - METHOD _OleValue( xSetValue ) - - METHOD OleNewEnumerator() - - METHOD OleCollection( xIndex, xValue ) OPERATOR "[]" - - METHOD OleValuePlus( xArg ) OPERATOR "+" - METHOD OleValueMinus( xArg ) OPERATOR "-" - METHOD OleValueMultiply( xArg ) OPERATOR "*" - METHOD OleValueDivide( xArg ) OPERATOR "/" - METHOD OleValueModulus( xArg ) OPERATOR "%" - METHOD OleValueInc() OPERATOR "++" - METHOD OleValueDec() OPERATOR "--" - METHOD OleValuePower( xArg ) OPERATOR "^" - - METHOD OleValueEqual( xArg ) OPERATOR "=" - METHOD OleValueExactEqual( xArg ) OPERATOR "==" - METHOD OleValueNotEqual( xArg ) OPERATOR "!=" - - METHOD __enumStart( enum, lDescend ) - METHOD __enumSkip( enum, lDescend ) - METHOD __enumStop() - - ERROR HANDLER OnError() - - DESTRUCTOR Release() - - // Needed to refernce, or hb_dynsymFindName() will fail - METHOD ForceSymbols() INLINE ::cClassName() - -ENDCLASS - -//-------------------------------------------------------------------- -METHOD New( uObj, cClass ) CLASS TOleAuto - - LOCAL oErr - - // Hack incase OLE Server already created and New() is attempted as an OLE Method. - IF ::hObj != NIL - RETURN HB_ExecFromArray( Self, "_New", HB_aParams() ) - ENDIF - - IF ValType( uObj ) = 'C' - ::hObj := CreateOleObject( uObj ) - - IF OleError() != 0 - IF Ole2TxtError() == "DISP_E_EXCEPTION" - oErr := ErrorNew() - oErr:Args := HB_aParams() - oErr:CanDefault := .F. - oErr:CanRetry := .F. - oErr:CanSubstitute := .T. - oErr:Description := OLEExceptionDescription() - oErr:GenCode := EG_OLEEXECPTION - oErr:Operation := ProcName() - oErr:Severity := ES_ERROR - oErr:SubCode := -1 - oErr:SubSystem := OLEExceptionSource() - - RETURN Throw( oErr ) - ELSE - oErr := ErrorNew() - oErr:Args := HB_aParams() - oErr:CanDefault := .F. - oErr:CanRetry := .F. - oErr:CanSubstitute := .T. - oErr:Description := Ole2TxtError() - oErr:GenCode := EG_OLEEXECPTION - oErr:Operation := ProcName() - oErr:Severity := ES_ERROR - oErr:SubCode := -1 - oErr:SubSystem := "TOleAuto" - - RETURN Throw( oErr ) - ENDIF - ENDIF - - ::cClassName := uObj - ELSEIF ValType( uObj ) = 'N' - OleAddRef( uObj ) - ::hObj := uObj - - IF ValType( cClass ) == 'C' - ::cClassName := cClass - ELSE - ::cClassName := LTrim( Str( uObj ) ) - ENDIF - ELSE - oErr := ErrorNew() - oErr:Args := HB_aParams() - oErr:CanDefault := .F. - oErr:CanRetry := .F. - oErr:CanSubstitute := .T. - oErr:Description := "Invalid argument to contrustor!" - oErr:GenCode := 0 - oErr:Operation := ProcName() - oErr:Severity := ES_ERROR - oErr:SubCode := -1 - oErr:SubSystem := "TOleAuto" - - RETURN Throw( oErr ) - ENDIF - -RETURN Self - -//-------------------------------------------------------------------- -// Destructor! -PROCEDURE Release() CLASS TOleAuto - - //TraceLog( ::cClassName, ::hObj ) - - IF ! Empty( ::hObj ) - //TraceLog( ::cClassName, ::hObj ) - OleReleaseObject( ::hObj ) - //::hObj := NIL - ENDIF - -RETURN - -//-------------------------------------------------------------------- -METHOD GetActiveObject( cClass ) CLASS TOleAuto - - LOCAL oErr - - IF ValType( cClass ) = 'C' - ::hObj := GetOleObject( cClass ) - - IF OleError() != 0 - IF Ole2TxtError() == "DISP_E_EXCEPTION" - oErr := ErrorNew() - oErr:Args := { cClass } - oErr:CanDefault := .F. - oErr:CanRetry := .F. - oErr:CanSubstitute := .T. - oErr:Description := OLEExceptionDescription() - oErr:GenCode := EG_OLEEXECPTION - oErr:Operation := ProcName() - oErr:Severity := ES_ERROR - oErr:SubCode := -1 - oErr:SubSystem := OLEExceptionSource() - - RETURN Throw( oErr ) - ELSE - oErr := ErrorNew() - oErr:Args := { cClass } - oErr:CanDefault := .F. - oErr:CanRetry := .F. - oErr:CanSubstitute := .T. - oErr:Description := Ole2TxtError() - oErr:GenCode := EG_OLEEXECPTION - oErr:Operation := ProcName() - oErr:Severity := ES_ERROR - oErr:SubCode := -1 - oErr:SubSystem := "TOleAuto" - - RETURN Throw( oErr ) - ENDIF - ENDIF - - ::cClassName := cClass - ELSE - MessageBox( 0, "Invalid parameter type to constructor TOleAuto():GetActiveObject()!", "OLE Interface", 0 ) - ::hObj := 0 - ENDIF - -RETURN Self - -//-------------------------------------------------------------------- -METHOD OleCollection( xIndex, xValue ) CLASS TOleAuto - - LOCAL xRet - - //TraceLog( PCount(), xIndex, xValue ) - - IF PCount() == 1 - RETURN ::Item( xIndex ) - ENDIF - - IF ValType( xIndex ) == 'N' .AND. xIndex < 0 - xIndex += ( ::Count + 1 ) - ENDIF - - TRY - // ASP Collection syntax. - xRet := ::_Item( xIndex, xValue ) - CATCH - xRet := ::SetItem( xIndex, xValue ) - END - -RETURN xRet - -//-------------------------------------------------------------------- -METHOD OleValuePlus( xArg ) CLASS TOleAuto - - LOCAL xRet, oErr - - TRY - xRet := ::OleValue + xArg - CATCH - oErr := ErrorNew() - oErr:Args := { Self, xArg } - oErr:CanDefault := .F. - oErr:CanRetry := .F. - oErr:CanSubstitute := .T. - oErr:Description := "argument error" - oErr:GenCode := EG_ARG - oErr:Operation := '+' - oErr:Severity := ES_ERROR - oErr:SubCode := 1081 - oErr:SubSystem := "BASE" - - RETURN Throw( oErr ) - END - -RETURN xRet - -//-------------------------------------------------------------------- -METHOD OleValueMinus( xArg ) CLASS TOleAuto - - LOCAL xRet, oErr - - TRY - xRet := ::OleValue - xArg - CATCH - oErr := ErrorNew() - oErr:Args := { Self, xArg } - oErr:CanDefault := .F. - oErr:CanRetry := .F. - oErr:CanSubstitute := .T. - oErr:Description := "argument error" - oErr:GenCode := EG_ARG - oErr:Operation := '+' - oErr:Severity := ES_ERROR - oErr:SubCode := 1082 - oErr:SubSystem := "BASE" - - RETURN Throw( oErr ) - END - -RETURN xRet - -//-------------------------------------------------------------------- -METHOD OleValueMultiply( xArg ) CLASS TOleAuto - - LOCAL xRet, oErr - - TRY - xRet := ::OleValue * xArg - CATCH - oErr := ErrorNew() - oErr:Args := { Self, xArg } - oErr:CanDefault := .F. - oErr:CanRetry := .F. - oErr:CanSubstitute := .T. - oErr:Description := "argument error" - oErr:GenCode := EG_ARG - oErr:Operation := '*' - oErr:Severity := ES_ERROR - oErr:SubCode := 1083 - oErr:SubSystem := "BASE" - - RETURN Throw( oErr ) - END - -RETURN xRet - -//-------------------------------------------------------------------- -METHOD OleValueDivide( xArg ) CLASS TOleAuto - - LOCAL xRet, oErr - - TRY - xRet := ::OleValue / xArg - CATCH - oErr := ErrorNew() - oErr:Args := { Self, xArg } - oErr:CanDefault := .F. - oErr:CanRetry := .F. - oErr:CanSubstitute := .T. - oErr:Description := "argument error" - oErr:GenCode := EG_ARG - oErr:Operation := '/' - oErr:Severity := ES_ERROR - oErr:SubCode := 1084 - oErr:SubSystem := "BASE" - - RETURN Throw( oErr ) - END - -RETURN xRet - -//-------------------------------------------------------------------- -METHOD OleValueModulus( xArg ) CLASS TOleAuto - - LOCAL xRet, oErr - - TRY - xRet := ::OleValue % xArg - CATCH - oErr := ErrorNew() - oErr:Args := { Self, xArg } - oErr:CanDefault := .F. - oErr:CanRetry := .F. - oErr:CanSubstitute := .T. - oErr:Description := "argument error" - oErr:GenCode := EG_ARG - oErr:Operation := '%' - oErr:Severity := ES_ERROR - oErr:SubCode := 1085 - oErr:SubSystem := "BASE" - - RETURN Throw( oErr ) - END - -RETURN xRet - -//-------------------------------------------------------------------- -METHOD OleValueInc() CLASS TOleAuto - - LOCAL oErr - - TRY - ++::OleValue - CATCH - oErr := ErrorNew() - oErr:Args := { Self } - oErr:CanDefault := .F. - oErr:CanRetry := .F. - oErr:CanSubstitute := .T. - oErr:Description := "argument error" - oErr:GenCode := EG_ARG - oErr:Operation := '++' - oErr:Severity := ES_ERROR - oErr:SubCode := 1086 - oErr:SubSystem := "BASE" - - RETURN Throw( oErr ) - END - -RETURN Self - -//-------------------------------------------------------------------- -METHOD OleValueDec() CLASS TOleAuto - - LOCAL oErr - - TRY - --::OleValue - CATCH - oErr := ErrorNew() - oErr:Args := { Self } - oErr:CanDefault := .F. - oErr:CanRetry := .F. - oErr:CanSubstitute := .T. - oErr:Description := "argument error" - oErr:GenCode := EG_ARG - oErr:Operation := '--' - oErr:Severity := ES_ERROR - oErr:SubCode := 1087 - oErr:SubSystem := "BASE" - - RETURN Throw( oErr ) - END - -RETURN Self - -//-------------------------------------------------------------------- -METHOD OleValuePower( xArg ) CLASS TOleAuto - - LOCAL xRet, oErr - - TRY - xRet := ::OleValue ^ xArg - CATCH - oErr := ErrorNew() - oErr:Args := { Self, xArg } - oErr:CanDefault := .F. - oErr:CanRetry := .F. - oErr:CanSubstitute := .T. - oErr:Description := "argument error" - oErr:GenCode := EG_ARG - oErr:Operation := '^' - oErr:Severity := ES_ERROR - oErr:SubCode := 1088 - oErr:SubSystem := "BASE" - - RETURN Throw( oErr ) - END - -RETURN xRet - -//-------------------------------------------------------------------- -METHOD OleValueEqual( xArg ) CLASS TOleAuto - - LOCAL xRet, oErr - - TRY - xRet := ::OleValue = xArg - CATCH - oErr := ErrorNew() - oErr:Args := { Self, xArg } - oErr:CanDefault := .F. - oErr:CanRetry := .F. - oErr:CanSubstitute := .T. - oErr:Description := "argument error" - oErr:GenCode := EG_ARG - oErr:Operation := '=' - oErr:Severity := ES_ERROR - oErr:SubCode := 1085 - oErr:SubSystem := "BASE" - - RETURN Throw( oErr ) - END - -RETURN xRet - -//-------------------------------------------------------------------- -METHOD OleValueExactEqual( xArg ) CLASS TOleAuto - - LOCAL xRet, oErr - - TRY - xRet := ::OleValue == xArg - CATCH - oErr := ErrorNew() - oErr:Args := { Self, xArg } - oErr:CanDefault := .F. - oErr:CanRetry := .F. - oErr:CanSubstitute := .T. - oErr:Description := "argument error" - oErr:GenCode := EG_ARG - oErr:Operation := '==' - oErr:Severity := ES_ERROR - oErr:SubCode := 1085 - oErr:SubSystem := "BASE" - - RETURN Throw( oErr ) - END - -RETURN xRet - -//-------------------------------------------------------------------- -METHOD OleValueNotEqual( xArg ) CLASS TOleAuto - - LOCAL xRet, oErr - - TRY - xRet := ::OleValue != xArg - CATCH - oErr := ErrorNew() - oErr:Args := { Self, xArg } - oErr:CanDefault := .F. - oErr:CanRetry := .F. - oErr:CanSubstitute := .T. - oErr:Description := "argument error" - oErr:GenCode := EG_ARG - oErr:Operation := '!=' - oErr:Severity := ES_ERROR - oErr:SubCode := 1085 - oErr:SubSystem := "BASE" - - RETURN Throw( oErr ) - END - -RETURN xRet - -//-------------------------------------------------------------------- - -METHOD __enumStart( enum, lDescend ) CLASS TOleAuto - - /* TODO: add support for descend order */ - ::pOleEnumerator := ::OleNewEnumerator() - -RETURN ::__enumSkip( @enum, lDescend ) - -//-------------------------------------------------------------------- - -METHOD __enumSkip( enum, lDescend ) CLASS TOleAuto - - LOCAL lContinue, xValue - - /* TODO: add support for descend order */ - HB_SYMBOL_UNUSED( lDescend ) - - xValue := __OLEENUMNEXT( ::pOleEnumerator, @lContinue ) - - /* set enumerator value */ - (@enum):__enumValue( xValue ) - -RETURN lContinue - -//-------------------------------------------------------------------- - -METHOD PROCEDURE __enumStop() CLASS TOleAuto - - __OLEENUMSTOP( ::pOleEnumerator ) - ::pOleEnumerator := NIL - -RETURN - -#endif diff --git a/harbour/contrib/win32prn/Makefile b/harbour/contrib/win32prn/Makefile deleted file mode 100644 index 5cc4200394..0000000000 --- a/harbour/contrib/win32prn/Makefile +++ /dev/null @@ -1,16 +0,0 @@ -# -# $Id$ -# - -ROOT = ../../ - -C_SOURCES=\ - tprinter.c \ - w32_papi.c \ - -PRG_SOURCES=\ - w32_pcls.prg \ - -LIBNAME=hbwin32prn - -include $(TOP)$(ROOT)config/lib.cf diff --git a/harbour/contrib/win32prn/make_b32.bat b/harbour/contrib/win32prn/make_b32.bat deleted file mode 100644 index c9cc003ded..0000000000 --- a/harbour/contrib/win32prn/make_b32.bat +++ /dev/null @@ -1,34 +0,0 @@ -@echo off -rem -rem $Id$ -rem - -if "%1" == "clean" goto CLEAN -if "%1" == "CLEAN" goto CLEAN - -:BUILD - - make -fmakefile.bc %1 %2 %3 > make_b32.log - if errorlevel 1 goto BUILD_ERR - -:BUILD_OK - - copy ..\..\lib\b32\hbwin32prn.lib ..\..\lib\*.* > nul - if exist ..\..\lib\b32\hbwin32prn.bak del ..\..\lib\b32\hbwin32prn.bak - goto EXIT - -:BUILD_ERR - - notepad make_b32.log - goto EXIT - -:CLEAN - if exist ..\..\lib\b32\hbwin32prn.lib del ..\..\lib\b32\hbwin32prn.lib - if exist ..\..\lib\b32\hbwin32prn.bak del ..\..\lib\b32\hbwin32prn.bak - if exist ..\..\obj\b32\w32_papi.obj del ..\..\obj\b32\w32_papi.obj - if exist ..\..\obj\b32\w32_pcls.obj del ..\..\obj\b32\w32_pcls.obj - if exist ..\..\obj\b32\tprinter.obj del ..\..\obj\b32\tprinter.obj - - goto EXIT - -:EXIT diff --git a/harbour/contrib/win32prn/make_vc.bat b/harbour/contrib/win32prn/make_vc.bat deleted file mode 100644 index 95bbba68dd..0000000000 --- a/harbour/contrib/win32prn/make_vc.bat +++ /dev/null @@ -1,21 +0,0 @@ -@echo off -rem -rem $Id$ -rem - -:BUILD - - nmake /f makefile.vc %1 %2 %3 > make_vc.log - if errorlevel 1 goto BUILD_ERR - -:BUILD_OK - - copy ..\..\lib\vc\hbwin32prn.lib ..\..\lib\*.* >nul - goto EXIT - -:BUILD_ERR - - notepad make_vc.log - -:EXIT - diff --git a/harbour/contrib/win32prn/makefile.bc b/harbour/contrib/win32prn/makefile.bc deleted file mode 100644 index e3d4a9764f..0000000000 --- a/harbour/contrib/win32prn/makefile.bc +++ /dev/null @@ -1,112 +0,0 @@ -# -# $Id$ -# - -# -# Makefile for Harbour Project for Borland C/C++ 3.x, 4.x, 5.x compilers -# - -# -# NOTE: You can use these envvars to configure the make process: -# (note that these are all optional) -# -# CFLAGS - Extra C compiler options for libraries and for -# executables -# C_USR - Extra C compiler options for libraries and for -# executables (GNU make compatible envvar) -# CLIBFLAGS - Extra C compiler options for the libraries -# HARBOURFLAGS - Extra Harbour compiler options -# PRG_USR - Extra Harbour compiler options -# (GNU make compatible envvar) -# - -# -# NOTE: "echo." intentionally used instead of "echo", to avoid conflicts -# with external commands named echo. -# - -CC = bcc32 -AS = tasm32 - -BIN_DIR = ..\..\bin\b32 -OBJ_DIR = ..\..\obj\b32 -LIB_DIR = ..\..\lib\b32 - -# This is needed, otherwise the libs may overflow when -# debug info is requested with -v -y -ARFLAGS = /P32 - -!if !$d(BCC_NOOPTIM) -CFLAGS = -O2 $(CFLAGS) -!endif - -# -# Directory macros. These should never have to change. -# - -INCLUDE_DIR = ..\..\include -TOOLS_DIR = . - -# -# C compiler definition and C flags. These should never have to change. -# - -CFLAGS = -I$(INCLUDE_DIR) -d $(C_USR) $(CFLAGS) -CLIBFLAGS = -c $(CFLAGS) $(CLIBFLAGS) -CLIBFLAGSDEBUG = -v $(CLIBFLAGS) -HARBOURFLAGS = -i$(INCLUDE_DIR) -n -q0 -w2 -es2 -gc0 $(PRG_USR) $(HARBOURFLAGS) -LDFLAGS = $(LDFLAGS) - -# -# Macros to access our library names -# - -TOOLS_LIB = $(LIB_DIR)\hbwin32prn.lib - -HARBOUR_EXE = $(BIN_DIR)\harbour.exe - -# -# Rules -# - -# -# TOOLS.LIB rules -# - -TOOLS_LIB_OBJS = \ - $(OBJ_DIR)\tprinter.obj \ - $(OBJ_DIR)\w32_papi.obj \ - \ - $(OBJ_DIR)\w32_pcls.obj \ - -# -# Our default target -# - -all: \ - $(TOOLS_LIB) \ - -# -# Library dependencies and build rules -# - -$(TOOLS_LIB) : $(TOOLS_LIB_OBJS) - -# -# TOOLS.LIB dependencies -# - -$(OBJ_DIR)\tprinter.obj : $(TOOLS_DIR)\tprinter.c - $(CC) $(CLIBFLAGS) -o$@ $** - tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, - -$(OBJ_DIR)\w32_papi.obj : $(TOOLS_DIR)\w32_papi.c - $(CC) $(CLIBFLAGS) -o$@ $** - tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, - -$(OBJ_DIR)\w32_pcls.c : $(TOOLS_DIR)\w32_pcls.prg - $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ - -$(OBJ_DIR)\w32_pcls.obj : $(OBJ_DIR)\w32_pcls.c - $(CC) $(CLIBFLAGS) -o$@ $** - tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, diff --git a/harbour/contrib/win32prn/makefile.vc b/harbour/contrib/win32prn/makefile.vc deleted file mode 100644 index 9f1d10cdac..0000000000 --- a/harbour/contrib/win32prn/makefile.vc +++ /dev/null @@ -1,141 +0,0 @@ -# -# $Id$ -# - -# -# Makefile for Harbour Project for Microsoft Visual C (32 bits) -# - -# -# NOTE: You can use these envvars to configure the make process: -# (note that these are all optional) -# -# CFLAGS - Extra C compiler options for libraries and for -# executables -# C_USR - Extra C compiler options for libraries and for -# executables (GNU make compatible envvar) -# CLIBFLAGS - Extra C compiler options for the libraries -# HARBOURFLAGS - Extra Harbour compiler options -# PRG_USR - Extra Harbour compiler options -# (GNU make compatible envvar) -# - -# -# Notes about this makefile: -# -# 1. To add new files to a dependancy list, add an obj name to one of the -# OBJ lists for the appropriate library. -# NOTE: put .prg related obj's last in the lib list. -# -# 2. This is a recursive script. If you change the name of this file, -# be sure to change MK_FILE (a few lines down) to the new name as well. -# -# 3. Recurrsion rules are quite simple: -# If you specifiy /a on the command line, files in the obj\vc dir -# will be deleted, and when nmake recurses, it's without the /a flag -# -# If a .prg.obj rule is fired, nmake will execute this script with -# a specific target as a parameter immediatley after compiling a given -# set of prg files. -# ie: Harbour $< -# nmake /fmakefile.vc obj\vc\rtl.lib2 -# which will simply get make to re-evaluate the dependancy list for the -# lib, and as a result, it will execute the C compiler using the .c.obj -# rule below to create the obj's for the prg's that were created just -# prior to the recurrsive call. Once the obj's are created, the -# recurrsion is complete. -# See additional notes under RTL.LIB below. -# - -MK_FILE = makefile.vc -MK_FLAGS = $(MAKEFLAGS: =) - -OBJ_DIR = ..\..\obj\vc -LIB_DIR = ..\..\lib\vc -BIN_DIR = ..\..\bin - -# -# Directory macros. These should never have to change. -# - -INCLUDE_DIR = ..\..\include -TOOLS_DIR = . - -# -# C compiler definition and C flags. These should never have to change. -# - -AS = masm -CFLAGS = -I$(INCLUDE_DIR) -TP -W3 -nologo $(C_USR) $(CFLAGS) -CLIBFLAGS = -c $(CFLAGS) $(CLIBFLAGS) -CLIBFLAGSDEBUG = -Zi $(CLIBFLAGS) -HARBOURFLAGS = -i$(INCLUDE_DIR) -n -q0 -w2 -es2 -gc0 $(PRG_USR) $(HARBOURFLAGS) -LDFLAGS = $(LDFLAGS) - -# -# Macros to access our library names -# - -TOOLS_LIB = $(LIB_DIR)\hbwin32prn.lib - -HARBOUR_EXE = $(BIN_DIR)\harbour.exe - -# -# Rules -# - -.SUFFIXES: .prg .lib .c .obj .asm - -# override builtin - -.c.obj:: - $(CC) $(CLIBFLAGS) -Fo$(OBJ_DIR)\ $< - -# -# -# - -LIBLIST = \ - $(TOOLS_LIB) - -# -# TOOLS.LIB rules -# - -{$(TOOLS_DIR)}.c{$(OBJ_DIR)}.obj:: - $(CC) $(CLIBFLAGS) -Fo$(OBJ_DIR)\ $< - -{$(TOOLS_DIR)}.prg{$(OBJ_DIR)}.obj:: - $(HARBOUR_EXE) $(HARBOURFLAGS) -o$(OBJ_DIR)\ $< - $(MAKE) -nologo /$(MK_FLAGS) /f$(MK_FILE) $(TOOLS_LIB)2 - -TOOLS_LIB_OBJS = \ - $(OBJ_DIR)\tprinter.obj \ - $(OBJ_DIR)\w32_papi.obj \ - \ - $(OBJ_DIR)\w32_pcls.obj \ - -# -# Our default target -# - - -all: \ - $(TOOLS_LIB) - -CLEAN: - -@if exist $(OBJ_DIR)\tprinter.* del $(OBJ_DIR)\tprinter.* - -@if exist $(OBJ_DIR)\w32_papi.* del $(OBJ_DIR)\w32_papi.* - -@if exist $(OBJ_DIR)\w32_pcls.* del $(OBJ_DIR)\w32_pcls.* - -@if exist $(TOOLS_LIB) del $(TOOLS_LIB) - -# -# Library dependencies and build rules -# - -$(TOOLS_LIB) : $(TOOLS_LIB_OBJS) - lib /out:$@ $** - -# dummy targets used for prg to c creation - -$(TOOLS_LIB)2 : $(TOOLS_LIB_OBJS) diff --git a/harbour/contrib/win32prn/testw32p.prg b/harbour/contrib/win32prn/testw32p.prg deleted file mode 100644 index 5755b96f58..0000000000 --- a/harbour/contrib/win32prn/testw32p.prg +++ /dev/null @@ -1,154 +0,0 @@ -/* - * $Id$ - */ - -#define FORM_A4 9 - -#define PS_SOLID 0 - -#define RGB( nR,nG,nB ) ( nR + ( nG * 256 ) + ( nB * 256 * 256 ) ) - -#define BLACK RGB( 0x0 ,0x0 ,0x0 ) -#define BLUE RGB( 0x0 ,0x0 ,0x85 ) -#define GREEN RGB( 0x0 ,0x85,0x0 ) -#define CYAN RGB( 0x0 ,0x85,0x85 ) -#define RED RGB( 0x85,0x0 ,0x0 ) -#define MAGENTA RGB( 0x85,0x0 ,0x85 ) -#define BROWN RGB( 0x85,0x85,0x0 ) -#define WHITE RGB( 0xC6,0xC6,0xC6 ) - -FUNCTION Main() - LOCAL nPrn:=1, cBMPFile:= SPACE( 40 ) - LOCAL aPrn:= GetPrinters() - LOCAL GetList:= {} - CLS - IF EMPTY(aPrn) - Alert("No printers installed - Cannot continue") - QUIT - ENDIF - DO WHILE !EMPTY(nPrn) - CLS - @ 0,0 SAY 'Win32Prn() Class test program. Choose a printer to test' - @ 1,0 SAY 'Bitmap file name' GET cBMPFile PICT '@!K' - READ - @ 2,0 TO maxRow(),maxCol() - nPrn:= ACHOICE(3,1,maxRow()-1,maxCol()-1,aPrn,.T.,,nPrn) - IF !EMPTY(nPrn) - PrnTest(aPrn[nPrn], cBMPFile) - ENDIF - ENDDO - RETURN(NIL) - -STATIC FUNCTION PrnTest(cPrinter, cBMPFile) - LOCAL oPrinter:= Win32Prn():New(cPrinter), aFonts, x, nColFixed, nColTTF, nColCharSet - oPrinter:Landscape:= .F. - oPrinter:FormType := FORM_A4 - oPrinter:Copies := 1 - IF !oPrinter:Create() - Alert("Cannot Create Printer") - ELSE - IF !oPrinter:startDoc('Win32Prn(Doc name in Printer Properties)') - Alert("StartDoc() failed") - ELSE - oPrinter:SetPen(PS_SOLID, 1, RED) - oPrinter:Bold(800) - oPrinter:TextOut(oPrinter:PrinterName+': MaxRow() = '+STR(oPrinter:MaxRow(),4)+' MaxCol() = '+STR(oPrinter:MaxCol(),4)) - oPrinter:Bold(0) // Normal - oPrinter:NewLine() - oPrinter:TextOut(' Partial list of available fonts that are available for OEM_') - oPrinter:NewLine() - oPrinter:UnderLine(.T.) - oPrinter:Italic(.T.) -// oPrinter:SetFont('Courier New',7,{3,-50}) // Compressed print - nColFixed:= 40 * oPrinter:CharWidth - nColTTF := 48 * oPrinter:CharWidth - nColCharSet := 60 * oPrinter:CharWidth - oPrinter:TextOut('FontName') - oPrinter:SetPos(nColFixed) - oPrinter:TextOut('Fixed?') - oPrinter:SetPos(nColTTF) - oPrinter:TextOut('TrueType?') - oPrinter:SetPos(nColCharset) - oPrinter:TextOut('CharSet#',.T.) - oPrinter:NewLine() - oPrinter:Italic(.F.) - oPrinter:UnderLine(.F.) - aFonts:= oPrinter:GetFonts() - oPrinter:NewLine() - FOR x:= 1 TO LEN(aFonts) STEP 2 - oPrinter:CharSet(aFonts[x,4]) - IF oPrinter:SetFont(aFonts[x,1]) // Could use "IF oPrinter:SetFontOk" after call to oPrinter:SetFont() - IF oPrinter:FontName == aFonts[x,1] // Make sure Windows didn't pick a different font - oPrinter:TextOut(aFonts[x,1]) - oPrinter:SetPos(nColFixed) - oPrinter:TextOut(IIF(aFonts[x,2],'Yes','No')) - oPrinter:SetPos(nColTTF) - oPrinter:TextOut(IIF(aFonts[x,3],'Yes','No')) - oPrinter:SetPos(nColCharSet) - oPrinter:TextOut(STR(aFonts[x,4],5)) - oPrinter:SetPos(oPrinter:LeftMargin, oPrinter:PosY + (oPrinter:CharHeight*2)) - IF oPrinter:PRow() > oPrinter:MaxRow() - 10 // Could use "oPrinter:NewPage()" to start a new page - EXIT - ENDIF - ENDIF - ENDIF - oPrinter:Line(0, oPrinter:PosY+5, 2000, oPrinter:PosY+5) - NEXT x - oPrinter:SetFont('Lucida Console',8,{3,-50}) // Alternative Compressed print - oPrinter:CharSet(0) // Reset default charset - oPrinter:Bold(800) - oPrinter:NewLine() - oPrinter:TextOut('This is on line'+STR(oPrinter:Prow(),4)+', Printed bold, ' ) - oPrinter:TextOut(' finishing at Column: ') - oPrinter:TextOut(STR(oPrinter:Pcol(),4)) - oPrinter:SetPrc(oPrinter:Prow()+3, 0) - oPrinter:Bold(0) - oPrinter:TextOut("Notice: UNDERLINE only prints correctly if there is a blank line after",.T.) - oPrinter:TextOut(" it. This is because of ::LineHeight and the next line",.T.) - oPrinter:TextOut(" printing over top of the underline. To avoid this happening",.T.) - oPrinter:TextOut(" you can to alter ::LineHeight or use a smaller font") - oPrinter:NewLine() - oPrinter:NewLine() - oPrinter:SetFont('Lucida Console',18, 0) // Large print - oPrinter:SetColor( GREEN ) - oPrinter:TextOut("Finally some larger print") - oPrinter:Box( 0, oPrinter:PosY+100, 100, oPrinter:PosY+200) - oPrinter:Arc(200, oPrinter:PosY+100, 300, oPrinter:PosY+200) - oPrinter:Ellipse(400, oPrinter:PosY+100, 500, oPrinter:PosY+200) - oPrinter:FillRect(600, oPrinter:PosY+100, 700, oPrinter:PosY+200, RED) - -// To print a barcode; -// Replace 'BCod39HN' with your own bar code font or any other font -// oPrinter:TextAtFont( oPrinter:MM_TO_POSX( 30 ) , oPrinter:MM_TO_POSY(60 ), '1234567890', 'BCod39HN', 24, 0 ) -// - PrintBitMap( oPrinter, cBMPFile ) - - oPrinter:EndDoc() - ENDIF - oPrinter:Destroy() - ENDIF - RETURN(NIL) - - -procedure PrintBitMap( oPrn, cBitFile ) - LOCAL oBMP - - IF EMPTY( cBitFile ) - * - ELSEIF !FILE( cBitFile ) - Alert( cBitFile + ' not found ' ) - ELSE - oBMP:= Win32BMP():new() - IF oBmp:loadFile( cBitFile ) - - oBmp:Draw( oPrn, { 200,200, 2000, 1500 } ) - - // Note: Can also use this method to print bitmap - // oBmp:Rect:= { 200,2000, 2000, 1500 } - // oPrn:DrawBitMap( oBmp ) - - ENDIF - oBMP:Destroy() - ENDIF - RETURN - diff --git a/harbour/contrib/win32prn/tprinter.c b/harbour/contrib/win32prn/tprinter.c deleted file mode 100644 index 016ebc4ef8..0000000000 --- a/harbour/contrib/win32prn/tprinter.c +++ /dev/null @@ -1,606 +0,0 @@ -/* - * $Id$ - */ - -/* - * Harbour Project source code: - * Tprinter.cpp - * Harbour THarbourPrinter C++ Class for Harbour print support - * Copyright 2002 Luiz Rafael Culik - * www - http://www.harbour-project.org - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). - * - * As a special exception, the Harbour Project gives permission for - * additional uses of the text contained in its release of Harbour. - * - * The exception is that, if you link the Harbour libraries with other - * files to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the Harbour library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the Harbour - * Project under the name Harbour. If you copy code from other - * Harbour Project or Free Software Foundation releases into a copy of - * Harbour, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. - * - * If you write modifications of your own for Harbour, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. - * - */ - -#include "hbsetup.h" - -#if defined(HB_OS_WIN_32) && (!defined(__RSXNT__)) && (!defined(__CYGWIN__)) - -#include - -#if defined(__LCC__) - #include -#endif - -#define HB_OS_WIN_32_USED -#include "hbapi.h" -#include "hbapiitm.h" - -BOOL hb_GetDefaultPrinter(LPTSTR pPrinterName, LPDWORD pdwBufferSize); -BOOL hb_GetPrinterNameByPort(LPTSTR pPrinterName, LPDWORD pdwBufferSize,LPTSTR pPortName, BOOL bSubStr); - -#define MAXBUFFERSIZE 255 - -BOOL hb_isLegacyDevice( LPTSTR pPrinterName) -{ - BOOL bLegacyDev = FALSE ; - int n = 0 ; - LPTSTR pszPrnDev[] = { "lpt1", "lpt2", "lpt3", "lpt4", "lpt5", "lpt6", "com1", "com2", "com3", "com4", NULL } ; - while ( pszPrnDev[ n ] && !bLegacyDev ) - { - bLegacyDev = ( hb_strnicmp( pPrinterName, pszPrnDev[ n ], strlen( pszPrnDev[ n ] ) ) == 0 ) ; - n++ ; - } - return( bLegacyDev ) ; -} - - -BOOL hb_PrinterExists( LPTSTR pPrinterName ) -{ - BOOL Result = FALSE ; - DWORD Flags = PRINTER_ENUM_LOCAL | PRINTER_ENUM_CONNECTIONS; - PRINTER_INFO_4 *buffer4, *pPrinterEnum4; - HANDLE hPrinter ; - ULONG needed = 0 , returned=0, a; - - HB_TRACE(HB_TR_DEBUG, ("hb_PrinterExists(%s)", pPrinterName)); - - if (!strchr( pPrinterName, OS_PATH_LIST_SEPARATOR ) - && !hb_isLegacyDevice( pPrinterName ) ) - - { // Don't bother with test if '\' in string - if (hb_iswinnt()) - { // Use EnumPrinter() here because much faster than OpenPrinter() - EnumPrinters(Flags,NULL,4,(LPBYTE) NULL,0,&needed,&returned) ; - if ( needed > 0 ) - { - pPrinterEnum4 = buffer4 = ( PRINTER_INFO_4 * ) hb_xgrab( needed ) ; - if ( pPrinterEnum4 ) - { - if (EnumPrinters(Flags,NULL,4,(LPBYTE) pPrinterEnum4, needed, &needed, &returned ) ) - { - for ( a = 0 ; !Result && a < returned ; a++, pPrinterEnum4++ ) - { - Result= ( strcmp((const char *) pPrinterName, (const char *) pPrinterEnum4->pPrinterName) == 0 ) ; - } - } - hb_xfree( buffer4 ) ; - } - } - } - else if ( OpenPrinter( (char *) pPrinterName, &hPrinter, NULL ) ) - { - ClosePrinter( hPrinter ); - Result = TRUE ; - } - } - return Result ; -} - -HB_FUNC( PRINTEREXISTS ) -{ - BOOL Result = FALSE ; - - if ISCHAR(1) - { - Result = hb_PrinterExists(hb_parcx(1)) ; - } - hb_retl(Result) ; -} - -BOOL hb_GetDefaultPrinter( LPTSTR pPrinterName, LPDWORD pdwBufferSize ) -{ - BOOL Result = FALSE ; - OSVERSIONINFO osvi; - osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); - GetVersionEx(&osvi); - - if (osvi.dwPlatformId == VER_PLATFORM_WIN32_NT && osvi.dwMajorVersion >= 5) /* Windows 2000 or later */ - { - typedef BOOL (WINAPI *DEFPRINTER)( LPTSTR, LPDWORD ) ; // stops warnings - DEFPRINTER fnGetDefaultPrinter; - HMODULE hWinSpool = LoadLibrary("winspool.drv"); - if ( hWinSpool ) - { - fnGetDefaultPrinter = ( DEFPRINTER ) GetProcAddress( hWinSpool, "GetDefaultPrinterA" ); - - if ( fnGetDefaultPrinter ) - { - Result = ( *fnGetDefaultPrinter)( pPrinterName, pdwBufferSize); - } - FreeLibrary( hWinSpool ); - } - } - - if ( !Result ) /* Win9X and Windows NT 4.0 or earlier & 2000+ if necessary for some reason i.e. dll could not load!!!! */ - { - DWORD dwSize = GetProfileString( "windows", "device", "", pPrinterName, *pdwBufferSize) ; - if ( dwSize && dwSize < *pdwBufferSize) - { - dwSize = 0 ; - while ( pPrinterName[ dwSize ] != '\0' && pPrinterName[ dwSize ] != ',') - { - dwSize++; - } - pPrinterName[ dwSize ] = '\0'; - *pdwBufferSize = dwSize + 1; - Result = TRUE ; - } - else - { - *pdwBufferSize = dwSize+1 ; - } - } - - if ( !Result && osvi.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS ) - { -/* - This option should never be required but is included because of this article - - http://support.microsoft.com/kb/246772/en-us - - This option will not enumerate any network printers. - - From the SDK technical reference for EnumPrinters(); - - If Level is 2 or 5, Name is a pointer to a null-terminated string that specifies - the name of a server whose printers are to be enumerated. - If this string is NULL, then the function enumerates the printers installed on the local machine. -*/ - - DWORD dwNeeded, dwReturned ; - PRINTER_INFO_2 *ppi2 ; - if ( EnumPrinters( PRINTER_ENUM_DEFAULT, NULL, 2, NULL, 0, &dwNeeded, &dwReturned) ) - { - if ( dwNeeded > 0 ) - { - ppi2 = (PRINTER_INFO_2 *) hb_xgrab( dwNeeded ); - if ( ppi2 ) - { - if ( EnumPrinters(PRINTER_ENUM_DEFAULT, NULL, 2, (LPBYTE) ppi2, dwNeeded, &dwNeeded, &dwReturned) && dwReturned > 0 ) - { - DWORD dwSize = (DWORD) lstrlen( ppi2->pPrinterName) ; - if ( dwSize && dwSize < *pdwBufferSize ) - { - lstrcpy( pPrinterName, ppi2->pPrinterName); - *pdwBufferSize = dwSize + 1; - Result = TRUE ; - } - } - hb_xfree( ppi2 ) ; - } - } - } - } - return( Result ) ; -} - - -HB_FUNC( GETDEFAULTPRINTER ) -{ - char szDefaultPrinter[MAXBUFFERSIZE]; - DWORD pdwBufferSize = MAXBUFFERSIZE; - if( hb_GetDefaultPrinter( ( LPTSTR ) &szDefaultPrinter , &pdwBufferSize ) ) - { - hb_retclen(szDefaultPrinter , pdwBufferSize-1); - } - else - { - hb_retc(""); - } -} - -BOOL hb_GetPrinterNameByPort( LPTSTR pPrinterName, LPDWORD pdwBufferSize, LPTSTR pPortName, BOOL bSubStr ) -{ - BOOL Result = FALSE, bFound = FALSE ; - ULONG needed, returned, a; - PRINTER_INFO_5 *pPrinterEnum,*buffer; - - HB_TRACE(HB_TR_DEBUG, ("hb_GetPrinterNameByPort(%s,%s)",pPrinterName, pPortName)); - - EnumPrinters( PRINTER_ENUM_LOCAL | PRINTER_ENUM_CONNECTIONS ,NULL,5,( LPBYTE ) NULL, 0, &needed,&returned ); - if ( needed > 0 ) - { - pPrinterEnum = buffer = ( PRINTER_INFO_5 * ) hb_xgrab( needed ) ; - - if (EnumPrinters( PRINTER_ENUM_LOCAL | PRINTER_ENUM_CONNECTIONS ,NULL,5,( LPBYTE ) buffer, needed, &needed,&returned ) ) - { - for( a = 0 ; a < returned && !bFound ; a++, pPrinterEnum++ ) - { - - if ( bSubStr ) - { - bFound = ( hb_strnicmp( pPrinterEnum->pPortName , pPortName, strlen( pPortName ) ) == 0 ); - } - else - { - bFound = ( hb_stricmp( pPrinterEnum->pPortName , pPortName ) == 0 ); - } - if ( bFound ) - { - if (*pdwBufferSize >= strlen(pPrinterEnum->pPrinterName)+1) - { - strcpy( pPrinterName , pPrinterEnum->pPrinterName ) ; - Result = TRUE; - } - // Store name length + \0 char for return - *pdwBufferSize = ( DWORD ) strlen( pPrinterEnum->pPrinterName ) + 1; - } - } - } - hb_xfree(buffer) ; - } - return Result; -} - -HB_FUNC( PRINTERPORTTONAME ) -{ - char szDefaultPrinter[ MAXBUFFERSIZE ]; - DWORD pdwBufferSize = MAXBUFFERSIZE; - - if( ISCHAR(1) && hb_parclen(1) > 0 && hb_GetPrinterNameByPort( ( LPTSTR ) &szDefaultPrinter , &pdwBufferSize , hb_parcx(1), ISLOG( 2 ) ? hb_parl( 2 ) : FALSE ) ) - { - hb_retc(szDefaultPrinter); - } - else - { - hb_retc(""); - } -} -#define BIG_PRINT_BUFFER (1024*32) - -LONG hb_PrintFileRaw( UCHAR *cPrinterName, UCHAR *cFileName, UCHAR *cDocName ) -{ - UCHAR printBuffer[ BIG_PRINT_BUFFER ] ; - HANDLE hPrinter, hFile ; - DOC_INFO_1 DocInfo ; - DWORD nRead, nWritten, Result; - - if ( OpenPrinter( (char *) cPrinterName, &hPrinter, NULL) != 0 ) - { - DocInfo.pDocName = (char *) cDocName ; - DocInfo.pOutputFile = NULL ; - DocInfo.pDatatype = "RAW" ; - if ( StartDocPrinter(hPrinter,1,(UCHAR *) &DocInfo) != 0 ) - { - if ( StartPagePrinter(hPrinter) != 0 ) - { - hFile = CreateFile( (const char *) cFileName,GENERIC_READ,0,NULL,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,NULL) ; - if (hFile != INVALID_HANDLE_VALUE ) - { - while (ReadFile(hFile, printBuffer, BIG_PRINT_BUFFER, &nRead, NULL) && (nRead > 0)) - { - if (printBuffer[nRead-1] == 26 ) - { - nRead-- ; // Skip the EOF() character - } - WritePrinter(hPrinter, printBuffer, nRead, &nWritten) ; - } - Result = 1 ; - CloseHandle(hFile) ; - } - else - { - Result= -6 ; - } - EndPagePrinter(hPrinter) ; - } - else - { - Result = -4 ; - } - EndDocPrinter(hPrinter); - } - else - { - Result= -3 ; - } - ClosePrinter(hPrinter) ; - } - else - { - Result= -2 ; - } - return Result ; -} - -HB_FUNC( PRINTFILERAW ) -{ - UCHAR *cPrinterName, *cFileName, *cDocName ; - DWORD Result = -1 ; - - if ( ISCHAR(1) && ISCHAR(2) ) - { - cPrinterName = (UCHAR *) hb_parcx( 1 ) ; - cFileName = (UCHAR *) hb_parcx( 2 ) ; - cDocName = ( ISCHAR(3) ? (UCHAR *) hb_parcx( 3 ) : cFileName ) ; - Result = hb_PrintFileRaw( cPrinterName, cFileName, cDocName ) ; - } - hb_retnl( Result ) ; -} - -HB_FUNC( GETPRINTERS ) -{ - HANDLE hPrinter ; - DWORD Flags = PRINTER_ENUM_LOCAL | PRINTER_ENUM_CONNECTIONS; - BOOL bPrinterNamesOnly= TRUE ; - BOOL bLocalPrintersOnly; - PRINTER_INFO_4 *buffer4, *pPrinterEnum4; - PRINTER_INFO_5 *buffer, *pPrinterEnum; - PRINTER_INFO_2 *pPrinterInfo2 ; - ULONG needed = 0 , returned=0, a; - PHB_ITEM SubItems, File, Port, Net, Driver, ArrayPrinter; - - ArrayPrinter = hb_itemNew( NULL ); - SubItems = hb_itemNew( NULL ); - File = hb_itemNew( NULL ); - Port = hb_itemNew( NULL ); - Net = hb_itemNew( NULL ); - Driver = hb_itemNew( NULL ); - - - hb_arrayNew( ArrayPrinter, 0 ); - - buffer = NULL ; - HB_TRACE(HB_TR_DEBUG, ("GETPRINTERS()")); - - if ( ISLOG(1) ) - { - bPrinterNamesOnly = !hb_parl(1) ; - } - - bLocalPrintersOnly = ISLOG(2) ? hb_parl(2) : FALSE; - - if ( hb_iswinnt() ) - { - EnumPrinters(Flags,NULL,4,(LPBYTE) NULL,0,&needed,&returned) ; - - if ( needed > 0 ) - { - pPrinterEnum4 = buffer4 = ( PRINTER_INFO_4 * ) hb_xgrab( needed ) ; - if (pPrinterEnum4) - { - if (EnumPrinters( Flags, NULL, 4, (LPBYTE) pPrinterEnum4, needed, &needed, &returned ) ) - { - if (bPrinterNamesOnly ) - { - for ( a = 0 ; a < returned ; a++, pPrinterEnum4++) - { - if(!bLocalPrintersOnly || pPrinterEnum4->Attributes & PRINTER_ATTRIBUTE_LOCAL) - { - hb_itemPutC( File, pPrinterEnum4->pPrinterName ); - hb_arrayAddForward( ArrayPrinter , File ); - } - } - } - else - { - for ( a = 0 ; a < returned ; a++, pPrinterEnum4++) - { - if(!bLocalPrintersOnly || pPrinterEnum4->Attributes & PRINTER_ATTRIBUTE_LOCAL) - { - if ( OpenPrinter( pPrinterEnum4->pPrinterName, &hPrinter, NULL ) ) - { - GetPrinter( hPrinter, 2, NULL, 0, &needed ); - if ( needed > 0 ) - { - pPrinterInfo2 = ( PRINTER_INFO_2 * ) hb_xgrab( needed ) ; - if ( pPrinterInfo2 ) - { - hb_arrayNew( SubItems, 0 ); - hb_itemPutC( File, pPrinterEnum4->pPrinterName ); - - if ( GetPrinter( hPrinter, 2, (LPBYTE) pPrinterInfo2, needed, &needed ) ) - { - hb_itemPutC( Port, pPrinterInfo2->pPortName ); - hb_itemPutC( Driver, pPrinterInfo2->pDriverName ); - } - else - { - hb_itemPutC( Port,"Error" ); - hb_itemPutC( Driver, "Error" ); - } - - if ( pPrinterEnum4->Attributes & PRINTER_ATTRIBUTE_LOCAL) - { - hb_itemPutC( Net,"LOCAL" ); - } - else - { - if ( pPrinterEnum4->Attributes & PRINTER_ATTRIBUTE_NETWORK) - { - hb_itemPutC( Net,"NETWORK" ); - } - else - { - hb_itemPutC( Net, "ERROR" ); - } - } - - hb_arrayAddForward( SubItems, File ) ; - hb_arrayAddForward( SubItems, Port ) ; - hb_arrayAddForward( SubItems, Net ) ; - hb_arrayAddForward( SubItems, Driver ) ; - hb_arrayAddForward( ArrayPrinter, SubItems ); - hb_xfree(pPrinterInfo2) ; - } - } - } - CloseHandle(hPrinter) ; - } - } - } - } - hb_xfree(buffer4) ; - } - } - } - else - { - EnumPrinters( Flags,NULL,5,(LPBYTE) buffer,0,&needed,&returned ); - - if( needed > 0 ) - { - pPrinterEnum = buffer = ( PRINTER_INFO_5 * ) hb_xgrab( needed ) ; - if (pPrinterEnum) - { - if ( EnumPrinters(Flags, NULL , 5 , (LPBYTE) buffer , needed , &needed , &returned ) ) - { - for ( a = 0 ; a < returned ; a++, pPrinterEnum++) - { - if(!bLocalPrintersOnly || pPrinterEnum->Attributes & PRINTER_ATTRIBUTE_LOCAL) - { - if (bPrinterNamesOnly ) - { - hb_itemPutC( File, pPrinterEnum->pPrinterName ); - hb_arrayAddForward( ArrayPrinter, File ); - } - else - { - // Tony (ABC) 11/1/2005 1:40PM. - for ( a = 0 ; a < returned ; a++, pPrinterEnum++) - { - if(!bLocalPrintersOnly || pPrinterEnum->Attributes & PRINTER_ATTRIBUTE_LOCAL) - { - if ( OpenPrinter( pPrinterEnum->pPrinterName, &hPrinter, NULL ) ) - { - GetPrinter( hPrinter, 2, NULL, 0, &needed ); - if ( needed > 0 ) - { - pPrinterInfo2 = ( PRINTER_INFO_2 * ) hb_xgrab( needed ) ; - if ( pPrinterInfo2 ) - { - hb_arrayNew( SubItems, 0 ); - hb_itemPutC( File, pPrinterEnum->pPrinterName ); - - if ( GetPrinter( hPrinter, 2, (LPBYTE) pPrinterInfo2, needed, &needed ) ) - { - hb_itemPutC( Port, pPrinterInfo2->pPortName ); - hb_itemPutC( Driver, pPrinterInfo2->pDriverName ); - } - else - { - hb_itemPutC( Port,"Error" ); - hb_itemPutC( Driver, "Error" ); - } - - if ( pPrinterEnum->Attributes & PRINTER_ATTRIBUTE_LOCAL) - { - hb_itemPutC( Net,"LOCAL" ); - } - else - { - if ( pPrinterEnum->Attributes & PRINTER_ATTRIBUTE_NETWORK) - { - hb_itemPutC( Net,"NETWORK" ); - } - else - { - hb_itemPutC( Net, "ERROR" ); - } - } - - hb_arrayAddForward( SubItems, File ) ; - hb_arrayAddForward( SubItems, Port ) ; - hb_arrayAddForward( SubItems, Net ) ; - hb_arrayAddForward( SubItems, Driver ) ; - hb_arrayAddForward( ArrayPrinter, SubItems ); - hb_xfree(pPrinterInfo2) ; - } - } - } - CloseHandle(hPrinter) ; - } - } - // Tony (ABC) 11/1/2005 1:40PM. Old Code... Justo in case. -// hb_arrayNew( SubItems, 0 ); -// hb_itemPutC( File, pPrinterEnum->pPrinterName ); -// hb_itemPutC( Port, pPrinterEnum->pPortName ); - -// if ( pPrinterEnum->Attributes & PRINTER_ATTRIBUTE_LOCAL) -// { -// hb_itemPutC( Net,"LOCAL" ); -// } -// else -// { -// if ( pPrinterEnum->Attributes & PRINTER_ATTRIBUTE_NETWORK) -// { -// hb_itemPutC( Net,"NETWORK" ); -// } -// else -// { -// hb_itemPutC( Net, "ERROR" ); -// } -// } - -// hb_arrayAddForward( SubItems , File ) ; -// hb_arrayAddForward( SubItems , Port ) ; -// hb_arrayAddForward( SubItems, Net ) ; -// hb_arrayAddForward( ArrayPrinter , SubItems ); - } - } - } - } - hb_xfree(buffer) ; - } - } - } - hb_itemReturnForward( ArrayPrinter ); - - hb_itemRelease( ArrayPrinter ); - hb_itemRelease( SubItems ); - hb_itemRelease( File ); - hb_itemRelease( Port ); - hb_itemRelease( Net ); - hb_itemRelease( Driver ); -} - -#endif diff --git a/harbour/contrib/win32prn/w32_papi.c b/harbour/contrib/win32prn/w32_papi.c deleted file mode 100644 index de19c4622e..0000000000 --- a/harbour/contrib/win32prn/w32_papi.c +++ /dev/null @@ -1,645 +0,0 @@ -/* - * $Id$ - */ - -/* - * Harbour Project source code: - * Printing subsystem for Win32 using GUI printing - * Copyright 2004 Peter Rees - * Rees Software & Systems Ltd - * - * See doc/license.txt for licensing terms. - * - * www - http://www.harbour-project.org - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option ) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/ ). - * - * As a special exception, the Harbour Project gives permission for - * additional uses of the text contained in its release of Harbour. - * - * The exception is that, if you link the Harbour libraries with other - * files to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the Harbour library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the Harbour - * Project under the name Harbour. If you copy code from other - * Harbour Project or Free Software Foundation releases into a copy of - * Harbour, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. - * - * If you write modifications of your own for Harbour, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. -*/ - -/* - - TPRINT() was designed to make it easy to emulate Clipper Dot Matrix printing. - Dot Matrix printing was in CPI ( Characters per inch & Lines per inch ). - Even though "Mapping Mode" for TPRINT() is MM_TEXT, ::SetFont() accepts the - nWidth parameter in CPI not Pixels. Also the default ::LineHeight is for - 6 lines per inch so ::NewLine() works as per "LineFeed" on Dot Matrix printers. - If you do not like this then inherit from the class and override anything you want - - Simple example - - - TO DO: Colour printing - etc.... - - Peter Rees 21 January 2004 - -*/ - -#ifndef HB_OS_WIN_32_USED - #define HB_OS_WIN_32_USED -#endif - -#include "hbapi.h" -#include "hbapiitm.h" - -#ifdef HB_OS_WIN_32 - -#include -#include - -#ifndef INVALID_FILE_SIZE - #define INVALID_FILE_SIZE (DWORD)0xFFFFFFFF -#endif - -HB_FUNC( WIN32_CREATEDC ) -{ - LONG Result = 0 ; - if (ISCHAR(1)) - { - Result = (LONG) CreateDC("",hb_parc(1),NULL, NULL) ; - } - hb_retnl(Result) ; -} - -HB_FUNC( WIN32_STARTDOC ) -{ - HDC hDC = (HDC) hb_parnl(1) ; - DOCINFO sDoc ; - BOOL Result = FALSE; - if (hDC ) - { - sDoc.cbSize= sizeof(DOCINFO) ; - sDoc.lpszDocName= hb_parc(2) ; - sDoc.lpszOutput = NULL ; - sDoc.lpszDatatype= NULL ; - sDoc.fwType = 0 ; - Result = (BOOL) (StartDoc(hDC, &sDoc) >0 ) ; - } - hb_retl(Result); -} - - -HB_FUNC( WIN32_ENDDOC ) -{ - BOOL Result = FALSE; - HDC hDC = (HDC) hb_parnl(1) ; - if (hDC) - { - if (ISLOG(2) && hb_parl(2)) - { - Result = (AbortDoc(hDC) > 0) ; - } - else - { - Result = (EndDoc( hDC) > 0) ; - } - } - hb_retl(Result) ; -} - -HB_FUNC( WIN32_DELETEDC ) -{ - HDC hDC = (HDC) hb_parnl(1) ; - if (hDC) - { - DeleteDC( hDC ) ; - } - hb_retnl(0) ; // Return zero as a new handle even if fails -} - -HB_FUNC( WIN32_STARTPAGE ) -{ - BOOL Result = FALSE ; - HDC hDC = (HDC) hb_parnl(1) ; - if (hDC) - { - Result = ( StartPage( hDC ) > 0) ; - } - hb_retl(Result) ; -} - -HB_FUNC( WIN32_ENDPAGE ) -{ - BOOL Result = FALSE ; - HDC hDC = (HDC) hb_parnl(1) ; - if (hDC) - { - Result = (EndPage( hDC ) > 0) ; - } - hb_retl(Result) ; -} - -HB_FUNC( WIN32_TEXTOUT ) -{ - LONG Result = 0 ; - HDC hDC = (HDC) hb_parnl(1) ; - SIZE sSize ; - if (hDC) - { - int iLen = (int) hb_parnl(5) ; - if ( iLen > 0 ) - { - int iRow = (int) hb_parnl(2) ; - int iCol = (int) hb_parnl(3) ; - char *pszData = hb_parc(4) ; - int iWidth = ISNUM(6) ? (int) hb_parnl(6) : 0 ; - if (ISNUM(7) && (hb_parnl(7) == 1 || hb_parnl(7) == 2)) - { - if (hb_parnl(7) == 1) - { - SetTextAlign((HDC) hDC, TA_BOTTOM | TA_RIGHT | TA_NOUPDATECP) ; - } - else - { - SetTextAlign((HDC) hDC, TA_BOTTOM | TA_CENTER | TA_NOUPDATECP) ; - } - } - else - { - SetTextAlign((HDC) hDC, TA_BOTTOM | TA_LEFT | TA_NOUPDATECP) ; - } - if (iWidth < 0 && iLen < 1024 ) - { - int n= iLen, aFixed[1024] ; - iWidth = -iWidth ; - while( n ) - { - aFixed[ --n ] = iWidth; - } - if (ExtTextOut( hDC, iRow, iCol, 0, NULL, pszData, iLen, aFixed )) - { - Result = (LONG) (iLen * iWidth) ; - } - } - else if (TextOut(hDC, iRow, iCol, pszData, iLen)) - { - GetTextExtentPoint32(hDC,pszData, iLen , &sSize) ; // Get the length of the text in device size - Result = (LONG) sSize.cx ; // return the width so we can update the current pen position (::PosY) - } - } - } - hb_retnl(Result) ; -} - -HB_FUNC( WIN32_GETTEXTSIZE ) -{ - LONG Result = 0 ; - HDC hDC = (HDC) hb_parnl(1) ; - SIZE sSize ; - if (hDC) - { - char *pszData = hb_parc(2) ; - int iLen = (int) hb_parnl(3) ; - GetTextExtentPoint32(hDC,pszData, iLen , &sSize) ; // Get the length of the text in device size - if (ISLOG(4) && !hb_parl(4)) - { - Result = (LONG) sSize.cy ; // return the height - } - else - { - Result = (LONG) sSize.cx ; // return the width - } - } - hb_retnl(Result) ; -} - - -HB_FUNC( WIN32_GETCHARSIZE ) -{ - LONG Result = 0 ; - HDC hDC = (HDC) hb_parnl(1) ; - if (hDC) - { - TEXTMETRIC tm; - GetTextMetrics( hDC, &tm ); - if ( ISLOG(2) && hb_parl(2) ) - { - Result = (LONG) tm.tmHeight; - } - else - { - Result = (LONG) tm.tmAveCharWidth; - } - } - hb_retnl(Result) ; -} - -HB_FUNC( WIN32_GETDEVICECAPS ) -{ - LONG Result = 0 ; - HDC hDC = (HDC) hb_parnl(1) ; - if (hDC && ISNUM(2)) - { - Result = (LONG) GetDeviceCaps( hDC, hb_parnl(2)) ; - } - hb_retnl( Result) ; -} - -HB_FUNC( WIN32_SETMAPMODE ) -{ - LONG Result = 0 ; - HDC hDC = (HDC) hb_parnl(1) ; - if (hDC && ISNUM(2)) - { - Result = SetMapMode( hDC, hb_parnl(2)) ; - } - hb_retnl( Result) ; -} - -HB_FUNC( WIN32_MULDIV ) -{ - hb_retnl(MulDiv(hb_parnl(1), hb_parnl(2), hb_parnl(3))); -} - -HB_FUNC( WIN32_CREATEFONT ) -{ - BOOL Result = FALSE ; - HDC hDC = (HDC) hb_parnl(1) ; - HFONT hFont, hOldFont ; - char *pszFont = hb_parc(2) ; - int iHeight = (int) hb_parnl(3) ; - int iMul = (int) hb_parnl(4) ; - int iDiv = (int) hb_parnl(5) ; - int iWidth ; - int iWeight = (int) hb_parnl(6) ; - DWORD dwUnderLine = (DWORD) hb_parl(7) ; - DWORD dwItalic = (DWORD) hb_parl(8) ; - DWORD dwCharSet = (DWORD) hb_parnl(9) ; - iWeight = iWeight > 0 ? iWeight : FW_NORMAL ; - iHeight = -MulDiv(iHeight, GetDeviceCaps(hDC, LOGPIXELSY), 72); - if (iDiv ) - { - iWidth = MulDiv(abs(iMul), GetDeviceCaps(hDC,LOGPIXELSX), abs(iDiv)) ; - } - else - { - iWidth = 0 ; // Use the default font width - } - - hFont = CreateFont(iHeight, iWidth, 0, 0, iWeight, dwItalic, dwUnderLine, 0, - dwCharSet, OUT_DEVICE_PRECIS, CLIP_DEFAULT_PRECIS, DRAFT_QUALITY, DEFAULT_PITCH | FF_DONTCARE, pszFont) ; - if (hFont) - { - Result = TRUE; - hOldFont = (HFONT) SelectObject(hDC, hFont) ; - if ( hOldFont ) - { - DeleteObject(hOldFont) ; - } - } - hb_retl( Result ) ; -} - -HB_FUNC( WIN32_GETPRINTERFONTNAME ) -{ - HDC hDC = (HDC) hb_parnl(1) ; - if (hDC) - { - unsigned char cFont[128] ; - GetTextFace(hDC, 127, (LPTSTR) cFont) ; - hb_retc( (char*) cFont ) ; - } - else - { - hb_retc("") ; - } -} - -HB_FUNC( WIN32_BITMAPSOK ) -{ - BOOL Result = FALSE ; - HDC hDC = (HDC) hb_parnl(1) ; - if (hDC) - { - Result = (GetDeviceCaps(hDC, RASTERCAPS) & RC_STRETCHDIB) ; - } - hb_retl(Result) ; -} - -HB_FUNC( WIN32_SETDOCUMENTPROPERTIES ) -{ - BOOL Result = FALSE ; - HDC hDC = (HDC) hb_parnl(1) ; - if (hDC) - { - HANDLE hPrinter ; - LPTSTR pszPrinterName = hb_parc(2) ; - PDEVMODE pDevMode = NULL ; - LONG lSize ; - if (OpenPrinter(pszPrinterName, &hPrinter, NULL)) - { - lSize= DocumentProperties(0,hPrinter,pszPrinterName, pDevMode,pDevMode,0); - if (lSize > 0 ) - { - pDevMode= (PDEVMODE) hb_xgrab(lSize) ; - if (pDevMode ) - { - DocumentProperties(0,hPrinter,pszPrinterName, pDevMode,pDevMode,DM_OUT_BUFFER) ; - if ( ISNUM(3) && hb_parnl(3) ) // 22/02/2007 don't change if 0 - { - pDevMode->dmPaperSize = ( short ) hb_parnl(3) ; - } - if (ISLOG(4)) - { - pDevMode->dmOrientation = ( short ) (hb_parl(4) ? 2 : 1) ; - } - if (ISNUM(5) && hb_parnl(5) > 0) - { - pDevMode->dmCopies = ( short ) hb_parnl(5) ; - } - if ( ISNUM(6) && hb_parnl(6) ) // 22/02/2007 don't change if 0 - { - pDevMode->dmDefaultSource = ( short ) hb_parnl(6) ; - } - if (ISNUM(7) && hb_parnl(7) ) // 22/02/2007 don't change if 0 - { - pDevMode->dmDuplex = ( short ) hb_parnl(7) ; - } - if (ISNUM(8) && hb_parnl(8) ) // 22/02/2007 don't change if 0 - { - pDevMode->dmPrintQuality = ( short ) hb_parnl(8) ; - } - Result= (BOOL) ResetDC(hDC, pDevMode) ; - hb_xfree(pDevMode) ; - } - } - ClosePrinter(hPrinter) ; - } - } - hb_retl(Result) ; -} - -// Functions for Loading & Printing bitmaps - -HB_FUNC( WIN32_LOADBITMAPFILE ) -{ - PTSTR pstrFileName = hb_parc(1) ; - BOOL bSuccess= FALSE ; - DWORD dwFileSize, dwHighSize, dwBytesRead ; - HANDLE hFile ; - BITMAPFILEHEADER * pbmfh = NULL ; - hFile = CreateFile (pstrFileName, GENERIC_READ, FILE_SHARE_READ, NULL,OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, NULL) ; - if (hFile != INVALID_HANDLE_VALUE) - { - dwFileSize = GetFileSize (hFile, &dwHighSize) ; - if ((dwFileSize != INVALID_FILE_SIZE) && !dwHighSize) // Do not continue if File size error or TOO big for memory - { - pbmfh = (BITMAPFILEHEADER *) hb_xgrab(dwFileSize) ; - if (pbmfh) - { - bSuccess = ReadFile (hFile, pbmfh, dwFileSize, &dwBytesRead, NULL) ; - bSuccess = bSuccess && (dwBytesRead == dwFileSize) && (pbmfh->bfType == * (WORD *) "BM") ; //&& (pbmfh->bfSize == dwFileSize) ; - } - } - CloseHandle (hFile) ; - } - if (bSuccess) - { - hb_retclen( (char *) pbmfh, dwFileSize ); // hb_retclenAdoptRaw - if( pbmfh ) - hb_xfree( pbmfh ); - } - else - { - hb_retc("") ; - if (pbmfh != NULL) - { - hb_xfree (pbmfh) ; - } - } -} - -HB_FUNC( WIN32_DRAWBITMAP ) -{ - HDC hDC = (HDC) hb_parnl(1) ; - BITMAPFILEHEADER * pbmfh = (BITMAPFILEHEADER *) hb_parc(2) ; - BITMAPINFO * pbmi ; - BYTE * pBits ; - int cxDib, cyDib ; - pbmi = (BITMAPINFO *) (pbmfh + 1) ; - pBits = (BYTE *) pbmfh + pbmfh->bfOffBits ; - - if (pbmi->bmiHeader.biSize == sizeof (BITMAPCOREHEADER)) - { // Remember there are 2 types of BitMap File - cxDib = ((BITMAPCOREHEADER *) pbmi)->bcWidth ; - cyDib = ((BITMAPCOREHEADER *) pbmi)->bcHeight ; - } - else - { - cxDib = pbmi->bmiHeader.biWidth ; - cyDib = abs (pbmi->bmiHeader.biHeight) ; - } - - SetStretchBltMode (hDC, COLORONCOLOR) ; - hb_retl( StretchDIBits( hDC, hb_parni(3), hb_parni(4), hb_parni(5), hb_parni(6), - 0, 0, cxDib, cyDib, pBits, pbmi, - DIB_RGB_COLORS, SRCCOPY ) != ( int ) GDI_ERROR ); -} - -static int CALLBACK FontEnumCallBack(LOGFONT *lplf, TEXTMETRIC *lpntm, DWORD FontType, LPVOID pArray ) -{ - PHB_ITEM SubItems = hb_itemNew( NULL ); - - hb_arrayNew( SubItems, 4 ); - hb_itemPutC( hb_arrayGetItemPtr( SubItems, 1 ), lplf->lfFaceName ); - hb_itemPutL( hb_arrayGetItemPtr( SubItems, 2 ), lplf->lfPitchAndFamily & FIXED_PITCH ); - hb_itemPutL( hb_arrayGetItemPtr( SubItems, 3 ), FontType & TRUETYPE_FONTTYPE ); - hb_itemPutNL( hb_arrayGetItemPtr( SubItems, 4 ), lpntm->tmCharSet ); - hb_arrayAddForward( (PHB_ITEM) pArray, SubItems); - - hb_itemRelease( SubItems ); - - return(TRUE); -} - -HB_FUNC( WIN32_ENUMFONTS ) -{ - BOOL Result = FALSE ; - HDC hDC = (HDC) hb_parnl(1) ; - - if (hDC) - { - PHB_ITEM Array = hb_itemNew( NULL ); - - hb_arrayNew( Array, 0 ); - - EnumFonts(hDC, (LPCTSTR) NULL, (FONTENUMPROC) FontEnumCallBack, (LPARAM) Array); - - hb_itemReturnForward( Array ); - - hb_itemRelease( Array ); - - Result = TRUE ; - } - - if( !Result ) - { - hb_ret() ; - } -} - -HB_FUNC( WIN32_GETEXEFILENAME ) -{ - unsigned char pBuf[1024] ; - GetModuleFileName(NULL, (LPTSTR) pBuf, 1023) ; - hb_retc( (char*) pBuf ) ; -} - -HB_FUNC( WIN32_SETCOLOR ) -{ - HDC hDC = ( HDC ) hb_parnl( 1 ); - - SetTextColor( hDC, (COLORREF) hb_parnl( 2 ) ); - if( ISNUM(3) ) - { - SetBkColor( hDC, (COLORREF) hb_parnl( 3 ) ); - } - if( ISNUM(4) ) - { - SetTextAlign( hDC, hb_parni( 4 ) ); - } -} - -HB_FUNC( WIN32_SETPEN ) -{ - HDC hDC = ( HDC ) hb_parnl( 1 ); - HPEN hPen = CreatePen( - hb_parni( 2 ), // pen style - hb_parni( 3 ), // pen width - (COLORREF) hb_parnl( 4 ) // pen color - ); - HPEN hOldPen = (HPEN) SelectObject( hDC, hPen); - - if( hOldPen ) - DeleteObject( hOldPen ); - - hb_retnl( (LONG) hPen); -} - - -HB_FUNC( WIN32_FILLRECT ) -{ - HDC hDC = ( HDC ) hb_parnl( 1 ); - int x1 = hb_parni( 2 ); - int y1 = hb_parni( 3 ); - int x2 = hb_parni( 4 ); - int y2 = hb_parni( 5 ); - HBRUSH hBrush = CreateSolidBrush( (COLORREF) hb_parnl( 6 ) ); - RECT rct; - - rct.top = y1; - rct.left = x1; - rct.bottom = y2; - rct.right = x2; - - FillRect( hDC, &rct, hBrush ); - - DeleteObject( hBrush ); - - hb_ret( ); -} - -HB_FUNC( WIN32_LINETO ) -{ - HDC hDC = ( HDC ) hb_parnl( 1 ); - int x1 = hb_parni( 2 ); - int y1 = hb_parni( 3 ); - int x2 = hb_parni( 4 ); - int y2 = hb_parni( 5 ); - - MoveToEx( hDC, x1, y1, NULL ); - - hb_retl( LineTo( hDC, x2, y2 ) ); -} - -HB_FUNC( WIN32_RECTANGLE ) -{ - HDC hDC = ( HDC ) hb_parnl( 1 ); - int x1 = hb_parni( 2 ); - int y1 = hb_parni( 3 ); - int x2 = hb_parni( 4 ); - int y2 = hb_parni( 5 ); - int iWidth = hb_parni( 6 ); - int iHeight = hb_parni( 7 ); - if ( iWidth && iHeight ) - { - hb_retl( RoundRect( hDC, x1, y1, x2, y2, iWidth, iHeight ) ); - } - else - { - hb_retl( Rectangle( hDC, x1, y1, x2, y2) ); - } -} - -HB_FUNC( WIN32_ARC ) -{ - HDC hDC = ( HDC ) hb_parnl( 1 ); - int x1 = hb_parni( 2 ); - int y1 = hb_parni( 3 ); - int x2 = hb_parni( 4 ); - int y2 = hb_parni( 5 ); - - hb_retl( Arc( hDC, x1, y1, x2, y2, 0, 0, 0, 0) ); -} - -HB_FUNC( WIN32_ELLIPSE ) -{ - HDC hDC = ( HDC ) hb_parnl( 1 ); - int x1 = hb_parni( 2 ); - int y1 = hb_parni( 3 ); - int x2 = hb_parni( 4 ); - int y2 = hb_parni( 5 ); - - hb_retl( Ellipse( hDC, x1, y1, x2, y2) ); -} - -HB_FUNC( WIN32_SETBKMODE ) -{ - hb_retnl( SetBkMode( (HDC) hb_parnl( 1 ), hb_parnl( 2 ) ) ) ; -} - -HB_FUNC( WIN32_OS_ISWIN9X ) -{ - OSVERSIONINFO osvi; - osvi.dwOSVersionInfoSize = sizeof( OSVERSIONINFO ); - GetVersionEx( &osvi ); - hb_retl( osvi.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS ); -} - -#endif diff --git a/harbour/contrib/win32prn/w32_pcls.prg b/harbour/contrib/win32prn/w32_pcls.prg deleted file mode 100644 index b53f3adc63..0000000000 --- a/harbour/contrib/win32prn/w32_pcls.prg +++ /dev/null @@ -1,695 +0,0 @@ -/* - * $Id$ - */ - -/* - * Harbour Project source code: - * Printing subsystem for Win32 using GUI printing - * Copyright 2004 Peter Rees - * Rees Software & Systems Ltd - * - * See doc/license.txt for licensing terms. - * - * www - http://www.harbour-project.org - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option ) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/ ). - * - * As a special exception, the Harbour Project gives permission for - * additional uses of the text contained in its release of Harbour. - * - * The exception is that, if you link the Harbour libraries with other - * files to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the Harbour library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the Harbour - * Project under the name Harbour. If you copy code from other - * Harbour Project or Free Software Foundation releases into a copy of - * Harbour, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. - * - * If you write modifications of your own for Harbour, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. -*/ - -/* - - TPRINT() was designed to make it easy to emulate Clipper Dot Matrix printing. - Dot Matrix printing was in CPI ( Characters per inch & Lines per inch ). - Even though "Mapping Mode" for TPRINT() is MM_TEXT, ::SetFont() accepts the - nWidth parameter in CPI not Pixels. Also the default ::LineHeight is for - 6 lines per inch so ::NewLine() works as per "LineFeed" on Dot Matrix printers. - If you do not like this then inherit from the class and override anything you want - - Simple example - - - TO DO: Colour printing - etc.... - - Peter Rees 21 January 2004 - -*/ - -#ifndef __PLATFORM__Windows - - Function Win32Prn() - Return nil - -#else - -#include "hbclass.ch" -#include "common.ch" - -// Cut from wingdi.h - -#define MM_TEXT 1 -#define MM_LOMETRIC 2 -#define MM_HIMETRIC 3 -#define MM_LOENGLISH 4 -#define MM_HIENGLISH 5 - -// Device Parameters for GetDeviceCaps() - -#define HORZSIZE 4 // Horizontal size in millimeters -#define VERTSIZE 6 // Vertical size in millimeters -#define HORZRES 8 // Horizontal width in pixels -#define VERTRES 10 // Vertical height in pixels -#define NUMBRUSHES 16 // Number of brushes the device has -#define NUMPENS 18 // Number of pens the device has -#define NUMFONTS 22 // Number of fonts the device has -#define NUMCOLORS 24 // Number of colors the device supports -#define RASTERCAPS 38 // Bitblt capabilities - -#define LOGPIXELSX 88 // Logical pixels/inch in X -#define LOGPIXELSY 90 // Logical pixels/inch in Y - -#define PHYSICALWIDTH 110 // Physical Width in device units -#define PHYSICALHEIGHT 111 // Physical Height in device units -#define PHYSICALOFFSETX 112 // Physical Printable Area x margin -#define PHYSICALOFFSETY 113 // Physical Printable Area y margin -#define SCALINGFACTORX 114 // Scaling factor x -#define SCALINGFACTORY 115 // Scaling factor y - -/* bin selections */ -#define DMBIN_FIRST DMBIN_UPPER -#define DMBIN_UPPER 1 -#define DMBIN_ONLYONE 1 -#define DMBIN_LOWER 2 -#define DMBIN_MIDDLE 3 -#define DMBIN_MANUAL 4 -#define DMBIN_ENVELOPE 5 -#define DMBIN_ENVMANUAL 6 -#define DMBIN_AUTO 7 -#define DMBIN_TRACTOR 8 -#define DMBIN_SMALLFMT 9 -#define DMBIN_LARGEFMT 10 -#define DMBIN_LARGECAPACITY 11 -#define DMBIN_CASSETTE 14 -#define DMBIN_FORMSOURCE 15 -#define DMBIN_LAST DMBIN_FORMSOURCE - -/* print qualities */ -#define DMRES_DRAFT (-1) -#define DMRES_LOW (-2) -#define DMRES_MEDIUM (-3) -#define DMRES_HIGH (-4) - -/* duplex enable */ -#define DMDUP_SIMPLEX 1 -#define DMDUP_VERTICAL 2 -#define DMDUP_HORIZONTAL 3 - -#define MM_TO_INCH 25.4 - -CLASS WIN32PRN - - METHOD New(cPrinter) - METHOD Create() // CreatesDC and sets "Courier New" font, set Orientation, Copies, Bin# - // Create() ( & StartDoc() ) must be called before printing can start. - METHOD Destroy() // Calls EndDoc() - restores default font, Deletes DC. - // Destroy() must be called to avoid memory leaks - METHOD StartDoc(cDocame) // Calls StartPage() - METHOD EndDoc(lAbortDoc) // Calls EndPage() if lAbortDoc not .T. - METHOD StartPage() - METHOD EndPage(lStartNewPage) // If lStartNewPage = .T. then StartPage() is called for the next page of output - METHOD NewLine() - METHOD NewPage() - METHOD SetFont(cFontName, nPointSize, nWidth, nBold, lUnderline, lItalic, nCharSet) - // NB: nWidth is in "CharactersPerInch" - // _OR_ { nMul, nDiv } which equates to "CharactersPerInch" - // _OR_ ZERO ( 0 ) which uses the default width of the font - // for the nPointSize - // IF nWidth (or nDiv) is < 0 then Fixed font is emulated - - METHOD SetDefaultFont() - - METHOD GetFonts() // Returns array of { "FontName", lFixed, lTrueType, nCharSetRequired } - METHOD Bold(nBoldWeight) - METHOD UnderLine(lOn) - METHOD Italic(lOn) - METHOD SetDuplexType(nDuplexType) // Get/Set current Duplexmode - METHOD SetPrintQuality(nPrintQuality) // Get/Set Printquality - METHOD CharSet(nCharSet) - - - METHOD SetPos(nX, nY) // **WARNING** : (Col,Row) _NOT_ (Row,Col) - METHOD SetColor(nClrText, nClrPane, nAlign) INLINE (; - ::TextColor:=nClrText, ::BkColor:=nClrPane, ::TextAlign:=nAlign,; - win32_SetColor( ::hPrinterDC, nClrText, nClrPane, nAlign) ) - - METHOD TextOut(cString, lNewLine, lUpdatePosX, nAlign) // nAlign : 0 = left, 1 = right, 2 = centered - METHOD TextOutAt(nPosX,nPosY, cString, lNewLine, lUpdatePosX, nAlign) // **WARNING** : (Col,Row) _NOT_ (Row,Col) - - - METHOD SetPen(nStyle, nWidth, nColor) INLINE (; - ::PenStyle:=nStyle, ::PenWidth:=nWidth, ::PenColor:=nColor,; - win32_SetPen(::hPrinterDC, nStyle, nWidth, nColor) ) - METHOD Line(nX1, nY1, nX2, nY2) INLINE win32_LineTo(::hPrinterDC, nX1, nY1, nX2, nY2) - METHOD Box(nX1, nY1, nX2, nY2, nWidth, nHeight) INLINE win32_Rectangle(::hPrinterDC, nX1, nY1, nX2, nY2, nWidth, nHeight) - METHOD Arc(nX1, nY1, nX2, nY2) INLINE win32_Arc(::hPrinterDC, nX1, nY1, nX2, nY2) - METHOD Ellipse(nX1, nY1, nX2, nY2) INLINE win32_Ellipse(::hPrinterDC, nX1, nY1, nX2, nY2) - METHOD FillRect(nX1, nY1, nX2, nY2, nColor) INLINE win32_FillRect(::hPrinterDC, nX1, nY1, nX2, nY2, nColor) - METHOD GetCharWidth() - METHOD GetCharHeight() - METHOD GetTextWidth(cString) - METHOD GetTextHeight(cString) - METHOD DrawBitMap(oBmp) - -// Clipper DOS compatible functions. - METHOD SetPrc(nRow, nCol) // Based on ::LineHeight and current ::CharWidth - METHOD PRow() - METHOD PCol() - METHOD MaxRow() // Based on ::LineHeight & Form dimensions - METHOD MaxCol() // Based on ::CharWidth & Form dimensions - - METHOD MM_TO_POSX( nMm ) // Convert position on page from MM to pixel location Column - METHOD MM_TO_POSY( nMm ) // " " " " " " " " " Row - METHOD INCH_TO_POSX( nInch ) // Convert position on page from INCH to pixel location Column - METHOD INCH_TO_POSY( nInch ) // " " " " " " " " " Row - - METHOD TextAtFont( nPosX, nPosY, cString, cFont, nPointSize,; // Print text string at location - nWidth, nBold, lUnderLine, lItalic, lNewLine,; // in specified font and color. - lUpdatePosX, nColor, nAlign ) // Restore original font and colour - // after printing. - METHOD SetBkMode( nMode ) INLINE win32_SetBkMode( ::hPrinterDc, nMode ) // OPAQUE= 2 or TRANSPARENT= 1 - // Set Background mode - - METHOD GetDeviceCaps( nCaps ) INLINE win32_GetDeviceCaps( ::hPrinterDC, nCaps) - - VAR PrinterName INIT "" - VAR Printing INIT .F. - VAR HavePrinted INIT .F. - VAR hPrinterDc INIT 0 - -// These next 4 variables must be set before calling ::Create() if -// you wish to alter the defaults - VAR FormType INIT 0 - VAR BinNumber INIT 0 - VAR Landscape INIT .F. - VAR Copies INIT 1 - - VAR SetFontOk INIT .F. - VAR FontName INIT "" // Current Point size for font - VAR FontPointSize INIT 12 // Point size for font - VAR FontWidth INIT {0,0} // {Mul, Div} Calc width: nWidth:= MulDiv(nMul, GetDeviceCaps(shDC,LOGPIXELSX), nDiv) - // If font width is specified it is in "characters per inch" to emulate DotMatrix - VAR fBold INIT 0 HIDDEN // font darkness weight ( Bold). See wingdi.h or WIN SDK CreateFont() for valid values - VAR fUnderLine INIT .F. HIDDEN // UnderLine is on or off - VAR fItalic INIT .F. HIDDEN // Italic is on or off - VAR fCharSet INIT 1 HIDDEN // Default character set == DEFAULT_CHARSET ( see wingdi.h ) - - VAR PixelsPerInchY - VAR PixelsPerInchX - VAR PageHeight INIT 0 - VAR PageWidth INIT 0 - VAR TopMargin INIT 0 - VAR BottomMargin INIT 0 - VAR LeftMargin INIT 0 - VAR RightMargin INIT 0 - VAR LineHeight INIT 0 - VAR CharHeight INIT 0 - VAR CharWidth INIT 0 - VAR fCharWidth INIT 0 HIDDEN - VAR BitmapsOk INIT .F. - VAR NumColors INIT 1 - VAR fDuplexType INIT 0 HIDDEN //DMDUP_SIMPLEX, 22/02/2007 change to 0 to use default printer settings - VAR fPrintQuality INIT 0 HIDDEN //DMRES_HIGH, 22/02/2007 change to 0 to use default printer settings - VAR fNewDuplexType INIT 0 HIDDEN - VAR fNewPrintQuality INIT 0 HIDDEN - VAR fOldLandScape INIT .F. HIDDEN - VAR fOldBinNumber INIT 0 HIDDEN - VAR fOldFormType INIT 0 HIDDEN - - VAR PosX INIT 0 - VAR PosY INIT 0 - - VAR TextColor - VAR BkColor - VAR TextAlign - - VAR PenStyle - VAR PenWidth - VAR PenColor - -ENDCLASS - -METHOD New(cPrinter) CLASS WIN32PRN - ::PrinterName := IIF(!EMPTY(cPrinter), cPrinter, GetDefaultPrinter()) - RETURN(Self) - -METHOD Create() CLASS WIN32PRN - LOCAL Result:= .F. - ::Destroy() // Finish current print job if any - IF !EMPTY(::hPrinterDC:= win32_CreateDC(::PrinterName)) - - // Set Form Type - // Set Number of Copies - // Set Orientation - // Set Duplex mode - // Set PrintQuality - win32_SetDocumentProperties(::hPrinterDC, ::PrinterName, ::FormType, ::Landscape, ::Copies, ::BinNumber, ::fDuplexType, ::fPrintQuality) - // Set mapping mode to pixels, topleft down - win32_SetMapMode(::hPrinterDC,MM_TEXT) -// win32_SetTextCharacterExtra(::hPrinterDC,0); // do not add extra char spacing even if bold - // Get Margins etc... here - ::PageWidth := win32_GetDeviceCaps(::hPrinterDC,PHYSICALWIDTH) - ::PageHeight := win32_GetDeviceCaps(::hPrinterDC,PHYSICALHEIGHT) - ::LeftMargin := win32_GetDeviceCaps(::hPrinterDC,PHYSICALOFFSETX) - ::RightMargin := (::PageWidth - ::LeftMargin)+1 - ::PixelsPerInchY := win32_GetDeviceCaps(::hPrinterDC,LOGPIXELSY) - ::PixelsPerInchX := win32_GetDeviceCaps(::hPrinterDC,LOGPIXELSX) - ::LineHeight := INT(::PixelsPerInchY / 6) // Default 6 lines per inch == # of pixels per line - ::TopMargin := win32_GetDeviceCaps(::hPrinterDC,PHYSICALOFFSETY) - ::BottomMargin := (::PageHeight - ::TopMargin)+1 - - // Set .T. if can print bitmaps - ::BitMapsOk := win32_BitMapsOk(::hPrinterDC) - - // supports Colour - ::NumColors := win32_GetDeviceCaps(::hPrinterDC,NUMCOLORS) - - // Set the standard font - ::SetDefaultFont() - ::HavePrinted:= ::Printing:= .F. - ::fOldFormType:= ::FormType // Last formtype used - ::fOldLandScape:= ::LandScape - ::fOldBinNumber:= ::BinNumber - Result:= .T. - ENDIF - RETURN(Result) - -METHOD Destroy() CLASS WIN32PRN - IF !EMPTY(::hPrinterDc) - IF ::Printing - ::EndDoc() - ENDIF - ::hPrinterDC:= win32_DeleteDC(::hPrinterDC) - ENDIF - RETURN(.T.) - -METHOD StartDoc(cDocName) CLASS WIN32PRN - LOCAL Result:= .F. - IF cDocName == NIL - cDocName:= win32_GetExeFileName()+" ["+DTOC(DATE())+' - '+TIME()+"]" - ENDIF - IF (Result:= win32_StartDoc(::hPrinterDc, cDocName)) - IF !(Result:= ::StartPage(::hPrinterDc)) - ::EndDoc(.T.) - ELSE - ::Printing:= .T. - ENDIF - ENDIF - RETURN(Result) - -METHOD EndDoc(lAbortDoc) CLASS WIN32PRN - IF lAbortDoc == NIL - lAbortDoc:= .F. - ENDIF - IF !::HavePrinted - lAbortDoc:= .T. - ENDIF - IF !lAbortDoc - ::EndPage(.F.) - ENDIF - win32_EndDoc(::hPrinterDC,lAbortDoc) - ::Printing:= .F. - ::HavePrinted:= .F. - RETURN(.T.) - -METHOD StartPage() CLASS WIN32PRN - LOCAL lLLandScape, nLBinNumber, nLFormType, nLDuplexType, nLPrintQuality - LOCAL lChangeDP:= .F. - IF ::LandScape <> ::fOldLandScape // Direct-modify property - lLLandScape:= ::fOldLandScape := ::LandScape - lChangeDP:= .T. - ENDIF - IF ::BinNumber <> ::fOldBinNumber // Direct-modify property - nLBinNumber:= ::fOldBinNumber := ::BinNumber - lChangeDP:= .T. - ENDIF - IF ::FormType <> ::fOldFormType // Direct-modify property - nLFormType:= ::fOldFormType := ::FormType - lChangeDP:= .T. - ENDIF - IF ::fDuplexType <> ::fNewDuplexType // Get/Set property - nLDuplexType:= ::fDuplexType:= ::fNewDuplexType - lChangeDP:= .T. - ENDIF - IF ::fPrintQuality <> ::fNewPrintQuality // Get/Set property - nLPrintQuality:= ::fPrintQuality:= ::fNewPrintQuality - lChangeDP:= .T. - ENDIF - IF lChangeDP - win32_SetDocumentProperties(::hPrinterDC, ::PrinterName, nLFormType, lLLandscape, , nLBinNumber, nLDuplexType, nLPrintQuality) - ENDIF - win32_StartPage(::hPrinterDC) - ::PosX:= ::LeftMargin - ::PosY:= ::TopMargin - RETURN(.T.) - -METHOD EndPage(lStartNewPage) CLASS WIN32PRN - IF lStartNewPage == NIL - lStartNewPage:= .T. - ENDIF - win32_EndPage(::hPrinterDC) - IF lStartNewPage - ::StartPage() - IF win32_OS_ISWIN9X() // Reset font on Win9X - ::SetFont() - ENDIF - ENDIF - RETURN(.T.) - -METHOD NewLine() CLASS WIN32PRN - ::PosX:= ::LeftMargin - ::PosY+= ::LineHeight - RETURN(::PosY) - -METHOD NewPage() CLASS WIN32PRN - ::EndPage(.T.) - RETURN(.T.) - - -// If font width is specified it is in "characters per inch" to emulate DotMatrix -// An array {nMul,nDiv} is used to get precise size such a the Dot Matric equivalent -// of Compressed print == 16.67 char per inch == { 3,-50 } -// If nDiv is < 0 then Fixed width printing is forced via ExtTextOut() -METHOD SetFont(cFontName, nPointSize, nWidth, nBold, lUnderline, lItalic, nCharSet) CLASS WIN32PRN - LOCAL cType - IF cFontName !=NIL - ::FontName:= cFontName - ENDIF - IF nPointSize!=NIL - ::FontPointSize:= nPointSize - ENDIF - IF nWidth != NIL - cType:= VALTYPE(nWidth) - IF cType='A' - ::FontWidth := nWidth - ELSEIF cType='N' .AND. !EMPTY(nWidth) - ::FontWidth := {1,nWidth } - ELSE - ::FontWidth := {0, 0 } - ENDIF - ENDIF - IF nBold != NIL - ::fBold := nBold - ENDIF - IF lUnderLine != NIL - ::fUnderline:= lUnderLine - ENDIF - IF lItalic != NIL - ::fItalic := lItalic - ENDIF - IF nCharSet != NIL - ::fCharSet := nCharSet - ENDIF - IF (::SetFontOk:= win32_CreateFont( ::hPrinterDC, ::FontName, ::FontPointSize, ::FontWidth[1], ::FontWidth[2], ::fBold, ::fUnderLine, ::fItalic, ::fCharSet)) - ::fCharWidth := ::GetCharWidth() - ::CharWidth:= ABS(::fCharWidth) - ::CharHeight:= ::GetCharHeight() - ENDIF - ::FontName:= win32_GetPrinterFontName(::hPrinterDC) // Get the font name that Windows actually used - RETURN(::SetFontOk) - -METHOD SetDefaultFont() - RETURN(::SetFont("Courier New",12,{1, 10}, 0, .F., .F., 0)) - -METHOD Bold(nWeight) CLASS WIN32PRN - LOCAL Result:= ::fBold - IF nWeight!= NIL - ::fBold:= nWeight - IF ::Printing - ::SetFont() - ENDIF - ENDIF - RETURN(Result) - -METHOD Underline(lUnderLine) CLASS WIN32PRN - LOCAL Result:= ::fUnderline - IF lUnderLine!= NIL - ::fUnderLine:= lUnderLine - IF ::Printing - ::SetFont() - ENDIF - ENDIF - RETURN(Result) - -METHOD Italic(lItalic) CLASS WIN32PRN - LOCAL Result:= ::fItalic - IF lItalic!= NIL - ::fItalic:= lItalic - IF ::Printing - ::SetFont() - ENDIF - ENDIF - RETURN(Result) - -METHOD CharSet(nCharSet) CLASS WIN32PRN - LOCAL Result:= ::fCharSet - IF nCharSet!= NIL - ::fCharSet:= nCharSet - IF ::Printing - ::SetFont() - ENDIF - ENDIF - RETURN(Result) - -METHOD SetDuplexType(nDuplexType) CLASS WIN32PRN - LOCAL Result:= ::fDuplexType - IF nDuplexType!= NIL - ::fNewDuplexType:= nDuplexType - IF !::Printing - ::fDuplexType:= nDuplexType - ENDIF - ENDIF - RETURN(Result) - -METHOD SetPrintQuality(nPrintQuality) CLASS WIN32PRN - LOCAL Result:= ::fPrintQuality - IF nPrintQuality!= NIL - ::fNewPrintQuality:= nPrintQuality - IF !::Printing - ::fPrintQuality:= nPrintQuality - ENDIF - ENDIF - RETURN(Result) - -METHOD GetFonts() CLASS WIN32PRN - RETURN(win32_ENUMFONTS(::hPrinterDC)) - -METHOD SetPos(nPosX, nPosY) CLASS WIN32PRN - LOCAL Result:= {::PosX, ::PosY} - IF nPosX != NIL - ::PosX:= INT(nPosX) - ENDIF - IF nPosY != NIL - ::PosY:= INT(nPosY) - ENDIF - RETURN(Result) - -METHOD TextOut(cString, lNewLine, lUpdatePosX, nAlign) CLASS WIN32PRN - LOCAL nPosX - IF nAlign == NIL - nAlign:= 0 - ENDIF - IF lUpdatePosX == NIL - lUpdatePosX:=.T. - ENDIF - IF lNewLine == NIL - lNewLine:= .F. - ENDIF - IF cString!=NIL - nPosX:= win32_TextOut(::hPrinterDC,::PosX, ::PosY, cString, LEN(cString), ::fCharWidth, nAlign) - ::HavePrinted:= .T. - IF lUpdatePosX - ::PosX+= nPosX - ENDIF - IF lNewLine - ::NewLine() - ENDIF - ENDIF - RETURN( .T. ) - -METHOD TextOutAt(nPosX,nPosY, cString, lNewLine, lUpdatePosX, nAlign) CLASS WIN32PRN - IF lNewLine == NIL - lNewLine:= .F. - ENDIF - IF lUpdatePosX == NIL - lUpdatePosX:= .T. - ENDIF - ::SetPos(nPosX,nPosY) - ::TextOut(cString, lNewLine, lUpdatePosX, nAlign) - RETURN(.T.) - -METHOD GetCharWidth() CLASS WIN32PRN - LOCAL nWidth:= 0 - IF ::FontWidth[2] < 0 .AND. !EMPTY(::FontWidth[1]) - nWidth:= win32_MulDiv(::FontWidth[1], ::PixelsPerInchX,::FontWidth[2]) - ELSE - nWidth:= win32_GetCharSize(::hPrinterDC) - ENDIF - RETURN(nWidth) - -METHOD GetCharHeight() CLASS WIN32PRN - RETURN win32_GetCharSize(::hPrinterDC, .T.) - -METHOD GetTextWidth(cString) CLASS WIN32PRN - LOCAL nWidth:= 0 - IF ::FontWidth[2] < 0 .AND. !EMPTY(::FontWidth[1]) - nWidth:= LEN(cString) * ::CharWidth - ELSE - nWidth:= win32_GetTextSize(::hPrinterDC, cString, LEN(cString)) // Return Width in device units - ENDIF - RETURN(nWidth) - -METHOD GetTextHeight(cString) CLASS WIN32PRN - RETURN(win32_GetTextSize(::hPrinterDC, cString, LEN(cString), .F.)) // Return Height in device units - -METHOD DrawBitMap(oBmp) CLASS WIN32PRN - LOCAL Result:= .F. - IF ::BitMapsOk .AND. ::Printing .AND. !EMPTY(oBmp:BitMap) - IF (Result:= win32_DrawBitMap(::hPrinterDc, oBmp:BitMap,oBmp:Rect[1], oBmp:Rect[2], oBmp:rect[3], oBmp:Rect[4])) - ::HavePrinted:= .T. - ENDIF - ENDIF - RETURN(Result) - -METHOD SetPrc(nRow, nCol) CLASS WIN32PRN - ::SetPos((nCol * ::CharWidth)+ ::LeftMArgin, (nRow * ::LineHeight) + ::TopMargin) - RETURN(NIL) - -METHOD PROW() CLASS WIN32PRN - RETURN(INT((::PosY- ::TopMargin)/::LineHeight)) // No test for Div by ZERO - -METHOD PCOL() CLASS WIN32PRN - RETURN(INT((::PosX - ::LeftMargin)/::CharWidth)) // Uses width of current character - -METHOD MaxRow() CLASS WIN32PRN - RETURN(INT(((::BottomMargin-::TopMargin)+1) / ::LineHeight) - 1) - -METHOD MaxCol() CLASS WIN32PRN - RETURN(INT(((::RightMargin-::LeftMargin)+1 ) / ::CharWidth) - 1) - -METHOD MM_TO_POSX( nMm ) CLASS WIN32PRN - RETURN( INT( ( ( nMM * ::PixelsPerInchX ) / MM_TO_INCH ) - ::LeftMargin ) ) - -METHOD MM_TO_POSY( nMm ) CLASS WIN32PRN - RETURN( INT( ( ( nMM * ::PixelsPerInchY ) / MM_TO_INCH ) - ::TopMargin ) ) - -METHOD INCH_TO_POSX( nInch ) CLASS WIN32PRN - RETURN( INT( ( nInch * ::PixelsPerInchX ) - ::LeftMargin ) ) - -METHOD INCH_TO_POSY( nInch ) CLASS WIN32PRN - RETURN( INT( ( nInch * ::PixelsPerInchY ) - ::TopMargin ) ) - -METHOD TextAtFont( nPosX, nPosY, cString, cFont, nPointSize, nWidth, nBold, lUnderLine, lItalic, nCharSet, lNewLine, lUpdatePosX, nColor, nAlign ) CLASS WIN32PRN - LOCAL lCreated:= .F., nDiv:= 0, cType - DEFAULT nPointSize TO ::FontPointSize - IF cFont != NIL - cType:= VALTYPE(nWidth) - IF cType='A' - nDiv := nWidth[ 1 ] - nWidth:= nWidth[ 2 ] - ELSEIF cType='N' .AND. !EMPTY(nWidth) - nDiv:= 1 - ENDIF - lCreated:= win32_CreateFont( ::hPrinterDC, cFont, nPointSize, nDiv, nWidth, nBold, lUnderLine, lItalic, nCharSet ) - ENDIF - IF nColor != NIL - nColor:= SetColor( ::hPrinterDC, nColor ) - ENDIF - ::TextOutAt( nPosX, nPosY, cString, lNewLine, lUpdatePosX, nAlign) - IF lCreated - ::SetFont() // Reset font - ENDIF - IF nColor != NIL - SetColor( ::hPrinterDC, nColor ) // Reset Color - ENDIF - RETURN( .T. ) - -// Bitmap class - -CLASS WIN32BMP - -EXPORTED: - - METHOD New() - METHOD LoadFile(cFileName) - METHOD Create() - METHOD Destroy() - METHOD Draw(oPrn,arectangle) - VAR Rect INIT { 0,0,0,0 } // Coordinates to print BitMap - // XDest, // x-coord of destination upper-left corner - // YDest, // y-coord of destination upper-left corner - // nDestWidth, // width of destination rectangle - // nDestHeight, // height of destination rectangle - // See WinApi StretchDIBits() - VAR BitMap INIT "" - VAR FileName INIT "" -ENDCLASS - -METHOD New() CLASS WIN32BMP - RETURN Self - -METHOD LoadFile(cFileName) CLASS WIN32BMP - ::FileName:= cFileName - ::Bitmap := win32_LoadBitMapFile(::FileName) - RETURN !EMPTY(::Bitmap) - -METHOD Create() CLASS WIN32BMP // Compatibility function for Alaska Xbase++ - Return Self - -METHOD Destroy() CLASS WIN32BMP // Compatibility function for Alaska Xbase++ - RETURN NIL - -METHOD Draw(oPrn, aRectangle) CLASS WIN32BMP // Pass a TPRINT class reference & Rectangle array - ::Rect := aRectangle - RETURN oPrn:DrawBitMap(Self) - -CLASS XBPBITMAP FROM WIN32BMP // Compatibility Class for Alaska Xbase++ - -ENDCLASS - -#endif