
{*******************************************************}
{                                                       }
{       Graphics Vision Unit                            }
{                                                       }
{	Portions copyright (c) 1992 Borland Intl.       }
{       Copyright (c) 1994 Stefan Milius                }
{	Copyright (c) 1997 Matthias Koeppe              }
{                                                       }
{*******************************************************}

Unit GVMenus;

{$ifndef FPK}
{$A+,B-,D+,F+,G+,O+,R-,S-,X+,I-}
{$endif FPK}

interface

{$ifdef FPK}
uses Objects, Drivers, Views, Memory, BGI, ExtGraph,
  {VgaMem,} GVFPK, GvViews;
{$i fpkdef.pp}
{$else}
{$ifdef Windows}
uses Objects, Drivers, WinGr, Views, GVViews, OMemory, VGAMem;
{$else}
uses Objects, Drivers, Views, GVViews, Memory, VGAMem;
{$endif}
{$endif}

Const

{ Color palettes }

  CMenuView   = #2#3#4#5#6#7#8#9;
  CStatusLine = #2#3#4#5#6#7#8#9;

{ Disabled flags }

  dfDisabled   = $01;
  dfMenuCheck  = $02;
  dfRadio      = $04;
  dfCheckState = $08;
  dfBitmap     = $10;

Type

{ TMenu types }

  TMenuStr = string[31];

  PMenu = ^TMenu;

  PMenuItem = ^TMenuItem;
  TMenuItem = record
    Next: PMenuItem;
    Name: Pointer;     { als Name PString ; als Bitmap Pointer }
    Command: Word;
    Disabled: Byte;
    KeyCode: Word;
    HelpCtx: Word;
    case Integer of
      0: (Param: PString);
      1: (SubMenu: PMenu);
  end;

  TMenu = record
    Items: PMenuItem;
    Default: PMenuItem;
  end;

{ TMenuView object }

  { Palette layout }
  { 1 = Normal text }
  { 2 = Disabled text }
  { 3 = Shortcut text }
  { 4 = Normal selection }
  { 5 = Disabled selection }
  { 6 = Shortcut selection }
  { 7 = Normal background }
  { 8 = Selected background }

  PMenuView = ^TMenuView;
  TMenuView = object(TGView)
    ParentMenu: PMenuView;
    Menu: PMenu;
    Current: PMenuItem;
    constructor Init(var Bounds: TRect);
    constructor Load(var S: TStream);
    procedure DrawItem (Item: PMenuItem); virtual;
    function Execute: Word; virtual;
    function FindItem(Ch: Char): PMenuItem;
    procedure GetItemRect(Item: PMenuItem; var R: TRect); virtual;
    function GetHelpCtx: Word; virtual;
    function GetPalette: PPalette; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    function HotKey(KeyCode: Word): PMenuItem;
    function IsBar: Boolean; virtual;
    function NewSubView(var Bounds: TRect; AMenu: PMenu;
      AParentMenu: PMenuView): PMenuView; virtual;
    procedure Store(var S: TStream);
  private
    OldCurrent: PMenuItem;
    procedure GetRect (Menus: PMenu; var Bounds: TRect);
    procedure SetCheck(I: PMenuItem);
  end;

{ TMenuBar object }

  { Palette layout }
  { 1 = Normal text }
  { 2 = Disabled text }
  { 3 = Shortcut text }
  { 4 = Normal selection }
  { 5 = Disabled selection }
  { 6 = Shortcut selection }
  { 7 = Normal background }
  { 8 = Selected background }

  PMenuBar = ^TMenuBar;
  TMenuBar = object(TMenuView)
    constructor Init(var Bounds: TRect; AMenu: PMenu);
    destructor Done; virtual;
    procedure Draw; virtual;
    procedure DrawItem (Item: PMenuItem); virtual;
    procedure GetItemRect(Item: PMenuItem; var R: TRect); virtual;
    function IsBar: Boolean; virtual;
  end;

{ TMenuBox object }

  { Palette layout }
  { 1 = Normal text }
  { 2 = Disabled text }
  { 3 = Shortcut text }
  { 4 = Normal selection }
  { 5 = Disabled selection }
  { 6 = Shortcut selection }
  { 7 = Normal background }
  { 8 = Selected background }

  PMenuBox = ^TMenuBox;
  TMenuBox = object(TMenuView)
    constructor Init(var Bounds: TRect; AMenu: PMenu;
      AParentMenu: PMenuView);
    procedure Draw; virtual;
    procedure DrawItem (Item: PMenuItem); virtual;
    procedure GetItemRect(Item: PMenuItem; var R: TRect); virtual;
  end;

{ TMenuPopup object }

  { Palette layout }
  { 1 = Normal text }
  { 2 = Disabled text }
  { 3 = Shortcut text }
  { 4 = Normal selection }
  { 5 = Disabled selection }
  { 6 = Shortcut selection }
  { 7 = Normal background }
  { 8 = Selected background }

  PMenuPopup = ^TMenuPopup;
  TMenuPopup = object(TMenuBox)
    constructor Init(var Bounds: TRect; AMenu: PMenu);
    function Execute: Word; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
  end;

{ TStatusItem }

  PStatusItem = ^TStatusItem;
  TStatusItem = record
    Next: PStatusItem;
    Text: PString;
    KeyCode: Word;
    Command: Word;
  end;

{ TStatusDef }

  PStatusDef = ^TStatusDef;
  TStatusDef = record
    Next: PStatusDef;
    Min, Max: Word;
    Items: PStatusItem;
  end;

{ TStatusLine }

  { Palette layout }
  { 1 = Normal text }
  { 2 = Disabled text }
  { 3 = Shortcut text }
  { 4 = Normal selection }
  { 5 = Disabled selection }
  { 6 = Shortcut selection }
  { 7 = Normal background }
  { 8 = Selected background }

  PStatusLine = ^TStatusLine;
  TStatusLine = object(TGView)
    Items: PStatusItem;
    Defs: PStatusDef;
    constructor Init (var Bounds: TRect; ADefs: PStatusDef);
    constructor Load (var S: TStream);
    destructor Done; virtual;
    procedure Draw; virtual;
    function GetPalette: PPalette; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    function Hint (AHelpCtx: Word): String; virtual;
    procedure Store (var S: TStream);
    procedure Update; virtual;
  private
    HelpContext: Word;
    Current: PStatusDef;
    CItem: PStatusItem;
    procedure GetItemRect (Item: PStatusItem; var R: TRect);
    procedure DrawItem (Item: PStatusItem);
    procedure DrawHint;
  end;

{ TMenuItem routines }

function NewItem(const Name, Param: TMenuStr; KeyCode: Word; Command: Word;
  AHelpCtx: Word; Next: PMenuItem): PMenuItem;
function NewBitmap(Image: Pointer; KeyCode: Word; Command: Word;
  AHelpCtx: Word; Next: PMenuItem): PMenuItem;
function NewLine(Next: PMenuItem): PMenuItem;
function NewSubMenu(const Name: TMenuStr; AHelpCtx: Word; SubMenu: PMenu;
  Next: PMenuItem): PMenuItem;
function NewBmpSubMenu(Image: Pointer; AHelpCtx: Word; SubMenu: PMenu;
  Next: PMenuItem): PMenuItem;

function NewCheckItem(const Name, Param: TMenuStr; KeyCode, Command, AHelpCtx: Word;
  ADisabled: Byte; Next: PMenuItem): PMenuItem;
