How to build menu like old ACHOICE function?

General Help regarding HMG, Compilation, Linking, Samples

Moderator: Rathinagiri

User avatar
sudip
Posts: 1454
Joined: Sat Mar 07, 2009 11:52 am
Location: Kolkata, WB, India

Re: How to build menu like old ACHOICE function?

Post by sudip »

Marek,

I just have an idea. Can it be done with a window with number or command buttons? Here arrow keys will work.

With best regards.

Sudip
With best regards,
Sudip
User avatar
mol
Posts: 3718
Joined: Thu Sep 11, 2008 5:31 am
Location: Myszków, Poland
Contact:

Re: How to build menu like old ACHOICE function?

Post by mol »

jucar_es presented Such an idea.
But, a menu like MainMenu or DropDown Menu is on my mind...

I'm studying sources of hmg to build my own menu, but it's going hard :D
User avatar
mol
Posts: 3718
Joined: Thu Sep 11, 2008 5:31 am
Location: Myszków, Poland
Contact:

Re: How to build menu like old ACHOICE function?

Post by mol »

I think, I've reached effect, which satisfies me!
There are some things to do, yet, but I want to place working sample now.
Problem is how to compute height of component to disable appearing of scrollbar.
Sample works fine for more than 4 options i menu.

I've changed some sources from hmg to produce my own component ACHOICEMENU
Please, test and write your opinions, I'll be greatful!
So, happy testing!
Marek

Code: Select all

MEMVAR _HMG_SYSDATA
#include <hmg.ch>
#include "common.ch"


#command @ <row>,<col> ACHOICEMENU <name> ;
		[ <dummy1: OF, PARENT> <parent> ] ;
		[ WIDTH <w> ] ;
		[ HEIGHT <h> ] ;
		[ ITEMS <aRows> ] ;
		[ VALUE <value> ] ;
		[ FONT <fontname> ] ;
		[ SIZE <fontsize> ] ;
		[ <bold : BOLD> ] ;
		[ <italic : ITALIC> ] ;
		[ <underline : UNDERLINE> ] ;
		[ <strikeout : STRIKEOUT> ] ;
		[ TOOLTIP <tooltip> ] ;
		[ BACKCOLOR <backcolor> ] ;
		[ FONTCOLOR <fontcolor> ] ;
		[ ON GOTFOCUS <gotfocus> ] ;
		[ ON CHANGE <change> ] ;
		[ ON LOSTFOCUS <lostfocus> ] ;
		[ ON DBLCLICK <dblclick> ] ;
		[ <multiselect : MULTISELECT> ] ;
		[ HELPID <helpid> ] 		;
		[ <invisible : INVISIBLE> ] ;
		[ <notabstop : NOTABSTOP> ] ;
		[ <sort : SORT> ] ;
		[ <dragitems : DRAGITEMS> ] ;
	=>;
	_DefineAchoice ( <"name">, <"parent">, <col>, <row>, <w>, <h>, <aRows>, ;
                         <value>, <fontname>, <fontsize>, <tooltip>, <{change}>, ;
                         <{dblclick}>, <{gotfocus}>, <{lostfocus}>, .f., ;
                         <helpid>, <.invisible.>, <.notabstop.>, <.sort.> , ;
			<.bold.>, <.italic.>, <.underline.>, <.strikeout.> ,;
			 <backcolor> , <fontcolor> , <.multiselect.> , <.dragitems.> )


