fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
b1ded1ebb493aedc4f62f71300aeb99ddbabe8bd
harbour-core/harbour/source/rtl/ttopbar.prg
Przemyslaw Czerpak 9113680b5a 2008-10-11 03:24 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) 
* harbour/source/rtl/scrollbr.prg
  * harbour/source/rtl/getsys.prg
  * harbour/source/rtl/tpopup.prg
  * harbour/source/rtl/tgetlist.prg
  * harbour/source/rtl/radiogrp.prg
  * harbour/source/rtl/listbox.prg
  * harbour/source/rtl/checkbox.prg
  * harbour/source/rtl/browse.prg
  * harbour/source/rtl/tget.prg
  * harbour/source/rtl/ttopbar.prg
  * harbour/source/rtl/pushbtn.prg
  * harbour/source/rtl/tmenusys.prg
  * harbour/source/rtl/achoice.prg
  * harbour/source/rtl/teditor.prg
  * harbour/source/rtl/radiobtn.prg
  * harbour/source/rtl/tbrowse.prg
    * replaced DispOut() with hb_dispOut()
    * replaced DispBox() with hb_dispBox()
    % removed saving and restoring of cursor position in places where
      it's not longer necessary due to hb_dispOut()/hb_dispBox() usage
    % removed saving and restoring of SetColor() value in places where
      it's not longer necessary due to hb_dispOut()/hb_dispBox() usage
    % removed saving and restoring of MSetCursor(). If it's necessary
      low GT driver should hide and redraw mouse cursor before and after
      screen update. We do not have to make it manually

   The above modification gives faster code and allow to access screen
   from different threads simultaneously because functions like
   hb_dispOut() and hb_dispBox() are stateless and atomic in screen
   access. Not all .prg code has been updated yet. If someone is
   familiar with this code then please help. I'll add yet HB_SCROLL()
   function which will support additionally colors.
   Viktor if possible please verify this modifications.
2008-10-11 01:24:26 +00:00

484 lines
12 KiB
Plaintext
Raw Blame History

