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

This commit is contained in:
PC1\PTyTb
2025-08-14 10:50:33 +03:00
parent 04b5259737
commit 3ac578b6e6
79 changed files with 10256 additions and 1284 deletions
+5
View File
@@ -0,0 +1,5 @@
[uCreateChat.pas]
SaveTime=14.08.2025 10:44:31
FileCount=2
File0=C:\Users\PTyTb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\forms\uCreateChat.pas
File1=C:\Users\PTyTb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\forms\uCreateChat.fmx
+189
View File
@@ -0,0 +1,189 @@
object fCreateChat: TfCreateChat
Left = 0
Top = 0
Caption = #1056#1077#1076#1072#1082#1090#1086#1088' '#1095#1072#1090#1086#1074
ClientHeight = 287
ClientWidth = 810
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
OnCreate = FormCreate
OnShow = FormShow
DesignerMasterStyle = 0
object GroupBox1: TGroupBox
Position.X = 8.000000000000000000
Position.Y = 8.000000000000000000
Size.Width = 305.000000000000000000
Size.Height = 271.000000000000000000
Size.PlatformDefault = False
Text = #1041#1083#1086#1082' '#1089#1086#1086#1073#1097#1077#1085#1080#1103
TabOrder = 1
inline frChatSettings1: TfrColorSettings
Align = Client
Margins.Top = 20.000000000000000000
Size.Width = 305.000000000000000000
Size.Height = 251.000000000000000000
Size.PlatformDefault = False
inherited ccbStyleBorderColor: TColorComboBox
TabOrder = 30
end
inherited Label40: TLabel
TabOrder = 8
end
inherited Label42: TLabel
TabOrder = 35
end
inherited Label44: TLabel
TabOrder = 38
end
inherited Label48: TLabel
TabOrder = 40
end
inherited sbStyleBlockBorderSize: TSpinBox
TabOrder = 37
end
inherited sbStyleBlockPadding: TSpinBox
TabOrder = 41
end
inherited Label1: TLabel
TabOrder = 34
end
inherited ccbBColor: TColorComboBox
TabOrder = 36
end
inherited btnChangeBGColor: TButton
TabOrder = 39
end
end
end
object GroupBox2: TGroupBox
Position.X = 321.000000000000000000
Position.Y = 8.000000000000000000
Size.Width = 240.000000000000000000
Size.Height = 145.000000000000000000
Size.PlatformDefault = False
Text = #1064#1088#1080#1092#1090
TabOrder = 2
inline frFontSettings1: TfrFontSettings
Align = Client
Margins.Top = 20.000000000000000000
Size.Width = 240.000000000000000000
Size.Height = 125.000000000000000000
Size.PlatformDefault = False
inherited ccbFontColor: TColorComboBox
TabOrder = 36
end
inherited Label49: TLabel
TabOrder = 35
end
inherited Label46: TLabel
TabOrder = 39
end
end
end
object GroupBox10: TGroupBox
Position.X = 569.000000000000000000
Position.Y = 8.000000000000000000
Size.Width = 232.000000000000000000
Size.Height = 203.000000000000000000
Size.PlatformDefault = False
Text = #1053#1072#1089#1090#1088#1086#1081#1082#1080
TabOrder = 0
object Label27: TLabel
Position.X = 8.000000000000000000
Position.Y = 22.000000000000000000
Size.Width = 249.000000000000000000
Size.Height = 17.000000000000000000
Size.PlatformDefault = False
TextSettings.Trimming = None
Text = #1052#1072#1082#1089#1080#1084#1072#1083#1100#1085#1086#1077' '#1082#1086#1083#1080#1095#1077#1089#1090#1074#1086' '#1089#1086#1086#1073#1097#1077#1085#1080#1081
TabOrder = 3
end
object Label38: TLabel
Position.X = 8.000000000000000000
Position.Y = 77.000000000000000000
Size.Width = 249.000000000000000000
Size.Height = 17.000000000000000000
Size.PlatformDefault = False
TextSettings.Trimming = None
Text = #1042#1088#1077#1084#1103' '#1086#1090#1086#1073#1088#1072#1078#1077#1085#1080#1103' '#1089#1086#1086#1073#1097#1077#1085#1080#1103
TabOrder = 0
end
object sbMaxMsg: TSpinBox
Touch.InteractiveGestures = [LongTap, DoubleTap]
TabOrder = 5
Cursor = crIBeam
Value = 5.000000000000000000
Position.X = 8.000000000000000000
Position.Y = 47.000000000000000000
end
object sbTimeMsg: TSpinBox
Touch.InteractiveGestures = [LongTap, DoubleTap]
TabOrder = 2
Cursor = crIBeam
Value = 10.000000000000000000
Position.X = 8.000000000000000000
Position.Y = 102.000000000000000000
end
object Label39: TLabel
Position.X = 8.000000000000000000
Position.Y = 132.000000000000000000
Size.Width = 193.000000000000000000
Size.Height = 17.000000000000000000
Size.PlatformDefault = False
TextSettings.Trimming = None
Text = #1055#1086#1088#1090' '#1042#1077#1073' '#1057#1077#1088#1074#1077#1088#1072
TabOrder = 6
end
object cbFreez: TCheckBox
Position.X = 112.000000000000000000
Position.Y = 105.000000000000000000
Size.Width = 112.000000000000000000
Size.Height = 19.000000000000000000
Size.PlatformDefault = False
TabOrder = 38
Text = #1042#1077#1095#1085#1086
end
object sbWebServerPort: TSpinBox
Touch.InteractiveGestures = [LongTap, DoubleTap]
TabOrder = 4
Cursor = crIBeam
Min = 8080.000000000000000000
Max = 65000.000000000000000000
Value = 8085.000000000000000000
Position.X = 8.000000000000000000
Position.Y = 157.000000000000000000
end
end
object edtWebChatTest: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
TabOrder = 5
Position.X = 321.000000000000000000
Position.Y = 161.000000000000000000
Size.Width = 240.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
end
object btnWebChatTest: TButton
Position.X = 321.000000000000000000
Position.Y = 191.000000000000000000
Size.Width = 152.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 3
Text = #1058#1077#1089#1090#1086#1074#1086#1077' '#1089#1086#1086#1073#1097#1077#1085#1080#1077
TextSettings.Trimming = None
OnClick = btnWebChatTestClick
end
object btnCreateWebChat: TButton
Position.X = 704.000000000000000000
Position.Y = 257.000000000000000000
Size.Width = 97.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 4
Text = #1057#1086#1079#1076#1072#1090#1100' '#1095#1072#1090
TextSettings.Trimming = None
OnClick = btnCreateWebChatClick
end
end
+207
View File
@@ -0,0 +1,207 @@
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);
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;
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.