unit fOBS; interface uses 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, uRecords; type TfrOBS = class(TFrame) sgWebChats: TStringGrid; btnCreateOBSChat: TButton; btnDeleteeChat: TButton; Label1: TLabel; IntegerColumn1: TIntegerColumn; StringColumn1: TStringColumn; StringColumn2: TStringColumn; btnCreateOBSNotify: TButton; btnCreateOBSKandinsky: 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); private { Private declarations } public { Public declarations } listChats: TArray; listNotify: TArray; listKandinsky: TArray; procedure UpdateGridFromArray; procedure AddChat(newRecord: TOBSChat); procedure EdtChat(newRecord: TOBSChat); procedure DelChat(aPort: Integer); procedure AddNotify(newRecord: TOBSNotify); procedure EdtNotify(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.isEdit:=false; 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.isEdit:=false; 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.EdtChat(newRecord: TOBSChat); var rChat: TOBSChat; SavedColor: TAlphaColor; begin rChat:= newRecord; if TryStrToUInt('$' + rChat.ColorBlock, Cardinal(SavedColor)) then fCreateChat.frChatSettings1.cpStyleBlockColor.Color := SavedColor else fCreateChat.frChatSettings1.cpStyleBlockColor.Color := TAlphaColorRec.Black; fCreateChat.frChatSettings1.ccbStyleBorderColor.ItemIndex := rChat.ColorBorder; fCreateChat.frChatSettings1.ccbBColor.ItemIndex := rChat.ColorBackground; fCreateChat.frChatSettings1.sbStyleBlockBorderSize.Value := rChat.SolidBorder; fCreateChat.frChatSettings1.sbStyleBlockPadding.Value := rChat.Paddings; fCreateChat.frFontSettings1.ccbFontColor.ItemIndex := rChat.ColorFont; fCreateChat.frFontSettings1.sbFontSize.Value := rChat.SizeFont; fCreateChat.frFontSettings1.cbFontStyleDefault.ItemIndex := rChat.StyleFont; fCreateChat.sbTimeMsg.Value := rChat.TimeMess; fCreateChat.sbMaxMsg.Value := rChat.MaxCountMess; fCreateChat.sbWebServerPort.Value := rChat.port; fCreateChat.Show; end; procedure TfrOBS.EdtNotify(newRecord: TOBSNotify); var OBSNotify: TOBSNotify; SavedColor: TAlphaColor; begin OBSNotify:=newRecord; with OBSNotify do begin fCreateNotify.edtESImage.Text := Picture; fCreateNotify.edtESSound.Text := Sound; if TryStrToUInt('$' + ColorBlock, Cardinal(SavedColor)) then fCreateNotify.frColorSettings1.cpStyleBlockColor.Color := SavedColor else fCreateNotify.frColorSettings1.cpStyleBlockColor.Color := TAlphaColorRec.Black; // fCreateNotify. ColorBlock:= GetColorFromColorPanel(frColorSettings1.cpStyleBlockColor.Color); fCreateNotify.frColorSettings1.sbStyleBlockBorderSize.Value := SolidBorder; fCreateNotify.frColorSettings1.sbStyleBlockPadding.Value := Paddings; fCreateNotify.frColorSettings1.ccbStyleBorderColor.ItemIndex := ColorBorder; fCreateNotify.frColorSettings1.ccbBColor.ItemIndex := ColorBackground; fCreateNotify.edtESTitle.Text := HeaderText; fCreateNotify.frFontSettings2.ccbFontColor.ItemIndex := HeaderColorFont; fCreateNotify.frFontSettings2.sbFontSize.Value := HeaderSizeFont; fCreateNotify.frFontSettings2.cbFontStyleDefault.ItemIndex := HeaderStyleFont; fCreateNotify.edtESMessage.Text := MessText; fCreateNotify.frFontSettings3.ccbFontColor.ItemIndex := MessColorFont; fCreateNotify.frFontSettings3.sbFontSize.Value := MessSizeFont; fCreateNotify.frFontSettings3.cbFontStyleDefault.ItemIndex := MessStyleFont; fCreateNotify.sbTimeMsg.Value := TimeMess; fCreateNotify.cbEventsType.ItemIndex := TypeEvent; fCreateNotify.edtIF.Text := TypeEdit; fCreateNotify.sbWebServerPort.Value := port; end; end; procedure TfrOBS.sgWebChatsCellDblClick(const Column: TColumn; const Row: Integer); begin if sgWebChats.Cells[1,row] = 'Оповещение' then begin fCreateNotify.isEdit:=true; fCreateNotify.Show; end; if sgWebChats.Cells[1,row] = 'Чат' then begin fCreateChat.isEdit:=true; fCreateChat.Show; end; 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.