Code: Select all
#include "fivewin.ch"
#define DT_TOP 0x00000000
#define DT_LEFT 0x00000000
#define DT_CENTER 0x00000001
#define DT_RIGHT 0x00000002
#define DT_VCENTER 0x00000004
#define DT_BOTTOM 0x00000008
#define DT_WORDBREAK 0x00000010
#define DT_SINGLELINE 0x00000020
#define DT_EXPANDTABS 0x00000040
#define DT_TABSTOP 0x00000080
#define DT_NOCLIP 0x00000100
#define DT_EXTERNALLEADING 0x00000200
#define DT_CALCRECT 0x00000400
#define DT_NOPREFIX 0x00000800
#define DT_INTERNAL 0x00001000
#xcommand ASSERT <uAction,...> ;
=> ;
if( eval({||<uAction>}), (MsgAlert( "Assert error : " + <(uAction)> + chr(10)+chr(13) + "Fichero: " + ProcFile() + chr(10)+chr(13) + "Funcion: " + ProcName() + chr(10)+chr(13) + "Línea: " + str(ProcLine()) + chr(10)+chr(13) ),__quit()), )
CLASS TDC
DATA m_lCompatible INIT .f.
DATA m_hDC
DATA m_hWnd INIT nil
DATA m_hOldPen INIT -1
DATA m_hOldBrush INIT -1
DATA m_hOldBmp INIT -1
DATA m_nOldTop, m_nOldLeft
DATA m_nOldMode
DATA m_nOldColor
DATA m_aGdis AS ARRAY INIT {}
METHOD GetDC ( hWnd ) CONSTRUCTOR // Ok
METHOD CompatibleDC( hDC ) CONSTRUCTOR // Ok
METHOD End()
METHOD SetTransparent() // Ok
METHOD SetSolid() // Ok
// Pen
METHOD CreatePen( nColor, nWidth, nStyle ) // Ok
METHOD SelectPen( hPen ) // Ok
METHOD DeletePen( hPen ) // Ok
METHOD BlackPen ( nWidth ) INLINE ::CreatePen( 0, nWidth, 0 )
METHOD GrayPen ( nWidth ) INLINE ::CreatePen( RGB( 128, 128, 128 ), nWidth, 0 )
METHOD LtGrayPen( nWidth ) INLINE ::CreatePen( RGB( 192, 192, 192 ), nWidth, 0 )
METHOD WhitePen ( nWidth ) INLINE ::CreatePen( RGB( 255, 255, 255 ), nWidth, 0 )
// Brush
METHOD CreateBrush( nColor ) // Ok
METHOD SelectBrush( hBrush ) // Ok
METHOD DeleteBrush( hBrush ) // Ok
METHOD GrayBrush() INLINE ::CreateBrush( RGB( 128, 128, 128 ) )
METHOD LtGrayBrush() INLINE ::CreateBrush( RGB( 192, 192, 192 ) )
METHOD WhiteBrush() INLINE ::CreateBrush( RGB( 255, 255, 255 ) )
// Images
METHOD LoadImage( cResName ) // Ok
METHOD ReadImage( cFileName ) // Ok
METHOD CreateCmpBitmap( nWidth, nHeight ) // Ok
METHOD SelectBitmap( hBitmap ) // Ok
METHOD DeleteBitmap( hBitmap ) // Ok
METHOD DrawImage( hImage, nTop, nLeft, nWidth, nHeight ) // Ok
METHOD DrawImageEx( hImage, nTop, nLeft ) // Ok
METHOD DrawDisable( hImage, nTop, nLeft ) // Ok
METHOD DrawTransparent( hImage, nTop, nLeft ) // Ok
METHOD MoveTo( nTop, nLeft ) INLINE MoveTo( ::m_hDC, nLeft, nTop )
METHOD Line( nTop, nLeft, nBottom, nRight ) // Ok
METHOD Rectangle( nTop, nLeft, nBottom, nRight ) // Ok
METHOD RectangleEx( nTop, nLeft, nWidth, nHeight ) // Ok
//METHOD BlackBox( nTop, nLeft, nBottom, nRight )
//METHOD BlackBoxEx( nTop, nLeft, nWidth, nHeight )
METHOD Circle( nTop, nLeft, nRadius ) // Ok
METHOD Ellipse( nTop, nLeft, nBottom, nRight ) // Ok
METHOD EllipseEx( nTop, nLeft, nWidth, nHeight ) // Ok
//METHOD DrawText( cText, nTop, nLeft, nBottom, nRight, nStyle )
//METHOD TextOut( cText, nTop, nLeft )
ENDCLASS
/********************************************************************************************/
METHOD GetDC( hWnd ) CLASS TDC
/********************************************************************************************/
DEFAULT hWnd := 0
::m_hWnd := hWnd
::m_hDC := GetDC( hWnd )
::m_nOldMode := GetBkMode( ::m_hDC )
::m_nOldColor := GetBkColor( ::m_hDC )
return self
/********************************************************************************************/
METHOD CompatibleDC( hDC ) CLASS TDC
/********************************************************************************************/
ASSERT empty( hDC )
if valtype( hDC ) == "O"
hDC := hDC:m_hDC
endif
::m_hDC := CreateCompatibleDC( hDC )
::m_lCompatible := .t.
::m_nOldMode := GetBkMode( ::m_hDC )
::m_nOldColor := GetBkColor( ::m_hDC )
return Self
/********************************************************************************************/
METHOD End() CLASS TDC
/********************************************************************************************/
local i
for i := 1 to len( ::m_aGdis )
DeleteObject( ::m_aGdis )
next
if ::m_lCompatible
DeleteDC( ::m_hDC )
else
ReleaseDC( ::m_hWnd, ::m_hDC )
endif
return nil
/********************************************************************************************/
METHOD SelectPen( hPen ) CLASS TDC
/********************************************************************************************/
if ::m_hOldPen > 0
SelectObject( ::m_hDC, ::m_hOldPen )
endif
::m_hOldPen := SelectObject( ::m_hDC, hPen )
return nil
/********************************************************************************************/
METHOD DeletePen( hPen ) CLASS TDC
/********************************************************************************************/
ASSERT empty( hPen )
if ::m_hOldPen > 0
SelectObject( ::m_hDC, ::m_hOldPen )
::m_hOldPen := -1
endif
DeleteObject( hPen )
return nil
/********************************************************************************************/
METHOD SelectBrush( hBrush )
/********************************************************************************************/
ASSERT empty( hBrush )
if ::m_hOldBrush > 0
SelectObject( ::m_hDC, ::m_hOldBrush )
endif
::m_hOldBrush := SelectObject( ::m_hDC, hBrush )
return nil
/********************************************************************************************/
METHOD DeleteBrush( hBrush ) CLASS TDC
/********************************************************************************************/
ASSERT empty( hBrush )
if ::m_oldBrush > 0
SelectObject( ::m_hDC, ::m_hOldBrush )
endif
DeleteObject( hBrush )
return nil
/********************************************************************************************/
METHOD SelectBitmap( hBitmap )
/********************************************************************************************/
ASSERT empty( hBitmap )
if ::m_hOldBmp > 0
SelectObject( ::m_hDC, ::m_hOldBmp )
endif
::m_hOldBmp := SelectObject( ::m_hDC, hBitmap )
return nil
/********************************************************************************************/
METHOD DeleteBitmap( hBitmap ) CLASS TDC
/********************************************************************************************/
ASSERT empty( hBitmap )
if ::m_oldBitmap > 0
SelectObject( ::m_hDC, ::m_hOldBitmap )
endif
DeleteObject( hBitmap )
return nil
/********************************************************************************************/
METHOD SetTransparent() CLASS TDC
/********************************************************************************************/
if ::m_oldMode != nil
SetBkMode( ::m_hDC, ::m_oldMode )
endif
::m_oldMode := SetBkMode( ::m_hDC, 1 ) // TRANSPARENT
return nil
/********************************************************************************************/
METHOD SetSolid() CLASS TDC
/********************************************************************************************/
if ::m_oldMode != nil
SetBkMode( ::m_hDC, ::m_oldMode )
endif
::m_oldMode := SetBkMode( ::m_hDC, 2 ) // SOLID
return nil
/********************************************************************************************/
METHOD Line( nTop, nLeft, nBottom, nRight ) CLASS TDC
/********************************************************************************************/
if pcount() == 2
// nTop y nLeft son en realidad el destino de la línea
nBottom := nTop
nRight := nLeft
nTop := ::nOldTop
nLeft := ::nOldLeft
endif
LineTo( ::m_hDC, nTop, nLeft, nBottom, nRight )
return nil
/********************************************************************************************/
METHOD Rectangle( nTop, nLeft, nBottom, nRight ) CLASS TDC
/********************************************************************************************/
if pcount() == 2
// nTop y nLeft son en realidad el destino de la línea
nBottom := nTop
nRight := nLeft
nTop := ::nOldTop
nLeft := ::nOldLeft
endif
Rectangle( ::m_hDC, nTop, nLeft, nBottom, nRight )
return nil
/********************************************************************************************/
METHOD RectangleEx( nTop, nLeft, nWidth, nHeight ) CLASS TDC
/********************************************************************************************/
Rectangle( ::m_hDC, nTop, nLeft, nTop + nHeight, nLeft + nWidth )
return nil
/********************************************************************************************/
METHOD Circle( nTCenter, nLCenter, nRadius ) CLASS TDC
/********************************************************************************************/
Ellipse( ::m_hDC, nLCenter-nRadius, nTCenter - nRadius, nLCenter + nRadius, nTCenter + nRadius )
return nil
/********************************************************************************************/
METHOD Ellipse( nTCenter, nLCenter, nWidth, nHeight ) CLASS TDC
/********************************************************************************************/
local nMedW := nWidth / 2
local nMedH := nHeight / 2
Ellipse( ::m_hDC, nLCenter - nMedW, nTCenter - nMedH, nLCenter + nMedW, nTCenter + nMedH )
return nil
/********************************************************************************************/
METHOD EllipseEx( nTop, nLeft, nBottom, nRight ) CLASS TDC
/********************************************************************************************/
Ellipse( ::m_hDC, nLeft, nTop, nRight, nBottom )
return nil
/********************************************************************************************/
METHOD CreatePen( nColor, nWidth, nStyle ) CLASS TDC
/********************************************************************************************/
DEFAULT nStyle := 0 // PS_SOLID
DEFAULT nWidth := 1
DEFAULT nColor := 0 // negro
local hPen
hPen := CreatePen( nStyle, nWidth, nColor )
aadd( ::m_aGdis, {hPen,.f.} )
return
/********************************************************************************************/
METHOD CreateBrush( nColor ) CLASS TDC
/********************************************************************************************/
DEFAULT nColor := RGB( 255, 255, 255 )
local hBrush
hBrush := CreateSolidBrush( nColor )
aadd( ::m_aGdis, {hBrush,.f.} )
return hBrush
/********************************************************************************************/
METHOD LoadImage( cResName ) CLASS TDC
/********************************************************************************************/
local hBmp
hBmp := PalBmpLoad( cResName )[1]
aadd( ::m_aGdis, {hBmp,.f.} )
return hBmp
/********************************************************************************************/
METHOD ReadImage( cFileName ) CLASS TDC
/********************************************************************************************/
local hBmp
if at( ".BMP", upper( cFileName ) ) > 0
hBmp := ReadBitmap( 0, cFileName )
else
hBmp := NViewLib32( AllTrim( cFileName ), 0 )
endif
aadd( ::m_aGdis, {hBmp,.f.} )
return hBmp
/********************************************************************************************/
METHOD CreateCmpBitmap( nWidth, nHeight ) CLASS TDC
/********************************************************************************************/
ASSERT empty( ::m_hDC )
local hBmp
hBmp := CreateCompatibleBitmap( ::m_hDC, nWidth, nHeight )
aadd( ::m_aGdis, {hBmp,.f.} )
return
/********************************************************************************************/
METHOD DrawImage( hImage, nTop, nLeft, nWidth, nHeight ) CLASS TDC
/********************************************************************************************/
DrawState( ::m_hDC, nil, hImage, nLeft, nTop, nWidth, nHeight, 4 )
return nil
/********************************************************************************************/
METHOD DrawTransparent( hImage, nTop, nLeft ) CLASS TDC
/********************************************************************************************/
DrawMasked( ::m_hDC, hImage, nTop, nLeft )
return nil
/********************************************************************************************/
METHOD DrawImageEx( hImage, nTop, nLeft ) CLASS TDC
/********************************************************************************************/
DrawState( ::m_hDC, nil, hImage, nLeft, nTop, bmpWidth( hImage ), bmpHeight( hImage ), 4 )
return nil
/********************************************************************************************/
METHOD DrawDisable( hImage, nTop, nLeft ) CLASS TDC
/********************************************************************************************/
DrawState( ::m_hDC, nil, hImage, nLeft, nTop, bmpWidth( hImage ), bmpHeight( hImage ), nOr( 4, 32 ) )
return nil
DLL32 Function NViewLib32( cName AS STRING, nShow AS LONG ) AS LONG PASCAL FROM "NViewLibLoad" LIB "nviewlib.dll"
#pragma BEGINDUMP
#include <windows.h>
#include <winuser.h>
#include "hbapi.h"
// #define DST_COMPLEX 0x0000
// #define DST_TEXT 0x0001
// #define DST_PREFIXTEXT 0x0002
// #define DST_ICON 0x0003
// #define DST_BITMAP 0x0004
HB_FUNC( DRAWSTATE )
{
hb_retl( DrawState( ( HDC ) hb_parnl( 1 ),
(HBRUSH) hb_parnl( 2 ),
NULL,
(LPARAM) hb_parnl( 3 ),
(WPARAM) 0 ,
hb_parni( 4 ),
hb_parni( 5 ),
hb_parni( 6 ),
hb_parni( 7 ),
hb_parnl( 8 ) ) );
}
HB_FUNC ( BMPHEIGHT )
{
BITMAP bm;
GetObject( ( HGDIOBJ ) hb_parnl( 1 ), sizeof( BITMAP ), ( LPSTR ) &bm );
hb_retnl( bm.bmHeight );
}
//---------------------------------------------------------------------------//
HB_FUNC ( BMPWIDTH )
{
BITMAP bm;
GetObject( ( HGDIOBJ ) hb_parnl( 1 ), sizeof( BITMAP ), ( LPSTR ) &bm );
hb_retnl( bm.bmWidth );
}
HB_FUNC( CREATECOMPATIBLEBITMAP )
{
hb_retnl( (LONG) CreateCompatibleBitmap( ( HDC ) hb_parnl( 1 ), hb_parni( 2 ), hb_parni( 3 ) ));
}
HB_FUNC( CREATECOMPATIBLEDC )
{
hb_retnl( (LONG) CreateCompatibleDC( ( HDC ) hb_parnl( 1 )));
}
HB_FUNC( GETBKMODE )
{
hb_retni( GetBkMode( ( HDC ) hb_parnl( 1 )));
}
#pragma ENDDUMP