menu.tbl

来自「一个不错的做图软件」· TBL 代码 · 共 320 行

<?xml version="1.0" encoding="utf-8"?>
<vg version="722" range="0,0,1024,712" backcolor="$8000000F">
<page name="Page" bounds="0,0,793.70078,1122.141732" visible="false"/>
<sheet name="MenuItem" visible="false">
<rect name="Rect1" origin="77,15.5" bounds="0,0,153,22" linetype="0" backcolor="$80000004" pattern="1"/>
<text name="Text1" origin="25,2.75" bounds="21,3,91,19" backcolor="$8000000A" autosize="true" border="0" fontname="瀹嬩綋" fontsize="12" fontcolor="$80000007" wordwrap="false" textalign="4" text="MenuItem(M)"/>
<line name="Line1" origin="152.2,4" visible="false" backcolor="$0" pattern="1">
<points>
144,8,6
144,14,2
147,11,3
</points>
</line>
<line name="Line2" origin="1,1" selectmode="0" linetype="0" backcolor="$C0C0C0">
<points>
1,1,6
1,21,2
21,21,2
21,1,3
</points>
</line>
<programe>
<!--
property Caption read GetCaption write SetCaption
property Checked read FChecked write SetChecked editor Bool
property Enable read GetEnable write SetEnable editor Bool
property Focused read GetFocused write SetFocused editor Bool
private function GetCaption()
return Text1.Text
end function
private function GetEnable()
return Line2.Alpha = 100
end function
private function GetFocused()
return Rect1.BackColor = $8000000D
end function
private function GetItems()
if Doc <> 0 then
  return Doc.ActiveSheet
else
  return 0
end if
end function
public function HideSubMenu()
if Doc <> 0 then
  Doc.Hide()
  i = 0
  while i < Doc.ActiveSheet.UnitCount
    d = Doc.ActiveSheet.Units[i]
    if UCase( d.Type ) = "MENUITEM" then
      d.HideSubMenu()
    end if
    i = i + 1
  wend
end if
end function
private function Initialize(Sender)
Doc=0
FChecked = false
FPicture = ""
FSubMenu=""
end function
property Items read GetItems
private function OnClick(Sender)
if Line2.Alpha = 100 then
  i = 0
  while i < ActiveSheet.UnitCount
    d = ActiveSheet.Units[i]
    if UCase( d.Type ) = "MENUITEM" then
      d.HideSubMenu()
    end if
    i = i + 1
  wend
  ActiveSheet.HandleCommand( Sender.Id )
end if
end function
private function OnDestroy(Sender)
if Doc <> 0 then
  Doc.Free()
end if
end function
public function OnKeyDown(Sender,Key)
if ( Key = 13 ) and ( Line2.Alpha = 100 ) then
  Parent.HandleCommand( Id )
else if Key = 27 then
  Close( 0 )
else if Key = 37 then
  if ActiveSheet.HasProperty( "MainMenu" ) then
    HideSubMenu()
  end if
  Close( 1 )
else if Key = 38 then
  i=0
  prior = 0
  last = 0
  t = 0
  while i < Parent.UnitCount
    d = Parent.Units[i]
    if d.Type = Type then
      if d = this then
        prior = t
      else
        t = d
      end if
      last = d
    end if
    i = i + 1
  wend
  if prior <> 0 then
    prior.Focused = true
  else
    last.Focused = true
  end if
else if Key = 39 then
  if Doc <> 0 then
    OnMouseEnter( Sender )
  else
    Close( 2 )
  end if
else if Key = 40 then
  i=0
  first = 0
  next = 0
  t = 0
  while i < Parent.UnitCount
    d = Parent.Units[i]
    if d.Type = Type then
      if d = this then
        t = d
      else if t <> 0 then
        next = d
        t = 0
      end if
      if first = 0 then
        first = d
      end if
    end if
    i = i + 1
  wend
  if next <> 0 then
    next.Focused = true
  else
    first.Focused = true
  end if
else if Line2.Alpha = 100 then
  s = '(' + chr( Key ) + ')'
  if At( s, Caption ) > 0 then
    OnClick( Sender )
  end if
end if
end function
private function OnLoad(Sender)
if Len( SubMenu ) > 0 then
  Sheet = SheetByName( SubMenu )
  if Sheet <> 0 then
    Line1.Visible = true
    Doc = Create( Handle, "", true, false )
    Doc.CopySheet( Sheet )
    Doc.DeleteSheet( Doc.Sheet1 )
    Doc.BorderStyle = 1
    Doc.ScrollBars = 0
    Doc.SelectAll()
    Doc.RangeLeft = Doc.ActiveSheet.Selection.Left
    Doc.RangeTop = Doc.ActiveSheet.Selection.Top
    Doc.RangeRight = Doc.ActiveSheet.Selection.Right + 1
    Doc.RangeBottom = Doc.ActiveSheet.Selection.Bottom + 1
    Doc.ActiveSheet.Selection.Clear()
    Doc.ActiveSheet.SetPropertyValue( "MainMenu", Parent )
    OnLoadSubMenu( Sender, Doc.ActiveSheet )
  else
    Line1.Visible = false
  end if
