home *** CD-ROM | disk | FTP | other *** search
/ Mega Top 1 / os2_top1.zip / os2_top1 / APPS / PROG / PASCAL / SPEED2 / SRC / RCOMP / RCMENU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-09-29  |  10.8 KB  |  385 lines
  1. UNIT RcMenu;
  2.  
  3. INTERFACE
  4.  
  5. USES RcTypes;
  6.  
  7. VAR
  8.     TempMenu:PMenu;
  9.  
  10. CONST
  11.     MenuCount:Word=0;
  12.  
  13.  
  14.     MenuStyles:ARRAY[1..14] OF TStyle=(
  15.     (Name:'MIS_TEXT';Style:$0001),
  16.     (Name:'MIS_BITMAP';Style:$0002),
  17.     (Name:'MIS_SEPARATOR';Style:$0004),
  18.     (Name:'MIS_OWNERDRAW';Style:$0008),
  19.     (Name:'MIS_SUBMENU';Style:$0010),
  20.     (Name:'MIS_MULTMENU';Style:$0020),
  21.     (Name:'MIS_SYSCOMMAND';Style:$0040),
  22.     (Name:'MIS_HELP';Style:$0080),
  23.     (Name:'MIS_STATIC';Style:$0100),
  24.     (Name:'MIS_BUTTONSEPARATOR';Style:$0200),
  25.     (Name:'MIS_BREAK';Style:$0400),
  26.     (Name:'MIS_BREAKSEPARATOR';Style:$0800),
  27.     (Name:'MIS_GROUP';Style:$1000),
  28.     (Name:'MIS_SINGLE';Style:$2000));
  29.  
  30.     MenuAttribs:ARRAY[1..5] OF TStyle=(
  31.     (Name:'MIA_NODISMISS';Style:$0020),
  32.     (Name:'MIA_FRAMED';Style:$1000),
  33.     (Name:'MIA_CHECKED';Style:$2000),
  34.     (Name:'MIA_DISABLED';Style:$4000),
  35.     (Name:'MIA_HILITED';Style:$8000));
  36.  
  37.  
  38. PROCEDURE ParseMenu;
  39. PROCEDURE Write_res_Menus;
  40. PROCEDURE Write_Menus;
  41.  
  42. IMPLEMENTATION
  43.  
  44. PROCEDURE WriteSubMenu(m,m1:PMenu);
  45. BEGIN
  46.      while m1<>NIL do
  47.      begin
  48.           IF m1^.SubMenus<>NIL THEN
  49.           BEGIN
  50.                m1^.Style:=m1^.Style and 65531; {no separators}
  51.                WriteWord(m1^.Style);
  52.                WriteWord(m1^.Attrib);
  53.                WriteWord(m1^.ident);
  54.                WriteStr(m1^.MenuName);
  55.  
  56.                WriteWord(m1^.SubSize AND 65535);
  57.                WriteWord(m1^.SubSize SHR 16);
  58.                WriteWord($0352);
  59.                WriteWord(4);
  60.                WriteWord(m1^.SubCount);
  61.                WriteSubMenu(m1,m1^.SubMenus);
  62.           END
  63.           ELSE
  64.           BEGIN
  65.                IF m1^.Style AND 4=4 THEN {Separator}
  66.                BEGIN
  67.                     writeWord(4);
  68.                     writeWord(0);
  69.                     writeWord($ffff);
  70.                END
  71.                ELSE
  72.                BEGIN
  73.                     writeword(m1^.Style);
  74.                     writeword(m1^.Attrib);
  75.                     writeword(m1^.ident);
  76.                     writestr(m1^.menuname);
  77.                END;
  78.           END;
  79.           m1:=m1^.next;  {Next submenu entry}
  80.      end;
  81. END;
  82.  
  83.  
  84. PROCEDURE Write_res_Menus;
  85. var m,m1,m2:PMenu;
  86.     b:byte;
  87.     l:Longint;
  88. BEGIN
  89.      m2:=Menus;
  90.      if m2=NIL then exit;
  91.      while m2<>NIL do   {alle Menus}
  92.      begin
  93.           l:=m2^.subsize;   {Overall Size of the menu bar}
  94.           m:=m2;
  95.           if m<>NIL THEN  {If there is at least one menu entry}
  96.           BEGIN
  97.                WriteWord(l mod 65536);
  98.                WriteWord(l div 65536);
  99.                WriteWord($0352);
  100.                WriteWord(4);
  101.                WriteWord(m^.subcount);
  102.           END;
  103.  
  104.           m:=m^.SubMenus;   {Main menu entries}
  105.           while m<>NIL do   {all main menu entries}
  106.           begin
  107.               m^.Style:=m^.Style and 65531; {no separators}
  108.               WriteWord(m^.Style);
  109.               WriteWord(m^.Attrib);
  110.               WriteWord(m^.ident);
  111.               WriteStr(m^.MenuName);
  112.               m1:=m^.SubMenus;  {Submenu entries}
  113.               if m1<>NIL then
  114.               BEGIN
  115.                    writeword(m^.subsize mod 65536);
  116.                    writeword(m^.subsize div 65536);
  117.                    writeword($0352);
  118.                    writeword(4);
  119.                    writeword(m^.subcount);
  120.                    WriteSubMenu(m,m1)
  121.               END
  122.               ELSE   {No Submenu entry for this}
  123.               BEGIN
  124.                  WriteWord($0a);
  125.                  WriteWord(0);
  126.                  WriteWord($0352);
  127.                  WriteWord(4);
  128.                  WriteWord(0);
  129.               END;
  130.               m:=m^.next;   {Next Main menu entry}
  131.         end; {While main menu<>NIL}
  132.         writeword(0);
  133.         m2:=m2^.next;  {Next menu bar}
  134.      END;
  135. END;
  136.  
  137.  
  138. PROCEDURE Write_Menus;
  139. VAR w:Word;
  140.     m:PMenu;
  141. BEGIN
  142.      MenuOffset:=IconOffset;
  143.      {Nun die Bezeichner der Menus}
  144.      m:=Menus;
  145.      while m<>NIL do
  146.      begin
  147.           WriteWord(3);                     {Typ:Menu}
  148.           writeword(m^.ident);              {Bezeichner des Menus}
  149.           writeword(m^.subsize AND 65535);  {Länge der Einträge für dieses Menu}
  150.           writeword(m^.subsize SHR 16);
  151.           writeWord(3);                     {Object number}
  152.           writeWord(MenuOffset AND 65535);  {Relativer Resourcenoffset}
  153.           writeWord(MenuOffset SHR 16);
  154.           inc(MenuOffset,m^.SubSize);
  155.           m:=m^.next;
  156.      end;
  157. END;
  158.  
  159. PROCEDURE NewMenu(VAR m,m1:PMenu;DefaultStyle:WORD);
  160. Var spos:Byte;
  161. BEGIN
  162.      IF m=NIL THEN
  163.      BEGIN
  164.           New(m);
  165.           m1:=m;
  166.      END
  167.      ELSE
  168.      BEGIN
  169.           m1:=m;
  170.           while m1^.next<>NIL do m1:=m1^.next;
  171.           new(m1^.next);
  172.           m1:=m1^.next;
  173.      END;
  174.      m1^.MenuName:=params;
  175.      m1^.SubCount:=0;
  176.      m1^.SubMenus:=NIL;
  177.      m1^.SubSize:=0;
  178.      m1^.Style:=DefaultStyle;
  179.      m1^.Attrib:=0;
  180.      m1^.Next:=NIL;
  181. END;
  182.  
  183.  
  184. PROCEDURE SubMenuSize(m:PMenu;VAR s:WORD);
  185. BEGIN
  186.      WHILE m<>NIL DO   {all submenu entries}
  187.      BEGIN
  188.           IF m^.SubMenus<>NIL THEN  {weitere Submenueinträge}
  189.           BEGIN
  190.                s:=s+7+length(m^.Menuname);
  191.                s:=s+10;
  192.                SubMenuSize(m^.SubMenus,s);
  193.           END
  194.           ELSE
  195.           BEGIN
  196.                IF m^.Style AND 4=4 THEN s:=s+6 {Separator}
  197.                ELSE s:=s+7+length(m^.menuname);
  198.           END;
  199.           m:=m^.next;
  200.      END;
  201. END;
  202.  
  203.  
  204. PROCEDURE MenuSize(m:PMenu;VAR s,s1:WORD);
  205. BEGIN
  206.      s1:=s;
  207.      IF m^.SubMenus<>NIL THEN  {1. Untermenu}
  208.      BEGIN
  209.          s:=s+10;
  210.          SubMenuSize(m^.SubMenus,s);
  211.      END
  212.      ELSE s:=s+10;  {No first SubMenu entries}
  213.      m^.SubSize:=s-s1;
  214. END;
  215.  
  216. PROCEDURE Calc_MenuSize(VAR m:PMenu);
  217. var m1,m2:PMenu;
  218.     s,s1:word;
  219. BEGIN
  220.      if m=NIL then exit;
  221.      s:=12;  {Size without anything for every menubar}
  222.      m1:=m^.SubMenus;    {Main menu entries}
  223.      while m1<>NIL do   {all SubMenus}
  224.      begin
  225.           s:=s+7+length(m1^.MenuName);  {Main menu entry}
  226.           MenuSize(m1,s,s1);
  227.           m1:=m1^.next;    {Next main menu}
  228.      end;
  229.      m^.SubSize:=s;      {overall size}
  230. END;
  231.  
  232. PROCEDURE GetMenuAttribs(VAR s:string;m:PMenu);
  233. VAR t:BYTE;
  234.     params,temp:STRING;
  235. Label l;
  236. BEGIN
  237.      SplitLine(s,params,',');
  238. l:
  239.      SplitLine(Params,Temp,'|');
  240.      FOR t:=1 TO length(Temp) DO Temp[t]:=upcase(temp[t]);
  241.      FOR t:=1 TO 14 DO
  242.      BEGIN
  243.           IF MenuAttribs[t].Name=temp THEN
  244.           BEGIN
  245.                m^.Attrib:=m^.Attrib or MenuAttribs[t].Style;
  246.                IF params<>'' THEN goto l;
  247.                exit;
  248.           END;
  249.      END;
  250.      Error('Illegal menu attribute:'+temp);
  251. END;
  252.  
  253.  
  254.  
  255.  
  256.  
  257. PROCEDURE GetMenuStyles(VAR s:string;m:PMenu);
  258. VAR t:BYTE;
  259.     params,temp:STRING;
  260. Label l;
  261. BEGIN
  262.      SplitLine(s,params,',');
  263. l:
  264.      SplitLine(Params,Temp,'|');
  265.      FOR t:=1 TO length(Temp) DO Temp[t]:=upcase(temp[t]);
  266.      FOR t:=1 TO 14 DO
  267.      BEGIN
  268.           IF MenuStyles[t].Name=temp THEN
  269.           BEGIN
  270.                m^.Style:=m^.Style or MenuStyles[t].Style;
  271.                IF params<>'' THEN goto l;
  272.                exit;
  273.           END;
  274.      END;
  275.      Error('Illegal menu style:'+temp);
  276. END;
  277.  
  278. PROCEDURE ReadMenu(VAR m:PMenu);
  279. VAR s:string;
  280.     m1:PMenu;
  281.     c:Integer;
  282.     i:WORD;
  283.     i1:LONGINT;
  284. BEGIN
  285.      Read_Line;
  286.      if commanditem<>__BEGIN then error('BEGIN expected');
  287.      while commanditem<>__END do
  288.      begin
  289.           Read_line;
  290.           case commanditem of
  291.             __END: ;
  292.             ELSE
  293.             begin
  294.                  case commanditem of
  295.                    __SUBMENU:
  296.                    BEGIN
  297.                         inc(m^.subcount);
  298.                         s:=params;
  299.                         SplitLine(s,params,',');
  300.                         IF Params[1]<>'"' THEN error('Syntax error');
  301.                         IF Params[length(Params)]<>'"' THEN error('Syntax error');
  302.                         dec(Params[0]);
  303.                         delete(Params,1,1);
  304.                         NewMenu(m^.SubMenus,m1,$10);
  305.                         SplitLine(s,params,',');
  306.                         val(params,m1^.ident,c);
  307.                         if c<>0 then
  308.                         BEGIN
  309.                              IF not SearchConstant(params,i1) THEN
  310.                                 error('Illegal numeric format');
  311.                              m1^.ident:=i1;
  312.                         END;
  313.                         IF s='' THEN m1^.Style:=m1^.Style or 1 {MIS_TEXT}
  314.                         ELSE GetMenuStyles(s,m1);
  315.                         IF s<>'' THEN Error('Syntax error');
  316.                         ReadMenu(m1);
  317.                    END;
  318.                    __MENUITEM:
  319.                    BEGIN
  320.                         inc(m^.subcount);
  321.                         s:=params;
  322.                         IF s='SEPARATOR' THEN
  323.                         BEGIN
  324.                              Params:='';
  325.                              NewMenu(m^.SubMenus,m1,0);
  326.                              m1^.Style:=4; {MIS_SEPARATOR}
  327.                         END
  328.                         ELSE
  329.                         BEGIN
  330.                              SplitLine(s,params,',');
  331.                              IF Params[1]<>'"' THEN error('Syntax error');
  332.                              IF Params[length(Params)]<>'"' THEN error('Syntax error');
  333.                              dec(Params[0]);
  334.                              delete(Params,1,1);
  335.                              NewMenu(m^.SubMenus,m1,0);
  336.                              SplitLine(s,params,',');
  337.                              val(params,m1^.ident,c);
  338.                              if c<>0 then
  339.                              BEGIN
  340.                                  IF not SearchConstant(params,i1) THEN
  341.                                   error('Illegal numeric format');
  342.                                  m1^.ident:=i1;
  343.                              END;
  344.                              IF s='' THEN m1^.Style:=m1^.Style or 1 {MIS_TEXT}
  345.                              ELSE GetMenuStyles(s,m1);
  346.                              IF s<>'' THEN GetMenuAttribs(s,m1);
  347.                              IF s<>'' THEN Error('Syntax error');
  348.                          END;
  349.                    END;
  350.                    else error('Unknown command '+command);
  351.                  end; {case}
  352.             end;
  353.           end; {case}
  354.      end;
  355.      CommandItem:=__BEGIN;
  356. END;
  357.  
  358.  
  359. PROCEDURE ParseMenu;
  360. VAR m:PMenu;
  361.     i:WORD;
  362.     memopt:WORD;
  363.     c:Integer;
  364.     s,s1:string;
  365.     i1:LONGINT;
  366. Label l;
  367. BEGIN
  368.      INC(MenuCount);
  369.      val(params,i,c);
  370.      if c<>0 then
  371.      BEGIN
  372.           IF not SearchConstant(params,i1) THEN
  373.             error('Illegal numeric format');
  374.           i:=i1;
  375.      END;
  376.      params:='';
  377.      NewMenu(Menus,m,$11);
  378.      m^.ident:=i;
  379.      ReadMenu(m);
  380.      Calc_MenuSize(m);
  381. END;
  382.  
  383.  
  384. BEGIN
  385. END.