home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 08 / grafkurs / grafwrit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-06-01  |  3.3 KB  |  87 lines
  1. (*-------------------------------------------------------------------------*)
  2. (*                           GRAFWRIT.PAS                                  *)
  3. (*            Zeichenzellen-Ausgaberoutinen der Grafikserie                *)
  4. (*-------------------------------------------------------------------------*)
  5. PROCEDURE InitGrafWrite (NameDesFont : TGrafStr);
  6.  
  7. VAR f : FILE OF TFont;
  8.  
  9. BEGIN                                         (* Variablen inititalisieren *)
  10.   BoldFont := FALSE;        KursivFont := FALSE;      SmallFont := FALSE;
  11.   DoubleHighFont := FALSE;  DoubleWideFont := FALSE;
  12.   FontWriteMode := TransparentMode;
  13.   IF Length(NameDesFont) = 0 THEN                            (* Font laden *)
  14.     NameDesFont := DefaultFontName;
  15.   Assign(f,NameDesFont);
  16.   ReSet(f);  Read(f,Font);  Close(f);
  17. END;
  18. (*-------------------------------------------------------------------------*)
  19. PROCEDURE GrafWriteXY (x,y : REAL; Str : TGrafStr);
  20.  
  21. VAR i, xpos, ypos : INTEGER;  Cell11, Cell12, Cell21, Cell22 : TCell;
  22.  
  23.   (*-----------------------------------------------------------------------*)
  24.   PROCEDURE WriteCellXY (x,y : INTEGER; Cell : TCell); (* 1 Zeichen ausgeb.*)
  25.  
  26.   VAR i, j : TCellElemIndex;
  27.  
  28.     PROCEDURE clip(x, y: INTEGER);
  29.     BEGIN
  30.       WITH window[Aktwin]^ DO
  31.         IF (x>=Vxmin) AND (x<=Vxmax) AND (y>=Vymin) AND (y<=Vymax) THEN
  32.           Point(x,y)
  33.     END;
  34.  
  35.   BEGIN
  36.     FOR i := 0 TO CellSize DO
  37.       FOR j := 0 TO CellSize DO
  38.         CASE FontWriteMode OF
  39.           TransparentMode : IF Cell[i,j] THEN clip(xpos+j, ypos+i);
  40.               ReplaceMode : IF Cell[i,j] THEN clip(xpos+j, ypos+i)
  41.                             ELSE
  42.                               BEGIN
  43.                                 Set_Pen_Color(First_Color_Value);
  44.                                 clip(xpos+j, ypos+i);
  45.                                 Set_Pen_Color(Last_Color_Value)
  46.                               END
  47.         END
  48.   END;
  49.   (*-----------------------------------------------------------------------*)
  50. BEGIN
  51.   xpos := x_WinTrans(x);  ypos := y_WinTrans(y);
  52.   FOR i := 1 TO Length(Str) DO
  53.     BEGIN
  54.       Cell11 := Font[Ord(Str[i])];
  55.       IF BoldFont THEN MakeBold(Cell11);
  56.       IF SmallFont THEN MakeSmall(Cell11);
  57.       IF KursivFont THEN MakeKursiv(Cell11);
  58.       IF DoubleHighFont THEN MakeDoubleHigh(Cell11,Cell21);
  59.       IF DoubleWideFont THEN
  60.         BEGIN
  61.           MakeDoubleWide(Cell11,Cell12);
  62.           IF DoubleHighFont THEN MakeDoubleWide(Cell21,Cell22)
  63.         END;
  64.       WriteCellXY(xpos, ypos, Cell11);
  65.       IF DoubleHighFont THEN
  66.         BEGIN
  67.           ypos := ypos + Succ(CellSize);
  68.           WriteCellXY(xpos, ypos, Cell21);
  69.           ypos := ypos - Succ(CellSize)
  70.         END;
  71.       xpos := xpos + Succ(CellSize);
  72.       IF DoubleWideFont THEN
  73.         BEGIN
  74.           WriteCellXY(xpos, ypos, Cell12);
  75.           IF DoubleHighFont THEN
  76.             BEGIN
  77.               ypos := ypos + Succ(CellSize);
  78.               WriteCellXY(xpos, ypos, Cell22);
  79.               ypos := ypos - Succ(CellSize)
  80.             END;
  81.           xpos := xpos + Succ(CellSize)
  82.         END
  83.     END
  84. END;
  85. (*-------------------------------------------------------------------------*)
  86. (*                        Ende von GRAFWRIT.PAS                            *)
  87.