реструктуризация файлов, добавление вебчатов

2025-08-14 10:50:33 +03:00
parent 04b5259737
commit 3ac578b6e6
79 changed files with 10256 additions and 1284 deletions
@@ -0,0 +1,191 @@
+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.