home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TVTOOL.ZIP / TVMENUS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-08  |  3.5 KB  |  40 lines
  1. {*
  2. *
  3. *   Copyright (c) 1992 by Richard W. Hansen
  4. *
  5. *   This source code will compile.
  6. *   Unpacked source is available to registered users.
  7. *
  8. *}
  9. UNIT TvMenus;{$I TVDEFS.INC}INTERFACE USES TvConst,App,Drivers,Menus,Views,Objects;CONST Marker:String[10]='√';
  10. NoMarker:String[10]=' ';MarkerLen:Byte=1;TYPE PNewMenuBar=^TNewMenuBar;TNewMenuBar=Object(TMenuBar)
  11. Procedure HandleEvent(var E:TEvent);Virtual;Procedure ToggleMarker(Cmd:Word);Procedure SetMarker(Cmd:Word);
  12. Procedure ClearMarker(Cmd:Word);Function MarkerIsSet(Cmd:Word):Boolean;Procedure ResetMarkers(FirstCmd:Word;LastCmd:Word;
  13. NewCmd:Word);Function FindCmd(AMenu:PMenu;Cmd:Word):PMenuItem;end;Function NewMarkedItem(Name,Param:TMenuStr;KeyCode:Word;
  14. Command:Word;AHelpCtx:Word;Next:PMenuItem):PMenuItem;Function PopupMenu(PopMenu:PMenuBox):Word;
  15. Function MousePopupMenu(PopMenu:PMenuBox):Word;IMPLEMENTATION Function PopupMenu(PopMenu:PMenuBox):Word;var Command:Word;
  16. Event:TEvent;X:Integer;Y:Integer;begin X:=PopMenu^.Origin.X;if(X+PopMenu^.Size.X)>Desktop^.Size.X then
  17. X:=Desktop^.Size.X-PopMenu^.Size.X;Y:=PopMenu^.Origin.Y;if(Y+PopMenu^.Size.Y)>Desktop^.Size.Y then
  18. Y:=Desktop^.Size.Y-PopMenu^.Size.Y;if(X<0)then X:=0;if(Y<0)then Y:=0;PopMenu^.MoveTo(X,Y);
  19. PopupMenu:=Desktop^.ExecView(PopMenu);end;Function MousePopupMenu(PopMenu:PMenuBox):Word;var Command:Word;Event:TEvent;
  20. Pos:TPoint;begin Repeat Desktop^.GetEvent(Event);Until(Event.What=evMouseUp);Desktop^.MakeLocal(MouseWhere,Pos);
  21. if(Pos.X+PopMenu^.Size.X)>Desktop^.Size.X then Pos.X:=Desktop^.Size.X-PopMenu^.Size.X;
  22. if(Pos.Y+PopMenu^.Size.Y)>Desktop^.Size.Y then Pos.Y:=Desktop^.Size.Y-PopMenu^.Size.Y;if(Pos.X<0)then Pos.X:=0;
  23. if(Pos.Y<0)then Pos.Y:=0;PopMenu^.MoveTo(Pos.X,Pos.Y);MousePopupMenu:=Desktop^.ExecView(PopMenu);end;
  24. Function NewMarkedItem(Name,Param:TMenuStr;KeyCode:Word;Command:Word;AHelpCtx:Word;Next:PMenuItem):PMenuItem;var i:Byte;begin 
  25. if(Copy(Name,1,MarkerLen)<>Marker)then Insert(NoMarker,Name,1);if(Name[MarkerLen+1]<>' ')then Insert(' ',Name,MarkerLen+1);
  26. NewMarkedItem:=NewItem(Name,Param,KeyCode,Command,AHelpCtx,Next);end;Procedure TNewMenuBar.HandleEvent(var E:TEvent);begin
  27. if(E.What=evCommand)then if(E.Command>=cmMarkStart)and(E.Command<=cmMarkEnd)then begin ToggleMarker(E.Command);end;
  28. TMenuBar.HandleEvent(E);end;Procedure TNewMenuBar.ToggleMarker(Cmd:Word);begin if MarkerIsSet(Cmd)then ClearMarker(Cmd)else
  29. SetMarker(Cmd);end;Procedure TNewMenuBar.SetMarker(Cmd:Word);var P:PMenuItem;i:Byte;begin P:=FindCmd(Menu,Cmd);if(P<>nil)then
  30. for i:=1 to MarkerLen do P^.Name^[i]:=Marker[i];end;Procedure TNewMenuBar.ClearMarker(Cmd:Word);var P:PMenuItem;i:Byte;begin
  31. P:=FindCmd(Menu,Cmd);if(P<>nil)then for i:=1 to MarkerLen do P^.Name^[i]:=NoMarker[i];end;
  32. Function TNewMenuBar.MarkerIsSet(Cmd:Word):Boolean;var P:PMenuItem;begin MarkerIsSet:=False;P:=FindCmd(Menu,Cmd);
  33. if(P<>nil)then MarkerIsSet:=(Copy(P^.Name^,1,MarkerLen)=Marker);end;Procedure TNewMenuBar.ResetMarkers(FirstCmd:Word;
  34. LastCmd:Word;NewCmd:Word);var P:PMenuItem;i:Byte;begin P:=FindCmd(Menu,FirstCmd);While(P<>nil)do begin
  35. if(P^.Command=NewCmd)then for i:=1 to MarkerLen do P^.Name^[i]:=Marker[i]
  36. else if(P^.Command>=FirstCmd)and(P^.Command<=LastCmd)then for i:=1 to MarkerLen do P^.Name^[i]:=NoMarker[i];P:=P^.Next;end;
  37. end;Function TNewMenuBar.FindCmd(AMenu:PMenu;Cmd:Word):PMenuItem;var P:PMenuItem;Item:PMenuItem;begin Item:=nil;
  38. P:=AMenu^.Items;while(P<>nil)and(Item=nil)do begin if(P^.Command=0)and(P^.Name<>nil)then Item:=FindCmd(P^.SubMenu,Cmd)
  39. else if(P^.Command=Cmd)and not P^.Disabled then Item:=P;P:=P^.Next;end;FindCmd:=Item;end;End.
  40.