function NewBmpCheckItem(Image: pointer; KeyCode, Command, AHelpCtx: Word;
  ADisabled: Byte; Next: PMenuItem): PMenuItem;

{ TMenu routines }

function NewMenu(Items: PMenuItem): PMenu;
procedure DisposeMenu(Menu: PMenu);

const
  dfByCommand = $000;
  dfByPosition = $100;

function LookUpMenu(Menu: PMenu; idCheckItem: Word; Flags: Word): PMenuItem;
function SetMenuState(Menu: PMenu; idCheckItem: Word; Check: Word): Word;
function ChangeMenuState(Menu: PMenu; idCheckItem: Word;
  Check: Word; Enable: Boolean): Word;
function GetMenuState(Menu: PMenu; idCheckItem: Word; Flags: Word): Word;

{ TStatusLine routines }

function NewStatusDef(AMin, AMax: Word; AItems: PStatusItem;
  ANext: PStatusDef): PStatusDef;
function NewStatusKey(const AText: String; AKeyCode: Word; ACommand: Word;
  ANext: PStatusItem): PStatusItem;

{ GVMenus registration procedure }

procedure RegisterGVMenus;

const

{ Stream registration records }

  RMenuBar: TStreamRec = (
     ObjType: 141;
     VmtLink: Ofs(TypeOf(TMenuBar)^);
     Load:    @TMenuBar.Load;
     Store:   @TMenuBar.Store);

  RMenuBox: TStreamRec = (
     ObjType: 142;
     VmtLink: Ofs(TypeOf(TMenuBox)^);
     Load:    @TMenuBox.Load;
     Store:   @TMenuBox.Store);

  RStatusLine: TStreamRec = (
     ObjType: 143;
     VmtLink: Ofs(TypeOf(TStatusLine)^);
     Load:    @TStatusLine.Load;
     Store:   @TStatusLine.Store);

  RMenuPopup: TStreamRec = (
     ObjType: 144;
     VmtLink: Ofs(TypeOf(TMenuPopup)^);
     Load:    @TMenuPopup.Load;
     Store:   @TMenuPopup.Store);

implementation

{$ifdef FPK}
{$else}
{$ifdef Windows}
uses ExtGraph {, GvApp};
{$else}
uses Crt, Gr, MetaGr, ExtGraph, GVDriver, MyFonts{, GvApp};
{$endif}
{$endif}

(************************** TMenuView object ********************************)

constructor TMenuView.Init(var Bounds: TRect);
Begin
  TGView.Init (Bounds);
  EventMask := EventMask or evBroadcast;
End;

constructor TMenuView.Load(var S: TStream);

 procedure LoadMenu (var Menus: PMenu);
 var Item: PMenuItem;
 Begin
   New (Menus^.Items);
   Item:=Menus^.Items;
   Menus^.Default:=Item;
   While Item<>nil do Begin
     S.Read (Item^.Disabled, SizeOf (Item^.Disabled));
     If Item^.Disabled and dfBitmap <> 0
       then Item^.Name := LoadImage(S)
       else Item^.Name := S.ReadStr;
     S.Read (Item^.Next, SizeOf (Item^.Next));
     S.Read (Item^.Command, SizeOf (Item^.Command));
     S.Read (Item^.KeyCode, SizeOf (Item^.KeyCode));
     S.Read (Item^.HelpCtx, SizeOf (Item^.HelpCtx));
     If (Item^.Command=0) and (Item^.Name<>nil) then Begin
       New (Item^.SubMenu);
       LoadMenu (Item^.SubMenu);
     End
     Else Item^.Param:=S.ReadStr;
     If Item^.Next<>nil then Begin
       New (Item^.Next);
       Item:=Item^.Next;
     End
     Else Item:=nil;
   End;
 End;

Begin
  TGView.Load (S);
  New (Menu);
  LoadMenu (Menu);
End;

procedure TMenuView.DrawItem(Item: PMenuItem);
Begin
  Abstract;
End;

function TMenuView.Execute: Word;
type
  MenuAction = (DoNothing, DoSelect, DoReturn);
var
  AutoSelect: Boolean;
  Action: MenuAction;
  Ch: Char;
  Result_: Word;
  ItemShown, P: PMenuItem;
  Target: PMenuView;
  TargetGroup: PGGroup;
  R: TRect;
  E: TEvent;
  MouseActive: Boolean;

procedure TrackMouse;
var
  Mouse: TPoint;
  R: TRect;
begin
  MakeLocal(E.Where, Mouse);
  Current := Menu^.Items;
  while Current <> nil do
  begin
    GetItemRect(Current, R);
    if R.Contains(Mouse) then
    begin
      MouseActive := True;
      Exit;
    end;
    Current := Current^.Next;
  end;
end;

procedure TrackKey(FindNext: Boolean);

procedure NextItem;
begin
  Current := Current^.Next;
  if Current = nil then Current := Menu^.Items;
end;

procedure PrevItem;
var
  P: PMenuItem;
begin
  P := Current;
  if P = Menu^.Items then P := nil;
  repeat
{$ifdef FPK} {bug 0.9.4, cf.  tlocloc.pp}
    Current := Current^.Next;
    if Current = nil then Current := Menu^.Items;
{$else}
    NextItem
{$endif}
  until Current^.Next = P;
end;

begin
  if Current <> nil then
    repeat
      if FindNext then NextItem else PrevItem;
    until Current^.Name <> nil;
end;

function MouseInOwner: Boolean;
var
  Mouse: TPoint;
  R: TRect;
begin
  MouseInOwner := False;
  if (ParentMenu <> nil) and (ParentMenu^.IsBar) then
  begin
    ParentMenu^.MakeLocal(E.Where, Mouse);
    ParentMenu^.GetItemRect(ParentMenu^.Current, R);
    MouseInOwner := R.Contains(Mouse);
  end;
end;

function MouseInMenus: Boolean;
var
  P: PMenuView;
begin
  P := ParentMenu;
  while (P <> nil) and not P^.MouseInView(E.Where) do P := P^.ParentMenu;
  MouseInMenus := P <> nil;
end;

function TopMenu: PMenuView;
var
  P: PMenuView;
begin
  P := @Self;
  while P^.ParentMenu <> nil do P := P^.ParentMenu;
  TopMenu := P;
end;

