25개 이상의 토픽을 선택하실 수 없습니다. Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

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