www.FiveTechSoft.com
https://fivetechsoft.com/forums/
Code: Select all
*****************************************************************************
********************** Funciones útiles en Harbour & FWH ********************
********************** 10ª parte ********************************************
#include "FiveWin.ch"
#define TFOLDANG_000 1
#define TFOLDANG_090 2
#define TFOLDANG_180 3
#define TFOLDANG_270 4
#define OPAQUE 0
#define TRANSPARENT 1
#define CLR_AZULADITO_008 RGB( 255-016-008, 255-016-008, 255-016 )
#define COLOR_WINDOW 5 // window background // ver "WColors.ch"
#define CS_DBLCLKS 8 // ver "Windows.prg"
static oWindow
FUNCTION uFoldAng_test()
local oFoldAng1, oFoldAng2, oFoldAng3, oFoldAng4
local b1Action, b2Action, b3Action, b4Action
local acItems1 := { "Gargantilla", "Pendiente", "Sortija", "Pulsera" }
local acItems2 := { "Solitario", "Sello", "Cruces", "Colgante", "Varios" }
local acItems3 := { "Primera", "Segunda", "3ª" }
local acItems4 := { "1ª", "Segunda", "3ª", "Última" }
local aLetras1 := { "G", "P", "S", "V" }
local aLetras2 := { "O", "E", "C", "L", "X" }
local anColors1, anColors2, anColors3, anColors4
local nPenPixels := 002
local n1Inclin := TFOLDANG_000
local n2Inclin := TFOLDANG_270
local n3Inclin := TFOLDANG_180
local n4Inclin := TFOLDANG_090
local n1ItemInic // predeterminadamente, vale 1
local n2ItemInic := 5
local n3ItemInic := 2
local n4ItemInic := 3
local nAltoFolde := 023
local nTop1 := 047
local nLeft1 := 100
local nBottom1 := nTop1 + nAltoFolde - 1
local nRight1 := nLeft1 + 404
local nTop2 := nTop1 + nAltoFolde
local nLeft2 := nRight1
local nBottom2 := 517
local nRight2 := nLeft2 + nAltoFolde - 1
local nTop3 := nBottom2
local nLeft3 := nLeft1
local nBottom3 := nBottom2 + nAltoFolde
local nRight3 := nRight1
local nTop4 := nTop1 + nAltoFolde
local nLeft4 := nLeft1 - nAltoFolde
local nBottom4 := nBottom2
local nRight4 := nLeft1
DEFINE WINDOW oWindow ;
TITLE "Almacén de Joyas"
oFoldAng1 := TFoldAng():New( nTop1, nLeft1, ;
nBottom1, nRight1, ;
n1ItemInic, n1Inclin, ;
acItems1, anColors1, ;
b1Action, oWindow )
oFoldAng1:nPenPix := nPenPixels
oFoldAng1:nClrLine := CLR_CYAN
oFoldAng1:bAction := {| Self | ::oWnd:cTitle := ;
cTitle12( oFoldang1, oFoldang2, aLetras1, acItems1, aLetras2, acItems2 ) ;
}
oFoldAng2 := TFoldAng():New( nTop2, nLeft2, ;
nBottom2, nRight2, ;
n2ItemInic, n2Inclin, ;
acItems2, anColors2, ;
b2Action, oWindow )
oFoldAng2:nPenPix := nPenPixels
oFoldAng2:bAction := {| Self | ::nClrLine := ::nRgbCicl(), ;
::oWnd:cTitle := ;
cTitle12( oFoldang1, oFoldang2, aLetras1, acItems1, aLetras2, acItems2 ) ;
}
oFoldAng3 := TFoldAng():New( nTop3, nLeft3, ;
nBottom3, nRight3, ;
n3ItemInic, n3Inclin, ;
acItems3, anColors3, ;
b3Action, oWindow )
oFoldAng3:bAction := {| Self | ::nClrLine := ::nRgbCicl() ;
}
oFoldAng4 := TFoldAng():New( nTop4, nLeft4, ;
nBottom4, nRight4, ;
n4ItemInic, n4Inclin, ;
acItems4, anColors4, ;
b4Action, oWindow )
oFoldAng4:bAction := {| Self | ::nClrLine := ::nRgbCicl() ;
}
ACTIVATE WINDOW oWindow ;
MAXIMIZED
RETURN NIL
//
static FUNCTION cTitle12( oFoldang1, oFoldang2, aLetras1, acItems1, ;
aLetras2, acItems2 )
local c := aLetras1[ oFoldang1:nOption ] + " : " + acItems1[ oFoldang1:nOption ]
c += " / "
c += aLetras2[ oFoldang2:nOption ] + " : " + acItems2[ oFoldang2:nOption ]
RETURN c
///////////////////////////////////////////////////////////////////////////
CLASS TFoldAng FROM TControl
CLASSDATA lRegistered AS LOGICAL
DATA bAction
DATA acItems, anWidthPix, anArcDegred, anColors
DATA nOption, nItem, ;
nClrSiSele, nClrBkSele, nClrNoSele, nClrLine, ;
nInclin, nDegreds, ;
nPenPix
METHOD New( nTop, nLeft, nBottom, nRight, ;
nOption, nInclin, ;
acItems, anColors, ;
bAction, oWnd ) CONSTRUCTOR
METHOD Register( nClsStyle )
METHOD nHeight() INLINE ::nBottom - ::nTop - 1
METHOD nWidth() INLINE ::nRight - ::nLeft - 1
METHOD LButtonDown( nRow, nCol, nKeyFlags )
METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
METHOD Paint()
METHOD PaintItem()
METHOD nTopTxt()
METHOD nLeftTxt()
METHOD nLeftItem()
METHOD nRightItem()
METHOD nRgbCicl()
METHOD GiraFont( nArcDegred )
METHOD Length()
ENDCLASS
METHOD New( nTop, nLeft, nBottom, nRight, ;
nOption, nInclin, ;
acItems, anColors, ;
bAction, oWnd ) CLASS TFoldAng
local n, nAncho
local cTitle, cMsg
DEFAULT nTop := 012, nLeft := 420, ;
nBottom := 400, nRight := 451
DEFAULT nOption := 1, ;
nInclin := TFOLDANG_270
If nInclin < TFOLDANG_000 .or. nInclin > TFOLDANG_270
cTitle := 'TFoldAng():New( nTop, nLeft, nBottom, nRight, ' + ;
'nOption, nInclin, acItems, anColors, bAction, oWnd )'
cMsg := 'Parámetro nInclin con valor incorrecto:' + Str( nInclin )
MsgStop( cMsg, cTitle )
QUIT ///
End
DEFAULT acItems := { "Uno", "Dos", "Tres" }, ; // no funcionan los "&"
anColors := {}
DEFAULT bAction := {| Self | Tone( 234, 1 ) }
DEFAULT oWnd := GetWndDefault()
::nPenPix := 1
::nInclin := nInclin
::nClrNoSele := CLR_HGRAY
::nClrSiSele := CLR_WHITE
::nClrBkSele := CLR_HGRAY
::nClrLine := CLR_CYAN
::nTop := nTop
::nLeft := nLeft
::nBottom := nBottom
::nRight := nRight
::nOption := nOption
::nItem := 1 // el ítem que se está pintando
::acItems := acItems
::anArcDegred := { 000, 090, 000, 270 }
::anColors := anColors
::anWidthPix := {}
::bAction := bAction
::oWnd := oWnd
::nStyle := nOR( WS_CHILD, WS_VISIBLE, WS_TABSTOP )
::nDegreds := ::anArcDegred[ ::nInclin ]
::GiraFont( ::nDegreds )
If Empty( anColors )
aEval( acItems, {| cItem, nI | aAdd( ::anColors, ::nRgbCicl() ) } )
End
For n := 1 To Len( ::acItems )
nAncho := ::GetWidth( ::acItems[ n ], ::oFont ) + 060
aAdd( ::anWidthPix, nAncho )
Next
::Register()
If Empty( oWnd:hWnd )
oWnd:DefControl( Self )
Else
::Create()
oWnd:AddControl( Self )
End
RETURN Self
METHOD Register( nClsStyle ) CLASS TFoldAng
local oBrush
local hUser, nClrPane
DEFAULT ::lRegistered := .f.
If ::lRegistered
RETURN NIL ///
End
#ifdef __CLIPPER__
hUser := GetModuleHandle( "user.exe" )
#else
hUser := GetInstance()
#endif
DEFAULT nClsStyle := nOR( CS_VREDRAW, CS_HREDRAW ),;
nClrPane := GetSysColor( COLOR_WINDOW ), ;
oBrush := TBrush():New( , nClrPane )
nClsStyle := nOr( nClsStyle, CS_GLOBALCLASS, CS_DBLCLKS )
If GetClassInfo( hUser, ::ClassName()/*"TSAYTRANS"*/ ) == NIL
::lRegistered := RegisterClass( ;
::ClassName(), nClsStyle,,, hUser, 0, oBrush:hBrush )
Else
::lRegistered := .t.
End
oBrush:End()
RETURN NIL
METHOD Length() CLASS TFoldAng
local n, nLen := ::anWidthPix[ 1 ] // al menos hay un ítem, así que esto no produce un error
For n := 2 To Len( ::anWidthPix )
nLen += ::anWidthPix[ n ] - 020
Next
RETURN nLen
METHOD nLeftItem() CLASS TFoldAng
local n, nAux := 0
If ::nItem == 1
RETURN 0 ///
End
For n := 2 To ::nItem
nAux += ::anWidthPix[ n - 1 ] - 020
Next
RETURN nAux
METHOD nRightItem() CLASS TFoldAng
RETURN ( ::nLeftItem() + ::anWidthPix[ ::nItem ] )
METHOD nTopTxt() CLASS TFoldAng
local nPos
If ::nInclin = TFOLDANG_000
nPos := ( ::nHeight() - ::nGetChrHeight() ) / 2
ElseIf ::nInclin = TFOLDANG_090
nPos := ::nRightItem() - 030
ElseIf ::nInclin = TFOLDANG_180
nPos := ( ::nHeight() - ::nGetChrHeight() ) / 2
ElseIf ::nInclin = TFOLDANG_270
nPos := ::nLeftItem() + 030
End
RETURN nPos
METHOD nLeftTxt() CLASS TFoldAng
local nPos
If ::nInclin = TFOLDANG_000
nPos := ::nLeftItem() + 030
ElseIf ::nInclin = TFOLDANG_090
nPos := ( ::nWidth() - ::nGetChrHeight() ) / 2 + 001
ElseIf ::nInclin = TFOLDANG_180
nPos := ::nLeftItem() + 030
ElseIf ::nInclin = TFOLDANG_270
nPos := ( ::nGetChrHeight() + ::nWidth() ) / 2 + 001
End
RETURN nPos
METHOD nRgbCicl() CLASS TFoldAng
static nColor := CLR_GRAY ///
If nColor == CLR_BLACK
nColor := CLR_GRAY
ElseIf nColor == CLR_GRAY
nColor := CLR_BLUE
ElseIf nColor == CLR_BLUE
nColor := CLR_CYAN
ElseIf nColor == CLR_CYAN
nColor := CLR_RED
ElseIf nColor == CLR_RED
nColor := CLR_MAGENTA
ElseIf nColor == CLR_MAGENTA
nColor := CLR_GREEN
ElseIf nColor == CLR_GREEN
nColor := CLR_BROWN
ElseIf nColor == CLR_BROWN
nColor := CLR_BLACK ///
End
RETURN nColor
METHOD GiraFont( nArcDegred ) CLASS TFoldAng
local lReBuild := ( ValType( ::oFont ) = "O" )
If lReBuild
::oFont:End()
End
DEFINE FONT ::oFont ;
NAME "Arial" ;
SIZE 006, 013 ;
NESCAPEMENT nArcDegred * 10 // truco para que el texto salga tumbado (funciona sólo con fonts TrueType)
If lReBuild
::Refresh()
End
RETURN NIL
METHOD Paint() CLASS TFoldAng
local n, nLen := Len( ::acItems )
For n := 1 To nLen
::nItem := n
If n == ::nOption
if nLen == 1
Exit ///
end
Loop ///
End
::PaintItem()
Next
::nItem := ::nOption
::PaintItem()
RETURN NIL
METHOD PaintItem() CLASS TFoldAng // actúa en función de ::nItem ::nOption ::nInclin
local an2
local nColor := ::anColors[ ::nItem ]
local nWidth := ::nWidth()
local nHeight := ::nHeight()
local nTopTxt := ::nTopTxt()
local nLeftTxt := ::nLeftTxt()
local nLeftItem := ::nLeftItem()
local nRightItem := ::nRightItem()
local hDC := ::GetDC()
local hPen := CreatePen( PS_SOLID, ::nPenPix, nColor )
local hOldPen, nOldColor, hOldBrush, hOldFont, nOldMode, hBrush, hPenLine
local cPrompt := ::acItems[ ::nItem ]
If ::nItem = ::nOption
hBrush := CreateSolidBrush( ::nClrBkSele )
Else
hBrush := CreateSolidBrush( nColor )
End
If ::nInclin = TFOLDANG_000
an2 := { { nLeftItem , nHeight },;
{ nLeftItem + 4, nHeight - 2 },;
{ nLeftItem + 6, nHeight - 4 },;
{ nLeftItem + 7, nHeight - 7 },;
{ nLeftItem + 7, 7 },;
{ nLeftItem + 8, 4 },;
{ nLeftItem + 10, 2 },;
{ nLeftItem + 13, 0 },;
{ nRightItem - 13, 0 },;
{ nRightItem - 10, 2 },;
{ nRightItem - 8, 4 },;
{ nRightItem - 7, 7 },;
{ nRightItem - 7, nHeight - 7 },;
{ nRightItem - 6, nHeight - 4 },;
{ nRightItem - 4, nHeight - 2 },;
{ nRightItem , nHeight },;
{ nLeftItem , nHeight } ;
}
ElseIf ::nInclin = TFOLDANG_090
an2 := { { nWidth , nLeftItem },;
{ nWidth - 2, nLeftItem + 4 },;
{ nWidth - 4, nLeftItem + 6 },;
{ nWidth - 7, nLeftItem + 7 },;
{ 7, nLeftItem + 7 },;
{ 4, nLeftItem + 8 },;
{ 2, nLeftItem + 10 },;
{ 0, nLeftItem + 13 },;
{ 0, nRightItem - 13 },;
{ 2, nRightItem - 10 },;
{ 4, nRightItem - 8 },;
{ 7, nRightItem - 7 },;
{ nWidth - 7, nRightItem - 7 },;
{ nWidth - 4, nRightItem - 6 },;
{ nWidth - 2, nRightItem - 4 },;
{ nWidth , nRightItem },;
{ nWidth , nLeftItem } ;
}
ElseIf ::nInclin = TFOLDANG_180
an2 := { { nLeftItem , 0 },;
{ nLeftItem + 4, 2 },;
{ nLeftItem + 6, 4 },;
{ nLeftItem + 7, 7 },;
{ nLeftItem + 7, nHeight - 7 },;
{ nLeftItem + 8, nHeight - 4 },;
{ nLeftItem + 10, nHeight - 2 },;
{ nLeftItem + 13, nHeight },;
{ nRightItem - 13, nHeight },;
{ nRightItem - 10, nHeight - 2 },;
{ nRightItem - 8, nHeight - 4 },;
{ nRightItem - 7, nHeight - 7 },;
{ nRightItem - 7, 7 },;
{ nRightItem - 6, 4 },;
{ nRightItem - 4, 2 },;
{ nRightItem , 0 },;
{ nLeftItem , 0 } ;
}
ElseIf ::nInclin = TFOLDANG_270
an2 := { { 0, nLeftItem },;
{ 2, nLeftItem + 4 },;
{ 4, nLeftItem + 6 },;
{ 7, nLeftItem + 7 },;
{ nWidth - 7, nLeftItem + 7 },;
{ nWidth - 4, nLeftItem + 8 },;
{ nWidth - 2, nLeftItem + 10 },;
{ nWidth , nLeftItem + 13 },;
{ nWidth , nRightItem - 13 },;
{ nWidth - 2, nRightItem - 10 },;
{ nWidth - 4, nRightItem - 8 },;
{ nWidth - 7, nRightItem - 7 },;
{ 7, nRightItem - 7 },;
{ 4, nRightItem - 6 },;
{ 2, nRightItem - 4 },;
{ 0, nRightItem },;
{ 0, nLeftItem } ;
}
End
hOldBrush := SelectObject( hDC, hBrush )
hOldPen := SelectObject( hDC, hPen )
PolyPolygon( hDC, an2 ) ///
SelectObject( hDC, hOldPen )
DeleteObject( hPen )
SelectObject( hDC, hOldBrush )
DeleteObject( hBrush )
hPenLine := CreatePen( PS_SOLID, ::nPenPix, ::nClrLine )
hOldPen := SelectObject( hDC, hPenLine )
If ::nInclin = TFOLDANG_000
MoveTo( hDC, 000, nHeight )
LineTo( hDC, nWidth, nHeight )
ElseIf ::nInclin = TFOLDANG_090
MoveTo( hDC, nWidth, 000 )
LineTo( hDC, nWidth, nHeight )
ElseIf ::nInclin = TFOLDANG_180
MoveTo( hDC, 000, 000 )
LineTo( hDC, nWidth, 000 )
ElseIf ::nInclin = TFOLDANG_270
MoveTo( hDC, 000, 000 )
LineTo( hDC, 000, nHeight )
End
SelectObject( hDC, hOldPen )
DeleteObject( hPenLine )
nOldMode := SetBkMode( hDC, TRANSPARENT ) // TextOut() respetará el color de background
hOldFont := SelectObject( hDC, ::oFont:hFont )
If ::nItem = ::nOption
nOldColor := SetTextColor( hDC, ::nClrSiSele )
Else
nOldColor := SetTextColor( hDC, ::nClrNoSele )
End
TextOut( hDC, nTopTxt, nLeftTxt, cPrompt ) ///
SetTextColor( hDC, nOldColor )
SelectObject( hDC, hOldFont )
SetBkMode( hDC, nOldMode )
::ReleaseDC()
RETURN NIL
METHOD LButtonDown( nRow, nCol, nKeyFlags ) CLASS TFoldAng
local n, nLen := Len( ::acItems )
::SetFocus()
IF ::nInclin = TFOLDANG_000
For n := 1 To nLen
::nItem := n // para que ::nLeftItem() y ::nRightItem() devuelvan los valores correctos
If nCol > ::nLeftItem() .and. nCol < ::nRightItem() ///
::nOption := n
::Refresh()
if ::bAction != NIL
Eval( ::bAction, Self )
Exit ///