home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9302 / pastrick / drehfont.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-02-23  |  9.1 KB  |  323 lines
  1. (* ****************************************************** *)
  2. (*                     DREHFONT.PAS                       *)
  3. (* BGI-Erweiterung für die Ausgabe von Texten in          *)
  4. (* beliebigen Richtungen auf dem Bildschirm               *)
  5. (* (für Vektorfonts)                                      *)
  6. (*  (c) 1993 Jeanette Winzenburg & DMV                    *)
  7. (* ****************************************************** *)
  8. UNIT DrehFont;
  9.  
  10. INTERFACE
  11.  
  12. USES Graph, Objects;
  13.  
  14. CONST
  15.   xyRatio : REAL = 1.0;
  16.       { Seitenverhältnis des Bildschirms }
  17.  
  18.   PROCEDURE InitDrehen;
  19.   { Initialisiert Drehmöglichkeit für Vektorfonts,
  20.     Aufruf nach InitGraph und vor SetTextStyle }
  21.  
  22.   { ** redefinierte BGI-Funktionen ** }
  23.   FUNCTION RegisterBGIFont(FontZeiger : Pointer) : INTEGER;
  24.  
  25.   PROCEDURE SetTextStyle
  26.                    (FontNr, Direction, CharSize : INTEGER);
  27.  
  28.   PROCEDURE SetUserCharSize
  29.                         (xMul, xDiv, yMul, yDiv : INTEGER);
  30.   PROCEDURE OutText(Text : STRING);
  31.   PROCEDURE OutTextXY(x, y : INTEGER; Text : STRING);
  32.  
  33.   { ** neue Einstellfunktionen ** }
  34.   PROCEDURE SetGrad(Winkel : INTEGER);
  35.   PROCEDURE SetDirection(Winkel : REAL);
  36.   PROCEDURE SetKursiv(Winkel : INTEGER);
  37.  
  38. IMPLEMENTATION
  39.  
  40. CONST
  41.   FontInstalled : BOOLEAN = FALSE;
  42.  
  43. TYPE
  44.   tBruch  = RECORD
  45.               Fakt, Nenn : INTEGER;
  46.             END;
  47.   tBPoint = RECORD
  48.               x, y : ShortInt;
  49.             END;
  50.   pPktBuf = ^tPktbuf;
  51.   tPktBuf = ARRAY [0..1023] OF tBPoint;
  52.  
  53.   pVektorTab = ^tVektorTab;
  54.   tVektorTab = ARRAY [0..256] OF WORD;
  55.   tZeiger    = ARRAY [0..10] OF Pointer;
  56.   MemFunct   = PROCEDURE(VAR p : Pointer; Size : WORD);
  57.  
  58.   pfontInfo = ^FontInfo;
  59.   FontInfo  = RECORD
  60.     Id         : BYTE;         { Startkennung }
  61.     Anzahl     : word;          { Zeichenzahl }
  62.     xx, Erstes : CHAR;       { erstes Zeichen }
  63.     VektorOfs  : WORD;    { offset Vektorinfo }
  64.     xx1, Hoehe,                 { Zeichenhöhe }
  65.     xx2, Unter : ShortInt; { Zeichenunterlänge }
  66.     xx3        : ARRAY [0..4] OF BYTE;
  67.   END;                     { alle xx  unbekannte Bedeutung }
  68.  
  69.   tFont = RECORD
  70.     Nummer : integer;
  71.     Base   : word;    { offset zum Infostart }
  72.     Zeiger,     { Zeiger auf Fontinformation }
  73.     Breiten   : pByteArray; { Breitentabelle }
  74.     Info      : pFontInfo;       { Infostart }
  75.     VektorTab : pVektorTab;  { Vektortabelle }
  76.     xFak, yFak: tBruch;       { Usercharsize }
  77.     kursiv    : BOOLEAN;       { kursiv-flag }
  78.     sRad, sSin, sCos, { Winkel/trigon. Werte }
  79.     kRad, kSin       : REAL;
  80.   END;
  81.  
  82. VAR
  83.   Font        : tFont; { aktueller Font }
  84.   RegFonts    : tZeiger;
  85.                       { registrierte Fonts }
  86.   GraphGetMem : MemFunct;
  87.                       { "alte" Speicherfkt }
  88.  
  89.   PROCEDURE FontGetMem(VAR P : Pointer; Size : WORD); FAR;
  90.   BEGIN
  91.     GraphGetMem(p, Size);
  92.     IF NOT FontInstalled THEN Font.Zeiger := p;
  93.   END;
  94.  
  95.   PROCEDURE InitDrehen;
  96.   BEGIN
  97.     FillChar(Font, SizeOf(font), 0);
  98.     GraphGetMem    := MemFunct(GraphGetMemPtr);
  99.     GraphGetMemPtr := @FontGetMem;
  100.               { Memreservierung verbiegen }
  101.   END;
  102.  
  103.   FUNCTION RegisterBGIFont(FontZeiger: Pointer): INTEGER;
  104.   VAR
  105.     c : INTEGER;
  106.   BEGIN
  107.     c := Graph.RegisterBGIFont(FontZeiger);
  108.     IF c > 0 THEN RegFonts[c] := FontZeiger;
  109.     RegisterBGIFont := c;
  110.   END;
  111.  
  112.   PROCEDURE InitFont(FontNr : INTEGER);
  113.           { setzt font-Werte }
  114.   VAR
  115.     i : INTEGER;
  116.   BEGIN
  117.     Font.Nummer := FontNr;
  118.     i := 0;
  119.     REPEAT
  120.       Inc(i);
  121.     UNTIL Font.Zeiger^[i] = $1A;
  122.     Font.Base := Word(Font.Zeiger^[i + 1]);
  123.     Font.Info := @Font.Zeiger^[Font.Base];
  124.     Font.Vektortab := @Font.Zeiger^[Font.Base + $10];
  125.     Font.Breiten   := @font.Zeiger^[font.base + $10 +
  126.                       Font.Info^.Anzahl * 2];
  127.     SetKursiv(0);
  128.     SetDirection(HorizDir);
  129.     FontInstalled := TRUE;
  130.   END;
  131.  
  132.   FUNCTION GetVektor(Zeichen : CHAR) : pPktbuf;
  133.     { liefert Zeiger auf Vektor }
  134.   VAR
  135.     Stelle : INTEGER;
  136.   BEGIN
  137.     GetVektor := NIL;
  138.     Stelle := Byte(Zeichen) - Byte(Font.Info^.Erstes);
  139.     IF (Stelle < 0) OR
  140.        (Stelle >= Font.Info^.Anzahl) THEN Exit;
  141.     GetVektor := @Font.Zeiger^[Font.Base +
  142.                  Font.Info^.VektorOfs +
  143.                  Font.VektorTab^[Stelle]];
  144.   END;
  145.  
  146.   PROCEDURE SetDirection(Winkel : REAL);
  147.   BEGIN
  148.     Font.sRad := Winkel;
  149.     Font.sSin := Sin(Font.sRad);
  150.     Font.sCos := Cos(Font.sRad);
  151.   END;
  152.  
  153.   PROCEDURE SetGrad(Winkel : INTEGER);
  154.   BEGIN
  155.     SetDirection(Winkel * pi / 180);
  156.   END;
  157.  
  158.   PROCEDURE SetKursiv(Winkel : INTEGER);
  159.   BEGIN
  160.     IF Winkel <> 0 THEN BEGIN
  161.       Font.Kursiv := True;
  162.       Font.kRad   := Winkel * pi/ 180;
  163.       Font.kSin   := Sin(Font.kRad);
  164.     END ELSE
  165.       Font.kursiv := FALSE;
  166.   END;
  167.  
  168.   PROCEDURE Transform(VAR Punkt : tPoint);
  169.   VAR
  170.     Temp : tPoint;
  171.   BEGIN
  172.     Punkt.x := Font.xFak.Fakt * Punkt.x
  173.                DIV Font.xFak.Nenn;
  174.     Punkt.y := - Font.yFak.Fakt * Punkt.y
  175.                DIV Font.yFak.Nenn ;
  176.     IF Font.kursiv THEN
  177.       Inc(Punkt.x, Round(Punkt.y * Font.kSin));
  178.     Temp.x := Round(Punkt.x * Font.sCos +
  179.                     Punkt.y * Font.sSin);
  180.     Temp.y := Round((Punkt.y * Font.sCos -
  181.                      Punkt.x * Font.sSin) * xyRatio);
  182.     Punkt := Temp;
  183.   END;
  184.  
  185.   PROCEDURE OutVektor(Vektor: pPktBuf);
  186.           { gibt Vektor aus }
  187.   VAR Anfang, Temp : tPoint;
  188.       Stelle       : INTEGER;
  189.       Punkt        : tbPoint;
  190.   BEGIN
  191.     Anfang.x := GetX;
  192.     Anfang.y := GetY;
  193.     Stelle   := 0;
  194.     Punkt    := Vektor^[Stelle];
  195.     WHILE Punkt.x AND $80 <> 0 DO BEGIN
  196.       Temp.x := (Punkt.x AND $7F);
  197.       Temp.y := (Punkt.y AND $7F);
  198.       IF (Temp.y AND $40) <> 0 THEN
  199.         Temp.y := Temp.y - $80;
  200.       Transform(Temp);
  201.       Inc(Temp.x, Anfang.x);
  202.       Inc(Temp.y, Anfang.y);
  203.       IF Punkt.y AND $80 <> 0 THEN
  204.         LineTo(Temp.x, Temp.y)
  205.       ELSE
  206.         MoveTo(Temp.x, Temp.y);
  207.       Inc(Stelle);
  208.       Punkt := Vektor^[Stelle];
  209.     END;
  210.   END;
  211.  
  212.   PROCEDURE OutChar(Zeichen : CHAR);
  213.           { gibt Zeichen aus }
  214.   VAR
  215.     Vektor : pPktBuf;
  216.   BEGIN
  217.     Vektor := GetVektor(Zeichen);
  218.     IF Vektor <> NIL THEN OutVektor(Vektor);
  219.   END;
  220.  
  221.   PROCEDURE SetUserCharSize
  222.                          (xMul, xDiv, yMul, yDiv : INTEGER);
  223.   BEGIN
  224.     Graph.SetUserCharSize(xMul, xDiv, yMul, yDiv);
  225.     Font.xFak.Fakt := xMul;
  226.     Font.yFak.Fakt := yMul;
  227.     Font.xFak.Nenn := xDiv;
  228.     Font.yFak.Nenn := yDiv;
  229.   END;
  230.  
  231. TYPE
  232.   Faktors = ARRAY [0..10] OF tBruch;
  233.  
  234. CONST            { Standard-Vergrößerungen }
  235.   StdSize : Faktors = ( (Fakt: 1; Nenn: 1),
  236.    (Fakt: 3; Nenn:  5), (Fakt: 7; Nenn: 10),
  237.    (Fakt: 8; Nenn: 11), (Fakt: 1; Nenn: 1),
  238.    (Fakt: 4; Nenn:  3), (Fakt: 5; Nenn: 3),
  239.    (Fakt: 2; Nenn:  1), (Fakt: 5; Nenn: 2),
  240.    (Fakt: 3; Nenn:  1), (Fakt: 4; Nenn: 1));
  241.  
  242.   PROCEDURE SetTextStyle
  243.                     (FontNr, Direction, CharSize : INTEGER);
  244.   BEGIN
  245.     FontInstalled := (Font.Nummer = FontNr)
  246.                   OR (FontNr = 0) OR (FontNr > 10);
  247.     Graph.SetTextStyle(FontNr, Direction, CharSize);
  248.     IF NOT FontInstalled THEN BEGIN
  249.       IF RegFonts[FontNr] <> NIL THEN
  250.         Font.Zeiger := RegFonts[FontNr];
  251.       InitFont(FontNr);
  252.     END;
  253.     CASE CharSize OF
  254.       0..10: BEGIN
  255.                Font.xFak := StdSize[CharSize];
  256.                Font.yFak := StdSize[CharSize];
  257.              END;
  258.       ELSE BEGIN
  259.         Font.xFak := StdSize[0];
  260.         Font.yFak := StdSize[0];
  261.       END;
  262.     END;
  263.     SetGrad(Direction);
  264.   END;
  265.  
  266.   PROCEDURE OutText(Text : STRING);
  267.   VAR
  268.     i            : INTEGER;
  269.     setting      : TextSettingsType;
  270.     merke, delta : tPoint;
  271.     len, hoehe   : INTEGER;
  272.   BEGIN
  273.     GetTextSettings(Setting);
  274.     IF (Setting.Font = Font.Nummer) AND
  275.        (Setting.Font <> 0) THEN BEGIN
  276.       Merke.x := GetX;
  277.       Merke.y := GetY;
  278.       Len     := TextWidth(Text);
  279.       Hoehe   := TextHeight(Text);
  280.       Delta.x := 0; Delta.y := 0;
  281.       CASE Setting.Horiz OF
  282.         CenterText : BEGIN
  283.           Delta.x := -Round(Len/2 * Font.sCos);
  284.           Delta.y := Round(Len/2 * Font.sSin * xyRatio);
  285.         END;
  286.         RightText : BEGIN
  287.           Delta.x := -Round(Len * Font.sCos);
  288.           Delta.y := Round(Len * Font.sSin * xyRatio);
  289.         END;
  290.       END;
  291.       CASE Setting.Vert OF
  292.         CenterText : BEGIN
  293.           Inc(Delta.x, Round(Hoehe/2*Font.sSin));
  294.           Inc(Delta.y, Round(Hoehe/2*Font.sCos * xyRatio));
  295.         END;
  296.         TopText : BEGIN
  297.           Inc(Delta.x, Round(Hoehe*Font.sSin));
  298.           Inc(Delta.y, Round(Hoehe*Font.sCos * xyRatio));
  299.         END;
  300.       END;
  301.       MoveTo(Merke.x + Delta.x, Merke.y + Delta.y);
  302.       FOR i := 1 TO Length(Text) DO
  303.         OutChar(Text[i]);
  304.       IF Setting.Horiz = LeftText THEN
  305.         MoveRel(-Delta.x, -Delta.y)
  306.       ELSE
  307.         MoveTo(Merke.x, Merke.y);
  308.     END ELSE
  309.       Graph.OutText(Text);
  310.   END;
  311.  
  312.   PROCEDURE OutTextXY(x, y: INTEGER; Text : STRING);
  313.   BEGIN
  314.     MoveTo(x, y);
  315.     OutText(text);
  316.   END;
  317.  
  318. BEGIN
  319.   FillChar(RegFonts, SizeOf(RegFonts), 0);
  320. END.
  321. (* ****************************************************** *)
  322. (*                Ende von DREHFONT.PAS                   *)
  323.