unit FMXTee.Editor.Font;

interface

uses
  SysUtils, Types, System.UITypes, Classes, Variants, FMX.Types, FMX.Controls,
  FMX.Forms, FMX.Dialogs, FMXTee.Canvas, FMX.Colors, FMX.Edit, FMX.ListBox;

type
  TFontEditor = class(TForm)
    BColor: TComboColorBox;
    CBBold: TCheckBox;
    Button1: TButton;
    Button2: TButton;
    CBItalic: TCheckBox;
    CBFamily: TComboBox;
    CBUnderline: TCheckBox;
    CBStrikeOut: TCheckBox;
    Label1: TLabel;
    TBSize: TTrackBar;
    LSize: TLabel;
    BShadow: TButton;
    procedure CBBoldChange(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure BColorChange(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure CBItalicChange(Sender: TObject);
    procedure CBUnderlineChange(Sender: TObject);
    procedure TBSizeChange(Sender: TObject);
    procedure CBStrikeOutChange(Sender: TObject);
    procedure BShadowClick(Sender: TObject);
    procedure CBFamilyChange(Sender: TObject);
  private
    { Private declarations }
    Font : TTeeFont;

    procedure AddFamily;
    {$IFDEF MSWINDOWS}
    procedure GetFonts;
    {$ENDIF}
  public
    { Public declarations }
    class function CreateEditor(AOwner: TComponent; AFont: TTeeFont):TForm;
    class function Edit(AOwner: TComponent; AFont: TTeeFont): Boolean;
    class function Embedd(AOwner:TComponent; AFont:TTeeFont; AParent:TFmxObject):TFontEditor;
    procedure RefreshFont(AFont: TTeeFont);
  end;

implementation

uses
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF}
  System.Math, FMXTee.Editor.Stroke, FMXTee.Editor.Gradient,
  FMXTee.Editor.Shadow;

{$R *.fmx}

procedure TFontEditor.Button1Click(Sender: TObject);
begin
  TStrokeEditor.Edit(Self, Font.OutLine);
end;

procedure TFontEditor.Button2Click(Sender: TObject);
begin
  TGradientEditor.Edit(Self, Font.Gradient);
end;

procedure TFontEditor.CBFamilyChange(Sender: TObject);
begin
  Font.Family:=CBFamily.Selected.Text;
end;

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

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

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

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

procedure TFontEditor.BColorChange(Sender: TObject);
begin
  Font.Color:=BColor.Color;
end;

procedure TFontEditor.BShadowClick(Sender: TObject);
begin
  TShadowEditor.Edit(Self,Font.Shadow);
end;

class function TFontEditor.CreateEditor(AOwner: TComponent;
  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;

procedure TFontEditor.GetFonts;
var DC : HDC;
    LFont : TLogFont;
    tmp : TStringList;
    t   : Integer;
    i   : TListBoxItem;
begin
  DC := GetDC(0);
  try
    FillChar(LFont, sizeof(LFont), 0);
    LFont.lfCharset := DEFAULT_CHARSET;

    tmp:=TStringList.Create;
    try
      EnumFontFamiliesEx(DC, LFont, @EnumFontsProc, NativeInt(tmp), 0);

      tmp.Sorted:=True;

      for t := 0 to tmp.Count-1 do
      begin
        i:=TListBoxItem.Create(CBFamily.Owner);
        i.Text:=tmp[t];
        CBFamily.AddObject(i);
      end;

    finally
      tmp.Free;
    end;
  finally
    ReleaseDC(0, DC);
  end;
end;
{$ENDIF}

type
  TListAccess=class(TComboListBox);

procedure TFontEditor.AddFamily;
{$IFNDEF MSWINDOWS}
var i : TListBoxItem;
{$ENDIF}
begin
  if CBFamily.Count=0 then
  begin
    {$IFDEF MSWINDOWS}
    GetFonts;
    {$ELSE}
    if Assigned(Font) then
    begin
      i:=TListBoxItem.Create(Self);
      i.Text:=Font.Family;
      CBFamily.AddObject(i);
    end;
    {$ENDIF}
  end;

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

procedure TFontEditor.RefreshFont(AFont:TTeeFont);
begin
  Font:=AFont;

  if Assigned(Font) then
  begin
    BColor.Color:=Font.Color;
    TBSize.Value:=Font.Size;

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

  AddFamily;
end;

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

class function TFontEditor.Edit(AOwner: TComponent; AFont: TTeeFont): Boolean;
begin
  with TFontEditor(TFontEditor.CreateEditor(AOwner,AFont)) do
  try
    result:=ShowModal=mrOk;
  finally
    Free;
  end;
end;

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

end.