Function Main
	private 	aMenuItems := {"Position 1", "Position 2","Position 3","Position 4","Position 5","Position 6","Position 7", "Position 8"}
   Public NFlag := .f.


   DEFINE WINDOW Form_1 ;
      AT 0,0 ;
      WIDTH 640 HEIGHT 480 ;
      TITLE 'Menu like Achoice, by Marek (MOL)' ;
      MAIN 
	  
	  @ 30,30 ACHOICEMENU Menu1 ;
		 WIDTH 200 ;
		HEIGHT 20*len(aMenuItems) ;
		ITEMS aMenuItems ;
		VALUE 1 ;
		FONT "ARIAL" ;
		SIZE 12 ;
		BOLD ;
		TOOLTIP "Move pointer by arrow, then press ENTER" ;
		BACKCOLOR {255,0,0} ;
		FONTCOLOR {0,0,255} ;
		ON DBLCLICK MsgBox("Your selection is:" + aMenuItems[Form_1.Menu1.value]) 
   END WINDOW

		Form_1.Center
		Form_1.Menu1.SetFocus
        Form_1.Activate

Return

Function ProcessNotify()

   If nflag == .f.
      Form_1.Hide
      nflag := .t.
   Else
      Form_1.Restore
      nflag := .f.
   EndIf
return
/*----------------------------------------------------------------------------
Modification of _DefineListBox
made by Marek Olszewski (MOL-Systemy Komputerowe) www.mol-systemy.com.pl
2010.02.25
*/

Function _DefineAchoice ( ControlName, ParentForm, x, y, w, h, rows, value, ;
			fontname, fontsize, tooltip, changeprocedure, ;
			dblclick, gotfocus, lostfocus, break, HelpId, ;
			invisible, notabstop, sort , bold, italic, ;
			underline, strikeout , backcolor , fontcolor , ;
			multiselect , dragitems )
