home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 05 / grdlagen / gr_edit1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-23  |  16.1 KB  |  428 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, '+
  168.  'Nov. 1988***'#13#10'(c)Helmut Wessels'#13#10#0#0;
  169.       neu :ARRAY[1..25] OF BYTE =($2b,1,0,0,1,$13,0,0,$19,0,
  170.                        $FE,0,0,0,0,0,0,0,6,$80,0,$86,0,0,0);
  171. BEGIN
  172.   Assign(f, gr_filename);
  173.   {$I-} Reset(f, 1); {$I+}
  174.   IF IOResult = 0 THEN BEGIN
  175.     BlockRead(f, usatz, FileSize(f));
  176.     umfang := FileSize(f);
  177.     Close(f);
  178.   END ELSE BEGIN
  179.     Write(#7'Datei nicht vorhanden, wird neu erstellt!');
  180.     FillChar(usatz, 128, #0);
  181.     usatz[87] := $1a;  usatz[88] := $80;
  182.     usatz[96] := 1;    usatz[98] := 1;
  183.     Move(neu, usatz[128], 25);
  184.     umfang := 153;  Delay(1000);
  185.   END;
  186.   userfont.satz := @usatz;
  187.   struktur(userfont);     {Anwender-Datei wird strukturiert}
  188.   FOR k := 1 TO Length(kenn) DO usatz[k-1] := Ord(kenn[k]);
  189. END;
  190.  
  191. PROCEDURE meintext(k:BYTE;st:tText);    {entspricht OUTTEXT}
  192. VAR i : INTEGER;                {nur mit mehr Möglichkeiten}
  193. BEGIN
  194.   FOR i := 1 TO Length(st) DO
  195.     zeichne(outfont, Ord(st[i]), FALSE, k*ty/50,0);
  196. END;
  197.  
  198. PROCEDURE hoehe_aendern;          {Einstellung Standardhöhe}
  199. BEGIN
  200.   WITH userfont DO BEGIN
  201.     ClrScr;
  202.     GotoXY(1,16);
  203.     Write('Neue Werte eingeben, RETURN für alten Wert');
  204.     GotoXY(1,12);
  205.     Write('Bildhöhe in Raster-Einheiten: ', info^.hoehe);
  206.     GotoXY(1,14);
  207.     Write('Unterlängen in Raster-Einheiten: ',
  208.                                   -info^.unterlaengen);
  209.     GotoXY(37,12);  k := liesz;
  210.     IF k <> 0 THEN info^.hoehe := k;
  211.     GotoXY(37,14);  k := liesz;
  212.     IF k <> 0 THEN info^.unterlaengen := -k
  213.   END;
  214. END;
  215.  
  216. PROCEDURE anfuegen;    {fügt Platz für ein neues Zeichen an}
  217. CONST leer:ARRAY[1..6] OF BYTE = ($80,$00,$86,$00,$00,$00);
  218. BEGIN       {offs^ ergänzen, breite^ und vect^ verschieben }
  219.   WITH userfont, info^ DO BEGIN
  220.     Inc(vect_anfang, 3);     {davor werden 3 Byte eingefügt}
  221.     Inc(umfang, 9);                {plus 6 Byte Leerzeichen}
  222.     Move(vect^[0], vect^[3], umfang - vect_anfang - 128);
  223.                                      {um 3 Byte verschieben}
  224.     vect := @vect^[3];
  225.     Move(breite^[anfang], breite^[anfang+2], anzahl);
  226.                                      {um 2 Byte verschieben}
  227.     breite := @breite^[3];
  228.     breite^[anfang+anzahl] := 6;
  229.     offs^[anfang+anzahl] := umfang - vect_anfang - 128 - 6;
  230.     Move(leer, vect^[offs^[anfang+anzahl]], 6);
  231.     Inc(anzahl);
  232.   END;
  233. END;
  234.  
  235. PROCEDURE gr_speichern(bildname:tSTRING);  {Datei speichern}
  236. BEGIN
  237.   k := 80;                  {Eintrag für Dateiumfang suchen}
  238.   REPEAT Inc(k)
  239.   UNTIL (usatz[k-2] = $1a) AND (usatz[k-1] = $80)
  240.                            AND (usatz[k] = $00) OR (k>110);
  241.   i := Pos(':', bildname);          {Name des Zeichensatzes}
  242.   FOR s := i + 1 TO i + 4 DO
  243.     usatz[k + s - i] := Ord(UpCase(bildname[s]));
  244.   usatz[k + 6] := (umfang - 128) SHR 8;
  245.   usatz[k + 5] := (umfang - 128) AND $FF;
  246.   IF Pos('.',bildname) = 0 THEN bildname := bildname+'.chr';
  247.   Assign(f, bildname);  Rewrite(f, 1);
  248.   BlockWrite(f, usatz, umfang, k);  Close(f);
  249. END;
  250.  
  251. PROCEDURE editieren;     {Erstellen/bearbeiten einer Grafik}
  252. BEGIN                                     {folgt im 2. Teil}
  253. END;
  254.  
  255. PROCEDURE testen;       {Schreibt Zeichen auf leeren Schirm}
  256. VAR st: STRING[4];
  257. BEGIN
  258.    WriteLn; WriteLn(#10,'Test-Ende mit ESC!',#10);
  259.    REPEAT
  260.      Write('Welchen Vergrößerungsfaktor wünschen Sie? (',
  261.             faktor,') ');
  262.      k := liesz;
  263.    UNTIL k*userfont.info^.hoehe < GetMaxY;
  264.    IF k > 0 THEN faktor := k;
  265.    SetGraphMode(GraphMode);
  266.    WITH userfont, info^ DO BEGIN
  267.      cx := 0; cy := faktor*hoehe;   {Anfangspunkt 1.Zeichen}
  268.      REPEAT
  269.        k := Ord(ReadKey);
  270.        IF (k >= anfang) AND (k < anfang + anzahl)
  271.                         OR  (k = 13) THEN BEGIN
  272.          IF (cx > GetMaxX -
  273.                        Round(faktor/korr_faktor*breite^[k]))
  274.              {ist noch genügend Platz bis zum rechten Rand?}
  275.          OR (k=13) THEN BEGIN             {RETURN gedrückt?}
  276.            cx := 0;                             {neue Zeile}
  277.            cy := cy + faktor*(hoehe - unterlaengen + 1);
  278.            IF cy > GetMaxY THEN BEGIN          {Schirm voll}
  279.              ClearDevice;                          {löschen}
  280.              cx := 0;  cy := faktor * hoehe;
  281.            END;
  282.            MoveTo(cx, cy);
  283.          END;
  284.          IF k<>13 THEN zeichne(userfont,k,FALSE,faktor,0);
  285.       END ELSE Write(#7);
  286.     UNTIL k = 27;                             {Ende mit ESC}
  287.     RestoreCrtMode;
  288.   END;
  289. END;
  290.  
  291. PROCEDURE Zeichen_ansehen;       {Übersicht Grafik-Zeichen }
  292. VAR st                  : STRING[4];
  293.     faktor, xbreite, vx : WORD;
  294. BEGIN
  295.   SetGraphMode(GraphMode);
  296.   vx := GetMaxX DIV 16;         {Mindestabstand der Zeichen}
  297.   WITH userfont, info^ DO BEGIN
  298.     faktor := Trunc((GetMaxY-ty)/(hoehe-unterlaengen+ty)/3);
  299.     {Faktor wird nach Graphikkarte und Zeichenhöhe angepaßt}
  300.     cx := 0;
  301.     cy := 2*GetMaxY DIV 7 + faktor*unterlaengen;
  302.    {Es werden drei Zeilen pro Schirm geschrieben á 2/7 Höhe}
  303.     MoveTo(cx, cy);
  304.     i := anfang;
  305.     REPEAT
  306.       xbreite := Round(faktor/korr_faktor*breite^[i]);
  307.       IF (cx>GetMaxX-xbreite) OR (cx>GetMaxX-vx) THEN BEGIN
  308.         cx := 0;  Inc(cy, 2*GetMaxY DIV 7 + ty)
  309.       END;
  310.       IF (cy>GetMaxY-ty) OR (i = anfang + anzahl) THEN BEGIN
  311.         MoveTo(1, GetMaxY);
  312.         meintext(5, 'Bild-Datei '+
  313.                 Copy(gr_filename,1,Pos('.',gr_filename)-1));
  314.         MoveTo(GetMaxX DIV 2, GetMaxY);
  315.         meintext(5, ' [RET] = weiter, [ESC] = Ende');
  316.         c := ReadKey;
  317.         ClearDevice;
  318.         cx := 0;
  319.         cy := 2*GetMaxY DIV 7 + faktor*unterlaengen;
  320.       END;
  321.       IF (i < anfang + anzahl) AND (c <> #27) THEN BEGIN
  322.         Str(i, st);
  323.         MoveTo(cx, cy + faktor * (1 - unterlaengen) + ty);
  324.         meintext(5, 'Nr.' + st);
  325.         MoveTo(cx, cy);
  326.         zeichne(userfont, i, FALSE, faktor, 0);
  327.         IF xbreite < vx THEN Inc(cx, vx + 9 - xbreite)
  328.                         ELSE Inc(cx, 10);
  329.       END;
  330.       Inc(i);
  331.     UNTIL (i > anfang + anzahl) OR (c = #27);
  332.   END;
  333.   RestoreCrtMode;
  334. END;
  335.  
  336. PROCEDURE initialisieren;
  337. {Grafikkarten werden erkannt, für verschiedene Karten wird
  338.  ein Korrekturfaktor und eine Zeichengröße beigegeben      }
  339. BEGIN
  340.   GraphDriver := detect;
  341.   InitGraph(GraphDriver, GraphMode, '');
  342.   CASE GraphDriver OF                 {sorgt für Hardcopies}
  343.     CGA: IF GraphMode = CGAHi THEN    {im richtigen Höhen- }
  344.             korr_faktor:=0.5;         {Seiten-Verhältnis   }
  345.     EGA,EGAMono: CASE GraphMode OF
  346.                    EGALo           : korr_faktor := 0.5;
  347.                    EGAHi,EGAMonoHi : korr_faktor := 0.936;
  348.                  END;
  349.     HercMono, PC3270 : korr_faktor := 0.832;
  350.     ELSE korr_faktor := 1;
  351.   END;
  352.   cx_g := Round(GetMaxX/24);  {Grundstellung (Ursprung) für}
  353.   cy_g := Round(GetMaxY*0.675);             {Graphik-Raster}
  354.   cy_t := Round(GetMaxY*0.758);     {Höhe für Zahlenausgabe}
  355.   tx   := Round(GetMaxX/16);        {Breite f. 1 Zahlenpaar}
  356.   txof := GetMaxX-GetMaxX DIV 4 - tx DIV 2;     {Menüleiste}
  357.   ty   := GetMaxY DIV 29;             {Höhe der Textzeichen}
  358.   CASE GraphDriver OF
  359.     CGA             : ty := 6;               {Anpassung für}
  360.     HercMono,PC3270 : ty := 11;       {einige Graphikkarten}
  361.     EGA,EGAMono     : ty := 10;              {ausprobieren!}
  362.     VGA             : ty := 12;
  363.   END;
  364.   SetColor(white);
  365.   RestoreCrtMode;
  366. END;
  367.  
  368. BEGIN                                      { Hauptprogramm }
  369.   ClrScr;
  370.   WriteLn(#10'Der Vektor-Graphik-Editor     ( V 2.0 )'+
  371.              '             h.w. 1988');
  372.   WriteLn('mit Einbindung von Referenz-Adressen, Ellipsen,'+
  373.           ' Bögen und Texten');
  374.   WriteLn('sowie Größen- und Lageveränderungen'#10);
  375.   loadfont;
  376.   Write(#10#10,
  377.        'Welche Vektor-Zeichen-Datei soll geladen werden: ');
  378.   ReadLn(gr_filename);
  379.   IF Pos('.',gr_filename)=0 THEN
  380.      gr_filename:=gr_filename+'.chr';
  381.   laden; initialisieren;
  382.   WITH userfont,info^ DO BEGIN
  383.     faktor:=Round(GetMaxY/3/(hoehe-unterlaengen));
  384.      {Anpassung des Vergrößerungsfaktors an die Zeichenhöhe}
  385.     cx:=0; cy:=faktor*hoehe;
  386.     REPEAT
  387.       GotoXY(1,5);
  388.       WriteLn('Bilddatei ',gr_filename,' enthält ',umfang,
  389.           ' Byte mit ',anzahl,' Bildern ab Nr.',anfang,'.');
  390.       WriteLn('Höhe der Zeichen ',hoehe+1,
  391.          ' Raster-Einheiten, ','Unterlängen ',-unterlaengen,
  392.          ' Raster-Einheiten');
  393.       WriteLn('Momentaner Vergrößerungsfaktor für Test: ',
  394.           faktor);
  395.       WriteLn;
  396.       WriteLn('Sie möchten ...');
  397.       WriteLn('    die Grafiken testen (schreiben) .. T');
  398.       WriteLn('    eine Grafik editieren (ansehen) .. E');
  399.       WriteLn('    die Standard-Höhe ändern ......... H');
  400.       WriteLn('    Platz für neue Grafik anfügen .... A');
  401.       WriteLn('    Grafiken in Übersicht sehen ...... G');
  402.       WriteLn('    Aufhören  ........................ Q');
  403.       Write  ('------------------------------------->    ',
  404.               #8#8#8);
  405.       c := UpCase(ReadKey);
  406.       CASE c OF
  407.         'T' : testen;
  408.         'E' : editieren;
  409.         'H' : hoehe_aendern;
  410.         'A' : IF anfang + anzahl < 1000 THEN anfuegen;
  411.         'G' : Zeichen_ansehen;
  412.       END;
  413.     UNTIL c = 'Q';
  414.   END;
  415.   Write(#13'Möchten Sie den Zeichensatz speichern? (J/N)');
  416.   IF UpCase(ReadKey) = 'J' THEN BEGIN
  417.     WriteLn;
  418.     Write('Neuer Name: (4 Zeichen für Borland) ');
  419.     ReadLn(gr_filename);
  420.     IF gr_filename<>'' THEN gr_speichern(gr_filename);
  421.     WriteLn('Falls Sie einen neuen Namen gewählt haben '+
  422.             'und den Satz mit GRAPH.TPU benutzen wollen,');
  423.     WriteLn('müssen Sie den Namen noch in GRAPH.TPU eintr'+
  424.             'agen (ab Byte 697C)!')
  425.   END;
  426. END.
  427. (* ------------------------------------------------------ *)
  428. (*                 Ende von GR-EDIT1.PAS                  *)