1 files changed, 116 insertions, 0 deletions
diff --git a/packages/fcl-image/examples/textout.pp b/packages/fcl-image/examples/textout.pp
new file mode 100644
index 0000000000..712f83b4e6
--- /dev/null
+++ b/packages/fcl-image/examples/textout.pp
@@ -0,0 +1,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.