*-----------------------------------------------------------------------------*
Local i , cParentForm , mVar , ControlHandle
Local FontHandle , k := 0

   DEFAULT w               TO 120
   DEFAULT h               TO 120
   DEFAULT gotfocus        TO ""
   DEFAULT lostfocus       TO ""
   DEFAULT rows            TO {}
   DEFAULT value           TO 0
   DEFAULT changeprocedure TO ""
   DEFAULT dblclick        TO ""
   DEFAULT invisible       TO FALSE
   DEFAULT notabstop       TO FALSE
   DEFAULT sort            TO FALSE


	if _HMG_SYSDATA [ 264 ] = TRUE
		ParentForm := _HMG_SYSDATA [ 223 ]
		if .Not. Empty (_HMG_SYSDATA [ 224 ]) .And. ValType(FontName) == "U"
			FontName := _HMG_SYSDATA [ 224 ]
		EndIf
		if .Not. Empty (_HMG_SYSDATA [ 182 ]) .And. ValType(FontSize) == "U"
			FontSize := _HMG_SYSDATA [ 182 ]
		EndIf
	endif

	if _HMG_SYSDATA [ 183 ] > 0
		x 	:= x + _HMG_SYSDATA [ 334 ] [_HMG_SYSDATA [ 183 ]]
		y 	:= y + _HMG_SYSDATA [ 333 ] [_HMG_SYSDATA [ 183 ]]
		ParentForm := _HMG_SYSDATA [ 332 ] [_HMG_SYSDATA [ 183 ]]
	EndIf

	If .Not. _IsWindowDefined (ParentForm)
		MsgMiniGuiError("Window: "+ ParentForm + " is not defined. Program terminated")
	Endif

	If _IsControlDefined (ControlName,ParentForm)
		MsgMiniGuiError ("Control: " + ControlName + " Of " + ParentForm + " Already defined. Program Terminated")
	endif

	mVar := "_" + ParentForm + "_" + ControlName

	cParentForm := ParentForm

	ParentForm = GetFormHandle (ParentForm)

	if valtype(x) == "U" .or. valtype(y) == "U"

		If _HMG_SYSDATA [ 216 ] == "TOOLBAR"
			Break := TRUE
		EndIf

		i := GetFormIndex ( cParentForm )

		if i > 0

			if multiselect == .t.
				ControlHandle := InitMultiListBox ( _HMG_SYSDATA [ 87 ] [i], 0, x, y, w, h, fontname, fontsize, invisible, notabstop, sort , dragitems )
			else
				ControlHandle := InitListBox ( _HMG_SYSDATA [ 87 ] [i] , 0 , 0 , 0 , w , h , '' , 0 , invisible , notabstop, sort , dragitems )
			endif

			if valtype(fontname) != "U" .and. valtype(fontsize) != "U"
				FontHandle := _SetFont (ControlHandle,FontName,FontSize,bold,italic,underline,strikeout)
			Else
				FontHandle := _SetFont (ControlHandle,_HMG_SYSDATA [ 342 ],_HMG_SYSDATA [ 343 ],bold,italic,underline,strikeout)		
			endif

			AddSplitBoxItem ( Controlhandle , _HMG_SYSDATA [ 87 ] [i] , w , break , , , , _HMG_SYSDATA [ 258 ] )

			_HMG_SYSDATA [ 216 ]	:= "LISTBOX"

		EndIf

	Else

		if multiselect == .t.
			ControlHandle := InitMultiListBox ( ParentForm, 0, x, y, w, h, fontname, fontsize, invisible, notabstop, sort , dragitems )
		else
			ControlHandle := MOL_InitListBox ( ParentForm , 0 , x , y , w , h , '' , 0 , invisible , notabstop, sort , dragitems )
		endif

		if valtype(fontname) != "U" .and. valtype(fontsize) != "U"
			FontHandle := _SetFont (ControlHandle,FontName,FontSize,bold,italic,underline,strikeout)
		Else
			FontHandle := _SetFont (ControlHandle,_HMG_SYSDATA [ 342 ],_HMG_SYSDATA [ 343 ],bold,italic,underline,strikeout)		
		endif

	endif

	If _HMG_SYSDATA [ 265 ] = TRUE
		aAdd ( _HMG_SYSDATA [ 142 ] , ControlHandle )
	EndIf

	if valtype(tooltip) != "U"
		SetToolTip ( ControlHandle , tooltip , GetFormToolTipHandle (cParentForm) )
	endif

	k := _GetControlFree()

	Public &mVar. := k

	_HMG_SYSDATA [1] [k] := if ( multiselect , "MULTILIST" , "LIST" )
	_HMG_SYSDATA [2]  [k] :=  ControlName 
	_HMG_SYSDATA [3]  [k] :=  ControlHandle 
	_HMG_SYSDATA [4]  [k] :=  ParentForm 
	_HMG_SYSDATA [  5 ]  [k] :=  0 
	_HMG_SYSDATA [  6 ]  [k] :=  "" 
	_HMG_SYSDATA [  7 ]  [k] :=  {} 
	_HMG_SYSDATA [  8 ]  [k] :=  Nil 
	_HMG_SYSDATA [  9 ]  [k] :=  "" 
	_HMG_SYSDATA [ 10 ]  [k] :=  lostfocus 
	_HMG_SYSDATA [ 11 ]  [k] :=  gotfocus 
	_HMG_SYSDATA [ 12 ]  [k] :=  ChangeProcedure 
	_HMG_SYSDATA [ 13 ]  [k] :=  FALSE 
	_HMG_SYSDATA [ 14 ]  [k] :=  backcolor 
	_HMG_SYSDATA [ 15 ]  [k] :=  fontcolor 
	_HMG_SYSDATA [ 16 ]  [k] :=  dblclick 
	_HMG_SYSDATA [ 17 ]  [k] :=  {} 
	_HMG_SYSDATA [ 18 ]  [k] :=  y 
	_HMG_SYSDATA [ 19 ]   [k] := x 
	_HMG_SYSDATA [ 20 ]   [k] := w 
	_HMG_SYSDATA [ 21 ]   [k] := h 
	_HMG_SYSDATA [ 22 ]   [k] := 0 
	_HMG_SYSDATA [ 23 ]  [k] :=  iif ( _HMG_SYSDATA [ 183 ] > 0 ,_HMG_SYSDATA [ 333 ] [_HMG_SYSDATA [ 183 ]] , -1 ) 
	_HMG_SYSDATA [ 24 ]  [k] :=  iif ( _HMG_SYSDATA [ 183 ] > 0 ,_HMG_SYSDATA [ 334 ] [_HMG_SYSDATA [ 183 ]] , -1 ) 
	_HMG_SYSDATA [ 25 ]   [k] := "" 
	_HMG_SYSDATA [ 26 ]  [k] :=  0 
	_HMG_SYSDATA [ 27 ]  [k] :=  fontname 
	_HMG_SYSDATA [ 28 ]  [k] :=  fontsize 
	_HMG_SYSDATA [ 29 ]  [k] :=  {bold,italic,underline,strikeout} 
	_HMG_SYSDATA [ 30 ]   [k] :=  tooltip  
	_HMG_SYSDATA [ 31 ]   [k] :=  0  
	_HMG_SYSDATA [ 32 ]  [k] :=   0  
	_HMG_SYSDATA [ 33 ]   [k] :=  ""  
	_HMG_SYSDATA [ 34 ]  [k] :=   if(invisible,FALSE,TRUE) 
	_HMG_SYSDATA [ 35 ]   [k] :=  HelpId 
	_HMG_SYSDATA [ 36 ]  [k] :=   FontHandle 
	_HMG_SYSDATA [ 37 ]  [k] :=   0
	_HMG_SYSDATA [ 38 ]  [k] :=   .T. 
	_HMG_SYSDATA [ 39 ] [k] := 0
	_HMG_SYSDATA [ 40 ] [k] := { NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL }

	for i = 1 to len (rows)
  		ListboxAddString (ControlHandle,rows[i])
	next x

	if multiselect == .t.
		if value <> Nil
			LISTBOXSETMULTISEL (ControlHandle,Value)
		endif
	else
		if value <> 0
			ListboxSetCurSel (ControlHandle,Value)
		endif
	endif

