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

frames/fOBS.pas

@@ -4,7 +4,8 @@ interface
 
 uses
   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,
   System.Rtti, FMX.Grid.Style, FMX.Grid, FMX.ScrollBox, FMX.Edit, FMX.Colors,
   FMX.ListBox, FMX.EditBox, FMX.SpinBox, FMX.Controls.Presentation, uRecords,
@@ -27,6 +28,13 @@ type
     WebServerChat: TTTW_Chat;
   end;
 
+type
+  TEventWebServers = record
+    port: integer;
+    se: TStyleEvent;
+    WebServerChat: TTTW_Events;
+  end;
+
 type
   TfrOBS = class(TFrame)
     sgWebChats: TStringGrid;
@@ -62,7 +70,15 @@ type
     ChatBadges: Tlist<TChatBadge>;
     ChatEmotes: Tlist<TEmotes>;
     ChatWebServers: Tlist<TChatWebServers>;
+    EventWebServers: Tlist<TEventWebServers>;
     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 UpdateGridFromArray;
     procedure AddChat(newRecord: TOBSChat);
@@ -117,7 +133,6 @@ begin
   end;
 end;
 
-
 function TfrOBS.GetBadgesHTML(Badges: string): string;
 var
   BadgeList: TArray<string>;
@@ -201,23 +216,23 @@ begin
   end;
 end;
 
-
-function TfrOBS.ReplaceEmotesInMessage(const MessageText, EmotesString: string): string;
+function TfrOBS.ReplaceEmotesInMessage(const MessageText,
+  EmotesString: string): string;
 var
   ProcessedEmotes: TDictionary<string, string>;
-  Parts: TStringList;
-  i, ColonPos: Integer;
+  Parts: tstringlist;
+  i, ColonPos: integer;
   EmoteID: string;
   Emote: TEmotes;
   ResultText: string;
 begin
-  Result := MessageText;
+  result := MessageText;
   if EmotesString.Trim = '' then
     Exit;
 
   // Èñïîëüçóåì ñëîâàðü äëÿ îòñëåæèâàíèÿ óæå îáðàáîòàííûõ ýìîäçè
   ProcessedEmotes := TDictionary<string, string>.Create;
-  Parts := TStringList.Create;
+  Parts := tstringlist.Create;
   try
     // Ðàçäåëÿåì îáùóþ ñòðîêó ñìàéëîâ ïî '/'
     Parts.StrictDelimiter := True;
@@ -245,7 +260,8 @@ begin
       if Emote.ID = '' then
         Continue;
 
-      var imgUrl: string;
+      var
+        imgUrl: string;
       if Emote.topImage <> '' then
         imgUrl := Emote.topImage
       else if Emote.images.Url4x <> '' then
@@ -254,25 +270,21 @@ begin
         Continue; // Ïðîïóñêàåì åñëè íåò URL
 
       // Çàìåíÿåì âñå âõîæäåíèÿ èìåíè ýìîäçè
-      ResultText := StringReplace(
-        ResultText,
-        Emote.name,
+      ResultText := StringReplace(ResultText, Emote.name,
         Format('<img src="%s" width="18" height="18">', [imgUrl]),
-        [rfReplaceAll]
-      );
+        [rfReplaceAll]);
 
       // Ïîìå÷àåì ýìîäçè êàê îáðàáîòàííûé
       ProcessedEmotes.Add(EmoteID, '');
     end;
 
-    Result := ResultText;
+    result := ResultText;
   finally
     ProcessedEmotes.Free;
     Parts.Free;
   end;
 end;
 
-
 procedure TfrOBS.AddChat(newRecord: TOBSChat);
 begin
   SetLength(listChats, Length(listChats) + 1);
@@ -296,6 +308,7 @@ begin
   listNotify[High(listNotify)] := newRecord;
   UpdateGridFromArray;
   db.SaveRecordArray<TOBSNotify>('listNotify', listNotify);
+   CreateWebEvents(newRecord);
 end;
 
 procedure TfrOBS.btnCreateOBSChatClick(Sender: TObject);
@@ -382,7 +395,7 @@ var
         repeat
           if (SearchRec.Attr and faAnyFile) = SearchRec.Attr then
           begin
-            mySL.Add(SearchRec.Name);
+            mySL.Add(SearchRec.name);
             Inc(n);
           end;
         until FindNext(SearchRec) <> 0;
@@ -426,6 +439,90 @@ begin
   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);
 var
   i, j: integer;
@@ -526,15 +623,18 @@ begin
         chatWeb.MaxMsg := newRecord.MaxCountMess;
         chatWeb.TimeMsg := newRecord.TimeMess;
         chatWeb.Freez := newRecord.Freez = 1;
-        chatWeb.StyleBorderColor := f.ccbStyleBorderColor.Items[newRecord.ColorBorder];
+        chatWeb.StyleBorderColor := f.ccbStyleBorderColor.Items
+          [newRecord.ColorBorder];
         chatWeb.StyleBlockColor := newRecord.ColorBlock;
         chatWeb.StyleBlockBorderSize := newRecord.SolidBorder;
         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.FontSize := newRecord.SizeFont;
         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);
 
         // 4. Âîçâðàùàåì ìîäèôèöèðîâàííóþ çàïèñü â ñïèñîê
@@ -572,7 +672,7 @@ var
 begin
   result.ID := '';
   if not Assigned(ChatEmotes) then
-    exit;
+    Exit;
 
   for i := 0 to ChatEmotes.Count - 1 do
     if ChatEmotes[i].ID = ID then
@@ -583,7 +683,7 @@ begin
 end;
 
 procedure TfrOBS.sgWebChatsCellDblClick(const Column: TColumn;
-const Row: integer);
+  const Row: integer);
 var
   myChatRec: TOBSChat;
   myNotifyRec: TOBSNotify;
@@ -616,6 +716,346 @@ begin
   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;
 var
   i, rowIndex: integer;