Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How to create a Top-Level Form with a Top-Level menu (programmatically)

Forms & Screen

How to create a Top-Level Form with a Top-Level menu (programmatically)

by  Mike Gagnon  Posted    (Edited  )
This is only an example (some of the menu items and command buttons do not work). Copy the following into a program and run it.
Code:
PUBLIC oform1
oform1=NEWOBJECT("form1")
oform1.Show
RETURN
DEFINE CLASS form1 AS form
	ShowWindow = 2
	DoCreate = .T.
	Caption = "Form1"
	Name = "Form1"
        AutoCenter = .t.
	ADD OBJECT commandgroup1 AS commandgroup WITH ;
		AutoSize = .F., ;
		ButtonCount = 5, ;
		BorderStyle = 0, ;
		Value = 1, ;
		Height = 37, ;
		Left = 12, ;
		Top = 192, ;
		Width = 348, ;
		Name = "Commandgroup1", ;
		Command1.AutoSize = .F., ;
		Command1.Top = 5, ;
		Command1.Left = 5, ;
		Command1.Height = 27, ;
		Command1.Width = 66, ;
		Command1.Caption = "Top", ;
		Command1.Name = "Command1", ;
		Command2.AutoSize = .F., ;
		Command2.Top = 5, ;
		Command2.Left = 73, ;
		Command2.Height = 27, ;
		Command2.Width = 66, ;
		Command2.Caption = "Previous", ;
		Command2.Name = "Command2", ;
		Command3.AutoSize = .F., ;
		Command3.Top = 5, ;
		Command3.Left = 141, ;
		Command3.Height = 27, ;
		Command3.Width = 66, ;
		Command3.Caption = "Next", ;
		Command3.Name = "Command3", ;
		Command4.AutoSize = .F., ;
		Command4.Top = 5, ;
		Command4.Left = 209, ;
		Command4.Height = 27, ;
		Command4.Width = 66, ;
		Command4.Caption = "Last", ;
		Command4.Name = "Command4", ;
		Command5.AutoSize = .F., ;
		Command5.Top = 5, ;
		Command5.Left = 277, ;
		Command5.Height = 27, ;
		Command5.Width = 66, ;
		Command5.Caption = "Exit", ;
		Command5.Name = "Command5"
	ADD OBJECT text1 AS textbox WITH ;
		Height = 25, ;
		Left = 60, ;
		Top = 48, ;
		Width = 85, ;
		Name = "Text1"
	PROCEDURE oMenu
		LPARAMETERS oFormRef, getMenuName, lUniquePopups, parm4, parm5, parm6, parm7, parm8, parm9
		LOCAL cMenuName, nTotPops, a_menupops, cTypeParm2, cSaveFormName
		IF TYPE("m.oFormRef") # "O" OR ;
		  LOWER(m.oFormRef.BaseClass) # 'form' OR ;
		  m.oFormRef.ShowWindow # 2
			MESSAGEBOX([This menu can only be called from a Top-Level form. Ensure that your form's ShowWindow property is set to 2. Read the header section of the menu's MPR file for more details.])
			RETURN
		ENDIF
		m.cTypeParm2 = TYPE("m.getMenuName")
		m.cMenuName = SYS(2015)
		m.cSaveFormName = m.oFormRef.Name
		IF m.cTypeParm2 = "C" OR (m.cTypeParm2 = "L" AND m.getMenuName)
			m.oFormRef.Name = m.cMenuName
		ENDIF
		IF m.cTypeParm2 = "C" AND !EMPTY(m.getMenuName)
			m.cMenuName = m.getMenuName
		ENDIF
		DIMENSION a_menupops[3]
		IF TYPE("m.lUniquePopups")="L" AND m.lUniquePopups
			FOR nTotPops = 1 TO ALEN(a_menupops)
				a_menupops[m.nTotPops]= SYS(2015)
			ENDFOR
		ELSE
			a_menupops[1]="system"
			a_menupops[2]="forms"
			a_menupops[3]="help"
		ENDIF
		DEFINE MENU (m.cMenuName) IN (m.oFormRef.Name) BAR
		DEFINE PAD _0ty0h5629 OF (m.cMenuName) PROMPT "System" COLOR SCHEME 3 ;
			KEY ALT+S, ""
		DEFINE PAD _0ty0h562a OF (m.cMenuName) PROMPT "Forms" COLOR SCHEME 3 ;
			KEY ALT+F, ""
		DEFINE PAD _0ty0h562b OF (m.cMenuName) PROMPT "Help" COLOR SCHEME 3 ;
			KEY ALT+H, ""
		ON PAD _0ty0h5629 OF (m.cMenuName) ACTIVATE POPUP (a_menupops[1])
		ON PAD _0ty0h562a OF (m.cMenuName) ACTIVATE POPUP (a_menupops[2])
		ON PAD _0ty0h562b OF (m.cMenuName) ACTIVATE POPUP (a_menupops[3])
		DEFINE POPUP (a_menupops[1]) MARGIN RELATIVE SHADOW COLOR SCHEME 4
		DEFINE BAR 1 OF (a_menupops[1]) PROMPT "Exit"
		ON SELECTION BAR 1 OF (a_menupops[1]) quit
		DEFINE POPUP (a_menupops[2]) MARGIN RELATIVE SHADOW COLOR SCHEME 4
		DEFINE BAR 1 OF (a_menupops[2]) PROMPT "Form #1"
		DEFINE BAR 2 OF (a_menupops[2]) PROMPT "\-"
		DEFINE BAR 3 OF (a_menupops[2]) PROMPT "Form #2"
		DEFINE POPUP (a_menupops[3]) MARGIN RELATIVE SHADOW COLOR SCHEME 4
		DEFINE BAR 1 OF (a_menupops[3]) PROMPT "About"
		ACTIVATE MENU (m.cMenuName) NOWAIT

		IF m.cTypeParm2 = "C"
			m.getMenuName = m.cMenuName
			m.oFormRef.Name = m.cSaveFormName 
		ENDIF
	ENDPROC
	PROCEDURE Init
		_screen.Visible = .f.
		this.oMenu(this)
	ENDPROC
	PROCEDURE commandgroup1.Command5.Click
		thisform.Release
	ENDPROC
ENDDEFINE
Mike Gagnon
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top