{*********************************************}
{  TeeChart Charting Library for FireMonkey   }
{  Copyright (c) 2012-2020 by Steema Software }
{  All Rights Reserved                        }
{*********************************************}
unit FMXTee.Editor.Font;
{$I TeeDefs.inc}

interface

uses
  SysUtils, Types, System.UITypes, Classes, Variants, FMX.Types, FMX.Controls,
  {$IFNDEF UPTOXE3}
  FMX.StdCtrls,
  {$ENDIF}
  FMX.Forms, FMX.Dialogs, FMXTee.Canvas, FMX.Colors, FMX.Edit, FMX.ListBox,
  FMX.TabControl;

type
  TFontEditor = class(TForm)
    BColor: TComboColorBox;
    CBBold: TCheckBox;
    CBItalic: TCheckBox;
    CBFamily: TComboBox;
    CBUnderline: TCheckBox;
    CBStrikeOut: TCheckBox;
    Label1: TLabel;
    TBSize: TTrackBar;
    LSize: TLabel;
    TabControl1: TTabControl;
    TabFont: TTabItem;
    TabPattern: TTabItem;
    TabShadow: TTabItem;
    TabEmboss: TTabItem;
    TabOutline: TTabItem;
    procedure CBBoldChange(Sender: TObject);
    procedure BColorChange(Sender: TObject);
    procedure CBItalicChange(Sender: TObject);
    procedure CBUnderlineChange(Sender: TObject);
    procedure TBSizeChange(Sender: TObject);
    procedure CBStrikeOutChange(Sender: TObject);
    procedure CBFamilyChange(Sender: TObject);
    procedure TabControl1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    IFont : TTeeFont;

    ICreating : Boolean;

    FShadowEditor,
    FEmbossEditor,
    FOutlineEditor,
    FBrushEditor : TCommonCustomForm;

    procedure AddFamily;

  public
    { Public declarations }
    class function CreateEditor(const AOwner: TComponent; const AFont: TTeeFont):TForm;
    class function Edit(const AOwner: TComponent; const AFont: TTeeFont): Boolean;
    class function Embedd(const AOwner:TComponent; const AFont:TTeeFont; const AParent:TFmxObject):TFontEditor;
    class function Fonts:TStringList;
    procedure RefreshFont(const AFont: TTeeFont);
  end;

implementation

uses
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF}
  {$IFDEF MACOS}
  {$IFNDEF IOS}
  Macapi.Foundation, Macapi.AppKit,
  {$ENDIF}
  {$ENDIF}
  System.Math, FMXTee.Editor.Stroke, FMXTee.Editor.Gradient,
  FMXTee.Editor.Shadow, FMXTee.Editor.Brush;

{$R *.fmx}

procedure TFontEditor.CBFamilyChange(Sender: TObject);
begin
  if not ICreating then
     IFont.Family:=CBFamily.Selected.Text;
end;

procedure TFontEditor.CBBoldChange(Sender: TObject);
begin
  if not ICreating then
  if CBBold.IsChecked then
     IFont.Style:=IFont.Style + [TFontStyle.fsBold]
  else
     IFont.Style:=IFont.Style - [TFontStyle.fsBold];
end;

procedure TFontEditor.CBItalicChange(Sender: TObject);
begin
  if not ICreating then
  if CBItalic.IsChecked then
     IFont.Style:=IFont.Style + [TFontStyle.fsItalic]
  else
     IFont.Style:=IFont.Style - [TFontStyle.fsItalic];
end;

procedure TFontEditor.CBStrikeOutChange(Sender: TObject);
begin
  if not ICreating then
  if CBStrikeOut.IsChecked then
     IFont.Style:=IFont.Style + [TFontStyle.fsStrikeout]
  else
     IFont.Style:=IFont.Style - [TFontStyle.fsStrikeout];
end;

procedure TFontEditor.CBUnderlineChange(Sender: TObject);
begin
  if not ICreating then
  if CBUnderline.IsChecked then
     IFont.Style:=IFont.Style + [TFontStyle.fsUnderline]
  else
     IFont.Style:=IFont.Style - [TFontStyle.fsUnderline];
end;

procedure TFontEditor.BColorChange(Sender: TObject);
begin
  if not ICreating then
     IFont.Color:=BColor.Color;
end;

class function TFontEditor.CreateEditor(const AOwner: TComponent;
  const AFont: TTeeFont): TForm;
begin
  result:=TFontEditor.Create(AOwner);
  TFontEditor(result).RefreshFont(AFont);
end;

{$IFDEF MSWINDOWS}
function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
var
  Temp : String;
  CBFamily : TStringList;
begin
  Temp := LogFont.lfFaceName;

  CBFamily:=TStringList(Data);
  if CBFamily.IndexOf(Temp)=-1 then
     CBFamily.Add(Temp);

  Result := 1;
end;
{$ENDIF}