Return Nil


#pragma BEGINDUMP
#define _WIN32_IE      0x0500
#define HB_OS_WIN_32_USED
#define _WIN32_WINNT   0x0400
#include <shlobj.h>

#include <windows.h>
#include <commctrl.h>
#include "hbapi.h"
#include "hbvm.h"
#include "hbstack.h"
#include "hbapiitm.h"
#include "winreg.h"
#include "tchar.h"

HB_FUNC( MOL_INITLISTBOX )
{

	HWND hwnd;
	HWND hbutton;
	//int Style = WS_CHILD | WS_VSCROLL | LBS_DISABLENOSCROLL | LBS_NOTIFY | LBS_NOINTEGRALHEIGHT ;
	int Style = WS_CHILD | WS_VSCROLL |  LBS_NOTIFY | LBS_NOINTEGRALHEIGHT ;

	hwnd = (HWND) hb_parnl (1);

	if ( ! hb_parl (9) )
	{
		Style = Style | WS_VISIBLE ;
	}

	if ( ! hb_parl (10) )
	{
		Style = Style | WS_TABSTOP ;
	}

	if ( hb_parl (11) )
	{
		Style = Style | LBS_SORT ;
	}

	hbutton = CreateWindowEx( WS_EX_CLIENTEDGE ,
                             "LISTBOX" ,
                             "" ,
                             Style ,
                             hb_parni(3) ,
                             hb_parni(4) ,
                             hb_parni(5) ,
                             hb_parni(6) ,
                             hwnd ,
                             (HMENU)hb_parni(2) ,
                             GetModuleHandle(NULL) ,
                             NULL ) ;

	if ( hb_parl (12) )
	{
		MakeDragList(hbutton);
	}

	hb_retnl ( (LONG) hbutton );

}
User avatar
Rathinagiri
Posts: 5471
Joined: Tue Jul 29, 2008 6:30 pm
DBs Used: MariaDB, SQLite, SQLCipher and MySQL
Location: Sivakasi, India
Contact:

Re: How to build menu like old ACHOICE function?

Post by Rathinagiri »

Nice work Marek.

