fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
ab5eedbb2fcd901e6ea928367deecda0b7cb63ba
harbour-core/harbour/source/rtl/pushbtn.prg
Viktor Szakats 53030631bf 2008-05-07 11:21 UTC+0100 Viktor Szakats (harbour.01 syenar hu) 
* contrib/rddads/make_b32.bat
   * contrib/rddads/make_vc.bat
   * contrib/rddads/ads.ch
   * contrib/rddads/rddads.h
   * contrib/rddads/ads1.c
   * contrib/rddads/adsfunc.c
   * contrib/rddads/adsmgmnt.c
     + Added ACE version autodetection.
       You can override with: -DADS_LIB_VERSION=700 (and similar)
       (ADS_REQUIRE_VERSION still accepted for compatibility)
     ! Fixed a few lib version related problems.
     ! hMgmtHandle global renamed to ads_g_hMgmtHandle.
     * Formatting.

   * contrib/rddads/rddads.h
     + QUESTION: added about ADS_MAX_KEY_LENGTH redefinition.
       Is it needed?

   * source/compiler/hbmain.c
     * Changed output device (hb_compOutStd() -> hb_compOutErr()) 
       for following texts:
       "Compiling..."
       "No code generated"
       "Lines x, Functions/Procedures x"
       This is to replicate CA-Cl*pper behaviour a bit more.

   * include/hbextern.ch
   * common.mak
   * source/rtl/Makefile
   * source/rtl/maxrow.c
   + source/rtl/scrrow.c
   * contrib/xhb/hbcompat.ch
     + Added hb_ScrMaxRow(), hb_ScrMaxCol()
       These will return the screen dimensions regardless 
       of the size of an active window (when using CT 
       windows for example). Functionality is the same 
       as MaxRow(.T.) and MaxCol(.T.) previously.
     ! MaxRow()/MaxCol() extended parameters removed.
     + Added MaxRow(.T.)/MaxCol(.T.) conversions for 
       xhb lib (hbcompat.ch) in both directions.
     ; XBase++ doesn't have any extended parameters 
       for Max*() function. Flagship has two of them, 
       both of them doing something different. CAVO doesn't 
       have these functions at all.

   * contrib/xhb/hbcompat.ch
     ! GTI_* macros updated to HB_GTI_*.

   * source/vm/memvclip.c
     % Minor opt in __QQPUB().

   * source/vm/extend.c
     * 0 -> NULL

   * source/vm/estack.c
     - QUESTION removed.

   * source/lang/msgbgmik.c
   * source/rtl/console.c
   * source/rtl/philes.c
   * source/rtl/adir.prg
   * source/rtl/getsys53.prg
   * source/rtl/getsys.prg
   * source/rtl/tget.prg
   * source/rtl/ttopbar.prg
   * source/rtl/pushbtn.prg
   * source/rtl/mod.c
   * source/rtl/memofile.c
   * source/rtl/radiobtn.prg
   * source/rtl/filesys.c
   * source/rtl/tbrowse.prg
   * source/vm/estack.c
   * source/vm/itemapi.c
   * source/vm/hvm.c
   * source/vm/cmdarg.c
   * source/vm/fm.c
   * source/vm/eval.c
   * source/common/hbver.c
   * source/common/expropt2.c
   * utils/hbtest/hbtest.prg
   * utils/hbtest/rt_misc.prg
   * utils/hbtest/rt_str.prg
     ! Comment fixes and minor formatting.
2008-05-07 10:26:41 +00:00

398 lines
10 KiB
Plaintext
Raw Blame History

/*
* $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
EXPORTED:
VAR cargo /* NOTE: CA-Cl*pper 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( nMRow, nMCol )
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( nMRow, nMCol ) 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 nMRow >= ::Row .AND. ;
nMCol >= ::Col .AND. ;
nMRow < ::Row + nCurrentPos .AND. ;
nMCol < ::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( hb_ColorIndex( ::cColorSpec, 2 ) )
ELSEIF ::lHasFocus
SetColor( hb_ColorIndex( ::cColorSpec, 1 ) )
ELSE
SetColor( hb_ColorIndex( ::cColorSpec, 0 ) )
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 ), hb_ColorIndex( ::cColorSpec, 3 ) )
ENDIF
ENDIF
DispEnd()
MSetCursor( lOldMCur )
SetColor( cOldColor )
SetPos( nOldRow, nOldCol )
RETURN Self
METHOD bitmap( cBitmap ) CLASS PUSHBUTTON
IF cBitmap != NIL
::cBitmap := __eInstVar53( Self, "BITMAP", cBitmap, "C", 1001 )
ENDIF
RETURN ::cBitmap
METHOD buffer() CLASS PUSHBUTTON
RETURN ::lBuffer
METHOD caption( cCaption ) CLASS PUSHBUTTON
IF cCaption != NIL
::cCaption := __eInstVar53( Self, "CAPTION", cCaption, "C", 1001 )
ENDIF
RETURN ::cCaption
METHOD col( nCol ) CLASS PUSHBUTTON
IF nCol != NIL
::nCol := __eInstVar53( Self, "COL", nCol, "N", 1001 )
ENDIF
RETURN ::nCol
METHOD colorSpec( cColorSpec ) CLASS PUSHBUTTON
IF cColorSpec != NIL
::cColorSpec := __eInstVar53( Self, "COLORSPEC", cColorSpec, "C", 1001,;
{|| !Empty( hb_ColorIndex( cColorSpec, 3 ) ) .AND. Empty( hb_ColorIndex( cColorSpec, 5 ) ) } )
ENDIF
RETURN ::cColorSpec
METHOD fBlock( bFBlock ) CLASS PUSHBUTTON
IF PCount() > 0
::bFBlock := iif( bFBlock == NIL, NIL, __eInstVar53( Self, "FBLOCK", bFBlock, "B", 1001 ) )
ENDIF
RETURN ::bFBlock
METHOD hasFocus() CLASS PUSHBUTTON
RETURN ::lHasFocus
METHOD message( cMessage ) CLASS PUSHBUTTON
IF cMessage != NIL
::cMessage := __eInstVar53( Self, "MESSAGE", cMessage, "C", 1001 )
ENDIF
RETURN ::cMessage
METHOD row( nRow ) CLASS PUSHBUTTON
IF nRow != NIL
::nRow := __eInstVar53( Self, "ROW", nRow, "N", 1001 )
ENDIF
RETURN ::nRow
METHOD sBlock( bSBlock ) CLASS PUSHBUTTON
IF PCount() > 0
::bSBlock := iif( bSBlock == NIL, NIL, __eInstVar53( Self, "SBLOCK", bSBlock, "B", 1001 ) )
ENDIF
RETURN ::bSBlock
METHOD typeOut() CLASS PUSHBUTTON
RETURN .F.
METHOD style( cStyle ) CLASS PUSHBUTTON
IF cStyle != NIL
::cStyle := __eInstVar53( 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 := hb_ColorIndex( cColor, CLR_UNSELECTED ) + "," +;
hb_ColorIndex( cColor, CLR_ENHANCED ) + "," +;
hb_ColorIndex( cColor, CLR_STANDARD ) + "," +;
hb_ColorIndex( cColor, CLR_BACKGROUND )
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
Reference in New Issue View Git Blame Copy Permalink