diff --git a/harbour/ChangeLog b/harbour/ChangeLog index a9e0db87f3..c841ce1f9e 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,26 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-10-18 12:16 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) + + contrib/win32 + + contrib/win32/test + + contrib/win32/test/testw32p.prg + + contrib/win32/test/oleenum.prg + - test/oleenum.prg + + contrib/win32/Makefile + + contrib/win32/makefile.bc + + contrib/win32/makefile.vc + + contrib/win32/make_b32.bat + + contrib/win32/make_vc.bat + + contrib/win32/w32_tole.prg + + contrib/win32/w32_tprn.prg + + contrib/win32/tprinter.c + + contrib/win32/w32_ole.c + + contrib/win32/w32_prn.c + + Added a Win32 contrib lib by merging win32prn and ole2 + libs. The name of the new library is "hbwin32". + ; directx was not added for now. + 2007-10-17 11:55 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) * common.mak * source/rtl/Makefile diff --git a/harbour/contrib/Makefile b/harbour/contrib/Makefile index c16f0fa202..c6fedb79b0 100644 --- a/harbour/contrib/Makefile +++ b/harbour/contrib/Makefile @@ -31,10 +31,9 @@ DIRS +=\ ifneq ($(HB_COMPILER),rsxnt) DIRS +=\ - ole2 \ + win32 \ odbc \ adordd \ - win32prn \ endif diff --git a/harbour/contrib/win32/Makefile b/harbour/contrib/win32/Makefile new file mode 100644 index 0000000000..97335e3bd2 --- /dev/null +++ b/harbour/contrib/win32/Makefile @@ -0,0 +1,18 @@ +# +# $Id$ +# + +ROOT = ../../ + +C_SOURCES=\ + tprinter.c \ + w32_ole.c \ + w32_prn.c \ + +PRG_SOURCES=\ + w32_tole.prg \ + w32_tprn.prg \ + +LIBNAME=hbwin32 + +include $(TOP)$(ROOT)config/lib.cf diff --git a/harbour/contrib/win32/make_b32.bat b/harbour/contrib/win32/make_b32.bat new file mode 100644 index 0000000000..5350471b2c --- /dev/null +++ b/harbour/contrib/win32/make_b32.bat @@ -0,0 +1,36 @@ +@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\hbwin32.lib ..\..\lib\*.* > nul + if exist ..\..\lib\b32\hbwin32.bak del ..\..\lib\b32\hbwin32.bak + goto EXIT + +:BUILD_ERR + + notepad make_b32.log + goto EXIT + +:CLEAN + if exist ..\..\lib\b32\hbwin32.lib del ..\..\lib\b32\hbwin32.lib + if exist ..\..\lib\b32\hbwin32.bak del ..\..\lib\b32\hbwin32.bak + if exist ..\..\obj\b32\tprinter.obj del ..\..\obj\b32\tprinter.obj + if exist ..\..\obj\b32\w32_ole.obj del ..\..\obj\b32\w32_ole.obj + if exist ..\..\obj\b32\w32_prn.obj del ..\..\obj\b32\w32_prn.obj + if exist ..\..\obj\b32\w32_tole.obj del ..\..\obj\b32\w32_tole.obj + if exist ..\..\obj\b32\w32_tprn.obj del ..\..\obj\b32\w32_tprn.obj + + goto EXIT + +:EXIT diff --git a/harbour/contrib/win32/make_vc.bat b/harbour/contrib/win32/make_vc.bat new file mode 100644 index 0000000000..59fdeae702 --- /dev/null +++ b/harbour/contrib/win32/make_vc.bat @@ -0,0 +1,21 @@ +@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\hbwin32.lib ..\..\lib\*.* >nul + goto EXIT + +:BUILD_ERR + + notepad make_vc.log + +:EXIT + diff --git a/harbour/contrib/win32/makefile.bc b/harbour/contrib/win32/makefile.bc new file mode 100644 index 0000000000..be59a5fd88 --- /dev/null +++ b/harbour/contrib/win32/makefile.bc @@ -0,0 +1,125 @@ +# +# $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)\hbwin32.lib + +HARBOUR_EXE = $(BIN_DIR)\harbour.exe + +# +# Rules +# + +# +# TOOLS.LIB rules +# + +TOOLS_LIB_OBJS = \ + $(OBJ_DIR)\tprinter.obj \ + $(OBJ_DIR)\w32_ole.obj \ + $(OBJ_DIR)\w32_prn.obj \ + \ + $(OBJ_DIR)\w32_tole.obj \ + $(OBJ_DIR)\w32_tprn.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_ole.obj : $(TOOLS_DIR)\w32_ole.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\w32_prn.obj : $(TOOLS_DIR)\w32_prn.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\w32_tole.c : $(TOOLS_DIR)\w32_tole.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\w32_tole.obj : $(OBJ_DIR)\w32_tole.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\w32_tprn.c : $(TOOLS_DIR)\w32_tprn.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\w32_tprn.obj : $(OBJ_DIR)\w32_tprn.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, diff --git a/harbour/contrib/win32/makefile.vc b/harbour/contrib/win32/makefile.vc new file mode 100644 index 0000000000..077908e9e8 --- /dev/null +++ b/harbour/contrib/win32/makefile.vc @@ -0,0 +1,145 @@ +# +# $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)\hbwin32.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_ole.obj \ + $(OBJ_DIR)\w32_prn.obj \ + \ + $(OBJ_DIR)\w32_tole.obj \ + $(OBJ_DIR)\w32_tprn.obj \ + +# +# Our default target +# + + +all: \ + $(TOOLS_LIB) + +CLEAN: + -@if exist $(OBJ_DIR)\tprinter.* del $(OBJ_DIR)\tprinter.* + -@if exist $(OBJ_DIR)\w32_ole.* del $(OBJ_DIR)\w32_ole.* + -@if exist $(OBJ_DIR)\w32_prn.* del $(OBJ_DIR)\w32_prn.* + -@if exist $(OBJ_DIR)\w32_tole.* del $(OBJ_DIR)\w32_tole.* + -@if exist $(OBJ_DIR)\w32_tprn.* del $(OBJ_DIR)\w32_tprn.* + -@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/tests/oleenum.prg b/harbour/contrib/win32/test/oleenum.prg similarity index 100% rename from harbour/tests/oleenum.prg rename to harbour/contrib/win32/test/oleenum.prg diff --git a/harbour/contrib/win32/test/testw32p.prg b/harbour/contrib/win32/test/testw32p.prg new file mode 100644 index 0000000000..5755b96f58 --- /dev/null +++ b/harbour/contrib/win32/test/testw32p.prg @@ -0,0 +1,154 @@ +/* + * $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/win32/tprinter.c b/harbour/contrib/win32/tprinter.c new file mode 100644 index 0000000000..016ebc4ef8 --- /dev/null +++ b/harbour/contrib/win32/tprinter.c @@ -0,0 +1,606 @@ +/* + * $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/win32/w32_ole.c b/harbour/contrib/win32/w32_ole.c new file mode 100644 index 0000000000..77a585dac2 --- /dev/null +++ b/harbour/contrib/win32/w32_ole.c @@ -0,0 +1,2196 @@ +/* + * $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/win32/w32_prn.c b/harbour/contrib/win32/w32_prn.c new file mode 100644 index 0000000000..de19c4622e --- /dev/null +++ b/harbour/contrib/win32/w32_prn.c @@ -0,0 +1,645 @@ +/* + * $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/win32/w32_tole.prg b/harbour/contrib/win32/w32_tole.prg new file mode 100644 index 0000000000..dd31c87673 --- /dev/null +++ b/harbour/contrib/win32/w32_tole.prg @@ -0,0 +1,677 @@ +/* + * $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/win32/w32_tprn.prg b/harbour/contrib/win32/w32_tprn.prg new file mode 100644 index 0000000000..b53f3adc63 --- /dev/null +++ b/harbour/contrib/win32/w32_tprn.prg @@ -0,0 +1,695 @@ +/* + * $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