ttw_fmx_v10/uCreateChat.pas

unit uCreateChat;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants, FMX.ListBox, FMX.Colors, FMX.SpinBox,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  fColorSettings, fFontSettings, FMX.Controls.Presentation, FMX.StdCtrls,
  FMX.Edit, FMX.EditBox, StrUtils, uRecords;

type
  TfCreateChat = class(TForm)
    frChatSettings1: TfrColorSettings;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    frFontSettings1: TfrFontSettings;
    GroupBox10: TGroupBox;
    Label27: TLabel;
    Label38: TLabel;
    sbMaxMsg: TSpinBox;
    sbTimeMsg: TSpinBox;
    Label39: TLabel;
    cbFreez: TCheckBox;
    sbWebServerPort: TSpinBox;
    edtWebChatTest: TEdit;
    btnWebChatTest: TButton;
    btnCreateWebChat: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnCreateWebChatClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    function GetColorFromColorPanel(aColor: TAlphaColor): string;
  public
    { Public declarations }
    isEdit: boolean;
    oldPort: integer;
    procedure setRecord(aRec: TOBSChat);
  end;

var
  fCreateChat: TfCreateChat;

implementation

uses uGeneral;

{$R *.fmx}

function TfCreateChat.GetColorFromColorPanel(aColor: TAlphaColor): string;
var
  Color: TAlphaColor;
  r, G, B: Byte;
  A: Real;
  FS: TFormatSettings;
begin
  Color := aColor;
  r := TAlphaColorRec(Color).r;
  G := TAlphaColorRec(Color).G;
  B := TAlphaColorRec(Color).B;
  A := TAlphaColorRec(Color).A / 255; // Ïðåîáðàçóåì àëüôà-êàíàë â äèàïàçîí 0..1

  // Óñòàíàâëèâàåì òî÷êó â êà÷åñòâå äåñÿòè÷íîãî ðàçäåëèòåëÿ
  FS := TFormatSettings.Create;
  FS.DecimalSeparator := '.';

  result := Format('rgba(%d, %d, %d, %.2f)', [r, G, B, A], FS);
end;

procedure TfCreateChat.setRecord(aRec: TOBSChat);
var
  SavedColor: TAlphaColor;
begin
  if TryStrToUInt('$' + aRec.ColorBlock, Cardinal(SavedColor)) then
    fCreateChat.frChatSettings1.cpStyleBlockColor.Color := SavedColor
  else
    fCreateChat.frChatSettings1.cpStyleBlockColor.Color := TAlphaColorRec.Black;
  fCreateChat.frChatSettings1.ccbStyleBorderColor.ItemIndex := aRec.ColorBorder;
  fCreateChat.frChatSettings1.ccbBColor.ItemIndex := aRec.ColorBackground;
  fCreateChat.frChatSettings1.sbStyleBlockBorderSize.Value := aRec.SolidBorder;
  fCreateChat.frChatSettings1.sbStyleBlockPadding.Value := aRec.Paddings;

  fCreateChat.frFontSettings1.ccbFontColor.ItemIndex := aRec.ColorFont;
  fCreateChat.frFontSettings1.sbFontSize.Value := aRec.SizeFont;
  fCreateChat.frFontSettings1.cbFontStyleDefault.ItemIndex := aRec.StyleFont;

  fCreateChat.sbTimeMsg.Value := aRec.TimeMess;
  fCreateChat.sbMaxMsg.Value := aRec.MaxCountMess;
  fCreateChat.sbWebServerPort.Value := aRec.port;
  oldPort := aRec.port;
end;

procedure TfCreateChat.btnCreateWebChatClick(Sender: TObject);
var
  OBSChat: TOBSChat;
begin
  OBSChat.ColorBlock := GetColorFromColorPanel
    (frChatSettings1.cpStyleBlockColor.Color);
  OBSChat.ColorBorder := frChatSettings1.ccbStyleBorderColor.ItemIndex;
  OBSChat.ColorBackground := frChatSettings1.ccbBColor.ItemIndex;
  OBSChat.SolidBorder := round(frChatSettings1.sbStyleBlockBorderSize.Value);
  OBSChat.Paddings := round(frChatSettings1.sbStyleBlockPadding.Value);

  OBSChat.ColorFont := frFontSettings1.ccbFontColor.ItemIndex;
  OBSChat.SizeFont := round(frFontSettings1.sbFontSize.Value);
  OBSChat.StyleFont := frFontSettings1.cbFontStyleDefault.ItemIndex;

  OBSChat.MaxCountMess := round(sbMaxMsg.Value);
  OBSChat.TimeMess := round(sbTimeMsg.Value);
  OBSChat.port := round(sbWebServerPort.Value);

  if isEdit then
    TTW_Bot.frOBS1.EdtChat(OBSChat, oldPort)
  else
    TTW_Bot.frOBS1.AddChat(OBSChat);
  close;
end;

procedure TfCreateChat.FormCreate(Sender: TObject);
  procedure LoadFontList;
  var
    SearchRec: TSearchRec;
    n: integer;
  begin
    if not DirectoryExists(myConst.fontsPath) then
      CreateDir(myConst.fontsPath);

    n := 1;
    if FindFirst(IncludeTrailingPathDelimiter(myConst.fontsPath) + '*.*',
      faArchive, SearchRec) = 0 then
      try
        repeat
          if (SearchRec.Attr and faAnyFile) = SearchRec.Attr then
          begin
            fCreateChat.frFontSettings1.cbFontStyleDefault.Items.Add
              (SearchRec.Name);
            Inc(n);
          end;
        until FindNext(SearchRec) <> 0;
      finally
        System.SysUtils.FindClose(SearchRec);
      end;
  end;

  procedure LoadChatOBSSettings;
  var
    I: integer;
    c: TComponent;
    ColorStr: string;
    SavedColor: TAlphaColor;
  begin
    for I := 0 to frChatSettings1.ComponentCount - 1 do
    begin
      c := frChatSettings1.Components[I];
      if c is TComboBox then
        TComboBox(c).ItemIndex :=
          strtoint(db.ReadSetting(TComboBox(c).Name, '0'))
      else if c is TColorComboBox then
        TColorComboBox(c).ItemIndex :=
          strtoint(db.ReadSetting(TComboBox(c).Name, '147'))
      else if c is TSpinBox then
        TSpinBox(c).text := db.ReadSetting(TSpinBox(c).Name,
          IfThen(TSpinBox(c).Name = 'sbWebServerPort', '8080', '1'))
      else if c is TCheckBox then
        TCheckBox(c).IsChecked := db.ReadSetting(TCheckBox(c).Name, '0') = '1';
    end;

    ColorStr := db.ReadSetting('cpStyleBlockColor', 'FF000000');
    if TryStrToUInt('$' + ColorStr, Cardinal(SavedColor)) then
      frChatSettings1.cpStyleBlockColor.Color := SavedColor
    else
      frChatSettings1.cpStyleBlockColor.Color := TAlphaColorRec.Black;
  end;

begin
  isEdit := false;
  LoadChatOBSSettings;
  LoadFontList;

end;

procedure TfCreateChat.FormShow(Sender: TObject);
begin
  if isEdit then
    btnCreateWebChat.text := 'Èçìåíèòü ÷àò'
  else
    btnCreateWebChat.text := 'Ñîçäàòü ÷àò';
end;

end.