2009/04/20 | 顶层表单的菜单工具栏
类别(数据库学习笔记) | 评论(0) | 阅读(107) | 发表于 00:04

lujin=left(sys(16),rat('\',sys(16))-1)
SET defa to (lujin)
TopForm=CREATEOBJECT('TopForm')
TopForm.show
on shutdown TopForm.destroy
_screen.windowstate=1
read events
set default to
on shutdown
_screen.windowstate=2
retu

DEFINE CLASS TopForm AS form
 showwindow=2
 DoCreate = .T.
 Caption = "TopForm_Menu_Toolbar"
 width=500
 height=300
 TopToolBar='Toolbar1'
 nActivate=0

 proc QueryUnload
  NODEFAULT
        clear events

 *建菜单
 PROCEDURE Init
  this.oMenu(this)

 *建工具栏
 proc activate
  with this
   if .nActivate=0
    .nActivate=2
    .TopToolBar=createobject('TOOLBAR1')
    .TopToolBar.top=-30
    .TopToolBar.Dock(0)
    .TopToolBar.show()
   endif
  endwith

 *10进制转换
 proc DtoX
  lParameters lnvalue,lnX
  leResult = ""
  If lnvalue >= lnX
   Do While ( lnvalue >= lnX )
    lcTemp = SubStr("0123456789abcdef",Int(lnvalue % lnX) + 1,1)
    leResult = AllTrim(lcTemp) + leResult
    lnvalue = Int(lnvalue / lnX)
   EndDo
   leResult = SubStr("0123456789abcdef",lnvalue + 1,1) + leResult
  Else
   leResult = SubStr("0123456789abcdef",Int(lnvalue % lnX) + 1,1)
  EndIf
  Return leResult

 *菜单
 PROCEDURE oMenu
  LPARAMETERS oFormRef, getMenuName

  cTypeParm2 = TYPE("getMenuName")
  cMenuName = SYS(2015)
  cSaveFormName = oFormRef.Name

  IF cTypeParm2 = "C" OR (cTypeParm2 = "L" AND getMenuName)
   oFormRef.Name = cMenuName
  ENDIF

  IF cTypeParm2 = "C" AND !EMPTY(getMenuName)
   cMenuName = getMenuName
  ENDIF

  nPad=10
  public menupops,aPad
  DIMENSION menupops[nPad],aPad(nPad)

  menupops[1]="文件"
  menupops[2]="表单"
  menupops[3]="备份"
  menupops[4]="编辑"
  menupops[5]="查看"
  menupops[6]="工具"
  menupops[7]="窗口"
  menupops[8]="进货"
  menupops[9]="财务"
  menupops[10]="帮助"

  for i=1 to nPad
   aPad(i)='_0ty0h'+thisform.DtoX(22056+i,16)
  endfor

  DEFINE MENU (cMenuName) IN (oFormRef.Name) BAR
  DEFINE PAD (aPad[1]) OF (cMenuName) PROMPT menupops[1] COLOR SCHEME 3 ;
   KEY ALT+F, ""
  DEFINE PAD (aPad[2]) OF (cMenuName) PROMPT menupops[2] COLOR SCHEME 3 ;
   KEY ALT+M, ""
  DEFINE PAD (aPad[3]) OF (cMenuName) PROMPT menupops[3] COLOR SCHEME 3 ;
   KEY ALT+H, ""
  DEFINE PAD (aPad[4]) OF (cMenuName) PROMPT menupops[4] COLOR SCHEME 3 ;
   KEY ALT+E, ""
  DEFINE PAD (aPad[5]) OF (cMenuName) PROMPT menupops[5] COLOR SCHEME 3 ;
   KEY ALT+T, ""
  DEFINE PAD (aPad[6]) OF (cMenuName) PROMPT menupops[6] COLOR SCHEME 3 ;
   KEY ALT+H, ""
  DEFINE PAD (aPad[7]) OF (cMenuName) PROMPT menupops[7] COLOR SCHEME 3 ;
   KEY ALT+H, ""
  DEFINE PAD (aPad[8]) OF (cMenuName) PROMPT menupops[8] COLOR SCHEME 3 ;
   KEY ALT+H, ""
  DEFINE PAD (aPad[9]) OF (cMenuName) PROMPT menupops[9] COLOR SCHEME 3 ;
   KEY ALT+H, ""
  DEFINE PAD (aPad[10]) OF (cMenuName) PROMPT menupops[10] COLOR SCHEME 3 ;
   KEY ALT+H, ""

  ON PAD (aPad[1]) OF (cMenuName) ACTIVATE POPUP (menupops[1])
  ON PAD (aPad[2]) OF (cMenuName) ACTIVATE POPUP (menupops[2])
  ON PAD (aPad[3]) OF (cMenuName) ACTIVATE POPUP (menupops[3])
  ON PAD (aPad[4]) OF (cMenuName) ACTIVATE POPUP (menupops[4])
  ON PAD (aPad[5]) OF (cMenuName) ACTIVATE POPUP (menupops[5])
  ON PAD (aPad[6]) OF (cMenuName) ACTIVATE POPUP (menupops[6])
  ON PAD (aPad[7]) OF (cMenuName) ACTIVATE POPUP (menupops[7])
  ON PAD (aPad[8]) OF (cMenuName) ACTIVATE POPUP (menupops[8])
  ON PAD (aPad[9]) OF (cMenuName) ACTIVATE POPUP (menupops[9])
  ON PAD (aPad[10]) OF (cMenuName) ACTIVATE POPUP (menupops[10])

  DEFINE POPUP (menupops[1]) MARGIN RELATIVE SHADOW COLOR SCHEME 4
  DEFINE BAR 1 OF (menupops[1]) PROMPT "Exit"
  ON SELECTION BAR 1 OF (menupops[1]) clear events

  DEFINE POPUP (menupops[2]) MARGIN RELATIVE SHADOW COLOR SCHEME 4
  DEFINE BAR 1 OF (menupops[2]) PROMPT "Form #1" STYLE 'B'
  DEFINE BAR 2 OF (menupops[2]) PROMPT "Form #2"
  ON SELECTION POPUP (menupops[2]) do Sele_Pad_Bar with prompt(),popup()

  DEFINE POPUP (menupops[3]) MARGIN RELATIVE SHADOW COLOR SCHEME 4
  DEFINE BAR 1 OF (menupops[3]) PROMPT "ccc"
  ON SELECTION POPUP (menupops[3]) do Sele_Pad_Bar with prompt(),popup()

  DEFINE POPUP (menupops[4]) MARGIN RELATIVE SHADOW COLOR SCHEME 4
  DEFINE BAR 1 OF (menupops[4]) PROMPT "ddd"
  ON SELECTION POPUP (menupops[4]) do Sele_Pad_Bar with prompt(),popup()

  DEFINE POPUP (menupops[5]) MARGIN RELATIVE SHADOW COLOR SCHEME 4
  DEFINE BAR 1 OF (menupops[5]) PROMPT "eee"
  ON SELECTION POPUP (menupops[5]) do Sele_Pad_Bar with prompt(),popup()

  DEFINE POPUP (menupops[6]) MARGIN RELATIVE SHADOW COLOR SCHEME 4
  DEFINE BAR 1 OF (menupops[6]) PROMPT "fff"
  ON SELECTION POPUP (menupops[6]) do Sele_Pad_Bar with prompt(),popup()

  DEFINE POPUP (menupops[7]) MARGIN RELATIVE SHADOW COLOR SCHEME 4
  DEFINE BAR 1 OF (menupops[7]) PROMPT "ggg"
  ON SELECTION POPUP (menupops[7]) do Sele_Pad_Bar with prompt(),popup()

  DEFINE POPUP (menupops[8]) MARGIN RELATIVE SHADOW COLOR SCHEME 4
  DEFINE BAR 1 OF (menupops[8]) PROMPT "hhh"
  ON SELECTION POPUP (menupops[8]) do Sele_Pad_Bar with prompt(),popup()

  DEFINE POPUP (menupops[9]) MARGIN RELATIVE SHADOW COLOR SCHEME 4
  DEFINE BAR 1 OF (menupops[9]) PROMPT "iii"
  ON SELECTION POPUP (menupops[9]) do Sele_Pad_Bar with prompt(),popup()

  DEFINE POPUP (menupops[10]) MARGIN RELATIVE SHADOW COLOR SCHEME 4
  DEFINE BAR 1 OF (menupops[10]) PROMPT "jjj" FONT '华文楷体', 16
  ON SELECTION POPUP (menupops[10]) do Sele_Pad_Bar with prompt(),popup()

  ACTIVATE MENU (cMenuName) NOWAIT

  getMenuName = cMenuName
  oFormRef.Name = cSaveFormName

ENDDEFINE

proc Sele_Pad_Bar
 para prompt,popup
 do case
 case prompt='Exit' and lower(popup)=menupops[1]
  clear events
 case prompt='Form #1' and lower(popup)=menupops[2]
  messageb(menupops[2]+'---Form #1',0,[],2000)
 case prompt='Form #2' and lower(popup)=menupops[2]
  messageb(menupops[2]+'---Form #2',0,[],2000)
 endcase
endproc

DEFINE CLASS TOOLBAR1 AS TOOLBAR
 ShowWindow=1
 visible=.t.

 add object CmdCancel as commandbutton with width=60,height=24,Style=0,caption='退出'
 add object sep1 as Separator
 ADD OBJECT COMBO1 AS COMbobox with width=200,ColumnCount=2,ColumnWidths = "90,110",DisplayValue='二列组合框'
 add object sep2 as Separator
 ADD OBJECT CmdCaidan AS COMMandbutton with width=60,height=24,caption='?'
 add object sep3 as Separator
 ADD OBJECT OPTION AS OptionGroup with ButtonCount=2,width=90,height=24

 proc CmdCaidan.click
     messageb('安徽太湖老头子查达楼学习作,请多指教!')

 proc init
  with this.OPTION
   .Buttons(1).width = 40
   .Buttons(1).caption = '预览'
   .Buttons(1).top = 4
   .Buttons(2).width = 42
   .Buttons(2).left = 44
   .Buttons(2).top = 4
   .Buttons(2).caption = '打印'
  endwith

  with this.combo1
   .AddItem('编号' ,1,1)
   .List(1,2) = '品名'
   .Picture[1] = 'fox.bmp'

   .AddItem('0023456' ,2,1)
   .List(2,2) = '电脑'

   .AddItem('0087654' ,3,1)
   .List(3,2) = '\Abcdefg'
  endwith

 proc CmdCancel.click
  CLEAR EVENTS

endDEFINE

 

0

评论Comments