Vous ne pouvez pas sélectionner plus de 25 sujets Les noms de sujets doivent commencer par une lettre ou un nombre, peuvent contenir des tirets ('-') et peuvent comporter jusqu'à 35 caractères.

102 lignes
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.