fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2010-01-15 19:24 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* 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
This commit is contained in:
Przemyslaw Czerpak
2010-01-15 18:25:14 +00:00
parent 9b462b15d0
commit 0ee3aa6d4f
4 changed files with 90 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
harbour/ChangeLog
View File

@@ -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

30
harbour/contrib/hbwin/win_prn1.c
View File

@@ -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 )

56
harbour/contrib/hbwin/win_tprn.prg
View File

@@ -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 )

12
harbour/include/hbclass.ch
View File

@@ -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([<msg,...>]) => ;#error [ <msg>] ; #line
#endif
#xtranslate __HB_CLS_VARERR(<var>) => __HB_CLS_ERR( Invalid instance variable name: <var> )
#xtranslate __HB_CLS_VARERR(<var>) => __HB_CLS_ERR( Invalid instance variable name \<<var>> )
DECLARE HBClass ;
New( cName AS String, OPTIONAL SuperParams ) AS CLASS HBClass ;
@@ -309,7 +307,7 @@ DECLARE HBClass ;
DECLARED METHOD \<type> <MethodName>(\[ \<xparams>] ) CLASS <ClassName>
#xcommand METHOD <type: FUNCTION, PROCEDURE> <MethodName> CLASS <ClassName> _CLASS_IMPLEMENTATION_ => ;
__HB_CLS_ERR( Method <MethodName> not declared or declaration mismatch in class: <ClassName> ) ;;
__HB_CLS_ERR( Method \<<MethodName>> not declared or declaration mismatch in class \<<ClassName>> ) ;;
DECLARED METHOD <type> <MethodName> CLASS <ClassName>
#xcommand METHOD <MethodName> [ <ctor: CONSTRUCTOR> ] [ AS <type> ] [ <export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] [<persistent: PERSISTENT, PROPERTY>] [<sync: SYNC>] [_CLASS_DECLARATION_] => ;