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