begin
  AutoSelect := False;
  Result_ := 0;
  ItemShown := nil;
  Current := Menu^.Default;
  MouseActive := False;
  repeat
    Action := DoNothing;
    GetEvent(E);
    case E.What of
      evMouseDown:
	if MouseInView(E.Where) or MouseInOwner then
        begin
	  TrackMouse;
	  if IsBar then AutoSelect := True;
	end else Action := DoReturn;
      evMouseUp:
	begin
	  TrackMouse;
	  if MouseInOwner then
	    Current := Menu^.Default
	  else
	    {if (Current <> nil) and (Current^.Name <> nil) then
	      Action := DoSelect}
	 {} if Current <> nil then
	      if Current^.Name = nil
	      then begin
		Action := DoNothing;
		Current := Menu^.Default
	      end
	      else Action := DoSelect {}
	    else
	      if MouseActive or MouseInView(E.Where) then Action := DoReturn
	      else
	      begin
		Current := Menu^.Default;
		if Current = nil then Current := Menu^.Items;
		Action := DoNothing;
	      end;
	end;
      evMouseMove:
	if E.Buttons <> 0 then
	begin
	  TrackMouse;
	  if not (MouseInView(E.Where) or MouseInOwner) and
	    MouseInMenus then Action := DoReturn;
	end;
      evKeyDown:
	case CtrlToArrow(E.KeyCode) of
{$ifdef CALC_BOOL_PARAM_PROBLEM}
	  kbUp, kbDown:
	    if not IsBar then
	      TrackKey(Equal(CtrlToArrow(E.KeyCode), kbDown)) else
	      if E.KeyCode = kbDown then AutoSelect := True;
	  kbLeft, kbRight:
	    if ParentMenu = nil then
	      TrackKey(Equal(CtrlToArrow(E.KeyCode), kbRight)) else
	      Action := DoReturn;
{$else}
	  kbUp, kbDown:
	    if not IsBar then
	      TrackKey(CtrlToArrow(E.KeyCode) = kbDown) else
	      if E.KeyCode = kbDown then AutoSelect := True;
	  kbLeft, kbRight:
	    if ParentMenu = nil then
	      TrackKey(CtrlToArrow(E.KeyCode) = kbRight) else
	      Action := DoReturn;
{$endif}
	  kbHome, kbEnd:
	    if not IsBar then
            begin
	      Current := Menu^.Items;
              if E.KeyCode = kbEnd then TrackKey(False);
            end;
	  kbEnter:
	    begin
	      if IsBar then AutoSelect := True;
	      Action := DoSelect;
	    end;
	  kbEsc:
	    begin
	      Action := DoReturn;
	      if (ParentMenu = nil) or (not ParentMenu^.IsBar) then
		ClearEvent(E);
	    end;
	  else begin
	    Target := @Self;
	    Ch := GetAltChar(E.KeyCode);
	    if Ch = #0 then Ch := E.CharCode else Target := TopMenu;
	    P := Target^.FindItem(Ch);
	    if P = nil then
	    begin
	      P := TopMenu^.HotKey(E.KeyCode);
	      if (P <> nil) and CommandEnabled(P^.Command) then
	      begin
		Result_ := P^.Command;
		If P^.Disabled and dfMenuCheck <> 0 then
		  P^.Disabled := P^.Disabled xor dfCheckState;
		Action := DoReturn;
	      end
	    end else
	      if Target = @Self then
	      begin
		if IsBar then AutoSelect := True;
		Action := DoSelect;
		Current := P;
	      end else
		if (ParentMenu <> Target) or (ParentMenu^.Current <> P) then
		  Action := DoReturn;
	  end
	end;
      evCommand:
	if E.Command = cmMenu then
	begin
	  AutoSelect := False;
	  if ParentMenu <> nil then Action := DoReturn;
	end else Action := DoReturn;
    end;
    if ItemShown <> Current then
    begin
      SetViewport;
      OldCurrent := ItemShown;
      DrawItem(ItemShown);
      DrawItem(Current);
      OldCurrent := nil;
      RestoreViewport;
      ItemShown := Current;
    end;
    if (Action = DoSelect) or ((Action = DoNothing) and AutoSelect) then
      if Current <> nil then with Current^ do if Name <> nil then
	if Command = 0 then
	begin
	  if E.What and (evMouseDown + evMouseMove) <> 0 then PutEvent(E);
	  GetItemRect(Current, R);
	{ slight changes, for window menubar support }
	  TargetGroup := ApplicationGroup {Application}; { TV: Owner }
	  R.A.Y := R.B.Y;
	  MakeGlobal(R.A, R.A);
	  TargetGroup^.MakeLocal(R.A, R.A);
	  R.B := TargetGroup^.Size;
	  If IsBar
	  then Dec(R.A.X, 2)
	  else Inc(R.A.X, 2);
	  Target := TopMenu^.NewSubView(R, SubMenu, @Self);
	  Result_ := TargetGroup^.ExecView(Target);
	{ /changes }
	  Dispose(Target, Done);
	end else
	if Action = DoSelect
	then begin
	  Result_ := Command;
	  SetCheck(Current)
	end;
    if (Result_ <> 0) and CommandEnabled(Result_) then
    begin
      Action := DoReturn;
      ClearEvent(E);
    end
    else
      Result_ := 0;
  until Action = DoReturn;
  if E.What <> evNothing then
    if (ParentMenu <> nil) or (E.What = evCommand)
    then PutEvent(E);
  if Current <> nil then
  begin
    Menu^.Default := Current;
    OldCurrent := Current;
    Current := nil;
    DrawItem(OldCurrent);
    OldCurrent := nil
  end;
  Execute := Result_;
end;

function TMenuView.FindItem(Ch: Char): PMenuItem;
var Item: PMenuItem;
Begin
  Item:=Menu^.Items;
  While Item<>nil do Begin
    If (Item^.Name<>nil)
      and (Ord(GetShortCut (PString(Item^.Name)^))=Ord(Upcase(Ch))) then
       If Item^.Disabled and dfDisabled <> 0 then Begin
	 FindItem:=nil; Exit
       End else Begin FindItem:=Item; Exit End;
    Item:=Item^.Next;
  End;
  FindItem:=nil;
End;

procedure TMenuView.GetItemRect(Item: PMenuItem; var R: TRect);
Begin
  Abstract;
End;

function TMenuView.GetHelpCtx: Word;
var Help: Word;
Begin
  If (Current<>nil) and (Current^.HelpCtx<>hcNoContext) then
    Help:=Current^.HelpCtx
  Else If ParentMenu<>nil then Help:=ParentMenu^.GetHelpCtx
			  else Help:=hcNoContext;
  GetHelpCtx:=Help;
End;

function TMenuView.GetPalette: PPalette;
Const
  P:String [Length (CMenuView)]=CMenuView;
Begin
  GetPalette:=@P
End;

Procedure TMenuView.GetRect (Menus: PMenu; var Bounds: TRect);
var Item: PMenuItem;
    L, N, P: Word;
    S: TPoint;

 function GetLength (Item: PString): Word;
 Begin
   If Item<>nil then GetLength:=TextWidth(Item^)
		else GetLength:=0;
 End;

Begin
  Item:=Menus^.Items;
  L:=0;
  SetTextParams (ftSystem,0,0,False);
  Bounds.Assign (0,0,0,0);
  While Item<>nil do Begin
    If Item^.Name <> nil then
      If Item^.Disabled and dfBitmap <> 0 then Begin
	GetImageExtent(Item^.Name, S);
        If Item^.Command = 0 then Inc(S.X, 12);
        If S.X + 4 > L then L := S.X + 4;
        Inc(Bounds.B.Y, S.Y + 5);
      End
      else Begin
        N := GetLength(PString(Item^.Name));
        If Item^.Command<>0 then Begin
           P := GetLength(Item^.Param);
          If N + P + 10 > L then  L := N + P + 10;
        End
        Else If N + 12 > L then L := N + 12;
        Inc (Bounds.B.Y,20);
      End
    Else Inc(Bounds.B.Y, 7);
    Item:=Item^.Next;
  End;
  Bounds.B.X := L + 3 + 2 * 16; { Rand fr Haken }
  Inc (Bounds.B.Y,3);
End;

