您最多选择25个主题 主题必须以字母或数字开头,可以包含连字符 (-),并且长度不得超过35个字符

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