How to build menu like old ACHOICE function?
Moderator: Rathinagiri
Re: How to build menu like old ACHOICE function?
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
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
Sudip
Re: How to build menu like old ACHOICE function?
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
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
Re: How to build menu like old ACHOICE function?
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
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 );
}
- 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?
Nice work Marek.
Modified Listbox without vertical scroll bar if number of items are less is good. Thanks for sharing. I will use it.
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.
South or North HMG is worth.
...the possibilities are endless.
Re: How to build menu like old ACHOICE function?
If you change line:
to line:
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.
Code: Select all
int Style = WS_CHILD | WS_VSCROLL | LBS_NOTIFY | LBS_NOINTEGRALHEIGHT ;
Code: Select all
int Style = WS_CHILD | LBS_NOTIFY | LBS_NOINTEGRALHEIGHT ;
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.
Re: How to build menu like old ACHOICE function?
Dear Marek,
While I compile Achoicemenu following error comes
HB_FUN_MSGMINIGUIERROR
How to solve it
Regards
While I compile Achoicemenu following error comes
HB_FUN_MSGMINIGUIERROR
How to solve it
Regards
BPD
Convert Dream into Reality through HMG
Convert Dream into Reality through HMG
- 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?
Dear BPD,
You can change the lines referring MSGMINIGUIERROR into MsgStop()
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.
South or North HMG is worth.
...the possibilities are endless.
- dhaine_adp
- Posts: 457
- Joined: Wed Aug 06, 2008 12:22 pm
- Location: Manila, Philippines
Re: How to build menu like old ACHOICE function?
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
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
Danny
Manila, Philippines
- dhaine_adp
- Posts: 457
- Joined: Wed Aug 06, 2008 12:22 pm
- Location: Manila, Philippines
Re: How to build menu like old ACHOICE function?
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
Regards,
--
Danny
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
Danny
Manila, Philippines
Re: How to build menu like old ACHOICE function?
Dear Danny,
Good work
How to unload Achoicemenu design by Marek from window
Good work
How to unload Achoicemenu design by Marek from window
BPD
Convert Dream into Reality through HMG
Convert Dream into Reality through HMG