procedure TMenuView.HandleEvent(var Event: TEvent);
var
  P: PMenuItem;

	procedure ChangeCommands;
	var F: Byte;

	 procedure ChangeCommandMenu (Menus: PMenu);
	 var Item: PMenuItem;
	 Begin
	   Item:=Menus^.Items;
	   While Item<>nil do Begin
	     If (Item^.Name <> nil) and (Hi (Item^.Command)=0) and
		(Item^.Command<>0) then Begin
	       If not CommandEnabled (Lo (Item^.Command)) and
		  (Item^.Disabled and dfDisabled = 0) then Begin
		 Item^.Disabled:=Item^.Disabled or dfDisabled;
		 If Exposed and (F=0) then DrawItem (Item);
               End;
               If CommandEnabled (Lo (Item^.Command)) and
	          (Item^.Disabled and dfDisabled <> 0) then Begin
		 Item^.Disabled:=Item^.Disabled and not dfDisabled;
		 If Exposed and (F=0) then DrawItem (Item);
               End;
             End;
	     If (Item^.Command=0) and (Item^.Name<>nil) then Begin
               Inc (F);
	       ChangeCommandMenu (Item^.SubMenu);
               Dec (F);
             End;
	     Item:=Item^.Next;
           End;
	 End;

        Begin
          F:=0;
	  If ParentMenu<>nil then Exit;
          ChangeCommandMenu (Menu);
        End;

        {procedure UpdateMenu(Menu: PMenu);
	var
	  P: PMenuItem;
          CommandState: Boolean;
        begin
          P := Menu^.Items;
          while P <> nil do
	  begin
	    if P^.Name <> nil then
              if P^.Command = 0 then UpdateMenu(P^.SubMenu)
              else
              begin
	        CommandState := CommandEnabled(P^.Command);
	        if Boolean(P^.Disabled and dfDisabled) = CommandState then
		begin
		  P^.Disabled := (P^.Disabled and not dfDisabled) or Byte(not CommandState);
		  CallDraw := True;
	        end;
              end;
            P := P^.Next;
          end;
	end;}

	procedure DoSelect;
	begin
	  PutEvent(Event);
	  Event.Command := GOwner^.ExecView(@Self);
	  if (Event.Command <> 0) and CommandEnabled(Event.Command) then
	  begin
	    Event.What := evCommand;
	    Event.InfoPtr := nil;
	    PutEvent(Event);
	  end;
	  ClearEvent(Event);
	end;

	procedure PositionalCtx;
	var
	  Mouse: TPoint;
	  R: TRect;
	  P: PMenuItem;
	begin
	  MakeLocal(Event.Where, Mouse);
	  P := Menu^.Items;
	  while P <> nil do
	  begin
	    GetItemRect(P, R);
	    if R.Contains(Mouse) then
	    begin
	      If P^.HelpCtx <> 0
	      then begin
		Event.What := evNothing;
		Event.InfoLong := P^.HelpCtx
	      end;
	      Exit;
	    end;
	    P := P^.Next;
	  end;
	end;

begin
  if Menu <> nil then
    case Event.What of
      evMouseDown:
	DoSelect;
      evKeyDown:
	if (FindItem(GetAltChar(Event.KeyCode)) <> nil) then
	  DoSelect
	else
	begin
	  P := HotKey(Event.KeyCode);
	  if (P <> nil) and (CommandEnabled(P^.Command)) then
	  begin
	    If P^.Disabled and dfMenuCheck <> 0 then
	      P^.Disabled := P^.Disabled xor dfCheckState;

	    Event.What := evCommand;
	    Event.Command := P^.Command;
	    Event.InfoPtr := nil;
	    PutEvent(Event);
	    ClearEvent(Event);
	  end;
	end;
      evCommand:
	if Event.Command = cmMenu then DoSelect;
      evBroadcast:
	if Event.Command = cmCommandSetChanged then
	begin
	  {CallDraw := False;
	  UpdateMenu(Menu);
	  if CallDraw then DrawView;}
	  ChangeCommands
	end;
      evPositionalCtx:
	PositionalCtx;
    end;
  inherited HandleEvent(Event);
end;

function TMenuView.HotKey(KeyCode: Word): PMenuItem;

function FindHotKey(P: PMenuItem): PMenuItem;
var
  T: PMenuItem;
begin
  while P <> nil do
  begin
    if P^.Name <> nil then
      if P^.Command = 0 then
      begin
	T := FindHotKey(P^.SubMenu^.Items);
	if T <> nil then
	begin
	  FindHotKey := T;
	  Exit;
	end;
      end
      else if (P^.Disabled and dfDisabled = 0) and (P^.KeyCode <> kbNoKey) and
	(P^.KeyCode = KeyCode) then
      begin
	FindHotKey := P;
	Exit;
      end;
    P := P^.Next;
  end;
  FindHotKey := nil;
end;

begin
  HotKey := FindHotKey(Menu^.Items);
end;

procedure TMenuView.SetCheck(I: PMenuItem);
var It: PMenuItem;
Begin
  With I^ do Begin
    If Disabled and dfMenuCheck = 0 then Exit;
    If Disabled and dfRadio <> 0 then Begin
      It := Menu^.Items;
      While It <> nil do Begin
	If It^.Disabled and (dfMenuCheck+dfRadio) = dfMenuCheck + dfRadio then
	  It^.Disabled := It^.Disabled and not dfCheckState;
	It := It^.Next;
      End;
      Disabled := Disabled or dfCheckState;
    End
    Else If Disabled and dfCheckState <> 0 then
	   Disabled := Disabled and not dfCheckState
	 else Disabled := Disabled or dfCheckState;
  End;
End;

function TMenuView.IsBar: Boolean;
begin
  IsBar := false
end;

function TMenuView.NewSubView(var Bounds: TRect; AMenu: PMenu;
  AParentMenu: PMenuView): PMenuView;
var MenuView: PMenuView;
Begin
  MenuView:=New (PMenuBox,Init (Bounds,AMenu,AParentMenu));
  MenuView^.OldCurrent:=MenuView^.Menu^.Default;
  NewSubView:=MenuView;
End;

procedure TMenuView.Store(var S: TStream);

 procedure StoreMenu (Menus: PMenu);
 var Item: PMenuItem;
 Begin
   Item:=Menus^.Items;
   While Item<>nil do Begin
     S.Write (Item^.Disabled, SizeOf (Item^.Disabled));
     If Item^.Disabled and dfBitmap <> 0
       then StoreImage(S, Item^.Name)
       else S.WriteStr (PString(Item^.Name));
     S.Write (Item^.Next, SizeOf (Item^.Next));
     S.Write (Item^.Command, SizeOf (Item^.Command));
     S.Write (Item^.KeyCode, SizeOf (Item^.KeyCode));
     S.Write (Item^.HelpCtx, SizeOf (Item^.HelpCtx));
     If (Item^.Command=0) and (Item^.Name<>nil) then StoreMenu (Item^.SubMenu)
						else S.WriteStr (Item^.Param);
     Item:=Item^.Next;
   End;
 End;

Begin
  TGView.Store (S);
  StoreMenu (Menu);
End;

(*************************** TMenuBar object ********************************)

constructor TMenuBar.Init(var Bounds: TRect; AMenu: PMenu);
Begin
  TMenuView.Init (Bounds);
  GrowMode:=GrowMode or gfGrowHiX;
  Options:=Options or ofPreProcess;
  ParentMenu:=nil;
  Menu:=AMenu;
  OldCurrent:=Menu^.Default;
End;

destructor TMenuBar.Done;
Begin
  DisposeMenu (Menu);
  inherited Done;
End;

