home *** CD-ROM | disk | FTP | other *** search
/ Fifty: Elektronik / FIFTY Elektronik (PS_Computer_Vertrieb).iso / ps8 / fty1017 / gepackt.exe / DISK2 / PLOTSRC.EXE / VORLAGE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-10  |  22.6 KB  |  839 lines
  1. {$O+,R-,S-,B-,I+,F+}
  2. Unit VORLAGE;
  3.  
  4. Interface
  5.  
  6. uses
  7.   Crt,
  8.   Dos,
  9.   StrTool,
  10.   GEDDEFS,
  11.   KEYSCRN,
  12.   PLOTSYS,
  13.   PLOTSTOR,
  14.   PLSteuer,
  15.   PLGLOB;
  16.  
  17.  
  18.  
  19. Function Hole_Format(Var Fn   :Str64;
  20.                      Var Name :Str15;
  21.                      Var Df   :Druckparams;
  22.                      Var RecNr: Integer):Integer;
  23. { 0 = gefunden, -1 = nicht gefunden >0 :Ioerror }
  24.  
  25. Procedure  SetParams(D :Druckparams;Batch :Boolean);
  26.  
  27. Procedure  GetParams(Var D :Druckparams);
  28.  
  29. Procedure Vorlage_Laden;
  30.  
  31. Procedure Vorlage_Speichern;
  32.  
  33. Procedure Vorlage_loeschen;
  34.  
  35. Procedure BatchInit;
  36.  
  37.  
  38.  
  39. implementation
  40.  
  41. Const GEDDY50ID='GED-PDF-50';
  42.       GEDDY55ID='GED-PDF-55';
  43.       Suffix   ='.PDF';
  44.  
  45. Type
  46.  
  47. Oldparams =Record
  48.                FileID     :Str10; { enthält GEDDY-PAR}
  49.                PARname    :Str15; { 12 Zeichen       }
  50.                InitString,
  51.                ExitString :Str64;
  52.                Librarypath:Str64;
  53.                Faktor     :System.Real;
  54.                D_PenWidth   :System.Real;
  55.                D_PenSpeed   :Integer;
  56.                LinScal1,
  57.                LinScal2   :System.Real;
  58.                Ursprung   :Koord;
  59.                D_Offset   :Koord; { 0.1 mm Schritte }
  60.                D_Fenster1 :Koord; { 0.1 mm Schritte }
  61.                D_Fenster2 :Koord; { 0.1 mm Schritte }
  62.                D_Pens     :Array[1..8] of Byte;
  63.                D_LineWidth:Array[1..8] of Byte;
  64.                D_Layers   :set of 0..7;
  65.                D_Adapt    :Boolean;
  66.                D_Mirror   :Boolean;
  67.                D_Portrait :Boolean;
  68.                D_Zurueck  :Boolean;
  69.                D_Farbe    :Byte;
  70.                D_Modus    :Byte;
  71.                LoetStopInc:System.Real;
  72.                D_Absolut  :Boolean;{ Laser }
  73.                D_Position :Koord;  { nur LaserDrucker }
  74.                D_Erweiter :Array[1..86] of Byte;
  75.                {Record-Länge =384 Bytes }
  76.              end;
  77.  
  78. Procedure Convert_oldRec(Old:OldParams;Var New:DruckParams);
  79. Var I:Integer;
  80. begin
  81.    With new Do
  82.    begin
  83.      FileID:=GEDDY55ID;
  84.      ParName:=Old.PARname;
  85.      InitString:=Old.InitString;
  86.      ExitString:=Old.ExitString;
  87.      Librarypath:=Old.Librarypath;
  88.      Faktor:=Old.Faktor;
  89.      For I:=1 to MaxLayer+1 do
  90.              D_PenInfo[I].Penwidth:=Old.D_PenWidth;
  91.      PenSpeed:=Old.D_PenSpeed;
  92.      LinScal1:=Old.LinScal1/SetUpInfo.PinstInfo.LinescaleFac;
  93.      LinScal2:=Old.LinScal2/SetUpInfo.PinstInfo.LinescaleFac;
  94.      Ursprung:=Old.Ursprung;
  95.      D_offset:=Old.D_Offset;
  96.      D_Fenster1:=Old.D_Fenster1;
  97.      D_Fenster2:=Old.D_Fenster2;
  98.      For I:=1 to 8 do D_PenInfo[I].PenNr:=Old.D_Pens[I];
  99.      For I:=9 to MaxLayer+1 do D_PenInfo[I].PenNr:=1;
  100.      D_Layers:=[8..MaxLayer]+Old.D_Layers;
  101.      D_adapt:=Old.D_Adapt;
  102.      D_Mirror:=Old.D_Mirror;
  103.      D_portrait:=Old.D_Portrait;
  104.      D_zurueck:=Old.D_Zurueck;
  105.      D_farbe:=Old.D_Farbe;
  106.      D_modus:=Old.D_Modus;
  107.      LoetstopInc:=Old.LoetStopInc;
  108.      D_absolut:=Old.D_Absolut;
  109.      D_position.X:=0;{Old.D_Position;}
  110.      D_Position.Y:=0;
  111.      D_TextWidth:=0.08;
  112.    end;
  113. end;
  114.  
  115. Procedure Convert_50REC(Var New:DruckParams);
  116. Var I:Integer;
  117. begin
  118.    With new Do
  119.    begin
  120.      If FileID<>GEDDY50ID then Exit;
  121.      FileID:=GEDDY55ID;
  122.    end;
  123. end;
  124.  
  125.  
  126. Function Exist_n_Conv(Fname:Str64):Boolean;
  127.  
  128. Var Path :Str64;
  129.     Name :Str64;
  130.     Ext  :ExtStr;
  131.     Neu  :DruckParams;
  132.     Old  :Oldparams;
  133.     F    :File of Oldparams;
  134.     Fneu :File of Druckparams;
  135.     Ok   :Boolean;
  136.     Procedure Check;
  137.     begin
  138.       If Ioresult=0 then Exit;
  139.       Ok:=false;
  140.     end;
  141. begin
  142.   {$I-}
  143.   Assign(F,Fname);
  144.   Reset(F);
  145.   OK:=IOresult=0;
  146.   Read(F,Old);
  147.   OK:=(IOresult=0) and Ok;
  148.   If OK then
  149.     begin
  150.       Close(F);
  151.       OK:=IOresult=0;
  152.   end;
  153.   {$I+}
  154.   Exist_n_Conv:=Ok;
  155.   If Not(Ok) then Exit;
  156.   If Old.FileID=GEDDY50ID then Exit;
  157.   If Old.FileID=GEDDY55ID then Exit;
  158.   Fsplit(Fname,Path,Name,Ext);
  159.   Assign(F,Fname);
  160.   Name:='GED$$$$.TMP';
  161.   ProcessFilename(Path,Name);
  162.   Rename(F,Name);Check;
  163.   Reset(F);Check;
  164.   Assign(Fneu,Fname);
  165.   Rewrite(Fneu);Check;
  166.   While Not(Eof(F)) and Ok do
  167.    begin
  168.      Read(F,Old);Check;
  169.      Convert_OldRec(Old,Neu);
  170.      Write(Fneu,Neu);Check;
  171.    end;
  172.   Close(F); Check;
  173.   Erase(F); Check;
  174.   Close(Fneu); Check;
  175.   Exist_N_Conv:=Ok;
  176. end;
  177.  
  178. Procedure SelectParam(Var FormFile :Str64;
  179.                       Var Format   :Druckparams;
  180.                       Var TC       :Char);
  181.  
  182.  
  183. Const maxdir =255;
  184.  
  185. type
  186.   List_Entry  = Record
  187.                   Inh   :Str15;
  188.                   RecNr :Integer;
  189.                 end;
  190.  
  191.   list = array[1..maxdir] of List_Entry;
  192. var
  193.   DirList        : list;
  194.   Taste          : Char;
  195.   NDirList,first,
  196.   Last,OldFirst,
  197.   FlipPos,OldFlip:Integer;
  198.   Color          :Byte;
  199.   M_Save:Char;
  200.   Dparfile       :File of Druckparams;
  201.   ErrorNr        :Integer;
  202.   ErrorMsg       :Str64;
  203.   FileOpen       :Boolean;
  204.  
  205.   Procedure GetDirectory;
  206.   Var   Dpar  :Druckparams;
  207.         c,rn,i:Integer;
  208.         Mask :Str80;
  209.         TC :Char;
  210.  
  211.     procedure quicksort(var a: list; Lo,Hi: integer);
  212.       Var     x,y: List_Entry;
  213.       procedure sort(l,r: integer);
  214.        var   i,j: integer;
  215.        begin
  216.          i:=l; j:=r; x:=a[(l+r) DIV 2];
  217.          repeat
  218.            while a[i].Inh<x.Inh do i:=i+1;
  219.            while x.Inh<a[j].Inh do j:=j-1;
  220.            if i<=j then
  221.              begin
  222.                y:=a[i]; a[i]:=a[j]; a[j]:=y;
  223.                i:=i+1; j:=j-1;
  224.              end;
  225.          until i>j;
  226.          if l<j then sort(l,j);
  227.          if i<r then sort(i,r);
  228.        end;
  229.     begin
  230.       sort(Lo,Hi);
  231.     end;
  232.  
  233.   begin { procedure GetDirectory }
  234.     c:=0;
  235.     rn:=0;
  236.     ErrorMsg:='Datei enthält keine Druckformate';
  237.     {$I-}
  238.     Reset(Dparfile);
  239.     ErrorNr:=ioresult;
  240.     FileOpen:=ErrorNr=0;
  241.     While Not(Eof(Dparfile)) and (C<Maxdir) and (ErrorNr=0) do
  242.       begin
  243.         Read(Dparfile,dpar);
  244.         ErrorNr:=Ioresult;
  245.         If (ErrorNr=0) and (Dpar.ParName<>'') then
  246.         begin
  247.           c := Succ(c);
  248.           With DirList[c] Do
  249.           begin
  250.             Inh:=dpar.Parname;
  251.             RecNr:=rn;
  252.           end;
  253.         end;
  254.         Inc(Rn,1);
  255.       end;
  256.     NDirList:=c;
  257.     {$I+}
  258.     If ErrorNr>0 then
  259.        begin
  260.          NDirList:=0;
  261.          If ErrorNr =2 then ErrorMsg:='Datei nicht gefunden '
  262.          else
  263.          begin
  264.            ErrorMSG:='Disketten-Lesefehler';
  265.            DiskErrors(-ErrorNr);
  266.            TC:=SelectError(DiskError+'- <Esc>','Fehler',[ESc]);
  267.          end;
  268.        end;
  269.     Quicksort(Dirlist,1,c);
  270.     First:=1;
  271.     Last:=First+49;
  272.     If Last>NdirList then Last:=NdirList;
  273.     FlipPos:=First;
  274.   end;
  275.  
  276.   Procedure ShowDir(First,Last:Integer;Var Error :Str64);
  277.   Var I:Integer;
  278.       S:Str80;
  279.   begin
  280.     MakeFrame(wind_dir,ModeWinCol,1);
  281.     WriteToWindow(wind_dir,10,12,ModeHeadCol,
  282.     ' Cursortasten: wählen, <Ret>: bestätigen, <ESC>: Ende ');
  283.     WriteToWindow(wind_dir,3,1,ModeHeadCol,' '+FormFile+' ');
  284.     If Last>First+49 then Last:=First+49;
  285.     FillChar(S,Sizeof(S),32);
  286.     S[0]:=#70;
  287.     For I:=1 to 10 do
  288.       WritetoWindow(Wind_dir,4,1+I,ModeNorCol,S);
  289.     For I:=First to Last  do
  290.      begin
  291.        With Dirlist[I] do
  292.          WritetoWindow(Wind_dir,4+((I-First) mod 5)*14,2+((I-First) div 5),
  293.                     ModeNorCol,Inh);
  294.      end;
  295.      If Ndirlist<1 then
  296.        WritetoWindow(Wind_dir,18,5,ModeLowCol,Error);
  297.   end;
  298.  
  299.   Procedure FlipDir(P:Integer;Color:Byte);
  300.   Var X,Y :Integer;
  301.   begin
  302.     X:=wind_dir.x1+3+((P-First) mod 5)*14;
  303.     Y:=Wind_dir.Y1+1+((P-First) div 5);
  304.     FlipLine(X,Y,Color,12);
  305.   end;
  306.  
  307. BEGIN
  308.   TC:=#0;
  309.   M_Save:=Mouse_Left;
  310.   Mouse_Left:=^M;
  311.   Assign(Dparfile,Formfile);
  312.   GetDirectory;
  313.   MakeWindow(wind_dir,3,9,74,12,ModeWinCol,wok);
  314.   ShowDir(First,Last,ErrorMsg);
  315.   PutWindow (wind_dir,wok);                { Menü anzeigen }
  316.   If NdirList >0 Then FlipDir(FlipPos,ModeFlpCol);
  317.   IF wok<>0 THEN
  318.   begin
  319.     Mouse_Left:=M_save;
  320.     EXIT;
  321.   end;
  322.    Repeat
  323.       Taste:=GetKey([Mouse_Left,^E,^S,^D,^X,^M,^A,^F,^Q,^Z,^M,Esc,
  324.                      'A'..'Z','a'..'z','0'..'9','-','$','#','&','_',
  325.                      #128..#160]);
  326.       If NdirList>0 then
  327.       begin
  328.         OldFlip:=FlipPos;
  329.         OldFirst:=First;
  330.         Case Taste of
  331.         'A'..'Z','a'..'z',
  332.         '0'..'9','-',
  333.         '$','#','&','_',
  334.         #128..#160        :begin
  335.                              FlipPos:=1;
  336.                              While (Upcase(DirList[FlipPos].Inh[1])<Upcase(Taste))
  337.                                    and (FlipPos<NDirList) Do Inc(FlipPos);
  338.                            end;
  339.         ^S :FlipPos:=FlipPos-1;(*Pfeil links *)
  340.         ^D :FlipPos:=FlipPos+1;(*Pfeil rechts*)
  341.         ^E :FlipPos:=FlipPos-5;(*Pfeil rauf  *)
  342.         ^X :FlipPos:=FlipPos+5;(*Pfeil runter*)
  343.         ^A :FlipPos:=1;(*Anfang      *)
  344.         ^F :FlipPos:=Ndirlist;(*ende        *)
  345.         ^Q :FlipPos:=FlipPos+45;(*Page-down   *)
  346.         ^Z :FlipPos:=FlipPos-45;(*Page-up     *)
  347.         end;
  348.         If OldFlip<>FlipPos Then
  349.         begin
  350.           If FlipPos<1 then FlipPos:=1;
  351.           If FlipPos>NdirList Then FlipPos:=Ndirlist;
  352.           If (FlipPos<First) or (FlipPos>Last) then
  353.              First:=((FlipPos-1) div 5) *5 +1;
  354.           If First>Ndirlist-45 Then
  355.             First:=((Ndirlist-46) div 5)*5+1;
  356.           If First<1 Then First:=1;
  357.             Last:=First+49;
  358.           If Last>NdirList then Last:=NdirList;
  359.           If OldFirst<>First Then
  360.             begin
  361.               Showdir(First,Last,ErrorMsg);
  362.               ShowWindow(Wind_dir);
  363.               FlipDir(FlipPos,ModeFlpCol);
  364.             end
  365.           else
  366.             begin
  367.               FlipDir(OldFlip,ModeNorCol);
  368.               FlipDir(FlipPos,ModeFlpCol);
  369.             end;
  370.         end;
  371.       end;
  372.    UNTIL Taste IN [^M,Esc,Mouse_left];
  373.    TC:=Taste;
  374.    If (flipPos>0) and (FlipPos<=NdirList)  and (TC<>#27) Then
  375.     With DirList[FlipPos] do
  376.     begin
  377.       {$I-}
  378.       Seek(DparFile,RecNr);
  379.       Read(Dparfile,Format);
  380.       Convert_50Rec(Format);
  381.       {$I+}
  382.       ErrorNr:=Ioresult;
  383.       If ErrorNr<>0 then FillChar(Format,Sizeof(Format),0);
  384.     end;
  385.   If FileOpen then
  386.     begin
  387.       {$I-}
  388.       Close(Dparfile);
  389.       ErrorNr:=Ioresult;
  390.       {$I+}
  391.     end;
  392.   RestoreWindow (wind_dir,wok);                   { Hintergrund anzeigen }
  393.   DeleteWindow(Wind_Dir);
  394.   Mouse_Left:=M_save;
  395. END;
  396.  
  397. Function Hole_Format(Var Fn   :Str64;
  398.                      Var Name :Str15;
  399.                      Var Df   :Druckparams;
  400.                      Var RecNr: Integer):Integer;
  401. { 0 = gefunden, -1 = nicht gefunden >0 :Ioerror }
  402.  
  403.   Var Dparfile :File of Druckparams;
  404.       D        :Druckparams;
  405.       ErrNr    :Integer;
  406.       Found    :Boolean;
  407.   begin
  408.     If Not Exist_N_Conv(Fn) then
  409.       begin
  410.         Hole_Format:=2; { File Not Found }
  411.         Exit;
  412.       end;
  413.     Assign(Dparfile,Fn);
  414.     {$I-}
  415.     Found:=false;
  416.     RecNr:=-1;
  417.     Reset(Dparfile);
  418.     ErrnR:=Ioresult;
  419.     If ErrNr=0 Then
  420.     begin
  421.       While Not(Eof(Dparfile) or Found) and (ErrNr=0) do
  422.         begin
  423.           Inc(recNr,1);
  424.           Read(Dparfile,D);
  425.           Convert_50Rec(D);
  426.           ErrnR:=Ioresult;
  427.           Found:=D.Parname=Name;
  428.          end;
  429.        Close(Dparfile);
  430.        ErrnR:=Ioresult;
  431.      end;
  432.     {$I+}
  433.     If Found and (ErrNr=0) then
  434.       begin
  435.         Df:=D;
  436.         Hole_Format:=0;
  437.       end
  438.      else If ErrNr=0 then Hole_Format:=-1 else Hole_Format:=ErrNr;
  439.   end;
  440.  
  441. Procedure ReadDruckpar(FormFile     :Str64;
  442.                        Var Format   :Druckparams;
  443.                        Var TC       :Char);
  444. Var Dname    :Str15;
  445.     F        :Druckparams;
  446.     C :Char;
  447. begin
  448.   FillChar(F,Sizeof(F),0);
  449.   Dname:='';
  450.   SelectParam(FormFile,F,TC);
  451.   If (F.FileId='') and (F.ParName='') then
  452.    begin
  453.      FillChar(Format,Sizeof(Format),0);
  454.      TC:=Esc;
  455.    end;
  456.   If (TC<>Esc) and (F.FileID<>GEDDY55ID) then
  457.   begin
  458.     C:=SelectError('Fehler beim Zugriff auf Format-Vorlage  - <Esc>','Fehler:',[Esc]);
  459.     TC:=Esc;
  460.     FillChar(Format,Sizeof(Format),0);
  461.   end else If TC<>Esc then Format:=F;
  462. end;
  463.  
  464. Procedure SetParams(D :Druckparams;Batch :Boolean);
  465. Var I:Integer;
  466.     Dummy :Boolean;
  467.     C: Char;
  468. begin
  469.   With D,SetupInfo.SetupPlotter,SetupInfo.PinstInfo do
  470.   begin
  471.     ActualParname:=ParName;
  472.     DeviceInit:=InitString;
  473.     DeviceExit:=ExitString;
  474.     PlotScale:=Faktor;
  475.     If Batch then
  476.       Filesetup.LIBpath:=Librarypath
  477.     else
  478.      If UpcaseStr(Filesetup.LIBpath)<>UpcaseStr(Librarypath) then
  479.         begin
  480.           C:=SelectError('Bibliothek des Formats <> aktuelle Bibliothek ! - <Esc>',
  481.                          'Warnung:',[Esc]);
  482.         end;
  483.     SetupInfo.Voreinstellung.Ursprung:=Ursprung;
  484.     Limit(D_offset.X,MinFormX,FormX);
  485.     Limit(D_offset.Y,MinFormY,FormY);
  486.     Limit(D_Fenster1.X,MinFormX,FormX);
  487.     Limit(D_Fenster1.Y,MinFormY,FormY);
  488.     Limit(D_Fenster2.X,MinFormX,FormX);
  489.     Limit(D_Fenster2.Y,MinFormY,FormY);
  490.     Plotoffset:=D_offset;
  491.     FensterX1:=D_Fenster1.X;
  492.     FensterY1:=D_Fenster1.Y;
  493.     FensterX2:=D_Fenster2.X;
  494.     FensterY2:=D_Fenster2.Y;
  495.     LScaledotted:=LinScal1;
  496.     Lscaledashed:=LinScal2;
  497.     For I:=1 to 9 do Stiftbreiten[I]:=D_PenInfo[I].PenWidth;
  498.     Plotlayers:=D_Layers;
  499.     For I:=1 to MaxLayer+1 Do Penlookup[I]:=D_PenInfo[I].PenNr;
  500.     Adaptlines:=D_Adapt;
  501.     Spiegeln:=D_Mirror;
  502.     Portrait:=D_portrait;
  503.     PlotModus:=PlotModi(D_Modus);
  504.     LoetStopPlus:=LoetstopInc;
  505.     Plotspeed:=PenSpeed;
  506.     Schriftdicke:=D_TextWidth;
  507.     GrafWindow(FensterX1,FensterY1,FensterX2,FensterY2);
  508.   end;
  509. end;
  510.  
  511. Procedure  GetParams(Var D :Druckparams);
  512. Var I:Integer;
  513. begin
  514.   With D,SetupInfo.SetupPlotter,SetupInfo.PinstInfo do
  515.   begin
  516.     D.FileID:=GEDDY55ID;
  517.     D.PARName:=ActualPARname;
  518.     InitString:=DeviceInit;
  519.     ExitString:=DeviceExit;
  520.     LibraryPath:=FileSetup.LIBPath;
  521.     Faktor:=PlotScale;
  522.     Ursprung:=SetupInfo.Voreinstellung.Ursprung;
  523.     D_offset:=Plotoffset;
  524.     D_Fenster1.X:=FensterX1;
  525.     D_Fenster1.Y:=FensterY1;
  526.     D_Fenster2.X:=FensterX2;
  527.     D_Fenster2.Y:=FensterY2;
  528.     LinScal1:=LScaledotted;
  529.     LinScal2:=Lscaledashed;
  530.     For I:=1 to 9 do D_PenInfo[i].PenWidth:=Stiftbreiten[I];
  531.     For I:=10 to MaxLayer+1 do D_PenInfo[I].PenWidth:=0;
  532.     D_Layers:=Plotlayers;
  533.     For I:=1 to MaxLayer+1 Do D_PenInfo[I].PenNr:=PenLookup[I];
  534.     D_Adapt:=Adaptlines;
  535.     D_Mirror:=Spiegeln;
  536.     D_portrait:=Portrait;
  537.     D_Modus:=Byte(Plotmodus);
  538.     LoetStopInc:=LoetStopPlus;
  539.     Penspeed:=PlotSpeed;
  540.     D_TextWidth:=SchriftDicke;
  541.   end;
  542. end;
  543.  
  544.  
  545.  
  546. Procedure Store_Vorlage(Fname :Str64;D:Druckparams;Erase:Boolean);
  547. Var Dparfile:File of Druckparams;
  548.     D1      :Druckparams;
  549.     RecNr   :Integer;
  550.     Result  :Integer;
  551.     Ok      :Boolean;
  552.     Dname   :Str15;
  553.     OvrW,TC :Char;
  554.  
  555.     Function Check:Boolean;
  556.     begin
  557.       Ok:=(Ioresult=0) and ok;
  558.       Check:=Ok;
  559.     end;
  560.  
  561. begin
  562.   If Not(Erase) then
  563.   begin
  564.     MakeWindow(wind_tmp,27,15,24,3,DiaWinCol,wok);
  565.     MakeFrame(wind_tmp,DiaWinCol,1);
  566.     WriteToWindow(wind_tmp,3,1,DiaHeadCol,' Name für Format: ');
  567.     PutWindow(Wind_tmp,Wok);
  568.     Dname:=UpcaseStr(D.Parname);
  569.     If Dname='' then Dname:='STANDARD';
  570.     Repeat
  571.       OvrW:='J';
  572.       InputKbd(Dname,12,30,16,[^M,Esc,^Q],Alphas+[#128..#160],TC);
  573.       Dname:=UpcaseStr(Dname);
  574.       If TC<>Esc then
  575.       begin
  576.       If (Length(Dname)>0) then
  577.        begin
  578.         If Hole_Format(Fname,Dname,D1,RecNr)=0 then
  579.           OvrW:=SelectError( 'Überschreiben ? (J/N)  ','',['J','N']);
  580.        end
  581.       else
  582.         begin
  583.           OvrW:=SelectError('Name muß angegeben werden !  - <Esc> ','Fehler:',[Esc]);
  584.           OvrW:='N'
  585.         end;
  586.       end;
  587.     Until (OvrW='J') or (TC=Esc);
  588.     RestoreWindow(Wind_tmp,wok);
  589.     DeleteWindow(Wind_tmp);
  590.   end
  591.   else
  592.     begin
  593.     TC:=SelectError(D.Parname+' wirklich löschen ? (J/N)','',['J','N',Esc]);
  594.     If TC<>'J' then TC:=Esc;
  595.     end;
  596.   If TC<>Esc then
  597.   begin
  598.     If Not(Erase) then
  599.     begin
  600.       ActualParname:=Dname;
  601.       D.Parname:=DName;
  602.     end;
  603.     Result:=Hole_Format(Fname,D.Parname,D1,RecNr);
  604.     If Not(Erase) and (Result<0) then
  605.       begin
  606.         DName:='';
  607.         Result:=Hole_Format(Fname,Dname,D1,RecNr);
  608.        end;
  609.     Assign(Dparfile,Fname);
  610.     Ok:=True;
  611.     {$I-}
  612.     If Result<1 then
  613.       begin
  614.         Reset(Dparfile);
  615.         If Check then
  616.         begin
  617.           If Result<0 then RecNr:=FileSize(Dparfile);
  618.           If RecNr<250 then
  619.           begin
  620.             If Erase then D.Parname:='';
  621.             If Check then Seek(DparFile,RecNr);
  622.             If Check then Write(Dparfile,D);
  623.           end
  624.           else
  625.            begin
  626.              OvrW:=SelectError('Nicht gespeichert, mehr als 250 Einträge ! - <Esc>',
  627.                                'Fehler:',[Esc]);
  628.            end;
  629.           Close(Dparfile);
  630.           Ok:=Check;
  631.         end;
  632.       end
  633.       else
  634.         begin
  635.           Rewrite(Dparfile);
  636.           If Check then Write(Dparfile,D);
  637.           Close(Dparfile);
  638.           Ok:=Check;
  639.         end;
  640.       {$I+}
  641.       If Not(Ok) then
  642.         OvrW:=SelectError('Fehler beim Abspeichern ! - <Esc>','Fehler:',[Esc]);
  643.     end;
  644. end;
  645.  
  646. Procedure Vorlage_Laden;
  647. TYPE txtarr    = ARRAY [1 .. 5] OF Str80;
  648. VAR  texte: txtarr;
  649.      P     :Byte;
  650.      Fname :Str64;
  651.      LadenMen   :MenueType;
  652.      FileNames :Array[1..2] of Str64;
  653.      sel   :Integer;
  654.      Df  :Druckparams;
  655.      TC  :Char;
  656. begin
  657.   ActualHelp:=92;
  658.   P:=0;
  659.   If EXist_N_Conv('STANDARD'+Suffix) then
  660.    begin
  661.      Inc(P,1);
  662.      Filenames[P]:='STANDARD'+Suffix;
  663.      Texte[P]:=' ~S~TANDARD'+Suffix+' ';
  664.    end;
  665.    Inc(P,1);
  666.    Filenames[P]:=Filesetup.DWG+Suffix;
  667.    Texte[P]:=' '+Filenames[P]+' ';
  668.    With FileSetUp Do
  669.       ProcessFilename(DWGpath,Filenames[p]);
  670.    If Not (Exist_N_Conv(Filenames[p])) then Dec(P,1);
  671.    If P>0 then
  672.    begin
  673.      MakeMenue(LadenMen,12,13,30,P+2,P,ModeWinCol,MainFlpCol,ModeHiCol,
  674.            Ptr(Seg(texte),Ofs(texte)),wok);
  675.      WriteToWindow(LadenMen.picture,5,1,ModeHeadCol,' FORMAT laden aus: ');
  676.      WriteToWindow(LadenMen.picture,3,P+2,ModeHeadCol,
  677.                   ' '+Chr(24)+Chr(25)+' wählen   <ESC> Ende ');
  678.      Sel:=GetMenueChoice(LadenMen,wok);
  679.      If sel>0 then
  680.        begin
  681.          GetParams(Df);
  682.          ReadDruckpar(Filenames[Sel],Df,TC);
  683.          If TC<>Esc Then SetParams(Df,false);
  684.        end;
  685.      DeleteWindow(LadenMen.Picture);
  686.     end
  687.     else
  688.     TC:=SelectError('Keine FORMAT-Datei vorhanden ! -<Esc>','Fehler:',[Esc]);
  689. end;
  690.  
  691. Procedure Vorlage_Speichern;
  692.   TYPE txtarr    = ARRAY [1 .. 5] OF Str80;
  693.   VAR  texte: txtarr;
  694.        P     :Byte;
  695.        StoreMen :Menuetype;
  696.        sel    :Integer;
  697.        FileNames :Array[1..2] of Str64;
  698.        Df :Druckparams;
  699.        tmp :WindowType;
  700.   BEGIN
  701.     ActualHelp:=92;
  702.     Filenames[1]:='STANDARD'+Suffix;
  703.     Filenames[2]:=Filesetup.DWG+Suffix;
  704.     texte[1]:=' ~S~TANDARD'+Suffix+' ';
  705.     texte[2]:=' '+Filenames[2]+' ';
  706.     With FileSetUp Do
  707.     begin
  708.       ProcessFilename(DWGpath,Filenames[2]);
  709.     end;
  710.     P:=2;
  711.     MakeMenue(StoreMen,12,13,30,P+2,P,ModeWinCol,MainFlpCol,ModeHiCol,
  712.           Ptr(Seg(texte),Ofs(texte)),wok);
  713.     WriteToWindow(StoreMen.picture,5,1,ModeHeadCol,' FORMAT speichern in : ');
  714.  
  715.     WriteToWindow(StoreMen.picture,3,P+2,ModeHeadCol,
  716.                   ' '+Chr(24)+Chr(25)+' wählen   <ESC> Ende ');
  717.     Tmp:=StoreMen.Picture;
  718.     PutWindow(Tmp,wok);
  719.     sel:=GetMenueChoice(Storemen,wok);
  720.     If sel>0 then
  721.     begin
  722.       GetParams(Df);
  723.       Store_Vorlage(Filenames[sel],Df,false);
  724.     end;
  725.     RestoreWindow(tmp,wok);
  726.     DeleteWindow(StoreMen.Picture);
  727.   END;
  728.  
  729. Procedure Vorlage_Loeschen;
  730. TYPE txtarr    = ARRAY [1 .. 5] OF Str80;
  731. VAR  texte: txtarr;
  732.      P     :Byte;
  733.      Fname :Str64;
  734.      LadenMen   :MenueType;
  735.      FileNames :Array[1..2] of Str64;
  736.      sel   :Integer;
  737.      Df  :Druckparams;
  738.      TC  :Char;
  739. begin
  740.   ActualHelp:=92;
  741.   P:=0;
  742.   If EXist_N_Conv('STANDARD'+Suffix) then
  743.    begin
  744.      Inc(P,1);
  745.      Filenames[P]:='STANDARD'+Suffix;
  746.      Texte[P]:=' ~S~TANDARD'+Suffix+' ';
  747.    end;
  748.    Inc(P,1);
  749.    Filenames[P]:=Filesetup.DWG+Suffix;
  750.    Texte[P]:=' '+Filenames[P]+' ';
  751.    With FileSetUp Do
  752.       ProcessFilename(DWGpath,Filenames[p]);
  753.    If Not (Exist_N_Conv(Filenames[p])) then Dec(P,1);
  754.    If P>0 then
  755.    begin
  756.      MakeMenue(LadenMen,12,13,30,P+2,P,ModeWinCol,MainFlpCol,ModeHiCol,
  757.            Ptr(Seg(texte),Ofs(texte)),wok);
  758.      WriteToWindow(LadenMen.picture,5,1,ModeHeadCol,' FORMAT laden aus: ');
  759.      WriteToWindow(LadenMen.picture,3,P+2,ModeHeadCol,
  760.                   ' '+Chr(24)+Chr(25)+' wählen   <ESC> Ende ');
  761.      Sel:=GetMenueChoice(LadenMen,wok);
  762.      If sel>0 then
  763.        begin
  764.          ReadDruckpar(Filenames[Sel],Df,TC);
  765.          If TC<>Esc Then
  766.            Store_Vorlage(Filenames[sel],Df,true);
  767.        end;
  768.      DeleteWindow(LadenMen.Picture);
  769.     end
  770.     else
  771.     TC:=SelectError('Keine FORMAT-Datei vorhanden ! -<Esc>','Fehler:',[Esc]);
  772. end;
  773.  
  774. Procedure BatchInit;
  775. Var Pfad :PathStr;
  776.     Name :PathStr;
  777.     Ex   :ExtStr;
  778.     Format    :Str15;
  779.     F1,RecNr   :Integer;
  780.     FormatFile :PathStr;
  781.     Df         :Druckparams;
  782.  
  783. begin
  784.   FillChar(Batchpar,Sizeof(BatchPar),0);
  785.   If Batch then
  786.   begin
  787.     If ParamCount=2 then
  788.     begin
  789.       Pfad:=Fexpand(ParamStr(1));
  790.       Fsplit(Pfad,Pfad,Name,Ex);
  791.       Format:=UpcaseStr(ParamStr(2));
  792.       If Pfad[Length(Pfad)]='\' then
  793.         Delete(Pfad,Length(Pfad),1);
  794.       With FileSetup Do
  795.       Begin
  796.         ActivePath:=Pfad;
  797.         DWGPath:=Pfad;
  798.         DWG:=Name;
  799.         CheckPath(Pfad);
  800.        end;
  801.        FormatFile:=Name+Suffix;
  802.        ProcessFilename(Pfad,FormatFile);
  803.        If Hole_Format(Formatfile,Format,Df,RecNr)<>0 then
  804.          begin
  805.            FormatFile:='STANDARD'+Suffix;
  806.            If Hole_Format(Formatfile,Format,Df,RecNr)<>0 then Error(101);
  807.          end;
  808.       BatchPAR:=Df;
  809.       SetParams(Df,Batch);
  810.       With FileSetup Do
  811.       Begin
  812.         Macropath:=LibPath;
  813.         CheckPath(MacroPath);
  814.        DirMask:='*.*';
  815.      End;
  816.      AufDatei:=OutPath<>'';
  817.     end else Error(100); { Unzulässige Parameter }
  818.   end else
  819.    begin
  820.     With FileSetup do
  821.     begin
  822.       Formatfile:=DWG+Suffix;
  823.       Processfilename(DWGpath,FormatFile);
  824.     end;
  825.     Format:='STANDARD';
  826.     If Hole_Format(Formatfile,Format,Batchpar,RecNr)=0 then
  827.        Batchpar.Librarypath:=FileSetup.LIBpath
  828.       else
  829.         begin
  830.            FormatFile:='STANDARD'+Suffix;
  831.            Format:='STANDARD';
  832.            If Hole_Format(Formatfile,Format,Batchpar,RecNr)=0 then
  833.              Batchpar.Librarypath:=FileSetup.LIBpath;
  834.       end;
  835.    end;
  836. end;
  837.  
  838. end.
  839.