1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
{$mode objfpc}{$h+}
{$CODEPAGE UTF8}
program textout;
uses
cwstring,classes, sysutils, FPImage, FPCanvas, FPImgCanv, ftFont, FPWritePNG, freetype;
const
MyColor : TFPColor = (Red: $7FFF; Green: $0000; Blue: $FFFF; Alpha: alphaOpaque);
procedure DoDraw(FN, fnChinese : String);
var
canvas : TFPcustomCAnvas;
image : TFPCustomImage;
writer : TFPCustomImageWriter;
f : TFreeTypeFont;
S : String;
U : UnicodeString;
begin
f:=Nil;
image := TFPMemoryImage.Create (256,256);
Canvas := TFPImageCanvas.Create (image);
Writer := TFPWriterPNG.Create;
InitEngine;
with TFPWriterPNG(Writer) do
begin
indexed := false;
wordsized := false;
UseAlpha := false;
GrayScale := false;
end;
try
with Canvas as TFPImageCanvas do
begin
// Clear background
brush.FPcolor:=colwhite;
brush.style:=bsSolid;
pen.mode := pmCopy;
pen.style := psSolid;
pen.width := 1;
pen.FPColor := colWhite;
FillRect(0,0,255,255);
// Set font
F:=TFreeTypeFont.Create;
Font:=F;
Font.Name:=FN;
Font.Size:=14;
Font.FPColor:=colBlack;
S:='Hello, world!';
Canvas.TextOut(20,20,S);
U:=UTF8Decode('привет, Мир!');
Font.FPColor:=colBlue;
Canvas.TextOut(50,50,U);
if (FNChinese<>'') then
begin
Font.Name:=FNChinese;
U:=UTF8Decode('你好，世界!');
Font.FPColor:=colRed;
Canvas.TextOut(20,100,U);
end
else
begin
Font.Size:=10;
Canvas.TextOut(20,100,'No chinese font available.');
end;
U:=UTF8Decode('non-ASCII chars: ßéùµàçè§âêû');
Font.Size:=10;
Canvas.TextOut(20,180,U);
end;
writeln ('Saving to "TextTest.png" for inspection !');
Image.SaveToFile ('TextTest.png', writer);
finally
F.Free;
Canvas.Free;
image.Free;
writer.Free;
end;
end;
Var
D,FontFile, FontFileChinese : String;
Info : TSearchRec;
begin
// Initialize font search path;
{$IFDEF UNIX}
{$IFNDEF DARWIN}
D := '/usr/share/fonts/truetype/';
DefaultSearchPath:=D;
if FindFirst(DefaultSearchPath+AllFilesMask,faDirectory,Info)=0 then
try
repeat
if (Info.Attr and faDirectory)<>0 then
if (Info.Name<>'.') and (info.name<>'..') then
DefaultSearchPath:=DefaultSearchPath+';'+D+Info.Name;
Until FindNext(Info)<>0;
finally
FindClose(Info);
end;
{$ENDIF}
{$ENDIF}
FontFile:=ParamStr(1);
if FontFile='' then
FontFile:='LiberationSans-Regular.ttf';
FontFileChinese:=ParamStr(2);
if FontFileChinese='' then
With TFontManager.Create do
try
FontFileChinese:=SearchFont('wqy-microhei.ttc',False);
finally
Free;
end;
DoDraw(FontFile,FontFileChinese);
end.
|
