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, System.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); procedure btnWebChatTestClick(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.btnWebChatTestClick(Sender: TObject); var j:integer; aRecord: TTwitchChatMessage; begin aRecord.Username:='Test'; aRecord.DisplayName:='Test'; aRecord.Message:=edtWebChatTest.Text; for j := 0 to TTW_Bot.frOBS1.ChatWebServers.Count - 1 do begin if TTW_Bot.frOBS1.ChatWebServers[j].port = round(sbWebServerPort.Value) then begin TTW_Bot.frOBS1.MsgToWebServer(aRecord); end; end; end; procedure TfCreateChat.FormCreate(Sender: TObject); procedure LoadFontList; var SearchRec: TSearchRec; begin if not DirectoryExists(myConst.fontsPath) then CreateDir(myConst.fontsPath); 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); 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.