fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

See ChangeLog entry 2000-05-23 12:30 GMT-4 David G. Holm <dholm@jsd-llc.com>

Browse Source
This commit is contained in:
David G. Holm
2000-05-23 16:34:30 +00:00
parent 9f05928bd2
commit 38804ba817
6 changed files with 1011 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
harbour/ChangeLog
View File

@@ -1,3 +1,15 @@
2000-05-23 12:30 GMT-4 David G. Holm <dholm@jsd-llc.com>
* include/hbver.h
% Bumped version from "a" to "b" and updated date to 2000-02-22,
due to release of new os2/gcc build at my iterim build web site.
+ include/button.ch
+ source/rtl/menuitem.prg
+ source/rtl/popup.prg
+ source/rtl/topbar.prg
+ Added for Jose Lalin <dezac@corevia.com>.
20000522-10:40 GMT-8 Ron Pinkas <Ron@Profit-Master.com>
* source/compiler/hbpcode.c

98
harbour/include/button.ch Normal file
View File

@@ -0,0 +1,98 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Header file for menu classes and related functions
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* 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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#ifndef _BUTTON_DEFINED
#define _BUTTON_DEFINED
/* orientation modes for scrollbar class */
#define SCROLL_VERTICAL 1
#define SCROLL_HORIZONTAL 2
/* menu separators strings */
#define MENU_SEPARATOR Chr(196)
#define SEPARATOR_DOUBLE ( Chr(204) + Chr(205) + Chr(185) ) // double line left and right and double separator for popup menu
#define SEPARATOR_SINGLE ( Chr(195) + MENU_SEPARATOR + Chr(180) ) // single separator for popup menu
#define SEPARATOR_DOUBLE_SINGLE ( Chr(199) + MENU_SEPARATOR + Chr(182) ) // double line left and right and single separator for popup menu
/* string constants for menuitems display */
#define MENU_STYLE ( Chr(251) + Chr(16) )
/* return values for HitTest methods */
#define HTNOWHERE 0
#define HTTOPLEFT -1
#define HTTOP -2
#define HTTOPRIGHT -3
#define HTRIGHT -4
#define HTBOTTOMRIGHT -5
#define HTBOTTOM -6
#define HTBOTTOMLEFT -7
#define HTLEFT -8
#define HTBORDERFIRST -8
#define HTBORDERLAST -1
#define HTCAPTION -1025
#define HTCLIENT -2049
#define HTSCROLLTHUMBDRAG -3073
#define HTSCROLLUNITDEC -3074
#define HTSCROLLUNITINC -3075
#define HTSCROLLBLOCKDEC -3076
#define HTSCROLLBLOCKINC -3077
#define HTSCROLLFIRST -3077
#define HTSCROLLLAST -3073
#define HTDROPBUTTON -4097
#define HTSEPARATOR -4098
#define HTCELL -5121
#define HTHEADING -5122
#define HTFOOTING -5123
#define HTHEADSEP -5124
#define HTFOOTSEP -5125
#define HTCOLSEP -5126
#define HTMENU -6145
#define HTSIZE -6146
#define HTMINBUTTON -6147
#define HTMAXBUTTON -6148
#define HTGROWBOX HTSIZE
#define HTREDUCE HTMINBUTTON
#define HTZOOM HTMAXBUTTON
#endif /* _BUTTON_DEFINED */

4
harbour/include/hbver.h
View File

@@ -38,10 +38,10 @@
#define HB_VER_MAJOR 0 /* Major version number */
#define HB_VER_MINOR 33 /* Minor version number */
#define HB_VER_REVISION "a" /* Revision letter */
#define HB_VER_REVISION "b" /* Revision letter */
#define HB_VER_BUILD 33 /* Build number */
#define HB_VER_YEAR 2000 /* Build year */
#define HB_VER_MONTH 05 /* Build month */
#define HB_VER_DAY 05 /* Build day */
#define HB_VER_DAY 22 /* Build day */
#endif /* HB_VER_H_ */

82
harbour/source/rtl/menuitem.prg Normal file
View File

