home *** CD-ROM | disk | FTP | other *** search
/ Mega Top 1 / os2_top1.zip / os2_top1 / APPS / PROG / PASCAL / SPEED2 / SRC / RCOMP / RCOMP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-09-29  |  16.9 KB  |  518 lines
  1. PROGRAM RComp;
  2.  
  3. {$m 32768}
  4.  
  5. {**************************************************************************
  6.  *                   Sourcefile für Speed-386                             *
  7.  *           Created using (c) Borland International 1993                 *
  8.  *        (C) 1993,94 R.Nürnberger Franz-Mehring-Str.2 09112 Chemnitz     *
  9.  *                                                                        *
  10.  * Beschreibung: Der Resourcencompiler für WIN-386                        *
  11.  *                                                                        *
  12.  **************************************************************************
  13.  }
  14.  
  15.  
  16. USES Dos,Crt,RcTypes,RcDialog,RcMenu,RcIcon,RcAccel,PMDialog;
  17.  
  18. RESOURCE RCOMP;
  19.  
  20. IMPORTS
  21.        FUNCTION WinGetPs(Win:HWND):HPS:                 'PMWIN' index 757;
  22.        FUNCTION WinReleasePs(ps:HPS):LONGWORD:          'PMWIN' index 848;
  23.        FUNCTION GpiCharStringAt(s:PString;Count:LONGWORD;
  24.                                 VAR Point:POINTL;hp:HPS):
  25.                                 LONGWORD:               'PMGPI' index 359;
  26.        FUNCTION GpiMove(VAR Point:POINTL;hp:HPS):LONGWORD:
  27.                                                         'PMGPI' index 404;
  28.        FUNCTION GpiBox(VRound,HRound:LONGWORD;VAR Point:POINTL;
  29.                        Control:LONGWORD;hp:HPS):LONGWORD:'PMGPI' index 356;
  30.        FUNCTION WinDrawBorder(flCmd,clrBack,ClrFore,cy,cx:LONGWORD;
  31.                               VAR rec:RECTL;hp:HPS):LONGWORD:'PMWIN' index 731;
  32.        PROCEDURE WinSetDlgItemtext(t:PString;item:LONGWORD;Dlg:HWND):
  33.                                                          'PMWIN' index 859;
  34.        FUNCTION DosCreateThread(Stack,Flags:LONGWORD;Para:POINTER;
  35.                                 Adr:POINTER;VAR tid:LONGWORD):
  36.                                  LONGWORD:               'DOSCALLS' index 311;
  37.        PROCEDURE DosKillThread(Tid:LONGWORD):            'DOSCALLS' index 111;
  38.        PROCEDURE WinDisMissDlg(result:LONGWORD;Dlg:HWND):'PMWIN' index 729;
  39.        FUNCTION WinBeginPaint1(prclPaint:PRECTL;
  40.                                _hps:HPS;_hwnd:HWND):
  41.                                LONGWORD:                 'PMWIN' index 703;
  42.        PROCEDURE DosSleep(p:LONGWORD):                   'DOSCALLS' index 229;
  43.        FUNCTION WinSetWindowPos(fl:LONGWORD;
  44.                                 cy,cx,y,x:LONGWORD;
  45.                                 hwndInsertBehind:HWND;
  46.                                 _hwnd:HWND):LONGWORD:   PMWIN index 875;
  47.        FUNCTION WinQueryWindowRect(VAR prclDest:RECTL;
  48.                                       _hwnd:HWND ):
  49.                                       LONGWORD:            PMWIN index 840;
  50.        FUNCTION WinDefDlgProc(Para2,Para1:POINTER;msg:LONGWORD;hwnddlg:HWND):
  51.                            LONGWORD:    PMWIn index 910;
  52.        FUNCTION WinDestroyWindow(_hwnd:HWND):
  53.                                     LONGWORD:              PMWIN index 728;
  54.        FUNCTION WinQueryWindowPos(_swp:SWP;
  55.                                      _hwnd:HWND):LONGWORD: PMWIN index 837;
  56.        FUNCTION WinQuerySysValue(iSysValue:LONGWORD;
  57.                                     hwndDesktop:HWND):
  58.                                     LONGWORD:              PMWIN index 829;
  59.        FUNCTION WinWindowFromID(id:LONGWORD;
  60.                                    hwndParent:HWND):HWND:  PMWIN index 899;
  61.        FUNCTION WinSetWindowText(psztext:PSZ;
  62.                                  _hwnd:HWND):LONGWORD:     PMWIN index 877;
  63.        FUNCTION WinPostMsg(mp2,mp1:POINTER;
  64.                               msg:LONGWORD;
  65.                               _hwnd:HWND):LONGWORD:        PMWIN index 919;
  66.        FUNCTION WinProcessDlg(hwndDlg:HWND):LONGWORD: PMWIN index 796;
  67. END;
  68.  
  69.  
  70.  
  71. TYPE
  72.     TResDialog=Object(TDialog)
  73.                  CONSTRUCTOR Init(Parent,Owner:HWND;hmod:HModule;idDlg:LONGWORD;
  74.                                   PCreateParams:Pointer);
  75.                  DESTRUCTOR Done;
  76.                  FUNCTION DialogHandleEvent(Dlg:HWND;msg:LONGWORD;Para1,Para2:
  77.                                             LONGWORD;VAR Handled:BOOLEAN):
  78.                                             LONGWORD:VIRTUAL;
  79.               END;
  80.  
  81.     TSuccErrDialog=Object(TDialog)
  82.                  CONSTRUCTOR Init(Parent,Owner:HWND;hmod:HModule;idDlg:LONGWORD;
  83.                                   PCreateParams:Pointer);
  84.                  DESTRUCTOR Done;
  85.                  FUNCTION DialogHandleEvent(Dlg:HWND;msg:LONGWORD;Para1,Para2:
  86.                                             LONGWORD;VAR Handled:BOOLEAN):
  87.                                             LONGWORD:VIRTUAL;
  88.                    END;
  89.  
  90. VAR
  91.    ResLen:LONGINT;
  92.    Temp:word;
  93.    _About:TDialog;
  94.    _succ,_err:TSuccErrDialog;
  95.    ___r:LONGWORD;
  96.    __D:TResDialog;
  97.    ResTid:LONGWORD;
  98.    ErrStr:STRING;
  99.  
  100. CONST
  101.    StringCount:WORD=0;
  102.  
  103.  
  104. FUNCTION TResDialog.DialogHandleEvent(Dlg:HWND;msg:LONGWORD;Para1,Para2:
  105.                                      LONGWORD;VAR Handled:BOOLEAN):LONGWORD;
  106. VAR H:BOOLEAN;
  107.     r:LONGWORD;
  108.     hp:HPS;
  109.     s:String;
  110.     pt:POINTL;
  111.     ScrWidth,Scrheight:LONGWORD;
  112.     Rec:RECTL;
  113.     _Swp:SWP;
  114.     command:WORD;
  115.     __DirS:DirStr;
  116.     __NameS:NameStr;
  117.     __ExtS:ExtStr;
  118. BEGIN
  119.      r:=Inherited.DialogHandleEvent(Dlg,msg,para1,para2,Handled);
  120.      H:=TRUE;
  121.      CASE msg OF
  122.          WM_INITDLG:
  123.          BEGIN
  124.               {Center dialog on screen}
  125.               ScrWidth:=WinQuerySysValue (20{SV_CXSCREEN},1{HWND_DESKTOP});
  126.               ScrHeight:=WinQuerySysValue (21{SV_CYSCREEN},1{HWND_DESKTOP});
  127.               WinQueryWindowRect (rec,Dlg);
  128.               WinSetWindowPos ($82{SWP_MOVE OR SWP_ACTIVATE},0,0,
  129.                                (ScrHeight-rec.ytop) DIV 2,
  130.                                (ScrWidth-Rec.XRight) DIV 2,
  131.                                3{HWND_TOP},Dlg);
  132.          END;
  133.          WM_PAINT:
  134.          BEGIN
  135.               s:=QuellDat;  {Main file:}
  136.               WinSetDlgItemText (s,2002,Dlg); {Main file:}
  137.               WinSetDlgItemText (s,2003,Dlg); {Assembling:}
  138.  
  139.               r:=WinDefDlgProc(POINTER(para2),POINTER(para1),msg,Dlg);
  140.  
  141.               hp:=WinGetPs(Dlg);
  142.  
  143.               WinQueryWindowRect (rec,Dlg);
  144.               GpiMove (POINTL(rec),hp);
  145.               dec(Rec.xRight);
  146.               dec(Rec.yTop);
  147.               GpiBox (0,0,POINTL(rec.xright),2,hp);
  148.               WinQueryWindowPos (_Swp,WinWindowFromID (2000,Dlg));
  149.               Rec.xLeft:= _Swp.x-1;
  150.               Rec.yBottom:= _Swp.y-1;
  151.               Rec.xRight:= _Swp.x + _Swp.cx + 1;
  152.               Rec.yTop:= _Swp.y + _Swp.cy + 1;
  153.               WinDrawBorder($800,CLR_WHITE,CLR_DARKGRAY,
  154.                             1,1,rec,hp);
  155.               WinQueryWindowPos (_Swp,WinWindowFromID (2001,Dlg));
  156.               Rec.xLeft:= _Swp.x-1;
  157.               Rec.yBottom:= _Swp.y-1;
  158.               Rec.xRight:= _Swp.x + _Swp.cx + 1;
  159.               Rec.yTop:= _Swp.y + _Swp.cy + 1;
  160.               WinDrawBorder($800,CLR_WHITE,CLR_DARKGRAY,
  161.                             1,1,rec,hp);
  162.               WinReleasePs(hp); {Canvas Handle free}
  163.          END;
  164.          WM_DISMISS:
  165.          BEGIN
  166.               WinDisMissDlg(1,ResDlg);
  167.               ErrorDetected:=BOOLEAN(Para1);
  168.          END;
  169.          WM_USER_DRAW_M: {Draw Main file}
  170.          BEGIN
  171.               s:=Quelldat;
  172.               IF Length(s)>30 THEN
  173.               BEGIN
  174.                    FSplit(s,__dirs,__names,__exts);
  175.                    s:='...\'+__names+'.'+__exts;
  176.               END;
  177.               WinSetDlgItemText (s,2002,Dlg); {Main file:}
  178.          END;
  179.          WM_USER_DRAW_A: {Draw current file}
  180.          BEGIN
  181.               s:=Quelldat;
  182.               IF Length(s)>30 THEN
  183.               BEGIN
  184.                    FSplit(s,__dirs,__names,__exts);
  185.                    s:='...\'+__names+'.'+__exts;
  186.               END;
  187.               WinSetDlgItemText (s,2003,Dlg); {Assembling:}
  188.          END;
  189.          WM_COMMAND:
  190.          BEGIN
  191.               command:=Word(Para1);
  192.               IF command=2005 {Cancel} THEN
  193.               BEGIN
  194.                    WinDisMissDlg(1,Dlg);
  195.                    err:='User break';
  196.                    ErrorDetected:=TRUE;  {Cancel pressed}
  197.               END
  198.               ELSE H:=FALSE;
  199.          END;
  200.          ELSE IF not Handled THEN H:=FALSE;
  201.      END; {case}
  202.  
  203.      Handled:=H;
  204.      DialogHandleEvent:=r;
  205. END;
  206.  
  207. CONSTRUCTOR TResDialog.Init(Parent,Owner:HWND;hmod:HModule;idDlg:LONGWORD;
  208.                            PCreateParams:Pointer);
  209. BEGIN
  210.      Inherited.Init(Parent,Owner,hmod,idDlg,PCreateParams);
  211. END;
  212.  
  213. DESTRUCTOR TResDialog.Done;
  214. BEGIN
  215. END;
  216.  
  217. FUNCTION TSuccErrDialog.DialogHandleEvent(Dlg:HWND;msg:LONGWORD;Para1,Para2:
  218.                                      LONGWORD;VAR Handled:BOOLEAN):LONGWORD;
  219. VAR H:BOOLEAN;
  220.     r:LONGWORD;
  221.     hp:HPS;
  222.     s:String;
  223.     pt:POINTL;
  224.     ScrWidth,Scrheight:LONGWORD;
  225.     Rec:RECTL;
  226.     _Swp:SWP;
  227.     command:WORD;
  228. BEGIN
  229.      r:=0;
  230.      H:=TRUE;
  231.      CASE msg OF
  232.          WM_INITDLG:
  233.          BEGIN
  234.               {Center dialog on screen}
  235.               ScrWidth:=WinQuerySysValue (20{SV_CXSCREEN},1{HWND_DESKTOP});
  236.               ScrHeight:=WinQuerySysValue (21{SV_CYSCREEN},1{HWND_DESKTOP});
  237.               WinQueryWindowRect (rec,Dlg);
  238.               WinSetWindowPos ($82{SWP_MOVE OR SWP_ACTIVATE},0,0,
  239.                                (ScrHeight-rec.ytop) DIV 2,
  240.                                (ScrWidth-Rec.XRight) DIV 2,
  241.                                3{HWND_TOP},Dlg);
  242.          END;
  243.          WM_PAINT:
  244.          BEGIN
  245.               r:=WinDefDlgProc(POINTER(para2),POINTER(para1),msg,Dlg);
  246.  
  247.               hp:=WinGetPs(Dlg);
  248.               WinQueryWindowRect (rec,Dlg);
  249.               GpiMove (POINTL(rec),hp);
  250.               dec(Rec.xRight);
  251.               dec(Rec.yTop);
  252.               GpiBox (0,0,POINTL(rec.xright),2,hp);
  253.               WinQueryWindowPos (_Swp,WinWindowFromID (2000,Dlg));
  254.               Rec.xLeft:= _Swp.x-1;
  255.               Rec.yBottom:= _Swp.y-1;
  256.               Rec.xRight:= _Swp.x + _Swp.cx + 1;
  257.               Rec.yTop:= _Swp.y + _Swp.cy + 1;
  258.               WinDrawBorder($800,CLR_WHITE,CLR_DARKGRAY,
  259.                             1,1,rec,hp);
  260.               WinQueryWindowPos (_Swp,WinWindowFromID (2001,Dlg));
  261.               Rec.xLeft:= _Swp.x-1;
  262.               Rec.yBottom:= _Swp.y-1;
  263.               Rec.xRight:= _Swp.x + _Swp.cx + 1;
  264.               Rec.yTop:= _Swp.y + _Swp.cy + 1;
  265.               WinDrawBorder($800,CLR_WHITE,CLR_DARKGRAY,
  266.                             1,1,rec,hp);
  267.               WinReleasePs(hp); {Canvas Handle free}
  268.          END;
  269.          WM_COMMAND:
  270.          BEGIN
  271.               command:=Word(Para1);
  272.               IF command=2005 {Ok} THEN
  273.               BEGIN
  274.                    WinDisMissDlg(1,Dlg);
  275.               END
  276.               ELSE H:=FALSE;
  277.          END;
  278.          ELSE IF not Handled THEN H:=FALSE;
  279.      END; {case}
  280.  
  281.      Handled:=H;
  282.      DialogHandleEvent:=r;
  283. END;
  284.  
  285. CONSTRUCTOR TSuccErrDialog.Init(Parent,Owner:HWND;hmod:HModule;idDlg:LONGWORD;
  286.                            PCreateParams:Pointer);
  287. BEGIN
  288.      Inherited.Init(Parent,Owner,hmod,idDlg,PCreateParams);
  289. END;
  290.  
  291. DESTRUCTOR TSuccErrDialog.Done;
  292. BEGIN
  293. END;
  294.  
  295. PROCEDURE Parse_line;
  296. BEGIN
  297.      CASE Commanditem OF
  298.        __MENU:ParseMenu;
  299.        __ICON,__POINTER:ParseIcon;
  300.        __BITMAP:ParseBitMap;
  301.        __CONST:ParseConst;
  302.        __DLGTEMPLATE:ParseDialog;
  303.        __ACCELTABLE:ParseAccel;
  304.        __HELPTABLE:ParseHelpTable;
  305.        __HELPSUBTABLE:ParseHelpSubTable;
  306.        __END:;
  307.        else error('Command '+command+' not found');
  308.      END; {CASE}
  309. END;
  310.  
  311. PROCEDURE Parse;
  312. BEGIN
  313.      WHILE not eof(quellf) DO
  314.      BEGIN
  315.           Read_line;
  316.           Parse_line;
  317.      END;
  318. END;
  319.  
  320.  
  321. PROCEDURE RunResComp;
  322. VAR p:POINTER;
  323. Label l;
  324. BEGIN
  325.      Quelline:=0;
  326.      Dialogs:=NIL;
  327.      Menus:=NIL;
  328.      Icons:=NIL;
  329.      Bitmaps:=NIL;
  330.      Constants:=NIL;
  331.      Accelerators:=NIL;
  332.      HelpTables:=NIL;
  333.      HelpSubTables:=NIL;
  334.      DialogCount:=0;
  335.      AccelCount:=0;
  336.      HelptableCount:=0;
  337.      HelpSubTableCount:=0;
  338.      IconCount:=0;
  339.      BitmapCount:=0;
  340.      MenuCount:=0;
  341.      Assign(quellf,quelldat);
  342.      reset(quellf,1);
  343.      if ioresult<>0 then error('Could not open sourcefile '+quelldat);
  344.      Assign(zielf,zieldat);
  345.      rewrite(zielf,1);
  346.      if ioresult<>0 then error('Could not open destination file '+zieldat);
  347.      {writeln('Compiling...');}
  348.      Parse;
  349.      close(quellf);
  350.      if ioresult<>0 then error('Could not close sourcefile');
  351.      {writeln('Successfull...');
  352.      writeln('Generating '+zieldat);}
  353.  
  354.      WriteWord(BitmapCount); {Anzahl Bitmaps}
  355.      WriteWord(IconCount);   {Anzahl Icons}
  356.      WriteWord(MenuCount);   {Anzahl Menus}
  357.      WriteWord(dialogcount); {Anzahl Dialoge}
  358.      WriteWord(AccelCount);  {Anzahl Acceleratortabellen}
  359.      WriteWord(HelptableCount);  {Anzahl Helptabletabellen}
  360.      WriteWord(HelpSubtableCount);  {Anzahl HelpSubtabletabellen}
  361.  
  362.      ResLen:=0;
  363.  
  364.      TempIcon:=Bitmaps;
  365.      while TempIcon<>NIL do
  366.      begin
  367.           ResLen:=ResLen+TempIcon^.subsize;
  368.           TempIcon:=TempIcon^.next;
  369.      end;
  370.  
  371.      TempIcon:=Icons;
  372.      while TempIcon<>NIL do
  373.      begin
  374.           ResLen:=ResLen+TempIcon^.subsize;
  375.           TempIcon:=TempIcon^.next;
  376.      end;
  377.  
  378.      TempMenu:=Menus;
  379.      while TempMenu<>NIL do
  380.      begin
  381.           ResLen:=ResLen+TempMenu^.subsize;
  382.           TempMenu:=TempMenu^.next;
  383.      end;
  384.  
  385.      TempDialog:=Dialogs;
  386.      while TempDialog<>NIL do
  387.      begin
  388.           ResLen:=ResLen+TempDialog^.subsize;
  389.           TempDialog:=TempDialog^.next;
  390.      end;
  391.  
  392.      TempAccel:=Accelerators;
  393.      while TempAccel<>NIL do
  394.      begin
  395.           ResLen:=ResLen+TempAccel^.subsize;
  396.           TempAccel:=TempAccel^.next;
  397.      end;
  398.  
  399.      TempHelptable:=HelpTables;
  400.      while Temphelptable<>NIL do
  401.      begin
  402.           ResLen:=ResLen+TempHelptable^.subsize;
  403.           TemphelpTable:=Temphelptable^.next;
  404.      end;
  405.  
  406.      TempHelpSubtable:=HelpSubTables;
  407.      while TemphelpSubtable<>NIL do
  408.      begin
  409.           ResLen:=ResLen+TempHelpSubtable^.subsize;
  410.           TemphelpSubTable:=TemphelpSubtable^.next;
  411.      end;
  412.  
  413.      Blockwrite(Zielf,ResLen,4);
  414.      if ioresult<>0 then error('File write error');
  415.  
  416.      {Zuerst die Bitmaps}
  417.      Write_Bitmaps;
  418.  
  419.      {jetzt die Icons}
  420.      Write_Icons;
  421.  
  422.      {Jetzt die Menus}
  423.      Write_Menus;
  424.  
  425.      {jetzt die Dialoge}
  426.      Write_Dialogs;
  427.  
  428.      {Jetzt die Acceleratortabellen}
  429.      Write_Accels;
  430.  
  431.      {Hifetabellen}
  432.      Write_HelpTables;
  433.  
  434.      {Hilfesubtabellen}
  435.      Write_HelpSubTables;
  436.  
  437.      {Die Daten der einzelnen Ressourcen}
  438.      Write_Res_Icons(Bitmaps);
  439.      Write_Res_Icons(Icons);
  440.      Write_Res_Menus;
  441.      Write_Res_Dialogs;
  442.      Write_Res_Accels;
  443.      Write_Res_Helptables;
  444.      Write_Res_HelpSubTables;
  445.  
  446.      for temp:=1 to 10 do writeword(0);
  447.  
  448.      close(zielf);
  449.      if ioresult<>0 then error('Could not close destination file');
  450.      {writeln('Ressource file created !');}
  451.  
  452.      ErrorDetected:=FALSE;
  453.      p:=NIL; {No error detected}
  454.      WinPostMsg(NIL,p,WM_DISMISS,ResDlg); {Delete dialog window}
  455. l:
  456.      goto l;  {Thread is killed by parent process}
  457. END;
  458.  
  459. BEGIN
  460.      if Paramcount=0 Then
  461.      BEGIN
  462.            _About.Init(1,0,0,4000,NIL);
  463.            _About.ExecDialog(___r);
  464.            _About.Done;
  465.            Halt(0);
  466.      END;
  467.      {writeln;
  468.      writeln('Ressource compiler for OS/2 V0.1 BETA (1994)');
  469.      writeln('(C) 1994 Rene Nürnberger');}
  470.      QuellDat:=Paramstr(1);
  471.      fsplit(Quelldat,d,n,e);
  472.      if e='' then e:='.RC';
  473.      if d='' then getdir(0,d);
  474.      if d[length(d)]='\' then dec(d[0]);
  475.      quelldat:=d+'\'+n+e;
  476.      If Paramcount=2 Then ZielDat:=Paramstr(2)
  477.      Else Zieldat:=d;
  478.      IF Zieldat[length(zieldat)]='\' then dec(zieldat[0]);
  479.      Zieldat:=Zieldat+'\'+n+'.RES';
  480.      ErrorDetected:=FALSE;
  481.      err:='';
  482.      __D.Init(1,0,0,1005,NIL);  {load dialog}
  483.      __D.GetDlg(ResDlg);
  484.      DosCreateThread(32768,2,NIL,@RunResComp,ResTid);
  485.      WinProcessDlg(ResDlg);  {Process the dialog}
  486.  
  487.      DosKillThread(ResTid);  {Kill the parent thread}
  488.      WinDestroyWindow(ResDlg);
  489.      {The program will return to here if main program is terminated}
  490.      __D.Done;
  491.      IF ErrorDetected THEN
  492.      BEGIN
  493.           _Err.Init(1,0,0,3001,NIL);
  494.           _Err.GetDlg(ResDlg);
  495.           Errstr:='Error detected in line:'+tostr(quelline);
  496.           WinSetDlgItemText (Errstr,1007,ResDlg); {Main file:}
  497.           Errstr:='"'+err+'"';
  498.           WinSetDlgItemText(Errstr,1009,ResDlg);
  499.           Errstr:='Work file:'+Quelldat;
  500.           WinSetDlgItemText (ErrStr,1008,ResDlg)
  501.           Beep(1200,300);
  502.           _Err.ExecDialog(___r);
  503.           _Err.Done;
  504.     END
  505.     ELSE
  506.     BEGIN
  507.          Beep(800,50);
  508.          Beep(1000,30);
  509.          Beep(1300,50);
  510.          _Succ.Init(1,0,0,3000,NIL);
  511.          _Succ.GetDlg(ResDlg);
  512.          Errstr:='Work file:'+Quelldat;
  513.          WinSetDlgItemText (ErrStr,1008,ResDlg)
  514.          _Succ.ExecDialog(___r);
  515.          _Succ.Done;
  516.     END;
  517. END.
  518.