/*
* $Id$
*/
/*
* Harbour Project source code:
* TOPBAR menu class
*
* Copyright 2000 Jose Lalin <dezac@corevia.com>
* 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 "inkey.ch"
/* NOTE: Harbour doesn't support CA-Cl*pper 5.3 GUI functionality, but
it has all related variables and methods. */
#ifdef HB_COMPAT_C53
CREATE CLASS TOPBARMENU FUNCTION HBTopBarMenu
EXPORTED:
METHOD addItem( oItem )
METHOD delItem( nPos )
METHOD display()
METHOD getFirst()
METHOD getItem( nPos )
METHOD getLast()
METHOD getNext()
METHOD getPrev()
METHOD getAccel( nKey )
METHOD getShortCt( nKey ) /* NOTE: This method exists but it is not documented in the manuals nor the NG's [jlalin] */
METHOD hitTest( nMRow, nMCol )
METHOD insItem( nPos, oItem )
METHOD select( nPos )
METHOD setItem( nPos, oItem )
METHOD colorSpec( cColorSpec ) SETGET
METHOD current() SETGET
METHOD itemCount() SETGET
METHOD left( nLeft ) SETGET
METHOD right( nRight ) SETGET
METHOD row( nRow ) SETGET
METHOD New( nRow, nLeft, nRight ) /* NOTE: This method is a Harbour extension [vszakats] */
PROTECTED:
VAR cColorSpec
VAR nCurrent INIT 0
VAR nItemCount INIT 0
VAR nLeft
VAR nRight
VAR nRow
VAR aItems INIT {}
VAR nWidth INIT 0
ENDCLASS
METHOD addItem( oItem ) CLASS TOPBARMENU
IF ISOBJECT( oItem ) .AND. oItem:ClassName() == "MENUITEM"
::nItemCount++
AAdd( ::aItems, oItem )
::nWidth := Max( __CapMetrics( oItem ), ::nWidth )
ENDIF
RETURN Self
METHOD delItem( nPos ) CLASS TOPBARMENU
LOCAL nLen
LOCAL aItems
LOCAL nWidth
IF nPos >= 1 .AND. nPos <= ::nItemCount
nLen := Len( ::aItems[ nPos ]:caption )
ADel( ::aItems, nPos )
ASize( ::aItems, --::nItemCount )
IF ::nWidth == nLen + 2
aItems := ::aItems
nLen := ::nItemCount
nWidth := 0
FOR nPos := 1 TO nLen
nWidth := Max( __CapMetrics( aItems[ nPos ] ), nWidth )
NEXT
::nWidth := nWidth
ENDIF
ENDIF
RETURN Self
METHOD display() CLASS TOPBARMENU
LOCAL nRow := ::nRow
LOCAL nLeft := ::nLeft
LOCAL nRight := ::nRight
LOCAL aItems := ::aItems
LOCAL nItemCount := ::nItemCount
LOCAL nCurrent := ::nCurrent
LOCAL cColor1 := hb_ColorIndex( ::cColorSpec, 0 )
LOCAL cColor2 := hb_ColorIndex( ::cColorSpec, 1 )
LOCAL oPopUp
LOCAL nItem
LOCAL cCaption
LOCAL nCaptionLen
LOCAL nPos
DispBegin()
hb_dispOutAt( nRow, nLeft, Space( nRight - nLeft + 1 ), cColor1 )
FOR nItem := 1 TO nItemCount
cCaption := " " + RTrim( aItems[ nItem ]:caption ) + " "
nCaptionLen := Len( cCaption )
IF nCaptionLen == 0
LOOP
ENDIF
IF nLeft > nRight - nCaptionLen
nLeft := nRight - nCaptionLen
ENDIF
aItems[ nItem ]:__row := nRow
aItems[ nItem ]:__col := nLeft
IF aItems[ nItem ]:isPopUp()
oPopUp := aItems[ nItem ]:data
oPopUp:top := nRow + 1
oPopUp:left := nLeft
oPopUp:bottom := NIL
oPopUp:right := NIL
ENDIF
IF ( nPos := At( "&", cCaption ) ) > 0
IF nPos == Len( cCaption )
nPos := 0
ELSE
cCaption := Stuff( cCaption, nPos, 1, "" )
nCaptionLen--
ENDIF
ENDIF
hb_dispOutAt( nRow, nLeft, cCaption,;
iif( nItem == nCurrent, cColor2,;
iif( aItems[ nItem ]:enabled, cColor1, hb_ColorIndex( ::cColorSpec, 4 ) ) ) )
IF aItems[ nItem ]:enabled .AND. nPos > 0
hb_dispOutAt( nRow, nLeft + nPos - 1, SubStr( cCaption, nPos, 1 ),;
iif( nItem == nCurrent, hb_ColorIndex( ::cColorSpec, 3 ), hb_ColorIndex( ::cColorSpec, 2 ) ) )
ENDIF
nLeft += nCaptionLen
NEXT
IF nCurrent != 0 .AND. ;
::aItems[ nCurrent ]:isPopUp() .AND. ;
::aItems[ nCurrent ]:data:isOpen
::aItems[ nCurrent ]:data:display()
ENDIF
DispEnd()
RETURN Self
METHOD getFirst() CLASS TOPBARMENU
LOCAL n
FOR n := 1 TO ::nItemCount
IF ::aItems[ n ]:enabled
RETURN n
ENDIF
NEXT
RETURN 0
METHOD getItem( nPos ) CLASS TOPBARMENU
RETURN iif( nPos >= 1 .AND. nPos <= ::nItemCount, ::aItems[ nPos ], NIL )
METHOD getLast() CLASS TOPBARMENU
LOCAL n
FOR n := ::nItemCount TO 1 STEP -1
IF ::aItems[ n ]:enabled
RETURN n
ENDIF
NEXT
RETURN 0
METHOD getNext() CLASS TOPBARMENU
LOCAL n
IF ::nCurrent < ::nItemCount
FOR n := ::nCurrent + 1 TO ::nItemCount
IF ::aItems[ n ]:enabled
RETURN n
ENDIF
NEXT
ENDIF
RETURN 0
METHOD getPrev() CLASS TOPBARMENU
LOCAL n
IF ::nCurrent > 1
FOR n := ::nCurrent - 1 TO 1 STEP -1
IF ::aItems[ n ]:enabled
RETURN n
ENDIF
NEXT
ENDIF
RETURN 0
/* NOTE: This method corrects two bugs in Cl*pper:
1) when two menuitems have the same key and the
first item is disabled
2) when a menuitem is disabled it will ignore the key [jlalin] */
METHOD getAccel( nKey ) CLASS TOPBARMENU
LOCAL nIndex := AScan( { K_ALT_A, K_ALT_B, K_ALT_C, K_ALT_D, K_ALT_E, K_ALT_F,;
K_ALT_G, K_ALT_H, K_ALT_I, K_ALT_J, K_ALT_K, K_ALT_L,;
K_ALT_M, K_ALT_N, K_ALT_O, K_ALT_P, K_ALT_Q, K_ALT_R,;
K_ALT_S, K_ALT_T, K_ALT_U, K_ALT_V, K_ALT_W, K_ALT_X,;
K_ALT_Y, K_ALT_Z, K_ALT_1, K_ALT_2, K_ALT_3, K_ALT_4,;
K_ALT_5, K_ALT_6, K_ALT_7, K_ALT_8, K_ALT_9, K_ALT_0 }, nKey )
LOCAL cKey
LOCAL nAt
LOCAL n
IF nIndex > 0
cKey := SubStr( "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890", nIndex, 1 )
FOR n := 1 TO ::nItemCount
IF ( nAt := At( "&", ::aItems[ n ]:caption ) ) > 0 .AND. ;
Upper( SubStr( ::aItems[ n ]:caption, nAt + 1, 1 ) ) == cKey
#ifdef HB_EXTENSION
IF ::aItems[ n ]:enabled
#endif
RETURN n
#ifdef HB_EXTENSION
ENDIF
#endif
ENDIF
NEXT
ENDIF
RETURN 0
METHOD getShortCt( nKey ) CLASS TOPBARMENU
LOCAL n
FOR n := 1 TO ::nItemCount
IF ::aItems[ n ]:shortcut == nKey
RETURN n
ENDIF
NEXT
RETURN 0
/* NOTE: In my tests I can't get other values than HTNOWHERE or a value
greather than 0 (selected item), althought the NG's says that
it returns other HT* values [jlalin]
This method correct a bug in Cl*pper:
when click on a disabled menuitem it will ignore it [jlalin] */
METHOD hitTest( nMRow, nMCol ) CLASS TOPBARMENU
LOCAL aItems
LOCAL nColumn
LOCAL n
IF nMRow == ::nRow
aItems := ::aItems
FOR n := 1 TO ::nItemCount
nColumn := aItems[ n ]:__col
IF nMCol >= nColumn .AND. nMCol <= nColumn + Len( aItems[ n ]:caption )
#ifdef HB_EXTENSION
IF aItems[ n ]:enabled
#endif
RETURN n
#ifdef HB_EXTENSION
ENDIF
#endif
ENDIF
NEXT
ENDIF
RETURN HTNOWHERE
METHOD insItem( nPos, oItem ) CLASS TOPBARMENU
IF nPos >= 1 .AND. nPos <= ::nItemCount .AND. ;
ISOBJECT( oItem ) .AND. oItem:ClassName() == "MENUITEM"
ASize( ::aItems, ++::nItemCount )
AIns( ::aItems, nPos )
::aItems[ nPos ] := oItem
::nWidth := Max( __CapMetrics( oItem ), ::nWidth )
ENDIF
RETURN Self
METHOD select( nPos ) CLASS TOPBARMENU
IF ( nPos >= 1 .AND. nPos <= ::nItemCount .AND. ;
::nCurrent != nPos .AND. ;
::aItems[ nPos ]:enabled ) .OR. nPos == 0
// IF ::isOpen() .AND. ;
// ::nCurrent > 0 .AND. ;
// ::aItems[ ::nCurrent ]:isPopUp()
//
// ::aItems[ ::nCurrent ]:data:close()
// ENDIF
::nCurrent := nPos
ENDIF
RETURN Self
METHOD setItem( nPos, oItem ) CLASS TOPBARMENU
IF nPos >= 1 .AND. nPos <= ::nItemCount .AND. ;
ISOBJECT( oItem ) .AND. oItem:ClassName() == "MENUITEM"
::aItems[ nPos ] := oItem
::nWidth := Max( __CapMetrics( oItem ), ::nWidth )
ENDIF
RETURN Self
METHOD colorSpec( cColorSpec ) CLASS TOPBARMENU
IF cColorSpec != NIL
::cColorSpec := __eInstVar53( Self, "COLORSPEC", cColorSpec, "C", 1001,;
{|| !Empty( hb_ColorIndex( cColorSpec, 5 ) ) .AND. Empty( hb_ColorIndex( cColorSpec, 6 ) ) } )
ENDIF
RETURN ::cColorSpec
METHOD current() CLASS TOPBARMENU
RETURN ::nCurrent
METHOD itemCount() CLASS TOPBARMENU
RETURN ::nItemCount
METHOD left( nLeft ) CLASS TOPBARMENU
IF nLeft != NIL
::nLeft := __eInstVar53( Self, "LEFT", nLeft, "N", 1001 )
ENDIF
RETURN ::nLeft
METHOD right( nRight ) CLASS TOPBARMENU
IF nRight != NIL
::nRight := __eInstVar53( Self, "RIGHT", nRight, "N", 1001 )
ENDIF
RETURN ::nRight
METHOD row( nRow ) CLASS TOPBARMENU
IF nRow != NIL
/* NOTE: CA-Cl*pper 5.3 has a bug, where it would show "TOP" in case of an error. */
::nRow := __eInstVar53( Self, "ROW", nRow, "N", 1001 )
ENDIF
RETURN ::nRow
/* -------------------------------------------- */
METHOD New( nRow, nLeft, nRight ) CLASS TOPBARMENU
LOCAL cColor
IF !ISNUMBER( nRow ) .OR. ;
!ISNUMBER( nLeft ) .OR. ;
!ISNUMBER( nRight )
RETURN NIL
ENDIF
::nLeft := nLeft
::nRight := nRight
::nRow := nRow
IF IsDefColor()
::cColorSpec := "N/W,W/N,W+/W,W+/N,N+/W,W/N"
ELSE
cColor := SetColor()
::cColorSpec := hb_ColorIndex( cColor, CLR_UNSELECTED ) + "," +;
hb_ColorIndex( cColor, CLR_ENHANCED ) + "," +;
hb_ColorIndex( cColor, CLR_BACKGROUND ) + "," +;
hb_ColorIndex( cColor, CLR_ENHANCED ) + "," +;
hb_ColorIndex( cColor, CLR_STANDARD ) + "," +;
hb_ColorIndex( cColor, CLR_BORDER )
ENDIF
RETURN Self
/* -------------------------------------------- */
FUNCTION TopBar( nRow, nLeft, nRight )
RETURN HBTopBarMenu():New( nRow, nLeft, nRight )
#endif
Reference in New Issue View Git Blame Copy Permalink