else
  Line1.Visible = false
end if
end function
published function OnLoadSubMenu(Sender,ASheet)
end function
private function OnMouseEnter(Sender)
Focused = true
if Doc <> 0 and Line2.Alpha = 100 then
  extern int=GetSystemMetrics( int ) in User32.dll
  SM_CXSCREEN = 0
  SM_CYSCREEN = 1
  ScreenWidth = GetSystemMetrics( SM_CXSCREEN )
  ScreenHeight = GetSystemMetrics( SM_CYSCREEN )
  p = Point( Right, Top )
  ViewToClient( p )
  ClientToScreen( p )
  if p.x + Doc.RangeRight - Doc.RangeLeft > ScreenWidth then
    p.x = p.x - Width - Doc.RangeRight + Doc.RangeLeft + 4
  else
    p.x = p.x - 4
  end if
  if p.y + Doc.RangeBottom - Doc.RangeTop > ScreenHeight then
    p.y = p.y - Doc.RangeBottom + Doc.RangeTop + Height
  end if
  firstfocused = 0
  i = 0
  while i < Doc.ActiveSheet.UnitCount
    d = Doc.ActiveSheet.Units[i]
    if d.Type = Type then
      if d.Focused then
        firstfocused = 0
        break
      else if firstfocused = 0 then
        firstfocused = d
      end if
    end if
    i = i + 1
  wend
  if firstfocused <> 0 then
    firstfocused.Focused = true
  end if
  Doc.Popup( p.x, p.y )
end if
end function
private function OnMouseExit(Sender)
Focused = false
end function
private function OnResize(Sender)
Height = Rect1.Height
Rect1.SetBounds( Left, Top, Width, Rect1.Height )
Line1.Left = Rect1.Left + Rect1.Width - Line1.Width - 4
Text1.Width = Line1.Left - Text1.Left
end function
property Picture read FPicture write SetPicture editor Picture
private function SetCaption(AValue)
Text1.Text = AValue
if Text1.Left + Text1.Width > Line1.Left then
  n = Text1.Left + Text1.Width - Line1.Left
  Line1.Left = Line1.Left + n
  Rect1.Width = Rect1.Width + n
  Refresh()
end if
end function
private function SetChecked(AValue)
FChecked = AValue
if FChecked then
  Line2.Picture = SystemParams.DefaultPath + "checkbox.bmp"
else
  Line2.Picture = 0
  Line2.Picture = SystemParams.DefaultPath + FPicture
end if
end function
private function SetEnable(AValue)
if AValue then
  Text1.FontColor = $80000007
  Line2.Alpha = 100
else
  Text1.FontColor = $80000011
  Line2.Alpha = 20
end if
end function
private function SetFocused(AValue)
if AValue then
  Rect1.BackColor = $8000000D
  if Line2.Alpha = 100 then
    Text1.FontColor = $8000000E
  else
    Text1.FontColor = $80000011
  end if
  i = 0
  while i < Parent.UnitCount
    d = Parent.Units[i]
    if LCase( d.Type ) = "menuitem" then
      if d <> this then
        d.Focused = false
        d.HideSubMenu()
      end if
    end if
    i = i + 1
  wend
else
  Rect1.BackColor = $80000004
  if Line2.Alpha = 100 then
    Text1.FontColor = $80000007
  else
    Text1.FontColor = $80000011
  end if
end if
UpdateWindow()
end function
private function SetPicture(AValue)
FPicture = AValue
SetChecked( FChecked )
end function
private function SetSubMenu(AValue)
FSubMenu = AValue
if Doc <> 0 then
  Doc.Free()
  Doc = 0
end if
if IsLoaded() then
  OnLoad( this )
end if
end function
property submenu read FSubMenu write SetSubMenu
-->
</programe>
</sheet>
<sheet name="MainMenuItem" origin="161,84" bounds="90,74,232,94" visible="false" submenu="">
<text name="Text1" origin="94,75.25" bounds="90,74,232,94" backcolor="$8000000F" pattern="1" border="0" fontname="Arial" fontsize="12" fontcolor="$80000007" textalign="4" text="鏂囦欢(F)"/>
<Framea name="Framea1" origin="178,122" bounds="90,74,232,94" visible="false">
<line name="Line1" origin="178,122" linecolor="$80000014">
<points>
90,94,6
90,74,2
232,74,2
</points>
</line>
<line name="Line2" origin="178,122" linecolor="$80000010">
<points>
90,94,6
232,94,2
232,74,2
</points>
</line>
</Framea>
<杈规