procedure TMenuBar.Draw;
var Item: PMenuItem;
Begin
  Item:=Menu^.Items;
  SetFillStyle (SolidFill, GetColor (7));
  Bar (0, 0, Size.X-1, Size.Y-1);
  SetColor (Black);
  HoriLine (0, Size.Y-1, Size.X-1);
  While Item<>nil do Begin
    If Item <> Current then DrawItem (Item);
    Item:=Item^.Next;
  End;
  If Current <> nil then DrawItem(Current)
End;

procedure TMenuBar.DrawItem(Item: PMenuItem);
var ItemRect: TRect;
    Col1, Col2: Byte;
Begin
  If Item=nil then Exit;
  SetViewport;
  GetItemRect (Item,ItemRect);
  If Item=Current then Begin
    If Item^.Disabled and dfDisabled <> 0 then Begin Col1:=GetColor (5); Col2:=Col1 End
      else Begin Col1:=GetColor (4); Col2:=GetColor (6); End;
    SetFillStyle (SolidFill, GetColor (8));
  End
  Else Begin
    If Item^.Disabled and dfDisabled <> 0 then Begin Col1:=GetColor (2); Col2:=Col1 End
      else Begin Col1:=GetColor (1); Col2:=GetColor (3) End;
    SetFillStyle (SolidFill, GetColor (7));
  End;
  With ItemRect do
    If (Current = nil) or (Item = Current) or
       (OldCurrent = Item) then Bar (A.X-2, A.Y, B.X+1, B.Y-1)
    Else Bar (A.X, A.Y, B.X-1, B.Y-1);
  SetTextParams(ftSystem, 0, Col1 + Col2 shl 8, true);
  SetTextJustify(CenterText, CenterText);
  With ItemRect do Begin
    If Item^.Disabled and dfBitmap <> 0 then
      PutImage(A.X + 6, A.Y, Item^.Name^, NormalPut)
    Else Begin
      Dec(B.Y, A.Y); Dec(B.X, A.X);
      OutTextXY(A.X + B.X div 2, A.Y + B.Y div 2, PString(Item^.Name)^);
    End;
  End;
  RestoreViewport
End;

procedure TMenuBar.GetItemRect(Item: PMenuItem; var R: TRect);
var I: PMenuItem;
    J: Integer;
    S: Integer;
    Extent: TPoint;
Begin
  SetTextParams (ftSystem,0,0,True);
  I:=Menu^.Items;
  J:=6;
  While I<>Item do Begin
    If I^.Disabled and dfBitmap <> 0
    then begin
      GetImageExtent(I^.Name, Extent);
      Inc(J, Extent.x + 12)
    end
    else Inc (J, TextWidth (PString(I^.Name)^)+12);
    I:=I^.Next;
  End;
  If Item^.Disabled and dfBitmap <> 0
  then begin
    GetImageExtent(Item^.Name, Extent);
    S := Extent.x
  end
  else S := TextWidth(PString(Item^.Name)^);
  R.Assign (J, 0, J + S + 12, Size.Y-1);
End;

function TMenuBar.IsBar: Boolean;
begin
  IsBar := true
end;

(*************************** TMenuBox object ********************************)

constructor TMenuBox.Init(var Bounds: TRect; AMenu: PMenu;
  AParentMenu: PMenuView);
var R: TRect;
Begin
  GetRect (AMenu, R);
  R.Move(Bounds.A.X, Bounds.A.Y);
  Bounds := R;
  If Bounds.B.X >= ApplicationGroup^.Size.X then
    Bounds.Move (ApplicationGroup^.Size.X-1-Bounds.B.X,0);
  TMenuView.Init (Bounds);
  Options:=Options or (ofPreProcess + ofStoreBack);
  ParentMenu:=AParentMenu;
  Menu:=AMenu;
End;

procedure TMenuBox.Draw;
var Item: PMenuItem;
Begin
  Item:=Menu^.Items;
  SetColor (Black);
  RectAngle (0, 0, Size.X-2, Size.Y-2);
  SetColor (DarkGray);
  HoriLine (0, Size.Y-1, Size.X-1);
  VertLine (Size.X-1, 0, Size.Y-1);
  While Item<>nil do Begin
    DrawItem (Item);
    Item:=Item^.Next;
  End;
End;

procedure TMenuBox.DrawItem(Item: PMenuItem);
var ItemRect: TRect;
    HelpItem: PMenuItem;
    Col1, Col2, Count: Byte;
Begin
  If Item=nil then Exit;
  SetViewport;
  Count:=0;
  HelpItem:=Menu^.Items;
  While HelpItem<>Item do Begin Inc (Count); HelpItem:=HelpItem^.Next End;
  GetItemRect (Item,ItemRect);
  If (Item=Current) and (Item^.Name <> nil) then Begin
    If Item^.Disabled and dfDisabled <> 0 then Begin Col1:=GetColor (5); Col2:=Col1 End
      else Begin Col1:=GetColor (4); Col2:=GetColor (6); End;
    SetFillStyle (SolidFill, GetColor (8));
  End
  Else Begin
    If (Item^.Name <> nil) and (Item^.Disabled and dfDisabled <> 0) then Begin
      Col1:=GetColor (2); Col2:=Col1
    End
    Else Begin Col1:=GetColor (1); Col2:=GetColor (3) End;
    SetFillStyle (SolidFill, GetColor (7));
  End;
  If Item^.Name <> nil then Begin
    With ItemRect do Begin
      Bar (A.X, A.Y, B.X-1, B.Y-1);
      If Item^.Disabled and (dfMenuCheck+dfCheckState) = dfMenuCheck+dfCheckState
        then DrawColIcon(A.X, A.Y + (B.Y - A.Y) div 2 - 8, 24, Col1);
    End;
    If Item^.Disabled and dfBitmap <> 0 then Begin
      PasteImage(ItemRect.A.X + 18, ItemRect.A.Y + 2, Item^.Name, NormalPut);
      If Item^.Command = 0 then DrawColIcon(ItemRect.B.X - 10, ItemRect.A.Y, 16, Col1);
    End else Begin
      SetTextParams(ftSystem, 0, Col1 + Col2 shl 8, true);
      SetTextJustify(LeftText, CenterText);
      With ItemRect do Begin
        Dec(B.Y, A.Y);
        Inc (A.X, 16); { Rand fr Haken }
        Dec (B.X, 16);
        OutTextXY(A.X, A.Y + B.Y div 2, PString(Item^.Name)^);
      End;
      If Item^.Command=0 then Begin
        DrawColIcon (ItemRect.B.X+6, ItemRect.A.Y, 16, Col1)
      End
      Else If Item^.Param<>nil then With ItemRect do Begin
        SetTextJustify(RightText, CenterText);
        OutTextXY(B.X - 2, A.Y + B.Y div 2, Item^.Param^);
      End;
    End
  End
  Else Begin
    With ItemRect do
      Bar (A.X, A.Y, B.X-1, B.Y-1);
    SetColor (GetColor (1));
    ItemRect.A.Y:=ItemRect.A.Y + (ItemRect.B.Y-ItemRect.A.Y) div 2;
    HoriLine (ItemRect.A.X,ItemRect.A.Y,ItemRect.B.X-1);
  End;
  RestoreViewport
End;

procedure TMenuBox.GetItemRect(Item: PMenuItem; var R: TRect);
var I: PMenuItem;
    J: Integer;
    Extent: TPoint;
