From 03f66b835cc5744a4f7665e97e8cc265f135da0c Mon Sep 17 00:00:00 2001 From: Bergmann89 Date: Sun, 22 Feb 2015 20:26:33 +0100 Subject: [PATCH] * implemented FreeType font generator --- examples/simple/TextSuiteTest.lpi | 17 +- examples/simple/TextSuiteTest.lpr | 4 +- examples/simple/TextSuiteTest.lps | 622 +++++++++++++++--------------- examples/simple/uMainForm.pas | 51 ++- utsFontCreatorFreeType.pas | 359 +++++++++++++++++ utsFontCreatorGDI.pas | 340 +--------------- utsFreeType.pas | 607 +++++++++++++++++++++++++++++ utsGDI.pas | 342 ++++++++++++++++ utsPostProcess.pas | 4 + utsTextSuite.pas | 17 +- utsUtils.pas | 28 ++ 11 files changed, 1719 insertions(+), 672 deletions(-) create mode 100644 utsFontCreatorFreeType.pas create mode 100644 utsFreeType.pas create mode 100644 utsGDI.pas 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;