diff --git a/examples/simple/TextSuiteTest.lpi b/examples/simple/TextSuiteTest.lpi
index ae42065..da32eb9 100644
--- a/examples/simple/TextSuiteTest.lpi
+++ b/examples/simple/TextSuiteTest.lpi
@@ -33,7 +33,7 @@
-
+
@@ -85,6 +85,21 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/examples/simple/TextSuiteTest.lpr b/examples/simple/TextSuiteTest.lpr
index dae9bf7..cdfe0a4 100644
--- a/examples/simple/TextSuiteTest.lpr
+++ b/examples/simple/TextSuiteTest.lpr
@@ -6,8 +6,8 @@ uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
- Interfaces, sysutils, Forms, uMainForm,
- utsFontCreatorGDI, utsUtils, utsTypes, utsTtfUtils, utsTextSuite, utsRendererOpenGL, utsCodePages, utsPostProcess;
+ Interfaces, sysutils, Forms, uMainForm, utsFontCreatorGDI, utsUtils, utsTypes, utsTtfUtils, utsTextSuite,
+ utsRendererOpenGL, utsCodePages, utsPostProcess, utsFontCreatorFreeType, utsGDI, utsFreeType;
{$R *.res}
diff --git a/examples/simple/TextSuiteTest.lps b/examples/simple/TextSuiteTest.lps
index f44d1ec..09122fd 100644
--- a/examples/simple/TextSuiteTest.lps
+++ b/examples/simple/TextSuiteTest.lps
@@ -4,13 +4,13 @@
-
+
-
+
@@ -20,95 +20,125 @@
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
-
+
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
@@ -120,508 +150,486 @@
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
+
-
-
-
-
+
+
+
-
-
-
+
+
+
+
-
-
-
-
+
+
+
-
-
-
-
+
+
-
-
+
+
-
-
-
+
+
+
-
-
+
-
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
+
-
-
-
+
+
+
-
-
+
+
-
-
+
-
-
-
-
+
+
+
-
-
+
-
-
-
-
+
+
+
-
-
-
+
+
+
-
-
+
-
-
-
-
+
+
+
-
-
+
-
-
-
-
+
+
+
-
+
-
-
-
-
+
+
+
-
-
-
+
-
-
-
-
+
+
+
-
-
+
-
-
-
-
+
+
+
-
-
+
-
+
+
+
+
+
+
+
+
-
+
-
+
-
+
-
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
+
-
+
+
+
+
+
-
-
-
-
-
-
-
+
diff --git a/examples/simple/uMainForm.pas b/examples/simple/uMainForm.pas
index aedf488..77c66ea 100644
--- a/examples/simple/uMainForm.pas
+++ b/examples/simple/uMainForm.pas
@@ -7,8 +7,8 @@ unit uMainForm;
interface
uses
- Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, uglcContext, TextSuite, uglcTypes,
- utsTextSuite, utsTypes, utsFontCreatorGDI, utsRendererOpenGL, utsPostProcess;
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, uglcContext, uglcTypes,
+ utsTextSuite, utsTypes, utsFontCreatorGDI, utsRendererOpenGL, utsPostProcess, utsFontCreatorFreeType;
type
TMainForm = class(TForm)
@@ -29,8 +29,10 @@ type
ftsContext: TtsContext;
ftsRenderer: TtsRendererOpenGL;
ftsGenerator: TtsFontGeneratorGDI;
+ ftsFreeType: TtsFontGeneratorFreeType;
ftsFont1: TtsFont;
ftsFont2: TtsFont;
+ ftsFont3: TtsFont;
{$ENDIF}
procedure Render;
public
@@ -48,23 +50,13 @@ uses
dglOpenGL;
const
- TEST_STRING = 'orem 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. 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.';
+ //TEST_STRING = '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. 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.';
+ TEST_STRING = 'Lorem';
procedure TMainForm.FormCreate(Sender: TObject);
var
pf: TglcContextPixelFormatSettings;
pp: TtsPostProcessStep;
- pa: TtsImage;
-const
- data: array[0..63] of Byte = (
- $FF, $AA, $88, $44, $44, $88, $AA, $FF,
- $AA, $88, $44, $22, $22, $44, $88, $AA,
- $88, $44, $22, $11, $11, $22, $44, $88,
- $44, $22, $11, $00, $00, $11, $22, $44,
- $44, $22, $11, $00, $00, $11, $22, $44,
- $88, $44, $22, $11, $11, $22, $44, $88,
- $AA, $88, $44, $22, $22, $44, $88, $AA,
- $FF, $AA, $88, $44, $44, $88, $AA, $FF);
begin
pf := TglcContext.MakePF();
fContext := TglcContext.GetPlatformClass.Create(self, pf);
@@ -82,6 +74,8 @@ begin
ftsRenderer := TtsRendererOpenGL.Create(ftsContext, tsFormatRGBA8);
ftsGenerator := TtsFontGeneratorGDI.Create(ftsContext);
+ ftsFreeType := TtsFontGeneratorFreeType.Create(ftsContext);
+ {
pp := TtsPostProcessFillColor.Create(tsColor4f(0.0, 0.0, 0.0, 1.0), TS_MODES_MODULATE_ALPHA, TS_CHANNELS_RGBA);
pp.AddUsageRange(tsUsageInclude, #$0000, #$FFFF);
ftsGenerator.AddPostProcessStep(pp);
@@ -89,9 +83,15 @@ begin
pp := TtsPostProcessShadow.Create(3, 0, 2, 2, tsColor4f(1.0, 0.0, 1.0, 0.05));
pp.AddUsageRange(tsUsageInclude, #$0000, #$FFFF);
ftsGenerator.AddPostProcessStep(pp);
-
- ftsFont1 := ftsGenerator.GetFontByName('Calibri', ftsRenderer, 100, [tsStyleBold, tsStyleItalic], tsAANormal);
- ftsFont2 := ftsGenerator.GetFontByName('Calibri', ftsRenderer, 20, [], tsAANormal);
+ }
+ try
+ ftsFont1 := ftsGenerator.GetFontByFile('Calibri', ftsRenderer, 25, [tsStyleBold], tsAANormal);
+ ftsFont2 := ftsGenerator.GetFontByName('Calibri', ftsRenderer, 20, [], tsAANormal);
+ ftsFont3 := ftsFreeType.GetFontByFile('calibrib.ttf', ftsRenderer, 25, tsAANone);
+ except
+ on e: EtsException do
+ MessageDlg('Error', e.Message, mtError, [mbOK], 0);
+ end;
{$ENDIF}
end;
@@ -104,6 +104,7 @@ begin
FreeAndNil(ftsFont1);
FreeAndNil(ftsFont2);
FreeAndNil(ftsGenerator);
+ FreeAndNil(ftsFreeType);
FreeAndNil(ftsRenderer);
FreeAndNil(ftsContext);
{$ENDIF}
@@ -134,7 +135,7 @@ begin
fFrameTime := t;
glViewport(0, 0, ClientWidth, ClientHeight);
- glClearColor(1, 1, 1, 0);
+ glClearColor(0, 0, 0, 0);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glMatrixMode(GL_PROJECTION);
@@ -151,25 +152,17 @@ begin
tsTextOutA(TEST_STRING);
tsTextEndBlock;
{$ELSE}
- block := ftsRenderer.BeginBlock(10, 10, ClientWidth-20, ClientHeight-20, [tsBlockFlagWordWrap]);
+ block := ftsRenderer.BeginBlock(0, 0, ClientWidth, ClientHeight, [tsBlockFlagWordWrap]);
try
block.HorzAlign := tsHorzAlignJustify;
block.ChangeFont(ftsFont1);
block.ChangeColor(tsColor4f(1.0, 1.0, 1.0, 1.0));
- block.TextOutW('L');
-
- block.ChangeFont(ftsFont2);
- block.ChangeColor(tsColor4f(1.0, 1.0, 1.0, 1.0));
block.TextOutW(TEST_STRING + sLineBreak);
- block.ChangeFont(ftsFont1);
- block.ChangeColor(tsColor4f(1.0, 1.0, 1.0, 1.0));
- block.TextOutW('L');
-
- block.ChangeFont(ftsFont2);
+ block.ChangeFont(ftsFont3);
block.ChangeColor(tsColor4f(1.0, 1.0, 1.0, 1.0));
- block.TextOutW(TEST_STRING);
+ block.TextOutA(TEST_STRING);
finally
ftsRenderer.EndBlock(block);
end;
diff --git a/utsFontCreatorFreeType.pas b/utsFontCreatorFreeType.pas
new file mode 100644
index 0000000..a7297eb
--- /dev/null
+++ b/utsFontCreatorFreeType.pas
@@ -0,0 +1,359 @@
+unit utsFontCreatorFreeType;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, syncobjs, dynlibs,
+ utsTextSuite, utsTypes, utsFreeType;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TtsFreeTypeFaceHandle = class
+ private
+ fFace: FT_Face;
+ public
+ constructor Create(const aFace: FT_Face);
+ destructor Destroy; override;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TtsFontFreeType = class(TtsFont)
+ private
+ fHandle: TtsFreeTypeFaceHandle;
+ public
+ constructor Create(const aHandle: TtsFreeTypeFaceHandle; const aRenderer: TtsRenderer;
+ const aGenerator: TtsFontGenerator; const aProperties: TtsFontProperties);
+ destructor Destroy; override;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TtsFontGeneratorFreeType = class(TtsFontGenerator)
+ private
+ fHandle: FT_Library;
+
+ function ConvertFont(const aFont: TtsFont): TtsFontFreeType;
+ procedure LoadNames(const aFace: FT_Face; var aProperties: TtsFontProperties);
+ protected
+ function GetGlyphMetrics(const aFont: TtsFont; const aCharCode: WideChar;
+ out aGlyphOrigin, aGlyphSize: TtsPosition; out aAdvance: Integer): Boolean; override;
+ procedure GetCharImage(const aFont: TtsFont; const aCharCode: WideChar;
+ const aCharImage: TtsImage); override;
+ public
+ function GetFontByFile(const aFilename: String; const aRenderer: TtsRenderer;
+ const aSize: Integer; const aAntiAliasing: TtsAntiAliasing): TtsFont; overload;
+
+ constructor Create(const aContext: TtsContext);
+ destructor Destroy; override;
+ end;
+
+implementation
+
+uses
+ utsUtils, math;
+
+const
+ FT_SIZE_FACTOR = 64;
+ FT_SIZE_RES = 72; //dpi
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsFreeTypeFaceHandle/////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsFreeTypeFaceHandle.Create(const aFace: FT_Face);
+begin
+ inherited Create;
+ fFace := aFace;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsFreeTypeFaceHandle.Destroy;
+begin
+ FT_Done_Face(fFace);
+ inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsFontFreeType///////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsFontFreeType.Create(const aHandle: TtsFreeTypeFaceHandle; const aRenderer: TtsRenderer;
+ const aGenerator: TtsFontGenerator; const aProperties: TtsFontProperties);
+begin
+ inherited Create(aRenderer, aGenerator, aProperties);
+ fHandle := aHandle;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsFontFreeType.Destroy;
+begin
+ FreeAndNil(fHandle);
+ inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsFontGeneratorFreeType//////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsFontGeneratorFreeType.ConvertFont(const aFont: TtsFont): TtsFontFreeType;
+begin
+ if not (aFont is TtsFontFreeType) then
+ raise EtsException.Create('aFont need to be a TtsFontGDI object');
+ result := (aFont as TtsFontFreeType);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsFontGeneratorFreeType.LoadNames(const aFace: FT_Face; var aProperties: TtsFontProperties);
+var
+ i, cnt: FT_Int;
+ err: FT_Error;
+ name: FT_SfntName;
+
+ function DecodeAnsi(const aCodePage: TtsCodePage): String;
+ var
+ tmp: WideString;
+ len: Integer;
+ begin
+ SetLength(tmp, name.string_len);
+ len := tsAnsiSBCDToWide(@tmp[1], name.string_len, PAnsiChar(name.string_), aCodePage, '?');
+ SetLength(tmp, len);
+ result := UTF8Encode(tmp);
+ end;
+
+ function Decode: String;
+ var
+ tmp: WideString;
+ len: Integer;
+ begin
+ result := '';
+ case name.platform_id of
+ TT_PLATFORM_APPLE_UNICODE: begin
+ case name.encoding_id of
+ TT_APPLE_ID_DEFAULT,
+ TT_APPLE_ID_UNICODE_1_1,
+ TT_APPLE_ID_UNICODE_2_0: begin
+ SetLength(tmp, name.string_len);
+ len := tsUTFBE16ToWide(@tmp[1], name.string_len, name.string_, name.string_len, '?');
+ SetLength(tmp, len);
+ result := UTF8Encode(tmp);
+ end;
+ end;
+ end;
+
+ TT_PLATFORM_ISO: begin
+ case name.encoding_id of
+ TT_ISO_ID_8859_1:
+ result := DecodeAnsi(tsISO_8859_1);
+ end;
+ end;
+ end;
+ end;
+
+begin
+ cnt := FT_Get_Sfnt_Name_Count(aFace);
+ for i := 0 to cnt-1 do begin
+ err := FT_Get_Sfnt_Name(aFace, i, @name);
+ if (err <> 0) then
+ continue;
+
+ case name.name_id of
+ TT_NAME_ID_COPYRIGHT:
+ if (aProperties.Copyright = '') then
+ aProperties.Copyright := Decode;
+
+ TT_NAME_ID_FONT_FAMILY:
+ if (aProperties.Fontname = '') then
+ aProperties.Fontname := Decode;
+
+ TT_NAME_ID_FULL_NAME:
+ if (aProperties.FullName = '') then
+ aProperties.FullName := Decode;
+ end;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsFontGeneratorFreeType.GetGlyphMetrics(const aFont: TtsFont; const aCharCode: WideChar; out aGlyphOrigin, aGlyphSize: TtsPosition; out aAdvance: Integer): Boolean;
+var
+ font: TtsFontFreeType;
+ err: FT_Error;
+begin
+ result := false;
+
+ aGlyphOrigin.x := 0;
+ aGlyphOrigin.x := 0;
+ aGlyphSize.x := 0;
+ aGlyphSize.y := 0;
+ aAdvance := 0;
+
+ font := ConvertFont(aFont);
+ case font.Properties.AntiAliasing of
+ tsAANormal:
+ err := FT_Load_Char(font.fHandle.fFace, Ord(aCharCode), FT_LOAD_DEFAULT);
+ tsAANone:
+ err := FT_Load_Char(font.fHandle.fFace, Ord(aCharCode), FT_LOAD_MONOCHROME);
+ else
+ raise EtsException.Create('unknown anti aliasing');
+ end;
+ case err of
+ FT_ERR_None:
+ { nop };
+ FT_ERR_Invalid_Character_Code:
+ exit;
+ else
+ raise EtsException.Create('unable to set glyph metrix: error=' + IntToStr(err));
+ end;
+
+ result := true;
+ with font.fHandle.fFace^.glyph^.metrics do begin
+ aAdvance := horiAdvance div FT_SIZE_FACTOR;
+ aGlyphOrigin.x := horiBearingX div FT_SIZE_FACTOR;
+ aGlyphOrigin.y := horiBearingY div FT_SIZE_FACTOR;
+ aGlyphSize.x := width div FT_SIZE_FACTOR;
+ aGlyphSize.y := height div FT_SIZE_FACTOR;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsFontGeneratorFreeType.GetCharImage(const aFont: TtsFont; const aCharCode: WideChar; const aCharImage: TtsImage);
+var
+ font: TtsFontFreeType;
+ err: FT_Error;
+ g: FT_GlyphSlot;
+ b: PFT_Bitmap;
+
+ procedure CopyGray;
+ var
+ x, y: Integer;
+ src, dst: PByte;
+ c: TtsColor4f;
+ begin
+ aCharImage.CreateEmpty(font.Renderer.Format, b^.width, b^.rows);
+ c := tsColor4f(1, 1, 1, 1);
+ for y := 0 to b^.rows-1 do begin
+ src := b^.buffer + y * b^.pitch;
+ dst := aCharImage.Scanline[y];
+ for x := 0 to b^.width-1 do begin
+ c.a := src^ / $FF;
+ inc(src, 1);
+ tsFormatMap(aCharImage.Format, dst, c);
+ end;
+ end;
+ end;
+
+ procedure CopyMono;
+ var
+ x, y, i, cnt: Integer;
+ src, dst: PByte;
+ tmp: Byte;
+ c: TtsColor4f;
+ begin
+ aCharImage.CreateEmpty(font.Renderer.Format, b^.width, b^.rows);
+ c := tsColor4f(1, 1, 1, 1);
+ for y := 0 to b^.rows-1 do begin
+ src := b^.buffer + y * b^.pitch;
+ dst := aCharImage.Scanline[y];
+ x := b^.width;
+ while (x > 0) do begin
+ cnt := min(8, x);
+ tmp := src^;
+ inc(src, 1);
+ for i := 1 to cnt do begin
+ if ((tmp and $80) > 0) then
+ c.a := 1.0
+ else
+ c.a := 0.0;
+ tmp := (tmp and not $80) shl 1;
+ tsFormatMap(aCharImage.Format, dst, c);
+ end;
+ dec(x, cnt);
+ end;
+ end;
+ end;
+
+begin
+ font := ConvertFont(aFont);
+ g := font.fHandle.fFace^.glyph;
+
+ if not (font.Properties.AntiAliasing in [tsAANormal, tsAANone]) then
+ raise Exception.Create('unknown anti aliasing');
+ case font.Properties.AntiAliasing of
+ tsAANormal:
+ err := FT_Load_Char(font.fHandle.fFace, Ord(aCharCode), FT_LOAD_DEFAULT or FT_LOAD_RENDER);
+ tsAANone:
+ err := FT_Load_Char(font.fHandle.fFace, Ord(aCharCode), FT_LOAD_MONOCHROME or FT_LOAD_TARGET_MONO or FT_LOAD_RENDER);
+ end;
+ if (err <> 0) then
+ raise EtsException.Create('unable to set glyph metrix: error=' + IntToStr(err));
+ if (g^.format <> FT_GLYPH_FORMAT_BITMAP) then
+ raise EtsException.Create('invalid glyph format');
+
+ b := @g^.bitmap;
+ case b^.pixel_mode of
+ FT_PIXEL_MODE_MONO:
+ CopyMono;
+ FT_PIXEL_MODE_GRAY:
+ CopyGray;
+ else
+ raise EtsException.Create('unknown glyph bitmap format');
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsFontGeneratorFreeType.GetFontByFile(const aFilename: String; const aRenderer: TtsRenderer;
+ const aSize: Integer; const aAntiAliasing: TtsAntiAliasing): TtsFont;
+var
+ face: FT_Face;
+ err: FT_Error;
+ prop: TtsFontProperties;
+begin
+ err := FT_New_Face(fHandle, PAnsiChar(aFilename), 0, @face);
+ if (err <> 0) then
+ raise EtsException.Create('unable to create free type face from file: ' + aFilename + ' error=' + IntToStr(err));
+
+ err := FT_Set_Char_Size(face, 0, aSize * FT_SIZE_FACTOR, FT_SIZE_RES, FT_SIZE_RES);
+ if (err <> 0) then
+ raise EtsException.Create('unable to set char size: error=' + IntToStr(err));
+
+ FillByte(prop, SizeOf(prop), 0);
+ prop.AntiAliasing := tsAANormal;
+ prop.FaceName := face^.family_name;
+ prop.StyleName := face^.style_name;
+ LoadNames(face, prop);
+
+ prop.Size := aSize;
+ prop.AntiAliasing := aAntiAliasing;
+ prop.DefaultChar := '?';
+ prop.Style := [];
+ if ((face^.style_flags and FT_STYLE_FLAG_BOLD) <> 0) then
+ Include(prop.Style, tsStyleBold);
+ if ((face^.style_flags and FT_STYLE_FLAG_ITALIC) <> 0) then
+ Include(prop.Style, tsStyleItalic);
+
+ prop.Ascent := face^.size^.metrics.ascender div FT_SIZE_FACTOR;
+ prop.Descent := -face^.size^.metrics.descender div FT_SIZE_FACTOR;
+ prop.ExternalLeading := 0;
+ prop.BaseLineOffset := 0;
+
+ prop.UnderlinePos := face^.underline_position div FT_SIZE_FACTOR;
+ prop.UnderlineSize := face^.underline_thickness div FT_SIZE_FACTOR;
+ prop.StrikeoutPos := 0;
+ prop.StrikeoutSize := 0;
+
+ result := TtsFontFreeType.Create(TtsFreeTypeFaceHandle.Create(face), aRenderer, self, prop);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsFontGeneratorFreeType.Create(const aContext: TtsContext);
+begin
+ inherited Create(aContext);
+ fHandle := InitFreeType;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsFontGeneratorFreeType.Destroy;
+begin
+ inherited Destroy; // first call interited
+ QuitFreeType; // QuitFreeType will free callpacks
+end;
+
+end.
+
diff --git a/utsFontCreatorGDI.pas b/utsFontCreatorGDI.pas
index 90bf50f..301deb9 100644
--- a/utsFontCreatorGDI.pas
+++ b/utsFontCreatorGDI.pas
@@ -5,25 +5,10 @@ unit utsFontCreatorGDI;
interface
uses
- Classes, SysUtils, syncobjs, dynlibs,
- utsTextSuite, utsTypes;
+ Classes, SysUtils,
+ utsTextSuite, utsTypes, utsGDI;
type
- HDC = Cardinal;
-
- TFixed = packed record
- fract: Word;
- value: Smallint;
- end;
-
- TMat2 = packed record
- eM11: TFixed;
- eM12: TFixed;
- eM21: TFixed;
- eM22: TFixed;
- end;
- PMat2 = ^TMat2;
-
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TtsFontGDI = class(TtsFont)
private
@@ -101,284 +86,6 @@ implementation
uses
math, utsTtfUtils;
-const
- LIB_GDI32 = 'gdi32.dll';
- LIB_KERNEL32 = 'kernel32.dll';
-
- GDI_ERROR = DWORD($FFFFFFFF);
-
- FW_NORMAL = 400;
- FW_BOLD = 700;
-
- DEFAULT_CHARSET = 1;
-
- NONANTIALIASED_QUALITY = 3;
- ANTIALIASED_QUALITY = 4;
-
- GGO_METRICS = 0;
- GGO_BITMAP = 1;
- GGO_GRAY8_BITMAP = 6;
- GGO_GLYPH_INDEX = $80;
-
- FR_PRIVATE = $10;
- FR_NOT_ENUM = $20;
-
- LOCALE_USER_DEFAULT = $0400;
- LOCALE_ILANGUAGE = $1;
-
- GCP_MAXEXTENT = $100000;
-
- TMPF_FIXED_PITCH = 1;
-
-type
- HFONT = Cardinal;
- HGDIOBJ = Cardinal;
-
- TLogFontA = record
- lfHeight: Longint;
- lfWidth: Longint;
- lfEscapement: Longint;
- lfOrientation: Longint;
- lfWeight: Longint;
- lfItalic: Byte;
- lfUnderline: Byte;
- lfStrikeOut: Byte;
- lfCharSet: Byte;
- lfOutPrecision: Byte;
- lfClipPrecision: Byte;
- lfQuality: Byte;
- lfPitchAndFamily: Byte;
- lfFaceName: array[0..31] of AnsiChar;
- end;
- PLogFontA = ^TLogFontA;
-
- TTextMetricW = record
- tmHeight: Longint;
- tmAscent: Longint;
- tmDescent: Longint;
- tmInternalLeading: Longint;
- tmExternalLeading: Longint;
- tmAveCharWidth: Longint;
- tmMaxCharWidth: Longint;
- tmWeight: Longint;
- tmOverhang: Longint;
- tmDigitizedAspectX: Longint;
- tmDigitizedAspectY: Longint;
- tmFirstChar: WideChar;
- tmLastChar: WideChar;
- tmDefaultChar: WideChar;
- tmBreakChar: WideChar;
- tmItalic: Byte;
- tmUnderlined: Byte;
- tmStruckOut: Byte;
- tmPitchAndFamily: Byte;
- tmCharSet: Byte;
- end;
- PTextMetricW = ^TTextMetricW;
-
- TGlyphMetrics = record
- gmBlackBoxX: Cardinal;
- gmBlackBoxY: Cardinal;
- gmptGlyphOrigin: TtsPosition;
- gmCellIncX: Smallint;
- gmCellIncY: Smallint;
- end;
- PGlyphMetrics = ^TGlyphMetrics;
-
- TGCPResultsW = record
- lStructSize: DWORD;
- lpOutString: PWideChar;
- lpOrder: PDWORD;
- lpDx: PInteger;
- lpCaretPos: PInteger;
- lpClass: PChar;
- lpGlyphs: PCardinal;
- nGlyphs: Cardinal;
- nMaxFit: Cardinal;
- end;
- PGCPResultsW = ^TGCPResultsW;
-
- TPanose = record
- bFamilyType: Byte;
- bSerifStyle: Byte;
- bWeight: Byte;
- bProportion: Byte;
- bContrast: Byte;
- bStrokeVariation: Byte;
- bArmStyle: Byte;
- bLetterform: Byte;
- bMidline: Byte;
- bXHeight: Byte;
- end;
- PPanose = ^TPanose;
-
- TOutlineTextmetricW = record
- otmSize: LongWord;
- otmTextMetrics: TTextMetricW;
- otmFiller: Byte;
- otmPanoseNumber: TPanose;
- otmfsSelection: LongWord;
- otmfsType: LongWord;
- otmsCharSlopeRise: Integer;
- otmsCharSlopeRun: Integer;
- otmItalicAngle: Integer;
- otmEMSquare: LongWord;
- otmAscent: Integer;
- otmDescent: Integer;
- otmLineGap: LongWord;
- otmsCapEmHeight: LongWord;
- otmsXHeight: LongWord;
- otmrcFontBox: TtsRect;
- otmMacAscent: Integer;
- otmMacDescent: Integer;
- otmMacLineGap: LongWord;
- otmusMinimumPPEM: LongWord;
- otmptSubscriptSize: TtsPosition;
- otmptSubscriptOffset: TtsPosition;
- otmptSuperscriptSize: TtsPosition;
- otmptSuperscriptOffset: TtsPosition;
- otmsStrikeoutSize: LongWord;
- otmsStrikeoutPosition: Integer;
- otmsUnderscoreSize: Integer;
- otmsUnderscorePosition: Integer;
- otmpFamilyName: PWideChar;
- otmpFaceName: PWideChar;
- otmpStyleName: PWideChar;
- otmpFullName: PWideChar;
- end;
- POutlineTextmetricW = ^TOutlineTextmetricW;
-
- TCreateFontIndirectA = function (const p1: TLogFontA): HFONT; stdcall;
-
- TAddFontResourceA = function(Filename: PAnsiChar): Integer; stdcall;
- TAddFontResourceExA = function(Filename: PAnsiChar; Flag: DWORD; pdv: Pointer): Integer; stdcall;
- TAddFontMemResourceEx = function(pbFont: Pointer; cbFont: DWORD; pdv: Pointer; pcFonts: PDWORD): THandle; stdcall;
- TRemoveFontResourceA = function(Filename: PAnsiChar): Boolean; stdcall;
- TRemoveFontResourceExA = function(filename: PAnsiChar; Flag: DWORD; pdv: Pointer): Boolean; stdcall;
- TRemoveFontMemResourceEx = function(fh: THandle): Boolean; stdcall;
-
- TGetTextMetricsW = function(DC: HDC; var TM: TTextMetricW): Boolean; stdcall;
- TGetGlyphOutlineA = function(DC: HDC; uChar, uFormat: Cardinal; lpgm: PGlyphMetrics; cbBuffer: DWORD; lpvBuffer: Pointer; lpmat2: PMat2): DWORD; stdcall;
-
- TGetCharacterPlacementW = function(DC: HDC; Str: PWideChar; Count, MaxExtent: Integer; Result: PGCPResultsW; Flags: DWORD): DWORD; stdcall;
- TGetFontData = function(DC: HDC; TableName, Offset: DWORD; Buffer: Pointer; Data: DWORD): DWORD; stdcall;
-
- TCreateCompatibleDC = function(DC: HDC): HDC; stdcall;
- TDeleteDC = function(DC: HDC): Boolean; stdcall;
- TSelectObject = function(DC: HDC; p2: HGDIOBJ): HGDIOBJ; stdcall;
- TDeleteObject = function(p1: HGDIOBJ): Boolean; stdcall;
-
- TGetOutlineTextMetricsW = function(DC: HDC; p2: LongWord; var OTMetricStructs: TOutlineTextmetricW): LongWord; stdcall;
-
- TGetLocaleInfoA = function(Locale: DWORD; LCType: DWORD; lpLCData: pAnsiChar; cchData: Integer): Integer; stdcall;
-
-var
- gdiRefCount: Integer;
- gdiCritSec: TCriticalSection;
- gdiInitialized: Boolean;
- gdiLibHandle: TLibHandle = 0;
- kernel32LibHandle: TLibHandle = 0;
-
- CreateFontIndirectA: TCreateFontIndirectA;
- AddFontResourceA: TAddFontResourceA;
- AddFontResourceExA: TAddFontResourceExA;
- AddFontMemResourceEx: TAddFontMemResourceEx;
- RemoveFontResourceA: TRemoveFontResourceA;
- RemoveFontResourceExA: TRemoveFontResourceExA;
- RemoveFontMemResourceEx: TRemoveFontMemResourceEx;
- GetTextMetricsW: TGetTextMetricsW;
- GetGlyphOutlineA: TGetGlyphOutlineA;
- GetCharacterPlacementW: TGetCharacterPlacementW;
- GetFontData: TGetFontData;
- CreateCompatibleDC: TCreateCompatibleDC;
- DeleteDC: TDeleteDC;
- SelectObject: TSelectObject;
- DeleteObject: TDeleteObject;
- GetOutlineTextMetricsW: TGetOutlineTextMetricsW;
-
- GetLocaleInfoA: TGetLocaleInfoA;
-
-procedure InitGDI;
-
- function GetProcAddr(const aLibHandle: TLibHandle; const aName: String): Pointer;
- begin
- result := GetProcAddress(aLibHandle, aName);
- if not Assigned(result) then
- raise EtsException.Create('unable to load procedure from library: ' + aName);
- end;
-
-begin
- try
- if (gdiLibHandle = 0) then begin
- gdiLibHandle := LoadLibrary(LIB_GDI32);
- if (gdiLibHandle = 0) then
- raise EtsException.Create('unable to load gdi lib: ' + LIB_GDI32);
- end;
-
- if (kernel32LibHandle = 0) then begin
- kernel32LibHandle := LoadLibrary(LIB_KERNEL32);
- if (kernel32LibHandle = 0) then
- raise EtsException.Create('unable to load kernel lib: ' + LIB_KERNEL32);
- end;
-
- CreateFontIndirectA := TCreateFontIndirectA( GetProcAddr(gdiLibHandle, 'CreateFontIndirectA'));
- AddFontResourceA := TAddFontResourceA( GetProcAddr(gdiLibHandle, 'AddFontResourceA'));
- AddFontResourceExA := TAddFontResourceExA( GetProcAddr(gdiLibHandle, 'AddFontResourceExA'));
- AddFontMemResourceEx := TAddFontMemResourceEx( GetProcAddr(gdiLibHandle, 'AddFontMemResourceEx'));
- RemoveFontResourceA := TRemoveFontResourceA( GetProcAddr(gdiLibHandle, 'RemoveFontResourceA'));
- RemoveFontResourceExA := TRemoveFontResourceExA( GetProcAddr(gdiLibHandle, 'RemoveFontResourceExA'));
- RemoveFontMemResourceEx := TRemoveFontMemResourceEx(GetProcAddr(gdiLibHandle, 'RemoveFontMemResourceEx'));
- GetTextMetricsW := TGetTextMetricsW( GetProcAddr(gdiLibHandle, 'GetTextMetricsW'));
- GetGlyphOutlineA := TGetGlyphOutlineA( GetProcAddr(gdiLibHandle, 'GetGlyphOutlineA'));
- GetCharacterPlacementW := TGetCharacterPlacementW( GetProcAddr(gdiLibHandle, 'GetCharacterPlacementW'));
- GetFontData := TGetFontData( GetProcAddr(gdiLibHandle, 'GetFontData'));
- CreateCompatibleDC := TCreateCompatibleDC( GetProcAddr(gdiLibHandle, 'CreateCompatibleDC'));
- DeleteDC := TDeleteDC( GetProcAddr(gdiLibHandle, 'DeleteDC'));
- SelectObject := TSelectObject( GetProcAddr(gdiLibHandle, 'SelectObject'));
- DeleteObject := TDeleteObject( GetProcAddr(gdiLibHandle, 'DeleteObject'));
- GetOutlineTextMetricsW := TGetOutlineTextMetricsW( GetProcAddr(gdiLibHandle, 'GetOutlineTextMetricsW'));
-
- GetLocaleInfoA := TGetLocaleInfoA(GetProcAddr(kernel32LibHandle, 'GetLocaleInfoA'));
-
- gdiInitialized := true;
- except
- gdiInitialized := false;
- FreeLibrary(gdiLibHandle);
- FreeLibrary(kernel32LibHandle);
- end;
-end;
-
-procedure QuitGDI;
-begin
- CreateFontIndirectA := nil;
- AddFontResourceA := nil;
- AddFontResourceExA := nil;
- RemoveFontResourceA := nil;
- RemoveFontResourceExA := nil;
- GetTextMetricsW := nil;
- GetGlyphOutlineA := nil;
- GetCharacterPlacementW := nil;
- GetFontData := nil;
- CreateCompatibleDC := nil;
- DeleteDC := nil;
- SelectObject := nil;
- DeleteObject := nil;
-
- GetLocaleInfoA := nil;
-
- if (gdiLibHandle <> 0) then begin
- FreeLibrary(gdiLibHandle);
- gdiLibHandle := 0;
- end;
-
- if (kernel32LibHandle <> 0) then begin
- FreeLibrary(kernel32LibHandle);
- kernel32LibHandle := 0;
- end;
-
- gdiInitialized := false;
-end;
-
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TtsFontGDI////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -853,11 +560,16 @@ var
prop: TtsFontProperties;
begin
reg := TtsFontRegistrationFile.Create(aFilename);
- if not reg.IsRegistered then
- raise EtsException.Create('unable to register font file: ' + aFilename);
- handle := CreateFont(reg.Fontname, aSize, aStyle, aAntiAliasing, prop);
- if (handle = 0) then
- raise EtsException.Create('unable to create font from file: ' + aFilename);
+ try
+ if not reg.IsRegistered then
+ raise EtsException.Create('unable to register font file: ' + aFilename);
+ handle := CreateFont(reg.Fontname, aSize, aStyle, aAntiAliasing, prop);
+ if (handle = 0) then
+ raise EtsException.Create('unable to create font from file: ' + aFilename);
+ except
+ FreeAndNil(reg);
+ raise;
+ end;
result := TtsRegistredFontGDI.Create(aRenderer, self, reg, prop, handle);
end;
@@ -882,38 +594,14 @@ end;
constructor TtsFontGeneratorGDI.Create(const aContext: TtsContext);
begin
inherited Create(aContext);
- gdiCritSec.Enter;
- try
- inc(gdiRefCount, 1);
- if not gdiInitialized then
- InitGDI;
- finally
- gdiCritSec.Leave;
- end;
+ InitGDI;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TtsFontGeneratorGDI.Destroy;
begin
inherited Destroy; // first free all fonts (managed by parent class)
- gdiCritSec.Enter;
- try
- dec(gdiRefCount, 1);
- if (gdiRefCount <= 0) then
- QuitGDI;
- finally
- gdiCritSec.Leave;
- end;
+ QuitGDI;
end;
-initialization
- gdiRefCount := 0;
- gdiInitialized := false;
- gdiCritSec := TCriticalSection.Create;
-
-finalization
- if gdiInitialized then
- QuitGDI;
- FreeAndNil(gdiCritSec);
-
end.
diff --git a/utsFreeType.pas b/utsFreeType.pas
new file mode 100644
index 0000000..d24fb15
--- /dev/null
+++ b/utsFreeType.pas
@@ -0,0 +1,607 @@
+unit utsFreeType;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, syncobjs, dynlibs, utsTextSuite;
+
+type
+ // Simple Types
+ FT_Error = Integer;
+ FT_Library = Pointer;
+ FT_Short = ShortInt;
+ FT_UShort = Word;
+ FT_Int = Integer;
+ FT_Int32 = Integer;
+ FT_UInt = Cardinal;
+ FT_Long = LongInt;
+ FT_ULong = Cardinal;
+ FT_Fixed = LongInt;
+ FT_Pos = LongInt;
+ FT_F26Dot6 = LongInt;
+ FT_String = AnsiChar;
+
+ // Enums
+ FT_Encoding = Integer;
+ FT_Glyph_Format = Integer;
+
+ // Pointer
+ FT_Face = ^FT_FaceRec;
+ FT_GlyphSlot = ^FT_GlyphSlotRec;
+ FT_Size = ^FT_SizeRec;
+ FT_CharMap = ^FT_CharMapRec;
+
+ PFT_Library = ^FT_Library;
+ PFT_Face = ^FT_Face;
+ PFT_String = ^FT_String;
+ PFT_SfntName = ^FT_SfntName;
+ PFT_Bitmap = ^FT_Bitmap;
+
+ // unneeded
+ FT_Driver = Pointer;
+ FT_Memory = Pointer;
+ FT_Stream = Pointer;
+ FT_ListNode = Pointer;
+ FT_Face_Internal = Pointer;
+ FT_SubGlyph = Pointer;
+ FT_Slot_Internal = Pointer;
+ FT_Size_Internal = Pointer;
+
+ FT_Generic_Finalizer = procedure(aObject: Pointer);
+
+ FT_Generic = record
+ data: Pointer;
+ finalizer: FT_Generic_Finalizer;
+ end;
+
+ FT_BBox = record
+ xMin, yMin, xMax, yMax: FT_Pos;
+ end;
+
+ FT_Vector = record
+ x, y: FT_Pos;
+ end;
+
+ FT_ListRec = record
+ head: FT_ListNode;
+ tail: FT_ListNode;
+ end;
+
+ FT_CharMapRec = record
+ face: FT_Face;
+ encoding: FT_Encoding;
+ platform_id: FT_UShort;
+ encoding_id: FT_UShort;
+ end;
+
+ FT_Size_Metrics = record
+ x_ppem: FT_UShort;
+ y_ppem: FT_UShort;
+
+ x_scale: FT_Fixed;
+ y_scale: FT_Fixed;
+
+ ascender: FT_Pos;
+ descender: FT_Pos;
+ height: FT_Pos;
+ max_advance: FT_Pos;
+ end;
+
+ FT_SizeRec = record
+ face: FT_Face;
+ generic_: FT_Generic;
+ metrics: FT_Size_Metrics;
+ internal: FT_Size_Internal;
+ end;
+
+ FT_Glyph_Metrics = record
+ width: FT_Pos;
+ height: FT_Pos;
+
+ horiBearingX: FT_Pos;
+ horiBearingY: FT_Pos;
+ horiAdvance: FT_Pos;
+
+ vertBearingX: FT_Pos;
+ vertBearingY: FT_Pos;
+ vertAdvance: FT_Pos;
+ end;
+
+ FT_Bitmap_Size = record
+ height: FT_Short;
+ width: FT_Short;
+
+ size: FT_Pos;
+
+ x_ppem: FT_Pos;
+ y_ppem: FT_Pos;
+ end;
+
+ FT_Bitmap = record
+ rows: Integer;
+ width: Integer;
+ pitch: Integer;
+ buffer: PByte;
+ num_grays: ShortInt;
+ pixel_mode: Byte;
+ palette_mode: Byte;
+ palette: Pointer;
+ end;
+
+ FT_Outline = record
+ n_contours: ShortInt;
+ n_points: ShortInt;
+
+ points: ^FT_Vector;
+ tags: PByte;
+ contours: PShortInt;
+
+ flags: Integer;
+ end;
+
+ FT_GlyphSlotRec = record
+ library_: FT_Library;
+ face: FT_Face;
+ next: FT_GlyphSlot;
+ reserved: FT_UInt;
+ generic_: FT_Generic;
+
+ metrics: FT_Glyph_Metrics;
+ linearHoriAdvance: FT_Fixed;
+ linearVertAdvance: FT_Fixed;
+ advance: FT_Vector;
+
+ format: FT_Glyph_Format;
+
+ bitmap: FT_Bitmap;
+ bitmap_left: FT_Int;
+ bitmap_top: FT_Int;
+
+ outline: FT_Outline;
+
+ num_subglyphs: FT_UInt;
+ subglyphs: FT_SubGlyph;
+
+ control_data: Pointer;
+ control_len: LongInt;
+
+ lsb_delta: FT_Pos;
+ rsb_delta: FT_Pos;
+
+ other: Pointer;
+
+ internal: FT_Slot_Internal;
+ end;
+
+ FT_FaceRec = record
+ num_faces: FT_Long;
+ face_index: FT_Long;
+
+ face_flags: FT_Long;
+ style_flags: FT_Long;
+
+ num_glyphs: FT_Long;
+
+ family_name: PFT_String;
+ style_name: PFT_String;
+
+ num_fixed_sizes: FT_Int;
+ available_sizes: ^FT_Bitmap_Size;
+
+ num_charmaps: FT_Int;
+ charmaps: ^FT_CharMap;
+
+ generic_: FT_Generic;
+
+ bbox: FT_BBox;
+
+ units_per_EM: FT_UShort;
+ ascender: FT_Short;
+ descender: FT_Short;
+ height: FT_Short;
+
+ max_advance_width: FT_Short;
+ max_advance_height: FT_Short;
+
+ underline_position: FT_Short;
+ underline_thickness: FT_Short;
+
+ glyph: FT_GlyphSlot;
+ size: FT_Size;
+ charmap: FT_CharMap;
+
+ { private }
+ driver: FT_Driver;
+ memory: FT_Memory;
+ stream: FT_Stream;
+ sizes_list: FT_ListRec;
+ autohint: FT_Generic;
+ extensions: Pointer;
+ internal: FT_Face_Internal;
+ { private end }
+ end;
+
+ FT_SfntName = record
+ platform_id: FT_UShort;
+ encoding_id: FT_UShort;
+ language_id: FT_UShort;
+ name_id: FT_UShort;
+
+ string_: PByte;
+ string_len: FT_UInt;
+ end;
+
+ TFT_Init_FreeType = function(aLibrary: PFT_Library): FT_Error;
+ TFT_Done_FreeType = function(aLibrary: FT_Library): FT_Error;
+ TFT_New_Face = function(aLibrary: FT_Library; const aFilename: PAnsiChar; aFaceIndex: FT_Long; aFace: PFT_Face): FT_Error;
+ TFT_Done_Face = function(aFace: FT_Face): FT_Error;
+
+ TFT_Get_Sfnt_Name_Count = function(aFace: FT_Face): FT_UInt;
+ TFT_Get_Sfnt_Name = function(aFace: FT_Face; aIndex: FT_UInt; aName: PFT_SfntName): FT_Error;
+
+ TFT_Set_Char_Size = function(aFace: FT_Face; aCharWidth: FT_F26Dot6; aCharHeight: FT_F26Dot6; aHorzDPI: FT_UInt; aVertDPI: FT_UInt): FT_Error;
+ TFT_Load_Char = function(aFace: FT_Face; aCharCode: FT_ULong; aLoadFlags: FT_Int32): FT_Error;
+
+var
+ FT_Init_FreeType: TFT_Init_FreeType;
+ FT_Done_FreeType: TFT_Done_FreeType;
+ FT_New_Face: TFT_New_Face;
+ FT_Done_Face: TFT_Done_Face;
+
+ FT_Get_Sfnt_Name_Count: TFT_Get_Sfnt_Name_Count;
+ FT_Get_Sfnt_Name: TFT_Get_Sfnt_Name;
+
+ FT_Set_Char_Size: TFT_Set_Char_Size;
+ FT_Load_Char: TFT_Load_Char;
+
+const
+ TT_NAME_ID_COPYRIGHT = 0;
+ TT_NAME_ID_FONT_FAMILY = 1;
+ TT_NAME_ID_FONT_SUBFAMILY = 2;
+ TT_NAME_ID_UNIQUE_ID = 3;
+ TT_NAME_ID_FULL_NAME = 4;
+ TT_NAME_ID_VERSION_STRING = 5;
+ TT_NAME_ID_PS_NAME = 6;
+ TT_NAME_ID_TRADEMARK = 7;
+
+ TT_PLATFORM_APPLE_UNICODE = 0;
+ TT_PLATFORM_MACINTOSH = 1;
+ TT_PLATFORM_ISO = 2; // deprecated
+ TT_PLATFORM_MICROSOFT = 3;
+ TT_PLATFORM_CUSTOM = 4;
+ TT_PLATFORM_ADOBE = 7; // artificial
+
+ TT_ISO_ID_7BIT_ASCII = 0;
+ TT_ISO_ID_10646 = 1;
+ TT_ISO_ID_8859_1 = 2;
+
+ TT_APPLE_ID_DEFAULT = 0; // Unicode 1.0
+ TT_APPLE_ID_UNICODE_1_1 = 1; // specify Hangul at U+34xx
+ TT_APPLE_ID_ISO_10646 = 2; // deprecated
+ TT_APPLE_ID_UNICODE_2_0 = 3; // or later
+ TT_APPLE_ID_UNICODE_32 = 4; // 2.0 or later, full repertoire
+
+ TT_MAC_ID_ROMAN = 0;
+ TT_MAC_ID_JAPANESE = 1;
+ TT_MAC_ID_TRADITIONAL_CHINESE = 2;
+ TT_MAC_ID_KOREAN = 3;
+ TT_MAC_ID_ARABIC = 4;
+ TT_MAC_ID_HEBREW = 5;
+ TT_MAC_ID_GREEK = 6;
+ TT_MAC_ID_RUSSIAN = 7;
+ TT_MAC_ID_RSYMBOL = 8;
+ TT_MAC_ID_DEVANAGARI = 9;
+ TT_MAC_ID_GURMUKHI = 10;
+ TT_MAC_ID_GUJARATI = 11;
+ TT_MAC_ID_ORIYA = 12;
+ TT_MAC_ID_BENGALI = 13;
+ TT_MAC_ID_TAMIL = 14;
+ TT_MAC_ID_TELUGU = 15;
+ TT_MAC_ID_KANNADA = 16;
+ TT_MAC_ID_MALAYALAM = 17;
+ TT_MAC_ID_SINHALESE = 18;
+ TT_MAC_ID_BURMESE = 19;
+ TT_MAC_ID_KHMER = 20;
+ TT_MAC_ID_THAI = 21;
+ TT_MAC_ID_LAOTIAN = 22;
+ TT_MAC_ID_GEORGIAN = 23;
+ TT_MAC_ID_ARMENIAN = 24;
+ TT_MAC_ID_MALDIVIAN = 25;
+ TT_MAC_ID_SIMPLIFIED_CHINESE = 25;
+ TT_MAC_ID_TIBETAN = 26;
+ TT_MAC_ID_MONGOLIAN = 27;
+ TT_MAC_ID_GEEZ = 28;
+ TT_MAC_ID_SLAVIC = 29;
+ TT_MAC_ID_VIETNAMESE = 30;
+ TT_MAC_ID_SINDHI = 31;
+ TT_MAC_ID_UNINTERP = 32;
+
+ FT_LOAD_DEFAULT = 0;
+ FT_LOAD_NO_SCALE = ( 1 shl 0 );
+ FT_LOAD_NO_HINTING = ( 1 shl 1 );
+ FT_LOAD_RENDER = ( 1 shl 2 );
+ FT_LOAD_NO_BITMAP = ( 1 shl 3 );
+ FT_LOAD_VERTICAL_LAYOUT = ( 1 shl 4 );
+ FT_LOAD_FORCE_AUTOHINT = ( 1 shl 5 );
+ FT_LOAD_CROP_BITMAP = ( 1 shl 6 );
+ FT_LOAD_PEDANTIC = ( 1 shl 7 );
+ FT_LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH = ( 1 shl 9 );
+ FT_LOAD_NO_RECURSE = ( 1 shl 10 );
+ FT_LOAD_IGNORE_TRANSFORM = ( 1 shl 11 );
+ FT_LOAD_MONOCHROME = ( 1 shl 12 );
+ FT_LOAD_LINEAR_DESIGN = ( 1 shl 13 );
+ FT_LOAD_NO_AUTOHINT = ( 1 shl 15 );
+ FT_LOAD_COLOR = ( 1 shl 20 );
+
+ FT_GLYPH_FORMAT_NONE = 0;
+ FT_GLYPH_FORMAT_COMPOSITE = (Ord('c') shl 24) or
+ (Ord('o') shl 16) or
+ (Ord('m') shl 8) or
+ (Ord('p'));
+ FT_GLYPH_FORMAT_BITMAP = (Ord('b') shl 24) or
+ (Ord('i') shl 16) or
+ (Ord('t') shl 8) or
+ (Ord('s'));
+ FT_GLYPH_FORMAT_OUTLINE = (Ord('o') shl 24) or
+ (Ord('u') shl 16) or
+ (Ord('t') shl 8) or
+ (Ord('l'));
+ FT_GLYPH_FORMAT_PLOTTER = (Ord('p') shl 24) or
+ (Ord('l') shl 16) or
+ (Ord('o') shl 8) or
+ (Ord('t'));
+
+ //FT_PIXEL_MODE_NONE = 0;
+ FT_PIXEL_MODE_MONO = 0;
+ FT_PIXEL_MODE_GRAY = 1;
+ FT_PIXEL_MODE_GRAY2 = 2;
+ FT_PIXEL_MODE_GRAY4 = 3;
+ FT_PIXEL_MODE_LCD = 4;
+ FT_PIXEL_MODE_LCD_V = 5;
+ FT_PIXEL_MODE_BGRA = 6;
+
+ FT_ERR_Ok = $00;
+ FT_ERR_None = $00;
+
+ FT_ERR_Cannot_Open_Resource = $01;
+ FT_ERR_Unknown_File_Format = $02;
+ FT_ERR_Invalid_File_Format = $03;
+ FT_ERR_Invalid_Version = $04;
+ FT_ERR_Lower_Module_Version = $05;
+ FT_ERR_Invalid_Argument = $06;
+ FT_ERR_Unimplemented_Feature = $07;
+ FT_ERR_Invalid_Table = $08;
+ FT_ERR_Invalid_Offset = $09;
+ FT_ERR_Array_Too_Large = $0A;
+
+ { glyph/character errors }
+ FT_ERR_Invalid_Glyph_Index = $10;
+ FT_ERR_Invalid_Character_Code = $11;
+ FT_ERR_Invalid_Glyph_Format = $12;
+ FT_ERR_Cannot_Render_Glyph = $13;
+ FT_ERR_Invalid_Outline = $14;
+ FT_ERR_Invalid_Composite = $15;
+ FT_ERR_Too_Many_Hints = $16;
+ FT_ERR_Invalid_Pixel_Size = $17;
+
+ { handle errors }
+ FT_ERR_Invalid_Handle = $20;
+ FT_ERR_Invalid_Library_Handle = $21;
+ FT_ERR_Invalid_Driver_Handle = $22;
+ FT_ERR_Invalid_Face_Handle = $23;
+ FT_ERR_Invalid_Size_Handle = $24;
+ FT_ERR_Invalid_Slot_Handle = $25;
+ FT_ERR_Invalid_CharMap_Handle = $26;
+ FT_ERR_Invalid_Cache_Handle = $27;
+ FT_ERR_Invalid_Stream_Handle = $28;
+
+ { driver errors }
+ FT_ERR_Too_Many_Drivers = $30;
+ FT_ERR_Too_Many_Extensions = $31;
+
+ { memory errors }
+ FT_ERR_Out_Of_Memory = $40;
+ FT_ERR_Unlisted_Object = $41;
+
+ { stream errors }
+ FT_ERR_Cannot_Open_Stream = $51;
+ FT_ERR_Invalid_Stream_Seek = $52;
+ FT_ERR_Invalid_Stream_Skip = $53;
+ FT_ERR_Invalid_Stream_Read = $54;
+ FT_ERR_Invalid_Stream_Operation = $55;
+ FT_ERR_Invalid_Frame_Operation = $56;
+ FT_ERR_Nested_Frame_Access = $57;
+ FT_ERR_Invalid_Frame_Read = $58;
+
+ { raster errors }
+ FT_ERR_Raster_Uninitialized = $60;
+ FT_ERR_Raster_Corrupted = $61;
+ FT_ERR_Raster_Overflow = $62;
+ FT_ERR_Raster_Negative_Height = $63;
+
+ { cache errors }
+ FT_ERR_Too_Many_Caches = $70;
+
+ { TrueType and SFNT errors }
+ FT_ERR_Invalid_Opcode = $80;
+ FT_ERR_Too_Few_Arguments = $81;
+ FT_ERR_Stack_Overflow = $82;
+ FT_ERR_Code_Overflow = $83;
+ FT_ERR_Bad_Argument = $84;
+ FT_ERR_Divide_By_Zero = $85;
+ FT_ERR_Invalid_Reference = $86;
+ FT_ERR_Debug_OpCode = $87;
+ FT_ERR_ENDF_In_Exec_Stream = $88;
+ FT_ERR_Nested_DEFS = $89;
+ FT_ERR_Invalid_CodeRange = $8A;
+ FT_ERR_Execution_Too_Long = $8B;
+ FT_ERR_Too_Many_Function_Defs = $8C;
+ FT_ERR_Too_Many_Instruction_Defs = $8D;
+ FT_ERR_Table_Missing = $8E;
+ FT_ERR_Horiz_Header_Missing = $8F;
+ FT_ERR_Locations_Missing = $90;
+ FT_ERR_Name_Table_Missing = $91;
+ FT_ERR_CMap_Table_Missing = $92;
+ FT_ERR_Hmtx_Table_Missing = $93;
+ FT_ERR_Post_Table_Missing = $94;
+ FT_ERR_Invalid_Horiz_Metrics = $95;
+ FT_ERR_Invalid_CharMap_Format = $96;
+ FT_ERR_Invalid_PPem = $97;
+ FT_ERR_Invalid_Vert_Metrics = $98;
+ FT_ERR_Could_Not_Find_Context = $99;
+ FT_ERR_Invalid_Post_Table_Format = $9A;
+ FT_ERR_Invalid_Post_Table = $9B;
+
+ { CFF CID and Type 1 errors }
+ FT_ERR_Syntax_Error = $A0;
+ FT_ERR_Stack_Underflow = $A1;
+ FT_ERR_Ignore = $A2;
+
+ { BDF errors }
+ FT_ERR_Missing_Startfont_Field = $B0;
+ FT_ERR_Missing_Font_Field = $B1;
+ FT_ERR_Missing_Size_Field = $B2;
+ FT_ERR_Missing_Chars_Field = $B3;
+ FT_ERR_Missing_Startchar_Field = $B4;
+ FT_ERR_Missing_Encoding_Field = $B5;
+ FT_ERR_Missing_Bbx_Field = $B6;
+ FT_ERR_Bbx_Too_Big = $B7;
+ FT_ERR_Corrupted_Font_Header = $B8;
+ FT_ERR_Corrupted_Font_Glyphs = $B9;
+
+ FT_STYLE_FLAG_ITALIC = (1 shl 0);
+ FT_STYLE_FLAG_BOLD = (1 shl 1);
+
+ FT_RENDER_MODE_NORMAL = 0;
+ FT_RENDER_MODE_LIGHT = 1;
+ FT_RENDER_MODE_MONO = 2;
+ FT_RENDER_MODE_LCD = 3;
+ FT_RENDER_MODE_LCD_V = 4;
+
+ FT_LOAD_TARGET_NORMAL = FT_RENDER_MODE_NORMAL shl 16;
+ FT_LOAD_TARGET_LIGHT = FT_RENDER_MODE_LIGHT shl 16;
+ FT_LOAD_TARGET_MONO = FT_RENDER_MODE_MONO shl 16;
+ FT_LOAD_TARGET_LCD = FT_RENDER_MODE_LCD shl 16;
+ FT_LOAD_TARGET_LCD_V = FT_RENDER_MODE_LCD_V shl 16;
+
+function InitFreeType: FT_Library;
+procedure QuitFreeType;
+
+implementation
+
+{$IFDEF WINDOWS}
+ {$IFDEF WIN32}
+ {$DEFINE TS_FT_WIN32}
+ {$ELSE}
+ {$DEFINE TS_FT_WIN64}
+ {$ENDIF}
+{$ELSE}
+ {$DEFINE TS_FT_LINUX}
+{$ENDIF}
+
+const
+{$IF DEFINED(TS_FT_WIN32)}
+ LIB_FREE_TYPE = 'freetype6-x86.dll';
+{$ELSEIF DEFINED(TS_FT_WIN64)}
+ LIB_FREE_TYPE = 'freetype6-x64.dll';
+{$ELSEIF DEFINED(TS_FT_LINUX)}
+ LIB_FREE_TYPE = ???
+{$ELSE}
+ {$ERROR 'unknown/unsupported OS'}
+{$IFEND}
+
+var
+ FreeTypeInitialized: Boolean;
+ FreeTypeRefCount: Integer;
+ FreeTypeCritSec: TCriticalSection;
+ FreeTypeLibHandle: TLibHandle = 0;
+
+ ftLibrary: FT_Library;
+
+function InitFreeType: FT_Library;
+
+ function GetProcAddr(const aName: String): Pointer;
+ begin
+ result := GetProcAddress(FreeTypeLibHandle, aName);
+ if not Assigned(result) then
+ raise EtsException.Create('unable to load procedure from library: ' + aName);
+ end;
+
+var
+ err: FT_Error;
+begin
+ result := nil;
+ FreeTypeCritSec.Enter;
+ try try
+ inc(FreeTypeRefCount, 1);
+ if FreeTypeInitialized then
+ exit;
+
+ if (FreeTypeLibHandle = 0) then begin
+ FreeTypeLibHandle := LoadLibrary(LIB_FREE_TYPE);
+ if (FreeTypeLibHandle = 0) then
+ raise EtsException.Create('unable to load free type lib: ' + LIB_FREE_TYPE + ' error=' + IntToStr(GetLastOSError));
+ end;
+
+ FT_Init_FreeType := TFT_Init_FreeType(GetProcAddr('FT_Init_FreeType'));
+ FT_Done_FreeType := TFT_Done_FreeType(GetProcAddr('FT_Done_FreeType'));
+ FT_New_Face := TFT_New_Face( GetProcAddr('FT_New_Face'));
+ FT_Done_Face := TFT_Done_Face( GetProcAddr('FT_Done_Face'));
+
+ FT_Get_Sfnt_Name_Count := TFT_Get_Sfnt_Name_Count(GetProcAddr('FT_Get_Sfnt_Name_Count'));
+ FT_Get_Sfnt_Name := TFT_Get_Sfnt_Name( GetProcAddr('FT_Get_Sfnt_Name'));
+
+ FT_Set_Char_Size := TFT_Set_Char_Size(GetProcAddr('FT_Set_Char_Size'));
+ FT_Load_Char := TFT_Load_Char( GetProcAddr('FT_Load_Char'));
+
+ err := FT_Init_FreeType(@ftLibrary);
+ if (err <> 0) then
+ raise EtsException.Create('unable to create free type library handle: ' + IntToStr(err));
+
+ FreeTypeInitialized := true;
+ result := ftLibrary;
+ except
+ FreeTypeInitialized := false;
+ end;
+ finally
+ FreeTypeCritSec.Leave;
+ end;
+end;
+
+procedure QuitFreeType;
+begin
+ FreeTypeCritSec.Enter;
+ try
+ dec(FreeTypeRefCount, 1);
+ if (FreeTypeRefCount > 0) then
+ exit;
+
+ FT_Done_FreeType(ftLibrary);
+
+ FT_Init_FreeType := nil;
+ FT_Done_FreeType := nil;
+
+ if (FreeTypeLibHandle <> 0) then begin
+ FreeLibrary(FreeTypeLibHandle);
+ FreeTypeLibHandle := 0;
+ end;
+ FreeTypeInitialized := false;
+ finally
+ FreeTypeCritSec.Leave;
+ end;
+end;
+
+initialization
+ FreeTypeRefCount := 0;
+ FreeTypeInitialized := false;
+ FreeTypeCritSec := TCriticalSection.Create;
+
+finalization
+ if FreeTypeInitialized then
+ QuitFreeType;
+ FreeAndNil(FreeTypeCritSec);
+
+end.
+
diff --git a/utsGDI.pas b/utsGDI.pas
new file mode 100644
index 0000000..893bb48
--- /dev/null
+++ b/utsGDI.pas
@@ -0,0 +1,342 @@
+unit utsGDI;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, utsTypes, syncobjs, dynlibs;
+
+type
+ HDC = Cardinal;
+
+ TFixed = packed record
+ fract: Word;
+ value: Smallint;
+ end;
+
+ TMat2 = packed record
+ eM11: TFixed;
+ eM12: TFixed;
+ eM21: TFixed;
+ eM22: TFixed;
+ end;
+ PMat2 = ^TMat2;
+
+
+const
+ GDI_ERROR = DWORD($FFFFFFFF);
+
+ FW_NORMAL = 400;
+ FW_BOLD = 700;
+
+ DEFAULT_CHARSET = 1;
+
+ NONANTIALIASED_QUALITY = 3;
+ ANTIALIASED_QUALITY = 4;
+
+ GGO_METRICS = 0;
+ GGO_BITMAP = 1;
+ GGO_GRAY8_BITMAP = 6;
+ GGO_GLYPH_INDEX = $80;
+
+ FR_PRIVATE = $10;
+ FR_NOT_ENUM = $20;
+
+ LOCALE_USER_DEFAULT = $0400;
+ LOCALE_ILANGUAGE = $1;
+
+ GCP_MAXEXTENT = $100000;
+
+ TMPF_FIXED_PITCH = 1;
+
+type
+ HFONT = Cardinal;
+ HGDIOBJ = Cardinal;
+
+ TLogFontA = record
+ lfHeight: Longint;
+ lfWidth: Longint;
+ lfEscapement: Longint;
+ lfOrientation: Longint;
+ lfWeight: Longint;
+ lfItalic: Byte;
+ lfUnderline: Byte;
+ lfStrikeOut: Byte;
+ lfCharSet: Byte;
+ lfOutPrecision: Byte;
+ lfClipPrecision: Byte;
+ lfQuality: Byte;
+ lfPitchAndFamily: Byte;
+ lfFaceName: array[0..31] of AnsiChar;
+ end;
+ PLogFontA = ^TLogFontA;
+
+ TTextMetricW = record
+ tmHeight: Longint;
+ tmAscent: Longint;
+ tmDescent: Longint;
+ tmInternalLeading: Longint;
+ tmExternalLeading: Longint;
+ tmAveCharWidth: Longint;
+ tmMaxCharWidth: Longint;
+ tmWeight: Longint;
+ tmOverhang: Longint;
+ tmDigitizedAspectX: Longint;
+ tmDigitizedAspectY: Longint;
+ tmFirstChar: WideChar;
+ tmLastChar: WideChar;
+ tmDefaultChar: WideChar;
+ tmBreakChar: WideChar;
+ tmItalic: Byte;
+ tmUnderlined: Byte;
+ tmStruckOut: Byte;
+ tmPitchAndFamily: Byte;
+ tmCharSet: Byte;
+ end;
+ PTextMetricW = ^TTextMetricW;
+
+ TGlyphMetrics = record
+ gmBlackBoxX: Cardinal;
+ gmBlackBoxY: Cardinal;
+ gmptGlyphOrigin: TtsPosition;
+ gmCellIncX: Smallint;
+ gmCellIncY: Smallint;
+ end;
+ PGlyphMetrics = ^TGlyphMetrics;
+
+ TGCPResultsW = record
+ lStructSize: DWORD;
+ lpOutString: PWideChar;
+ lpOrder: PDWORD;
+ lpDx: PInteger;
+ lpCaretPos: PInteger;
+ lpClass: PChar;
+ lpGlyphs: PCardinal;
+ nGlyphs: Cardinal;
+ nMaxFit: Cardinal;
+ end;
+ PGCPResultsW = ^TGCPResultsW;
+
+ TPanose = record
+ bFamilyType: Byte;
+ bSerifStyle: Byte;
+ bWeight: Byte;
+ bProportion: Byte;
+ bContrast: Byte;
+ bStrokeVariation: Byte;
+ bArmStyle: Byte;
+ bLetterform: Byte;
+ bMidline: Byte;
+ bXHeight: Byte;
+ end;
+ PPanose = ^TPanose;
+
+ TOutlineTextmetricW = record
+ otmSize: LongWord;
+ otmTextMetrics: TTextMetricW;
+ otmFiller: Byte;
+ otmPanoseNumber: TPanose;
+ otmfsSelection: LongWord;
+ otmfsType: LongWord;
+ otmsCharSlopeRise: Integer;
+ otmsCharSlopeRun: Integer;
+ otmItalicAngle: Integer;
+ otmEMSquare: LongWord;
+ otmAscent: Integer;
+ otmDescent: Integer;
+ otmLineGap: LongWord;
+ otmsCapEmHeight: LongWord;
+ otmsXHeight: LongWord;
+ otmrcFontBox: TtsRect;
+ otmMacAscent: Integer;
+ otmMacDescent: Integer;
+ otmMacLineGap: LongWord;
+ otmusMinimumPPEM: LongWord;
+ otmptSubscriptSize: TtsPosition;
+ otmptSubscriptOffset: TtsPosition;
+ otmptSuperscriptSize: TtsPosition;
+ otmptSuperscriptOffset: TtsPosition;
+ otmsStrikeoutSize: LongWord;
+ otmsStrikeoutPosition: Integer;
+ otmsUnderscoreSize: Integer;
+ otmsUnderscorePosition: Integer;
+ otmpFamilyName: PWideChar;
+ otmpFaceName: PWideChar;
+ otmpStyleName: PWideChar;
+ otmpFullName: PWideChar;
+ end;
+ POutlineTextmetricW = ^TOutlineTextmetricW;
+
+ TCreateFontIndirectA = function (const p1: TLogFontA): HFONT; stdcall;
+
+ TAddFontResourceA = function(Filename: PAnsiChar): Integer; stdcall;
+ TAddFontResourceExA = function(Filename: PAnsiChar; Flag: DWORD; pdv: Pointer): Integer; stdcall;
+ TAddFontMemResourceEx = function(pbFont: Pointer; cbFont: DWORD; pdv: Pointer; pcFonts: PDWORD): THandle; stdcall;
+ TRemoveFontResourceA = function(Filename: PAnsiChar): Boolean; stdcall;
+ TRemoveFontResourceExA = function(filename: PAnsiChar; Flag: DWORD; pdv: Pointer): Boolean; stdcall;
+ TRemoveFontMemResourceEx = function(fh: THandle): Boolean; stdcall;
+
+ TGetTextMetricsW = function(DC: HDC; var TM: TTextMetricW): Boolean; stdcall;
+ TGetGlyphOutlineA = function(DC: HDC; uChar, uFormat: Cardinal; lpgm: PGlyphMetrics; cbBuffer: DWORD; lpvBuffer: Pointer; lpmat2: PMat2): DWORD; stdcall;
+
+ TGetCharacterPlacementW = function(DC: HDC; Str: PWideChar; Count, MaxExtent: Integer; Result: PGCPResultsW; Flags: DWORD): DWORD; stdcall;
+ TGetFontData = function(DC: HDC; TableName, Offset: DWORD; Buffer: Pointer; Data: DWORD): DWORD; stdcall;
+
+ TCreateCompatibleDC = function(DC: HDC): HDC; stdcall;
+ TDeleteDC = function(DC: HDC): Boolean; stdcall;
+ TSelectObject = function(DC: HDC; p2: HGDIOBJ): HGDIOBJ; stdcall;
+ TDeleteObject = function(p1: HGDIOBJ): Boolean; stdcall;
+
+ TGetOutlineTextMetricsW = function(DC: HDC; p2: LongWord; var OTMetricStructs: TOutlineTextmetricW): LongWord; stdcall;
+
+ TGetLocaleInfoA = function(Locale: DWORD; LCType: DWORD; lpLCData: pAnsiChar; cchData: Integer): Integer; stdcall;
+
+var
+ CreateFontIndirectA: TCreateFontIndirectA;
+ AddFontResourceA: TAddFontResourceA;
+ AddFontResourceExA: TAddFontResourceExA;
+ AddFontMemResourceEx: TAddFontMemResourceEx;
+ RemoveFontResourceA: TRemoveFontResourceA;
+ RemoveFontResourceExA: TRemoveFontResourceExA;
+ RemoveFontMemResourceEx: TRemoveFontMemResourceEx;
+ GetTextMetricsW: TGetTextMetricsW;
+ GetGlyphOutlineA: TGetGlyphOutlineA;
+ GetCharacterPlacementW: TGetCharacterPlacementW;
+ GetFontData: TGetFontData;
+ CreateCompatibleDC: TCreateCompatibleDC;
+ DeleteDC: TDeleteDC;
+ SelectObject: TSelectObject;
+ DeleteObject: TDeleteObject;
+ GetOutlineTextMetricsW: TGetOutlineTextMetricsW;
+
+ GetLocaleInfoA: TGetLocaleInfoA;
+
+procedure InitGDI;
+procedure QuitGDI;
+
+implementation
+
+uses
+ utsTextSuite;
+
+const
+ LIB_GDI32 = 'gdi32.dll';
+ LIB_KERNEL32 = 'kernel32.dll';
+
+var
+ gdiRefCount: Integer;
+ gdiCritSec: TCriticalSection;
+ gdiInitialized: Boolean;
+ gdiLibHandle: TLibHandle = 0;
+ kernel32LibHandle: TLibHandle = 0;
+
+procedure InitGDI;
+
+ function GetProcAddr(const aLibHandle: TLibHandle; const aName: String): Pointer;
+ begin
+ result := GetProcAddress(aLibHandle, aName);
+ if not Assigned(result) then
+ raise EtsException.Create('unable to load procedure from library: ' + aName);
+ end;
+
+begin
+ gdiCritSec.Enter;
+ try try
+ inc(gdiRefCount, 1);
+ if gdiInitialized then
+ exit;
+
+ if (gdiLibHandle = 0) then begin
+ gdiLibHandle := LoadLibrary(LIB_GDI32);
+ if (gdiLibHandle = 0) then
+ raise EtsException.Create('unable to load gdi lib: ' + LIB_GDI32);
+ end;
+
+ if (kernel32LibHandle = 0) then begin
+ kernel32LibHandle := LoadLibrary(LIB_KERNEL32);
+ if (kernel32LibHandle = 0) then
+ raise EtsException.Create('unable to load kernel lib: ' + LIB_KERNEL32);
+ end;
+
+ CreateFontIndirectA := TCreateFontIndirectA( GetProcAddr(gdiLibHandle, 'CreateFontIndirectA'));
+ AddFontResourceA := TAddFontResourceA( GetProcAddr(gdiLibHandle, 'AddFontResourceA'));
+ AddFontResourceExA := TAddFontResourceExA( GetProcAddr(gdiLibHandle, 'AddFontResourceExA'));
+ AddFontMemResourceEx := TAddFontMemResourceEx( GetProcAddr(gdiLibHandle, 'AddFontMemResourceEx'));
+ RemoveFontResourceA := TRemoveFontResourceA( GetProcAddr(gdiLibHandle, 'RemoveFontResourceA'));
+ RemoveFontResourceExA := TRemoveFontResourceExA( GetProcAddr(gdiLibHandle, 'RemoveFontResourceExA'));
+ RemoveFontMemResourceEx := TRemoveFontMemResourceEx(GetProcAddr(gdiLibHandle, 'RemoveFontMemResourceEx'));
+ GetTextMetricsW := TGetTextMetricsW( GetProcAddr(gdiLibHandle, 'GetTextMetricsW'));
+ GetGlyphOutlineA := TGetGlyphOutlineA( GetProcAddr(gdiLibHandle, 'GetGlyphOutlineA'));
+ GetCharacterPlacementW := TGetCharacterPlacementW( GetProcAddr(gdiLibHandle, 'GetCharacterPlacementW'));
+ GetFontData := TGetFontData( GetProcAddr(gdiLibHandle, 'GetFontData'));
+ CreateCompatibleDC := TCreateCompatibleDC( GetProcAddr(gdiLibHandle, 'CreateCompatibleDC'));
+ DeleteDC := TDeleteDC( GetProcAddr(gdiLibHandle, 'DeleteDC'));
+ SelectObject := TSelectObject( GetProcAddr(gdiLibHandle, 'SelectObject'));
+ DeleteObject := TDeleteObject( GetProcAddr(gdiLibHandle, 'DeleteObject'));
+ GetOutlineTextMetricsW := TGetOutlineTextMetricsW( GetProcAddr(gdiLibHandle, 'GetOutlineTextMetricsW'));
+
+ GetLocaleInfoA := TGetLocaleInfoA(GetProcAddr(kernel32LibHandle, 'GetLocaleInfoA'));
+
+ gdiInitialized := true;
+ except
+ gdiInitialized := false;
+ FreeLibrary(gdiLibHandle);
+ FreeLibrary(kernel32LibHandle);
+ end;
+ finally
+ gdiCritSec.Leave;
+ end;
+end;
+
+procedure QuitGDI;
+begin
+ gdiCritSec.Enter;
+ try
+ dec(gdiRefCount, 1);
+ if (gdiRefCount > 0) then
+ exit;
+
+ CreateFontIndirectA := nil;
+ AddFontResourceA := nil;
+ AddFontResourceExA := nil;
+ RemoveFontResourceA := nil;
+ RemoveFontResourceExA := nil;
+ GetTextMetricsW := nil;
+ GetGlyphOutlineA := nil;
+ GetCharacterPlacementW := nil;
+ GetFontData := nil;
+ CreateCompatibleDC := nil;
+ DeleteDC := nil;
+ SelectObject := nil;
+ DeleteObject := nil;
+
+ GetLocaleInfoA := nil;
+
+ if (gdiLibHandle <> 0) then begin
+ FreeLibrary(gdiLibHandle);
+ gdiLibHandle := 0;
+ end;
+
+ if (kernel32LibHandle <> 0) then begin
+ FreeLibrary(kernel32LibHandle);
+ kernel32LibHandle := 0;
+ end;
+
+ gdiInitialized := false;
+ finally
+ gdiCritSec.Leave;
+ end;
+end;
+
+initialization
+ gdiRefCount := 0;
+ gdiInitialized := false;
+ gdiCritSec := TCriticalSection.Create;
+
+finalization
+ if gdiInitialized then
+ QuitGDI;
+ FreeAndNil(gdiCritSec);
+
+end.
diff --git a/utsPostProcess.pas b/utsPostProcess.pas
index 9495819..04d7cfa 100644
--- a/utsPostProcess.pas
+++ b/utsPostProcess.pas
@@ -235,6 +235,10 @@ begin
tmpX := fKernel.Size - fX;
tmpY := fKernel.Size - fY;
aCharImage.Blend(orig, tmpX, tmpY, @tsBlendFundAlpha);
+
+ aChar.GlyphOrigin := tsPosition(
+ aChar.GlyphOrigin.x - tmpX,
+ aChar.GlyphOrigin.y - tmpX);
finally
FreeAndNil(orig);
end;
diff --git a/utsTextSuite.pas b/utsTextSuite.pas
index 879a286..4a8179f 100644
--- a/utsTextSuite.pas
+++ b/utsTextSuite.pas
@@ -1513,7 +1513,7 @@ begin
try
if (tsStyleUnderline in aFont.Properties.Style) then
DrawLine(result, CharImage, aFont.Properties.UnderlinePos, aFont.Properties.UnderlineSize);
- if (tsStyleUnderline in aFont.Properties.Style) then
+ if (tsStyleStrikeout in aFont.Properties.Style) then
DrawLine(result, CharImage, aFont.Properties.StrikeoutPos, aFont.Properties.StrikeoutSize);
except
CharImage.FillColor(tsColor4f(1, 0, 0, 0), COLOR_CHANNELS_RGB, IMAGE_MODES_NORMAL);
@@ -2099,7 +2099,7 @@ var
font: TtsFont;
char: TtsChar;
metric: TtsTextMetric;
- DrawText: Boolean;
+ draw: Boolean;
function GetChar(const aCharCode: WideChar): TtsChar;
begin
@@ -2121,7 +2121,7 @@ var
end;
tsItemTypeText: begin
- if DrawText and Assigned(font) then begin
+ if draw and Assigned(font) then begin
c := item^.Text;
while (c^ <> #0) do begin
char := GetChar(c^);
@@ -2136,7 +2136,7 @@ var
end;
tsItemTypeSpace: begin
- if DrawText and Assigned(font) then begin
+ if draw and Assigned(font) then begin
ExtraSpaceActual := ExtraSpaceActual + ExtraSpaceTotal;
c := item^.Text;
while (c^ <> #0) do begin
@@ -2185,9 +2185,11 @@ var
// check vertical clipping
case aBlock.Clipping of
tsClipCharBorder, tsClipWordBorder:
- DrawText := (y + line^.meta.Height > rect.Top) and (y < rect.Bottom);
+ draw := (y + line^.meta.Height > rect.Top) and (y < rect.Bottom);
tsClipCharComplete, tsClipWordComplete:
- DrawText := (y > rect.Top) and (y + line^.meta.Height < rect.Bottom);
+ draw := (y > rect.Top) and (y + line^.meta.Height < rect.Bottom);
+ else
+ draw := true;
end;
// check horizontal alignment
@@ -2204,7 +2206,7 @@ var
ExtraSpaceTotal := (aBlock.Width - line^.meta.Width) / line^.meta.SpaceCount;
end;
- if DrawText then
+ if draw then
SetDrawPos(x, y + line^.meta.Ascent);
inc(y, line^.meta.Height + line^.meta.Spacing);
item := line^.First;
@@ -2303,6 +2305,7 @@ begin
if not Assigned(aText) then
exit;
len := Length(aText);
+ result := tsStrAlloc(len);
tsAnsiToWide(result, len, aText, fCodePage, fCodePageDefault);
end;
diff --git a/utsUtils.pas b/utsUtils.pas
index b5eb9af..7d6f400 100644
--- a/utsUtils.pas
+++ b/utsUtils.pas
@@ -16,6 +16,7 @@ function tsStrCopy(aDst, aSrc: PWideChar): PWideChar;
function tsAnsiToWide(aDst: PWideChar; const aSize: Integer; aSrc: PAnsiChar; const aCodePage: TtsCodePage; const aDefaultChar: WideChar): Integer;
function tsISO_8859_1ToWide(aDst: PWideChar; const aSize: Integer; aSrc: PAnsiChar): Integer;
function tsUTF8ToWide(aDst: PWideChar; const aSize: Integer; const aSrc: PAnsiChar; const aDefaultChar: WideChar): Integer;
+function tsUTFBE16ToWide(aDst: PWideChar; const aDstSize: Integer; aSrc: PByte; aSrcSize: Integer; const aDefaultChar: WideChar): Integer;
function tsAnsiSBCDToWide(aDst: PWideChar; const aSize: Integer; aSrc: PAnsiChar; const aCodePage: TtsCodePage; const aDefaultChar: WideChar): Integer;
implementation
@@ -162,6 +163,33 @@ begin
end;
end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function tsUTFBE16ToWide(aDst: PWideChar; const aDstSize: Integer; aSrc: PByte; aSrcSize: Integer;
+ const aDefaultChar: WideChar): Integer;
+var
+ tmp: Word;
+
+ procedure AddToDest(aCharCode: Word);
+ begin
+ if ((aCharCode and $D800) = $D800) or
+ ((aCharCode and $DC00) = $DC00) then
+ aCharCode := Ord(aDefaultChar);
+
+ aDst^ := WideChar(aCharCode);
+ inc(aDst, 1);
+ result := result + 1;
+ end;
+
+begin
+ result := 0;
+ while (aSrcSize > 1) and (aDstSize > 0) do begin
+ tmp := (aSrc^ shl 8) or (aSrc + 1)^;
+ inc(aSrc, 2);
+ dec(aSrcSize, 2);
+ AddToDest(tmp);
+ end;
+end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function tsAnsiSBCDToWide(aDst: PWideChar; const aSize: Integer; aSrc: PAnsiChar;
const aCodePage: TtsCodePage; const aDefaultChar: WideChar): Integer;