Modified Listbox without vertical scroll bar if number of items are less is good. Thanks for sharing. I will use it. :)
East or West HMG is the Best.
South or North HMG is worth.
...the possibilities are endless.
User avatar
mol
Posts: 3718
Joined: Thu Sep 11, 2008 5:31 am
Location: Myszków, Poland
Contact:

Re: How to build menu like old ACHOICE function?

Post by mol »

If you change line:

Code: Select all

int Style = WS_CHILD | WS_VSCROLL |  LBS_NOTIFY | LBS_NOINTEGRALHEIGHT ;
to line:

Code: Select all

int Style = WS_CHILD | LBS_NOTIFY | LBS_NOINTEGRALHEIGHT ;
vertical scrollbar never appears.

thanks for testing.
Marek


Ps. I've tried to use procedures to create menu like a system menu, notify menu, but, I can't find how to control fontsize and colors of menu.

So, modified listbox seems to be the best way to build Achoice.
User avatar
bpd2000
Posts: 1207
Joined: Sat Sep 10, 2011 4:07 am
Location: India

Re: How to build menu like old ACHOICE function?

Post by bpd2000 »

Dear Marek,
While I compile Achoicemenu following error comes

HB_FUN_MSGMINIGUIERROR

How to solve it

Regards
BPD
Convert Dream into Reality through HMG
User avatar
Rathinagiri
Posts: 5471
Joined: Tue Jul 29, 2008 6:30 pm
DBs Used: MariaDB, SQLite, SQLCipher and MySQL
Location: Sivakasi, India
Contact:

Re: How to build menu like old ACHOICE function?

Post by Rathinagiri »

Dear BPD,

You can change the lines referring MSGMINIGUIERROR into MsgStop()
East or West HMG is the Best.
South or North HMG is worth.
...the possibilities are endless.
User avatar
dhaine_adp
Posts: 457
Joined: Wed Aug 06, 2008 12:22 pm
Location: Manila, Philippines

Re: How to build menu like old ACHOICE function?

Post by dhaine_adp »

Hi,

Regarding achoice, I think, grid control can be used for AChoice like interface without any buttons at all and it can be combine with windows TOPMOST, MODAL. But sorry I don't have a sample to give, three days ago it is also my problem when I realized that Achoice can be achieved by Grid without sweat. IMHO.

Regards,

Danny
Regards,

Danny
Manila, Philippines
User avatar
dhaine_adp
Posts: 457
Joined: Wed Aug 06, 2008 12:22 pm
Location: Manila, Philippines

Re: How to build menu like old ACHOICE function?

Post by dhaine_adp »

Hello Marek and everyone,

Here is my implementation of ACHOICE in HMG using grid control. The only problem is that it nearly look likes the ACHOICE of the old days.

Caveats:
1. Grid control height and width must be larger than the height of the window, frmAchoice in this regard so that the scroll bars is not visible.
2. If you want the horizontal and or vertical scroll bar, then adjust the dimentsion calculation.
3. I'm still using HMG 3.8 (out of pure laziness to back-up and test).
4. You can build the sample using the build.bat


Code: Select all


#include "minigui.ch"
#include "inkey.ch"
#include "common.ch"


*************
function main

   DEFINE WINDOW Win1;
      AT 0,0 WIDTH 300 HEIGHT 400;
      TITLE "Test";
      ICON NIL;
      MAIN NOSIZE;

      DEFINE MAINMENU
        DEFINE POPUP "&File"
          ITEM "Test ACHOICE" ACTION Test()
          ITEM "Exit" ACTION ThisWindow.Release
        END POPUP
      END MENU
   END WINDOW
   Win1.Center
   Win1.Activate
   RETURN


