From 193e4cb2faa12092902b7c4f68eb80c5dab14331 Mon Sep 17 00:00:00 2001 From: "PC1\\PTyTb" Date: Thu, 7 Aug 2025 21:58:46 +0300 Subject: [PATCH] =?UTF-8?q?=D0=94=D0=BE=D0=B1=D0=B0=D0=B2=D0=B8=D0=BB=20?= =?UTF-8?q?=D0=B8=D0=BD=D1=82=D0=B5=D0=B3=D1=80=D0=B0=D1=86=D0=B8=D0=B8=20?= =?UTF-8?q?=D1=81=20=D0=9E=D0=91=D0=A1?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- fCommands.fmx | 46 +++------- fFontSettings.fmx | 6 +- fOBS.fmx | 9 +- fOBS.pas | 224 +++++++++++++++++++++++++++++++++++++++++++++- fSimpleGrid.fmx | 2 +- fSimpleGrid.pas | 2 +- uCreateChat.fmx | 42 ++++----- uCreateChat.pas | 47 +++++++++- uCreateNotify.fmx | 60 ++++--------- uCreateNotify.pas | 59 +++++++++++- uDataBase.pas | 6 +- uGeneral.fmx | 39 +++++--- uGeneral.pas | 164 ++++++++++++++------------------- uRecords.pas | 57 ++++++++++-- 14 files changed, 534 insertions(+), 229 deletions(-) diff --git a/fCommands.fmx b/fCommands.fmx index da1f2fe..2c50142 100644 --- a/fCommands.fmx +++ b/fCommands.fmx @@ -48,35 +48,6 @@ object frCommands: TfrCommands Viewport.Width = 388.000000000000000000 Viewport.Height = 157.000000000000000000 end - inherited GroupBox7: TGroupBox - inherited btnAddUserName: TButton - TabOrder = 38 - end - inherited btnGetDateFollow: TButton - TabOrder = 39 - end - inherited btnGetAgeAccaunt: TButton - TabOrder = 40 - end - inherited btnCounterAddtoText: TButton - TabOrder = 41 - end - inherited cbCounterName: TComboBox - TabOrder = 42 - end - inherited btnGPT: TButton - TabOrder = 43 - end - inherited btnRandomUserName: TButton - TabOrder = 44 - end - inherited btnGetChannelStat: TButton - TabOrder = 45 - end - inherited btnAIPic: TButton - TabOrder = 46 - end - end inherited btnAddCommand: TButton OnClick = frContruct1btnAddCommandClick end @@ -115,13 +86,16 @@ object frCommands: TfrCommands Viewport.Height = 116.000000000000000000 end inherited btnRandomAdd: TButton - TabOrder = 37 + TabOrder = 35 end inherited btnRandomDel: TButton - TabOrder = 38 + TabOrder = 36 end inherited btnRmGroup: TButton - TabOrder = 39 + TabOrder = 38 + end + inherited Label4: TLabel + TabOrder = 40 end end end @@ -176,7 +150,7 @@ object frCommands: TfrCommands object btnRandAdd: TButton Position.X = 9.000000000000000000 Position.Y = 205.000000000000000000 - TabOrder = 32 + TabOrder = 31 Text = #1044#1086#1073#1072#1074#1080#1090#1100 TextSettings.Trimming = None OnClick = btnRandAddClick @@ -243,7 +217,7 @@ object frCommands: TfrCommands Size.PlatformDefault = False inherited sg: TStringGrid Size.Width = 293.000000000000000000 - TabOrder = 44 + TabOrder = 43 OnCellDblClick = frsgSoundssgCellDblClick Viewport.Width = 289.000000000000000000 Viewport.Height = 124.000000000000000000 @@ -279,7 +253,7 @@ object frCommands: TfrCommands Size.PlatformDefault = False inherited sg: TStringGrid Size.Width = 293.000000000000000000 - TabOrder = 44 + TabOrder = 43 OnCellDblClick = frsgFilessgCellDblClick Viewport.Width = 289.000000000000000000 Viewport.Height = 124.000000000000000000 @@ -319,7 +293,7 @@ object frCommands: TfrCommands Size.PlatformDefault = False inherited sg: TStringGrid Size.Width = 293.000000000000000000 - TabOrder = 44 + TabOrder = 43 OnCellDblClick = frsgNeirosgCellDblClick Viewport.Width = 289.000000000000000000 Viewport.Height = 124.000000000000000000 diff --git a/fFontSettings.fmx b/fFontSettings.fmx index 42592d6..9b387ad 100644 --- a/fFontSettings.fmx +++ b/fFontSettings.fmx @@ -10,7 +10,7 @@ object frFontSettings: TfrFontSettings Size.PlatformDefault = False TextSettings.Trimming = None Text = #1056#1072#1079#1084#1077#1088' '#1096#1088#1080#1092#1090#1072 - TabOrder = 9 + TabOrder = 8 end object sbFontSize: TSpinBox Touch.InteractiveGestures = [LongTap, DoubleTap] @@ -30,14 +30,14 @@ object frFontSettings: TfrFontSettings Size.Width = 120.000000000000000000 Size.Height = 22.000000000000000000 Size.PlatformDefault = False - TabOrder = 39 + TabOrder = 38 end object Label49: TLabel Position.X = 116.000000000000000000 Position.Y = 63.000000000000000000 TextSettings.Trimming = None Text = #1062#1074#1077#1090' '#1096#1088#1080#1092#1090#1072 - TabOrder = 38 + TabOrder = 37 end object cbFontStyleDefault: TComboBox Items.Strings = ( diff --git a/fOBS.fmx b/fOBS.fmx index 15a0152..1a8d9c5 100644 --- a/fOBS.fmx +++ b/fOBS.fmx @@ -3,7 +3,6 @@ object frOBS: TfrOBS Size.Height = 252.000000000000000000 Size.PlatformDefault = False object sgWebChats: TStringGrid - Anchors = [akLeft, akTop, akRight, akBottom] Align = Bottom CanFocus = True ClipChildren = True @@ -14,8 +13,8 @@ object frOBS: TfrOBS TabOrder = 0 RowCount = 0 Options = [ColumnResize, ColumnMove, ColLines, RowLines, Tabs, Header, HeaderClick, AutoDisplacement] - Viewport.Width = 689.000000000000000000 - Viewport.Height = 189.000000000000000000 + Viewport.Width = 685.000000000000000000 + Viewport.Height = 164.000000000000000000 object IntegerColumn1: TIntegerColumn Header = #1055#1086#1088#1090 HeaderSettings.TextSettings.WordWrap = False @@ -36,6 +35,7 @@ object frOBS: TfrOBS TabOrder = 1 Text = #1057#1086#1079#1076#1072#1090#1100' '#1095#1072#1090 TextSettings.Trimming = None + OnClick = btnCreateOBSChatClick end object btnDeleteeChat: TButton Position.X = 601.000000000000000000 @@ -43,6 +43,7 @@ object frOBS: TfrOBS TabOrder = 2 Text = #1059#1076#1072#1083#1080#1090#1100 TextSettings.Trimming = None + OnClick = btnDeleteeChatClick end object Label1: TLabel Position.X = 8.000000000000000000 @@ -59,6 +60,7 @@ object frOBS: TfrOBS TabOrder = 4 Text = #1057#1086#1079#1076#1072#1090#1100' '#1086#1087#1086#1074#1077#1097#1077#1085#1080#1077 TextSettings.Trimming = None + OnClick = btnCreateOBSNotifyClick end object btnCreateOBSKandinsky: TButton Position.X = 257.000000000000000000 @@ -69,5 +71,6 @@ object frOBS: TfrOBS TabOrder = 5 Text = #1057#1086#1079#1076#1072#1090#1100' '#1050#1072#1085#1076#1080#1085#1089#1082#1080#1081 TextSettings.Trimming = None + OnClick = btnCreateOBSKandinskyClick end end diff --git a/fOBS.pas b/fOBS.pas index 0386960..06e8db9 100644 --- a/fOBS.pas +++ b/fOBS.pas @@ -3,10 +3,11 @@ unit fOBS; interface uses - System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, + System.SysUtils, System.Types, System.UITypes, System.Classes, + System.Variants, 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; + FMX.ListBox, FMX.EditBox, FMX.SpinBox, FMX.Controls.Presentation, uRecords; type TfrOBS = class(TFrame) @@ -19,14 +20,233 @@ type StringColumn2: TStringColumn; btnCreateOBSNotify: TButton; btnCreateOBSKandinsky: TButton; + procedure btnDeleteeChatClick(Sender: TObject); + procedure btnCreateOBSKandinskyClick(Sender: TObject); + procedure btnCreateOBSChatClick(Sender: TObject); + procedure btnCreateOBSNotifyClick(Sender: TObject); private { Private declarations } public { Public declarations } + listChats: TArray; + listNotify: TArray; + listKandinsky: TArray; + + procedure UpdateGridFromArray; + procedure AddChat(newRecord: TOBSChat); + procedure DelChat(aPort: integer); + + procedure AddNotify(newRecord: TOBSNotify); + procedure DelNotify(aPort: integer); + + procedure AddKandinsky(newRecord: TOBSKandinsky); + procedure DelKandinsky(aPort: integer); + end; implementation {$R *.fmx} +uses uGeneral, uCreateChat, uCreateNotify; + +{ TfrOBS } + +procedure TfrOBS.AddChat(newRecord: TOBSChat); +begin + SetLength(listChats, Length(listChats) + 1); + listChats[High(listChats)] := newRecord; + UpdateGridFromArray; + db.SaveRecordArray('listChats', listChats); +end; + +procedure TfrOBS.AddKandinsky(newRecord: TOBSKandinsky); +begin + SetLength(listKandinsky, Length(listKandinsky) + 1); + listKandinsky[High(listKandinsky)] := newRecord; + UpdateGridFromArray; + db.SaveRecordArray('listKandinsky', listKandinsky); +end; + +procedure TfrOBS.AddNotify(newRecord: TOBSNotify); +begin + SetLength(listNotify, Length(listNotify) + 1); + listNotify[High(listNotify)] := newRecord; + UpdateGridFromArray; + db.SaveRecordArray('listNotify', listNotify); +end; + +procedure TfrOBS.btnCreateOBSChatClick(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; + fCreateChat.sbWebServerPort.Value:=dport; + fCreateChat.Show; +end; + +procedure TfrOBS.btnCreateOBSKandinskyClick(Sender: TObject); +var + dport: integer; + I: integer; + rk: TOBSKandinsky; +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; + rk.port := dport; + AddKandinsky(rk); + +end; + +procedure TfrOBS.btnCreateOBSNotifyClick(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; + fCreateNotify.sbWebServerPort.Value:=dport; + fCreateNotify.Show; +end; + +procedure TfrOBS.btnDeleteeChatClick(Sender: TObject); +begin + if sgWebChats.Cells[1, sgWebChats.Row] = 'Чат' then + begin + DelChat(strtoint(sgWebChats.Cells[0, sgWebChats.Row])); + end; + if sgWebChats.Cells[1, sgWebChats.Row] = 'Kandinsky' then + begin + DelKandinsky(strtoint(sgWebChats.Cells[0, sgWebChats.Row])); + end; + if sgWebChats.Cells[1, sgWebChats.Row] = 'Оповещение' then + begin + DelNotify(strtoint(sgWebChats.Cells[0, sgWebChats.Row])); + end; +end; + +procedure TfrOBS.DelChat(aPort: integer); +var + I, j: integer; +begin + // Ищем в обратном порядке для безопасного удаления + for I := High(listChats) downto 0 do + begin + if listChats[I].port = aPort then + begin + // Сдвигаем элементы массива + for j := I to High(listChats) - 1 do + listChats[j] := listChats[j + 1]; + // Уменьшаем размер массива + SetLength(listChats, Length(listChats) - 1); + // Выходим после первого найденного совпадения (предполагаем уникальность портов) + Break; + end; + end; + + db.SaveRecordArray('listChats', listChats); + UpdateGridFromArray; +end; + +procedure TfrOBS.DelKandinsky(aPort: integer); +var + I, j: integer; +begin + // Ищем в обратном порядке для безопасного удаления + for I := High(listKandinsky) downto 0 do + begin + if listKandinsky[I].port = aPort then + begin + // Сдвигаем элементы массива + for j := I to High(listKandinsky) - 1 do + listKandinsky[j] := listKandinsky[j + 1]; + // Уменьшаем размер массива + SetLength(listKandinsky, Length(listKandinsky) - 1); + // Выходим после первого найденного совпадения (предполагаем уникальность портов) + Break; + end; + end; + UpdateGridFromArray; + db.SaveRecordArray('listKandinsky', listKandinsky); +end; + +procedure TfrOBS.DelNotify(aPort: integer); +var + I, j: integer; +begin + // Ищем в обратном порядке для безопасного удаления + for I := High(listNotify) downto 0 do + begin + if listNotify[I].port = aPort then + begin + // Сдвигаем элементы массива + for j := I to High(listNotify) - 1 do + listNotify[j] := listNotify[j + 1]; + // Уменьшаем размер массива + SetLength(listNotify, Length(listNotify) - 1); + // Выходим после первого найденного совпадения (предполагаем уникальность портов) + Break; + end; + end; + + UpdateGridFromArray; + db.SaveRecordArray('listNotify', listNotify); +end; + +procedure TfrOBS.UpdateGridFromArray; +var + I, rowIndex: integer; +begin + sgWebChats.BeginUpdate; + try + sgWebChats.RowCount := 0; // Сбрасываем строки + + rowIndex := 0; // Отдельный счетчик для строк сетки + + // listChats + for I := 0 to High(listChats) do + begin + sgWebChats.RowCount := rowIndex + 1; + sgWebChats.Cells[0, rowIndex] := inttostr(listChats[I].port); + sgWebChats.Cells[1, rowIndex] := 'Чат'; + sgWebChats.Cells[2, rowIndex] := 'http://127.0.0.1:' + inttostr(listChats[I].port); + Inc(rowIndex); // Увеличиваем счетчик строк + end; + + // listNotify + for I := 0 to High(listNotify) do + begin + sgWebChats.RowCount := rowIndex + 1; + sgWebChats.Cells[0, rowIndex] := inttostr(listNotify[I].port); + sgWebChats.Cells[1, rowIndex] := 'Оповещение'; + sgWebChats.Cells[2, rowIndex] := 'http://127.0.0.1:' + inttostr(listNotify[I].port); + Inc(rowIndex); // Увеличиваем счетчик строк + end; + + // listKandinsky + for I := 0 to High(listKandinsky) do + begin + sgWebChats.RowCount := rowIndex + 1; + sgWebChats.Cells[0, rowIndex] := inttostr(listKandinsky[I].port); + sgWebChats.Cells[1, rowIndex] := 'Kandinsky'; + sgWebChats.Cells[2, rowIndex] := 'http://127.0.0.1:' + inttostr(listKandinsky[I].port); + Inc(rowIndex); // Увеличиваем счетчик строк + end; + finally + sgWebChats.EndUpdate; + end; +end; + end. diff --git a/fSimpleGrid.fmx b/fSimpleGrid.fmx index 712d104..eb6bffb 100644 --- a/fSimpleGrid.fmx +++ b/fSimpleGrid.fmx @@ -9,7 +9,7 @@ object frSimpleGrid: TfrSimpleGrid Size.Width = 339.000000000000000000 Size.Height = 149.000000000000000000 Size.PlatformDefault = False - TabOrder = 45 + TabOrder = 44 RowCount = 0 Options = [ColumnResize, ColumnMove, ColLines, RowLines, Tabs, Header, HeaderClick, AutoDisplacement] OnCellClick = sgCellClick diff --git a/fSimpleGrid.pas b/fSimpleGrid.pas index 46fb189..2f275be 100644 --- a/fSimpleGrid.pas +++ b/fSimpleGrid.pas @@ -127,7 +127,7 @@ var begin sg.BeginUpdate; try - sg.RowCount := 1; // Сбрасываем строки (оставляем только заголовки) + sg.RowCount := 0; // Сбрасываем строки (оставляем только заголовки) for i := 0 to High(FMyRecord) do begin diff --git a/uCreateChat.fmx b/uCreateChat.fmx index 5879ef5..8134c75 100644 --- a/uCreateChat.fmx +++ b/uCreateChat.fmx @@ -24,28 +24,34 @@ object fCreateChat: TfCreateChat Size.Height = 251.000000000000000000 Size.PlatformDefault = False inherited ccbStyleBorderColor: TColorComboBox - TabOrder = 35 - end - inherited cpStyleBlockColor: TColorPanel - TabOrder = 7 + TabOrder = 33 end inherited Label40: TLabel TabOrder = 8 end inherited Label42: TLabel - TabOrder = 36 + TabOrder = 35 end inherited Label44: TLabel - TabOrder = 39 + TabOrder = 38 end inherited Label48: TLabel - TabOrder = 41 + TabOrder = 40 + end + inherited sbStyleBlockBorderSize: TSpinBox + TabOrder = 37 end inherited sbStyleBlockPadding: TSpinBox TabOrder = 46 end + inherited Label1: TLabel + TabOrder = 34 + end inherited ccbBColor: TColorComboBox - OnChange = nil + TabOrder = 36 + end + inherited btnChangeBGColor: TButton + TabOrder = 39 end end end @@ -63,21 +69,8 @@ object fCreateChat: TfCreateChat Size.Width = 240.000000000000000000 Size.Height = 125.000000000000000000 Size.PlatformDefault = False - inherited Label41: TLabel - TabOrder = 8 - end - inherited sbFontSize: TSpinBox - OnChange = nil - end - inherited ccbFontColor: TColorComboBox - TabOrder = 38 - OnChange = nil - end - inherited Label49: TLabel - TabOrder = 37 - end - inherited cbFontStyleDefault: TComboBox - OnChange = nil + inherited Label46: TLabel + TabOrder = 39 end end end @@ -141,7 +134,7 @@ object fCreateChat: TfCreateChat Size.Width = 112.000000000000000000 Size.Height = 19.000000000000000000 Size.PlatformDefault = False - TabOrder = 38 + TabOrder = 37 Text = #1042#1077#1095#1085#1086 end object sbWebServerPort: TSpinBox @@ -180,5 +173,6 @@ object fCreateChat: TfCreateChat TabOrder = 4 Text = #1057#1086#1079#1076#1072#1090#1100' '#1095#1072#1090 TextSettings.Trimming = None + OnClick = btnCreateWebChatClick end end diff --git a/uCreateChat.pas b/uCreateChat.pas index f0e72a7..cbca45b 100644 --- a/uCreateChat.pas +++ b/uCreateChat.pas @@ -7,7 +7,7 @@ uses 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; + FMX.Edit, FMX.EditBox, StrUtils, uRecords; type TfCreateChat = class(TForm) @@ -27,8 +27,10 @@ type btnWebChatTest: TButton; btnCreateWebChat: TButton; procedure FormCreate(Sender: TObject); + procedure btnCreateWebChatClick(Sender: TObject); private { Private declarations } + function GetColorFromColorPanel(aColor: TAlphaColor): string; public { Public declarations } end; @@ -42,6 +44,49 @@ 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.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); + + TTW_Bot.frOBS1.AddChat(OBSChat); + close; +end; + procedure TfCreateChat.FormCreate(Sender: TObject); procedure LoadFontList; var diff --git a/uCreateNotify.fmx b/uCreateNotify.fmx index 8259811..21bb139 100644 --- a/uCreateNotify.fmx +++ b/uCreateNotify.fmx @@ -73,26 +73,20 @@ object fCreateNotify: TfCreateNotify Size.Width = 311.000000000000000000 Size.Height = 258.000000000000000000 Size.PlatformDefault = False - inherited ccbStyleBorderColor: TColorComboBox - TabOrder = 37 - end - inherited Label42: TLabel - TabOrder = 36 - end inherited Label44: TLabel - TabOrder = 39 + TabOrder = 38 end inherited Label48: TLabel - TabOrder = 41 + TabOrder = 40 end - inherited sbStyleBlockBorderSize: TSpinBox - TabOrder = 42 - end - inherited sbStyleBlockPadding: TSpinBox - TabOrder = 44 + inherited Label1: TLabel + TabOrder = 35 end inherited ccbBColor: TColorComboBox - OnChange = nil + TabOrder = 39 + end + inherited btnChangeBGColor: TButton + TabOrder = 41 end end object GroupBox10: TGroupBox @@ -145,7 +139,7 @@ object fCreateNotify: TfCreateNotify Position.X = 8.000000000000000000 Position.Y = 135.000000000000000000 Text = #1057#1086#1073#1099#1090#1080#1077 - TabOrder = 68 + TabOrder = 60 end object cbEventsType: TComboBox Items.Strings = ( @@ -159,17 +153,17 @@ object fCreateNotify: TfCreateNotify Size.Width = 192.000000000000000000 Size.Height = 22.000000000000000000 Size.PlatformDefault = False - TabOrder = 69 + TabOrder = 61 end object Label3: TLabel Position.X = 8.000000000000000000 Position.Y = 190.000000000000000000 Text = #1059#1089#1083#1086#1074#1080#1077' '#1089#1091#1084#1084#1099 - TabOrder = 70 + TabOrder = 62 end object edtIF: TEdit Touch.InteractiveGestures = [LongTap, DoubleTap] - TabOrder = 71 + TabOrder = 63 Position.X = 8.000000000000000000 Position.Y = 215.000000000000000000 Size.Width = 192.000000000000000000 @@ -186,6 +180,7 @@ object fCreateNotify: TfCreateNotify TabOrder = 64 Text = #1057#1086#1079#1076#1072#1090#1100' '#1086#1087#1086#1074#1077#1097#1077#1085#1080#1077 TextSettings.Trimming = None + OnClick = btnCreateEventClick end object btnESTest: TButton Position.X = 596.000000000000000000 @@ -222,21 +217,8 @@ object fCreateNotify: TfCreateNotify Size.Width = 241.000000000000000000 Size.Height = 115.000000000000000000 Size.PlatformDefault = False - inherited Label41: TLabel - TabOrder = 8 - end - inherited sbFontSize: TSpinBox - OnChange = nil - end - inherited ccbFontColor: TColorComboBox - TabOrder = 38 - OnChange = nil - end - inherited Label49: TLabel - TabOrder = 37 - end - inherited cbFontStyleDefault: TComboBox - OnChange = nil + inherited Label46: TLabel + TabOrder = 39 end end end @@ -250,29 +232,19 @@ object fCreateNotify: TfCreateNotify Size.Width = 261.000000000000000000 Size.Height = 167.000000000000000000 Size.PlatformDefault = False - Text = #1047#1072#1075#1086#1083#1086#1074#1086#1082 + Text = #1057#1086#1086#1073#1097#1077#1085#1080#1077 TabOrder = 65 inline frFontSettings3: TfrFontSettings Align = Client Size.Width = 241.000000000000000000 Size.Height = 115.000000000000000000 Size.PlatformDefault = False - inherited Label41: TLabel - TabOrder = 8 - end - inherited sbFontSize: TSpinBox - OnChange = nil - end inherited ccbFontColor: TColorComboBox TabOrder = 37 - OnChange = nil end inherited Label49: TLabel TabOrder = 36 end - inherited cbFontStyleDefault: TComboBox - OnChange = nil - end inherited Label46: TLabel TabOrder = 38 end diff --git a/uCreateNotify.pas b/uCreateNotify.pas index 4eed545..16a8d74 100644 --- a/uCreateNotify.pas +++ b/uCreateNotify.pas @@ -6,7 +6,7 @@ uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, fFontSettings, fColorSettings, FMX.StdCtrls, FMX.Edit, FMX.Controls.Presentation, - FMX.ListBox, FMX.EditBox, FMX.SpinBox, FMX.Colors; + FMX.ListBox, FMX.EditBox, FMX.SpinBox, FMX.Colors,uRecords; type TfCreateNotify = class(TForm) @@ -35,8 +35,10 @@ type frFontSettings3: TfrFontSettings; edtESMessage: TEdit; procedure FormCreate(Sender: TObject); + procedure btnCreateEventClick(Sender: TObject); private { Private declarations } + function GetColorFromColorPanel(aColor: TAlphaColor): string; public { Public declarations } end; @@ -50,6 +52,61 @@ uses uGeneral; {$R *.fmx} +function TfCreateNotify.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 TfCreateNotify.btnCreateEventClick(Sender: TObject); +var + OBSNotify: TOBSNotify; +begin + with OBSNotify do + begin + Picture:=edtESImage.Text; + Sound:=edtESSound.Text; + + ColorBlock:= GetColorFromColorPanel(frColorSettings1.cpStyleBlockColor.Color); + SolidBorder:=round(frColorSettings1.sbStyleBlockBorderSize.Value); + Paddings:=round(frColorSettings1.sbStyleBlockPadding.Value); + ColorBorder:=frColorSettings1.ccbStyleBorderColor.ItemIndex; + ColorBackground:=frColorSettings1.ccbBColor.ItemIndex; + + HeaderText:=edtESTitle.text; + HeaderColorFont:=frFontSettings2.ccbFontColor.ItemIndex; + HeaderSizeFont:=round(frFontSettings2.sbFontSize.Value); + HeaderStyleFont:=frFontSettings2.cbFontStyleDefault.ItemIndex; + + MessText:=edtESMessage.text; + MessColorFont:=frFontSettings3.ccbFontColor.ItemIndex; + MessSizeFont:=round(frFontSettings3.sbFontSize.Value); + MessStyleFont:=frFontSettings3.cbFontStyleDefault.ItemIndex; + + TimeMess:=round(sbTimeMsg.Value); + TypeEvent:=cbEventsType.ItemIndex; + TypeEdit:=edtIF.Text; + Port:=round(sbWebServerPort.Value);; + end; + + TTW_Bot.frOBS1.AddNotify(OBSNotify); + close; +end; + procedure TfCreateNotify.FormCreate(Sender: TObject); var i: Integer; diff --git a/uDataBase.pas b/uDataBase.pas index 739da06..24517aa 100644 --- a/uDataBase.pas +++ b/uDataBase.pas @@ -498,7 +498,11 @@ var Value: TValue; Param: TFDParam; begin - if Length(Items) = 0 then Exit; + if Length(Items) = 0 then + begin + FConnection.ExecSQL('DELETE FROM ' + TableName); + exit; + end; EnsureTableForRecord(TableName, TypeInfo(T)); diff --git a/uGeneral.fmx b/uGeneral.fmx index b309a87..422512b 100644 --- a/uGeneral.fmx +++ b/uGeneral.fmx @@ -17,7 +17,7 @@ object TTW_Bot: TTTW_Bot Size.Width = 970.000000000000000000 Size.Height = 744.000000000000000000 Size.PlatformDefault = False - TabIndex = 2 + TabIndex = 4 TabOrder = 0 TabPosition = PlatformDefault Sizes = ( @@ -78,6 +78,9 @@ object TTW_Bot: TTTW_Bot ImageIndex = 10 TabOrder = 33 end + inherited edtBotTokenStreamer: TEdit + TabOrder = 34 + end inherited Label53: TLabel TabOrder = 36 end @@ -188,7 +191,7 @@ object TTW_Bot: TTTW_Bot item end> TextSettings.Trimming = None - IsSelected = True + IsSelected = False ImageIndex = 13 Size.Width = 78.000000000000000000 Size.Height = 26.000000000000000000 @@ -279,8 +282,14 @@ object TTW_Bot: TTTW_Bot Viewport.Width = 207.000000000000000000 Viewport.Height = 116.000000000000000000 end - inherited Label4: TLabel - TabOrder = 40 + inherited btnRandomAdd: TButton + TabOrder = 34 + end + inherited btnRandomDel: TButton + TabOrder = 35 + end + inherited btnRmGroup: TButton + TabOrder = 37 end inherited Label5: TLabel TabOrder = 43 @@ -423,7 +432,7 @@ object TTW_Bot: TTTW_Bot item end> TextSettings.Trimming = None - IsSelected = False + IsSelected = True ImageIndex = 10 Size.Width = 136.000000000000000000 Size.Height = 26.000000000000000000 @@ -453,7 +462,6 @@ object TTW_Bot: TTTW_Bot Size.Width = 94.000000000000000000 Size.PlatformDefault = False TabOrder = 2 - OnClick = frChatOBS1btnCreateChatClick end inherited btnDeleteeChat: TButton Anchors = [akTop, akRight] @@ -461,21 +469,20 @@ object TTW_Bot: TTTW_Bot ImageIndex = 4 Position.X = 882.000000000000000000 TabOrder = 3 + OnClick = frOBS1btnDeleteeChatClick end inherited Label1: TLabel - TabOrder = 7 + TabOrder = 8 end inherited btnCreateOBSNotify: TButton Images = ImageList1 ImageIndex = 24 Position.X = 110.000000000000000000 - OnClick = frOBS1btnCreateOBSNotifyClick end inherited btnCreateOBSKandinsky: TButton Images = ImageList1 ImageIndex = 5 Position.X = 264.000000000000000000 - OnClick = frOBS1btnCreateOBSKandinskyClick end object btnCreateChat: TButton Images = ImageList1 @@ -488,7 +495,6 @@ object TTW_Bot: TTTW_Bot TabOrder = 1 Text = #1057#1086#1079#1076#1072#1090#1100' '#1086#1087#1086#1074#1077#1097#1077#1085#1080#1077 TextSettings.Trimming = None - OnClick = frChatOBS1btnCreateChatClick end end end @@ -553,6 +559,7 @@ object TTW_Bot: TTTW_Bot Text = '' end inherited OpenDialog1: TOpenDialog + Left = 472 Top = 32 end end @@ -653,19 +660,28 @@ object TTW_Bot: TTTW_Bot end end inherited GroupBox17: TGroupBox + inherited edtCounterTrigger: TEdit + TabOrder = 38 + end + inherited edtCounterCount: TEdit + TabOrder = 37 + end inherited btnCounterAdd: TButton Images = ImageList1 ImageIndex = 0 + TabOrder = 39 end inherited btnCounterDelete: TButton Images = ImageList1 ImageIndex = 4 + TabOrder = 40 end inherited btnCounterP: TButton Images = ImageList1 ImageIndex = 0 Position.X = 416.000000000000000000 Size.Width = 22.000000000000000000 + TabOrder = 42 Text = '' end inherited btnCounterM: TButton @@ -673,13 +689,16 @@ object TTW_Bot: TTTW_Bot ImageIndex = 12 Position.X = 449.000000000000000000 Size.Width = 22.000000000000000000 + TabOrder = 43 Text = '' end inherited btnCounterEdit: TButton Images = ImageList1 ImageIndex = 3 + TabOrder = 44 end inherited sgCounter: TStringGrid + TabOrder = 45 Viewport.Width = 463.000000000000000000 Viewport.Height = 121.000000000000000000 inherited scCounterTrigger: TStringColumn diff --git a/uGeneral.pas b/uGeneral.pas index da94006..3e6489b 100644 --- a/uGeneral.pas +++ b/uGeneral.pas @@ -8,7 +8,7 @@ uses FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.TabControl, FMX.Controls.Presentation, FMX.StdCtrls, System.ImageList, FMX.ImgList, FMX.Styles, ShellAPI, StrUtils, - fSettings, fAI, fNotify, fAutoActions, FMX.ListBox, fLog, uRecords, + fSettings, fAI, fNotify, fAutoActions, FMX.ListBox, fLog, uRecords, System.IOUtils, fCommands, uDataBase, FMX.Edit, FMX.Colors, FMX.SpinBox, windows, System.Skia, FMX.Skia, uCreateChat, uCreateNotify, fOBS; @@ -57,11 +57,9 @@ type procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton3Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); - procedure frChatOBS1btnCreateChatClick(Sender: TObject); - procedure frOBS1btnCreateOBSNotifyClick(Sender: TObject); - procedure frOBS1btnCreateOBSKandinskyClick(Sender: TObject); procedure frSettings1btnDAStartClick(Sender: TObject); procedure frCommands1btnRandAddClick(Sender: TObject); + procedure frOBS1btnDeleteeChatClick(Sender: TObject); private { Private declarations } procedure ReadDB(); @@ -136,57 +134,34 @@ begin db := TSettingsDatabase.Create(myConst.DBPath); ReadDB; - frCommands1.frsgSounds.ObjectRecord:=frCommands1.listSounds; - frCommands1.frsgSounds.TableName:='listSounds'; + frCommands1.frsgSounds.ObjectRecord := frCommands1.listSounds; + frCommands1.frsgSounds.TableName := 'listSounds'; frCommands1.frsgSounds.UpdateGrid; - frCommands1.frsgFiles.ObjectRecord:=frCommands1.listFiles; - frCommands1.frsgFiles.TableName:='listFiles'; + frCommands1.frsgFiles.ObjectRecord := frCommands1.listFiles; + frCommands1.frsgFiles.TableName := 'listFiles'; frCommands1.frsgFiles.UpdateGrid; - frCommands1.frsgNeiro.ObjectRecord:=frCommands1.listNeiro; - frCommands1.frsgNeiro.TableName:='listNeiro'; + frCommands1.frsgNeiro.ObjectRecord := frCommands1.listNeiro; + frCommands1.frsgNeiro.TableName := 'listNeiro'; frCommands1.frsgNeiro.UpdateGrid; - - for Path in TDirectory.GetFiles(myConst.stlPath) do cbTheme.Items.Add(ExtractFileName(Path)); cbTheme.ItemIndex := strtoint(db.ReadSetting('cbTheme', '-1')); end; -procedure TTTW_Bot.frChatOBS1btnCreateChatClick(Sender: TObject); -begin -fCreateChat.Show; -end; - procedure TTTW_Bot.frCommands1btnRandAddClick(Sender: TObject); begin frCommands1.btnRandAddClick(Sender); end; -procedure TTTW_Bot.frOBS1btnCreateOBSKandinskyClick(Sender: TObject); -var dport:integer; - I: Integer; +procedure TTTW_Bot.frOBS1btnDeleteeChatClick(Sender: TObject); begin -dport:=8080; - for I := 0 to frOBS1.sgWebChats.RowCount-1 do - begin - if strtoint(frOBS1.sgWebChats.Cells[0,i]) >= dport then - dport:=strtoint(frOBS1.sgWebChats.Cells[0,i])+1; - end; - frOBS1.sgWebChats.RowCount:=frOBS1.sgWebChats.RowCount+1; - frOBS1.sgWebChats.Cells[0,frOBS1.sgWebChats.RowCount-1]:=inttostr(dport); - frOBS1.sgWebChats.Cells[1,frOBS1.sgWebChats.RowCount-1]:='Kandinsky'; - frOBS1.sgWebChats.Cells[2,frOBS1.sgWebChats.RowCount-1]:='http://127.0.0.1:'+inttostr(dport); + frOBS1.btnDeleteeChatClick(Sender); end; -procedure TTTW_Bot.frOBS1btnCreateOBSNotifyClick(Sender: TObject); -begin -fCreateNotify.Show; -end; - procedure TTTW_Bot.frSettings1btnDAStartClick(Sender: TObject); begin frSettings1.btnDAStartClick(Sender); @@ -269,18 +244,19 @@ var // Загрузка данных в гриды команд procedure LoadGridsData; begin - DB.LoadRecordArray('RandomCounters', frCommands1.RandomCounters); - DB.LoadRecordArray('listSounds', frCommands1.listSounds); - DB.LoadRecordArray('listFiles', frCommands1.listFiles); - DB.LoadRecordArray('listNeiro', frCommands1.listNeiro); - DB.LoadRecordArray('listCommands', frCommands1.listCommands); + db.LoadRecordArray('RandomCounters', + frCommands1.RandomCounters); + db.LoadRecordArray('listSounds', frCommands1.listSounds); + db.LoadRecordArray('listFiles', frCommands1.listFiles); + db.LoadRecordArray('listNeiro', frCommands1.listNeiro); + db.LoadRecordArray('listCommands', frCommands1.listCommands); + frCommands1.UpdateGridFromArray; + + db.LoadRecordArray('listChats', frOBS1.listChats); + db.LoadRecordArray('listNotify', frOBS1.listNotify); + db.LoadRecordArray('listKandinsky', frOBS1.listKandinsky); + frOBS1.UpdateGridFromArray; - frCommands1.UpdateGridFromArray; - { db.LoadGridFromTable('sgRandomInt', frCommands1.sgRandomInt); - db.LoadGridFromTable('sgCommands', frCommands1.sgCommands); - db.LoadGridFromTable('sgSAFiles', frCommands1.sgSAFiles); - db.LoadGridFromTable('sgTFiles', frCommands1.sgTFiles); - db.LoadGridFromTable('sgAIGen', frCommands1.sgAIGen); } end; // Загрузка списка групп @@ -371,55 +347,56 @@ var ii: Integer; // Настройки GigaChat - procedure SetupGigaChatSettings; - begin - frAI1.rbGC.IsChecked := True; - frAI1.Label45.text := 'ClientID'; - frAI1.Label47.text := 'Autorization Code'; - frAI1.Label1.Visible := False; - frAI1.edtAIP2.Visible := True; - frAI1.edtAIP2.Password := True; - frAI1.edtAIP3.Visible := False; - frAI1.cbOllama.Visible := False; - end; + procedure SetupGigaChatSettings; + begin + frAI1.rbGC.IsChecked := True; + frAI1.Label45.text := 'ClientID'; + frAI1.Label47.text := 'Autorization Code'; + frAI1.Label1.Visible := False; + frAI1.edtAIP2.Visible := True; + frAI1.edtAIP2.Password := True; + frAI1.edtAIP3.Visible := False; + frAI1.cbOllama.Visible := False; + end; -// Настройки DeepSeek - procedure SetupDeepSeekSettings; - begin - frAI1.rbDS.IsChecked := True; - frAI1.Label45.text := 'API Token'; - frAI1.Label47.text := ''; - frAI1.Label1.Visible := False; - frAI1.edtAIP2.Visible := False; - frAI1.edtAIP3.Visible := False; - frAI1.cbOllama.Visible := False; - end; + // Настройки DeepSeek + procedure SetupDeepSeekSettings; + begin + frAI1.rbDS.IsChecked := True; + frAI1.Label45.text := 'API Token'; + frAI1.Label47.text := ''; + frAI1.Label1.Visible := False; + frAI1.edtAIP2.Visible := False; + frAI1.edtAIP3.Visible := False; + frAI1.cbOllama.Visible := False; + end; -// Настройки ChatGPT - procedure SetupChatGPTSettings; - begin - frAI1.rbCG.IsChecked := True; - frAI1.Label45.text := 'API Token'; - frAI1.Label47.text := ''; - frAI1.Label1.Visible := False; - frAI1.edtAIP2.Visible := False; - frAI1.edtAIP3.Visible := False; - frAI1.cbOllama.Visible := False; - end; + // Настройки ChatGPT + procedure SetupChatGPTSettings; + begin + frAI1.rbCG.IsChecked := True; + frAI1.Label45.text := 'API Token'; + frAI1.Label47.text := ''; + frAI1.Label1.Visible := False; + frAI1.edtAIP2.Visible := False; + frAI1.edtAIP3.Visible := False; + frAI1.cbOllama.Visible := False; + end; + + // Настройки кастомного ИИ + procedure SetupCustomAISettings; + begin + frAI1.RBCustom.IsChecked := True; + frAI1.Label45.text := 'API Token'; + frAI1.Label47.text := 'URL'; + frAI1.Label1.Visible := True; + frAI1.edtAIP2.Visible := True; + frAI1.edtAIP2.Password := False; + frAI1.edtAIP3.Visible := True; + frAI1.cbOllama.Visible := True; + frAI1.cbOllama.IsChecked := db.ReadSetting(frAI1.cbOllama.Name) = '1'; + end; -// Настройки кастомного ИИ - procedure SetupCustomAISettings; - begin - frAI1.RBCustom.IsChecked := True; - frAI1.Label45.text := 'API Token'; - frAI1.Label47.text := 'URL'; - frAI1.Label1.Visible := True; - frAI1.edtAIP2.Visible := True; - frAI1.edtAIP2.Password := False; - frAI1.edtAIP3.Visible := True; - frAI1.cbOllama.Visible := True; - frAI1.cbOllama.IsChecked := db.ReadSetting(frAI1.cbOllama.Name) = '1'; - end; begin for I := 0 to frAI1.ComponentCount - 1 do begin @@ -445,8 +422,6 @@ var frSettings1.init; end; - - // Загрузка гридов автоматических действий procedure LoadAutoActionsGrids; begin @@ -461,7 +436,6 @@ begin LoadGroupNames; LoadEncryptedConfig; - LoadNotifySettings; LoadAISettings; LoadAutoActionsGrids; diff --git a/uRecords.pas b/uRecords.pas index c9e8512..a67ecb8 100644 --- a/uRecords.pas +++ b/uRecords.pas @@ -2,21 +2,67 @@ unit uRecords; interface +type + TOBSKandinsky = record + port: integer; + end; + +type + TOBSNotify = record + Picture: string; + Sound: string; + + ColorBlock: string; + SolidBorder: integer; + Paddings: integer; + ColorBorder: integer; + ColorBackground: integer; + + HeaderText: string; + HeaderColorFont: integer; + HeaderSizeFont: integer; + HeaderStyleFont: integer; + + MessText: string; + MessColorFont: integer; + MessSizeFont: integer; + MessStyleFont: integer; + + TimeMess: integer; + TypeEvent: integer; + TypeEdit: string; + port: integer; + + end; + +type + TOBSChat = record + ColorBlock: string; + ColorBorder: integer; + ColorBackground: integer; + ColorFont: integer; + SolidBorder: integer; + Paddings: integer; + SizeFont: integer; + MaxCountMess: integer; + TimeMess: integer; + port: integer; + StyleFont: integer; + end; type TRandomCounters = record rndName: string; - Ot: Integer; - ToValue: Integer; + Ot: integer; + ToValue: integer; end; - type +type TListCommands = record R1: string; R2: string; end; - type TConst = record GeneralPath: string; @@ -398,9 +444,6 @@ type DA_URL: string; end; - - implementation - end.