home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 05 / t4_grf / mustwahl.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-02-25  |  8.9 KB  |  292 lines
  1. (* ------------------------------------------------------ *)
  2. (*                       MUSTWAHL.PAS                     *)
  3. (* Programm zur Zusammenstellung von Farb- und Muster-    *)
  4. (* paletten  für Turbo Pascal Version 4.0                 *)
  5. (* (C) 1988 by Berthold Freier  &  PASCAL INTERNATIONAL   *)
  6.  
  7. PROGRAM musterwahl;
  8.  
  9. USES Crt,Graph;
  10.  
  11. CONST
  12.   musterzahl = 12;
  13.  
  14. TYPE                           (* Feld für die Belegungen *)
  15.   feld = ARRAY [1..20,0..1] OF Word;
  16.  
  17. VAR
  18.   streifen :     feld;  (* Array der Belegungen *)
  19.   xkoord,               (* angepaßte Koordinate *)
  20.   ykoord,               (* angepaßte Koordinate *)
  21.   wahl :      INTEGER;  (* gewählter Streifen   *)
  22.   farbenzahl,           (* Gesamtzahl der mög-  *)
  23.                         (* lichen Farben        *)
  24.   hintergrund,          (* Wert für Hintergrund *)
  25.   schreibfarbe : Word;  (* aktuelle Schreibfarbe*)
  26.   ch :           CHAR;  (* Tastatureingaben     *)
  27.   beenden,              (* Schalter für Ende    *)
  28.   neustart : BOOLEAN;   (* Schalter für Neustart*)
  29.  
  30.  
  31. (*             Trubo-Graphik-Treiber initialisieren:      *)
  32.  
  33. PROCEDURE initialisierung (VAR xkoord,ykoord : INTEGER;
  34.                            VAR farbenzahl : Word);
  35.  
  36. VAR
  37.   GraphDriver,GraphMode : INTEGER;
  38.  
  39.  
  40.   PROCEDURE Abort(Msg : STRING);
  41.   BEGIN
  42.     WriteLn(Msg, ': ', GraphErrorMsg(GraphResult));
  43.     Halt(1);
  44.   END;
  45.  
  46.  
  47. BEGIN
  48.                 (* Automatische Wahl des Grapik-Treibers: *)
  49.   GraphDriver := Detect;
  50.          (* Graphik initialisieren und die Dateien
  51.            .BGI und .CHR im aktuellen Verzeichnis suchen: *)
  52.   InitGraph(GraphDriver,GraphMode,'');
  53.   IF GraphResult <> grOk THEN BEGIN
  54.     WriteLn ('Fehler bei Initialisierung der Graphik :',
  55.               GraphDriver);
  56.     WriteLn ('Bitte RETURN drücken ');
  57.     ReadLn;  Halt;
  58.   END;
  59.   xkoord := (GetMaxX+1) DIV 320;
  60.   ykoord := (GetMaxY+1) DIV 50;
  61.   farbenzahl := GetMaxColor;
  62. END;
  63.  
  64.  
  65. PROCEDURE startwerte (VAR streifen : feld);
  66.  
  67. VAR
  68.   i : INTEGER;
  69.  
  70. BEGIN                         (* Feld mit Mustern belegen *)
  71.   FOR i := 1 TO 20 DO BEGIN
  72.     streifen[i,0] := i MOD (musterzahl-1) +1;
  73.     streifen[i,1] := i MOD farbenzahl +1;
  74.   END;
  75. END;
  76.  
  77.  
  78. PROCEDURE titel (xkoord,ykoord : INTEGER;
  79.                  schreibfarbe : Word);
  80.  
  81. BEGIN
  82.   SetColor(schreibfarbe);
  83.   SetTextStyle(TriplexFont,HorizDir,3);
  84.   OutTextXY(xkoord*25,1,
  85.             'Programm zur Muster-Zusammenstellung');
  86.   SetTextStyle(SmallFont,HorizDir,5);
  87. END;
  88.  
  89.  
  90. PROCEDURE erklaerung (VAR farbenzahl,hintergrund,
  91.                           schreibfarbe           : Word;
  92.                           xkoord,ykoord : INTEGER);
  93.  
  94. VAR
  95.   s : STRING[2];
  96.  
  97. BEGIN
  98.   SetColor(1);
  99.   SetTextStyle(SansSerifFont,HorizDir,1);
  100.   OutTextXY(xkoord*25,ykoord*10,
  101.   'Dieses Programm hilft bei der Zusammenstellung von');
  102.   OutTextXY(xkoord*25,ykoord*14,
  103.   'Muster-Paletten in Turbo Pascal. Die Funktionstasten');
  104.   OutTextXY(xkoord*25,ykoord*18,
  105.   'steuern den Ablauf und werden aktuell angezeigt.');
  106.   SetColor(1);
  107.   OutTextXY(xkoord*25,ykoord*40,
  108.      'Geben Sie nun die Farbnummer des Hintergrunds ein .');
  109.   Str(farbenzahl,s);
  110.   SetColor(3);
  111.   OutTextXY(xkoord*90,ykoord*44,
  112.             'Bitte nur Werte von 0 bis ');
  113.   OutTextXY(xkoord*210,ykoord*44,s);
  114.   REPEAT
  115.     Read (hintergrund)
  116.   UNTIL (hintergrund <= farbenzahl) AND (hintergrund > -1);
  117.   IF hintergrund > 0 THEN BEGIN (* Festlegen der Schreibf.*)
  118.     SetBkColor(hintergrund);
  119.     SetPalette(hintergrund,0);
  120.     SetPalette(0,hintergrund);
  121.     schreibfarbe := hintergrund;(* eventuell mit 0 tausch.*)
  122.   END
  123.   ELSE BEGIN
  124.     SetBkColor(0);
  125.     schreibfarbe := farbenzahl;
  126.   END;
  127.   SetViewport(xkoord*0,ykoord*0,xkoord*320,ykoord*50,
  128.               ClipOn);
  129.   ClearViewPort;
  130.                          (* Ausgabe der Tastenbelegungen: *)
  131.   SetColor(schreibfarbe);
  132.   SetTextStyle(SmallFont,HorizDir,5);
  133.   OutTextXY(xkoord*1,ykoord*44,'F1 = Pfeil nach links');
  134.   OutTextXY(xkoord*100,ykoord*44,'F3 = Farbnummer hoeher');
  135.   OutTextXY(xkoord*200,ykoord*44,'F4 = Musternummer hoeher');
  136.   OutTextXY(xkoord*1,ykoord*46,'F2 = Pfeil nach rechts');
  137.   OutTextXY(xkoord*100,ykoord*46,'F5 = Farbnummer tiefer');
  138.   OutTextXY(xkoord*200,ykoord*46,'F6 = Musternummer tiefer');
  139.   OutTextXY(xkoord*30,ykoord*48,
  140.             'F7 = Neustart des Programmes');
  141.   OutTextXY(xkoord*170,ykoord*48,'F9 = Programm beenden');
  142. END;
  143.  
  144.  
  145. PROCEDURE ausgabe (streifen : feld;
  146.                    xkoord,ykoord,wahl : INTEGER);
  147.  
  148. VAR
  149.   s : STRING[2];
  150.  
  151. BEGIN
  152.   SetFillStyle(0,0);
  153.   IF streifen[wahl,1] = hintergrund THEN s := '0'
  154.   ELSE IF streifen[wahl,1] = 0 THEN Str(schreibfarbe,s)
  155.   ELSE Str(streifen[wahl,1],s);
  156.   Bar(wahl*xkoord*16-xkoord*12,ykoord*7,
  157.       wahl*xkoord*16,ykoord*7+ykoord*2);
  158.   OutTextXY(wahl*xkoord*16-xkoord*10,ykoord*7,s);
  159.   Str(streifen[wahl,0],s);
  160.   Bar(wahl*xkoord*16-xkoord*12,ykoord*38,
  161.       wahl*xkoord*16,ykoord*38+ykoord*2);
  162.   OutTextXY(wahl*xkoord*16-xkoord*10,ykoord*38,s);
  163.   SetFillStyle(streifen[wahl,0],streifen[wahl,1]);
  164.   Bar(wahl*xkoord*16-xkoord*16,ykoord*12,
  165.       wahl*xkoord*16-xkoord*2,ykoord*37);
  166. END;
  167.  
  168.  
  169. PROCEDURE erstausgabe (streifen : feld;
  170.                        xkoord,ykoord : INTEGER);
  171.  
  172. VAR
  173.   i : INTEGER;
  174.  
  175. BEGIN
  176.   FOR i:=1 TO 20 DO BEGIN
  177.     SetFillStyle(streifen[i,0],streifen[i,1]);
  178.     Bar(i*xkoord*16-xkoord*16,ykoord*12,
  179.         i*xkoord*16-xkoord*2,ykoord*37);
  180.   END;
  181.   SetColor(schreibfarbe);
  182.   OutTextXY(xkoord*140,ykoord*5,'Farbnummern');
  183.   OutTextXY(xkoord*140,ykoord*40,'Musternummern');
  184.   FOR i:=1 TO 20 DO ausgabe(streifen,xkoord,ykoord,i);
  185.   SetLineStyle(1,0,3);            (* Linien zur Abteilung *)
  186.   Line(0,ykoord*9+3,xkoord*320,ykoord*9+3);
  187.   SetLineStyle(3,0,3);
  188.   Line(0,ykoord*43,xkoord*320,ykoord*43);
  189.   Line(0,ykoord*4,xkoord*320,ykoord*4);
  190. END;
  191.  
  192.  
  193. PROCEDURE pfeil (xkoord,ykoord,wahl : INTEGER;
  194.                  schreibfarbe : Word);
  195.  
  196. BEGIN
  197.   SetColor(schreibfarbe);
  198.   MoveTo(wahl*xkoord*16-xkoord*14,ykoord*10);
  199.   LineRel(xkoord*6,ykoord*1);
  200.   LineRel(xkoord*6,-ykoord*1);
  201.   LineTo(wahl*xkoord*16-xkoord*14,ykoord*10);
  202. END;
  203.  
  204.  
  205. PROCEDURE steuerung (ch : CHAR;
  206.                      VAR streifen : feld;
  207.                      VAR wahl : INTEGER);
  208.  
  209. BEGIN
  210.   CASE ch OF
  211.     #59 : BEGIN                               (* Taste F1 *)
  212.             pfeil(xkoord,ykoord,wahl,0);
  213.             wahl := wahl-1;
  214.             IF wahl = 0 THEN wahl := 20;
  215.             pfeil(xkoord,ykoord,wahl,schreibfarbe);
  216.           END;
  217.     #60 : BEGIN                               (* Taste F2 *)
  218.             pfeil(xkoord,ykoord,wahl,0);
  219.             wahl := wahl+1;
  220.             IF wahl = 21 THEN wahl:=1;
  221.             pfeil(xkoord,ykoord,wahl,schreibfarbe);
  222.           END;
  223.     #61 : BEGIN                               (* Taste F3 *)
  224.             streifen[wahl,1]:=streifen[wahl,1]+1;
  225.             IF streifen[wahl,1]=16 THEN streifen[wahl,1]:=0;
  226.             ausgabe(streifen,xkoord,ykoord,wahl);
  227.           END;
  228.     #63 : BEGIN                               (* Taste F5 *)
  229.             IF streifen[wahl,1]=0 THEN streifen[wahl,1]:=16;
  230.             streifen[wahl,1]:=streifen[wahl,1]-1;
  231.             ausgabe(streifen,xkoord,ykoord,wahl);
  232.           END;
  233.     #62 : BEGIN                               (* Taste F4 *)
  234.             streifen[wahl,0]:=streifen[wahl,0]+1;
  235.             IF streifen[wahl,0]=musterzahl THEN
  236.               streifen[wahl,0]:=0;
  237.             ausgabe(streifen,xkoord,ykoord,wahl);
  238.           END;
  239.     #64 : BEGIN                               (* Taste F6 *)
  240.             IF streifen[wahl,0]=0 THEN
  241.               streifen[wahl,0]:=musterzahl;
  242.             streifen[wahl,0]:=streifen[wahl,0]-1;
  243.             ausgabe(streifen,xkoord,ykoord,wahl);
  244.           END;
  245.     #65 : BEGIN                               (* Taste F7 *)
  246.             neustart:=TRUE;
  247.             ClearDevice;
  248.           END;
  249.     #67 : BEGIN                               (* Taste F9 *)
  250.             beenden:=TRUE;
  251.             ClearDevice;
  252.             CloseGraph;
  253.             Halt;
  254.           END;
  255.     ELSE Write(#7);                       (* andere Taste *)
  256.   END;
  257. END;
  258.  
  259.  
  260. PROCEDURE tastatur (VAR ch : CHAR; streifen : feld;
  261.                     wahl : INTEGER);
  262.  
  263. BEGIN
  264.   REPEAT
  265.     ch := ReadKey;
  266.     IF ch = #0 THEN BEGIN            (* wenn Sondertaste, *)
  267.       ch := ReadKey;                 (* dann weitergeben, *)
  268.       steuerung (ch,streifen,wahl);
  269.     END;                  (* ansonsten nichts ! *)
  270.   UNTIL beenden OR neustart;
  271. END;
  272.  
  273.  
  274. BEGIN
  275.   initialisierung(xkoord,ykoord,farbenzahl);
  276.   beenden := FALSE;
  277.   REPEAT
  278.     neustart := FALSE;
  279.     startwerte(streifen);
  280.     titel(xkoord,ykoord,3);
  281.     erklaerung(farbenzahl,schreibfarbe,hintergrund,
  282.                xkoord,ykoord);
  283.     titel(xkoord,ykoord,schreibfarbe);
  284.     erstausgabe(streifen,xkoord,ykoord);
  285.     SetLineStyle(0,0,1);
  286.     wahl := 10;
  287.     pfeil(xkoord,ykoord,wahl,schreibfarbe);
  288.     tastatur(ch,streifen,wahl);
  289.   UNTIL beenden;
  290.   CloseGraph;
  291. END.
  292.