1b46bf32b9
* tests/Makefile
* tests/rto_get.prg
+ tests/rto_tb.prg
* include/button.ch
* include/hbextern.ch
* common.mak
* source/rtl/Makefile
- source/rtl/mssgline.prg
+ source/rtl/gui.prg
+ source/rtl/menusys.prg
+ source/rtl/tmenusys.prg
* source/rtl/checkbox.prg
* source/rtl/einstvar.prg
* source/rtl/getlist.prg
* source/rtl/getsys.prg
* source/rtl/listbox.prg
* source/rtl/memoedit.prg
* source/rtl/pushbtn.prg
* source/rtl/radiobtn.prg
* source/rtl/radiogrp.prg
* source/rtl/scrollbr.prg
* source/rtl/tbcolumn.prg
* source/rtl/tbrowse.prg
* source/rtl/teditor.prg
* source/rtl/tget.prg
* source/rtl/tgetlist.prg
* source/rtl/tlabel.prg
* source/rtl/tmenuitm.prg
* source/rtl/tpopup.prg
* source/rtl/treport.prg
* source/rtl/ttopbar.prg
; These changes mainly targeted the .prg
level UI classes of Harbour.
+ Code standardization, cleanup, formatting.
(formatting is not fully complete yet)
! Lots of compatibility fixes.
! Lots of bugfixes (crashes, wrongly passed
parameters, etc).
! Minor fix in one of the methods of HBReportForm()
- Non-Clipper classes removed (the MENUSYS/msgline
related ones).
! Some fixes adapted from xHarbour's TBrowse()
+ Class VARs properly scoped.
+ TBColumn() is now fully compatible.
* The mess in the TTopBar and related classes was
cleaned up, some small non-Clipper compatible
classes were removed and a new TMenuSys class
was created of the related parts.
% Optimizations.
+ TBrowse/TBColumn regression test suite
added (far from complete at this point).
; NOTE: No C5.3 GUI support is implemented in Harbour.
; NOTE: Harbour uses Disp*() functions in UI functions
to update screen. C5.x uses a mixture of Dev*(),
Q?Out() and Disp*().
; NOTE: TBrowse() fixing is still a work in progress.
; Please test.
398 lines
10 KiB
Plaintext
398 lines
10 KiB
Plaintext
/*
|
|
* $Id$
|
|
*/
|
|
|
|
/*
|
|
* Harbour Project source code:
|
|
* PUSHBUTTON class
|
|
*
|
|
* Copyright 2000 Luiz Rafael Culik <culik@sl.conex.net>
|
|
* www - http://www.harbour-project.org
|
|
*
|
|
* This program is free software; you can redistribute it and/or modify
|
|
* it under the terms of the GNU General Public License as published by
|
|
* the Free Software Foundation; either version 2, or (at your option)
|
|
* any later version.
|
|
*
|
|
* This program is distributed in the hope that it will be useful,
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
* GNU General Public License for more details.
|
|
*
|
|
* You should have received a copy of the GNU General Public License
|
|
* along with this software; see the file COPYING. If not, write to
|
|
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
|
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
|
*
|
|
* As a special exception, the Harbour Project gives permission for
|
|
* additional uses of the text contained in its release of Harbour.
|
|
*
|
|
* The exception is that, if you link the Harbour libraries with other
|
|
* files to produce an executable, this does not by itself cause the
|
|
* resulting executable to be covered by the GNU General Public License.
|
|
* Your use of that executable is in no way restricted on account of
|
|
* linking the Harbour library code into it.
|
|
*
|
|
* This exception does not however invalidate any other reasons why
|
|
* the executable file might be covered by the GNU General Public License.
|
|
*
|
|
* This exception applies only to the code released by the Harbour
|
|
* Project under the name Harbour. If you copy code from other
|
|
* Harbour Project or Free Software Foundation releases into a copy of
|
|
* Harbour, as the General Public License permits, the exception does
|
|
* not apply to the code that you add in this way. To avoid misleading
|
|
* anyone as to the status of such modified files, you must delete
|
|
* this exception notice from them.
|
|
*
|
|
* If you write modifications of your own for Harbour, it is your choice
|
|
* whether to permit this exception to apply to your modifications.
|
|
* If you do not wish that, delete this exception notice.
|
|
*
|
|
*/
|
|
|
|
#include 'hbclass.ch'
|
|
|
|
#include "button.ch"
|
|
#include "color.ch"
|
|
#include "common.ch"
|
|
#include "setcurs.ch"
|
|
|
|
/* NOTE: Harbour doesn't support CA-Cl*pper 5.3 GUI functionality, but
|
|
it has all related variables and methods. */
|
|
|
|
/* NOTE: CA-Cl*pper 5.3 uses a mixture of QQOut(), DevOut(), Disp*()
|
|
functions to generate screen output. Harbour uses Disp*()
|
|
functions only. [vszakats] */
|
|
|
|
#ifdef HB_COMPAT_C53
|
|
|
|
CREATE CLASS PUSHBUTTON FUNCTION HBPushButton
|
|
|
|
EXPORT:
|
|
|
|
VAR cargo /* NOTE: CA-Clipper 5.3 has a bug, where this var cannot be assigned NIL. */
|
|
|
|
VAR bmpXOff INIT -1 /* NOTE: Fully compatible behaviour not implemented. */
|
|
VAR bmpYOff INIT -1 /* NOTE: Fully compatible behaviour not implemented. */
|
|
VAR capXOff INIT -1 /* NOTE: Fully compatible behaviour not implemented. */
|
|
VAR capYOff INIT -1 /* NOTE: Fully compatible behaviour not implemented. */
|
|
VAR sizeX INIT 0 /* NOTE: Fully compatible behaviour not implemented. */
|
|
VAR sizeY INIT 0 /* NOTE: Fully compatible behaviour not implemented. */
|
|
|
|
METHOD display()
|
|
METHOD hitTest( nRow, nCol )
|
|
METHOD killFocus()
|
|
METHOD select()
|
|
METHOD setFocus()
|
|
|
|
METHOD bitmap( cBitmap ) SETGET
|
|
METHOD buffer() SETGET
|
|
METHOD caption( cCaption ) SETGET
|
|
METHOD col( nCol ) SETGET
|
|
METHOD colorSpec( cColorSpec ) SETGET
|
|
METHOD fBlock( bFBlock ) SETGET
|
|
METHOD hasFocus() SETGET
|
|
METHOD message( cMessage ) SETGET
|
|
METHOD row( nRow ) SETGET
|
|
METHOD sBlock( bSBlock ) SETGET
|
|
METHOD typeOut() SETGET
|
|
METHOD style( cStyle ) SETGET
|
|
|
|
METHOD New( nRow, nCol, cCaption ) /* NOTE: This method is a Harbour extension [vszakats] */
|
|
|
|
PROTECTED:
|
|
|
|
VAR cBitmap INIT ""
|
|
VAR lBuffer INIT .F.
|
|
VAR cCaption
|
|
VAR nCol
|
|
VAR cColorSpec
|
|
VAR bFBlock
|
|
VAR lHasFocus INIT .F.
|
|
VAR cMessage INIT ""
|
|
VAR nRow
|
|
VAR bSBlock
|
|
VAR cStyle INIT "<>"
|
|
VAR lTypeOut INIT .F.
|
|
|
|
ENDCLASS
|
|
|
|
METHOD setFocus() CLASS PUSHBUTTON
|
|
|
|
IF !::lHasFocus
|
|
::lHasFocus := .T.
|
|
::display()
|
|
|
|
IF ISBLOCK( ::bFBlock )
|
|
Eval( ::bFBlock )
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN Self
|
|
|
|
METHOD select( nPos ) CLASS PUSHBUTTON
|
|
|
|
LOCAL nCurPos := nPos
|
|
|
|
IF ::lHasFocus
|
|
::lbuffer := .T.
|
|
::display()
|
|
|
|
IF ISNUMBER( nPos )
|
|
|
|
IF nPos == 32
|
|
|
|
Inkey( 0.4 )
|
|
DO WHILE nCurPos == 32
|
|
nCurPos := Inkey( 0.1 )
|
|
ENDDO
|
|
ELSE
|
|
DO WHILE nPos == Inkey( 0 )
|
|
ENDDO
|
|
ENDIF
|
|
ENDIF
|
|
|
|
IF ISBLOCK( ::bSBlock )
|
|
Eval( ::bSBlock )
|
|
ENDIF
|
|
|
|
::lBuffer := .F.
|
|
::display()
|
|
ENDIF
|
|
|
|
RETURN Self
|
|
|
|
METHOD killFocus() CLASS PUSHBUTTON
|
|
|
|
IF ::lHasFocus
|
|
::lHasFocus := .F.
|
|
|
|
IF ISBLOCK( ::bFBlock )
|
|
Eval( ::bFBlock )
|
|
ENDIF
|
|
|
|
::display()
|
|
ENDIF
|
|
|
|
RETURN Self
|
|
|
|
METHOD hitTest( nRow, nCol ) CLASS PUSHBUTTON
|
|
|
|
LOCAL nCurrentPos := 1
|
|
LOCAL nLen := Len( ::cCaption )
|
|
LOCAL nStyleLen
|
|
LOCAL nAccelPos
|
|
|
|
IF ( nAccelPos := At( "&", ::cCaption ) ) > 0 .AND. nAccelPos < nLen
|
|
nLen--
|
|
ENDIF
|
|
|
|
IF ( nStyleLen := Len( ::cStyle ) ) == 2
|
|
nLen += 2
|
|
ELSEIF nStyleLen == 8
|
|
nCurrentPos := 3
|
|
nLen += 2
|
|
ENDIF
|
|
|
|
IF nRow >= ::Row .AND. ;
|
|
nCol >= ::Col .AND. ;
|
|
nRow < ::Row + nCurrentPos .AND. ;
|
|
nCol < ::Col + nLen
|
|
RETURN HTCLIENT
|
|
ENDIF
|
|
|
|
RETURN HTNOWHERE
|
|
|
|
METHOD display() CLASS PUSHBUTTON
|
|
|
|
LOCAL cOldColor := SetColor()
|
|
LOCAL nOldRow := Row()
|
|
LOCAL nOldCol := Col()
|
|
LOCAL lOldMCur := MSetCursor( .F. )
|
|
|
|
LOCAL cStyle := ::cStyle
|
|
LOCAL cCaption := ::cCaption
|
|
LOCAL nRow := ::nRow
|
|
LOCAL nCol := ::nCol
|
|
LOCAL nPos
|
|
|
|
DispBegin()
|
|
|
|
IF ::lBuffer
|
|
SetColor( __GUIColor( ::cColorSpec, 3 ) )
|
|
ELSEIF ::lHasFocus
|
|
SetColor( __GUIColor( ::cColorSpec, 2 ) )
|
|
ELSE
|
|
SetColor( __GUIColor( ::cColorSpec, 1 ) )
|
|
ENDIF
|
|
|
|
IF ( nPos := At( "&", cCaption ) ) == 0
|
|
ELSEIF nPos == Len( cCaption )
|
|
nPos := 0
|
|
ELSE
|
|
cCaption := Stuff( cCaption, nPos, 1, "" )
|
|
ENDIF
|
|
|
|
IF !Empty( cStyle )
|
|
|
|
nCol++
|
|
|
|
IF Len( cStyle ) == 2
|
|
DispOutAt( ::nRow, ::nCol, SubStr( cStyle, 1, 1 ) )
|
|
DispOutAt( ::nRow, ::nCol + Len( cCaption ) + 1, SubStr( cStyle, 2, 1 ) )
|
|
ELSE
|
|
nRow++
|
|
DispBox( ::nRow, ::nCol, ::nRow + 2, ::nCol + Len( cCaption ) + 1, cStyle )
|
|
ENDIF
|
|
ENDIF
|
|
|
|
IF !Empty( cCaption )
|
|
|
|
DispOutAt( nRow, nCol, cCaption )
|
|
|
|
IF nPos != 0
|
|
DispOutAt( nRow, nCol + nPos - 1, SubStr( cCaption, nPos, 1 ), __GUIColor( ::cColorSpec, 4 ) )
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
DispEnd()
|
|
|
|
MSetCursor( lOldMCur )
|
|
SetColor( cOldColor )
|
|
SetPos( nOldRow, nOldCol )
|
|
|
|
RETURN Self
|
|
|
|
METHOD bitmap( cBitmap ) CLASS PUSHBUTTON
|
|
|
|
IF cBitmap != NIL
|
|
::cBitmap := _eInstVar( Self, "BITMAP", cBitmap, "C", 1001 )
|
|
ENDIF
|
|
|
|
RETURN ::cBitmap
|
|
|
|
METHOD buffer() CLASS PUSHBUTTON
|
|
RETURN ::lBuffer
|
|
|
|
METHOD caption( cCaption ) CLASS PUSHBUTTON
|
|
|
|
IF cCaption != NIL
|
|
::cCaption := _eInstVar( Self, "CAPTION", cCaption, "C", 1001 )
|
|
ENDIF
|
|
|
|
RETURN ::cCaption
|
|
|
|
METHOD col( nCol ) CLASS PUSHBUTTON
|
|
|
|
IF nCol != NIL
|
|
::nCol := _eInstVar( Self, "COL", nCol, "N", 1001 )
|
|
ENDIF
|
|
|
|
RETURN ::nCol
|
|
|
|
METHOD colorSpec( cColorSpec ) CLASS PUSHBUTTON
|
|
|
|
IF cColorSpec != NIL
|
|
::cColorSpec := _eInstVar( Self, "COLORSPEC", cColorSpec, "C", 1001,;
|
|
{|| !Empty( __GUIColor( cColorSpec, 4 ) ) .AND. Empty( __GUIColor( cColorSpec, 6 ) ) } )
|
|
ENDIF
|
|
|
|
RETURN ::cColorSpec
|
|
|
|
METHOD fBlock( bFBlock ) CLASS PUSHBUTTON
|
|
|
|
IF PCount() > 0
|
|
::bFBlock := iif( bFBlock == NIL, NIL, _eInstVar( Self, "FBLOCK", bFBlock, "B", 1001 ) )
|
|
ENDIF
|
|
|
|
RETURN ::bFBlock
|
|
|
|
METHOD hasFocus() CLASS PUSHBUTTON
|
|
RETURN ::lHasFocus
|
|
|
|
METHOD message( cMessage ) CLASS PUSHBUTTON
|
|
|
|
IF cMessage != NIL
|
|
::cMessage := _eInstVar( Self, "MESSAGE", cMessage, "C", 1001 )
|
|
ENDIF
|
|
|
|
RETURN ::cMessage
|
|
|
|
METHOD row( nRow ) CLASS PUSHBUTTON
|
|
|
|
IF nRow != NIL
|
|
::nRow := _eInstVar( Self, "ROW", nRow, "N", 1001 )
|
|
ENDIF
|
|
|
|
RETURN ::nRow
|
|
|
|
METHOD sBlock( bSBlock ) CLASS PUSHBUTTON
|
|
|
|
IF PCount() > 0
|
|
::bSBlock := iif( bSBlock == NIL, NIL, _eInstVar( Self, "SBLOCK", bSBlock, "B", 1001 ) )
|
|
ENDIF
|
|
|
|
RETURN ::bSBlock
|
|
|
|
METHOD typeOut() CLASS PUSHBUTTON
|
|
RETURN .F.
|
|
|
|
METHOD style( cStyle ) CLASS PUSHBUTTON
|
|
|
|
IF cStyle != NIL
|
|
::cStyle := _eInstVar( Self, "STYLE", cStyle, "C", 1001, {|| Len( cStyle ) == 0 .OR. Len( cStyle ) == 2 .OR. Len( cStyle ) == 8 } )
|
|
ENDIF
|
|
|
|
RETURN ::cStyle
|
|
|
|
METHOD New( nRow, nCol, cCaption ) CLASS PUSHBUTTON
|
|
|
|
LOCAL cColor
|
|
|
|
IF !ISNUMBER( nRow ) .OR. ;
|
|
!ISNUMBER( nCol )
|
|
RETURN NIL
|
|
ENDIF
|
|
|
|
DEFAULT cCaption TO ""
|
|
|
|
::caption := cCaption
|
|
::nCol := nCol
|
|
::nRow := nRow
|
|
|
|
IF IsDefColor()
|
|
::cColorSpec := "W/N,N/W,W+/N,W+/N"
|
|
ELSE
|
|
cColor := SetColor()
|
|
::cColorSpec := __GUIColor( cColor, CLR_UNSELECTED + 1 ) + "," +;
|
|
__GUIColor( cColor, CLR_ENHANCED + 1 ) + "," +;
|
|
__GUIColor( cColor, CLR_STANDARD + 1 ) + "," +;
|
|
__GUIColor( cColor, CLR_BACKGROUND + 1 )
|
|
ENDIF
|
|
|
|
RETURN Self
|
|
|
|
FUNCTION PushButton( nRow, nCol, cCaption )
|
|
RETURN HBPushButton():New( nRow, nCol, cCaption )
|
|
|
|
FUNCTION _PUSHBUTT_( cCaption, cMessage, cColorSpec, bFBlock, bSBlock, cStyle, nSizeX, nSizeY, nCapXOff, nCapYOff, cBitmap, nBmpXOff, nBmpYOff )
|
|
LOCAL o := HBPushButton():New( Row(), Col(), cCaption )
|
|
|
|
o:message := cMessage
|
|
o:colorSpec := cColorSpec
|
|
o:fBlock := bFBlock
|
|
o:sBlock := bSBlock
|
|
o:style := cStyle
|
|
o:sizeX := nSizeX
|
|
o:sizeY := nSizeY
|
|
o:capXOff := nCapXOff
|
|
o:capYOff := nCapYOff
|
|
o:bitmap := cBitmap
|
|
o:bmpXOff := nBmpXOff
|
|
o:bmpYOff := nBmpYOff
|
|
|
|
RETURN o
|
|
|
|
#endif
|