отремонтировал и анимировал смайлики для вебчатов

This commit is contained in:
PC1\PTyTb
2025-08-14 19:58:19 +03:00
parent 3ac578b6e6
commit bad576dd4d
10 changed files with 217 additions and 567 deletions
+62 -1
View File
@@ -1041,7 +1041,11 @@ var
EmoteObj: TJSONObject; EmoteObj: TJSONObject;
ImagesObj: TJSONObject; ImagesObj: TJSONObject;
Emote: TEmotes; Emote: TEmotes;
I: Integer; I, J: Integer;
chosenFormat, chosenTheme, chosenScale: string;
foundAnimated, foundNonStatic, foundDark: Boolean;
scaleVal, maxScale: Double;
s: string;
begin begin
if JSONString = '' then Exit; if JSONString = '' then Exit;
@@ -1069,11 +1073,68 @@ begin
Emote.format := GetStringArray(EmoteObj, 'format'); Emote.format := GetStringArray(EmoteObj, 'format');
Emote.scale := GetStringArray(EmoteObj, 'scale'); Emote.scale := GetStringArray(EmoteObj, 'scale');
Emote.theme_mode := GetStringArray(EmoteObj, 'theme_mode'); Emote.theme_mode := GetStringArray(EmoteObj, 'theme_mode');
// Âûáîð ôîðìàòà (format)
foundAnimated := False;
foundNonStatic := False;
chosenFormat := 'static'; // çíà÷åíèå ïî óìîë÷àíèþ
// Ïðîâåðêà íàëè÷èÿ "animated"
for s in Emote.format do
if s = 'animated' then
begin
chosenFormat := 'animated';
foundAnimated := True;
Break;
end;
// Åñëè íå íàéäåí "animated", èùåì ëþáîé íå-"static"
if not foundAnimated then
for s in Emote.format do
if s <> 'static' then
begin
chosenFormat := s;
foundNonStatic := True;
Break;
end;
// Âûáîð òåìû (theme_mode)
foundDark := False;
for s in Emote.theme_mode do
if s = 'dark' then
begin
chosenTheme := 'dark';
foundDark := True;
Break;
end;
if not foundDark then
chosenTheme := 'light';
// Âûáîð ìàñøòàáà (scale)
maxScale := 0;
for s in Emote.scale do
begin
if TryStrToFloat(s, scaleVal, TFormatSettings.Invariant) then
if scaleVal > maxScale then
maxScale := scaleVal;
end;
// Åñëè ìàñøòàáû îòñóòñòâóþò, èñïîëüçóåì 1.0
if maxScale = 0 then maxScale := 1.0;
chosenScale := Format('%.1f', [maxScale], TFormatSettings.Invariant);
// Ôîðìèðîâàíèå ññûëêè
Emote.topImage := 'https://static-cdn.jtvnw.net/emoticons/v2/' +
Emote.id + '/' +
chosenFormat + '/' +
chosenTheme + '/' +
chosenScale;
EmotesList.Add(Emote); EmotesList.Add(Emote);
end; end;
finally finally
RootObj.Free; RootObj.Free;
end; end;
end; end;
procedure TTTW_API.GetChannelEmotes(var ce: TList<TEmotes>); procedure TTTW_API.GetChannelEmotes(var ce: TList<TEmotes>);
-5
View File
@@ -1,5 +0,0 @@
[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
@@ -1,189 +0,0 @@
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
@@ -1,207 +0,0 @@
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.
+6 -5
View File
@@ -25,7 +25,7 @@ object fCreateChat: TfCreateChat
Size.Height = 251.000000000000000000 Size.Height = 251.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
inherited ccbStyleBorderColor: TColorComboBox inherited ccbStyleBorderColor: TColorComboBox
TabOrder = 31 TabOrder = 30
end end
inherited Label40: TLabel inherited Label40: TLabel
TabOrder = 8 TabOrder = 8
@@ -42,6 +42,9 @@ object fCreateChat: TfCreateChat
inherited sbStyleBlockBorderSize: TSpinBox inherited sbStyleBlockBorderSize: TSpinBox
TabOrder = 37 TabOrder = 37
end end
inherited sbStyleBlockPadding: TSpinBox
TabOrder = 41
end
inherited Label1: TLabel inherited Label1: TLabel
TabOrder = 34 TabOrder = 34
end end
@@ -67,9 +70,6 @@ object fCreateChat: TfCreateChat
Size.Width = 240.000000000000000000 Size.Width = 240.000000000000000000
Size.Height = 125.000000000000000000 Size.Height = 125.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
inherited Label41: TLabel
TabOrder = 6
end
inherited ccbFontColor: TColorComboBox inherited ccbFontColor: TColorComboBox
TabOrder = 36 TabOrder = 36
end end
@@ -141,7 +141,7 @@ object fCreateChat: TfCreateChat
Size.Width = 112.000000000000000000 Size.Width = 112.000000000000000000
Size.Height = 19.000000000000000000 Size.Height = 19.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
TabOrder = 37 TabOrder = 38
Text = #1042#1077#1095#1085#1086 Text = #1042#1077#1095#1085#1086
end end
object sbWebServerPort: TSpinBox object sbWebServerPort: TSpinBox
@@ -173,6 +173,7 @@ object fCreateChat: TfCreateChat
TabOrder = 3 TabOrder = 3
Text = #1058#1077#1089#1090#1086#1074#1086#1077' '#1089#1086#1086#1073#1097#1077#1085#1080#1077 Text = #1058#1077#1089#1090#1086#1074#1086#1077' '#1089#1086#1086#1073#1097#1077#1085#1080#1077
TextSettings.Trimming = None TextSettings.Trimming = None
OnClick = btnWebChatTestClick
end end
object btnCreateWebChat: TButton object btnCreateWebChat: TButton
Position.X = 704.000000000000000000 Position.X = 704.000000000000000000
+16
View File
@@ -29,6 +29,7 @@ type
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure btnCreateWebChatClick(Sender: TObject); procedure btnCreateWebChatClick(Sender: TObject);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
procedure btnWebChatTestClick(Sender: TObject);
private private
{ Private declarations } { Private declarations }
function GetColorFromColorPanel(aColor: TAlphaColor): string; function GetColorFromColorPanel(aColor: TAlphaColor): string;
@@ -117,6 +118,21 @@ begin
close; close;
end; 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 TfCreateChat.FormCreate(Sender: TObject);
procedure LoadFontList; procedure LoadFontList;
var var
+3 -6
View File
@@ -88,6 +88,7 @@ object TTW_Bot: TTTW_Bot
inherited btnDAGetCode: TButton inherited btnDAGetCode: TButton
Images = ImageList1 Images = ImageList1
ImageIndex = 10 ImageIndex = 10
TabOrder = 38
end end
inherited edtDAClientID: TEdit inherited edtDAClientID: TEdit
TabOrder = 33 TabOrder = 33
@@ -102,23 +103,19 @@ object TTW_Bot: TTTW_Bot
TabOrder = 35 TabOrder = 35
end end
inherited edtDARedirectURL: TEdit inherited edtDARedirectURL: TEdit
TabOrder = 42 TabOrder = 43
end end
inherited edtDACode: TEdit inherited edtDACode: TEdit
TabOrder = 36 TabOrder = 36
end end
inherited Label66: TLabel
TabOrder = 39
end
inherited btnDAStart: TButton inherited btnDAStart: TButton
Images = ImageList1 Images = ImageList1
ImageIndex = 18 ImageIndex = 18
TabOrder = 41
OnClick = frSettings1btnDAStartClick OnClick = frSettings1btnDAStartClick
end end
inherited btnGetDADef: TButton inherited btnGetDADef: TButton
Images = ImageList1 Images = ImageList1
TabOrder = 43 TabOrder = 44
end end
end end
inherited btnOpenRomaning: TButton inherited btnOpenRomaning: TButton
+40 -34
View File
@@ -12,7 +12,7 @@ uses
System.Generics.Collections, utts, uGigaChat, uChatAPI, System.Generics.Collections, utts, uGigaChat, uChatAPI,
System.IOUtils, fCommands, uDataBase, FMX.Edit, FMX.Colors, FMX.SpinBox, System.IOUtils, fCommands, uDataBase, FMX.Edit, FMX.Colors, FMX.SpinBox,
windows, System.Skia, FMX.Skia, uCreateChat, uCreateNotify, fOBS, fTTS, windows, System.Skia, FMX.Skia, uCreateChat, uCreateNotify, fOBS, fTTS,
fPlayerWeb, uWebServerKandinsky; fPlayerWeb, uWebServerKandinsky, FMX.Memo.Types, FMX.ScrollBox, FMX.Memo;
type type
TTTW_Bot = class(TForm) TTTW_Bot = class(TForm)
@@ -211,27 +211,27 @@ begin
raise Exception.Create('Не удалось получить Room ID'); raise Exception.Create('Не удалось получить Room ID');
// Загрузка эмодзи и бейджей // Загрузка эмодзи и бейджей
{ try try
fChatFrame.ChatBadges.Clear; frOBS1.ChatBadges.Clear;
ttw_API.getCustomChatBadges(fChatFrame.ChatBadges); ttw_API.getCustomChatBadges(frOBS1.ChatBadges);
ttw_API.getGlobalChatBadges(fChatFrame.ChatBadges); ttw_API.getGlobalChatBadges(frOBS1.ChatBadges);
fChatFrame.ChatEmotes.Clear; frOBS1.ChatEmotes.Clear;
ttw_API.GetChannelEmotes(fChatFrame.ChatEmotes); ttw_API.GetChannelEmotes(frOBS1.ChatEmotes);
ttw_API.GetGlobalEmotes(fChatFrame.ChatEmotes); ttw_API.GetGlobalEmotes(frOBS1.ChatEmotes);
fChatFrame.BTTV.getGlobal; frOBS1.BTTV.getGlobal;
fChatFrame.BTTV.getCustom(rid); frOBS1.BTTV.getCustom(rid);
fChatFrame.m7tv.getGlobal; frOBS1.m7tv.getGlobal;
fChatFrame.m7tv.getCustom(rid); frOBS1.m7tv.getCustom(rid);
except except
on E: Exception do on E: Exception do
begin begin
fLog.toLog(2, 'uGeneral', 'ConnectProcedure.Emotes', E.Message); toLog('uGeneral', 'ConnectProcedure.Emotes', E.Message, 2);
raise; raise;
end; end;
end; } end;
// Инициализация EventSub // Инициализация EventSub
@@ -396,7 +396,7 @@ begin
cbTheme.ItemIndex := cbTheme.Items.IndexOf(cbTheme.text); cbTheme.ItemIndex := cbTheme.Items.IndexOf(cbTheme.text);
if cbTheme.ItemIndex <> -1 then if cbTheme.ItemIndex <> -1 then
TStyleManager.SetStyleFromFile(myConst.stlPath + cbTheme.text); TStyleManager.SetStyleFromFile(myConst.stlPath + cbTheme.text);
db.WriteSetting('cbTheme', inttostr(cbTheme.ItemIndex)); db.WriteSetting('cbTheme', inttostr(cbTheme.ItemIndex));
end; end;
procedure TTTW_Bot.FormCreate(Sender: TObject); procedure TTTW_Bot.FormCreate(Sender: TObject);
@@ -493,15 +493,20 @@ end;
procedure TTTW_Bot.FormDestroy(Sender: TObject); procedure TTTW_Bot.FormDestroy(Sender: TObject);
begin begin
frOBS1.ChatBadges.Free;
frOBS1.ChatEmotes.Free;
frOBS1.ChatWebServers.Free;
DisconnectProcedure; DisconnectProcedure;
if Assigned(ttw_IRS) then if Assigned(ttw_IRS) then
ttw_IRS.Free; ttw_IRS.Free;
if Assigned(ttw_ES) then if Assigned(ttw_ES) then
ttw_ES.free; ttw_ES.Free;
if Assigned(Kandinsky) then if Assigned(Kandinsky) then
Kandinsky.Free; Kandinsky.Free;
if Assigned(ttw_API ) then if Assigned(ttw_API) then
ttw_API.Free; ttw_API.Free;
frSettings1.Destroy; frSettings1.Destroy;
FreeAndNil(db); FreeAndNil(db);
FreeAndNil(frAutoActions1.FTimerList); FreeAndNil(frAutoActions1.FTimerList);
@@ -710,11 +715,11 @@ begin
responseText := ProcessCommand(firstWord); responseText := ProcessCommand(firstWord);
decodeResponseSendToTTW(responseText, commandText, aRecord.DisplayName); decodeResponseSendToTTW(responseText, commandText, aRecord.DisplayName);
end; end;
TThread.Queue(nil, TThread.Queue(nil,
procedure procedure
begin begin
frOBS1.MsgToWebServer(aRecord); frOBS1.MsgToWebServer(aRecord);
end); end);
PlayNotifySound((aRecord.Moder = 1), (aRecord.Vip = 1), PlayNotifySound((aRecord.Moder = 1), (aRecord.Vip = 1),
(aRecord.Subscriber = 1)); (aRecord.Subscriber = 1));
end; end;
@@ -1041,20 +1046,21 @@ procedure TTTW_Bot.ReadDB;
// Загрузка интеграций с ОБС // Загрузка интеграций с ОБС
procedure LoadOBSGrids; procedure LoadOBSGrids;
var i:integer; var
I: Integer;
begin begin
db.LoadRecordArray<TOBSChat>('listChats', frOBS1.listChats); db.LoadRecordArray<TOBSChat>('listChats', frOBS1.listChats);
frOBS1.BTTV := TBTTV.Create; frOBS1.BTTV := TBTTV.Create;
frOBS1.m7tv := t7tv.Create; frOBS1.m7tv := t7tv.Create;
frOBS1.ChatBadges := Tlist<TChatBadge>.Create; frOBS1.ChatBadges := TList<TChatBadge>.Create;
frOBS1.ChatEmotes := Tlist<TEmotes>.Create; frOBS1.ChatEmotes := TList<TEmotes>.Create;
frOBS1.ChatWebServers := Tlist<TChatWebServers>.Create; frOBS1.ChatWebServers := TList<TChatWebServers>.Create;
for I := 0 to High(frOBS1.listChats) do for I := 0 to High(frOBS1.listChats) do
begin begin
frOBS1.CreateWebChat(frOBS1.listChats[i]); frOBS1.CreateWebChat(frOBS1.listChats[I]);
end; end;
db.LoadRecordArray<TOBSNotify>('listNotify', frOBS1.listNotify); db.LoadRecordArray<TOBSNotify>('listNotify', frOBS1.listNotify);
db.LoadRecordArray<TOBSKandinsky>('listKandinsky', frOBS1.listKandinsky); db.LoadRecordArray<TOBSKandinsky>('listKandinsky', frOBS1.listKandinsky);
+89 -120
View File
@@ -8,7 +8,7 @@ uses
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls, FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
System.Rtti, FMX.Grid.Style, FMX.Grid, FMX.ScrollBox, FMX.Edit, FMX.Colors, System.Rtti, FMX.Grid.Style, FMX.Grid, FMX.ScrollBox, FMX.Edit, FMX.Colors,
FMX.ListBox, FMX.EditBox, FMX.SpinBox, FMX.Controls.Presentation, uRecords, FMX.ListBox, FMX.EditBox, FMX.SpinBox, FMX.Controls.Presentation, uRecords,
System.Generics.Defaults, fFontSettings; System.Generics.Defaults, fFontSettings, System.Character;
type type
TChatWebServers = record TChatWebServers = record
@@ -117,125 +117,6 @@ begin
end; end;
end; end;
function TfrOBS.FindEmoteByID(const ID: string): TEmotes;
var
i: integer;
begin
result.ID := '';
if not Assigned(ChatEmotes) then
exit;
for i := 0 to ChatEmotes.Count - 1 do
if ChatEmotes[i].ID = ID then
begin
result := ChatEmotes[i];
Break;
end;
end;
function TfrOBS.ReplaceEmotesInMessage(const MessageText,
EmotesString: string): string;
type
TEmotePosition = record
StartPos: integer;
EndPos: integer;
ImageURL: string;
end;
var
Positions: Tlist<TEmotePosition>;
i, ColonPos: integer;
Parts, EmoteData, Ranges: tstringlist;
EmoteID, RangeStr: string;
StartPos, EndPos: integer;
Emote: TEmotes;
begin
result := MessageText;
if EmotesString.IsEmpty then
exit;
Parts := tstringlist.Create;
EmoteData := tstringlist.Create;
Ranges := tstringlist.Create;
Positions := Tlist<TEmotePosition>.Create;
try
Parts.Delimiter := '/';
Parts.StrictDelimiter := True;
Parts.DelimitedText := EmotesString;
for i := 0 to Parts.Count - 1 do
begin
ColonPos := Pos(':', Parts[i]);
if ColonPos = 0 then
Continue;
EmoteID := Copy(Parts[i], 1, ColonPos - 1);
RangeStr := Copy(Parts[i], ColonPos + 1, MaxInt);
Ranges.Clear;
Ranges.Delimiter := ',';
Ranges.StrictDelimiter := True;
Ranges.DelimitedText := RangeStr;
Emote := FindEmoteByID(EmoteID);
if Emote.ID = '' then
Continue;
for var j := 0 to Ranges.Count - 1 do
begin
EmoteData.Clear;
EmoteData.Delimiter := '-';
EmoteData.StrictDelimiter := True;
EmoteData.DelimitedText := Ranges[j];
if EmoteData.Count <> 2 then
Continue;
if TryStrToInt(EmoteData[0], StartPos) and
TryStrToInt(EmoteData[1], EndPos) then
begin
var
EmotePosition: TEmotePosition;
EmotePosition.StartPos := StartPos;
EmotePosition.EndPos := EndPos;
EmotePosition.ImageURL := Emote.images.Url1x;
Positions.Add(EmotePosition);
end;
end;
end;
Positions.Sort(TComparer<TEmotePosition>.Construct(
function(const Left, Right: TEmotePosition): integer
begin
result := Right.StartPos - Left.StartPos;
end));
var
SB := TStringBuilder.Create(MessageText);
try
for var Pos in Positions do
begin
if (Pos.StartPos < 0) or (Pos.EndPos >= SB.Length) or
(Pos.StartPos > Pos.EndPos) then
Continue;
var
Replacement := Format('<img src="%s" width="18" height="18">',
[Pos.ImageURL]);
SB.Remove(Pos.StartPos, Pos.EndPos - Pos.StartPos + 1);
SB.Insert(Pos.StartPos, Replacement);
end;
result := SB.ToString;
finally
SB.Free;
end;
finally
Parts.Free;
EmoteData.Free;
Ranges.Free;
Positions.Free;
end;
end;
function TfrOBS.GetBadgesHTML(Badges: string): string; function TfrOBS.GetBadgesHTML(Badges: string): string;
var var
@@ -320,6 +201,78 @@ begin
end; end;
end; end;
function TfrOBS.ReplaceEmotesInMessage(const MessageText, EmotesString: string): string;
var
ProcessedEmotes: TDictionary<string, string>;
Parts: TStringList;
i, ColonPos: Integer;
EmoteID: string;
Emote: TEmotes;
ResultText: string;
begin
Result := MessageText;
if EmotesString.Trim = '' then
Exit;
// Èñïîëüçóåì ñëîâàðü äëÿ îòñëåæèâàíèÿ óæå îáðàáîòàííûõ ýìîäçè
ProcessedEmotes := TDictionary<string, string>.Create;
Parts := TStringList.Create;
try
// Ðàçäåëÿåì îáùóþ ñòðîêó ñìàéëîâ ïî '/'
Parts.StrictDelimiter := True;
Parts.Delimiter := '/';
Parts.DelimitedText := EmotesString;
ResultText := MessageText;
// Îáðàáàòûâàåì êàæäóþ ÷àñòü
for i := 0 to Parts.Count - 1 do
begin
ColonPos := Pos(':', Parts[i]);
if ColonPos = 0 then
Continue;
// Èçâëåêàåì ID ñìàéëà
EmoteID := Copy(Parts[i], 1, ColonPos - 1);
// Ïðîïóñêàåì åñëè óæå îáðàáàòûâàëè ýòîò ýìîäçè
if ProcessedEmotes.ContainsKey(EmoteID) then
Continue;
// Ïîëó÷àåì äàííûå ñìàéëà
Emote := FindEmoteByID(EmoteID);
if Emote.ID = '' then
Continue;
var imgUrl: string;
if Emote.topImage <> '' then
imgUrl := Emote.topImage
else if Emote.images.Url4x <> '' then
imgUrl := Emote.images.Url4x
else
Continue; // Ïðîïóñêàåì åñëè íåò URL
// Çàìåíÿåì âñå âõîæäåíèÿ èìåíè ýìîäçè
ResultText := StringReplace(
ResultText,
Emote.name,
Format('<img src="%s" width="18" height="18">', [imgUrl]),
[rfReplaceAll]
);
// Ïîìå÷àåì ýìîäçè êàê îáðàáîòàííûé
ProcessedEmotes.Add(EmoteID, '');
end;
Result := ResultText;
finally
ProcessedEmotes.Free;
Parts.Free;
end;
end;
procedure TfrOBS.AddChat(newRecord: TOBSChat); procedure TfrOBS.AddChat(newRecord: TOBSChat);
begin begin
SetLength(listChats, Length(listChats) + 1); SetLength(listChats, Length(listChats) + 1);
@@ -613,6 +566,22 @@ begin
end; end;
end; end;
function TfrOBS.FindEmoteByID(const ID: string): TEmotes;
var
i: integer;
begin
result.ID := '';
if not Assigned(ChatEmotes) then
exit;
for i := 0 to ChatEmotes.Count - 1 do
if ChatEmotes[i].ID = ID then
begin
result := ChatEmotes[i];
Break;
end;
end;
procedure TfrOBS.sgWebChatsCellDblClick(const Column: TColumn; procedure TfrOBS.sgWebChatsCellDblClick(const Column: TColumn;
const Row: integer); const Row: integer);
var var
+1
View File
@@ -264,6 +264,7 @@ type
format: TArray<string>; format: TArray<string>;
scale: TArray<string>; scale: TArray<string>;
theme_mode: TArray<string>; theme_mode: TArray<string>;
topImage:string;
end; end;
TStyleChat = record TStyleChat = record