diff --git a/harbour/ChangeLog b/harbour/ChangeLog index f68d505eb1..7bc0d62602 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -17,6 +17,26 @@ past entries belonging to author(s): Viktor Szakats. */ +2010-01-15 19:24 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/include/hbclass.ch + * enable strict parameters validation in method declaration and + implementation when warning level (-w?) is 3 or higher + * small modification in error messages + + * harbour/contrib/hbwin/win_prn1.c + ! fixed WIN_FILLRECT() to return logical value (result of FillRect() + function) + + extended WIN_SETPEN() to accept previously created by this function + HPEN handles + ! fixed WIN_SETCOLOR() to return previously allocated color. + This function is used in such context in WIN_PRN class. + + * harbour/contrib/hbwin/win_tprn.prg + + added PageNumber member + ! fixed printer output detection to respect also graphic primitives + ! fixed SetColor() not changed to win_SetColor() when code was ported + from xHarbour + 2010-01-15 17:33 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) * src/vm/cmdarg.c * contrib/hbct/disk.c diff --git a/harbour/contrib/hbwin/win_prn1.c b/harbour/contrib/hbwin/win_prn1.c index 99d73861ab..7ce229a0d9 100644 --- a/harbour/contrib/hbwin/win_prn1.c +++ b/harbour/contrib/hbwin/win_prn1.c @@ -132,6 +132,13 @@ static const HB_GC_FUNCS s_gc_HPEN_funcs = hb_gcDummyMark }; +static HPEN win_HPEN_par( int iParam ) +{ + void ** ph = ( void ** ) hb_parptrGC( &s_gc_HPEN_funcs, iParam ); + + return ph ? ( HPEN ) * ph : ( HPEN ) hb_parptr( iParam ); +} + static HB_GARBAGE_FUNC( win_HFONT_release ) { void ** ph = ( void ** ) Cargo; @@ -641,7 +648,10 @@ HB_FUNC( WIN_SETCOLOR ) if( hDC ) { - SetTextColor( hDC, ( COLORREF ) hb_parnl( 2 ) ); + if( HB_ISNUM( 2 ) ) + hb_retnl( ( long ) SetTextColor( hDC, ( COLORREF ) hb_parnl( 2 ) ) ); + else + hb_retnl( ( long ) GetTextColor( hDC ) ); if( HB_ISNUM( 3 ) ) SetBkColor( hDC, ( COLORREF ) hb_parnl( 3 ) ); @@ -649,6 +659,8 @@ HB_FUNC( WIN_SETCOLOR ) if( HB_ISNUM( 4 ) ) SetTextAlign( hDC, hb_parni( 4 ) ); } + else + hb_retnl( ( long ) CLR_INVALID ); } HB_FUNC( WIN_SETPEN ) @@ -659,10 +671,13 @@ HB_FUNC( WIN_SETPEN ) { HPEN hPen; - hPen = CreatePen( hb_parni( 2 ), /* pen style */ - hb_parni( 3 ), /* pen width */ - ( COLORREF ) hb_parnl( 4 ) /* pen color */ - ); + if( HB_ISPOINTER( 2 ) ) + hPen = win_HPEN_par( 1 ); + else + hPen = CreatePen( hb_parni( 2 ), /* pen style */ + hb_parni( 3 ), /* pen width */ + ( COLORREF ) hb_parnl( 4 ) /* pen color */ + ); if( hPen ) { @@ -682,6 +697,7 @@ HB_FUNC( WIN_SETPEN ) HB_FUNC( WIN_FILLRECT ) { HDC hDC = win_HDC_par( 1 ); + HB_BOOL fResult = HB_FALSE; if( hDC ) { @@ -693,10 +709,12 @@ HB_FUNC( WIN_FILLRECT ) rct.right = hb_parnl( 4 ); rct.bottom = hb_parnl( 5 ); - FillRect( hDC, &rct, hBrush ); + if( FillRect( hDC, &rct, hBrush ) ) + fResult = HB_TRUE; DeleteObject( hBrush ); } + hb_retl( fResult ); } HB_FUNC( WIN_LINETO ) diff --git a/harbour/contrib/hbwin/win_tprn.prg b/harbour/contrib/hbwin/win_tprn.prg index 12da417fa6..828bdc7851 100644 --- a/harbour/contrib/hbwin/win_tprn.prg +++ b/harbour/contrib/hbwin/win_tprn.prg @@ -146,6 +146,7 @@ CREATE CLASS WIN_PRN VAR PrinterName INIT "" VAR Printing INIT .F. VAR HavePrinted INIT .F. + VAR PageNumber INIT 0 VAR hPrinterDc INIT 0 // These next 4 variables must be set before calling ::Create() if @@ -166,8 +167,8 @@ CREATE CLASS WIN_PRN 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 PixelsPerInchY INIT 0 + VAR PixelsPerInchX INIT 0 VAR PageHeight INIT 0 VAR PageWidth INIT 0 VAR TopMargin INIT 0 @@ -241,6 +242,7 @@ METHOD Create() CLASS WIN_PRN // Set the standard font ::SetDefaultFont() + ::PageNumber := 0 ::HavePrinted := ::Printing := .F. ::fOldFormType := ::FormType // Last formtype used ::fOldLandScape := ::LandScape @@ -288,6 +290,7 @@ METHOD EndDoc( lAbortDoc ) CLASS WIN_PRN ENDIF ::Printing := .F. ::HavePrinted := .F. + ::PageNumber := 0 RETURN .T. METHOD StartPage() CLASS WIN_PRN @@ -322,6 +325,7 @@ METHOD StartPage() CLASS WIN_PRN win_SetDocumentProperties( ::hPrinterDC, ::PrinterName, nLFormType, lLLandscape, , nLBinNumber, nLDuplexType, nLPrintQuality ) ENDIF win_StartPage( ::hPrinterDC ) + ::PageNumber++ ::PosX := ::LeftMargin ::PosY := ::TopMargin RETURN .T. @@ -481,7 +485,9 @@ METHOD SetColor( nClrText, nClrPane, nAlign ) CLASS WIN_PRN RETURN win_SetColor( ::hPrinterDC, nClrText, nClrPane, nAlign ) METHOD TextOut( cString, lNewLine, lUpdatePosX, nAlign ) CLASS WIN_PRN + LOCAL lResult := .F. LOCAL nPosX + LOCAL hPen IF cString != NIL @@ -491,7 +497,7 @@ METHOD TextOut( cString, lNewLine, lUpdatePosX, nAlign ) CLASS WIN_PRN nPosX := win_TextOut( ::hPrinterDC, ::PosX, ::PosY, cString, Len( cString ), ::fCharWidth, nAlign ) - ::HavePrinted := .T. + ::HavePrinted := lResult := .T. IF lUpdatePosX ::PosX += nPosX @@ -501,12 +507,11 @@ METHOD TextOut( cString, lNewLine, lUpdatePosX, nAlign ) CLASS WIN_PRN ENDIF ENDIF - RETURN .T. + RETURN lResult METHOD TextOutAt( nPosX, nPosY, cString, lNewLine, lUpdatePosX, nAlign ) CLASS WIN_PRN ::SetPos( nPosX, nPosY ) - ::TextOut( cString, lNewLine, lUpdatePosX, nAlign ) - RETURN .T. + RETURN ::TextOut( cString, lNewLine, lUpdatePosX, nAlign ) METHOD SetPen( nStyle, nWidth, nColor ) CLASS WIN_PRN ::PenStyle := nStyle @@ -515,19 +520,39 @@ METHOD SetPen( nStyle, nWidth, nColor ) CLASS WIN_PRN RETURN ! Empty( ::hPen := win_SetPen(::hPrinterDC, nStyle, nWidth, nColor ) ) METHOD Line( nX1, nY1, nX2, nY2 ) CLASS WIN_PRN - RETURN win_LineTo( ::hPrinterDC, nX1, nY1, nX2, nY2 ) + LOCAL lResult := win_LineTo( ::hPrinterDC, nX1, nY1, nX2, nY2 ) + IF lResult + ::HavePrinted := .T. + ENDIF + RETURN lResult METHOD Box( nX1, nY1, nX2, nY2, nWidth, nHeight ) CLASS WIN_PRN - RETURN win_Rectangle( ::hPrinterDC, nX1, nY1, nX2, nY2, nWidth, nHeight ) + LOCAL lResult := win_Rectangle( ::hPrinterDC, nX1, nY1, nX2, nY2, nWidth, nHeight ) + IF lResult + ::HavePrinted := .T. + ENDIF + RETURN lResult METHOD Arc( nX1, nY1, nX2, nY2 ) CLASS WIN_PRN - RETURN win_Arc( ::hPrinterDC, nX1, nY1, nX2, nY2 ) + LOCAL lResult := win_Arc( ::hPrinterDC, nX1, nY1, nX2, nY2 ) + IF lResult + ::HavePrinted := .T. + ENDIF + RETURN lResult METHOD Ellipse( nX1, nY1, nX2, nY2 ) CLASS WIN_PRN - RETURN win_Ellipse( ::hPrinterDC, nX1, nY1, nX2, nY2 ) + LOCAL lResult := win_Ellipse( ::hPrinterDC, nX1, nY1, nX2, nY2 ) + IF lResult + ::HavePrinted := .T. + ENDIF + RETURN lResult METHOD FillRect( nX1, nY1, nX2, nY2, nColor ) CLASS WIN_PRN - RETURN win_FillRect( ::hPrinterDC, nX1, nY1, nX2, nY2, nColor ) + LOCAL lResult := win_FillRect( ::hPrinterDC, nX1, nY1, nX2, nY2, nColor ) + IF lResult + ::HavePrinted := .T. + ENDIF + RETURN lResult METHOD GetCharWidth() CLASS WIN_PRN LOCAL nWidth @@ -592,6 +617,7 @@ METHOD Inch_To_PosY( nInch ) CLASS WIN_PRN METHOD TextAtFont( nPosX, nPosY, cString, cFont, nPointSize, nWidth, nBold, lUnderLine, lItalic, nCharSet, lNewLine, lUpdatePosX, nColor, nAlign ) CLASS WIN_PRN LOCAL lCreated := .F. + LOCAL lResult LOCAL nDiv := 0 LOCAL cType @@ -608,16 +634,16 @@ METHOD TextAtFont( nPosX, nPosY, cString, cFont, nPointSize, nWidth, nBold, lUnd lCreated := ! Empty( ::hFont := win_CreateFont( ::hPrinterDC, cFont, nPointSize, nDiv, nWidth, nBold, lUnderLine, lItalic, nCharSet ) ) ENDIF IF nColor != NIL - nColor := SetColor( ::hPrinterDC, nColor ) + nColor := win_SetColor( ::hPrinterDC, nColor ) ENDIF - ::TextOutAt( nPosX, nPosY, cString, lNewLine, lUpdatePosX, nAlign) + lResult := ::TextOutAt( nPosX, nPosY, cString, lNewLine, lUpdatePosX, nAlign) IF lCreated ::SetFont() // Reset font ENDIF IF nColor != NIL - SetColor( ::hPrinterDC, nColor ) // Reset Color + win_SetColor( ::hPrinterDC, nColor ) // Reset Color ENDIF - RETURN .T. + RETURN lResult METHOD SetBkMode( nMode ) CLASS WIN_PRN RETURN win_SetBkMode( ::hPrinterDc, nMode ) diff --git a/harbour/include/hbclass.ch b/harbour/include/hbclass.ch index cd06ee93e9..9cd855fe21 100644 --- a/harbour/include/hbclass.ch +++ b/harbour/include/hbclass.ch @@ -147,11 +147,9 @@ #endif #endif -/* - * I have to enable this definition by default until we will not fix - * preprocessor. [druzus] - */ -#ifndef HB_CLS_PARAMS_ERR +/* disable strict parameters validation in method declaration and + implementation when warning level (-w?) is not 3 or higher */ +#if __pragma( WARNINGLEVEL ) < 3 #ifndef HB_CLS_NO_PARAMS_ERR #define HB_CLS_NO_PARAMS_ERR #endif @@ -207,7 +205,7 @@ #xtranslate __HB_CLS_ERR([]) => ;#error [ ] ; #line #endif -#xtranslate __HB_CLS_VARERR() => __HB_CLS_ERR( Invalid instance variable name: ) +#xtranslate __HB_CLS_VARERR() => __HB_CLS_ERR( Invalid instance variable name \<> ) DECLARE HBClass ; New( cName AS String, OPTIONAL SuperParams ) AS CLASS HBClass ; @@ -309,7 +307,7 @@ DECLARE HBClass ; DECLARED METHOD \ (\[ \] ) CLASS #xcommand METHOD CLASS _CLASS_IMPLEMENTATION_ => ; - __HB_CLS_ERR( Method not declared or declaration mismatch in class: ) ;; + __HB_CLS_ERR( Method \<> not declared or declaration mismatch in class \<> ) ;; DECLARED METHOD CLASS #xcommand METHOD [ ] [ AS ] [ ] [] [