Code: Select all | Expand
//----------------------------------------------------------------------------//
// Author: Cristobal Navarro
// Sample demo Features MENUS, using databases and arrays
//----------------------------------------------------------------------------//
#include "FiveWin.ch"
Static oWnd
Static oFontMnu
function Main()
local oMenu
DEFINE FONT oFontMnu NAME "Segoe UI Symbol" SIZE 0, -14
DbUseArea( .T., , "Customer.dbf" )
DbUseArea( .T., , "utf8_01.dbf" )
DbUseArea( .T., , "states.dbf" )
//DbGoto( 3 )
DEFINE WINDOW oWnd TITLE "Test Menu From Databases and Arrays: " MENU MenuDatabase() ;
FROM 20, 40 TO 650, 1200 PIXEL
oWnd:bRClicked := { | nR, nC | MenuDatabase( .T., .F., nR, nC ) }
CtrlMove( oWnd )
ACTIVATE WINDOW oWnd ON INIT MenuDatabase( .F., .T., , ) MAXIMIZED
RELEASE oFontMnu
return nil
//----------------------------------------------------------------------------//
Function MenuDatabase( lPopup, lSys, nR, nC )
local oMenu
DEFAULT lPopup := .F.
DEFAULT lSys := .F.
if !lPopup
if !lSys
MENU oMenu 2013 ;
COLORMENU METRO_STEEL, CLR_WHITE ;
COLORLEFT CLR_WHITE, METRO_STEEL ;
COLORRIGHT CLR_WHITE, METRO_STEEL ;
COLORSELECT CLR_HCYAN, CLR_HCYAN, Rgb( 0, 0, 1 ) ; //CLR_WHITE, CLR_WHITE, CLR_BLUE ;
COLORSEPARATOR CLR_RED ;
COLORBOX CLR_WHITE
else
REDEFINE SYSMENU oMenu OF oWnd 2013 ;
COLORMENU METRO_STEEL, CLR_WHITE ;
COLORLEFT CLR_WHITE, METRO_STEEL ;
COLORRIGHT CLR_WHITE, METRO_STEEL ;
COLORSELECT CLR_WHITE, CLR_WHITE, CLR_BLUE ;
COLORSEPARATOR CLR_RED ;
COLORBOX CLR_WHITE
SEPARATOR
endif
else
MENU oMenu 2013 POPUP FONT oFontMnu ;
COLORMENU METRO_STEEL, CLR_WHITE ;
COLORLEFT CLR_WHITE, METRO_STEEL ;
COLORRIGHT CLR_WHITE, METRO_STEEL ;
COLORSELECT CLR_WHITE, CLR_WHITE, CLR_BLUE ;
COLORSEPARATOR CLR_RED ;
COLORBOX CLR_WHITE
endif
if lPopup
MENUITEM "Databases and Arrays Test and Font" SEPARATOR OF oMenu BOLD //ITALIC
SEPARATOR
endif
MENUITEM Alias( 1 ) // COLORMENU CLR_RED, CLR_YELLOW
MENU SELECT Alias( 1 ) LIMIT 16 COLUMNS 1, 4, 5
ENDMENU
MENUITEM Alias( 2 )
MENU SELECT Alias( 2 ) LIMIT 06 COLUMNS 1, 2, 3
ENDMENU
MENUITEM Alias( 3 )
MENU SELECT Alias( 3 ) LIMIT -1 COLUMNS 2
ENDMENU
MENUITEM Alias( 2 ) + "_EXPAND"
MENU SELECT Alias( 2 ) LIMIT 06 COLUMNS 1, 2, 3 EXPAND
ENDMENU
MENUITEM Upper( "FieldNames_" ) + Alias( 1 )
MENU SELECT ( Alias( 1 ) )->( DbStruct() ) LIMIT -1 COLUMNS 2, 1, 3 //, 4
ENDMENU
MENUITEM Upper( "FieldNames_" ) + Alias( 1 ) + "_EXPAND"
MENU SELECT ( Alias( 1 ) )->( DbStruct() ) LIMIT -1 COLUMNS 1, 2, 3, 4 ;
EXPAND NOFORM HEADERS "Name", "Type", "Length", "Decs"
ENDMENU
MENUITEM Upper( "FieldNames" ) + "_EXPAND_FORM_ACTIONS"
MENU SELECT ( Alias( 1 ) )->( DbStruct() ) LIMIT -1 COLUMNS 1, 2, 3, 4 EXPAND ;
HEADERS "Name", "Type", "Length", "Decs" ACTION { | oI | MyAction( oI ) }
//LEFTWIDTH if( lSys, 24, 1 ) ;
//LOGOMENU "..\bitmaps\fivetechv.png" ;
ENDMENU
MENUITEM "EXIT" ACTION oWnd:End() WHEN ( !lPopup .and. !lSys )
if lPopup
ENDMENU
if nC < oWnd:nRight - 400
ACTIVATE MENU oMenu AT nR, nC OF oWnd // Limit zone for show menu
else
oMenu:End() // Release Menus created
endif
else
if lSys
SEPARATOR
MENUITEM "Reset Menu" ACTION oMenu:Reset()
ENDSYSMENU
else
ENDMENU
endif
endif
Return oMenu
//----------------------------------------------------------------------------//
Function MyAction( oI )
//oI:SetCheck(.T.)
? "Object Item: ", oI, ;
"Position into Menu Parent: ", oI:nPos, ;
"oItem cPrompt:", oI:cPrompt, ;
"oItem Id: ", oI:nId, ;
"Object Menu Parent of Item: ", oI:oMenu, ;
"Position of Menu Parent: ", oI:oMenu:nPos
? "Object Menu Principal: ", Valtype( GetaMenusAux()[ 1 ] ), GetaMenusAux()[ 1 ]:lMenuBar
? "Items of Menu Principal: ", Len( GetaMenusAux()[ 1 ]:aMenuItems )
? "Menu Parent of Menu of Item Selected", GetParentAuxMenus( oI:oMenu ), ;
"Items of this Menu: ", Len( GetParentAuxMenus( oI:oMenu ):aMenuItems ), ;
"Separators, they are also counted"
? "Len Items Menu 5: ", Len( GetaMenusAux()[ 5 ]:aMenuItems )
? "Total Menus Create: ", Len( GetaMenusAux() )
Return nil
//----------------------------------------------------------------------------//
Function CtrlMove( oDlg )
local oFontWD2
local nRow := oDlg:nBottom - 150
local nCol := oDlg:nRight - 350
local nSize := 32
local oSay
@ nRow - 64, 20 GROUP TO nRow + 54, oDlg:nRight - 460 OF oDlg PIXEL PROMPT " Notes: "
@ nRow - 64, oDlg:nRight - 450 GROUP TO nRow + 54, oDlg:nRight - 80 OF oDlg PIXEL PROMPT " Menu " + Alias( 1 ) + " Changes: "
@ nRow - 24, 80 SAY " - Press RIGHT BUTTON of Mouse for Test Menu POPUP: [ MAX -> oWnd:nRight - 400 ]" ;
PIXEL OF oDlg COLOR CLR_WHITE, METRO_OLIVE FONT oFontMnu SIZE 550, 24
@ nRow + 12, 80 SAY " - Press over ICON Application for Test SYSMENU" PIXEL ;
OF oDlg COLOR CLR_WHITE, METRO_OLIVE FONT oFontMnu SIZE 550, 24
@ nRow - 24, nCol - nSize - 24 SAY oSay PROMPT " Controls for movement: " + Alias( 1 ) PIXEL ;
OF oDlg COLOR CLR_WHITE, METRO_OLIVE FONT oFontMnu SIZE 230, 22
oFontWD2 := TFont():New( 'Wingdings 3', 0, -21, .f., .f., 0, 0, 400, .f., .f., .f., 2,3, 2, 1,, 18 )
@ nRow, nCol BTNBMP PROMPT Chr( HexToDec( "72" ) ) SIZE nSize, nSize + 1 PIXEL OF oDlg FLAT ; //BITMAP aBmp[ 1 ]
TOOLTIP FWString( "Top" ) + " " + Alias( 1 ) FONT oFontWD2 ACTION ( ATTop() )
@ nRow, nCol + nSize * 1 + 1 BTNBMP PROMPT Chr( HexToDec( "76" ) ) SIZE nSize, nSize + 1 PIXEL OF oDlg FLAT ;
TOOLTIP FWString( "Move Up" ) + " " + Alias( 1 ) FONT oFontWD2 ACTION ( Retrocede() )
@ nRow, nCol + nSize * 2 + 2 BTNBMP PROMPT Chr( HexToDec( "77" ) ) SIZE nSize, nSize + 1 PIXEL OF oDlg FLAT ;
TOOLTIP FWString( "Move Down" ) + " " + Alias( 1 ) FONT oFontWD2 ACTION ( Avanza() )
@ nRow, nCol + nSize * 3 + 3 BTNBMP PROMPT Chr( HexToDec( "73" ) ) SIZE nSize, nSize + 1 PIXEL OF oDlg FLAT ;
TOOLTIP FWString( "Bottom" ) + " " + Alias( 1 ) FONT oFontWD2 ACTION ( ATBottom() )
oFontWD2:End()
AEval( oDlg:aControls, { |o| If( o:ClassName() == "TBTNBMP", ( o:SetColor( CLR_WHITE, METRO_OLIVE ), o:nRound := 0 ), nil ) } )
Return nil
//----------------------------------------------------------------------------//
Function Avanza( nAr )
local nRec := ( Alias( 1 ) )->( RecNo() )
local nPos := 0
local x
local oMnu := GetaMenusAux()[ 2 ]
local n
local aItems := {}
DEFAULT nAr := 1
//? oWnd:oMenu:hMenu, Len( GetaMenusAux()[ 1 ]:aMenuItems ), GetaMenusAux()[ 2 ]:aMenuItems[ 4 ]:cPrompt
//? GetaMenusAux()[ 1 ]:aMenuItems[ 1 ]:bAction:hMenu, oMnu:hMenu
if !Empty( oMnu )
if oMnu:nLimit > 0
( Alias( nAr ) )->( DbGoTo( ( oMnu:nLimit * oMnu:nPage ) + 1 ) )
if ( Alias( nAr ) )->( !Eof() )
oMnu:nPage++
aItems := oMnu:aMenuItems
x := 0
Do While ( Alias( nAr ) )->( !Eof() )
x++
if x > oMnu:nLimit
Exit
endif
For n = 1 to Len( oMnu:aCols )
aItems[ x + ( 2 * n ) + oMnu:nLimit * ( n - 1 ) ]:SetPrompt( ( Alias( nAr ) )->( FieldGet( oMnu:aCols[ n ] ) ) )
Next n
( Alias( nAr ) )->( DbSkip() )
Enddo
endif
endif
endif
( Alias( nAr ) )->( DbGoTo( nRec ) )
Return nil
//----------------------------------------------------------------------------//
Function Retrocede( nAr )
local nRec := ( Alias( 1 ) )->( RecNo() )
local nPos := 0
local x
local oMnu := GetaMenusAux()[ 2 ]
local n
local aItems := {}
DEFAULT nAr := 1
if !Empty( oMnu )
if oMnu:nLimit > 0
( Alias( nAr ) )->( DbGoTo( ( oMnu:nLimit * ( oMnu:nPage - 2 ) ) + 1 ) )
if ( Alias( nAr ) )->( !Bof() )
oMnu:nPage--
aItems := oMnu:aMenuItems
x := 0
Do While ( Alias( nAr ) )->( !Bof() )
x++
if x > oMnu:nLimit
Exit
endif
For n = 1 to Len( oMnu:aCols )
aItems[ x + ( 2 * n ) + oMnu:nLimit * ( n - 1 ) ]:SetPrompt( ( Alias( nAr ) )->( FieldGet( oMnu:aCols[ n ] ) ) )
Next n
( Alias( nAr ) )->( DbSkip( 1 ) )
Enddo
endif
endif
endif
( Alias( nAr ) )->( DbGoTo( nRec ) )
Return nil
//----------------------------------------------------------------------------//
Function ATTop( nAr )
local nRec := ( Alias( 1 ) )->( RecNo() )
local nPos := 0
local x
local oMnu := GetaMenusAux()[ 2 ]
local n
local aItems := {}
DEFAULT nAr := 1
if !Empty( oMnu )
if oMnu:nLimit > 0
( Alias( nAr ) )->( DbGoTop() )
if ( Alias( nAr ) )->( !Eof() )
oMnu:nPage := 1
aItems := oMnu:aMenuItems
x := 0
Do While ( Alias( nAr ) )->( !Eof() )
x++
if x > oMnu:nLimit
Exit
endif
For n = 1 to Len( oMnu:aCols )
aItems[ x + ( 2 * n ) + oMnu:nLimit * ( n - 1 ) ]:SetPrompt( ( Alias( nAr ) )->( FieldGet( oMnu:aCols[ n ] ) ) )
Next n
( Alias( nAr ) )->( DbSkip() )
Enddo
endif
endif
endif
( Alias( nAr ) )->( DbGoTo( nRec ) )
Return nil
//----------------------------------------------------------------------------//
Function ATBottom( nAr )
local nRec := ( Alias( 1 ) )->( RecNo() )
local nPos := 0
local x
local oMnu := GetaMenusAux()[ 2 ]
local n
local aItems := {}
DEFAULT nAr := 1
if !Empty( oMnu )
if oMnu:nLimit > 0
( Alias( nAr ) )->( DbGoTo( ( Alias( 1 ) )->( LastRec() ) - oMnu:nLimit + 1 ) )
if ( Alias( nAr ) )->( !Eof() )
oMnu:nPage := if( ( ( Alias( nAr ) )->( LastRec() ) % oMnu:nLimit ) = 0, ;
( ( Alias( nAr ) )->( LastRec() ) / oMnu:nLimit ), ;
Int( ( Alias( nAr ) )->( LastRec() ) / oMnu:nLimit ) + 1 )
aItems := oMnu:aMenuItems
x := 0
Do While ( Alias( nAr ) )->( !Eof() )
x++
if x > oMnu:nLimit
Exit
endif
For n = 1 to Len( oMnu:aCols )
aItems[ x + ( 2 * n ) + oMnu:nLimit * ( n - 1 ) ]:SetPrompt( ( Alias( nAr ) )->( FieldGet( oMnu:aCols[ n ] ) ) )
Next n
( Alias( nAr ) )->( DbSkip() )
Enddo
endif
endif
endif
( Alias( nAr ) )->( DbGoTo( nRec ) )
Return nil
//----------------------------------------------------------------------------//