www.FiveTechSoft.com
by carlos vargas » Sun Apr 14, 2024 6:10 pm
tGet():bColorBlock := { |oGet| IIf( oGet:lFocused, { CLR_BLACK, CLR_MENTA }, IIf( !oGet:lActive, { CLR_BLUE, CLR_SOFTYELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }
by Antonio Linares » Mon Apr 15, 2024 11:58 am
#include "FiveWin.ch"
function Main()
local oDlg, oGet1, oGet3
local cTest1, cTest2, cTest3, cTest4
cTest1 := cTest2 := cTest3 := cTest4 := PadR( "Hello world", 30 )
TGet():bColorBlock := { |oGet| If( oGet:lFocused, { CLR_BLACK, CLR_GREEN },;
If( ! oGet:lActive, { CLR_RED, CLR_YELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }
TMultiGet():bColorBlock := { |oGet| If( oGet:lFocused, { CLR_BLACK, CLR_GREEN },;
If( ! oGet:lActive, { CLR_RED, CLR_YELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }
DEFINE DIALOG oDlg SIZE 500, 300
@ 1, 1 GET oGet1 VAR cTest1
@ 2, 1 GET cTest2
@ 3, 1 GET oGet3 VAR cTest3 MULTILINE SIZE 240, 30
@ 6, 1 GET cTest4 MULTILINE SIZE 240, 30
ACTIVATE DIALOG oDlg CENTERED ;
ON INIT ( oGet1:Disable(), oGet3:Disable(), .T. )
return nil #include "FiveWin.ch"
#include "Constant.ch"
#include "Set.ch"
#include "print.ch"
#ifdef __CLIPPER__
#define EM_GETSEL (WM_USER+0)
#define EM_SETSEL (WM_USER+1)
#define EM_UNDO (WM_USER+23)
#define EM_LINEFROMCHAR (WM_USER+25)
#define EM_GETLINECOUNT (WM_USER+10)
#define EM_LINEINDEX (WM_USER+11)
#define EM_CANUNDO (WM_USER+22)
#else
#define EM_GETSEL 176
#define EM_SETSEL 177
#define EM_UNDO 199
#define EM_LINEFROMCHAR 201
#define EM_LINESCROLL 182
#define EM_GETLINECOUNT 186
#define EM_LINEINDEX 187
#define EM_CANUNDO 198
#ifdef __XPP__
#define ::Super ::TControl
#define New _New
#define GetNew _GetNew
#define GetDelSel _GetDelSel
#endif
#endif
#define COLOR_WINDOW 5
#define COLOR_WINDOWTEXT 8
#define ES_CENTER 1
#define WM_ERASEBKGND 20
#define WM_SETFONT 48
#define WM_CUT 768 // 0x300
#define WM_PASTE 770 // 0x302
#define WM_CLEAR 771 // 0x303
#define CW_USEDEFAULT 32768
#define GWL_STYLE ( -16)
#define EM_LIMITTEXT 197
#define EM_SCROLLCARET ( WM_USER + 49 )
#define WS_EX_CLIENTEDGE 512
#define EM_SETLIMITTEXT 0x00C5
static tmp
//----------------------------------------------------------------------------//
CLASS TMultiGet FROM TControl
DATA lReadOnly
DATA nPos
DATA hHeap
DATA nOldClrPane // Old background color, if color changed with focus
DATA bColor
ACCESS aColor INLINE ( tmp := Eval( ::bColor, Self ), If( HB_ISARRAY( tmp ), AClone( tmp ), { tmp, ::nClrPane } ) )
CLASSDATA lClrFocus INIT .F. // change GET color when focused
CLASSDATA nClrFocus INIT nRGB( 235, 235, 145 ) // color to use when GET is focused and lClrFocus is .T.
CLASSDATA lChangeCaret INIT .T.
CLASSDATA bColorBlock
METHOD New( nRow, nCol, bSetGet, oWnd, nWidth, nHeight, oFont, lHScroll,;
nClrFore, nClrBack, oCursor, lPixel, cMsg, lUpdate,;
bWhen, lCenter, lRight, lReadOnly, bValid, bChanged,;
lDesign, lNoBorder, lNoVScroll ) CONSTRUCTOR
METHOD ReDefine( nId, bSetGet, oWnd, nHelpId, nClrFore, nClrBack, oFont,;
oCursor, cMsg, lUpdate, bWhen, lReadOnly, bValid,;
bChanged ) CONSTRUCTOR
METHOD AdjClient() INLINE ::Super:AdjClient(), MoveGet( ::hWnd )
#ifndef __HARBOUR__
METHOD Append( cText, nLen ) INLINE ;
nLen := ::Len() ,;
SendMessage( ::hWnd, EM_SETSEL, 0,;
nMakeLong( nLen, nLen ) ),;
::Replace( cText )
#else
METHOD Append( cText, nLen ) INLINE ;
nLen := ::Len() ,;
SendMessage( ::hWnd, EM_SETSEL, nLen, nLen ),;
::Replace( cText )
#endif
METHOD cToChar() INLINE ::Super:cToChar( "EDIT" )
METHOD Copy()
METHOD Create( cClsName )
METHOD Cut()
METHOD Del()
METHOD Default()
METHOD DelLine( nLine )
METHOD Destroy()
#ifndef __C3__
METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 1
#endif
METHOD DlgGoLine()
METHOD EraseBkGnd() INLINE 1
METHOD Find( cText ) INLINE DlgFindText( cText, Self )
METHOD GetLine( nLine ) INLINE MGetLine( ::hWnd, nLine )
METHOD GetLineCount() INLINE SendMessage( ::hWnd, EM_GETLINECOUNT )
METHOD GotFocus()
METHOD GetRow()
METHOD GetCol()
#ifdef __CLIPPER__
METHOD GoBottom() INLINE ::SetPos( Len( AllTrim( ::GetText() ) ) + 1 )
#else
METHOD GoBottom() INLINE ( ::SetPos( Len( AllTrim( ::GetText() ) ) + 1 ),;
::SendMsg( EM_LINESCROLL, 0, ::GetLineCount() ) )
#endif
METHOD GoTo( nLine ) INLINE ;
::SetPos( SendMessage( ::hWnd, EM_LINEINDEX, nLine, 0 ) )
METHOD HideSel() INLINE ::SetSel( -1, 0 )
METHOD Initiate( hDlg )
METHOD LButtonDown( nRow, nCol, nFlags, lTouch )
METHOD LButtonUp( nRow, nCol, nFlags )
METHOD Len() INLINE GetWinTxtLenght( ::hWnd )
// Call this method to use unlimited text size
METHOD LimitText( nChars ) INLINE SendMessage( ::hWnd, EM_LIMITTEXT, If( Empty( nChars ), 0, nChars ), 0 )
METHOD LineIndex( nLine ) INLINE ::SendMsg( EM_LINEINDEX, nLine )
METHOD LostFocus( hCtlFocus )
METHOD MouseMove( nRow, nCol, nKeyFlags )
METHOD Move( nTop, nLeft, nBottom, nRight, lRepaint )
METHOD cText( cText ) SETGET
METHOD Paint()
METHOD Paste( cText )
METHOD Print()
METHOD RButtonDown( nRow, nCol, nFlags )
METHOD Refresh() BLOCK { | Self, nStart, nEnd | ::GetSelPos( @nStart, @nEnd ),;
::SetText( cValToChar( Eval( ::bSetGet ) ) ),;
::SetPos( nStart, nEnd ) }
METHOD Replace( cText ) INLINE ;
MGetReplace( ::hWnd, cText ),;
Eval( ::bSetGet, ::GetText() )
METHOD SaveToFile( cFileName ) INLINE MemoWrit( cFileName, ::GetText() )
METHOD SelectAll() INLINE ::SetSel( 0, -1 )
METHOD SetCoors( oRect )
#ifdef __CLIPPER__
METHOD SetSel( nStart, nEnd ) INLINE ;
nStart := If( nStart == nil, 1, nStart ),;
nEnd := If( nEnd == nil, nStart, nEnd ),;
SendMessage( ::hWnd, EM_SETSEL, 0,;
nMakeLong( nStart - If( nStart > 0, 1, 0 ),;
nEnd - If( nEnd > 0, 1, 0 ) ) ),;
::nPos := nStart
#else
METHOD SetSel( nStart, nEnd ) INLINE ;
nStart := If( nStart == nil, 1, nStart ),;
nEnd := If( nEnd == nil, nStart, nEnd ),;
SendMessage( ::hWnd, EM_SETSEL, nStart, nEnd ),;
::nPos := nStart
#endif
METHOD VScroll( nWParam, nLParam ) VIRTUAL
METHOD HScroll( nWParam, nLParam ) VIRTUAL
METHOD GetSel()
METHOD GetSelPos( nStart, nEnd )
METHOD KeyChar( nKey, nFlags )
METHOD KeyDown( nKey, nFlags )
METHOD SetColorFocus( nClrFocus )
#ifdef __CLIPPER__
METHOD SetPos( nStart, nEnd ) INLINE ;
nEnd := If( nEnd == nil, nStart, nEnd ),;
::SendMsg( EM_SETSEL, 0, nMakeLong( nStart, nEnd ) ),;
::nPos := nStart
#else
METHOD SetPos( nStart, nEnd ) INLINE ;
nEnd := If( nEnd == nil, nStart, nEnd ),;
::SendMsg( EM_SETSEL, nStart, nEnd ),;
::nPos := nStart,;
SendMessage(::hWnd, EM_SCROLLCARET, 0, 0)
#endif
METHOD UnDo() INLINE ::SendMsg( EM_UNDO ),;
Eval( ::bSetGet, ::GetText() )
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nRow, nCol, bSetGet, oWnd, nWidth, nHeight, oFont, lHScroll,;
nClrFore, nClrBack, oCursor, lPixel, cMsg, lUpdate,;
bWhen, lCenter, lRight, lReadOnly, bValid, bChanged,;
lDesign, lNoBorder, lNoVScroll ) CLASS TMultiGet
DEFAULT lHScroll := .f.,;
nClrFore := GetSysColor( COLOR_WINDOWTEXT ),;
nClrBack := GetSysColor( COLOR_WINDOW ),;
lPixel := .f., lUpdate := .f.,;
lCenter := .f., lRight := .f.,;
lReadOnly := .f., lDesign := .f.,;
oWnd := GetWndDefault(),;
nRow := 0, nCol := 0,;
lNoVScroll := .f., lNoBorder := .f.
::lUnicode = FW_SetUnicode()
if bSetGet != nil
::cCaption = cValToChar( Eval( bSetGet ) )
else
::cCaption = ""
endif
::nTop = nRow * If( lPixel, 1, MGET_CHARPIX_H ) //13
::nLeft = nCol * If( lPixel, 1, MGET_CHARPIX_W ) // 8
::nBottom = If( nHeight == nil, ::nTop + 11, ::nTop + nHeight )
::nRight = If( nWidth == nil, ::nLeft + Len( ::cCaption ) * 3.5, ;
::nLeft + nWidth )
::bSetGet = bSetGet
::uOriginalValue = Eval( ::bSetGet )
::oWnd = oWnd
::nStyle = nOR( WS_CHILD, WS_VISIBLE, ES_LEFT,;
ES_WANTRETURN, ES_MULTILINE,;
If( ! lReadOnly, WS_TABSTOP, 0 ),;
If( ! lNoVScroll, WS_VSCROLL, 0 ),;
If( lDesign, WS_CLIPSIBLINGS, 0 ),;
If( lHScroll, WS_HSCROLL, 0 ),;
If( lCenter, ES_CENTER, If( lRight, ES_RIGHT, ES_LEFT ) ) )
#ifdef __CLIPPER__
if ! lNoBorder
::nStyle = nOr( ::nStyle, WS_BORDER )
endif
#else
if ! IsAppThemed()
if ! lNoBorder
::nStyle = nOr( ::nStyle, WS_BORDER )
endif
else
if ! lNoBorder
::nStyle = nOr( ::nStyle, If( oWnd:IsKindOf( "TDIALOG" ), WS_BORDER, 0 ) )
::nExStyle = WS_EX_CLIENTEDGE
endif
endif
#endif
::nId = ::GetNewId()
::cCaption = RTrim( ::cCaption )
::lDrag = lDesign
::lCaptured = .f.
::oCursor = oCursor
if oFont != nil
oFont:nCount++
::oFont = oFont
endif
::cMsg = cMsg
::lUpdate = lUpdate
::bWhen = bWhen
::bValid = bValid
::lReadOnly = lReadOnly
::nPos = 0
::bChange = bChanged
if ! Empty( oWnd:hWnd )
::cCaption := Left( ::cCaption, 20000 )
::Create( "EDIT" )
::LimitText( 0 )
if Len( ::cCaption ) == 20000
::SetText( cValToChar( Eval( ::bSetGet ) ) )
endif
/*
if ::oFont != nil .or. ::oWnd:oFont != nil
PostMessage( ::hWnd, WM_SETFONT,;
If( oFont != nil, oFont:hFont,;
::oWnd:oFont:hFont ) )
endif
*/
if ::oFont == nil
::GetFont()
else
::SetFont( ::oFont )
endif
oWnd:AddControl( Self )
else
oWnd:DefControl( Self )
endif
::GetFont()
DEFAULT ::bColor := ::bColorBlock
if Empty( ::bColor )
::SetColor( ::nClrText, nClrBack )
else
tmp = ::aColor
::nClrText = tmp[ 1 ]
::nClrPane = tmp[ 2 ]
::oBrush = TBrush():New( , ::nClrPane )
::Refresh()
endif
if lDesign
::CheckDots()
endif
::SendMsg( EM_SETLIMITTEXT, -1 ) // Unlimited text length
return Self
//----------------------------------------------------------------------------//
METHOD ReDefine( nId, bSetGet, oWnd, nHelpId, nClrFore, nClrBack, oFont,;
oCursor, cMsg, lUpdate, bWhen, lReadOnly, bValid, bChanged ) CLASS TMultiGet
DEFAULT nClrFore := GetSysColor( COLOR_WINDOWTEXT ),;
nClrBack := GetSysColor( COLOR_WINDOW ),;
lUpdate := .f., lReadOnly := .f.,;
oWnd := GetWndDefault()
::lUnicode = FW_SetUnicode()
::nId = nId
::bSetGet = bSetGet
::uOriginalValue = Eval( ::bSetGet )
::oWnd = oWnd
::nHelpId = nHelpId
::lDrag = .f.
::lCaptured = .f.
if oFont != nil
oFont:nCount++
::oFont = oFont
endif
::oCursor = oCursor
::cMsg = cMsg
::lUpdate = lUpdate
::bWhen = bWhen
::bValid = bValid
::lReadOnly = lReadOnly
::nPos = 0
::bChange = bChanged
DEFAULT ::bColor := ::bColorBlock
if Empty( ::bColor )
::SetColor( nClrFore, nClrBack )
else
tmp = ::aColor
::nClrText = tmp[ 1 ]
::nClrPane = tmp[ 2 ]
::oBrush = TBrush():New( , ::nClrPane )
endif
oWnd:DefControl( Self )
return Self
//----------------------------------------------------------------------------//
METHOD Initiate( hDlg ) CLASS TMultiGet
::LimitText()
::Super:Initiate( hDlg )
::SetText( cValToChar( Eval( ::bSetGet ) ) )
::Default()
return nil
//----------------------------------------------------------------------------//
METHOD cText( cText ) CLASS TMultiGet
if PCount() == 1
::SetText( cText )
Eval( ::bSetGet, cText )
endif
return ::GetText()
//----------------------------------------------------------------------------//
METHOD Copy() CLASS TMultiGet
local oClp
#ifdef __XPP__
#undef New
#endif
DEFINE CLIPBOARD oClp OF Self ;
FORMAT TEXT
if oClp:Open()
oClp:Clear()
oClp:SetText( ::GetSel() )
oClp:End()
else
MsgAlert( "The clipboard is not available now!" )
endif
return nil
//---------------------------------------------------------------------------//
METHOD Create( cClsName ) CLASS TMultiGet
local hHeap
DEFAULT cClsName := ::ClassName(), ::cCaption := "",;
::nStyle := WS_OVERLAPPEDWINDOW,;
::nTop := 0, ::nLeft := 0, ::nBottom := 10, ::nRight := 10,;
::nId := 0
if ::oWnd != nil
::nStyle = nOR( ::nStyle, WS_CHILD )
endif
if ::nBottom != CW_USEDEFAULT
::hWnd = MGetCreate( cClsName, ::cCaption, ::nStyle, ;
::nLeft, ::nTop, ::nRight - ::nLeft + 1, ;
::nBottom - ::nTop + 1, ;
If( ::oWnd != nil, ::oWnd:hWnd, 0 ), ;
::nId, @hHeap, ::nExStyle )
else
::hWnd = MGetCreate( cClsName, ::cCaption, ::nStyle, ;
::nLeft, ::nTop, ::nRight, ::nBottom, ;
If( ::oWnd != nil, ::oWnd:hWnd, 0 ), ;
::nId, @hHeap, ::nExStyle )
endif
if ::hWnd == 0
WndCreateError( Self )
else
::Link()
if ::oFont != nil
::SetFont( ::oFont )
endif
::hHeap = hHeap
endif
return nil
//----------------------------------------------------------------------------//
METHOD Cut() CLASS TMultiGet
if ::lReadOnly
MsgAlert( "The get is read only!", "Can't cut" )
return nil
endif
::SendMsg( WM_CUT )
Eval( ::bSetGet, ::GetText() )
// EMW - the text has been changed!
if ::bChange != nil
Eval( ::bChange,,, Self )
endif
return nil
//*** EMW - Added method to delete selected text without affecting clipboard
//---------------------------------------------------------------------------//
METHOD Del() CLASS TMultiGet
if ::lReadOnly
MsgAlert( "The get is read only!", "Can't delete" )
return nil
endif
::SendMsg( WM_CLEAR )
Eval( ::bSetGet, ::GetText() )
if ::bChange != nil
Eval( ::bChange,,, Self )
endif
return nil
//*** EMW - End of addition
//----------------------------------------------------------------------------//
METHOD DelLine( nLine ) CLASS TMultiGet
DEFAULT nLine := ::GetRow()
::SendMsg( EM_SETSEL, .f.,;
nMakeLong( ::SendMsg( EM_LINEINDEX, nLine - 1 ),;
::SendMsg( EM_LINEINDEX, nLine ) ) )
::Cut()
Eval( ::bSetGet, ::GetText() )
// EMW - the text has been changed!
if ::bChange != nil
Eval( ::bChange,,, Self )
endif
return nil
//---------------------------------------------------------------------------//
METHOD Destroy() CLASS TMultiGet
if ::hHeap != 0
// LocalShrink( ::hHeap, 0 )
::hHeap = 0
endif
return ::Super:Destroy()
//---------------------------------------------------------------------------//
METHOD DlgGoLine() CLASS TMultiGet
local oDlgGoLine, nLine := ::GetRow()
DEFINE DIALOG oDlgGoLine FROM 5,5 TO 10,29 TITLE "Go To"
oDlgGoLine:lTruePixel := .f.
@ 0.5, 2 SAY "Line:" OF oDlgGoLine
@ 0.5, 5 GET nLine OF oDlgGoLine PICTURE "99999" SIZE 25, 11
@ 1.3, 2 BUTTON "&Ok" OF oDlgGoLine SIZE 32, 11 ;
ACTION ( ::GoTo( nLine ), oDlgGoLine:End() ) DEFAULT
@ 1.3, 9.5 BUTTON "&Cancel" OF oDlgGoLine SIZE 32, 11 ;
ACTION oDlgGoLine:End()
ACTIVATE DIALOG oDlgGoLine CENTERED
return nil
//---------------------------------------------------------------------------//
METHOD GetSel() CLASS TMultiGet
local n := ::SendMsg( EM_GETSEL )
local nStart := nLoWord( n )
local nEnd := nHiWord( n )
if ::lUnicode
return If( nStart != nEnd, HB_UTF8SUBSTR( ::cText, nStart + 1, nEnd - nStart ), "" )
endif
return If( nStart != nEnd, SubStr( ::cText, nStart + 1, nEnd - nStart ), "" )
//----------------------------------------------------------------------------//
METHOD GetSelPos( nStart, nEnd ) CLASS TMultiGet
local n := ::SendMsg( EM_GETSEL )
nStart := nLoWord( n )
nEnd := nHiWord( n )
return nil
//----------------------------------------------------------------------------//
METHOD GetRow() CLASS TMultiGet
return ::SendMsg( EM_LINEFROMCHAR,;
nLoWord( ::SendMsg( EM_GETSEL ) ) ) + 1
//----------------------------------------------------------------------------//
METHOD GetCol() CLASS TMultiGet
return nLoWord( ::SendMsg( EM_GETSEL ) ) - ;
::SendMsg( EM_LINEINDEX, ::GetRow() -1 , 0 ) + 1
//----------------------------------------------------------------------------//
METHOD LButtonDown( nRow, nCol, nFlags, lTouch ) CLASS TMultiGet
::nPos = nLoWord( ::PostMsg( EM_GETSEL ) )
return ::Super:LButtonDown( nRow, nCol, nFlags, lTouch )
//----------------------------------------------------------------------------//
METHOD LButtonUp( nRow, nCol, nFlags ) CLASS TMultiGet
if ::lDrag
::Super:LButtonUp( nRow, nCol, nFlags )
SysRefresh()
::Refresh()
return 0
endif
return ::Super:LButtonUp( nRow, nCol, nFlags )
//----------------------------------------------------------------------------//
METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TMultiGet
if ::lDrag
return ::Super:MouseMove( nRow, nCol, nKeyFlags )
else
::oWnd:SetMsg( ::cMsg )
if ::oCursor != nil
SetCursor( ::oCursor:hCursor )
else
CursorIBeam()
endif
::CheckToolTip()
if ::bMMoved != nil
Eval( ::bMMoved, nRow, nCol, nKeyFlags )
endif
endif
return nil // We want standard MultiLine Get behavior !!!
//---------------------------------------------------------------------------//
METHOD KeyDown( nKey, nFlags ) CLASS TMultiGet
do case
case ( nKey == VK_INSERT .and. GetKeyState( VK_SHIFT ) ) .or. ;
( nKey == ASC("V") .and. GetKeyState( VK_CONTROL ) ) .or. ;
( nKey == ASC('X') .and. GetKeyState( VK_CONTROL ) )
if !::lReadOnly
CallWindowProc( ::nOldProc, ::hWnd, WM_KEYDOWN, nKey, nFlags )
if ::bChange != nil
Eval( ::bChange, nKey, nFlags, Self )
endif
endif
return 0
case nKey == VK_DELETE
if ::lReadOnly
return 0
endif
if ::bChange != nil
Eval( ::bChange, nKey, nFlags, Self )
endif
endcase
return ::Super:KeyDown( nKey, nFlags )
//---------------------------------------------------------------------------//
METHOD KeyChar( nKey, nFlags ) CLASS TMultiGet
local bKeyAction := SetKey( nKey )
if bKeyAction != nil .and. lAnd( nFlags, 16777216 ) // function Key
Eval( bKeyAction, ProcName( 4 ), ProcLine( 4 ), Self )
return 0 // Already processed, API do nothing
endif
if ::lReadOnly
if nKey == VK_RETURN
::oWnd:GoNextCtrl( ::hWnd )
endif
return 0
endif
if nKey == VK_RETURN .and. ;
lAnd( GetWindowLong( ::hWnd, GWL_STYLE ), ES_WANTRETURN )
::oWnd:nLastKey = 0
if ::bChange != nil
Eval( ::bChange, nKey, nFlags, Self )
endif
return nil
endif
if nKey == VK_TAB
return ::Super:KeyChar( nKey, nFlags )
endif
if !::lReadOnly
CallWindowProc( ::nOldProc, ::hWnd, WM_CHAR, nKey, nFlags )
Eval( ::bSetGet, ::GetText() )
if ::bChange != nil
Eval( ::bChange, nKey, nFlags, Self )
endif
return 0
endif
return ::Super:KeyChar( nKey, nFlags )
//---------------------------------------------------------------------------//
METHOD Paint() CLASS TMultiGet
local aInfo := ::DispBegin()
if ! Empty( ::bColor )
tmp = ::aColor
::nClrText = tmp[ 1 ]
::nClrPane = tmp[ 2 ]
if ! Empty( ::oBrush )
::oBrush:End()
endif
::oBrush = TBrush():New( , ::nClrPane )
endif
if ::oBrush != nil
FillRect( ::hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
else
CallWindowProc( ::nOldProc, ::hWnd, WM_ERASEBKGND, ::hDC, 0 )
endif
CallWindowProc( ::nOldProc, ::hWnd, WM_PAINT, ::hDC, 0 )
if ValType( ::bPainted ) == "B"
Eval( ::bPainted, ::hDC, ::cPS, Self )
endif
::DispEnd( aInfo )
return 1
//----------------------------------------------------------------------------//
METHOD Paste( cText ) CLASS TMultiGet
local oClp, cFile
#ifdef __XPP__
#undef New
#endif
DEFINE CLIPBOARD oClp OF Self FORMAT TEXT
if Empty( cText ) .and. GetClipContentFormat( 15 ) == 15
cFile := oClp:GetFiles()[ 1 ]
cText := MEMOREAD( cFile )
if IsBinaryData( cText )
cText := cFile
endif
endif
if ! Empty( cText )
oClp:SetText( cText )
endif
::SendMsg( WM_PASTE )
Eval( ::bSetGet, ::GetText() )
if ::bChange != nil
Eval( ::bChange,,, Self )
endif
oClp:End()
return nil
//----------------------------------------------------------------------------//
METHOD RButtonDown( nRow, nCol, nFlags ) CLASS TMultiGet
local oMenu, oClp
if GetFocus() != ::hWnd
::SetFocus()
SysRefresh() // In case there is a VALID somewhere
if GetFocus() != ::hWnd
return nil
endif
endif
#ifdef __XPP__
#undef New
#endif
if ::bRClicked != nil
return Eval( ::bRClicked, nRow, nCol, nFlags )
endif
DEFINE CLIPBOARD oClp OF Self FORMAT TEXT
MENU oMenu POPUP
MENUITEM FWString( "&Undo" ) ACTION ( oMenuItem, ::UnDo() ) WHEN ( oMenuItem, ::SendMsg( EM_CANUNDO ) != 0 )
SEPARATOR
MENUITEM FWString( "Cu&t" ) ACTION ( oMenuItem, ::Cut() ) WHEN ( oMenuItem, ! Empty( ::GetSel() ) .and. !::lReadOnly )
MENUITEM FWString( "&Copy" ) ACTION ( oMenuItem, ::Copy() ) WHEN ( oMenuItem, ! Empty( ::GetSel() ) )
// MENUITEM FWString( "&Paste" ) ACTION ( oMenuItem, ::Paste() ) WHEN ( oMenuItem, ! Empty( oClp:GetText() ) .and. !::lReadOnly )
MENUITEM FWString( "&Paste" ) ACTION ( oMenuItem, ::Paste() ) WHEN ( oMenuItem, GetClipContentFormat( 13, 1, 15 ) > 0 .and. !::lReadOnly )
MENUITEM FWString( "&Delete" ) ACTION ( oMenuItem, ::Del() ) WHEN ( oMenuItem, ! Empty( ::GetSel() ) .and. !::lReadOnly )
if Upper( ::ClassName() ) == "TRICHEDIT"
SEPARATOR
MENUITEM FWString( "&Font" ) ACTION ( oMenuItem, ::SetCharFormat() )
endif
SEPARATOR
MENUITEM FWString( "P&rint" ) ACTION ( oMenuItem, ::Print() )
SEPARATOR
MENUITEM FWString( "Select &All" ) ACTION ( oMenuItem, ::SelectAll() )
ENDMENU
oClp:End()
ACTIVATE POPUP oMenu AT nRow - 60, nCol OF Self
return 0 // Message already processed
//----------------------------------------------------------------------------//
METHOD GotFocus() CLASS TMultiGet
::Super:GotFocus()
// ::SetPos( ::nPos )
CallWindowProc( ::nOldProc, ::hWnd, WM_SETFOCUS )
if Set( _SET_INSERT )
DestroyCaret()
CreateCaret( ::hWnd, 0, If( ::lChangeCaret, 6, 1 ),;
::nGetChrHeight() )
ShowCaret( ::hWnd )
endif
if ::lClrFocus
::nOldClrPane = ::nClrPane
::SetColor( ::nClrText,;
If( ValType( ::nClrFocus ) == "B", Eval( ::nClrFocus ), ::nClrFocus ) )
else
if ! Empty( ::bColor )
tmp = ::aColor
::nClrText = tmp[ 1 ]
::nClrPane = tmp[ 2 ]
::oBrush:End()
::oBrush = TBrush():New( , ::nClrPane )
::Refresh()
endif
endif
return 0
//----------------------------------------------------------------------------//
METHOD LostFocus( hCtlFocus ) CLASS TMultiGet
::Super:LostFocus( hCtlFocus )
if ::bSetGet != nil
Eval( ::bSetGet, ::GetText() )
endif
::nPos = nLoWord( ::SendMsg( EM_GETSEL ) )
if ::lClrFocus
if ::nOldClrPane != nil
::SetColor( ::nClrText, ::nOldClrPane )
endif
else
if ! Empty( ::bColor )
tmp = ::aColor
::nClrText = tmp[ 1 ]
::nClrPane = tmp[ 2 ]
::oBrush:End()
::oBrush = TBrush():New( , ::nClrPane )
::Refresh()
::Refresh()
endif
endif
return nil
//----------------------------------------------------------------------------//
METHOD Default() CLASS TMultiGet
return nil
//---------------------------------------------------------------------------//
METHOD Move( nTop, nLeft, nBottom, nRight, lRepaint ) CLASS TMultiGet
::Super:Move( nTop, nLeft, nBottom, nRight, lRepaint )
MoveGet( ::hWnd )
return nil
//----------------------------------------------------------------------------//
METHOD SetCoors( oRect ) CLASS TMultiGet
::Super:SetCoors( oRect )
MoveGet( ::hWnd )
return nil
//----------------------------------------------------------------------------//
METHOD Print() CLASS TMultiGet
local oPrn, oFont
local nRowStep
local nRow := 0, nCol := 0, n, n1 := 0
local nLines := ::GetLineCount()
PRINT oPrn NAME "Notes"
if Empty( oPrn:hDC )
MsgStop( "Printer not ready!" )
return self
endif
CursorWait()
DEFINE FONT oFont NAME GetSysFont() SIZE 0, -11 OF oPrn
nRowStep = oPrn:nVertRes() / 60 // We want 60 rows
PAGE
for n = 1 to nLines // rows
oPrn:Say( nRow, nCol, ::GetLine( n ), oFont )
nRow += nRowStep
n1 ++
IF n1 == 60
nRow := 0
n1 := 0
ENDPAGE
PAGE
ENDIF
next
ENDPAGE
ENDPRINT
oFont:End() // Destroy the font object
CursorArrow()
return nil
//----------------------------------------------------------------------------//
METHOD SetColorFocus( nClrFocus ) CLASS TMultiGet
local nOldClrFocus := ::nClrFocus
::lClrFocus = .T.
if nClrFocus != nil
::nClrFocus = nClrFocus
endif
return nOldClrFocus
//----------------------------------------------------------------------------//
function SetMGetColorFocus( nClrFocus )
return TMultiGet():SetColorFocus( nClrFocus )
//----------------------------------------------------------------------------//
by carlos vargas » Tue Apr 16, 2024 1:03 am
by Antonio Linares » Tue Apr 16, 2024 4:59 am
#include "FiveWin.ch"
function Main()
local oDlg, oGet1, oGet3
local cTest1, cTest2, cTest3, cTest4
cTest1 := cTest2 := cTest3 := cTest4 := PadR( "Hello world" + CRLF + CRLF + "another", 30 )
TGet():bColorBlock := { |oGet| If( oGet:lFocused, { CLR_WHITE, CLR_GREEN },;
If( ! oGet:lActive, { CLR_RED, CLR_YELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }
TMultiGet():bColorBlock := { |oGet| If( oGet:lFocused, { CLR_WHITE, CLR_GREEN },;
If( ! oGet:lActive, { CLR_RED, CLR_YELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }
DEFINE DIALOG oDlg SIZE 500, 300
@ 1, 1 GET oGet1 VAR cTest1
@ 2, 1 GET cTest2
@ 3, 1 GET oGet3 VAR cTest3 MULTILINE SIZE 240, 30
@ 6, 1 GET cTest4 MULTILINE SIZE 240, 30
ACTIVATE DIALOG oDlg CENTERED ;
ON INIT ( oGet1:Disable(), oGet3:Disable(), .T. )
return nil #include "FiveWin.ch"
#include "Constant.ch"
#include "Set.ch"
#include "print.ch"
#ifdef __CLIPPER__
#define EM_GETSEL (WM_USER+0)
#define EM_SETSEL (WM_USER+1)
#define EM_UNDO (WM_USER+23)
#define EM_LINEFROMCHAR (WM_USER+25)
#define EM_GETLINECOUNT (WM_USER+10)
#define EM_LINEINDEX (WM_USER+11)
#define EM_CANUNDO (WM_USER+22)
#else
#define EM_GETSEL 176
#define EM_SETSEL 177
#define EM_UNDO 199
#define EM_LINEFROMCHAR 201
#define EM_LINESCROLL 182
#define EM_GETLINECOUNT 186
#define EM_LINEINDEX 187
#define EM_CANUNDO 198
#ifdef __XPP__
#define ::Super ::TControl
#define New _New
#define GetNew _GetNew
#define GetDelSel _GetDelSel
#endif
#endif
#define COLOR_WINDOW 5
#define COLOR_WINDOWTEXT 8
#define ES_CENTER 1
#define WM_ERASEBKGND 20
#define WM_SETFONT 48
#define WM_CUT 768 // 0x300
#define WM_PASTE 770 // 0x302
#define WM_CLEAR 771 // 0x303
#define CW_USEDEFAULT 32768
#define GWL_STYLE ( -16)
#define EM_LIMITTEXT 197
#define EM_SCROLLCARET ( WM_USER + 49 )
#define WS_EX_CLIENTEDGE 512
#define EM_SETLIMITTEXT 0x00C5
#define ETO_OPAQUE 2
#define ETO_CLIPPED 4
#define TRANSPARENT 1
#define DT_WORDBREAK 16
#define DT_CALCRECT 1024
static tmp
//----------------------------------------------------------------------------//
CLASS TMultiGet FROM TControl
DATA lReadOnly
DATA nPos
DATA hHeap
DATA nOldClrPane // Old background color, if color changed with focus
DATA bColor
ACCESS aColor INLINE ( tmp := Eval( ::bColor, Self ), If( HB_ISARRAY( tmp ), AClone( tmp ), { tmp, ::nClrPane } ) )
CLASSDATA lClrFocus INIT .F. // change GET color when focused
CLASSDATA nClrFocus INIT nRGB( 235, 235, 145 ) // color to use when GET is focused and lClrFocus is .T.
CLASSDATA lChangeCaret INIT .T.
CLASSDATA bColorBlock
METHOD New( nRow, nCol, bSetGet, oWnd, nWidth, nHeight, oFont, lHScroll,;
nClrFore, nClrBack, oCursor, lPixel, cMsg, lUpdate,;
bWhen, lCenter, lRight, lReadOnly, bValid, bChanged,;
lDesign, lNoBorder, lNoVScroll ) CONSTRUCTOR
METHOD ReDefine( nId, bSetGet, oWnd, nHelpId, nClrFore, nClrBack, oFont,;
oCursor, cMsg, lUpdate, bWhen, lReadOnly, bValid,;
bChanged ) CONSTRUCTOR
METHOD AdjClient() INLINE ::Super:AdjClient(), MoveGet( ::hWnd )
#ifndef __HARBOUR__
METHOD Append( cText, nLen ) INLINE ;
nLen := ::Len() ,;
SendMessage( ::hWnd, EM_SETSEL, 0,;
nMakeLong( nLen, nLen ) ),;
::Replace( cText )
#else
METHOD Append( cText, nLen ) INLINE ;
nLen := ::Len() ,;
SendMessage( ::hWnd, EM_SETSEL, nLen, nLen ),;
::Replace( cText )
#endif
METHOD cToChar() INLINE ::Super:cToChar( "EDIT" )
METHOD Copy()
METHOD Create( cClsName )
METHOD Cut()
METHOD Del()
METHOD Default()
METHOD DelLine( nLine )
METHOD Destroy()
#ifndef __C3__
METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 1
#endif
METHOD DlgGoLine()
METHOD EraseBkGnd() INLINE 1
METHOD Find( cText ) INLINE DlgFindText( cText, Self )
METHOD GetLine( nLine ) INLINE MGetLine( ::hWnd, nLine )
METHOD GetLineCount() INLINE SendMessage( ::hWnd, EM_GETLINECOUNT )
METHOD GotFocus()
METHOD GetRow()
METHOD GetCol()
#ifdef __CLIPPER__
METHOD GoBottom() INLINE ::SetPos( Len( AllTrim( ::GetText() ) ) + 1 )
#else
METHOD GoBottom() INLINE ( ::SetPos( Len( AllTrim( ::GetText() ) ) + 1 ),;
::SendMsg( EM_LINESCROLL, 0, ::GetLineCount() ) )
#endif
METHOD GoTo( nLine ) INLINE ;
::SetPos( SendMessage( ::hWnd, EM_LINEINDEX, nLine, 0 ) )
METHOD HideSel() INLINE ::SetSel( -1, 0 )
METHOD Initiate( hDlg )
METHOD LButtonDown( nRow, nCol, nFlags, lTouch )
METHOD LButtonUp( nRow, nCol, nFlags )
METHOD Len() INLINE GetWinTxtLenght( ::hWnd )
// Call this method to use unlimited text size
METHOD LimitText( nChars ) INLINE SendMessage( ::hWnd, EM_LIMITTEXT, If( Empty( nChars ), 0, nChars ), 0 )
METHOD LineIndex( nLine ) INLINE ::SendMsg( EM_LINEINDEX, nLine )
METHOD LostFocus( hCtlFocus )
METHOD MouseMove( nRow, nCol, nKeyFlags )
METHOD Move( nTop, nLeft, nBottom, nRight, lRepaint )
METHOD cText( cText ) SETGET
METHOD Paint()
METHOD Paste( cText )
METHOD Print()
METHOD RButtonDown( nRow, nCol, nFlags )
METHOD Refresh() BLOCK { | Self, nStart, nEnd | ::GetSelPos( @nStart, @nEnd ),;
::SetText( cValToChar( Eval( ::bSetGet ) ) ),;
::SetPos( nStart, nEnd ) }
METHOD Replace( cText ) INLINE ;
MGetReplace( ::hWnd, cText ),;
Eval( ::bSetGet, ::GetText() )
METHOD SaveToFile( cFileName ) INLINE MemoWrit( cFileName, ::GetText() )
METHOD SelectAll() INLINE ::SetSel( 0, -1 )
METHOD SetCoors( oRect )
#ifdef __CLIPPER__
METHOD SetSel( nStart, nEnd ) INLINE ;
nStart := If( nStart == nil, 1, nStart ),;
nEnd := If( nEnd == nil, nStart, nEnd ),;
SendMessage( ::hWnd, EM_SETSEL, 0,;
nMakeLong( nStart - If( nStart > 0, 1, 0 ),;
nEnd - If( nEnd > 0, 1, 0 ) ) ),;
::nPos := nStart
#else
METHOD SetSel( nStart, nEnd ) INLINE ;
nStart := If( nStart == nil, 1, nStart ),;
nEnd := If( nEnd == nil, nStart, nEnd ),;
SendMessage( ::hWnd, EM_SETSEL, nStart, nEnd ),;
::nPos := nStart
#endif
METHOD VScroll( nWParam, nLParam ) VIRTUAL
METHOD HScroll( nWParam, nLParam ) VIRTUAL
METHOD GetSel()
METHOD GetSelPos( nStart, nEnd )
METHOD KeyChar( nKey, nFlags )
METHOD KeyDown( nKey, nFlags )
METHOD SetColorFocus( nClrFocus )
#ifdef __CLIPPER__
METHOD SetPos( nStart, nEnd ) INLINE ;
nEnd := If( nEnd == nil, nStart, nEnd ),;
::SendMsg( EM_SETSEL, 0, nMakeLong( nStart, nEnd ) ),;
::nPos := nStart
#else
METHOD SetPos( nStart, nEnd ) INLINE ;
nEnd := If( nEnd == nil, nStart, nEnd ),;
::SendMsg( EM_SETSEL, nStart, nEnd ),;
::nPos := nStart,;
SendMessage(::hWnd, EM_SCROLLCARET, 0, 0)
#endif
METHOD UnDo() INLINE ::SendMsg( EM_UNDO ),;
Eval( ::bSetGet, ::GetText() )
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nRow, nCol, bSetGet, oWnd, nWidth, nHeight, oFont, lHScroll,;
nClrFore, nClrBack, oCursor, lPixel, cMsg, lUpdate,;
bWhen, lCenter, lRight, lReadOnly, bValid, bChanged,;
lDesign, lNoBorder, lNoVScroll ) CLASS TMultiGet
DEFAULT lHScroll := .f.,;
nClrFore := GetSysColor( COLOR_WINDOWTEXT ),;
nClrBack := GetSysColor( COLOR_WINDOW ),;
lPixel := .f., lUpdate := .f.,;
lCenter := .f., lRight := .f.,;
lReadOnly := .f., lDesign := .f.,;
oWnd := GetWndDefault(),;
nRow := 0, nCol := 0,;
lNoVScroll := .f., lNoBorder := .f.
::lUnicode = FW_SetUnicode()
if bSetGet != nil
::cCaption = cValToChar( Eval( bSetGet ) )
else
::cCaption = ""
endif
::nTop = nRow * If( lPixel, 1, MGET_CHARPIX_H ) //13
::nLeft = nCol * If( lPixel, 1, MGET_CHARPIX_W ) // 8
::nBottom = If( nHeight == nil, ::nTop + 11, ::nTop + nHeight )
::nRight = If( nWidth == nil, ::nLeft + Len( ::cCaption ) * 3.5, ;
::nLeft + nWidth )
::bSetGet = bSetGet
::uOriginalValue = Eval( ::bSetGet )
::oWnd = oWnd
::nStyle = nOR( WS_CHILD, WS_VISIBLE, ES_LEFT,;
ES_WANTRETURN, ES_MULTILINE,;
If( ! lReadOnly, WS_TABSTOP, 0 ),;
If( ! lNoVScroll, WS_VSCROLL, 0 ),;
If( lDesign, WS_CLIPSIBLINGS, 0 ),;
If( lHScroll, WS_HSCROLL, 0 ),;
If( lCenter, ES_CENTER, If( lRight, ES_RIGHT, ES_LEFT ) ) )
#ifdef __CLIPPER__
if ! lNoBorder
::nStyle = nOr( ::nStyle, WS_BORDER )
endif
#else
if ! IsAppThemed()
if ! lNoBorder
::nStyle = nOr( ::nStyle, WS_BORDER )
endif
else
if ! lNoBorder
::nStyle = nOr( ::nStyle, If( oWnd:IsKindOf( "TDIALOG" ), WS_BORDER, 0 ) )
::nExStyle = WS_EX_CLIENTEDGE
endif
endif
#endif
::nId = ::GetNewId()
::cCaption = RTrim( ::cCaption )
::lDrag = lDesign
::lCaptured = .f.
::oCursor = oCursor
if oFont != nil
oFont:nCount++
::oFont = oFont
endif
::cMsg = cMsg
::lUpdate = lUpdate
::bWhen = bWhen
::bValid = bValid
::lReadOnly = lReadOnly
::nPos = 0
::bChange = bChanged
if ! Empty( oWnd:hWnd )
::cCaption := Left( ::cCaption, 20000 )
::Create( "EDIT" )
::LimitText( 0 )
if Len( ::cCaption ) == 20000
::SetText( cValToChar( Eval( ::bSetGet ) ) )
endif
/*
if ::oFont != nil .or. ::oWnd:oFont != nil
PostMessage( ::hWnd, WM_SETFONT,;
If( oFont != nil, oFont:hFont,;
::oWnd:oFont:hFont ) )
endif
*/
if ::oFont == nil
::GetFont()
else
::SetFont( ::oFont )
endif
oWnd:AddControl( Self )
else
oWnd:DefControl( Self )
endif
::GetFont()
DEFAULT ::bColor := ::bColorBlock
if Empty( ::bColor )
::SetColor( ::nClrText, nClrBack )
else
tmp = ::aColor
::nClrText = tmp[ 1 ]
::nClrPane = tmp[ 2 ]
::oBrush = TBrush():New( , ::nClrPane )
::Refresh()
endif
if lDesign
::CheckDots()
endif
::SendMsg( EM_SETLIMITTEXT, -1 ) // Unlimited text length
return Self
//----------------------------------------------------------------------------//
METHOD ReDefine( nId, bSetGet, oWnd, nHelpId, nClrFore, nClrBack, oFont,;
oCursor, cMsg, lUpdate, bWhen, lReadOnly, bValid, bChanged ) CLASS TMultiGet
DEFAULT nClrFore := GetSysColor( COLOR_WINDOWTEXT ),;
nClrBack := GetSysColor( COLOR_WINDOW ),;
lUpdate := .f., lReadOnly := .f.,;
oWnd := GetWndDefault()
::lUnicode = FW_SetUnicode()
::nId = nId
::bSetGet = bSetGet
::uOriginalValue = Eval( ::bSetGet )
::oWnd = oWnd
::nHelpId = nHelpId
::lDrag = .f.
::lCaptured = .f.
if oFont != nil
oFont:nCount++
::oFont = oFont
endif
::oCursor = oCursor
::cMsg = cMsg
::lUpdate = lUpdate
::bWhen = bWhen
::bValid = bValid
::lReadOnly = lReadOnly
::nPos = 0
::bChange = bChanged
DEFAULT ::bColor := ::bColorBlock
if Empty( ::bColor )
::SetColor( nClrFore, nClrBack )
else
tmp = ::aColor
::nClrText = tmp[ 1 ]
::nClrPane = tmp[ 2 ]
::oBrush = TBrush():New( , ::nClrPane )
endif
oWnd:DefControl( Self )
return Self
//----------------------------------------------------------------------------//
METHOD Initiate( hDlg ) CLASS TMultiGet
::LimitText()
::Super:Initiate( hDlg )
::SetText( cValToChar( Eval( ::bSetGet ) ) )
::Default()
return nil
//----------------------------------------------------------------------------//
METHOD cText( cText ) CLASS TMultiGet
if PCount() == 1
::SetText( cText )
Eval( ::bSetGet, cText )
endif
return ::GetText()
//----------------------------------------------------------------------------//
METHOD Copy() CLASS TMultiGet
local oClp
#ifdef __XPP__
#undef New
#endif
DEFINE CLIPBOARD oClp OF Self ;
FORMAT TEXT
if oClp:Open()
oClp:Clear()
oClp:SetText( ::GetSel() )
oClp:End()
else
MsgAlert( "The clipboard is not available now!" )
endif
return nil
//---------------------------------------------------------------------------//
METHOD Create( cClsName ) CLASS TMultiGet
local hHeap
DEFAULT cClsName := ::ClassName(), ::cCaption := "",;
::nStyle := WS_OVERLAPPEDWINDOW,;
::nTop := 0, ::nLeft := 0, ::nBottom := 10, ::nRight := 10,;
::nId := 0
if ::oWnd != nil
::nStyle = nOR( ::nStyle, WS_CHILD )
endif
if ::nBottom != CW_USEDEFAULT
::hWnd = MGetCreate( cClsName, ::cCaption, ::nStyle, ;
::nLeft, ::nTop, ::nRight - ::nLeft + 1, ;
::nBottom - ::nTop + 1, ;
If( ::oWnd != nil, ::oWnd:hWnd, 0 ), ;
::nId, @hHeap, ::nExStyle )
else
::hWnd = MGetCreate( cClsName, ::cCaption, ::nStyle, ;
::nLeft, ::nTop, ::nRight, ::nBottom, ;
If( ::oWnd != nil, ::oWnd:hWnd, 0 ), ;
::nId, @hHeap, ::nExStyle )
endif
if ::hWnd == 0
WndCreateError( Self )
else
::Link()
if ::oFont != nil
::SetFont( ::oFont )
endif
::hHeap = hHeap
endif
return nil
//----------------------------------------------------------------------------//
METHOD Cut() CLASS TMultiGet
if ::lReadOnly
MsgAlert( "The get is read only!", "Can't cut" )
return nil
endif
::SendMsg( WM_CUT )
Eval( ::bSetGet, ::GetText() )
// EMW - the text has been changed!
if ::bChange != nil
Eval( ::bChange,,, Self )
endif
return nil
//*** EMW - Added method to delete selected text without affecting clipboard
//---------------------------------------------------------------------------//
METHOD Del() CLASS TMultiGet
if ::lReadOnly
MsgAlert( "The get is read only!", "Can't delete" )
return nil
endif
::SendMsg( WM_CLEAR )
Eval( ::bSetGet, ::GetText() )
if ::bChange != nil
Eval( ::bChange,,, Self )
endif
return nil
//*** EMW - End of addition
//----------------------------------------------------------------------------//
METHOD DelLine( nLine ) CLASS TMultiGet
DEFAULT nLine := ::GetRow()
::SendMsg( EM_SETSEL, .f.,;
nMakeLong( ::SendMsg( EM_LINEINDEX, nLine - 1 ),;
::SendMsg( EM_LINEINDEX, nLine ) ) )
::Cut()
Eval( ::bSetGet, ::GetText() )
// EMW - the text has been changed!
if ::bChange != nil
Eval( ::bChange,,, Self )
endif
return nil
//---------------------------------------------------------------------------//
METHOD Destroy() CLASS TMultiGet
if ::hHeap != 0
// LocalShrink( ::hHeap, 0 )
::hHeap = 0
endif
return ::Super:Destroy()
//---------------------------------------------------------------------------//
METHOD DlgGoLine() CLASS TMultiGet
local oDlgGoLine, nLine := ::GetRow()
DEFINE DIALOG oDlgGoLine FROM 5,5 TO 10,29 TITLE "Go To"
oDlgGoLine:lTruePixel := .f.
@ 0.5, 2 SAY "Line:" OF oDlgGoLine
@ 0.5, 5 GET nLine OF oDlgGoLine PICTURE "99999" SIZE 25, 11
@ 1.3, 2 BUTTON "&Ok" OF oDlgGoLine SIZE 32, 11 ;
ACTION ( ::GoTo( nLine ), oDlgGoLine:End() ) DEFAULT
@ 1.3, 9.5 BUTTON "&Cancel" OF oDlgGoLine SIZE 32, 11 ;
ACTION oDlgGoLine:End()
ACTIVATE DIALOG oDlgGoLine CENTERED
return nil
//---------------------------------------------------------------------------//
METHOD GetSel() CLASS TMultiGet
local n := ::SendMsg( EM_GETSEL )
local nStart := nLoWord( n )
local nEnd := nHiWord( n )
if ::lUnicode
return If( nStart != nEnd, HB_UTF8SUBSTR( ::cText, nStart + 1, nEnd - nStart ), "" )
endif
return If( nStart != nEnd, SubStr( ::cText, nStart + 1, nEnd - nStart ), "" )
//----------------------------------------------------------------------------//
METHOD GetSelPos( nStart, nEnd ) CLASS TMultiGet
local n := ::SendMsg( EM_GETSEL )
nStart := nLoWord( n )
nEnd := nHiWord( n )
return nil
//----------------------------------------------------------------------------//
METHOD GetRow() CLASS TMultiGet
return ::SendMsg( EM_LINEFROMCHAR,;
nLoWord( ::SendMsg( EM_GETSEL ) ) ) + 1
//----------------------------------------------------------------------------//
METHOD GetCol() CLASS TMultiGet
return nLoWord( ::SendMsg( EM_GETSEL ) ) - ;
::SendMsg( EM_LINEINDEX, ::GetRow() -1 , 0 ) + 1
//----------------------------------------------------------------------------//
METHOD LButtonDown( nRow, nCol, nFlags, lTouch ) CLASS TMultiGet
::nPos = nLoWord( ::PostMsg( EM_GETSEL ) )
return ::Super:LButtonDown( nRow, nCol, nFlags, lTouch )
//----------------------------------------------------------------------------//
METHOD LButtonUp( nRow, nCol, nFlags ) CLASS TMultiGet
if ::lDrag
::Super:LButtonUp( nRow, nCol, nFlags )
SysRefresh()
::Refresh()
return 0
endif
return ::Super:LButtonUp( nRow, nCol, nFlags )
//----------------------------------------------------------------------------//
METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TMultiGet
if ::lDrag
return ::Super:MouseMove( nRow, nCol, nKeyFlags )
else
::oWnd:SetMsg( ::cMsg )
if ::oCursor != nil
SetCursor( ::oCursor:hCursor )
else
CursorIBeam()
endif
::CheckToolTip()
if ::bMMoved != nil
Eval( ::bMMoved, nRow, nCol, nKeyFlags )
endif
endif
return nil // We want standard MultiLine Get behavior !!!
//---------------------------------------------------------------------------//
METHOD KeyDown( nKey, nFlags ) CLASS TMultiGet
do case
case ( nKey == VK_INSERT .and. GetKeyState( VK_SHIFT ) ) .or. ;
( nKey == ASC("V") .and. GetKeyState( VK_CONTROL ) ) .or. ;
( nKey == ASC('X') .and. GetKeyState( VK_CONTROL ) )
if !::lReadOnly
CallWindowProc( ::nOldProc, ::hWnd, WM_KEYDOWN, nKey, nFlags )
if ::bChange != nil
Eval( ::bChange, nKey, nFlags, Self )
endif
endif
return 0
case nKey == VK_DELETE
if ::lReadOnly
return 0
endif
if ::bChange != nil
Eval( ::bChange, nKey, nFlags, Self )
endif
endcase
return ::Super:KeyDown( nKey, nFlags )
//---------------------------------------------------------------------------//
METHOD KeyChar( nKey, nFlags ) CLASS TMultiGet
local bKeyAction := SetKey( nKey )
if bKeyAction != nil .and. lAnd( nFlags, 16777216 ) // function Key
Eval( bKeyAction, ProcName( 4 ), ProcLine( 4 ), Self )
return 0 // Already processed, API do nothing
endif
if ::lReadOnly
if nKey == VK_RETURN
::oWnd:GoNextCtrl( ::hWnd )
endif
return 0
endif
if nKey == VK_RETURN .and. ;
lAnd( GetWindowLong( ::hWnd, GWL_STYLE ), ES_WANTRETURN )
::oWnd:nLastKey = 0
if ::bChange != nil
Eval( ::bChange, nKey, nFlags, Self )
endif
return nil
endif
if nKey == VK_TAB
return ::Super:KeyChar( nKey, nFlags )
endif
if !::lReadOnly
CallWindowProc( ::nOldProc, ::hWnd, WM_CHAR, nKey, nFlags )
Eval( ::bSetGet, ::GetText() )
if ::bChange != nil
Eval( ::bChange, nKey, nFlags, Self )
endif
return 0
endif
return ::Super:KeyChar( nKey, nFlags )
//---------------------------------------------------------------------------//
METHOD Paint() CLASS TMultiGet
local aInfo := ::DispBegin(), nOldMode, hOldFont
if ! Empty( ::bColor )
tmp = ::aColor
::nClrText = tmp[ 1 ]
::nClrPane = tmp[ 2 ]
if ! Empty( ::oBrush )
::oBrush:End()
endif
::oBrush = TBrush():New( , ::nClrPane )
endif
if ::oBrush != nil
FillRect( ::hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
else
CallWindowProc( ::nOldProc, ::hWnd, WM_ERASEBKGND, ::hDC, 0 )
endif
if Empty( ::bColor ) .or. ::lActive
CallWindowProc( ::nOldProc, ::hWnd, WM_PAINT, ::hDC, 0 )
else
FillRect( ::hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
SetTextColor( ::hDC, ::nClrText )
SetBkColor( ::hDC, ::nClrPane )
if ::oFont != nil
hOldFont = SelectObject( ::hDC, ::oFont:hFont )
endif
nOldMode = SetBkMode( ::hDC, TRANSPARENT )
DrawTextEx( ::hDC, GetWindowText( ::hWnd ),;
{ 2, 3, ::nHeight(), ::nWidth() }, DT_WORDBREAK )
SetBkMode( ::hDC, nOldMode )
if ::oFont != nil
SelectObject( ::hDC, hOldFont )
endif
endif
if ValType( ::bPainted ) == "B"
Eval( ::bPainted, ::hDC, ::cPS, Self )
endif
::DispEnd( aInfo )
return 1
//----------------------------------------------------------------------------//
METHOD Paste( cText ) CLASS TMultiGet
local oClp, cFile
#ifdef __XPP__
#undef New
#endif
DEFINE CLIPBOARD oClp OF Self FORMAT TEXT
if Empty( cText ) .and. GetClipContentFormat( 15 ) == 15
cFile := oClp:GetFiles()[ 1 ]
cText := MEMOREAD( cFile )
if IsBinaryData( cText )
cText := cFile
endif
endif
if ! Empty( cText )
oClp:SetText( cText )
endif
::SendMsg( WM_PASTE )
Eval( ::bSetGet, ::GetText() )
if ::bChange != nil
Eval( ::bChange,,, Self )
endif
oClp:End()
return nil
//----------------------------------------------------------------------------//
METHOD RButtonDown( nRow, nCol, nFlags ) CLASS TMultiGet
local oMenu, oClp
if GetFocus() != ::hWnd
::SetFocus()
SysRefresh() // In case there is a VALID somewhere
if GetFocus() != ::hWnd
return nil
endif
endif
#ifdef __XPP__
#undef New
#endif
if ::bRClicked != nil
return Eval( ::bRClicked, nRow, nCol, nFlags )
endif
DEFINE CLIPBOARD oClp OF Self FORMAT TEXT
MENU oMenu POPUP
MENUITEM FWString( "&Undo" ) ACTION ( oMenuItem, ::UnDo() ) WHEN ( oMenuItem, ::SendMsg( EM_CANUNDO ) != 0 )
SEPARATOR
MENUITEM FWString( "Cu&t" ) ACTION ( oMenuItem, ::Cut() ) WHEN ( oMenuItem, ! Empty( ::GetSel() ) .and. !::lReadOnly )
MENUITEM FWString( "&Copy" ) ACTION ( oMenuItem, ::Copy() ) WHEN ( oMenuItem, ! Empty( ::GetSel() ) )
// MENUITEM FWString( "&Paste" ) ACTION ( oMenuItem, ::Paste() ) WHEN ( oMenuItem, ! Empty( oClp:GetText() ) .and. !::lReadOnly )
MENUITEM FWString( "&Paste" ) ACTION ( oMenuItem, ::Paste() ) WHEN ( oMenuItem, GetClipContentFormat( 13, 1, 15 ) > 0 .and. !::lReadOnly )
MENUITEM FWString( "&Delete" ) ACTION ( oMenuItem, ::Del() ) WHEN ( oMenuItem, ! Empty( ::GetSel() ) .and. !::lReadOnly )
if Upper( ::ClassName() ) == "TRICHEDIT"
SEPARATOR
MENUITEM FWString( "&Font" ) ACTION ( oMenuItem, ::SetCharFormat() )
endif
SEPARATOR
MENUITEM FWString( "P&rint" ) ACTION ( oMenuItem, ::Print() )
SEPARATOR
MENUITEM FWString( "Select &All" ) ACTION ( oMenuItem, ::SelectAll() )
ENDMENU
oClp:End()
ACTIVATE POPUP oMenu AT nRow - 60, nCol OF Self
return 0 // Message already processed
//----------------------------------------------------------------------------//
METHOD GotFocus() CLASS TMultiGet
::Super:GotFocus()
// ::SetPos( ::nPos )
CallWindowProc( ::nOldProc, ::hWnd, WM_SETFOCUS )
if Set( _SET_INSERT )
DestroyCaret()
CreateCaret( ::hWnd, 0, If( ::lChangeCaret, 6, 1 ),;
::nGetChrHeight() )
ShowCaret( ::hWnd )
endif
if ::lClrFocus
::nOldClrPane = ::nClrPane
::SetColor( ::nClrText,;
If( ValType( ::nClrFocus ) == "B", Eval( ::nClrFocus ), ::nClrFocus ) )
else
if ! Empty( ::bColor )
tmp = ::aColor
::nClrText = tmp[ 1 ]
::nClrPane = tmp[ 2 ]
::oBrush:End()
::oBrush = TBrush():New( , ::nClrPane )
::Refresh()
endif
endif
return 0
//----------------------------------------------------------------------------//
METHOD LostFocus( hCtlFocus ) CLASS TMultiGet
::Super:LostFocus( hCtlFocus )
if ::bSetGet != nil
Eval( ::bSetGet, ::GetText() )
endif
::nPos = nLoWord( ::SendMsg( EM_GETSEL ) )
if ::lClrFocus
if ::nOldClrPane != nil
::SetColor( ::nClrText, ::nOldClrPane )
endif
else
if ! Empty( ::bColor )
tmp = ::aColor
::nClrText = tmp[ 1 ]
::nClrPane = tmp[ 2 ]
::oBrush:End()
::oBrush = TBrush():New( , ::nClrPane )
::Refresh()
::Refresh()
endif
endif
return nil
//----------------------------------------------------------------------------//
METHOD Default() CLASS TMultiGet
return nil
//---------------------------------------------------------------------------//
METHOD Move( nTop, nLeft, nBottom, nRight, lRepaint ) CLASS TMultiGet
::Super:Move( nTop, nLeft, nBottom, nRight, lRepaint )
MoveGet( ::hWnd )
return nil
//----------------------------------------------------------------------------//
METHOD SetCoors( oRect ) CLASS TMultiGet
::Super:SetCoors( oRect )
MoveGet( ::hWnd )
return nil
//----------------------------------------------------------------------------//
METHOD Print() CLASS TMultiGet
local oPrn, oFont
local nRowStep
local nRow := 0, nCol := 0, n, n1 := 0
local nLines := ::GetLineCount()
PRINT oPrn NAME "Notes"
if Empty( oPrn:hDC )
MsgStop( "Printer not ready!" )
return self
endif
CursorWait()
DEFINE FONT oFont NAME GetSysFont() SIZE 0, -11 OF oPrn
nRowStep = oPrn:nVertRes() / 60 // We want 60 rows
PAGE
for n = 1 to nLines // rows
oPrn:Say( nRow, nCol, ::GetLine( n ), oFont )
nRow += nRowStep
n1 ++
IF n1 == 60
nRow := 0
n1 := 0
ENDPAGE
PAGE
ENDIF
next
ENDPAGE
ENDPRINT
oFont:End() // Destroy the font object
CursorArrow()
return nil
//----------------------------------------------------------------------------//
METHOD SetColorFocus( nClrFocus ) CLASS TMultiGet
local nOldClrFocus := ::nClrFocus
::lClrFocus = .T.
if nClrFocus != nil
::nClrFocus = nClrFocus
endif
return nOldClrFocus
//----------------------------------------------------------------------------//
function SetMGetColorFocus( nClrFocus )
return TMultiGet():SetColorFocus( nClrFocus )
//----------------------------------------------------------------------------//
by carlos vargas » Fri Apr 19, 2024 11:29 pm
by karinha » Mon Apr 22, 2024 11:58 am
by Antonio Linares » Mon Apr 22, 2024 12:01 pm
by karinha » Mon Apr 22, 2024 1:59 pm
Antonio Linares wrote:Estimado Joao,
En los mensajes anteriores en esta conversación tienes un ejemplo getclr.prg
by karinha » Mon Apr 22, 2024 2:02 pm
// C:\MULTIGET\GETCLR2.PRG
#Include "FiveWin.ch" // Aparentemente TGET.PRG es mucho mejor.
FUNCTION Main()
LOCAL oDlg, oGet1, oGet2, oGet3, oGet4, Test1, cTest2, cTest3, cTest4, ;
oFont, oBtn, oSay, cSay, oSay2, cSay2, oSay3, cSay3, cTitle
cTest1 := SPACE( 50 )
cTest2 := SPACE( 50 )
cTest3 := SPACE( 100 )
cTest4 := SPACE( 100 )
cTest1 := "Test de MULTIGET cTest1"
cTest2 := "Test de MULTIGET cTest2"
cTest3 := "Test de MULTIGET en cTest3 MGET.PRG " + CRLF + ;
"Otro Texto con MULTILINE en cTest3 MGET.PRG" + CRLF + ;
"Otro Texto con MULTILINE en cTest3 MGET.PRG"
cTest4 := "Test de MULTIGET cTest4 MGET.PRG " + CRLF + ;
"Otro Texto CON MULTILINE MGET.PRG"
SkinButtons()
cTitle := "FWH: TESTANDO MGET.PRG -> TGET.PRG ES MUCHO MEJOR(MAS COMPLETA)"
// No me gusta esto, porque no es igual a la TGET.PRG - complicado usar esto.
TGet():bColorBlock := {| oGet | IF( oGet:lFocused, { CLR_WHITE, CLR_GREEN }, ;
IF( .NOT. oGet:lActive, { CLR_RED, CLR_YELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }
TMultiGet():bColorBlock := {| oGet | IF( oGet:lFocused, { CLR_WHITE, CLR_GREEN }, ;
IF( .NOT. oGet:lActive, { CLR_RED, CLR_YELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }
DEFINE FONT oFont NAME "Verdana" SIZE 0,-14 BOLD
DEFINE DIALOG oDlg SIZE 520, 354 TITLE cTitle COLOR CLR_BLACK, CLR_WHITE ;
TRANSPARENT
oDlg:lHelpIcon := .F.
@ 1, 1 GET oGet1 VAR cTest1 SIZE 130, 16 PICTURE "@!" OF oDlg FONT oFont ;
UPDATE // NOBORDER -> FUNCIONA SI. -> COLORS NO FUNCIONA. BAD.
@ 2.3, 1 GET oGet2 VAR cTest2 SIZE 130, 16 PICTURE "@!" OF oDlg FONT oFont
// PICTURE NO FUNCIONA CON MULTILINE.
// Maestro Antonio:
// ¿CÓMO SALTO DE UNA MULTILÍNEA PARA LLEGAR A LA OTRA?
@ 3.5, 1 GET oGet3 VAR cTest3 MULTILINE SIZE 200, 30 OF oDlg FONT oFont
// PICTURE NO FUNCIONA CON MULTILINE.
@ 6.5, 1 GET oGet4 VAR cTest4 MULTILINE SIZE 200, 30 OF oDlg FONT oFont
cSay := "¿CÓMO SALTO DE UNA MULTILÍNEA PARA LLEGAR A LA OTRA?"
@ 8.0, 01 SAY oSay VAR cSay PICTURE "@!" OF oDlg FONT oFont UPDATE ;
COLORS METRO_ORANGE, CLR_WHITE TRANSPARENT
cSay2 := "COMO HAGO EN WORKSHOP.exe?"
@ 11.0, 20 SAY oSay2 VAR cSay2 PICTURE "@!" OF oDlg FONT oFont UPDATE ;
COLORS METRO_ORANGE, CLR_WHITE TRANSPARENT
cSay3 := "FIVEWIN The Best"
@ 11.0, 00 SAY oSay3 VAR cSay3 PICTURE "@" OF oDlg FONT oFont UPDATE ;
COLORS METRO_PINK, CLR_WHITE TRANSPARENT
@ 133.5, 100 BTNBMP oBtn PROMPT "&EXIT" FILENAME ".\Exit.bmp" ;
SIZE 35, 35 OF oDlg PIXEL NOBORDER TOP 2007 FLAT FONT oFont ;
COLOR CLR_HRED, CLR_WHITE ACTION( oDlg:End() )
oBtn:lCancel := .T.
oBtn:nRound := 60
oBtn:bClrGrad := { |lInvert| If( lInvert, 0x80FFA54A, nARGB( 54, 0, 192, 0 ) ) }
ACTIVATE DIALOG oDlg CENTERED /* ;
ON INIT ( oGet1:Disable(), oGet3:Disable(), .T. ) */
oFont:End()
RETURN NIL
// FIN / END - kapiabafwh@gmail.com
by Antonio Linares » Mon Apr 22, 2024 8:03 pm
by karinha » Tue Apr 23, 2024 1:19 pm
Antonio Linares wrote:Estimado Joao,
Para saltar de un control a otro usa la tecla Tab
by karinha » Tue Apr 23, 2024 1:23 pm
// C:\MULTIGET\GETCLR2.PRG - Version: 3.1 - by kapiabafwh@gmail.com
#Include "FiveWin.ch" // Aparentemente TGET.PRG es mucho mejor.
FUNCTION Main()
LOCAL oDlg, oGet1, oGet2, oGet3, oGet4, Test1, cTest2, cTest3, cTest4, ;
oFont, oBtn, oSay, cSay, oSay2, cSay2, oSay3, cSay3, cTitle
cTest1 := SPACE( 50 )
cTest2 := SPACE( 50 )
cTest3 := SPACE( 100 )
cTest4 := SPACE( 100 )
cTest1 := "Test de MULTIGET cTest1"
cTest2 := "Test de MULTIGET cTest2"
cTest3 := "Test de MULTIGET en cTest3 MGET.PRG " + ;
"Otro Texto con MULTILINE en cTest3 MGET.PRG " + ;
"Otro Texto con MULTILINE en cTest3 MGET.PRG."
cTest4 := "Test de MULTIGET cTest4 MGET.PRG " + ;
"Otro Texto CON MULTILINE MGET.PRG."
SkinButtons()
cTitle := "FWH: TESTANDO MGET.PRG -> TGET.PRG ES MUCHO MEJOR(MAS COMPLETA)"
// No me gusta esto, porque no es igual a la TGET.PRG - complicado usar esto.
TGet():bColorBlock := {| oGet | IF( oGet:lFocused, { CLR_WHITE, CLR_GREEN }, ;
IF( .NOT. oGet:lActive, { CLR_RED, CLR_YELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }
TMultiGet():bColorBlock := {| oGet | IF( oGet:lFocused, { CLR_WHITE, CLR_GREEN }, ;
IF( .NOT. oGet:lActive, { CLR_RED, CLR_YELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }
DEFINE FONT oFont NAME "Verdana" SIZE 0,-14 BOLD
DEFINE DIALOG oDlg SIZE 520, 354 TITLE cTitle COLOR CLR_BLACK, CLR_WHITE ;
TRANSPARENT
oDlg:lHelpIcon := .F.
IF Set( _SET_INSERT, ! Set( _SET_INSERT ) )
Set( _SET_INSERT, ! Set( _SET_INSERT ) )
ENDIF
@ 1, 1 GET oGet1 VAR cTest1 SIZE 130, 16 PICTURE "@!" OF oDlg FONT oFont ;
UPDATE ; // NOBORDER -> FUNCIONA SI. -> COLORS NO FUNCIONA. BAD.
VALID( BLOCK_GET1() )
oGet1:bLostFocus := { || oGet1:SetColor( CLR_BLACK, CLR_WHITE) }
oGet1:bGotFocus := { || oGet1:SetColor( CLR_BLACK, nRGB( 255,255,45 )), ;
oGet1:SetSel(0,0) }
@ 2.3, 1 GET oGet2 VAR cTest2 SIZE 130, 16 PICTURE "@!" OF oDlg FONT oFont
oGet2:bLostFocus := { || oGet2:SetColor( CLR_BLACK, CLR_WHITE) }
oGet2:bGotFocus := { || oGet2:SetColor( CLR_BLACK, nRGB( 255,255,45 )), ;
oGet2:SetSel(0,0) }
@ 3.5, 1 GET oGet3 VAR cTest3 MULTILINE SIZE 245, 30 OF oDlg FONT oFont
oGet3:bLostFocus := { || oGet3:SetColor( CLR_BLACK, CLR_WHITE) }
oGet3:bGotFocus := { || oGet3:SetColor( CLR_BLACK, nRGB( 255,255,45 )), ;
oGet3:SetSel(0,0) }
// <Enter> y Flecha Arriba
oGet3:bKeyDown:={|nKey|IF(nKey==VK_RETURN, VER_FOCO_GET3( oGet4 ), ;
IF(nKey==VK_UP, oGet2:SetFocus(), ) ) }
@ 6.5, 1 GET oGet4 VAR cTest4 MULTILINE SIZE 245, 30 OF oDlg FONT oFont
oGet4:bLostFocus := { || oGet4:SetColor( CLR_BLACK, CLR_WHITE) }
oGet4:bGotFocus := { || oGet4:SetColor( CLR_BLACK, nRGB( 2455,255,45 )), ;
oGet4:SetSel(0,0) }
// SALTO DE UNA MULTILÍNEA PARA LLEGAR A LA OTRA
oGet4:bKeyDown:={|nKey|IF(nKey==VK_UP, VER_FOCO_GET4( oGet3 ),)}
cSay := "<ENTER> PARA SALTAR Y LA FLECHA ARRIBA PARA VOLVER."
@ 8.0, 01 SAY oSay VAR cSay PICTURE "@!" OF oDlg FONT oFont UPDATE ;
COLORS METRO_ORANGE, CLR_WHITE TRANSPARENT
cSay2 := "Antônio Liñares"
@ 10.5, 17.5 SAY oSay2 VAR cSay2 PICTURE "@" OF oDlg FONT oFont UPDATE ;
RIGHT COLORS METRO_VIOLET, CLR_WHITE TRANSPARENT
cSay3 := "FIVEWIN The Best"
@ 10.5, 01 SAY oSay3 VAR cSay3 PICTURE "@" OF oDlg FONT oFont UPDATE ;
COLORS METRO_PINK, CLR_WHITE TRANSPARENT
@ 133.5, 105 BTNBMP oBtn PROMPT "&EXIT" FILENAME ".\Exit.bmp" ;
SIZE 35, 35 OF oDlg PIXEL NOBORDER TOP 2007 FLAT FONT oFont ;
COLOR CLR_HRED, CLR_WHITE ACTION( oDlg:End() )
oBtn:lCancel := .T.
oBtn:nRound := 30
oBtn:bClrGrad := { |lInvert| If( lInvert, 0x80FFA54A, nARGB( 54, 0, 192, 0 ) ) }
ACTIVATE DIALOG oDlg CENTERED /* ;
ON INIT ( oGet1:Disable(), oGet3:Disable(), .T. ) */
IF Set( _SET_INSERT, ! Set( _SET_INSERT ) )
Set( _SET_INSERT, ! Set( _SET_INSERT ) )
ENDIF
oFont:End()
RETURN NIL
FUNCTION BLOCK_GET1()
IF GETASYNCKEY( VK_UP )
RETURN( .F. )
ENDIF
RETURN( .T. )
FUNCTION VER_FOCO_GET3( oGet4 ) // GET 3
oGet4:SetFocus()
oGet4:bGotFocus := { || oGet4:SetPos(0), Nil }
RETURN( .T. )
FUNCTION VER_FOCO_GET4( oGet3 ) // GET 3
oGet3:SetFocus()
oGet3:bGotFocus := { || oGet3:SetPos(0), Nil }
XFOCUS( oGet3 )
RETURN( .T. )
FUNCTION xFocus( oObj )
xSetFocus( oObj )
xSetFocus( oObj )
RETURN( .T. )
FUNCTION xSetFocus( oObj )
LOCAL _oWnd := oObj:oWnd, _oTempo := ""
DEFINE TIMER _oTempo INTERVAL 10 OF _oWnd ;
ACTION ( oObj:SetFocus(), _oTempo:End() )
ACTIVATE TIMER _oTempo
RETURN( .T. )
// FIN / END - kapiabafwh@gmail.com
by Antonio Linares » Tue Apr 23, 2024 1:32 pm
by karinha » Tue Apr 23, 2024 1:45 pm
Antonio Linares wrote:Joao,
Aqui funciona bien usando Tab y Shift-Tab
cual es el problema ?
by Antonio Linares » Tue Apr 23, 2024 1:56 pm
Return to FiveWin para Harbour/xHarbour
Users browsing this forum: Google [Bot] and 34 guests