сделал оповещения о событиях

This commit is contained in:
PC1\PTyTb
2025-08-14 21:43:02 +03:00
parent bad576dd4d
commit 2335bf1656
8 changed files with 874 additions and 35 deletions
+3 -2
View File
@@ -33,7 +33,6 @@ uses
uTTWEventSub in 'Services\uTTWEventSub.pas', uTTWEventSub in 'Services\uTTWEventSub.pas',
uTTWIRC in 'Services\uTTWIRC.pas', uTTWIRC in 'Services\uTTWIRC.pas',
uTWAuth in 'Services\uTWAuth.pas', uTWAuth in 'Services\uTWAuth.pas',
uWebServerKandinsky in 'Services\uWebServerKandinsky.pas',
uWSDA in 'Services\uWSDA.pas', uWSDA in 'Services\uWSDA.pas',
uDataBase in 'utils\uDataBase.pas', uDataBase in 'utils\uDataBase.pas',
uMyTimer in 'utils\uMyTimer.pas', uMyTimer in 'utils\uMyTimer.pas',
@@ -44,7 +43,9 @@ uses
uTTS in 'utils\uTTS.pas', uTTS in 'utils\uTTS.pas',
fPlayerWeb in 'frames\fPlayerWeb.pas' {frPlayerWeb: TFrame}, fPlayerWeb in 'frames\fPlayerWeb.pas' {frPlayerWeb: TFrame},
uPlayerThread in 'utils\uPlayerThread.pas', uPlayerThread in 'utils\uPlayerThread.pas',
uWebServerChat in 'utils\uWebServerChat.pas'; uWebServerChat in 'utils\uWebServerChat.pas',
uWebServerKandinsky in 'utils\uWebServerKandinsky.pas',
uWebServerEvents in 'utils\uWebServerEvents.pas';
{$R *.res} {$R *.res}
+2 -1
View File
@@ -411,7 +411,6 @@
<DCCReference Include="Services\uTTWEventSub.pas"/> <DCCReference Include="Services\uTTWEventSub.pas"/>
<DCCReference Include="Services\uTTWIRC.pas"/> <DCCReference Include="Services\uTTWIRC.pas"/>
<DCCReference Include="Services\uTWAuth.pas"/> <DCCReference Include="Services\uTWAuth.pas"/>
<DCCReference Include="Services\uWebServerKandinsky.pas"/>
<DCCReference Include="Services\uWSDA.pas"/> <DCCReference Include="Services\uWSDA.pas"/>
<DCCReference Include="utils\uDataBase.pas"/> <DCCReference Include="utils\uDataBase.pas"/>
<DCCReference Include="utils\uMyTimer.pas"/> <DCCReference Include="utils\uMyTimer.pas"/>
@@ -431,6 +430,8 @@
</DCCReference> </DCCReference>
<DCCReference Include="utils\uPlayerThread.pas"/> <DCCReference Include="utils\uPlayerThread.pas"/>
<DCCReference Include="utils\uWebServerChat.pas"/> <DCCReference Include="utils\uWebServerChat.pas"/>
<DCCReference Include="utils\uWebServerKandinsky.pas"/>
<DCCReference Include="utils\uWebServerEvents.pas"/>
<None Include=".gitignore"/> <None Include=".gitignore"/>
<BuildConfiguration Include="Base"> <BuildConfiguration Include="Base">
<Key>Base</Key> <Key>Base</Key>
+11 -4
View File
@@ -146,7 +146,7 @@ object fCreateNotify: TfCreateNotify
Position.X = 8.000000000000000000 Position.X = 8.000000000000000000
Position.Y = 135.000000000000000000 Position.Y = 135.000000000000000000
Text = #1057#1086#1073#1099#1090#1080#1077 Text = #1057#1086#1073#1099#1090#1080#1077
TabOrder = 42 TabOrder = 37
end end
object cbEventsType: TComboBox object cbEventsType: TComboBox
Items.Strings = ( Items.Strings = (
@@ -160,7 +160,7 @@ object fCreateNotify: TfCreateNotify
Size.Width = 192.000000000000000000 Size.Width = 192.000000000000000000
Size.Height = 22.000000000000000000 Size.Height = 22.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
TabOrder = 43 TabOrder = 38
OnChange = cbEventsTypeChange OnChange = cbEventsTypeChange
end end
object Label3: TLabel object Label3: TLabel
@@ -168,11 +168,11 @@ object fCreateNotify: TfCreateNotify
Position.Y = 190.000000000000000000 Position.Y = 190.000000000000000000
Text = #1059#1089#1083#1086#1074#1080#1077' '#1089#1091#1084#1084#1099 Text = #1059#1089#1083#1086#1074#1080#1077' '#1089#1091#1084#1084#1099
Visible = False Visible = False
TabOrder = 44 TabOrder = 39
end end
object edtIF: TEdit object edtIF: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap] Touch.InteractiveGestures = [LongTap, DoubleTap]
TabOrder = 45 TabOrder = 40
Position.X = 8.000000000000000000 Position.X = 8.000000000000000000
Position.Y = 215.000000000000000000 Position.Y = 215.000000000000000000
Size.Width = 192.000000000000000000 Size.Width = 192.000000000000000000
@@ -198,6 +198,7 @@ object fCreateNotify: TfCreateNotify
TabOrder = 59 TabOrder = 59
Text = #1058#1077#1089#1090 Text = #1058#1077#1089#1090
TextSettings.Trimming = None TextSettings.Trimming = None
OnClick = btnESTestClick
end end
object GroupBox1: TGroupBox object GroupBox1: TGroupBox
Padding.Left = 10.000000000000000000 Padding.Left = 10.000000000000000000
@@ -227,6 +228,9 @@ object fCreateNotify: TfCreateNotify
Size.Width = 241.000000000000000000 Size.Width = 241.000000000000000000
Size.Height = 115.000000000000000000 Size.Height = 115.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
inherited Label41: TLabel
TabOrder = 5
end
inherited ccbFontColor: TColorComboBox inherited ccbFontColor: TColorComboBox
TabOrder = 36 TabOrder = 36
end end
@@ -255,6 +259,9 @@ object fCreateNotify: TfCreateNotify
Size.Width = 241.000000000000000000 Size.Width = 241.000000000000000000
Size.Height = 115.000000000000000000 Size.Height = 115.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
inherited Label41: TLabel
TabOrder = 5
end
inherited ccbFontColor: TColorComboBox inherited ccbFontColor: TColorComboBox
TabOrder = 36 TabOrder = 36
end end
+45 -1
View File
@@ -4,7 +4,7 @@ interface
uses uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.SysUtils, System.Types, System.UITypes, System.Classes,
System.Variants, System.Variants, fOBS,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, fFontSettings, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, fFontSettings,
fColorSettings, FMX.StdCtrls, FMX.Edit, FMX.Controls.Presentation, fColorSettings, FMX.StdCtrls, FMX.Edit, FMX.Controls.Presentation,
FMX.ListBox, FMX.EditBox, FMX.SpinBox, FMX.Colors, uRecords; FMX.ListBox, FMX.EditBox, FMX.SpinBox, FMX.Colors, uRecords;
@@ -39,9 +39,11 @@ type
procedure btnCreateEventClick(Sender: TObject); procedure btnCreateEventClick(Sender: TObject);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
procedure cbEventsTypeChange(Sender: TObject); procedure cbEventsTypeChange(Sender: TObject);
procedure btnESTestClick(Sender: TObject);
private private
{ Private declarations } { Private declarations }
function GetColorFromColorPanel(aColor: TAlphaColor): string; function GetColorFromColorPanel(aColor: TAlphaColor): string;
function GetColorFromCCB(aColor: TAlphaColor): string;
public public
{ Public declarations } { Public declarations }
isEdit: boolean; isEdit: boolean;
@@ -155,6 +157,48 @@ begin
close; close;
end; end;
function TfCreateNotify.GetColorFromCCB(aColor: TAlphaColor): string;
var
Color: TAlphaColor;
r, G, B: Byte;
begin
Color := aColor;
r := TAlphaColorRec(Color).r;
G := TAlphaColorRec(Color).G;
B := TAlphaColorRec(Color).B;
result := Format('#%.2X%.2X%.2X', [r, G, B]);
end;
procedure TfCreateNotify.btnESTestClick(Sender: TObject);
var
se: TStyleEvent;
i: Integer;
begin
se.Title := edtESTitle.Text;
se.Context := edtESMessage.Text;
se.Url := edtESImage.Text;
se.SoundURL := edtESSound.Text;
se.Timestamp := Now;
se.TimeMsg := round(sbTimeMsg.Value);
se.BorderColor := GetColorFromCCB(frColorSettings1.ccbStyleBorderColor.Color);
se.BorderSize := round(frColorSettings1.sbStyleBlockBorderSize.Value);
se.BlockColor := GetColorFromColorPanel(frColorSettings1.cpStyleBlockColor.Color);
se.FontTitle.Font := frFontSettings2.cbFontStyleDefault.Text;
se.FontTitle.Size := round(frFontSettings2.sbFontSize.Value);
se.FontTitle.Color := GetColorFromCCB(frFontSettings2.ccbFontColor.Color);
se.FontContext.Font := frFontSettings3.cbFontStyleDefault.Text;
se.FontContext.Size := round(frFontSettings3.sbFontSize.Value);
se.FontContext.Color := GetColorFromCCB(frFontSettings3.ccbFontColor.Color);
se.RequireInteraction := True;
for i := 0 to TTW_Bot.frOBS1.EventWebServers.Count - 1 do
begin
TTW_Bot.frOBS1.EventWebServers[i].WebServerChat.AddMessage(se);
end;
end;
procedure TfCreateNotify.cbEventsTypeChange(Sender: TObject); procedure TfCreateNotify.cbEventsTypeChange(Sender: TObject);
begin begin
Label3.Visible := cbEventsType.ItemIndex = 4; Label3.Visible := cbEventsType.ItemIndex = 4;
+10 -5
View File
@@ -249,10 +249,10 @@ begin
ttw_ES.OnStatus := ESStatus; ttw_ES.OnStatus := ESStatus;
// ttw_ES.OnRAW := fRewards.ESOnRAW; // ttw_ES.OnRAW := fRewards.ESOnRAW;
// ttw_ES.OnSubOk := fRewards.ESOnSubOk; // ttw_ES.OnSubOk := fRewards.ESOnSubOk;
// ttw_ES.OnFollow := fWebServerEvents.ESOnFollow; ttw_ES.OnFollow := frOBS1.toEventWebServer;
// ttw_ES.OnSub := fWebServerEvents.ESOnSub; ttw_ES.OnSub := frOBS1.toEventWebServer;
// ttw_ES.OnGift := fWebServerEvents.ESOnGift; ttw_ES.OnGift := frOBS1.toEventWebServer;
// ttw_ES.OnRaid := fWebServerEvents.ESOnRaid; } ttw_ES.OnRaid := frOBS1.toEventWebServer;
toLog('uGeneral', 'ConnectProcedure.ttw_ES', 'Создан', 0); toLog('uGeneral', 'ConnectProcedure.ttw_ES', 'Создан', 0);
ttw_ES.Connect; ttw_ES.Connect;
except except
@@ -496,7 +496,7 @@ begin
frOBS1.ChatBadges.Free; frOBS1.ChatBadges.Free;
frOBS1.ChatEmotes.Free; frOBS1.ChatEmotes.Free;
frOBS1.ChatWebServers.Free; frOBS1.ChatWebServers.Free;
frOBS1.EventWebServers.Free;
DisconnectProcedure; DisconnectProcedure;
if Assigned(ttw_IRS) then if Assigned(ttw_IRS) then
@@ -1063,6 +1063,11 @@ procedure TTTW_Bot.ReadDB;
end; end;
db.LoadRecordArray<TOBSNotify>('listNotify', frOBS1.listNotify); db.LoadRecordArray<TOBSNotify>('listNotify', frOBS1.listNotify);
frOBS1.EventWebServers := TList<TEventWebServers>.Create;
for I := 0 to High(frOBS1.listNotify) do
begin
frOBS1.CreateWebEvents(frOBS1.listNotify[I]);
end;
db.LoadRecordArray<TOBSKandinsky>('listKandinsky', frOBS1.listKandinsky); db.LoadRecordArray<TOBSKandinsky>('listKandinsky', frOBS1.listKandinsky);
frOBS1.UpdateGridFromArray; frOBS1.UpdateGridFromArray;
end; end;
+461 -21
View File
@@ -4,7 +4,8 @@ interface
uses uses
System.SysUtils, System.Types, System.UITypes, System.Classes, uCustomEmoties, System.SysUtils, System.Types, System.UITypes, System.Classes, uCustomEmoties,
System.Variants, uWebServerChat, fColorSettings, System.Generics.Collections, System.Variants, uWebServerChat, uWebServerEvents, fColorSettings,
System.Generics.Collections,
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,
@@ -27,6 +28,13 @@ type
WebServerChat: TTTW_Chat; WebServerChat: TTTW_Chat;
end; end;
type
TEventWebServers = record
port: integer;
se: TStyleEvent;
WebServerChat: TTTW_Events;
end;
type type
TfrOBS = class(TFrame) TfrOBS = class(TFrame)
sgWebChats: TStringGrid; sgWebChats: TStringGrid;
@@ -62,7 +70,15 @@ type
ChatBadges: Tlist<TChatBadge>; ChatBadges: Tlist<TChatBadge>;
ChatEmotes: Tlist<TEmotes>; ChatEmotes: Tlist<TEmotes>;
ChatWebServers: Tlist<TChatWebServers>; ChatWebServers: Tlist<TChatWebServers>;
EventWebServers: Tlist<TEventWebServers>;
procedure MsgToWebServer(const aRecord: TTwitchChatMessage); procedure MsgToWebServer(const aRecord: TTwitchChatMessage);
procedure toEventWebServer(CustomReward: TFollowEvent); overload; // follow
procedure toEventWebServer(CustomReward: TSubEvent); overload; // sub
procedure toEventWebServer(CustomReward: TRaidEvent); overload; // raid
procedure toEventWebServer(CustomReward: TGiftEvent); overload; // gift
procedure toEventWebServer(aNick, aSum, aText: string); overload; // donate
procedure CreateWebEvents(eventsSettings: TOBSNotify);
procedure CreateWebChat(chatSettings: TOBSChat); procedure CreateWebChat(chatSettings: TOBSChat);
procedure UpdateGridFromArray; procedure UpdateGridFromArray;
procedure AddChat(newRecord: TOBSChat); procedure AddChat(newRecord: TOBSChat);
@@ -117,7 +133,6 @@ begin
end; end;
end; end;
function TfrOBS.GetBadgesHTML(Badges: string): string; function TfrOBS.GetBadgesHTML(Badges: string): string;
var var
BadgeList: TArray<string>; BadgeList: TArray<string>;
@@ -201,23 +216,23 @@ begin
end; end;
end; end;
function TfrOBS.ReplaceEmotesInMessage(const MessageText,
function TfrOBS.ReplaceEmotesInMessage(const MessageText, EmotesString: string): string; EmotesString: string): string;
var var
ProcessedEmotes: TDictionary<string, string>; ProcessedEmotes: TDictionary<string, string>;
Parts: TStringList; Parts: tstringlist;
i, ColonPos: Integer; i, ColonPos: integer;
EmoteID: string; EmoteID: string;
Emote: TEmotes; Emote: TEmotes;
ResultText: string; ResultText: string;
begin begin
Result := MessageText; result := MessageText;
if EmotesString.Trim = '' then if EmotesString.Trim = '' then
Exit; Exit;
// Èñïîëüçóåì ñëîâàðü äëÿ îòñëåæèâàíèÿ óæå îáðàáîòàííûõ ýìîäçè // Èñïîëüçóåì ñëîâàðü äëÿ îòñëåæèâàíèÿ óæå îáðàáîòàííûõ ýìîäçè
ProcessedEmotes := TDictionary<string, string>.Create; ProcessedEmotes := TDictionary<string, string>.Create;
Parts := TStringList.Create; Parts := tstringlist.Create;
try try
// Ðàçäåëÿåì îáùóþ ñòðîêó ñìàéëîâ ïî '/' // Ðàçäåëÿåì îáùóþ ñòðîêó ñìàéëîâ ïî '/'
Parts.StrictDelimiter := True; Parts.StrictDelimiter := True;
@@ -245,7 +260,8 @@ begin
if Emote.ID = '' then if Emote.ID = '' then
Continue; Continue;
var imgUrl: string; var
imgUrl: string;
if Emote.topImage <> '' then if Emote.topImage <> '' then
imgUrl := Emote.topImage imgUrl := Emote.topImage
else if Emote.images.Url4x <> '' then else if Emote.images.Url4x <> '' then
@@ -254,25 +270,21 @@ begin
Continue; // Ïðîïóñêàåì åñëè íåò URL Continue; // Ïðîïóñêàåì åñëè íåò URL
// Çàìåíÿåì âñå âõîæäåíèÿ èìåíè ýìîäçè // Çàìåíÿåì âñå âõîæäåíèÿ èìåíè ýìîäçè
ResultText := StringReplace( ResultText := StringReplace(ResultText, Emote.name,
ResultText,
Emote.name,
Format('<img src="%s" width="18" height="18">', [imgUrl]), Format('<img src="%s" width="18" height="18">', [imgUrl]),
[rfReplaceAll] [rfReplaceAll]);
);
// Ïîìå÷àåì ýìîäçè êàê îáðàáîòàííûé // Ïîìå÷àåì ýìîäçè êàê îáðàáîòàííûé
ProcessedEmotes.Add(EmoteID, ''); ProcessedEmotes.Add(EmoteID, '');
end; end;
Result := ResultText; result := ResultText;
finally finally
ProcessedEmotes.Free; ProcessedEmotes.Free;
Parts.Free; Parts.Free;
end; end;
end; end;
procedure TfrOBS.AddChat(newRecord: TOBSChat); procedure TfrOBS.AddChat(newRecord: TOBSChat);
begin begin
SetLength(listChats, Length(listChats) + 1); SetLength(listChats, Length(listChats) + 1);
@@ -296,6 +308,7 @@ begin
listNotify[High(listNotify)] := newRecord; listNotify[High(listNotify)] := newRecord;
UpdateGridFromArray; UpdateGridFromArray;
db.SaveRecordArray<TOBSNotify>('listNotify', listNotify); db.SaveRecordArray<TOBSNotify>('listNotify', listNotify);
CreateWebEvents(newRecord);
end; end;
procedure TfrOBS.btnCreateOBSChatClick(Sender: TObject); procedure TfrOBS.btnCreateOBSChatClick(Sender: TObject);
@@ -382,7 +395,7 @@ var
repeat repeat
if (SearchRec.Attr and faAnyFile) = SearchRec.Attr then if (SearchRec.Attr and faAnyFile) = SearchRec.Attr then
begin begin
mySL.Add(SearchRec.Name); mySL.Add(SearchRec.name);
Inc(n); Inc(n);
end; end;
until FindNext(SearchRec) <> 0; until FindNext(SearchRec) <> 0;
@@ -426,6 +439,90 @@ begin
end; end;
end; end;
procedure TfrOBS.CreateWebEvents(eventsSettings: TOBSNotify);
var
EventWebServer: TEventWebServers;
fonts: tstringlist;
f: TfrColorSettings;
t: TfrFontSettings;
procedure LoadFontList(const mySL: tstringlist);
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
mySL.Add(SearchRec.name);
Inc(n);
end;
until FindNext(SearchRec) <> 0;
finally
System.SysUtils.FindClose(SearchRec);
end;
end;
function 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;
begin
fonts := tstringlist.Create;
f := TfrColorSettings.Create(self);
t := TfrFontSettings.Create(self);
try
LoadFontList(fonts);
EventWebServer.WebServerChat := TTTW_Events.Create(fonts,eventsSettings.port);
EventWebServer.port := eventsSettings.port;
EventWebServer.se.title := eventsSettings.HeaderText;
EventWebServer.se.Context:=eventsSettings.MessText;
EventWebServer.se.Url:=eventsSettings.Picture;
EventWebServer.se.SoundURL:=eventsSettings.Sound;
EventWebServer.se.Timestamp:=now;
EventWebServer.se.TimeMsg:=eventsSettings.TimeMess;
EventWebServer.se.FontTitle.Font:= t.cbFontStyleDefault.Items[eventsSettings.HeaderStyleFont];
EventWebServer.se.FontTitle.Size:=eventsSettings.HeaderSizeFont;
EventWebServer.se.FontTitle.Color:=t.ccbFontColor.Items[eventsSettings.HeaderColorFont];
EventWebServer.se.FontContext.Font:= t.cbFontStyleDefault.Items[eventsSettings.MessStyleFont];
EventWebServer.se.FontContext.Size:=eventsSettings.MessSizeFont;
EventWebServer.se.FontContext.Color:=t.ccbFontColor.Items[eventsSettings.MessColorFont];
EventWebServer.se.BorderColor:=f.ccbStyleBorderColor.Items[eventsSettings.ColorBorder];
EventWebServer.se.BorderSize:=eventsSettings.SolidBorder;
EventWebServer.se.BlockColor:=GetColorFromColorPanel(f.cpStyleBlockColor.Color);
EventWebServers.Add(EventWebServer);
EventWebServers[EventWebServers.Count - 1].WebServerChat.ActiveServer(True);
finally
fonts.Free;
f.Free;
t.Free;
end;
end;
procedure TfrOBS.DelChat(aPort: integer); procedure TfrOBS.DelChat(aPort: integer);
var var
i, j: integer; i, j: integer;
@@ -526,15 +623,18 @@ begin
chatWeb.MaxMsg := newRecord.MaxCountMess; chatWeb.MaxMsg := newRecord.MaxCountMess;
chatWeb.TimeMsg := newRecord.TimeMess; chatWeb.TimeMsg := newRecord.TimeMess;
chatWeb.Freez := newRecord.Freez = 1; chatWeb.Freez := newRecord.Freez = 1;
chatWeb.StyleBorderColor := f.ccbStyleBorderColor.Items[newRecord.ColorBorder]; chatWeb.StyleBorderColor := f.ccbStyleBorderColor.Items
[newRecord.ColorBorder];
chatWeb.StyleBlockColor := newRecord.ColorBlock; chatWeb.StyleBlockColor := newRecord.ColorBlock;
chatWeb.StyleBlockBorderSize := newRecord.SolidBorder; chatWeb.StyleBlockBorderSize := newRecord.SolidBorder;
chatWeb.StyleBlockPadding := newRecord.Paddings; chatWeb.StyleBlockPadding := newRecord.Paddings;
chatWeb.FontStyleDefault := t.cbFontStyleDefault.Items[newRecord.StyleFont]; chatWeb.FontStyleDefault := t.cbFontStyleDefault.Items
[newRecord.StyleFont];
chatWeb.FontColor := t.ccbFontColor.Items[newRecord.ColorFont]; chatWeb.FontColor := t.ccbFontColor.Items[newRecord.ColorFont];
chatWeb.FontSize := newRecord.SizeFont; chatWeb.FontSize := newRecord.SizeFont;
chatWeb.BColor := f.ccbBColor.Items[newRecord.ColorBackground]; chatWeb.BColor := f.ccbBColor.Items[newRecord.ColorBackground];
chatWeb.WebServerChat.changeBackground(f.ccbBColor.Items[newRecord.ColorBackground]); chatWeb.WebServerChat.changeBackground
(f.ccbBColor.Items[newRecord.ColorBackground]);
chatWeb.WebServerChat.SetDeleteMode(not chatWeb.Freez, chatWeb.MaxMsg); chatWeb.WebServerChat.SetDeleteMode(not chatWeb.Freez, chatWeb.MaxMsg);
// 4. Âîçâðàùàåì ìîäèôèöèðîâàííóþ çàïèñü â ñïèñîê // 4. Âîçâðàùàåì ìîäèôèöèðîâàííóþ çàïèñü â ñïèñîê
@@ -572,7 +672,7 @@ var
begin begin
result.ID := ''; result.ID := '';
if not Assigned(ChatEmotes) then if not Assigned(ChatEmotes) then
exit; Exit;
for i := 0 to ChatEmotes.Count - 1 do for i := 0 to ChatEmotes.Count - 1 do
if ChatEmotes[i].ID = ID then if ChatEmotes[i].ID = ID then
@@ -616,6 +716,346 @@ begin
end; end;
end; end;
procedure TfrOBS.toEventWebServer(CustomReward: TFollowEvent);
var
se: TStyleEvent;
i, j: integer;
f: TfrColorSettings;
t: TfrFontSettings;
notify: TOBSNotify;
begin
f := TfrColorSettings.Create(self);
t := TfrFontSettings.Create(self);
try
for i := 0 to high(listNotify) do
begin
if listNotify[i].TypeEvent = 0 then
begin
notify := listNotify[i];
se.Title := notify.HeaderText;
se.Title := StringReplace(se.Title, '[NICK]',
CustomReward.event.user_name, [rfReplaceAll]);
se.Context := notify.MessText;
se.Url := notify.Picture;
se.SoundURL := notify.Sound;
se.Timestamp := Now;
se.TimeMsg := notify.TimeMess;
se.BorderColor := f.ccbStyleBorderColor.Items[notify.ColorBorder];
se.BorderSize := notify.SolidBorder;
se.BlockColor := notify.ColorBlock;
se.FontTitle.Font := t.cbFontStyleDefault.Items[notify.HeaderStyleFont];
se.FontTitle.Size := notify.HeaderSizeFont;
se.FontTitle.Color := t.ccbFontColor.Items[notify.HeaderColorFont];
se.FontContext.Font := t.cbFontStyleDefault.Items[notify.MessSizeFont];
se.FontContext.Size := notify.MessSizeFont;
se.FontContext.Color := t.ccbFontColor.Items[notify.MessColorFont];
se.RequireInteraction := True;
for j := 0 to EventWebServers.Count - 1 do
begin
EventWebServers[j].WebServerChat.AddMessage(se);
end;
end;
end;
finally
f.Free;
t.Free;
end;
end;
procedure TfrOBS.toEventWebServer(CustomReward: TSubEvent);
var
se: TStyleEvent;
i, j: integer;
f: TfrColorSettings;
t: TfrFontSettings;
notify: TOBSNotify;
begin
f := TfrColorSettings.Create(self);
t := TfrFontSettings.Create(self);
try
for i := 0 to high(listNotify) do
begin
if listNotify[i].TypeEvent = 1 then
begin
notify := listNotify[i];
se.Title := notify.HeaderText;
se.Title := StringReplace(se.Title, '[NICK]',
CustomReward.event.user_name, [rfReplaceAll]);
se.Context := notify.MessText;
se.Url := notify.Picture;
se.SoundURL := notify.Sound;
se.Timestamp := Now;
se.TimeMsg := notify.TimeMess;
se.BorderColor := f.ccbStyleBorderColor.Items[notify.ColorBorder];
se.BorderSize := notify.SolidBorder;
se.BlockColor := notify.ColorBlock;
se.FontTitle.Font := t.cbFontStyleDefault.Items[notify.HeaderStyleFont];
se.FontTitle.Size := notify.HeaderSizeFont;
se.FontTitle.Color := t.ccbFontColor.Items[notify.HeaderColorFont];
se.FontContext.Font := t.cbFontStyleDefault.Items[notify.MessSizeFont];
se.FontContext.Size := notify.MessSizeFont;
se.FontContext.Color := t.ccbFontColor.Items[notify.MessColorFont];
se.RequireInteraction := True;
for j := 0 to EventWebServers.Count - 1 do
begin
EventWebServers[j].WebServerChat.AddMessage(se);
end;
end;
end;
finally
f.Free;
t.Free;
end;
end;
procedure TfrOBS.toEventWebServer(CustomReward: TRaidEvent);
var
se: TStyleEvent;
i, j: integer;
f: TfrColorSettings;
t: TfrFontSettings;
notify: TOBSNotify;
begin
f := TfrColorSettings.Create(self);
t := TfrFontSettings.Create(self);
try
for i := 0 to high(listNotify) do
begin
if listNotify[i].TypeEvent = 3 then
begin
notify := listNotify[i];
se.Title := notify.HeaderText;
se.Title := StringReplace(se.Title, '[NICK]',
CustomReward.event.from_broadcaster_user_name, [rfReplaceAll]);
se.Context := notify.MessText;
se.Context := StringReplace(se.Context, '[SUM]',
inttostr(CustomReward.event.viewers), [rfReplaceAll]);
se.Url := notify.Picture;
se.SoundURL := notify.Sound;
se.Timestamp := Now;
se.TimeMsg := notify.TimeMess;
se.BorderColor := f.ccbStyleBorderColor.Items[notify.ColorBorder];
se.BorderSize := notify.SolidBorder;
se.BlockColor := notify.ColorBlock;
se.FontTitle.Font := t.cbFontStyleDefault.Items[notify.HeaderStyleFont];
se.FontTitle.Size := notify.HeaderSizeFont;
se.FontTitle.Color := t.ccbFontColor.Items[notify.HeaderColorFont];
se.FontContext.Font := t.cbFontStyleDefault.Items[notify.MessSizeFont];
se.FontContext.Size := notify.MessSizeFont;
se.FontContext.Color := t.ccbFontColor.Items[notify.MessColorFont];
se.RequireInteraction := True;
for j := 0 to EventWebServers.Count - 1 do
begin
EventWebServers[j].WebServerChat.AddMessage(se);
end;
end;
end;
finally
f.Free;
t.Free;
end;
end;
procedure TfrOBS.toEventWebServer(CustomReward: TGiftEvent);
var
se: TStyleEvent;
i, j: integer;
f: TfrColorSettings;
t: TfrFontSettings;
notify: TOBSNotify;
begin
f := TfrColorSettings.Create(self);
t := TfrFontSettings.Create(self);
try
for i := 0 to high(listNotify) do
begin
if listNotify[i].TypeEvent = 2 then
begin
notify := listNotify[i];
se.Title := notify.HeaderText;
se.Title := StringReplace(se.Title, '[NICK]',
CustomReward.event.user_name, [rfReplaceAll]);
se.Context := notify.MessText;
se.Url := notify.Picture;
se.SoundURL := notify.Sound;
se.Timestamp := Now;
se.TimeMsg := notify.TimeMess;
se.BorderColor := f.ccbStyleBorderColor.Items[notify.ColorBorder];
se.BorderSize := notify.SolidBorder;
se.BlockColor := notify.ColorBlock;
se.FontTitle.Font := t.cbFontStyleDefault.Items[notify.HeaderStyleFont];
se.FontTitle.Size := notify.HeaderSizeFont;
se.FontTitle.Color := t.ccbFontColor.Items[notify.HeaderColorFont];
se.FontContext.Font := t.cbFontStyleDefault.Items[notify.MessSizeFont];
se.FontContext.Size := notify.MessSizeFont;
se.FontContext.Color := t.ccbFontColor.Items[notify.MessColorFont];
se.RequireInteraction := True;
for j := 0 to EventWebServers.Count - 1 do
begin
EventWebServers[j].WebServerChat.AddMessage(se);
end;
end;
end;
finally
f.Free;
t.Free;
end;
end;
procedure TfrOBS.toEventWebServer(aNick, aSum, aText: string);
var
i, j: integer;
aSumInt: integer;
BestRow: integer;
BestPriority: integer;
BestValue: integer;
Condition: string;
CurrentPriority: integer;
CurrentValue: integer;
MinVal, MaxVal: integer;
Parts: tstringlist;
se: TStyleEvent;
notify: TOBSNotify;
f: TfrColorSettings;
t: TfrFontSettings;
begin
aSumInt := StrToIntDef(aSum, 0);
BestRow := -1;
BestPriority := -1;
BestValue := 0;
for i := 0 to high(listNotify) do
begin
if listNotify[i].TypeEvent = 4 then
begin
Condition := Trim(listNotify[i].TypeEdit);
if Condition = '' then
Continue;
CurrentPriority := -1;
CurrentValue := 0;
// Ïðîâåðêà íà òî÷íîå çíà÷åíèå
if Pos('-', Condition) = 0 then
begin
if Pos('>', Condition) = 0 then
begin
if Pos('<', Condition) = 0 then
begin
// Òî÷íîå çíà÷åíèå
CurrentValue := StrToIntDef(Condition, -1);
if aSumInt = CurrentValue then
CurrentPriority := 4;
end;
end;
end;
if CurrentPriority = -1 then
begin
if Pos('-', Condition) > 0 then
begin
// Äèàïàçîí
Parts := tstringlist.Create;
try
Parts.Delimiter := '-';
Parts.StrictDelimiter := True;
Parts.DelimitedText := Condition;
if Parts.Count = 2 then
begin
MinVal := StrToIntDef(Trim(Parts[0]), 0);
MaxVal := StrToIntDef(Trim(Parts[1]), 0);
if (aSumInt >= MinVal) and (aSumInt <= MaxVal) then
begin
CurrentPriority := 3;
CurrentValue := MinVal; // Ïðèîðèòåò ïî MinVal
end;
end;
finally
Parts.Free;
end;
end
else if Pos('>', Condition) > 0 then
begin
// Óñëîâèå ">X"
CurrentValue :=
StrToIntDef(Trim(StringReplace(Condition, '>', '',
[rfReplaceAll])), 0);
if aSumInt >= CurrentValue then
CurrentPriority := 2;
end
else if Pos('<', Condition) > 0 then
begin
// Óñëîâèå "<X"
CurrentValue :=
StrToIntDef(Trim(StringReplace(Condition, '<', '',
[rfReplaceAll])), 0);
if aSumInt <= CurrentValue then
CurrentPriority := 1;
end;
end;
if CurrentPriority <> -1 then
begin
// Îïðåäåëåíèå íàèëó÷øåãî óñëîâèÿ
if (CurrentPriority > BestPriority) or (CurrentPriority = BestPriority)
and ((CurrentPriority = 3) and (CurrentValue > BestValue) or
(CurrentPriority = 2) and (CurrentValue > BestValue) or
(CurrentPriority = 1) and (CurrentValue < BestValue)) then
begin
BestPriority := CurrentPriority;
BestValue := CurrentValue;
BestRow := i;
notify := listNotify[i];
end;
end;
if BestRow = -1 then
Break;
f := TfrColorSettings.Create(self);
t := TfrFontSettings.Create(self);
try
se.Title := notify.HeaderText;
se.Title := StringReplace(se.Title, '[NICK]', aNick, [rfReplaceAll]);
se.Title := StringReplace(se.Title, '[SUM]', aSum, [rfReplaceAll]);
se.Context := aText;
se.Url := notify.Picture;
se.SoundURL := notify.Sound;
se.Timestamp := Now;
se.TimeMsg := notify.TimeMess;
se.BorderColor := f.ccbStyleBorderColor.Items[notify.ColorBorder];
se.BorderSize := notify.SolidBorder;
se.BlockColor := notify.ColorBlock;
se.FontTitle.Font := t.cbFontStyleDefault.Items[notify.HeaderStyleFont];
se.FontTitle.Size := notify.HeaderSizeFont;
se.FontTitle.Color := t.ccbFontColor.Items[notify.HeaderColorFont];
se.FontContext.Font := t.cbFontStyleDefault.Items[notify.MessSizeFont];
se.FontContext.Size := notify.MessSizeFont;
se.FontContext.Color := t.ccbFontColor.Items[notify.MessColorFont];
se.RequireInteraction := True;
finally
f.Free;
t.Free;
end;
for j := 0 to EventWebServers.Count - 1 do
begin
EventWebServers[j].WebServerChat.AddMessage(se);
end;
end;
end;
end;
procedure TfrOBS.UpdateGridFromArray; procedure TfrOBS.UpdateGridFromArray;
var var
i, rowIndex: integer; i, rowIndex: integer;
+341
View File
@@ -0,0 +1,341 @@
unit uWebServerEvents;
interface
uses
Classes, StrUtils, DateUtils, System.JSON, System.Generics.Collections,
IdBaseComponent, IdComponent, IdCustomTCPServer, IdContext,
IdCustomHTTPServer, uRecords, System.IOUtils, IdGlobalProtocols,
IdHTTPServer, System.SysUtils, SyncObjs;
type
TTTW_Events = class(TObject)
private
msgStyle: TStyleEvent;
fFontsList: TStringList;
FMessages: TList<TStyleEvent>;
FCriticalSection: TCriticalSection;
procedure IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
procedure ProcessFileRequest(ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo; const Folder: string);
function GenerateHTML: string;
function GenerateJSON: string;
procedure CleanupOldMessages;
public
IdHTTPServer1: TIdHTTPServer;
constructor Create(FontList: TStrings; aPort:integer);
destructor Destroy; override;
procedure addMessage(newMsg: TStyleEvent);
procedure ActiveServer(aEn: boolean);
end;
implementation
uses ugeneral;
{ TTTW_Events }
constructor TTTW_Events.Create(FontList: TStrings; aPort:integer);
var
I: Integer;
begin
FCriticalSection := TCriticalSection.Create;
FMessages := TList<TStyleEvent>.Create;
fFontsList := TStringList.Create;
fFontsList.Assign(FontList);
IdHTTPServer1 := TIdHTTPServer.Create(nil);
IdHTTPServer1.DefaultPort := aPort;
IdHTTPServer1.OnCommandGet := IdHTTPServer1CommandGet;
end;
destructor TTTW_Events.Destroy;
begin
FCriticalSection.Free;
FMessages.Free;
fFontsList.Free;
IdHTTPServer1.Free;
inherited;
end;
procedure TTTW_Events.addMessage(newMsg: TStyleEvent);
begin
FCriticalSection.Enter;
try
FMessages.Add(newMsg);
CleanupOldMessages;
finally
FCriticalSection.Leave;
end;
end;
procedure TTTW_Events.CleanupOldMessages;
var
I: Integer;
TimeNow: TDateTime;
begin
TimeNow := Now;
FCriticalSection.Enter;
try
for I := FMessages.Count - 1 downto 0 do
begin
if SecondsBetween(TimeNow, FMessages[I].Timestamp) >= FMessages[I].TimeMsg then
FMessages.Delete(I);
end;
finally
FCriticalSection.Leave;
end;
end;
function TTTW_Events.GenerateHTML: string;
var
I: Integer;
s, s1: string;
begin
// Ãåíåðàöèÿ CSS äëÿ øðèôòîâ
s := 'body { background: #00FF00; }' + #13#10;
for I := 41 to fFontsList.Count - 1 do
begin
s1 := StringReplace(fFontsList[I], '.ttf', '', [rfReplaceAll]);
s := s + Format('@font-face { font-family: ''%s''; src: url(fonts/%s); }', [s1, fFontsList[I]]) + #13#10;
end;
Result := '<!DOCTYPE html><html><head>' +
'<meta http-equiv="Cache-Control" content="no-cache, no-store, must-revalidate">' +
'<meta http-equiv="Pragma" content="no-cache">' +
'<meta http-equiv="Expires" content="0">' +
'<title>Twitch Messages</title>' +
'<style>' + s +
'.message { ' +
' will-change: transform, opacity;' + // Îïòèìèçàöèÿ àíèìàöèè
' backface-visibility: hidden;' +
' transform: translateZ(0);' +
' margin:5px; ' +
' border-radius:5px; ' +
' transition: opacity 1s linear; ' +
' max-width: 600px; ' +
' margin-left: auto; ' +
' margin-right: auto; ' +
'}' +
'.nick { margin: 0; padding: 2px; }' +
'.text { margin: 0; padding: 5px; }' +
'#audio-warning { ' +
' display: none; ' +
' position: fixed; ' +
' top: 10px; ' +
' right: 10px; ' +
' background: #ffcccc; ' +
' padding: 10px; ' +
' border: 1px solid red; ' +
'}' +
'</style>' +
'<script>' +
'let lastPlayedTimestamp = 0;' +
'let audioEnabled = false;' +
'let pendingMessages = [];' +
'function enableAudio() {' +
' audioEnabled = true;' +
' document.getElementById("audio-overlay").style.display = "none";' +
' processPendingMessages();' +
'}' +
'function processPendingMessages() {' +
' pendingMessages.forEach(msg => {' +
' playNotificationSound(msg);' +
' });' +
' pendingMessages = [];' +
'}' +
'function playNotificationSound(msg) {' +
' if(!msg.sound) return;' +
' const audio = new Audio(msg.sound);' +
' audio.play()' +
' .catch(error => console.log("Audio error:", error));' +
'}' +
'function fetchMessages() {' +
' fetch("/messages")' +
' .then(response => response.json())' +
' .then(data => {' +
' const container = document.getElementById("messages");' +
' container.innerHTML = "";' +
' data.forEach(msg => {' +
// Ñîõðàíÿåì ñîîáùåíèÿ äî àêòèâàöèè çâóêà
' if(msg.sound && msg.timestamp > lastPlayedTimestamp) {' +
' playNotificationSound(msg);' +
' lastPlayedTimestamp = msg.timestamp;' +
' }' +
' const div = document.createElement("div");' +
' div.className = "message";' +
' div.id = "msg-" + msg.timestamp;' +
' div.style = `' +
' background-color: ${msg.color};' +
' padding: ${msg.padding}px;' +
' border: ${msg.sizeBorder}px solid ${msg.colorBorder};' +
' text-align: center;' +
' `;' +
// Âíóòðåííèé HTML
' let content = "";' +
' if(msg.url) {' +
' content += `<img src="${msg.url}" style="max-width: 100%; height: auto;">`;' +
' }' +
' content += `' +
' <p class="nick" style="' +
' color: ${msg.titlecolor};' +
' font-family: ''${msg.titlefamily}'';' +
' font-size: ${msg.titleSize}px;">' +
' ${msg.nickname}' +
' </p>' +
' <p class="text" style="' +
' color: ${msg.contentcolor};' +
' font-family: ''${msg.contentfamily}'';' +
' font-size: ${msg.contentSize}px;">' +
' ${msg.content}' +
' </p>' +
' `;' +
' div.innerHTML = content;' +
// Àíèìàöèÿ èñ÷åçíîâåíèÿ
' setTimeout(() => {' +
' div.style.opacity = "0";' +
' setTimeout(() => div.remove(), 1000);' +
' }, (msg.duration - 1) * 1000);' +
' container.appendChild(div);' +
' });' +
' });' +
'}' +
'setInterval(fetchMessages, 500);' +
'fetchMessages();' +
'</script>' +
'</head>' +
'<body>' +
' <div id="messages"></div>' +
'</body></html>';
end;
function TTTW_Events.GenerateJSON: string;
var
JSONArray: TJSONArray;
I: Integer; S,S1:STRING;
Msg: TStyleEvent;
begin
JSONArray := TJSONArray.Create;
try
FCriticalSection.Enter;
try
CleanupOldMessages;
for I := 0 to FMessages.Count - 1 do
begin
Msg := FMessages[I];
s:=StringReplace(Msg.FontTitle.Font,'.ttf','',[rfReplaceAll]);
s1:=StringReplace(Msg.FontContext.Font,'.ttf','',[rfReplaceAll]);
JSONArray.AddElement(TJSONObject.Create
.AddPair('nickname', Msg.Title)
.AddPair('url', Msg.Url)
.AddPair('content', Msg.Context)
.AddPair('timestamp', TJSONNumber.Create(DateTimeToUnix(Msg.Timestamp)))
.AddPair('sound', Msg.SoundURL)
.AddPair('duration', Msg.TimeMsg)
.AddPair('color', Msg.BlockColor)
.AddPair('colorBorder', Msg.BorderColor)
.AddPair('sizeBorder', TJSONNumber.Create(Msg.BorderSize))
.AddPair('fontSize', TJSONNumber.Create(Msg.FontTitle.size))
.AddPair('titlecolor', Msg.FontTitle.Color)
.AddPair('titlefamily', s)
.AddPair('titleSize', TJSONNumber.Create(Msg.FontTitle.Size))
.AddPair('contentcolor', Msg.FontContext.Color)
.AddPair('contentfamily', s1)
.AddPair('contentSize', TJSONNumber.Create(Msg.FontContext.Size))
); // Ôèêñèðîâàííûé ðàçìåð òåêñòà
end;
finally
FCriticalSection.Leave;
end;
Result := JSONArray.ToString;
finally
JSONArray.Free;
end;
end;
procedure TTTW_Events.ProcessFileRequest(ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo; const Folder: string);
var
FileName: string;
FilePath: string;
FS: TFileStream;
begin
FileName := TPath.GetFileName(ARequestInfo.Document);
FilePath := myConst.AppDataPath + Folder + '\' + FileName;
if FileExists(FilePath) then
begin
try
FS := TFileStream.Create(FilePath, fmOpenRead + fmShareDenyWrite);
AResponseInfo.ContentStream := FS;
AResponseInfo.ContentType := GetMIMETypeFromFile(FilePath);;
AResponseInfo.ResponseNo := 200;
except
FS.Free;
AResponseInfo.ResponseNo := 500;
end;
end
else
begin
AResponseInfo.ResponseNo := 404;
end;
end;
procedure TTTW_Events.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
if ARequestInfo.Document = '/' then
begin
AResponseInfo.CacheControl := 'no-cache, no-store, must-revalidate';
AResponseInfo.Pragma := 'no-cache';
AResponseInfo.Expires := 0;
AResponseInfo.ContentType := 'text/html';
AResponseInfo.ContentText := GenerateHTML;
end
else if ARequestInfo.Document = '/messages' then
begin
AResponseInfo.ContentType := 'application/json; charset=utf-8';
AResponseInfo.ContentText := GenerateJSON;
end
else if ARequestInfo.Document.StartsWith('/sounds/') then
begin
ProcessFileRequest(ARequestInfo, AResponseInfo, 'sounds');
end
else if ARequestInfo.Document.StartsWith('/fonts/') then
begin
ProcessFileRequest(ARequestInfo, AResponseInfo, 'fonts');
end
else if ARequestInfo.Document.StartsWith('/imgs/') then
begin
ProcessFileRequest(ARequestInfo, AResponseInfo, 'imgs');
end
else
AResponseInfo.ResponseNo := 404;
end;
procedure TTTW_Events.ActiveServer(aEn: boolean);
begin
IdHTTPServer1.Active := aEn;
end;
end.