PTyTb/ttw_fmx_v10
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

добавил Игры, нужно разобраться с передачей команд в игру

Browse Source
This commit is contained in:
PC1\PTyTb
2025-08-18 23:33:38 +03:00
parent fc5a835b1f
commit 318365f63b
16 changed files with 890 additions and 129 deletions
Download Patch File Download Diff File Expand all files Collapse all files
frames/fOBS.pas
+123 -22
View File
@@ -5,8 +5,8 @@ interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, uCustomEmoties,
System.Variants, uWebServerChat, uWebServerEvents, fColorSettings,
fFontSettings,
System.Generics.Collections, uWebServerKandinsky,
fFontSettings, uCreateGame,
System.Generics.Collections, uWebServerKandinsky, uWebServerGames,
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,
@@ -37,6 +37,14 @@ type
WebServerChat: TTTW_Events;
end;
type
TGameWebServers = record
port: integer;
game: string;
WebServerGame: TGameWebServer;
commands: tstringlist;
end;
type
TKandinskyWebServers = record
port: integer;
@@ -54,11 +62,13 @@ type
StringColumn2: TStringColumn;
btnCreateOBSNotify: TButton;
btnCreateOBSKandinsky: TButton;
btnCreateOBSGame: TButton;
procedure btnDeleteeChatClick(Sender: TObject);
procedure btnCreateOBSKandinskyClick(Sender: TObject);
procedure btnCreateOBSChatClick(Sender: TObject);
procedure btnCreateOBSNotifyClick(Sender: TObject);
procedure sgWebChatsCellDblClick(const Column: TColumn; const Row: integer);
procedure btnCreateOBSGameClick(Sender: TObject);
private
{ Private declarations }
@@ -72,6 +82,7 @@ type
listChats: TArray<TOBSChat>;
listNotify: TArray<TOBSNotify>;
listKandinsky: TArray<TOBSKandinsky>;
listGames: TArray<TOBSGames>;
BTTV: TBTTV;
m7tv: t7tv;
@@ -80,6 +91,8 @@ type
ChatWebServers: Tlist<TChatWebServers>;
EventWebServers: Tlist<TEventWebServers>;
KandinskyWebServers: Tlist<TKandinskyWebServers>;
GameWebServers: Tlist<TGameWebServers>;
procedure MsgToWebServer(const aRecord: TTwitchChatMessage);
procedure toEventWebServer(aEvent: TFollowEvent); overload; // follow
procedure toEventWebServer(aEvent: TSubEvent); overload; // sub
@@ -101,6 +114,10 @@ type
procedure AddKandinsky(newRecord: TOBSKandinsky);
procedure DelKandinsky(aPort: integer);
procedure CreateWebKandinsky(aRecord: TOBSKandinsky);
procedure addGame(aGame: string; aPort: integer);
procedure delGame(aPort: integer);
procedure CreateWebGame(aGame: string; aPort: integer);
end;
implementation
@@ -304,6 +321,18 @@ begin
CreateWebChat(newRecord);
end;
procedure TfrOBS.addGame(aGame: string; aPort: integer);
begin
SetLength(listGames, Length(listGames) + 1);
listGames[High(listGames)].port := aPort;
listGames[High(listGames)].game := aGame;
UpdateGridFromArray;
db.SaveRecordArray<TOBSGames>('listGames', listGames);
CreateWebGame(aGame, aPort);
end;
procedure TfrOBS.AddKandinsky(newRecord: TOBSKandinsky);
begin
SetLength(listKandinsky, Length(listKandinsky) + 1);
@@ -337,6 +366,20 @@ begin
fCreateChat.Show;
end;
procedure TfrOBS.btnCreateOBSGameClick(Sender: TObject);
var
dport, i: integer;
begin
dport := 8080;
for i := 0 to sgWebChats.RowCount - 1 do
begin
if strtoint(sgWebChats.Cells[0, i]) >= dport then
dport := strtoint(sgWebChats.Cells[0, i]) + 1;
end;
fCreateGame.sbWebServerPort.Value := dport;
fCreateGame.Show;
end;
procedure TfrOBS.btnCreateOBSKandinskyClick(Sender: TObject);
var
dport: integer;
@@ -383,6 +426,10 @@ begin
begin
DelNotify(strtoint(sgWebChats.Cells[0, sgWebChats.Row]));
end;
if sgWebChats.Cells[1, sgWebChats.Row] = 'Èãðà' then
begin
delGame(strtoint(sgWebChats.Cells[0, sgWebChats.Row]));
end;
end;
procedure TfrOBS.CreateWebChat(chatSettings: TOBSChat);
@@ -527,7 +574,7 @@ begin
EventWebServer.se.FontTitle.Color := eventsSettings.HeaderColorFont;
EventWebServer.se.FontContext.Font := eventsSettings.MessStyleFont;
EventWebServer.se.FontContext.Size := eventsSettings.MessSizeFont;
EventWebServer.se.FontContext.Color :=eventsSettings.MessColorFont;
EventWebServer.se.FontContext.Color := eventsSettings.MessColorFont;
EventWebServer.se.BorderColor := eventsSettings.ColorBorder;
EventWebServer.se.BorderSize := eventsSettings.SolidBorder;
EventWebServer.se.BlockColor := eventsSettings.ColorBlock;
@@ -540,6 +587,24 @@ begin
end;
end;
procedure TfrOBS.CreateWebGame(aGame: string; aPort: integer);
var
GameWebServer: TGameWebServers;
commands: TArray<string>;
Cmd: string;
begin
GameWebServer.port := aPort;
GameWebServer.WebServerGame := TGameWebServer.Create
(myConst.GeneralPath, aPort);
GameWebServers.Add(GameWebServer);
GameWebServers[GameWebServers.Count - 1].WebServerGame.Start;
GameWebServers[GameWebServers.Count - 1].WebServerGame.SetGame(aGame);
commands := GameWebServers[GameWebServers.Count - 1]
.WebServerGame.GetControlCommands;
for Cmd in commands do
GameWebServers[GameWebServers.Count - 1].commands.Add(Cmd);
end;
procedure TfrOBS.CreateWebKandinsky(aRecord: TOBSKandinsky);
var
KandinskyWebServer: TKandinskyWebServers;
@@ -579,6 +644,31 @@ begin
UpdateGridFromArray;
end;
procedure TfrOBS.delGame(aPort: integer);
var
i, j: integer;
begin
// Èùåì â îáðàòíîì ïîðÿäêå äëÿ áåçîïàñíîãî óäàëåíèÿ
for i := High(listGames) downto 0 do
begin
if listGames[i].port = aPort then
begin
// Ñäâèãàåì ýëåìåíòû ìàññèâà
for j := i to High(listGames) - 1 do
listGames[j] := listGames[j + 1];
// Óìåíüøàåì ðàçìåð ìàññèâà
SetLength(listGames, Length(listGames) - 1);
// Âûõîäèì ïîñëå ïåðâîãî íàéäåííîãî ñîâïàäåíèÿ (ïðåäïîëàãàåì óíèêàëüíîñòü ïîðòîâ)
Break;
end;
end;
GameWebServers[i].WebServerGame.Stop;
GameWebServers[i].WebServerGame.Destroy;
GameWebServers.Delete(i);
UpdateGridFromArray;
db.SaveRecordArray<TOBSGames>('listGames', listGames);
end;
procedure TfrOBS.DelKandinsky(aPort: integer);
var
i, j: integer;
@@ -690,37 +780,38 @@ end;
procedure TfrOBS.EdtNotify(newRecord: TOBSNotify; oldPort: integer);
var
i,mi: integer; ws:TEventWebServers;
i, mi: integer;
ws: TEventWebServers;
begin
for I := 0 to EventWebServers.Count - 1 do
if EventWebServers[i].port = oldPort then
begin
ws:=EventWebServers[i];
mi:=i;
end;
for i := 0 to EventWebServers.Count - 1 do
if EventWebServers[i].port = oldPort then
begin
ws := EventWebServers[i];
mi := i;
end;
for i := 0 to High(listNotify) do
if listNotify[i].port = oldPort then
begin
listNotify[i] := newRecord;
ws.port:=listNotify[i].port;
ws.typeEvent:=listNotify[i].TypeEvent;
ws.se.title:=listNotify[i].HeaderText;
ws.se.Context:=listNotify[i].MessText;
ws.se.Url:=listNotify[i].Picture;
ws.se.SoundURL:=listNotify[i].Sound;
ws.se.TimeMsg:=listNotify[i].TimeMess;
ws.se.FontTitle.Font:=listNotify[i].HeaderStyleFont;
ws.port := listNotify[i].port;
ws.typeEvent := listNotify[i].typeEvent;
ws.se.Title := listNotify[i].HeaderText;
ws.se.Context := listNotify[i].MessText;
ws.se.Url := listNotify[i].Picture;
ws.se.SoundURL := listNotify[i].Sound;
ws.se.TimeMsg := listNotify[i].TimeMess;
ws.se.FontTitle.Font := listNotify[i].HeaderStyleFont;
ws.se.FontTitle.Font := listNotify[i].HeaderStyleFont;
ws.se.FontTitle.Size := listNotify[i].HeaderSizeFont;
ws.se.FontTitle.Color := listNotify[i].HeaderColorFont;
ws.se.FontContext.Font := listNotify[i].MessStyleFont;
ws.se.FontContext.Size := listNotify[i].MessSizeFont;
ws.se.FontContext.Color := listNotify[i].MessColorFont;
ws.se.BorderColor :=listNotify[i].ColorBorder;
ws.se.BorderColor := listNotify[i].ColorBorder;
ws.se.BorderSize := listNotify[i].SolidBorder;
ws.se.BlockColor := listNotify[i].ColorBlock;
EventWebServers[mi]:=ws;
EventWebServers[mi] := ws;
UpdateGridFromArray;
db.SaveRecordArray<TOBSNotify>('listNotify', listNotify);
Break;
@@ -800,7 +891,7 @@ begin
ws := EventWebServers[i];
ws.se.Title := StringReplace(ws.se.Title, '[NICK]',
aEvent.event.user_name, [rfReplaceAll]);
ws.se.Timestamp:=now;
ws.se.Timestamp := now;
ws.se.RequireInteraction := True;
TTW_Bot.toLog('fOBS', 'toEventWebServer.BlockColor', ws.se.BlockColor, 3);
EventWebServers[i].WebServerChat.AddMessage(ws.se);
@@ -824,7 +915,7 @@ begin
EventWebServers[i] := ws;
EventWebServers[i].WebServerChat.AddMessage(EventWebServers[i].se);
end;
TTW_Bot.frEvents1.OnTTVEvent(aEvent.event.user_name);
TTW_Bot.frEvents1.OnTTVEvent(aEvent.event.user_name);
end;
procedure TfrOBS.toEventWebServer(aEvent: TRaidEvent);
@@ -926,6 +1017,16 @@ begin
inttostr(listKandinsky[i].port);
Inc(rowIndex); // Óâåëè÷èâàåì ñ÷åò÷èê ñòðîê
end;
for i := 0 to High(listGames) do
begin
sgWebChats.RowCount := rowIndex + 1;
sgWebChats.Cells[0, rowIndex] := inttostr(listGames[i].port);
sgWebChats.Cells[1, rowIndex] := 'Èãðà';
sgWebChats.Cells[2, rowIndex] := 'http://127.0.0.1:' +
inttostr(listGames[i].port);
Inc(rowIndex); // Óâåëè÷èâàåì ñ÷åò÷èê ñòðîê
end;
finally
sgWebChats.EndUpdate;
end;