Non puoi selezionare più di 25 argomenti Gli argomenti devono iniziare con una lettera o un numero, possono includere trattini ('-') e possono essere lunghi fino a 35 caratteri.

102 righe
2.5 KiB

  1. unit uMainForm;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  6. uglcContext, utsUtils,
  7. utsTextSuite;
  8. type
  9. TMainForm = class(TForm)
  10. procedure FormCreate(Sender: TObject);
  11. procedure FormDestroy(Sender: TObject);
  12. procedure FormPaint(Sender: TObject);
  13. private
  14. fContext: TglcContext;
  15. ftsContext: TtsContext;
  16. ftsRenderer: TtsRendererOpenGL;
  17. ftsCreator: TtsFontCreatorGDI;
  18. ftsFont: TtsFont;
  19. procedure Render;
  20. public
  21. { public declarations }
  22. end;
  23. var
  24. MainForm: TMainForm;
  25. implementation
  26. {$R *.lfm}
  27. uses
  28. dglOpenGL;
  29. const
  30. TEST_TEXT = 'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet.';
  31. procedure TMainForm.FormCreate(Sender: TObject);
  32. var
  33. pf: TglcContextPixelFormatSettings;
  34. begin
  35. pf := TglcContext.MakePF();
  36. fContext := TglcContext.GetPlatformClass.Create(self, pf);
  37. fContext.BuildContext;
  38. ftsContext := TtsContext.Create;
  39. ftsRenderer := TtsRendererOpenGL.Create(ftsContext, TtsFormat.tsFormatAlpha8);
  40. ftsCreator := TtsFontCreatorGDI.Create(ftsContext);
  41. ftsFont := ftsCreator.GetFontByFile(ExtractFilePath(Application.ExeName) + '../Prototype.ttf', 20, [], TtsAntiAliasing.tsAANormal);
  42. end;
  43. procedure TMainForm.FormDestroy(Sender: TObject);
  44. begin
  45. FreeAndNil(ftsFont);
  46. FreeAndNil(ftsCreator);
  47. FreeAndNil(ftsRenderer);
  48. FreeAndNil(ftsContext);
  49. FreeAndNil(fContext);
  50. end;
  51. procedure TMainForm.FormPaint(Sender: TObject);
  52. begin
  53. if Assigned(fContext) then begin
  54. Render;
  55. fContext.SwapBuffers;
  56. end;
  57. end;
  58. procedure TMainForm.Render;
  59. var
  60. block: TtsTextBlock;
  61. begin
  62. glClearColor(0, 0, 0, 0);
  63. glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  64. glViewport(0, 0, ClientWidth, ClientHeight);
  65. glMatrixMode(GL_PROJECTION);
  66. glLoadIdentity;
  67. glOrtho(0, ClientWidth, ClientHeight, 0, -10, 10);
  68. glMatrixMode(GL_MODELVIEW);
  69. glLoadIdentity;
  70. glEnable(GL_BLEND);
  71. glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
  72. block := ftsRenderer.BeginBlock(10, 10, ClientWidth-20, ClientHeight-20, [TtsBlockFlag.tsBlockFlagWordWrap]);
  73. try
  74. block.HorzAlign := TtsHorzAlignment.tsHorzAlignJustify;
  75. block.ChangeFont(ftsFont);
  76. block.ChangeColor(tsColor4f(1.0, 1.0, 1.0, 1.0));
  77. block.TextOutW(TEST_TEXT);
  78. finally
  79. ftsRenderer.EndBlock(block);
  80. end;
  81. end;
  82. end.