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.
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 );
}