@@ -0,0 +1,82 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* MENUITEM 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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "common.ch"
#include "button.ch"
//--------------------------------------------------------------------------//
function MenuItem( cCaption, boData, nShortcut, cMsg, nID )
LOCAL oClass
if ValType( boData ) == "B" .or. ValType( boData ) == "O"
boData := if( cCaption != MENU_SEPARATOR, boData, nil )
endif
DEFAULT cCaption TO "", ;
boData TO nil, ;
nShortcut TO 0, ;
cMsg TO "", ;
nID TO 0
oClass := TClass():New( "MENUITEM" )
oClass:AddData( "caption" , cCaption )
oClass:AddData( "cargo" )
oClass:AddData( "checked" , FALSE )
oClass:AddData( "column" , 0 )
oClass:AddData( "data" , boData )
oClass:AddData( "enabled" , if( cCaption != MENU_SEPARATOR, TRUE, FALSE ) )
oClass:AddData( "id" , nID )
oClass:AddData( "message" , cMsg )
oClass:AddData( "row" , 0 )
oClass:AddData( "shortcut" , nShortcut )
oClass:AddData( "style" , MENU_STYLE )
oClass:AddMethod( "isPopup", @isPopup() )
oClass:Create()
return oClass:Instance()
//--------------------------------------------------------------------------//
static function isPopUp()
LOCAL Self := QSelf()
if ValType( ::data ) == "O" .and. ::data:ClassName() == "POPUPMENU"
return TRUE
endif
return FALSE
//--------------------------------------------------------------------------//

461
harbour/source/rtl/popup.prg Normal file
View File

