diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 88c787ae45..46ccbe78fb 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,15 @@ +2000-05-23 12:30 GMT-4 David G. Holm + + * 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 . + 20000522-10:40 GMT-8 Ron Pinkas * source/compiler/hbpcode.c diff --git a/harbour/include/button.ch b/harbour/include/button.ch new file mode 100644 index 0000000000..9228384a63 --- /dev/null +++ b/harbour/include/button.ch @@ -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 */ diff --git a/harbour/include/hbver.h b/harbour/include/hbver.h index 40f5d14860..d9902e520a 100644 --- a/harbour/include/hbver.h +++ b/harbour/include/hbver.h @@ -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_ */ diff --git a/harbour/source/rtl/menuitem.prg b/harbour/source/rtl/menuitem.prg new file mode 100644 index 0000000000..5d8de38d6f --- /dev/null +++ b/harbour/source/rtl/menuitem.prg @@ -0,0 +1,82 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * MENUITEM class + * + * Copyright 2000 Jose Lalin + * 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 +//--------------------------------------------------------------------------// diff --git a/harbour/source/rtl/popup.prg b/harbour/source/rtl/popup.prg new file mode 100644 index 0000000000..63b192ac4a --- /dev/null +++ b/harbour/source/rtl/popup.prg @@ -0,0 +1,461 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * POPUP menu class + * + * Copyright 2000 Jose Lalin + * 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 +//--------------------------------------------------------------------------// diff --git a/harbour/source/rtl/topbar.prg b/harbour/source/rtl/topbar.prg new file mode 100644 index 0000000000..c21a6a289b --- /dev/null +++ b/harbour/source/rtl/topbar.prg @@ -0,0 +1,356 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * TOPBAR menu class + * + * Copyright 2000 Jose Lalin + * 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 +//--------------------------------------------------------------------------//