home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
1990
/
11
/
dtp
/
bezdemo.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-10-02
|
8KB
|
289 lines
(* ------------------------------------------------------ *)
(* BEZDEMO.PAS *)
(* Programm zur Demonstration der Unit BEZIER.PAS *)
(* Turbo Pascal 5.0 und 5.5 *)
(* (c) 1990 TOOLBOX *)
(* ------------------------------------------------------ *)
PROGRAM BezDemo;
USES Graph, Crt, Bezier, txKeys;
CONST BGIPath = '';
CursorOK : BOOLEAN = TRUE;
VAR i : WORD;
GD, GM, AnzPunkte : INTEGER;
Punkte : BezPoints;
x, y, MaxY : INTEGER;
DemoLineColor,
StartColor,
StuetzColor,
BezierColor : WORD;
Taste : KeyRec;
PROCEDURE InitGrafik;
BEGIN
DetectGraph(GD, GM);
CASE GD OF
MCGA,
CGA: BEGIN
GM := CGAC0;
StartColor := 3;
StuetzColor := 2;
BezierColor := 1;
DemoLineColor := 2;
END;
EGA,
EGA64,
VGA: BEGIN
StartColor := Yellow;
StuetzColor := LightRed;
BezierColor := White;
DemoLineColor := Green;
END;
HercMono:
BEGIN
StartColor := 1;
StuetzColor := 1;
BezierColor := 1;
DemoLineColor := 1;
END;
END;
InitGraph(GD, GM, BGIPath);
SetTextStyle(DefaultFont, HorizDir, 1);
SetTextJustify(CenterText, TopText);
MaxY:=GetMaxY - 3 * TextHeight('X');
SetColor(BezierColor);
Rectangle(0, 0, GetMaxX, MaxY);
Rectangle(0, MaxY, GetMaxX, GetMaxY);
SetViewPort(1, 1, GetMaxX-1, MaxY-1, TRUE);
END;
PROCEDURE CloseGrafik;
BEGIN
CloseGraph;
END;
PROCEDURE Schrift(Zeile1, Zeile2: STRING);
{ schreibt Text am unteren Bildschirmrand }
BEGIN
SetViewPort(1, MaxY+1, GetMaxX-1, GetMaxY-1, ClipOn);
ClearViewPort;
SetColor(StartColor);
OutTextXY(GetMaxX DIV 2, 1, Zeile1);
OutTextXY(GetMaxX DIV 2,
3*TextHeight('X') DIV 2+1, Zeile2);
SetViewPort(1, 1, GetMaxX-1, MaxY-1, ClipOn);
END;
PROCEDURE Add(VAR Source: INTEGER; Min, Max: INTEGER;
Step: SHORTINT; Wrap: BOOLEAN);
{ Add erhöht oder erniedrigt die als "Source" übergebene
Variable. Min und Max sind die erlaubten Grenzen, Wrap
schaltet das Wrapping bei Über- und Unterschreitung
der zulässigen Minimal- oder Maximalwerte ein und aus }
VAR
WrapNoetig : BOOLEAN;
SourceAlt : BYTE;
BEGIN
WrapNoetig := (Source+Step > Max) OR (Source+Step < Min);
CASE WrapNoetig OF
TRUE: IF Wrap THEN
IF Step > 0 THEN
Source := Min
ELSE
Source := Max
ELSE
IF Step > 0 THEN
Source := Max
ELSE
Source := Min;
FALSE: Inc(Source, Step);
END;
END;
PROCEDURE Cursor(VAR x, y: INTEGER; VAR OK: BOOLEAN);
{ Fadenkreuz-Cursor; übergibt die
Bildschirm-Koordinaten in den Variablen x und y }
VAR
ch : CHAR;
XAlt, YAlt : INTEGER;
CONST
Step: BYTE = 2;
PROCEDURE Draw; { zeichnet den Cursor }
BEGIN
Line(0, y, GetMaxX, y);
Line(x, 0, x, MaxY);
END;
BEGIN
XAlt:=x; { Original-Koordinaten sichern }
YAlt:=y;
SetWriteMode(XORPut);
SetColor(BezierColor);
REPEAT
Draw;
ScanKey(Taste);
Draw;
CASE Taste.Typ OF
KeyLinks : Add(x, 0, GetMaxX, -Step, TRUE);
KeyRechts : Add(x, 0, GetMaxX, Step, TRUE);
KeyOben : Add(y, 0, MaxY, -Step, TRUE);
KeyUnten : Add(y, 0, MaxY, Step, TRUE);
KeySpace : IF Step = 2 THEN { Schrittweite ändern }
Step := 15
ELSE
Step := 2;
END;
UNTIL Taste.Typ IN [KeyReturn, KeyEsc];
OK := (Taste.Typ = KeyReturn);
IF NOT OK THEN BEGIN { Mit <Esc> verlassen: }
x:=XAlt; { Original-Koordinaten restaurieren }
y:=YAlt;
END;
SetWriteMode(CopyPut);
END;
PROCEDURE ShowPoint(x, y : INTEGER; Color: WORD);
{ zeichnet die Markierungen für die Punkte }
BEGIN
SetColor(Color);
Circle(Round(x), Round(y), 6);
PutPixel(Round(x), Round(y), Color);
END;
PROCEDURE GetPoint(VAR x, y: INTEGER; Index, Color: WORD);
{ Eingabe der einzelnen Punkte mittels Fadenkreuzcursor }
CONST
OK: BOOLEAN = FALSE;
BEGIN
REPEAT
Cursor(x, y, OK);
IF NOT OK THEN BEGIN { Abbruch durch <ESC> }
CloseGrafik;
Halt;
END;
UNTIL OK;
ShowPoint(x, y, Color);
Punkte[Index].x := x;
Punkte[Index].y := y;
END;
PROCEDURE DoDemo; { Hauptprozedur für Demo }
VAR
ch : CHAR;
Index : INTEGER;
CONST
Step : BYTE = 5;
PROCEDURE ZeichneKurve(Farbe : WORD);
VAR
i : BYTE;
BEGIN
SetColor(Farbe);
SetLineStyle(SolidLn, 0, ThickWidth);
FOR i:=1 TO AnzPunkte DO BEGIN
{ Punkte an die Unit BEZIER übergeben }
BezDat^.TempPoints^[1]^[i].x := Punkte[i].x;
BezDat^.TempPoints^[1]^[i].y := Punkte[i].y;
END;
BezDoBeziere; { Kurve zeichnen }
SetLineStyle(SolidLn, 0, NormWidth);
END;
BEGIN
Index:=2;
ZeichneKurve(BezierColor);
REPEAT
x:=Round(Punkte[Index].x);
y:=Round(Punkte[Index].y);
IF GD = HercMono THEN
SetLineStyle(SolidLn, 0, ThickWidth);
ShowPoint(x, y, BezierColor);
SetLineStyle(SolidLn, 0, NormWidth);
ShowPoint(Round(Punkte[1].x),
Round(Punkte[1].y),StartColor);
ShowPoint(Round(Punkte[AnzPunkte].x),
Round(Punkte[AnzPunkte].y), StartColor);
ScanKey(Taste);
IF GD = HercMono THEN
SetLineStyle(SolidLn, 0, ThickWidth);
ShowPoint(x, y, 0);
SetLineStyle(SolidLn, 0, NormWidth);
CASE Taste.Typ OF
KeyLinks..KeyUnten:
BEGIN
ZeichneKurve(0); { alte Kurve löschen }
CASE Taste.Typ OF
KeyLinks: Add(x, 0, GetMaxX, -Step, TRUE);
KeyRechts: Add(x, 0, GetMaxX, Step, TRUE);
KeyOben: Add(y, 0, MaxY, -Step, TRUE);
KeyUnten: Add(y, 0, MaxY, Step, TRUE);
END;
Punkte[Index].x := x;
Punkte[Index].y := y;
ZeichneKurve(BezierColor); { neue Kurve }
END;
KeySpace: { Schrittweite ändern }
IF Step = 5 THEN Step := 15
ELSE Step := 5;
Zeichen:
CASE Taste.Zeichen OF
'+': BEGIN { nächsten Punkt anwählen }
ShowPoint(Round(Punkte[Index].x),
Round(Punkte[Index].y), StuetzColor);
Add(Index, 2, AnzPunkte-1, 1, TRUE);
END;
'-': BEGIN { vorigen Punkt anwählen }
ShowPoint(Round(Punkte[Index].x),
Round(Punkte[Index].y), StuetzColor);
Add(Index, 2, AnzPunkte-1, -1, TRUE);
END;
END;
END;
UNTIL Taste.Typ = KeyEsc;
CloseGrafik;
Halt;
END;
BEGIN
ClrScr;
HighVideo;
Writeln(^J, 'toolbox Bézier-Demonstration');
Writeln('============================', ^J^J);
LowVideo;
Writeln('Geben Sie bitte Sie bitte '+
'die Anzahl aller Punkte');
Write('incl. der Stützstellen ein (3 bis ',
BezMaxPoints, '): ');
Readln(AnzPunkte);
IF (AnzPunkte<3) OR (AnzPunkte>BezMaxPoints) THEN
Halt;
InitGrafik;
BezInitBezier(AnzPunkte);
x := GetMaxX DIV 2;
y := MaxY DIV 2;
Schrift('Start- und Endpunkt definieren',
'<SPACE> Schrittweite <ESC> Abbruch');
GetPoint(x, y, 1, StartColor);
GetPoint(x, y, AnzPunkte, StartColor);
Schrift('Stützpunkte definieren',
'<SPACE> Schrittweite <ESC> Abbruch');
FOR i := 2 TO AnzPunkte - 1 DO
GetPoint(x, y, i, StuetzColor);
Schrift('Stützpunkte verschieben mit <CURSOR>',
'<+/-> Punkt wählen <SPACE> Schrittweite');
DoDemo;
FOR i := 1 TO AnzPunkte DO
ShowPoint(Round(Punkte[i].x),
Round(Punkte[i].y), 0);
BezDisposeBezier;
END.