Subversion Repositories Kolibri OS

Rev

Go to most recent revision | Blame | Last modification | View Log | Download | RSS feed

  1. MODULE kfont;
  2.  
  3. IMPORT sys := SYSTEM, kfonts, KOSAPI;
  4.  
  5.  
  6. CONST
  7.  
  8.   FileName = "/rd/1/fonts/tahoma.kf";
  9.  
  10.  
  11. TYPE
  12.  
  13.   TWindow = RECORD
  14.  
  15.     Left, Top, Width, Height: INTEGER;
  16.     Color: INTEGER;
  17.     Header: ARRAY 256 OF CHAR
  18.  
  19.   END;
  20.  
  21.  
  22. VAR
  23.  
  24.   canvas : INTEGER;
  25.   bpp32  : BOOLEAN;
  26.  
  27.   Font12, Font16: kfonts.TFont;
  28.  
  29.  
  30. PROCEDURE CreateCanvas(width, height: INTEGER; bpp32: BOOLEAN): INTEGER;
  31. VAR canvas: INTEGER;
  32. BEGIN
  33.   canvas := KOSAPI.malloc(width * height * (3 + ORD(bpp32)) + 8);
  34.   sys.PUT(canvas, width);
  35.   sys.PUT(canvas + 4, height)
  36.   RETURN canvas
  37. END CreateCanvas;
  38.  
  39.  
  40. PROCEDURE ClearCanvas(canvas, color: INTEGER; bpp32: BOOLEAN);
  41. VAR data, width, height, i: INTEGER;
  42. BEGIN
  43.   sys.GET(canvas, width);
  44.   sys.GET(canvas + 4, height);
  45.   data := canvas + 8;
  46.   IF bpp32 THEN
  47.     FOR i := 1 TO width * height DO
  48.       sys.PUT(data, color); INC(data, 4)
  49.     END
  50.   ELSE
  51.     FOR i := 1 TO width * height - 1 DO
  52.       sys.PUT(data, color); INC(data, 3)
  53.     END;
  54.     sys.MOVE(sys.ADR(color), data, 3)
  55.   END
  56. END ClearCanvas;
  57.  
  58.  
  59. PROCEDURE WindowRedrawStatus(p: INTEGER);
  60. VAR aux: INTEGER;
  61. BEGIN
  62.   aux := KOSAPI.sysfunc2(12, p)
  63. END WindowRedrawStatus;
  64.  
  65.  
  66. PROCEDURE DefineAndDrawWindow(x, y, width, height, color, style, hcolor, hstyle: INTEGER; htext: ARRAY OF CHAR);
  67. VAR aux: INTEGER;
  68. BEGIN
  69.   aux := KOSAPI.sysfunc6(0, x * 65536 + width, y * 65536 + height, color + LSL(style, 24), hcolor + LSL(hstyle, 24), sys.ADR(htext[0]))
  70. END DefineAndDrawWindow;
  71.  
  72.  
  73. PROCEDURE WaitForEvent(): INTEGER;
  74.   RETURN KOSAPI.sysfunc1(10)
  75. END WaitForEvent;
  76.  
  77.  
  78. PROCEDURE ExitApp;
  79. VAR aux: INTEGER;
  80. BEGIN
  81.   aux := KOSAPI.sysfunc1(-1)
  82. END ExitApp;
  83.  
  84.  
  85. PROCEDURE DrawCanvas(canvas: INTEGER; x, y: INTEGER; bpp32: BOOLEAN);
  86. VAR xsize, ysize, aux: INTEGER;
  87. BEGIN
  88.   sys.GET(canvas,     xsize);
  89.   sys.GET(canvas + 4, ysize);
  90.   aux := KOSAPI.sysfunc7(65, canvas + 8, xsize * 65536 + ysize, x * 65536 + y, 24 + 8 * ORD(bpp32), 0, 0)
  91. END DrawCanvas;
  92.  
  93.  
  94. PROCEDURE DrawText;
  95. VAR x, y: INTEGER;
  96. BEGIN
  97.   ClearCanvas(canvas, 00FFFFFFH, bpp32);
  98.  
  99.   x := 0; y := 0;
  100.  
  101.   kfonts.TextOut(Font16,  canvas,  x,  y,  sys.ADR("font size 16"),    -1,  000000FFH,  kfonts.bpp32 * ORD(bpp32) + kfonts.smoothing                          );
  102.         y := y + kfonts.TextHeight( Font16 );
  103.         x := x + 20;
  104.  
  105.   kfonts.TextOut(Font12,  canvas,  x,  y,  sys.ADR("font size 12"),    -1,  00FF0000H,  kfonts.bpp32 * ORD(bpp32) + kfonts.smoothing                          );
  106.         y := y + kfonts.TextHeight( Font12 );
  107.         x := x + 20;
  108.  
  109.   kfonts.TextOut(Font16,  canvas,  x,  y,  sys.ADR("italic"),          -1,  00808080H,  kfonts.bpp32 * ORD(bpp32) + kfonts.smoothing + kfonts.italic          );
  110.         y := y + kfonts.TextHeight( Font16 );
  111.         x := x + 20;
  112.  
  113.   kfonts.TextOut(Font16,  canvas,  x,  y,  sys.ADR("bold"),            -1,  00000000H,  kfonts.bpp32 * ORD(bpp32) + kfonts.smoothing + kfonts.bold            );
  114.         y := y + kfonts.TextHeight( Font16 );
  115.         x := x + 20;
  116.  
  117.   kfonts.TextOut(Font16,  canvas,  x,  y,  sys.ADR("underline"),       -1,  00000000H,  kfonts.bpp32 * ORD(bpp32) + kfonts.smoothing + kfonts.underline       );
  118.         y := y + kfonts.TextHeight( Font16 );
  119.         x := x + 20;
  120.  
  121.   kfonts.TextOut(Font16,  canvas,  x,  y,  sys.ADR("strike-through"),  -1,  00000000H,  kfonts.bpp32 * ORD(bpp32) + kfonts.smoothing + kfonts.strike_through  );
  122.         y := y + kfonts.TextHeight( Font16 );
  123.         x := x + 20;
  124.  
  125.   DrawCanvas(canvas, 10, 10, bpp32);
  126. END DrawText;
  127.  
  128.  
  129. PROCEDURE draw_window(Window: TWindow);
  130. BEGIN
  131.   WindowRedrawStatus(1);
  132.   DefineAndDrawWindow(Window.Left, Window.Top, Window.Width, Window.Height, Window.Color, 51, 0, 0, Window.Header);
  133.   DrawText;
  134.   WindowRedrawStatus(2);
  135. END draw_window;
  136.  
  137.  
  138. PROCEDURE main;
  139. VAR Window: TWindow;
  140.     bool: BOOLEAN;
  141. BEGIN
  142.  
  143.   Window.Left   := 200;
  144.   Window.Top    := 200;
  145.   Window.Width  := 400;
  146.   Window.Height := 300;
  147.   Window.Color  := 00C0C0C0H;
  148.   Window.Header := "kfonts";
  149.  
  150.   bpp32 := TRUE;
  151.   canvas := CreateCanvas(Window.Width - 30, Window.Height - 50, bpp32);
  152.  
  153.   Font12 := kfonts.LoadFont(FileName);
  154.   IF kfonts.Enabled(Font12, 12) THEN
  155.     bool := kfonts.SetSize(Font12, 12)
  156.   END;
  157.  
  158.   Font16 := kfonts.LoadFont(FileName);
  159.   IF kfonts.Enabled(Font16, 16) THEN
  160.     bool := kfonts.SetSize(Font16, 16)
  161.   END;
  162.  
  163.   WHILE TRUE DO
  164.     CASE WaitForEvent() OF
  165.     |1: draw_window(Window)
  166.     |3: ExitApp
  167.     ELSE
  168.     END
  169.   END
  170.  
  171. END main;
  172.  
  173. BEGIN
  174.   main
  175. END kfont.