@@ -0,0 +1,461 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* POPUP 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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "box.ch"
#include "button.ch"
#include "color.ch"
#include "common.ch"
/* TOFIX: Harbour doesn't check if the colorSpec instance
var has always six pairs of colors. It should
do so and throw an error. [jlalin]
*/
/* NOTE: In the Get* methods we are breaking the "only one return" rule. I
know this isn't a good practice however we are eliminating a variable,
an exit statement and two assigments which is good for speed critical
and small functions. [jlalin]
*/
//--------------------------------------------------------------------------//
function PopUp( nTop, nLeft, nBottom, nRight )
LOCAL oClass
/* NOTE: When a PopUp is created and attached to a TopBar object, its
coords are initialized to -1, so the TopBar can update them
accordingly to its own position on to the screen. [jlalin]
*/
DEFAULT nTop TO -1, ;
nLeft TO -1, ;
nBottom TO 0, ;
nRight TO 0
oClass := TClass():New( "POPUPMENU" )
oClass:AddData( "aItems" , {} )
oClass:AddData( "border" , B_SINGLE + SEPARATOR_SINGLE )
oClass:AddData( "bottom" , nBottom )
oClass:AddData( "cargo" )
oClass:AddData( "colorSpec" , "N/W,W/N,W+/W,W+/N,N+/W,W/N" )
oClass:AddData( "current" , 0 )
oClass:AddData( "itemCount" , 0 )
oClass:AddData( "left" , nLeft )
oClass:AddData( "opened" , FALSE )
oClass:AddData( "right" , nRight )
oClass:AddData( "saveScr" , "" )
oClass:AddData( "top" , nTop )
oClass:AddData( "width" , 0 )
#ifdef HB_EXTENSION
oClass:AddData( "shadowed" , FALSE )
#endif
oClass:AddMethod( "AddItem" , @AddItem() )
oClass:AddMethod( "Close" , @Close() )
oClass:AddMethod( "DelItem" , @DelItem() )
oClass:AddMethod( "Display" , @Display() )
oClass:AddMethod( "GetAccel" , @GetAccel() )
oClass:AddMethod( "GetFirst" , @GetFirst() )
oClass:AddMethod( "GetItem" , @GetItem() )
oClass:AddMethod( "GetLast" , @GetLast() )
oClass:AddMethod( "GetNext" , @GetNext() )
oClass:AddMethod( "GetPrev" , @GetPrev() )
oClass:AddMethod( "GetShortct", @GetShortct() )
oClass:AddMethod( "HitTest" , @HitTest() )
oClass:AddMethod( "InsItem" , @InsItem() )
oClass:AddMethod( "IsOpen" , @IsOpen() )
oClass:AddMethod( "Open" , @Open() )
oClass:AddMethod( "Select" , @_Select() )
oClass:AddMethod( "SetItem" , @SetItem() )
/* NOTE: This method is new in Harbour */
oClass:AddMethod( "SetCoors" , @SetCoors() )
oClass:Create()
return oClass:Instance()
//--------------------------------------------------------------------------//
static function AddItem( oItem )
LOCAL Self := QSelf()
LOCAL nLen
aAdd( ::aItems, oItem )
::itemCount++
nLen := Len( StrTran( oItem:caption, "&", "" ) )
::width := Max( nLen + 4, ::width ) // 4 is for box margins
return Self
//--------------------------------------------------------------------------//
static function Close( lClose )
LOCAL Self := QSelf()
DEFAULT lClose TO TRUE
if ::opened
if lClose
if ::current > 0
if ::aItems[ ::current ]:isPopUp()
::aItems[ ::current ]:data:Close( lClose )
endif
endif
endif
::current := 0
::opened := FALSE
RestScreen( ::top, ::left, ::bottom, ::right, ::saveScr )
::saveScr := nil
endif
return Self
//--------------------------------------------------------------------------//
static function DelItem( nPos )
LOCAL Self := QSelf()
if nPos > 0 .and. nPos <= ::itemCount
aDel( ::aItems, nPos )
aSize( ::aItems, Len( ::aItems ) - 1 )
::itemCount--
aEval( ::aItems, ;
{|oItem| ::width := Max( Len( StrTran( oItem:caption, "&", "" ) ) + 4, ::width ) } )
endif
return Self
//--------------------------------------------------------------------------//
/* 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]
*/
static function GetAccel( nKey )
LOCAL Self := QSelf()
LOCAL nAt := 0
LOCAL cKey := Upper( Chr( nKey ) )
LOCAL n
for n := 1 to ::itemCount
nAt := At( "&", ::aItems[ n ]:caption )
if nAt > 0 .and. ::aItems[ n ]:enabled .and. ;
Upper( SubStr( ::aItems[ n ]:caption, nAt + 1, 1 ) ) == cKey
return n
endif
next
return 0
//--------------------------------------------------------------------------//
static function GetFirst()
LOCAL Self := QSelf()
LOCAL n
for n := 1 to ::itemCount
if ::aItems[ n ]:caption != MENU_SEPARATOR .and. ::aItems[ n ]:enabled
return n
endif
next
return 0
//--------------------------------------------------------------------------//
static function GetItem( nPos )
LOCAL Self := QSelf()
LOCAL oItem
if nPos > 0 .and. nPos <= ::itemCount
oItem := ::aItems[ nPos ]
endif
return oItem
//--------------------------------------------------------------------------//
static function GetLast()
LOCAL Self := QSelf()
LOCAL n
for n := ::itemCount to 1 step -1
if ::aItems[ n ]:caption != MENU_SEPARATOR .and. ::aItems[ n ]:enabled
return n
endif
next
return 0
//--------------------------------------------------------------------------//
static function GetNext()
LOCAL Self := QSelf()
LOCAL n
if ::current < ::itemCount
for n := ::current + 1 to ::itemCount
if ::aItems[ n ]:caption != MENU_SEPARATOR .and. ::aItems[ n ]:enabled
return n
endif
next
endif
return 0
//--------------------------------------------------------------------------//
static function GetPrev()
LOCAL Self := QSelf()
LOCAL n
if ::current > 1
for n := ::current - 1 to 1 step -1
if ::aItems[ n ]:caption != MENU_SEPARATOR .and. ::aItems[ n ]:enabled
return n
endif
next
endif
return 0
//--------------------------------------------------------------------------//
/* NOTE: This method corrects a bug in Cl*pper:
1) when a menuitem is disabled it will ignore the key [jlalin]
*/
static function GetShortct( nKey )
LOCAL Self := QSelf()
LOCAL n
for n := 1 to ::itemCount
if ::aItems[ n ]:enabled .and. ::aItems[ n ]:shortcut == nKey
return n
endif
next
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 click [jlalin]
*/
static function HitTest( nRow, nCol )
LOCAL Self := QSelf()
LOCAL nHit := HTNOWHERE
do case
case nRow == ::top
if nCol == ::left
nHit := HTTOPLEFT
elseif nCol == ::right
nHit := HTTOPRIGHT
else
nHit := HTTOP
endif
case nRow == ::bottom
if nCol == ::left
nHit := HTBOTTOMLEFT
elseif nCol == ::right
nHit := HTBOTTOMRIGHT
else
nHit := HTBOTTOM
endif
case nRow > ::top .and. nCol > ::left .and. nRow < ::bottom .and. nCol < ::right
if ::aItems[ nRow - ::top ]:enabled .and. ::aItems[ nRow - ::top ]:caption != MENU_SEPARATOR
nHit := nRow - ::top
else
nHit := HTSEPARATOR
endif
case nRow > ::top .and. nRow < ::bottom
if nCol == ::left
nHit := HTLEFT
elseif nCol == ::right
nHit := HTRIGHT
endif
endcase
return nHit
//--------------------------------------------------------------------------//
static function InsItem( nPos, oItem )
LOCAL Self := QSelf()
if nPos > 0 .and. nPos <= ::itemCount
aSize( ::aItems, ::itemCount )
aIns( ::aItems, nPos )
::aItems[ nPos ] := oItem
::itemCount++
aEval( ::aItems, ;
{|oItem| ::width := Max( Len( StrTran( oItem:caption, "&", "" ) ) + 4, ::width ) } )
endif
return Self
//--------------------------------------------------------------------------//
static function IsOpen()
LOCAL Self := QSelf()
return ::opened
//--------------------------------------------------------------------------//
static function Open()
LOCAL Self := QSelf()
if !::opened
::opened := TRUE
::saveScr := SaveScreen( ::top, ::left, ::bottom, ::right )
::Display()
endif
return Self
//--------------------------------------------------------------------------//
static function _Select( nPos )
LOCAL Self := QSelf()
if ( nPos > 0 .and. nPos <= ::itemCount ) .and. ;
::current != nPos .and. ::aItems[ nPos ]:enabled
if ::opened .and. ::current > 0
if ::aItems[ ::current ]:isPopUp()
::aItems[ ::current ]:data:Close()
endif
endif
::current := nPos
endif
return Self
//--------------------------------------------------------------------------//
static function SetItem( nPos, oItem )
LOCAL Self := QSelf()
if nPos > 0 .and. nPos <= ::itemCount
::aItems[ nPos ] := oItem
::width := Max( Len( StrTran( oItem:caption, "&", "" ) ) + 4, ::width )
endif
return Self
//--------------------------------------------------------------------------//
static function Display()
LOCAL Self := QSelf()
LOCAL nTop := ::top
LOCAL nAt := 0
LOCAL lPopup := FALSE
LOCAL cPrompt
LOCAL n
DispBegin()
DEFAULT ::border TO Space( 8 )
DispBox( ::top, ::left, ::bottom, ::right, ;
SubStr( ::border, 1, 8 ) + " ", ;
hb_ColorIndex( ::colorSpec, 5 ) )
#ifdef HB_EXTENSION
if ::shadowed
hb_Shadow( ::top + 1, ::left + 1, ::bottom + 1, ::right + 1 )
endif
#endif
for n := 1 to ::itemCount
nAt := At( "&", ::aItems[ n ]:caption )
cPrompt := StrTran( ::aItems[ n ]:caption, "&", "" )
if cPrompt == MENU_SEPARATOR
DispOutAt( ;
::aItems[ n ]:row + nTop + n, ::left, ;
SubStr( ::border, 9, 1 ) + ;
Replicate( SubStr( ::border, 10, 1 ), ::right - ::left - 1 ) + ;
SubStr( ::border, 11, 1 ), ;
hb_ColorIndex( ::colorspec, 5 ) )
else
lPopUp := ::aItems[ n ]:isPopUp()
DispOutAt( ;
::aItems[ n ]:row + nTop + n, ::left + 1, ;
if( ::aItems[ n ]:checked, SubStr( ::aItems[ n ]:style, 1, 1 ), " " ) + ;
PadR( cPrompt + " ", ::width - 4 ) + ;
if( lPopUp, SubStr( ::aItems[ n ]:style, 2, 1 ), " " ), ;
hb_ColorIndex( ::colorSpec, ;
if( ::aItems[ n ]:enabled, ;
if( n == ::current, CLR_ENHANCED, CLR_STANDARD ), ;
CLR_UNSELECTED ) ) )
if nAt > 0
DispOutAt( ;
::aItems[ n ]:row + nTop + n, ::left + nAt + 1, ;
SubStr( cPrompt, nAt, 1 ), ;
hb_ColorIndex( ::colorSpec, ;
if( ::aItems[ n ]:enabled, ;
if( n == ::current, CLR_BACKGROUND, CLR_BORDER ), ;
CLR_UNSELECTED ) ) )
endif
endif
next
DispEnd()
return Self
//--------------------------------------------------------------------------//
static function SetCoors( nItem, nRow, nCol )
LOCAL Self := QSelf()
if ::top == -1 .or. ::left == -1
::top := nRow
::left := nCol
::bottom := ::top + ::itemCount + 1
::right := ::left + ::width - 1
/* Just to avoid the warning by now (compiling with -w2) */
nItem := nItem
/* UNTESTED: I will wait until the bug in the classes.c module is fixed.
However it should work this way.
This updates the child popup coords of a given popup.
if nItem > 0 .and. ::aItems[ nItem ]:isPopup()
::aItems[ nItem ]:data:SetCoors( 0, row, ::right + 1 )
endif
*/
endif
return Self
//--------------------------------------------------------------------------//