function InstalledFonts:TStringList;
{$IFDEF MSWINDOWS}
var DC : HDC;
    LFont : TLogFont;
{$ELSE}
{$IFDEF MACOS}
{$IFNDEF IOS}
// http://delphiscience.wordpress.com/2012/11/20/getting-system-fonts-list-in-firemonkey-the-new-tplatformextensions-class/
var
  fManager: NsFontManager;
  list:NSArray;
  lItem:NSString;
  t: Integer;
{$ENDIF}
{$ENDIF}
{$ENDIF}
begin
  result:=TStringList.Create;

  {$IFDEF MSWINDOWS}
  DC := GetDC(0);
  try
    FillChar(LFont, sizeof(LFont), 0);
    LFont.lfCharset := DEFAULT_CHARSET;

    EnumFontFamiliesEx(DC, LFont, @EnumFontsProc, NativeInt(result), 0);
  finally
    ReleaseDC(0, DC);
  end;
  {$ELSE}

  {$IFDEF MACOS}

  {$IFDEF IOS}
  // ??
  {$ELSE}

  fManager := TNsFontManager.Wrap(TNsFontManager.OCClass.sharedFontManager);
  List := fManager.availableFontFamilies;

  if List <> nil then
     for t := 0 to List.Count-1 do
     begin
       lItem := TNSString.Wrap(List.objectAtIndex(t));
       result.Add(String(lItem.UTF8String));
     end;

  {$ENDIF}

  {$ELSE}

  {$IFDEF ANDROID}
  result.Add('Droid Sans');
  result.Add('Droid Serif');
  result.Add('Droid Sans Mono');
  result.Add('Roboto');
  {$ELSE}

  {$ENDIF}

  {$ENDIF}
  {$ENDIF}

  result.Sorted:=True;
end;

class function TFontEditor.Fonts:TStringList;
begin
  result:=InstalledFonts;
end;

type
  TListAccess=class(TComboListBox);

procedure TFontEditor.AddFamily;

  {$IFNDEF D18}
  procedure AddFont(const AFamily:String);
  var i : TListBoxItem;
  begin
    i:=TListBoxItem.Create(Self);
    i.Text:=AFamily;
    CBFamily.AddObject(i);
  end;
  {$ENDIF}

var tmp : TStringList;
    {$IFNDEF D18}
    t : Integer;
    {$ENDIF}
begin
  if CBFamily.Count=0 then
  begin
    tmp:=InstalledFonts;
    try

      {$IFDEF D18}
      CBFamily.Items:=tmp;
      {$ELSE}
      CBFamily.BeginUpdate;
      try
        for t := 0 to tmp.Count-1 do
            AddFont(tmp[t]);
      finally
        CBFamily.EndUpdate;
      end;
      {$ENDIF}

    finally
      tmp.Free;
    end;

    if Assigned(IFont) then
    begin
      {$IFDEF D18}
      CBFamily.Items.Add(IFont.Family);
      {$ELSE}
      AddFont(IFont.Family);
      {$ENDIF}
    end;
  end;

  if Assigned(IFont) then
     CBFamily.ItemIndex:=CBFamily.ListBox.Items.IndexOf(IFont.Family);
end;

procedure TFontEditor.RefreshFont(const AFont:TTeeFont);
begin
  ICreating:=True;

  IFont:=AFont;

  if Assigned(IFont) then
  begin
    BColor.Color:=IFont.Color;

    TBSize.Value:=IFont.Size;
    LSize.Text:=FormatFloat('#.##',IFont.Size);

    CBBold.IsChecked:=TFontStyle.fsBold in IFont.Style;
    CBItalic.IsChecked:=TFontStyle.fsItalic in IFont.Style;
    CBUnderline.IsChecked:=TFontStyle.fsUnderline in IFont.Style;
    CBStrikeOut.IsChecked:=TFontStyle.fsStrikeout in IFont.Style;
  end;

  AddFamily;

  ICreating:=False;
end;

procedure TFontEditor.TabControl1Change(Sender: TObject);
begin
  if (TabControl1.ActiveTab=TabPattern) and (not Assigned(FBrushEditor)) then
     FBrushEditor:=TBrushEditor.InsertForm(IFont.Brush,TabPattern)
  else
  if (TabControl1.ActiveTab=TabShadow) and (not Assigned(FShadowEditor)) then
     FShadowEditor:=TShadowEditor.InsertForm(IFont.Shadow,TabShadow)
  else
  if (TabControl1.ActiveTab=TabEmboss) and (not Assigned(FEmbossEditor)) then
     FEmbossEditor:=TShadowEditor.InsertForm(IFont.Emboss,TabEmboss)
  else
  if (TabControl1.ActiveTab=TabOutline) and (not Assigned(FOutlineEditor)) then
     FOutlineEditor:=TStrokeEditor.InsertForm(IFont.OutLine,TabOutline)
end;

procedure TFontEditor.TBSizeChange(Sender: TObject);
begin
  if not ICreating then
  begin
    IFont.Size:=Max(1,TBSize.Value);
    LSize.Text:=FormatFloat('#.##',IFont.Size);
  end;
end;

class function TFontEditor.Edit(const AOwner: TComponent; const AFont: TTeeFont): Boolean;
var tmp : TFontEditor;
begin
  tmp:=TFontEditor(TFontEditor.CreateEditor(AOwner,AFont));
  try
    {$IFDEF ANDROID}
    tmp.ShowModal(procedure(Value:TModalResult)
    begin
      //result:=Value=mrOk;
    end);

    result:=False;
    {$ELSE}
    result:=tmp.ShowModal=mrOk;
    {$ENDIF}
  finally
    tmp.Free;
  end;
end;

class function TFontEditor.Embedd(const AOwner: TComponent; const AFont:TTeeFont;
                                  const AParent: TFmxObject): TFontEditor;
begin
  result:=TFontEditor(EmbeddForm(TFontEditor.CreateEditor(AOwner,AFont),AParent));
end;

procedure TFontEditor.FormCreate(Sender: TObject);
begin
  TabControl1.ActiveTab:=TabFont;
end;

end.