***************************************
function Test()  // test stub module

   LOCAL aChoices_ := { { "Date"          },;
                        { "Date Before"   },;
                        { "Date After"    },;
                        { "Month to Date" },;
                        { "Year to Date"  },;
                        { "Date Range"    } }

   LOCAL nChoice := 0
   LOCAL cMsg    := ""
   
   nChoice := hmgAchoice( NIL, aChoices_, "Select Report Type" )
   IF nChoice > 0
      cMsg := aChoices_[ nChoice, 1 ]
      MSGINFO( cMsg, "HMG AChoice" )
   ENDIF
   RETURN NIL




*****************************************************************************
function hmgAchoice( cTitle, aSelection_, cHeading, cFont, nFontSize, lSort )

   LOCAL nRetVal := 0
   
   LOCAL nWidth  := 0
   LOCAL nHeight := 0

   LOCAL ii      := 0
   LOCAL nTemp   := 0
   LOCAL cLonger := ""
   
   LOCAL nCellWidth := 0
   LOCAL aItems_ := {}

   DEFAULT cTitle TO "Please select"
   DEFAULT aSelection_ TO {}
   DEFAULT cHeading TO "Available Options"
   DEFAULT cFont TO "ARIAL"
   DEFAULT nFontSize TO 9
   DEFAULT lSort TO .f.

   **--> terminate and return 0 if there are no selections specified
   IF LEN( aSelection_ ) < 1
      RETURN 0
   ENDIF

   **--> check if the array is needed to be sorted out
   IF lSort .AND. LEN( aSelection_ ) > 0
      aSelection_ := ASORT( aSelection_ )
   ENDIF

   **--> find the longgest array element, accounting the title and Heading as well
   cLonger := aSelection_[ 1, 1 ]
   FOR ii := 1 TO LEN( aSelection_ )
      IF LEN( cLonger  ) < LEN( aSelection_[ ii, 1 ] )
         cLonger := aSelection_[ ii, 1 ]
         nTemp   := ii
      ENDIF
   NEXT
   IF LEN( cLonger ) < LEN( cHeading )
      cLonger := cHeading
   ENDIF
   
   **--> calculate dimensions
   nWidth     := GETTEXTWIDTH( Nil, cLonger, cFont )
   nCellWidth := nWidth
   nHeight    := LEN( aSelection_ ) * nFontSize 
   nHeight    := INT( ( nHeight / 72 * 25.4 ) ) + 1
   nHeight    := ( nHeight * LEN( aSelection_ ) ) + 40

   DEFINE WINDOW frmAchoice;
      AT 0,0 WIDTH nWidth + 13 HEIGHT nHeight;
      TITLE cTitle;
      ICON "YourIconHere";
      MODAL NOSIZE;
      ON MOUSECLICK ThisWindow.Release ;
      
      ON KEY ESCAPE ACTION ThisWindow.release
      ON KEY RETURN ACTION ( nRetVal := frmAchoice.grdChoice.Value, ThisWindow.release )
      ON KEY DELETE ACTION ThisWindow.release
      ON KEY F1     ACTION ThisWindow.release
   
      @  0, 0 GRID grdChoice OF frmAchoice WIDTH  frmAchoice.Width HEIGHT frmAchoice.Height - 3;
         HEADERS { cHeading } WIDTHS { nCellWidth } ITEMS aSelection_ VALUE 1 ;
         FONT cFont SIZE nFontSize;
         ON CHANGE ( nRetVal := This.CellRowIndex );
         ON DBLCLICK ( nRetVal := This.CellRowIndex, ThisWindow.Release );
         NOLINES JUSTIFY { GRID_JTFY_CENTER }

   END WINDOW
   CENTER WINDOW frmAchoice
   ACTIVATE WINDOW frmAchoice
   RETURN nRetVal


Regards,

--
Danny
Regards,

Danny
Manila, Philippines
User avatar
bpd2000
Posts: 1207
Joined: Sat Sep 10, 2011 4:07 am
Location: India

Re: How to build menu like old ACHOICE function?

Post by bpd2000 »

Dear Danny,

Good work

How to unload Achoicemenu design by Marek from window
BPD
Convert Dream into Reality through HMG
Post Reply