home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 07 / vgraf / gr_edit1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-24  |  16.0 KB  |  427 lines
  1. (* ------------------------------------------------------ *)
  2. (*                   GR-EDIT1.PAS                         *)
  3. (*     Programm zur Demonstration der Vektorgrafik        *)
  4. (*         (c) 1988 Helmut Wessels & TOOLBOX              *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM VektorGraphik;
  7. USES Dos, Crt, Graph;
  8. TYPE tSTRING = STRING[20];
  9.      tText   = STRING[45];
  10.      tINFO   = RECORD
  11.                  x1                : BYTE;
  12.                  anzahl            : INTEGER;
  13.                           {Byte 2,3 = Anzahl der Zeichen   }
  14.                  x2, anfang        : BYTE;
  15.                           {Byte 5 = ASCII-Nr. d. 1.Zeichens}
  16.                  vect_anfang       : INTEGER;
  17.                           {Byte 6,7 = Anf. d. Vektortabelle}
  18.                  x3, hoehe         : BYTE;
  19.                           {Byte 9 = Höhe in Pixel + 1      }
  20.                  x4, unterlaengen  : ShortInt;
  21.                           {Byte 11 = Unterlängen           }
  22.                  x5,x6,x7,x8,x9    : BYTE;
  23.                END;
  24.      tOFFS   = ARRAY [1..1024] OF INTEGER;
  25.                           {Adressen der Vektoren in tVECT  }
  26.      tBREITE = ARRAY [1..1024] OF BYTE;
  27.                                     {Breite für die Zeichen}
  28.      tVECT   = ARRAY [0..14200] OF BYTE;   {evtl. auch mehr}
  29.                                         {Liste der Vektoren}
  30.      tART    = (normal,ref_zeichen,Kreis,texte,usw,quatsch);
  31.                            {in den oberen 4 Bit gespeichert}
  32.      tsatz   = ARRAY [0..16383] OF BYTE;    { evtl. größer }
  33.      tstrukt = RECORD
  34.                  satz   : ^tsatz;           {der ganze Satz}
  35.                  info   : ^tInfo;           {Struktur-Infos}
  36.                  breite : ^tBreite;         {Breitentabelle}
  37.                  offs   : ^tOffs;        {Einsprungadressen}
  38.                  vect   : ^tVect;          {Vektorentabelle}
  39.                END;
  40. VAR  faktor                                   : BYTE;
  41.      rx, ry                                   : ShortInt;
  42.      korr_faktor                              : REAL;
  43.      i,k,s,cx,cy,cx_g,cy_g,cy_t,tx,ty,txof,
  44.      umfang, GraphDriver, GraphMode           : INTEGER;
  45.      c                                        : CHAR;
  46.      gr_filename                              : tSTRING;
  47.      userfont, outfont                        : tstrukt;
  48.      usatz                                    : tsatz;
  49.      f                                        : FILE;
  50.  
  51. FUNCTION liesz : INTEGER;                     {Hilfsroutine}
  52. VAR s : STRING[5]; i, k : INTEGER;
  53. BEGIN
  54.   ReadLn(s);
  55.   Val(s, i, k);
  56.   IF k = 0 THEN liesz := i ELSE liesz := 0;
  57.   WriteLn;
  58. END;
  59.  
  60. FUNCTION bildwahl : WORD;            {Wahl einer Bildnummer}
  61. VAR i : INTEGER;  c : CHAR;
  62. BEGIN
  63.   Write('Nummer (bzw. Taste) des Bildes, Ende: [ESC]     ',
  64.          #8#8#8);
  65.   c := ReadKey;  i := 0;
  66.   WHILE c IN ['0'..'9'] DO BEGIN
  67.     i := 10*i + Ord(c) - 48;  Write(c);
  68.     c := ReadKey
  69.   END;
  70.   IF (c <> #27) AND (i = 0) THEN i := Ord(c);
  71.   WITH userfont, info^ DO
  72.     IF (i < anfang) OR (i >= anfang + anzahl) THEN BEGIN
  73.       i := 0;  WriteLn;
  74.       Write('Bild (noch) nicht vorhanden! [RETURN]');
  75.       c := ReadKey;  DelLine;
  76.     END;
  77.     bildwahl := i;
  78. END;
  79.  
  80. FUNCTION decodiere_vektor(a,b:BYTE; VAR x,y:ShortInt;
  81.                                     VAR linie:BOOLEAN):tART;
  82.              {entschlüsselt die Bedeutung eines Byte-Paares}
  83. BEGIN
  84.   x := a AND $7f;  y := b AND $7f;
  85.   IF Odd(y SHR 6) THEN y := $80 + y;
  86.   linie := Odd(b SHR 7);
  87.   IF Odd(a SHR 7) THEN decodiere_vektor := normal
  88.   ELSE IF a AND $70 > 0 THEN
  89.     decodiere_vektor := tART(a SHR 4)
  90.   ELSE decodiere_vektor := quatsch;
  91. END;
  92.  
  93. PROCEDURE zeichne(font  : tstrukt; nr : WORD; ref : BOOLEAN;
  94.                   faktor: REAL; drehung : BYTE);
  95.      {Zeichnet ein Bild, ruft sich u.U. selbst rekursiv auf}
  96. VAR x,y:ShortInt; w1,w2:BYTE; x1,y1,gcx,gcy,z,off:INTEGER;
  97.     linie:BOOLEAN;
  98.     sina,cosa,sinz,cosz,z1,z2,xf,alp,pi180:REAL;
  99. BEGIN
  100.   WITH font DO BEGIN
  101.     off:=offs^[nr];                 {Anfang der Vektorfolge}
  102.     IF ref OR (font.satz = outfont.satz) THEN BEGIN
  103.       gcx := GetX;  gcy := GetY
  104.     END ELSE BEGIN               {beim letzten Punkt weiter}
  105.       gcx := cx;    gcy := cy
  106.     END;                              {Bezugspunkt=Ursprung}
  107.     xf := faktor/korr_faktor;
  108.     REPEAT
  109.       CASE
  110.       decodiere_vektor(vect^[off],vect^[off+1],x,y,linie) OF
  111.         normal: BEGIN
  112.                   IF drehung <> 0 THEN BEGIN
  113.                     alp := drehung/90*Pi;  x1 := x;
  114.                     x1:=Round(xf*(x*Cos(alp)-y*Sin(alp)));
  115.                     y1:=Round(faktor*
  116.                                   (+x*Sin(alp)+y*Cos(alp)));
  117.                   END ELSE BEGIN
  118.                     x1 := Round(xf*x);
  119.                     y1 := Round(faktor*y)
  120.                   END;
  121.                   IF linie THEN LineTo(gcx + x1, gcy - y1)
  122.                            ELSE MoveTo(gcx+x1,gcy-y1)
  123.                 END; {normal}
  124.         ref_zeichen: BEGIN
  125.                                          { folgt in Teil 3 }
  126.                      END; {ref_zeichen}
  127.         texte : BEGIN
  128.                                          { folgt in Teil 3 }
  129.                 END;  {texte}
  130.         Kreis : BEGIN
  131.                                          { folgt in Teil 3 }
  132.                 END {kreis}
  133.       END; {case}
  134.       Inc(off, 2)
  135.     UNTIL (vect^[off] = 0);
  136.     IF (font.satz=userfont.satz) AND NOT ref THEN Inc(cx,x1)
  137.   END;
  138. END;
  139.  
  140. PROCEDURE struktur(VAR font : tstrukt);
  141. BEGIN                                {Zeiger werden gesetzt}
  142.   WITH font DO BEGIN
  143.     info  := @satz^[128];
  144.                        {Bis Byte 127: Impressum von BORLAND}
  145.     offs  := @satz^[144 - 2*(info^.anfang - 1)];
  146.     breite:= @satz^[144 + 2*info^.anzahl -(info^.anfang-1)];
  147.     vect  := @satz^[128 + info^.vect_anfang]
  148.   END;
  149. END;
  150.  
  151. PROCEDURE loadfont;    {Vektor-Datei für Texte wird geladen}
  152. VAR fontf : FILE;
  153. BEGIN
  154.   Assign(fontf, 'lit1.chr');         {Wird für Text benutzt}
  155.   Reset(fontf, 1);
  156.   GetMem(outfont.satz, FileSize(fontf));
  157.   BlockRead(fontf, outfont.satz^, FileSize(fontf));
  158.   Close(fontf);
  159.   IF RegisterBGIfont(outfont.satz) < 0 THEN BEGIN
  160.     Write(#7#7#7, 'Fehler');  Delay(2000);
  161.   END;
  162.   struktur(outfont);            {lit1.chr wird strukturiert}
  163. END;
  164.  
  165. PROCEDURE laden;         {Vektor-Datei für Anwenderzeichen }
  166. CONST kenn : STRING[87] =
  167.  'PK'#8#8'GRAPHIK-EDITOR für Vektor-Graphik, Version 2.0, Nov. 1988***'#13#10'(c)Helmut Wessels'#13#10#0#0;
  168.       neu :ARRAY[1..25] OF BYTE =($2b,1,0,0,1,$13,0,0,$19,0,
  169.                        $FE,0,0,0,0,0,0,0,6,$80,0,$86,0,0,0);
  170. BEGIN
  171.   Assign(f, gr_filename);
  172.   {$I-} Reset(f, 1); {$I+}
  173.   IF IOResult = 0 THEN BEGIN
  174.     BlockRead(f, usatz, FileSize(f));
  175.     umfang := FileSize(f);
  176.     Close(f);
  177.   END ELSE BEGIN
  178.     Write(#7'Datei nicht vorhanden, wird neu erstellt!');
  179.     FillChar(usatz, 128, #0);
  180.     usatz[87] := $1a;  usatz[88] := $80;
  181.     usatz[96] := 1;    usatz[98] := 1;
  182.     Move(neu, usatz[128], 25);
  183.     umfang := 153;  Delay(1000);
  184.   END;
  185.   userfont.satz := @usatz;
  186.   struktur(userfont);     {Anwender-Datei wird strukturiert}
  187.   FOR k := 1 TO Length(kenn) DO usatz[k-1] := Ord(kenn[k]);
  188. END;
  189.  
  190. PROCEDURE meintext(k:BYTE;st:tText);    {entspricht OUTTEXT}
  191. VAR i : INTEGER;                {nur mit mehr Möglichkeiten}
  192. BEGIN
  193.   FOR i := 1 TO Length(st) DO
  194.     zeichne(outfont, Ord(st[i]), FALSE, k*ty/50,0);
  195. END;
  196.  
  197. PROCEDURE hoehe_aendern;          {Einstellung Standardhöhe}
  198. BEGIN
  199.   WITH userfont DO BEGIN
  200.     ClrScr;
  201.     GotoXY(1,16);
  202.     Write('Neue Werte eingeben, RETURN für alten Wert');
  203.     GotoXY(1,12);
  204.     Write('Bildhöhe in Raster-Einheiten: ', info^.hoehe);
  205.     GotoXY(1,14);
  206.     Write('Unterlängen in Raster-Einheiten: ',
  207.                                   -info^.unterlaengen);
  208.     GotoXY(37,12);  k := liesz;
  209.     IF k <> 0 THEN info^.hoehe := k;
  210.     GotoXY(37,14);  k := liesz;
  211.     IF k <> 0 THEN info^.unterlaengen := -k
  212.   END;
  213. END;
  214.  
  215. PROCEDURE anfuegen;    {fügt Platz für ein neues Zeichen an}
  216. CONST leer:ARRAY[1..6] OF BYTE = ($80,$00,$86,$00,$00,$00);
  217. BEGIN       {offs^ ergänzen, breite^ und vect^ verschieben }
  218.   WITH userfont, info^ DO BEGIN
  219.     Inc(vect_anfang, 3);     {davor werden 3 Byte eingefügt}
  220.     Inc(umfang, 9);                {plus 6 Byte Leerzeichen}
  221.     Move(vect^[0], vect^[3], umfang - vect_anfang - 128);
  222.                                      {um 3 Byte verschieben}
  223.     vect := @vect^[3];
  224.     Move(breite^[anfang], breite^[anfang+2], anzahl);
  225.                                      {um 2 Byte verschieben}
  226.     breite := @breite^[3];
  227.     breite^[anfang+anzahl] := 6;
  228.     offs^[anfang+anzahl] := umfang - vect_anfang - 128 - 6;
  229.     Move(leer, vect^[offs^[anfang+anzahl]], 6);
  230.     Inc(anzahl);
  231.   END;
  232. END;
  233.  
  234. PROCEDURE gr_speichern(bildname:tSTRING);  {Datei speichern}
  235. BEGIN
  236.   k := 80;                  {Eintrag für Dateiumfang suchen}
  237.   REPEAT Inc(k)
  238.   UNTIL (usatz[k-2] = $1a) AND (usatz[k-1] = $80)
  239.                            AND (usatz[k] = $00) OR (k>110);
  240.   i := Pos(':', bildname);          {Name des Zeichensatzes}
  241.   FOR s := i + 1 TO i + 4 DO
  242.     usatz[k + s - i] := Ord(UpCase(bildname[s]));
  243.   usatz[k + 6] := (umfang - 128) SHR 8;
  244.   usatz[k + 5] := (umfang - 128) AND $FF;
  245.   IF Pos('.',bildname) = 0 THEN bildname := bildname+'.chr';
  246.   Assign(f, bildname);  Rewrite(f, 1);
  247.   BlockWrite(f, usatz, umfang, k);  Close(f);
  248. END;
  249.  
  250. PROCEDURE editieren;     {Erstellen/bearbeiten einer Grafik}
  251. BEGIN                                     {folgt im 2. Teil}
  252. END;
  253.  
  254. PROCEDURE testen;       {Schreibt Zeichen auf leeren Schirm}
  255. VAR st: STRING[4];
  256. BEGIN
  257.    WriteLn; WriteLn(#10,'Test-Ende mit ESC!',#10);
  258.    REPEAT
  259.      Write('Welchen Vergrößerungsfaktor wünschen Sie? (',
  260.             faktor,') ');
  261.      k := liesz;
  262.    UNTIL k*userfont.info^.hoehe < GetMaxY;
  263.    IF k > 0 THEN faktor := k;
  264.    SetGraphMode(GraphMode);
  265.    WITH userfont, info^ DO BEGIN
  266.      cx := 0; cy := faktor*hoehe;   {Anfangspunkt 1.Zeichen}
  267.      REPEAT
  268.        k := Ord(ReadKey);
  269.        IF (k >= anfang) AND (k < anfang + anzahl)
  270.                         OR  (k = 13) THEN BEGIN
  271.          IF (cx > GetMaxX -
  272.                        Round(faktor/korr_faktor*breite^[k]))
  273.              {ist noch genügend Platz bis zum rechten Rand?}
  274.          OR (k=13) THEN BEGIN             {RETURN gedrückt?}
  275.            cx := 0;                             {neue Zeile}
  276.            cy := cy + faktor*(hoehe - unterlaengen + 1);
  277.            IF cy > GetMaxY THEN BEGIN          {Schirm voll}
  278.              ClearDevice;                          {löschen}
  279.              cx := 0;  cy := faktor * hoehe;
  280.            END;
  281.            MoveTo(cx, cy);
  282.          END;
  283.          IF k<>13 THEN zeichne(userfont,k,FALSE,faktor,0);
  284.       END ELSE Write(#7);
  285.     UNTIL k = 27;                             {Ende mit ESC}
  286.     RestoreCrtMode;
  287.   END;
  288. END;
  289.  
  290. PROCEDURE Zeichen_ansehen;       {Übersicht Grafik-Zeichen }
  291. VAR st                  : STRING[4];
  292.     faktor, xbreite, vx : WORD;
  293. BEGIN
  294.   SetGraphMode(GraphMode);
  295.   vx := GetMaxX DIV 16;         {Mindestabstand der Zeichen}
  296.   WITH userfont, info^ DO BEGIN
  297.     faktor := Trunc((GetMaxY-ty)/(hoehe-unterlaengen+ty)/3);
  298.     {Faktor wird nach Graphikkarte und Zeichenhöhe angepaßt}
  299.     cx := 0;
  300.     cy := 2*GetMaxY DIV 7 + faktor*unterlaengen;
  301.    {Es werden drei Zeilen pro Schirm geschrieben á 2/7 Höhe}
  302.     MoveTo(cx, cy);
  303.     i := anfang;
  304.     REPEAT
  305.       xbreite := Round(faktor/korr_faktor*breite^[i]);
  306.       IF (cx>GetMaxX-xbreite) OR (cx>GetMaxX-vx) THEN BEGIN
  307.         cx := 0;  Inc(cy, 2*GetMaxY DIV 7 + ty)
  308.       END;
  309.       IF (cy>GetMaxY-ty) OR (i = anfang + anzahl) THEN BEGIN
  310.         MoveTo(1, GetMaxY);
  311.         meintext(5, 'Bild-Datei '+
  312.                 Copy(gr_filename,1,Pos('.',gr_filename)-1));
  313.         MoveTo(GetMaxX DIV 2, GetMaxY);
  314.         meintext(5, ' [RET] = weiter, [ESC] = Ende');
  315.         c := ReadKey;
  316.         ClearDevice;
  317.         cx := 0;
  318.         cy := 2*GetMaxY DIV 7 + faktor*unterlaengen;
  319.       END;
  320.       IF (i < anfang + anzahl) AND (c <> #27) THEN BEGIN
  321.         Str(i, st);
  322.         MoveTo(cx, cy + faktor * (1 - unterlaengen) + ty);
  323.         meintext(5, 'Nr.' + st);
  324.         MoveTo(cx, cy);
  325.         zeichne(userfont, i, FALSE, faktor, 0);
  326.         IF xbreite < vx THEN Inc(cx, vx + 9 - xbreite)
  327.                         ELSE Inc(cx, 10);
  328.       END;
  329.       Inc(i);
  330.     UNTIL (i > anfang + anzahl) OR (c = #27);
  331.   END;
  332.   RestoreCrtMode;
  333. END;
  334.  
  335. PROCEDURE initialisieren;
  336. {Grafikkarten werden erkannt, für verschiedene Karten wird
  337.  ein Korrekturfaktor und eine Zeichengröße beigegeben      }
  338. BEGIN
  339.   GraphDriver := detect;
  340.   InitGraph(GraphDriver, GraphMode, '');
  341.   CASE GraphDriver OF                 {sorgt für Hardcopies}
  342.     CGA: IF GraphMode = CGAHi THEN    {im richtigen Höhen- }
  343.             korr_faktor:=0.5;         {Seiten-Verhältnis   }
  344.     EGA,EGAMono: CASE GraphMode OF
  345.                    EGALo           : korr_faktor := 0.5;
  346.                    EGAHi,EGAMonoHi : korr_faktor := 0.936;
  347.                  END;
  348.     HercMono, PC3270 : korr_faktor := 0.832;
  349.     ELSE korr_faktor := 1;
  350.   END;
  351.   cx_g := Round(GetMaxX/24);  {Grundstellung (Ursprung) für}
  352.   cy_g := Round(GetMaxY*0.675);             {Graphik-Raster}
  353.   cy_t := Round(GetMaxY*0.758);     {Höhe für Zahlenausgabe}
  354.   tx   := Round(GetMaxX/16);        {Breite f. 1 Zahlenpaar}
  355.   txof := GetMaxX-GetMaxX DIV 4 - tx DIV 2;     {Menüleiste}
  356.   ty   := GetMaxY DIV 29;             {Höhe der Textzeichen}
  357.   CASE GraphDriver OF
  358.     CGA             : ty := 6;               {Anpassung für}
  359.     HercMono,PC3270 : ty := 11;       {einige Graphikkarten}
  360.     EGA,EGAMono     : ty := 10;              {ausprobieren!}
  361.     VGA             : ty := 12;
  362.   END;
  363.   SetColor(white);
  364.   RestoreCrtMode;
  365. END;
  366.  
  367. BEGIN                                      { Hauptprogramm }
  368.   ClrScr;
  369.   WriteLn(#10'Der Vektor-Graphik-Editor     ( V 2.0 )'+
  370.              '             h.w. 1988');
  371.   WriteLn('mit Einbindung von Referenz-Adressen, Ellipsen,'+
  372.           ' Bögen und Texten');
  373.   WriteLn('sowie Größen- und Lageveränderungen'#10);
  374.   loadfont;
  375.   Write(#10#10,
  376.        'Welche Vektor-Zeichen-Datei soll geladen werden: ');
  377.   ReadLn(gr_filename);
  378.   IF Pos('.',gr_filename)=0 THEN
  379.      gr_filename:=gr_filename+'.chr';
  380.   laden; initialisieren;
  381.   WITH userfont,info^ DO BEGIN
  382.     faktor:=Round(GetMaxY/3/(hoehe-unterlaengen));
  383.      {Anpassung des Vergrößerungsfaktors an die Zeichenhöhe}
  384.     cx:=0; cy:=faktor*hoehe;
  385.     REPEAT
  386.       GotoXY(1,5);
  387.       WriteLn('Bilddatei ',gr_filename,' enthält ',umfang,
  388.           ' Byte mit ',anzahl,' Bildern ab Nr.',anfang,'.');
  389.       WriteLn('Höhe der Zeichen ',hoehe+1,
  390.          ' Raster-Einheiten, ','Unterlängen ',-unterlaengen,
  391.          ' Raster-Einheiten');
  392.       WriteLn('Momentaner Vergrößerungsfaktor für Test: ',
  393.           faktor);
  394.       WriteLn;
  395.       WriteLn('Sie möchten ...');
  396.       WriteLn('    die Grafiken testen (schreiben) .. T');
  397.       WriteLn('    eine Grafik editieren (ansehen) .. E');
  398.       WriteLn('    die Standard-Höhe ändern ......... H');
  399.       WriteLn('    Platz für neue Grafik anfügen .... A');
  400.       WriteLn('    Grafiken in Übersicht sehen ...... G');
  401.       WriteLn('    Aufhören  ........................ Q');
  402.       Write  ('------------------------------------->    ',
  403.               #8#8#8);
  404.       c := UpCase(ReadKey);
  405.       CASE c OF
  406.         'T' : testen;
  407.         'E' : editieren;
  408.         'H' : hoehe_aendern;
  409.         'A' : IF anfang + anzahl < 1000 THEN anfuegen;
  410.         'G' : Zeichen_ansehen;
  411.       END;
  412.     UNTIL c = 'Q';
  413.   END;
  414.   Write(#13'Möchten Sie den Zeichensatz speichern? (J/N)');
  415.   IF UpCase(ReadKey) = 'J' THEN BEGIN
  416.     WriteLn;
  417.     Write('Neuer Name: (4 Zeichen für Borland) ');
  418.     ReadLn(gr_filename);
  419.     IF gr_filename<>'' THEN gr_speichern(gr_filename);
  420.     WriteLn('Falls Sie einen neuen Namen gewählt haben '+
  421.             'und den Satz mit GRAPH.TPU benutzen wollen,');
  422.     WriteLn('müssen Sie den Namen noch in GRAPH.TPU eintr'+
  423.             'agen (ab Byte 697C)!')
  424.   END;
  425. END.
  426. (* ------------------------------------------------------ *)
  427. (*                 Ende von GR-EDIT1.PAS                  *)