356
harbour/source/rtl/topbar.prg Normal file
View File

@@ -0,0 +1,356 @@
/*
* $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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "box.ch"
#include "button.ch"
#include "color.ch"
#include "common.ch"
#define HB_DEBUG_MENU_COLORS "N/BG, W+/N, GR+/BG, GR+/N, N/BG, N/BG"
/* TOFIX: Harbour doesn't check if the colorSpec instance
var has always six pairs of colors. It should
do so and throw an error. [jlalin]
*/
/* NOTE: In the Get* methods we are breaking the "only one return" rule. I
know this isn't a good practice however we are eliminating a variable,
an exit statement and two assigments which is good for speed critical
and small functions. [jlalin]
*/
//--------------------------------------------------------------------------//
function TopBar( nRow, nLeft, nRight )
LOCAL oClass
if ISNUMBER( 1 ) .and. ISNUMBER( 2 ) .and. ISNUMBER( 3 )
oClass := TClass():New( "TOPBARMENU" )
oClass:AddData( "cargo" )
oClass:AddData( "colorSpec" , "N/W,W/N,W+/W,W+/N,N+/W,W/N" )
oClass:AddData( "current" , 0 )
oClass:AddData( "itemCount" , 0 )
oClass:AddData( "left" , nLeft )
oClass:AddData( "right" , nRight )
oClass:AddData( "row" , nRow )
oClass:AddData( "aItems" , {} )
oClass:AddMethod( "AddItem" , @AddItem() )
oClass:AddMethod( "DelItem" , @DelItem() )
oClass:AddMethod( "Display" , @Display() )
oClass:AddMethod( "GetAccel" , @GetAccel() )
oClass:AddMethod( "GetFirst" , @GetFirst() )
oClass:AddMethod( "GetItem" , @GetItem() )
oClass:AddMethod( "GetLast" , @GetLast() )
oClass:AddMethod( "GetNext" , @GetNext() )
oClass:AddMethod( "GetPrev" , @GetPrev() )
/* NOTE: This method exists but it is not
documented in the manuals nor the NG's [jlalin]
*/
oClass:AddMethod( "GetShortct", @GetShortct() )
oClass:AddMethod( "HitTest" , @HitTest() )
oClass:AddMethod( "InsItem" , @InsItem() )
oClass:AddMethod( "Select" , @_Select() )
oClass:AddMethod( "SetItem" , @SetItem() )
oClass:Create()
else
return nil
endif
return oClass:Instance()
//--------------------------------------------------------------------------//
static function AddItem( oItem )
LOCAL Self := QSelf()
LOCAL oLast
::itemCount++
if ::itemCount > 1
oLast := ATail( ::aItems )
oItem:column := oLast:column + Len( StrTran( oLast:caption, "&", "" ) ) + 2
endif
aAdd( ::aItems, oItem )
return Self
//--------------------------------------------------------------------------//
static function DelItem( nPos )
LOCAL Self := QSelf()
if nPos > 0 .and. nPos <= Len( ::aItems )
aDel( ::aItems, nPos )
aSize( ::aItems, Len( ::aItems ) - 1 )
endif
return Self
//--------------------------------------------------------------------------//
static function GetFirst()
LOCAL Self := QSelf()
LOCAL n
for n := 1 to ::itemCount
if ::aItems[ n ]:enabled
return n
endif
next
return 0
//--------------------------------------------------------------------------//
static function GetItem( nPos )
LOCAL Self := QSelf()
LOCAL oItem
if nPos > 0 .and. nPos <= ::itemCount
oItem := ::aItems[ nPos ]
endif
return oItem
//--------------------------------------------------------------------------//
static function GetLast()
LOCAL Self := QSelf()
LOCAL n
for n := ::itemCount to 1 step -1
if ::aItems[ n ]:enabled
return n
endif
next
return 0
//--------------------------------------------------------------------------//
static function GetNext()
LOCAL Self := QSelf()
LOCAL n
if ::current < ::itemCount
for n := ::current + 1 to ::itemCount
if ::aItems[ n ]:enabled
return n
endif
next
endif
return 0
//--------------------------------------------------------------------------//
static function GetPrev()
LOCAL Self := QSelf()
LOCAL n
if ::current > 1
for n := ::current - 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]
*/
static function GetAccel( nKey )
LOCAL Self := QSelf()
LOCAL nAt := 0
LOCAL cKey := Upper( AltToKey_debugger( nKey ) ) /* By now */
LOCAL n
for n := 1 to ::itemCount
nAt := At( "&", ::aItems[ n ]:caption )
if nAt > 0 .and. ::aItems[ n ]:enabled .and. ;
Upper( SubStr( ::aItems[ n ]:caption, nAt + 1, 1 ) ) == cKey
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]
*/
static function HitTest( nRow, nCol )
LOCAL Self := QSelf()
LOCAL n
if ::row == nRow
for n := 1 to ::itemCount
if nCol >= ::aItems[ n ]:column .and. ;
nCol <= ::aItems[ n ]:column + Len( ::aItems[ n ]:caption ) .and. ;
::aItems[ n ]:enabled
return n
endif
next
endif
return HTNOWHERE
//--------------------------------------------------------------------------//
static function InsItem( nPos, oItem )
LOCAL Self := QSelf()
LOCAL n
if nPos > 0 .and. nPos <= ::itemCount
aSize( ::aItems, ::itemCount + 1 )
for n := ::itemCount to nPos
::aItems[ n ] := ::aItems[ n - 1 ]
next
::aItems[ nPos ] := oItem
::itemCount := Len( ::aItems )
endif
return Self
//--------------------------------------------------------------------------//
static function _Select( nPos )
LOCAL Self := QSelf()
if ( nPos > 0 .and. nPos <= ::itemCount ) .and. ;
nPos != ::current .and. ::aItems[ nPos ]:enabled
if ::current > 0
if ::aItems[ ::current ]:isPopUp()
::aItems[ ::current ]:data:Close()
endif
endif
::current := nPos
else
::current := 0
endif
return Self
//--------------------------------------------------------------------------//
static function SetItem( nPos, oItem )
LOCAL Self := QSelf()
if nPos > 0 .and. nPos <= ::itemCount
::aItems[ nPos ] := oItem
endif
return Self
//--------------------------------------------------------------------------//
static function GetShortct( nKey )
LOCAL Self := QSelf()
LOCAL n
for n := 1 to ::itemCount
if ::aItems[ n ]:shortcut == nKey
return n
endif
next
return 0
//--------------------------------------------------------------------------//
static function Display()
LOCAL Self := QSelf()
LOCAL oPopup
LOCAL nAt
LOCAL n
LOCAL cPrompt
LOCAL nOldRow := Row()
LOCAL nOldCol := Col()
LOCAL lOldCur := MSetCursor( FALSE )
DispBegin()
DispOutAt( ::row, ::left, ;
Space( ::right - ::left + 1 ), hb_ColorIndex( ::colorSpec, CLR_STANDARD ) )
for n := 1 to ::itemCount
nAt := At( "&", ::aItems[ n ]:caption )
cPrompt := " " + StrTran( ::aItems[ n ]:caption, "&", "" ) + " "
DispOutAt( ;
::row, ::aItems[ n ]:column, ;
cPrompt, ;
hb_ColorIndex( ::colorSpec, ;
if( ::aItems[ n ]:enabled, ;
if( n == ::current, CLR_ENHANCED, CLR_STANDARD ), ;
CLR_UNSELECTED ) ) )
if nAt > 0
DispOutAt( ::row, ::aItems[ n ]:column + nAt, ;
SubStr( ::aItems[ n ]:caption, nAt + 1, 1 ), ;
hb_ColorIndex( ::colorSpec, ;
if( n == ::current, CLR_BACKGROUND, CLR_BORDER ) ) )
endif
if ::aItems[ n ]:isPopup()
::aItems[ n ]:data:SetCoors( n, ::row + 1, ::aItems[ n ]:column )
endif
next
if ::current > 0 .and. ::aItems[ ::current ]:isPopup()
oPopUp := ::aItems[ ::current ]:data
if oPopUp:isOpen()
oPopUp:display()
endif
endif
DevPos( nOldRow, nOldCol )
MSetCursor( lOldCur )
DispEnd()
return Self
//--------------------------------------------------------------------------//