Begin
  I:=Menu^.Items;
  J:=1;
  While I<>Item do Begin
    If I^.Name <> nil then
      If I^.Disabled and dfBitmap <> 0
      then begin
        GetImageExtent(I^.Name, Extent);
        Inc(J, Extent.y + 5)
      end
      else Inc (J, 20)
    else Inc (J, 7);
    I:=I^.Next;
  End;
  If Item^.Name <> nil then
    If Item^.Disabled and dfBitmap <> 0
    then begin
      GetImageExtent(Item^.Name, Extent);
      R.Assign(1, J, Size.X - 2, J + Extent.y + 5)
    end
    else R.Assign (1, J, Size.X-2, J+20)
  else R.Assign (1, J, Size.X-2, J+7)
End;

(****************************** TMenuPopup object ***************************)

constructor TMenuPopup.Init(var Bounds: TRect; AMenu: PMenu);
Begin
  TMenuBox.Init(Bounds, AMenu, nil);
End;

function TMenuPopup.Execute: Word;
var
  Res: Word;
  Event: TEvent;
begin
  Res := inherited Execute;
  If Res <> 0
  then begin
    Event.What := evCommand;
    Event.Command := Res;
    Event.InfoPtr := nil;
    PutEvent(Event)
  end;
  Execute := Res
end;

procedure TMenuPopup.HandleEvent(var Event: TEvent);
var
  P: PMenuItem;
begin
  case Event.What of
    evKeyDown:
      begin
	P := FindItem(GetCtrlChar(Event.KeyCode));
        if P = nil then
	  P := HotKey(Event.KeyCode);
	if (P <> nil) and (CommandEnabled(P^.Command)) then
        begin
          If P^.Disabled and dfMenuCheck <> 0 then
            P^.Disabled := P^.Disabled xor dfCheckState;
          Event.What := evCommand;
	  Event.Command := P^.Command;
	  Event.InfoPtr := nil;
          PutEvent(Event);
          ClearEvent(Event);
        end
        else
          if GetAltChar(Event.KeyCode) <> #0 then
	    ClearEvent(Event);
      end;
  end;
  inherited HandleEvent(Event);
end;

(****************************** TStatusLine object **************************)

constructor TStatusLine.Init(var Bounds: TRect; ADefs: PStatusDef);
Begin
  TGView.Init (Bounds);
  Options:=Options or ofPreProcess;
  EventMask := EventMask or evBroadcast;
  GrowMode:=gfGrowLoY + gfGrowHiX + gfGrowHiY;
  Defs:=ADefs;
  Current := Defs;
  While (Current <> nil) and (Current^.Min <> hcNoContext) do
    Current := Current^.Next;
  If Current=nil then Items:=nil
                 else Items:=Current^.Items;
  HelpContext:=hcNoContext;
  CItem:=nil;
End;

constructor TStatusLine.Load(var S: TStream);
var Def: PStatusDef;

 procedure ReadStatusItem (var Item: PStatusItem);
 var I: PStatusItem;
 Begin
   S.Read (I, SizeOf (I));
   If I<>nil then I:=Item
             else Begin Dispose (Item); Item:=nil End;
   While I<>nil do Begin
     I^.Text:=S.ReadStr;
     S.Read (I^.KeyCode, SizeOf (I^.KeyCode));
     S.Read (I^.Command, SizeOf (I^.Command));
     S.Read (I^.Next, SizeOf (I^.Next));
     If I^.Next<>nil then Begin
       New (I^.Next);
       I:=I^.Next;
     End
     Else I:=nil;
   End;
 End;

Begin
  TGView.Load (S);
  S.Read (Def, SizeOf (Def));
  If Def<>nil then Begin
    New (Defs);
    Def:=Defs;
    While Def<>nil do Begin
      S.Read (Def^.Min, SizeOf (Def^.Min));
      S.Read (Def^.Max, SizeOf (Def^.Max));
      S.Read (Def^.Next, SizeOf (Def^.Next));
      New (Def^.Items);
      ReadStatusItem (Def^.Items);
      If Def^.Next<>nil then Begin
        New (Def^.Next);
        Def:=Def^.Next;
      End
      Else Def:=nil;
    End;
    Items:=Defs^.Items;
  End
  Else Begin Defs:=nil; Items:=nil End;
  Current:=Defs;
  HelpContext:=hcNoContext;
  CItem:=nil;
End;

destructor TStatusLine.Done;

 procedure FreeStatusItem (var Item: PStatusItem);
 Begin
   If Item=nil then Exit;
   If Item^.Next<>nil then FreeStatusItem (Item^.Next);
   DisposeStr (Item^.Text);
   Dispose (Item);
 End;

 procedure FreeStatusDef (var Def: PStatusDef);
 Begin
   If Def^.Next<>nil then FreeStatusDef (Def^.Next);
   FreeStatusItem (Def^.Items);
   Dispose (Def);
 End;

Begin
  FreeStatusDef (Defs);
  TGView.Done;
End;

procedure TStatusLine.Draw;
var Item: PStatusItem;
Begin
  SetFillStyle (SolidFill, GetColor (7));
  Bar (0, 0, Size.X-1, Size.Y-1);
  SetColor (Black);
  HoriLine (0, 0, Size.X-1);
  Item:=Items;
  While Item<>nil do Begin
    DrawItem (Item);
    Item:=Item^.Next
  End;
  DrawHint;
End;

function TStatusLine.GetPalette: PPalette;
Const P: String [Length (CStatusLine)] = CStatusLine;
Begin
  GetPalette:=@P;
End;

procedure TStatusLine.HandleEvent(var Event: TEvent);
var Flag: Boolean;
    R: TRect;
    EvWhere: TPoint;
    Item, Old: PStatusItem;
    Command: Word;

Begin
  TGView.HandleEvent (Event);
  Command:=0;
  If (Event.What=evMouseDown) and MouseInView (Event.Where) then Begin
    Repeat
      If not MouseInView (Event.Where) and (CItem<>nil) then Begin
        Old:=CItem;
        CItem:=nil;
        If (Old <> nil) and (Old^.Text<>nil) then Begin
	  DrawItem (Old);
	End;
      End
      Else Begin
        Item:=Items;
	Flag:=False;
        While Item<>nil do Begin
          GetItemRect (Item,R);
          MakeLocal (Event.Where,EvWhere);
          If R.Contains (EvWhere) then Begin
	    Flag:=True;
	    If CItem<>Item then Begin
              Old:=CItem;
	      CItem:=Item;
	      SetViewPort;
	      If (Item<>nil) and (Item^.Text<>nil) then DrawItem (Old);
	      DrawItem (Item);
	      RestoreViewPort;
	    End;
          End;
          Item:=Item^.Next;
	End;
        If not Flag then Begin
          Old:=CItem;
          CItem:=nil;
	  DrawItem (Old);
	End;
      End;
    Until not MouseEvent (Event, evMouseMove+evMouseAuto);
    If CItem = nil
      then Command := 0
      else Command:=CItem^.Command;
    Old:=CItem;
    CItem:=nil;
    DrawItem (Old);
  End;
  If Event.What=evKeyBoard then Begin
    Item:=Items;
    While Item<>nil do Begin
      If Item^.KeyCode=Event.KeyCode then Command:=Item^.Command;
      Item:=Item^.Next;
    End;
  End;
  If (Event.What=evBroadCast) and (Event.Command=cmCommandSetChanged) then
    DrawView;
  If (Command<>0) and ((Command>255) or CommandEnabled (Command)) then Begin
    Event.What:=evCommand;
    Event.Command:=Command;
    Event.InfoPtr:=nil;
    PutEvent (Event);
    ClearEvent (Event);
  End
{  Else If (Event.What and evMouse<>0) and MouseInView (Event.Where) then
	 ClearEvent (Event);}
