home *** CD-ROM | disk | FTP | other *** search
/ Mega Top 1 / os2_top1.zip / os2_top1 / APPS / PROG / PASCAL / SPEED2 / SRC / RCOMP / RCACCEL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-09-29  |  12.9 KB  |  501 lines
  1. UNIT RcAccel;
  2.  
  3. INTERFACE
  4.  
  5. USES RcTypes;
  6.  
  7. PROCEDURE ParseAccel;
  8. PROCEDURE ParseHelpTable;
  9. PROCEDURE ParseHelpSubTable;
  10. PROCEDURE Write_res_Accels;
  11. PROCEDURE Write_Accels;
  12. PROCEDURE Write_res_HelpTables;
  13. PROCEDURE Write_HelpTables;
  14. PROCEDURE Write_res_HelpSubTables;
  15. PROCEDURE Write_HelpSubTables;
  16.  
  17. VAR
  18.    TempAccel:PAccel;
  19.    TemphelpTable:PHelptable;
  20.    TempHelpSubTable:PHelpTable;
  21.  
  22. CONST
  23.      AccelCount:WORD=0;
  24.      HelptableCount:WORD=0;
  25.      HelpSubTableCount:WORD=0;
  26.  
  27. IMPLEMENTATION
  28.  
  29. PROCEDURE Write_Res_Accels;
  30. VAR a,a1:PAccel;
  31. BEGIN
  32.      a:=Accelerators;
  33.      WHILE a<>NIL DO
  34.      BEGIN
  35.           WriteWord(a^.SubCount);
  36.           WriteWord($0352);
  37.           a1:=a^.entries;
  38.           WHILE a1<>NIL DO
  39.           BEGIN
  40.                WriteWord(a1^.Flag);
  41.                WriteWord(a1^.name);
  42.                WriteWord(a1^.ident);
  43.                a1:=a1^.Next;
  44.           END;
  45.           a:=a^.next;
  46.      END;
  47. END;
  48.  
  49. PROCEDURE Write_Res_HelpTables;
  50. VAR h,h1:PHelpTable;
  51.     hi:PHelptableEntry;
  52. BEGIN
  53.      h:=Helptables;
  54.      WHILE h<>NIL DO
  55.      BEGIN
  56.           hi:=h^.Entries;
  57.           WHILE hi<>NIL do
  58.           BEGIN
  59.                Writeword(hi^.i1);
  60.                WriteWord(hi^.i2);
  61.                WriteWord($ffff);
  62.                WriteWord(hi^.i3);
  63.                hi:=hi^.next;
  64.           END;
  65.           WriteWord(0);
  66.           h:=h^.next;
  67.      END;
  68. END;
  69.  
  70. PROCEDURE Write_Res_HelpSubTables;
  71. VAR h,h1:PHelpTable;
  72.     hi:PHelptableEntry;
  73. BEGIN
  74.      h:=HelpSubtables;
  75.      WHILE h<>NIL DO
  76.      BEGIN
  77.           WriteWord(2);
  78.           hi:=h^.Entries;
  79.           WHILE hi<>NIL do
  80.           BEGIN
  81.                Writeword(hi^.i1);
  82.                WriteWord(hi^.i2);
  83.                hi:=hi^.next;
  84.           END;
  85.           WriteWord(0);
  86.           h:=h^.next;
  87.      END;
  88. END;
  89.  
  90.  
  91. PROCEDURE Write_Accels;
  92. VAR a:pAccel;
  93. BEGIN
  94.      AccelOffset:=DialogOffset;
  95.      {Nun die Bezeichner der Acceleratortables}
  96.      a:=Accelerators;
  97.      while a<>NIL do
  98.      begin
  99.           WriteWord(8);                     {Typ:Accelerator}
  100.           writeword(a^.ident);              {Bezeichner des Accelerators}
  101.           writeword(a^.subsize AND 65535);  {Länge der Einträge für diese Tabelle}
  102.           writeword(a^.subsize SHR 16);
  103.           writeWord(3);                     {Object number}
  104.           writeWord(AccelOffset AND 65535);  {Relativer Resourcenoffset}
  105.           writeWord(AccelOffset SHR 16);
  106.           inc(AccelOffset,a^.SubSize);
  107.           a:=a^.next;
  108.      end;
  109. END;
  110.  
  111. PROCEDURE Write_HelpTables;
  112. VAR h:pHelptable;
  113. BEGIN
  114.      HelpTableOffset:=AccelOffset;
  115.      {Nun die Bezeichner der Acceleratortables}
  116.      h:=HelpTables;
  117.      while h<>NIL do
  118.      begin
  119.           WriteWord($12);                     {Typ:helptable}
  120.           writeword(h^.ident);              {Bezeichner der Helptable}
  121.           writeword(h^.subsize AND 65535);  {Länge der Einträge für diese Tabelle}
  122.           writeword(h^.subsize SHR 16);
  123.           writeWord(3);                     {Object number}
  124.           writeWord(HelptableOffset AND 65535);  {Relativer Resourcenoffset}
  125.           writeWord(HelpTableOffset SHR 16);
  126.           inc(HelptableOffset,h^.SubSize);
  127.           h:=h^.next;
  128.      end;
  129. END;
  130.  
  131. PROCEDURE Write_HelpSubTables;
  132. VAR h:pHelptable;
  133. BEGIN
  134.      HelpSubTableOffset:=HelpTableOffset;
  135.      {Nun die Bezeichner der HilfeSubTabellen}
  136.      h:=helpSubTables;
  137.      while h<>NIL do
  138.      begin
  139.           WriteWord($13);                   {Typ:HelpSubTable}
  140.           writeword(h^.ident);              {Bezeichner der HelpSubTable}
  141.           writeword(h^.subsize AND 65535);  {Länge der Einträge für diese Tabelle}
  142.           writeword(h^.subsize SHR 16);
  143.           writeWord(3);                     {Object number}
  144.           writeWord(HelpSubTableOffset AND 65535);  {Relativer Resourcenoffset}
  145.           writeWord(HelpSubTableOffset SHR 16);
  146.           inc(HelpSubTableOffset,h^.SubSize);
  147.           h:=h^.next;
  148.      end;
  149. END;
  150.  
  151. PROCEDURE NewAccel(VAR a,a1:PAccel);
  152. Var spos:Byte;
  153. BEGIN
  154.      IF a=NIL THEN
  155.      BEGIN
  156.           New(a);
  157.           a1:=a;
  158.      END
  159.      ELSE
  160.      BEGIN
  161.           a1:=a;
  162.           while a1^.next<>NIL do a1:=a1^.next;
  163.           new(a1^.next);
  164.           a1:=a1^.next;
  165.      END;
  166.      a1^.SubCount:=0;
  167.      a1^.SubSize:=0;
  168.      a1^.Flag:=0;
  169.      a1^.Next:=NIL;
  170.      a1^.Entries:=NIL;
  171. END;
  172.  
  173. PROCEDURE NewHelpTable(VAR h,h1:PHelpTable);
  174. Var spos:Byte;
  175. BEGIN
  176.      IF h=NIL THEN
  177.      BEGIN
  178.           New(h);
  179.           h1:=h;
  180.      END
  181.      ELSE
  182.      BEGIN
  183.           h1:=h;
  184.           while h1^.next<>NIL do h1:=h1^.next;
  185.           new(h1^.next);
  186.           h1:=h1^.next;
  187.      END;
  188.      h1^.Entries:=NIL;
  189.      h1^.Next:=NIL;
  190. END;
  191.  
  192. PROCEDURE NewHelpEntry(VAR h:PHelpTable;VAR h1:PHelpTableEntry);
  193. Var spos:Byte;
  194. BEGIN
  195.      IF h^.Entries=NIL THEN
  196.      BEGIN
  197.           New(h^.Entries);
  198.           h1:=h^.Entries;
  199.      END
  200.      ELSE
  201.      BEGIN
  202.           h1:=h^.Entries;
  203.           while h1^.next<>NIL do h1:=h1^.next;
  204.           new(h1^.next);
  205.           h1:=h1^.next;
  206.      END;
  207.      h1^.Next:=NIL;
  208. END;
  209.  
  210.  
  211. CONST AccelOpt:ARRAY[1..9] OF TStyle=(
  212.        (Name:'CHAR';Style:$0001),
  213.        (Name:'VIRTUALKEY';Style:$0002),
  214.        (Name:'SCANCODE';Style:$0004),
  215.        (Name:'SHIFT';Style:$0008),
  216.        (Name:'CONTROL';Style:$0010),
  217.        (Name:'ALT';Style:$0020),
  218.        (Name:'LONEKEY';Style:$0040),
  219.        (Name:'SYSCOMMAND';Style:$0100),
  220.        (Name:'HELP';Style:$0200)
  221.        );
  222.  
  223. CONST VirtualKeys:ARRAY[1..59] OF TStyle=(
  224.       (Name:'VK_BUTTON1';Style:$01),
  225.       (Name:'VK_BUTTON2';Style:$02),
  226.       (Name:'VK_BUTTON3';Style:$03),
  227.       (Name:'VK_BREAK';Style:$04),
  228.       (Name:'VK_BACKSPACE';Style:$05),
  229.       (Name:'VK_TAB';Style:$06),
  230.       (Name:'VK_BACKTAB';Style:$07),
  231.       (Name:'VK_NEWLINE';Style:$08),
  232.       (Name:'VK_SHIFT';Style:$09),
  233.       (Name:'VK_CTRL';Style:$0A),
  234.       (Name:'VK_ALT';Style:$0B),
  235.       (Name:'VK_ALTGRAF';Style:$0C),
  236.       (Name:'VK_PAUSE';Style:$0D),
  237.       (Name:'VK_CAPSLOCK';Style:$0E),
  238.       (Name:'VK_ESC';Style:$0F),
  239.       (Name:'VK_SPACE';Style:$10),
  240.       (Name:'VK_PAGEUP';Style:$11),
  241.       (Name:'VK_PAGEDOWN';Style:$12),
  242.       (Name:'VK_END';Style:$13),
  243.       (Name:'VK_HOME';Style:$14),
  244.       (Name:'VK_LEFT';Style:$15),
  245.       (Name:'VK_UP';Style:$16),
  246.       (Name:'VK_RIGHT';Style:$17),
  247.       (Name:'VK_DOWN';Style:$18),
  248.       (Name:'VK_PRINTSCRN';Style:$19),
  249.       (Name:'VK_INSERT';Style:$1A),
  250.       (Name:'VK_DELETE';Style:$1B),
  251.       (Name:'VK_SCRLLOCK';Style:$1C),
  252.       (Name:'VK_NUMLOCK';Style:$1D),
  253.       (Name:'VK_ENTER';Style:$1E),
  254.       (Name:'VK_SYSRQ';Style:$1F),
  255.       (Name:'VK_F1';Style:$20),
  256.       (Name:'VK_F2';Style:$21),
  257.       (Name:'VK_F3';Style:$22),
  258.       (Name:'VK_F4';Style:$23),
  259.       (Name:'VK_F5';Style:$24),
  260.       (Name:'VK_F6';Style:$25),
  261.       (Name:'VK_F7';Style:$26),
  262.       (Name:'VK_F8';Style:$27),
  263.       (Name:'VK_F9';Style:$28),
  264.       (Name:'VK_F10';Style:$29),
  265.       (Name:'VK_F11';Style:$2A),
  266.       (Name:'VK_F12';Style:$2B),
  267.       (Name:'VK_F13';Style:$2C),
  268.       (Name:'VK_F14';Style:$2D),
  269.       (Name:'VK_F15';Style:$2E),
  270.       (Name:'VK_F16';Style:$2F),
  271.       (Name:'VK_F17';Style:$30),
  272.       (Name:'VK_F18';Style:$31),
  273.       (Name:'VK_F19';Style:$32),
  274.       (Name:'VK_F20';Style:$33),
  275.       (Name:'VK_F21';Style:$34),
  276.       (Name:'VK_F22';Style:$35),
  277.       (Name:'VK_F23';Style:$36),
  278.       (Name:'VK_F24';Style:$37),
  279.       (Name:'VK_ENDDRAG';Style:$38),
  280.       (Name:'VK_CLEAR';Style:$39),
  281.       (Name:'VK_EREOF';Style:$3A),
  282.       (Name:'VK_PA1';Style:$3B)
  283.       );
  284.  
  285. PROCEDURE Read_Options(VAR flags:WORD);
  286. VAR s,Temp:STRING;
  287.     t:BYTE;
  288. Label l;
  289. BEGIN
  290. l:
  291.      SplitLine(Params,Temp,'|');
  292.      FOR t:=1 TO length(Temp) DO Temp[t]:=upcase(temp[t]);
  293.      FOR t:=1 TO 9 DO
  294.      BEGIN
  295.           IF AccelOpt[t].Name=temp THEN
  296.           BEGIN
  297.                Flags:=Flags or Accelopt[t].Style;
  298.                IF params<>'' THEN goto l;
  299.                exit;
  300.           END;
  301.      END;
  302.      Error('Illegal Accelerator flag:'+temp);
  303. END;
  304.  
  305. PROCEDURE ParseAccel;
  306. VAR a,a1:PAccel;
  307.     i:WORD;
  308.     i1:LONGINT;
  309.     c:Integer;
  310.     s:string;
  311. Label l,l1;
  312. BEGIN
  313.      INC(AccelCount);
  314.      val(params,i,c);
  315.      if c<>0 then
  316.      BEGIN
  317.           IF not SearchConstant(params,i1) THEN
  318.             error('Illegal numeric format');
  319.           i:=i1;
  320.      END;
  321.      params:='';
  322.      NewAccel(Accelerators,a);
  323.      a^.ident:=i;
  324.      Read_Line;
  325.      IF commanditem<>__BEGIN THEN Error('BEGIN expected');
  326.      Read_Line;
  327.      REPEAT
  328.            params:=command;
  329.            SplitLine(Params,s,',');
  330.            IF s[1]<>'"' THEN
  331.            BEGIN
  332.                 val(s,i,c);
  333.                 IF c<>0 THEN
  334.                 BEGIN
  335.                      FOR c:=1 TO 59 DO IF s=virtualkeys[c].name THEN goto l1;
  336.                      Error('Illegal constant:'+s);
  337. l1:
  338.                      i:=virtualkeys[c].Style;
  339.                 END;
  340.                 IF i>255 THEN Error('Range check');
  341.                 IF i<0 THEN Error('Range check');
  342.                 NewAccel(a^.Entries,a1);
  343.                 inc(a^.SubCount);
  344.                 a1^.name:=i;
  345.                 goto l;
  346.            END;
  347.            IF s[3]<>'"' THEN Error('Char expected');
  348.            delete(s,1,1);
  349.            dec(s[0]);
  350.            IF length(s)<>1 THEN Error('Char expected');
  351.            NewAccel(a^.Entries,a1);
  352.            inc(a^.SubCount);
  353.            a1^.name:=ord(s[1]);
  354. l:
  355.            a1^.Flag:=0;
  356.            SplitLine(params,s,',');
  357.            val(s,i,c);
  358.            if c<>0 then
  359.            BEGIN
  360.                 IF not SearchConstant(s,i1) THEN
  361.                   error('Illegal numeric format');
  362.                 i:=i1;
  363.            END;
  364.            a1^.ident:=i;
  365.            Read_Options(a1^.flag);
  366.            Read_Line;
  367.      UNTIL commanditem=__END;
  368.      a^.Subsize:=4+6*a^.subcount;
  369. END;
  370.  
  371. PROCEDURE ParseHelpTable;
  372. VAR h,h1:PHelpTable;
  373.     i:WORD;
  374.     i1:LONGINT;
  375.     c:Integer;
  376.     s:string;
  377.     count:WORD;
  378.     w1,w2,w3:WORD;
  379.     hi:PHelpTableEntry;
  380. Label l,l1;
  381. BEGIN
  382.      INC(HelpTableCount);
  383.      val(params,i,c);
  384.      if c<>0 then
  385.      BEGIN
  386.           IF not SearchConstant(params,i1) THEN
  387.             error('Illegal numeric format');
  388.           i:=i1;
  389.      END;
  390.      params:='';
  391.      NewHelpTable(HelpTables,h);
  392.      h^.ident:=i;
  393.      Read_Line;
  394.      IF commanditem<>__BEGIN THEN Error('BEGIN expected');
  395.      count:=0;
  396.      Read_Line;
  397.      REPEAT
  398.            IF commanditem<>__HELPITEM THEN Error('HELPITEM expected');
  399.            inc(count);
  400.  
  401.            SplitLine(params,s,',');
  402.            val(s,i,c);
  403.            if c<>0 then
  404.            BEGIN
  405.                 IF not SearchConstant(s,i1) THEN
  406.                   error('Illegal numeric format');
  407.                 i:=i1;
  408.            END;
  409.            w1:=i;
  410.  
  411.            SplitLine(params,s,',');
  412.            val(s,i,c);
  413.            if c<>0 then
  414.            BEGIN
  415.                 IF not SearchConstant(s,i1) THEN
  416.                   error('Illegal numeric format');
  417.                 i:=i1;
  418.            END;
  419.            w2:=i;
  420.  
  421.            SplitLine(params,s,',');
  422.            val(s,i,c);
  423.            if c<>0 then
  424.            BEGIN
  425.                 IF not SearchConstant(s,i1) THEN
  426.                   error('Illegal numeric format');
  427.                 i:=i1;
  428.            END;
  429.            w3:=i;
  430.  
  431.            NewHelpEntry(h,hi);
  432.            hi^.i1:=w1;
  433.            hi^.i2:=w2;
  434.            hi^.i3:=w3;
  435.            Read_Line;
  436.      UNTIL commanditem=__END;
  437.      h^.Subsize:=(count*8)+2;
  438. END;
  439.  
  440.  
  441. PROCEDURE ParseHelpSubTable;
  442. VAR h,h1:PHelpTable;
  443.     i:WORD;
  444.     i1:LONGINT;
  445.     c:Integer;
  446.     s:string;
  447.     count:WORD;
  448.     w1,w2,w3:WORD;
  449.     hi:PHelpTableEntry;
  450. Label l,l1;
  451. BEGIN
  452.      INC(HelpSubTableCount);
  453.      val(params,i,c);
  454.      if c<>0 then
  455.      BEGIN
  456.           IF not SearchConstant(params,i1) THEN
  457.             error('Illegal numeric format');
  458.           i:=i1;
  459.      END;
  460.      params:='';
  461.      NewHelpTable(HelpSubTables,h);
  462.      h^.ident:=i;
  463.      Read_Line;
  464.      IF commanditem<>__BEGIN THEN Error('BEGIN expected');
  465.      count:=0;
  466.      Read_Line;
  467.      REPEAT
  468.            IF commanditem<>__HELPSUBITEM THEN Error('HELPSUBITEM expected');
  469.            inc(count);
  470.  
  471.            SplitLine(params,s,',');
  472.            val(s,i,c);
  473.            if c<>0 then
  474.            BEGIN
  475.                 IF not SearchConstant(s,i1) THEN
  476.                   error('Illegal numeric format');
  477.                 i:=i1;
  478.            END;
  479.            w1:=i;
  480.  
  481.            SplitLine(params,s,',');
  482.            val(s,i,c);
  483.            if c<>0 then
  484.            BEGIN
  485.                 IF not SearchConstant(s,i1) THEN
  486.                   error('Illegal numeric format');
  487.                 i:=i1;
  488.            END;
  489.            w2:=i;
  490.  
  491.            NewHelpEntry(h,hi);
  492.            hi^.i1:=w1;
  493.            hi^.i2:=w2;
  494.            Read_Line;
  495.      UNTIL commanditem=__END;
  496.      h^.Subsize:=(count*4)+4;
  497. END;
  498.  
  499.  
  500. BEGIN
  501. END.