End;

function TStatusLine.Hint(AHelpCtx: Word): String;
Begin
  Hint:='';
End;

procedure TStatusLine.Store(var S: TStream);
var Def: PStatusDef;

 procedure WriteStatusItem (Item: PStatusItem);
 Begin
   S.Write (Item, SizeOf (Item));
   While Item<>nil do Begin
     S.WriteStr (Item^.Text);
     S.Write (Item^.KeyCode, SizeOf (Item^.KeyCode));
     S.Write (Item^.Command, SizeOf (Item^.Command));
     S.Write (Item^.Next, SizeOf (Item^.Next));
     Item:=Item^.Next;
   End;
 End;

Begin
  TGView.Store (S);
  Def:=Defs;
  S.Write (Def, SizeOf (Def));
  While Def<>nil do Begin
    S.Write (Def^.Min, SizeOf (Def^.Min));
    S.Write (Def^.Max, SizeOf (Def^.Max));
    S.Write (Def^.Next, SizeOf (Def^.Next));
    WriteStatusItem (Def^.Items);
    Def:=Def^.Next;
  End;
End;

procedure TStatusLine.UpDate;
var Def, Old: PStatusDef;
Begin
  If GOwner=nil then Exit;
  If HelpContext<>GOwner^.GetHelpCtx then Begin
    HelpContext:=GOwner^.GetHelpCtx;
    Old:=Current;
    { get new current def }
    Def:=Defs;
    While (Def<>nil) and ((Def^.Min>HelpContext) or (Def^.Max<HelpContext))
      do Def:=Def^.Next;
    Current:=Def;
    If Current <> nil then
      Items:=Current^.Items
    Else Items := nil;
    { update layout }
    If Old=Current then Begin
      DrawHint;
    End
    Else DrawView;
  End;
End;

procedure TStatusLine.GetItemRect(Item: PStatusItem; var R: TRect);
var I: PStatusItem;
    J: Integer;
    S: String;

 procedure SetText(var S: String);
 Begin
   If S[1] in [#0,#1,#2] then Begin
     SetTextParams(Ord(S[1]), 0, 0, True);
     Delete(S, 1, 1);
   End
   Else SetTextParams(ftSystem, 0, 0, True);
 End;

Begin
  I:=Items;
  J:=6;
  While (I<>nil) and (I<>Item) do Begin
    If I^.Text <> nil then Begin
      S := I^.Text^;
      SetText(S);
      If I^.Text<>nil then Inc (J, TextWidth (S)+12);
    End;
    I:=I^.Next;
  End;
  If (Item = nil) or (Item^.Text=nil) then R.Assign (J, 1, J, Size.Y)
		    else Begin
		      S := Item^.Text^;
		      SetText(S);
		      R.Assign (J, 1, J+TextWidth (S)+12, Size.Y)
		    End

End;

procedure TStatusLine.DrawItem(Item: PStatusItem);
var R: TRect;
    Col1, Col2: Byte;
    S: String;
    Style: Integer;
Begin
  If (Item=nil) or (Item^.Text=nil) then Exit;
  SetViewport;
  GetItemRect (Item, R);
  If Item=CItem then Begin
    If GetState (sfDisabled) or ((Item^.Command<256) and
       not CommandEnabled (Item^.Command)) then Begin
      Col1:=GetColor (5); Col2:=Col1
    End
    Else Begin Col1:=GetColor (4); Col2:=GetColor (6); End;
    SetFillStyle (SolidFill, GetColor (8));
  End
  Else Begin
    If GetState (sfDisabled) or ((Item^.Command<256) and
       not CommandEnabled (Item^.Command)) then Begin
      Col1:=GetColor (2); Col2:=Col1
    End
    Else Begin Col1:=GetColor (1); Col2:=GetColor (3) End;
    SetFillStyle (SolidFill, GetColor (7));
  End;
  With R do Bar (A.X, A.Y, B.X-1, B.Y-1);
  S := Item^.Text^;
  If S[1] in [#0,#1,#2] then Begin
    Style := Ord(S[1]);
    Delete(S, 1, 1);
  End
  Else Style := ftSystem;
  SetTextJustify(CenterText, CenterText);
  SetTextParams(Style, 0, Col1 + Col2 shl 8, true);
  Dec (R.B.Y,R.A.Y);
  Dec (R.B.X,R.A.X);
  OutTextXY(R.A.X + R.B.X div 2, R.A.Y + R.B.Y div 2, S);
  RestoreViewport
End;

procedure TStatusLine.DrawHint;
var S: String;
    Item,Last: PStatusItem;
    ItemRect, R: TRect;
    Style: Integer;
Begin
  SetViewport;
  GetExtent (R);
  Inc (R.A.Y);
  Item:=Items;
  Last:=nil;
  While Item<>nil do Begin
    If Item^.Next=nil then Last:=Item;
    Item:=Item^.Next;
  End;
  S:=Hint (HelpContext);
  If S<>'' then Begin
    If Last <> nil then GetItemRect (Last,ItemRect)
		   else ItemRect.Assign (0,0,0,Size.Y);
    With ItemRect do Begin
      A.X:=B.X;
      B.X:=R.B.X-A.X;
      SetColor (GetColor (1));
      If (Last <> nil) and (A.X>0) then Begin
	VertLine (A.X+5, R.A.Y, R.B.Y);
	R.A.X:=A.X+6;
      End
      Else R.A.X:=A.X;
      SetFillStyle (SolidFill,GetColor (7));
      Bar (R.A.X, R.A.Y, R.B.X-1, R.B.Y-1);
      Inc (A.X,10);
      If S[1] in [#0,#1,#2] then Begin
	Style := Ord(S[1]);
	Delete(S, 1, 1);
      End
      Else Style := ftSystem;
      SetTextJustify(LeftText, CenterText);
      SetTextParams(Style, 0, GetColor(1) + GetColor(3) shl 8, true);
      OutTextXY(A.X, A.Y + B.Y div 2, S);
    End;
  End
  Else Begin
    If Last <> nil then GetItemRect (Last,ItemRect)
		   else ItemRect.Assign (0,0,0,Size.Y);
    With ItemRect do Begin
      A.X:=B.X+1;
      B.X:=R.B.X;
    End;
    SetFillStyle (SolidFill, GetColor (7));
    With ItemRect do Bar (A.X, A.Y, B.X-1, B.Y-1);
  End;
  RestoreViewport
End;

(****************************** TMenuItem routines **************************)

function NewItem(const Name, Param: TMenuStr; KeyCode: Word; Command: Word;
  AHelpCtx: Word; Next: PMenuItem): PMenuItem;
var Item: PMenuItem;
Begin
  New (Item);
  If Name='' then Item^.Name:=NewStr (' ')
	     else Item^.Name:=NewStr (Name);
  Item^.Param:=NewStr (Param);
  Item^.KeyCode:=KeyCode;
  Item^.Command:=Command;
  Item^.Disabled:=0;
  Item^.HelpCtx:=AHelpCtx;
  Item^.Next:=Next;
  NewItem:=Item;
End;

function NewBitmap(Image: Pointer; KeyCode: Word; Command: Word;
  AHelpCtx: Word; Next: PMenuItem): PMenuItem;
var Item: PMenuItem;
Begin
  New(Item);
  Item^.Name := CopyImage(Image);
  Item^.Param := nil;
  Item^.KeyCode := KeyCode;
  Item^.Command := Command;
  Item^.Disabled := dfBitmap;
  Item^.HelpCtx := AHelpCtx;
  Item^.Next := Next;
  NewBitmap := Item;
End;

function NewLine(Next: PMenuItem): PMenuItem;
var Item: PMenuItem;
Begin
  New (Item);
  Item^.Name:=nil;
  Item^.Param:=nil;
  Item^.Keycode:=kbNoKey;
  Item^.Command:=0;
  Item^.Disabled:=dfDisabled;
  Item^.HelpCtx:=hcNoContext;
  Item^.Next:=Next;
  NewLine:=Item;
End;

function NewSubMenu(const Name: TMenuStr; AHelpCtx: Word; SubMenu: PMenu;
  Next: PMenuItem): PMenuItem;
var Item: PMenuItem;
Begin
  New (Item);
  If Name='' then Item^.Name:=NewStr (' ')  { muá sein, sonst keine Unterscheidung zur Linie }
	     else Item^.Name:=NewStr (Name);
  Item^.SubMenu:=SubMenu;
  Item^.Next:=Next;
  Item^.Command:=0;
  Item^.KeyCode:=0;
  Item^.Disabled:=0;
  Item^.HelpCtx:=AHelpCtx;
  NewSubMenu:=Item;
End;

function NewBmpSubMenu(Image: Pointer; AHelpCtx: Word; SubMenu: PMenu;
  Next: PMenuItem): PMenuItem;
var Item: PMenuItem;
Begin
  New(Item);
  Item^.Name := CopyImage(Image);
  Item^.SubMenu := SubMenu;
  Item^.Command := 0;
  Item^.KeyCode := 0;
  Item^.Disabled := dfBitmap;
  Item^.HelpCtx := AHelpCtx;
  Item^.Next := Next;
  NewBmpSubMenu := Item;
End;

function NewCheckItem(const Name, Param: TMenuStr; KeyCode, Command, AHelpCtx: Word;
  ADisabled: Byte; Next: PMenuItem): PMenuItem;
var Item: PMenuItem;
Begin
  Item := NewItem(Name, Param, KeyCode, Command, AHelpCtx, Next);
  Item^.Disabled := ADisabled;
  NewCheckItem := Item;
End;

function NewBmpCheckItem(Image: Pointer; KeyCode, Command, AHelpCtx: Word;
  ADisabled: Byte; Next: PMenuItem): PMenuItem;
var Item: PMenuItem;
Begin
  Item := NewBitmap(Image, KeyCode, Command, AHelpCtx, Next);
  Item^.Disabled := ADisabled;
  NewBmpCheckItem := Item;
End;

(******************************** TMenu routines ****************************)

function NewMenu(Items: PMenuItem): PMenu;
var Menu: PMenu;
Begin
  New (Menu);
  Menu^.Items:=Items;
  Menu^.Default:=Items;

  { get a non-line as default }

  If Menu^.Items <> nil then
    While (Menu^.Default^.Name = nil) and (Menu^.Default^.Next <> nil) do
      Menu^.Default:=Menu^.Default^.Next;

  NewMenu:=Menu;
End;

procedure DisposeMenu(Menu: PMenu);
var
  Item, Help: PMenuItem;
Begin
  Item:=Menu^.Items;
  While Item<>nil do Begin
    If Item^.Name <> nil then
      If Item^.Disabled and dfBitmap <> 0 then Begin
        If Item^.Command = 0 then DisposeMenu(Item^.SubMenu);
	FreeImage(Item^.Name);
      End
      else Begin
	If Item^.Command=0
	then DisposeMenu (Item^.SubMenu)
	else DisposeStr (Item^.Param);
	DisposeStr (PString(Item^.Name));
      End;
    Help:=Item^.Next;
    Dispose (Item);
    Item:=Help;
  End;
  Dispose (Menu);
End;

{ Menu functions
}

function LookUpMenu(Menu: PMenu; idCheckItem: Word; Flags: Word): PMenuItem;
var
  Item, LookedUp: PMenuItem;
  i: Integer;
begin
  LookUpMenu := nil;
  If Menu <> nil then
  with Menu^ do begin
    Item := Items;
    If Flags and dfByPosition <> 0
    then begin
      For i := 1 to idCheckItem - 1 do
      begin
	Item := Item^.Next;
	If Item = nil then Break
      end;
      LookUpMenu := Item
    end
    else begin
      LookedUp := nil;
      If Item <> nil then
      repeat
	If (Item^.Command = 0) and (Item^.SubMenu <> nil)
	then LookedUp := LookUpMenu(Item^.SubMenu, idCheckItem, Flags) else
	if (Item^.Command = idCheckItem)
	then LookedUp := Item;
	Item := Item^.Next;
      until (Item = nil) or (LookedUp <> nil);
      LookUpMenu := LookedUp
    end
  end
end;

function SetMenuState(Menu: PMenu; idCheckItem: Word; Check: Word): Word;
var
  Item: PMenuItem;
begin
  Item := LookUpMenu(Menu, idCheckItem, Check);
  If Item <> nil
  then begin
    SetMenuState := Item^.Disabled;
    Item^.Disabled := Check
  end
  else
    SetMenuState := 0
end;

function ChangeMenuState(Menu: PMenu; idCheckItem: Word;
  Check: Word; Enable: Boolean): Word;
var
  Item: PMenuItem;
begin
  Item := LookUpMenu(Menu, idCheckItem, Check);
  If Item <> nil
  then begin
    ChangeMenuState := Item^.Disabled;
    If Enable
    then Item^.Disabled := Item^.Disabled or Check
    else Item^.Disabled := Item^.Disabled and not Check
  end
  else
    ChangeMenuState := 0
end;

function GetMenuState(Menu: PMenu; idCheckItem: Word; Flags: Word): Word;
var
  Item: PMenuItem;
begin
  Item := LookUpMenu(Menu, idCheckItem, Flags);
  If Item <> nil
  then GetMenuState := Item^.Disabled
  else GetMenuState := 0
end;

(**************************** TStatusLine routines **************************)

function NewStatusKey(const AText: String; AKeyCode: Word; ACommand: Word;
  ANext: PStatusItem): PStatusItem;
var Item: PStatusItem;
Begin
  New (Item);
  With Item^ do Begin
{    If AText='' then AText:=' '; }
    Text:=NewStr (AText);
    KeyCode:=AKeyCode;
    Command:=ACommand;
    Next:=ANext;
  End;
  NewStatusKey:=Item;
End;

function NewStatusDef(AMin, AMax: Word; AItems: PStatusItem;
  ANext: PStatusDef): PStatusDef;
var Def: PStatusDef;
Begin
  New (Def);
  With Def^ do Begin
    Min:=AMin;
    Max:=AMax;
    Items:=AItems;
    Next:=ANext;
  End;
  NewStatusDef:=Def;
End;

(************************ GVMenus registration procedure ********************)

procedure RegisterGVMenus;
Begin
  RegisterType (RMenuBar);
  RegisterType (RMenuBox);
  RegisterType (RStatusLine);
  RegisterType (RMenuPopup);
End;

End.
