698 lines
20 KiB
ObjectPascal
698 lines
20 KiB
ObjectPascal
unit fOBS;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils, System.Types, System.UITypes, System.Classes, uCustomEmoties,
|
|
System.Variants, uWebServerChat, 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,
|
|
System.Generics.Defaults, fFontSettings;
|
|
|
|
type
|
|
TChatWebServers = record
|
|
port: integer;
|
|
MaxMsg: integer;
|
|
TimeMsg: integer;
|
|
Freez: boolean;
|
|
StyleBorderColor: string;
|
|
StyleBlockColor: string;
|
|
StyleBlockBorderSize: integer;
|
|
StyleBlockPadding: integer;
|
|
FontStyleDefault: string;
|
|
FontColor: string;
|
|
BColor: string;
|
|
FontSize: integer;
|
|
WebServerChat: TTTW_Chat;
|
|
end;
|
|
|
|
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 }
|
|
|
|
function checkBttv(aMsg: string): string;
|
|
function ReplaceEmotesInMessage(const MessageText,
|
|
EmotesString: string): string;
|
|
function FindEmoteByID(const ID: string): TEmotes;
|
|
function GetBadgesHTML(Badges: string): string;
|
|
public
|
|
{ Public declarations }
|
|
listChats: TArray<TOBSChat>;
|
|
listNotify: TArray<TOBSNotify>;
|
|
listKandinsky: TArray<TOBSKandinsky>;
|
|
|
|
BTTV: TBTTV;
|
|
m7tv: t7tv;
|
|
ChatBadges: Tlist<TChatBadge>;
|
|
ChatEmotes: Tlist<TEmotes>;
|
|
ChatWebServers: Tlist<TChatWebServers>;
|
|
procedure MsgToWebServer(const aRecord: TTwitchChatMessage);
|
|
procedure CreateWebChat(chatSettings: TOBSChat);
|
|
procedure UpdateGridFromArray;
|
|
procedure AddChat(newRecord: TOBSChat);
|
|
procedure EdtChat(newRecord: TOBSChat; oldPort: integer);
|
|
procedure DelChat(aPort: integer);
|
|
|
|
procedure AddNotify(newRecord: TOBSNotify);
|
|
procedure EdtNotify(newRecord: TOBSNotify; oldPort: integer);
|
|
procedure DelNotify(aPort: integer);
|
|
|
|
procedure AddKandinsky(newRecord: TOBSKandinsky);
|
|
procedure DelKandinsky(aPort: integer);
|
|
|
|
end;
|
|
|
|
implementation
|
|
|
|
{$R *.fmx}
|
|
|
|
uses uGeneral, uCreateChat, uCreateNotify;
|
|
|
|
{ TfrOBS }
|
|
|
|
function TfrOBS.checkBttv(aMsg: string): string;
|
|
var
|
|
Words: tstringlist;
|
|
i: integer;
|
|
CurrentWord, Url: string;
|
|
begin
|
|
Words := tstringlist.Create;
|
|
try
|
|
// Ðàçáèâàåì ñòðîêó íà ñëîâà ïî ïðîáåëàì
|
|
Words.Delimiter := ' ';
|
|
Words.StrictDelimiter := True; // Èãíîðèðîâàòü ïîâòîðÿþùèåñÿ ïðîáåëû
|
|
Words.DelimitedText := aMsg;
|
|
|
|
// Îáðàáîòêà ñëîâ
|
|
for i := 0 to Words.Count - 1 do
|
|
begin
|
|
CurrentWord := Words[i];
|
|
Url := BTTV.generateURL(CurrentWord);
|
|
if Url = '' then
|
|
Url := m7tv.generateURL(CurrentWord);
|
|
if Url <> '' then
|
|
Words[i] := Format('<img src="%s" width="18" height="18">', [Url]);
|
|
end;
|
|
|
|
// Ñîáèðàåì ðåçóëüòàò
|
|
result := Words.text;
|
|
finally
|
|
Words.Free;
|
|
end;
|
|
end;
|
|
|
|
function TfrOBS.FindEmoteByID(const ID: string): TEmotes;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result.ID := '';
|
|
if not Assigned(ChatEmotes) then
|
|
exit;
|
|
|
|
for i := 0 to ChatEmotes.Count - 1 do
|
|
if ChatEmotes[i].ID = ID then
|
|
begin
|
|
result := ChatEmotes[i];
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
function TfrOBS.ReplaceEmotesInMessage(const MessageText,
|
|
EmotesString: string): string;
|
|
type
|
|
TEmotePosition = record
|
|
StartPos: integer;
|
|
EndPos: integer;
|
|
ImageURL: string;
|
|
end;
|
|
var
|
|
Positions: Tlist<TEmotePosition>;
|
|
i, ColonPos: integer;
|
|
Parts, EmoteData, Ranges: tstringlist;
|
|
EmoteID, RangeStr: string;
|
|
StartPos, EndPos: integer;
|
|
Emote: TEmotes;
|
|
begin
|
|
result := MessageText;
|
|
if EmotesString.IsEmpty then
|
|
exit;
|
|
|
|
Parts := tstringlist.Create;
|
|
EmoteData := tstringlist.Create;
|
|
Ranges := tstringlist.Create;
|
|
Positions := Tlist<TEmotePosition>.Create;
|
|
try
|
|
Parts.Delimiter := '/';
|
|
Parts.StrictDelimiter := True;
|
|
Parts.DelimitedText := EmotesString;
|
|
|
|
for i := 0 to Parts.Count - 1 do
|
|
begin
|
|
ColonPos := Pos(':', Parts[i]);
|
|
if ColonPos = 0 then
|
|
Continue;
|
|
|
|
EmoteID := Copy(Parts[i], 1, ColonPos - 1);
|
|
RangeStr := Copy(Parts[i], ColonPos + 1, MaxInt);
|
|
|
|
Ranges.Clear;
|
|
Ranges.Delimiter := ',';
|
|
Ranges.StrictDelimiter := True;
|
|
Ranges.DelimitedText := RangeStr;
|
|
|
|
Emote := FindEmoteByID(EmoteID);
|
|
if Emote.ID = '' then
|
|
Continue;
|
|
|
|
for var j := 0 to Ranges.Count - 1 do
|
|
begin
|
|
EmoteData.Clear;
|
|
EmoteData.Delimiter := '-';
|
|
EmoteData.StrictDelimiter := True;
|
|
EmoteData.DelimitedText := Ranges[j];
|
|
if EmoteData.Count <> 2 then
|
|
Continue;
|
|
|
|
if TryStrToInt(EmoteData[0], StartPos) and
|
|
TryStrToInt(EmoteData[1], EndPos) then
|
|
begin
|
|
var
|
|
EmotePosition: TEmotePosition;
|
|
EmotePosition.StartPos := StartPos;
|
|
EmotePosition.EndPos := EndPos;
|
|
EmotePosition.ImageURL := Emote.images.Url1x;
|
|
|
|
Positions.Add(EmotePosition);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Positions.Sort(TComparer<TEmotePosition>.Construct(
|
|
function(const Left, Right: TEmotePosition): integer
|
|
begin
|
|
result := Right.StartPos - Left.StartPos;
|
|
end));
|
|
|
|
var
|
|
SB := TStringBuilder.Create(MessageText);
|
|
try
|
|
for var Pos in Positions do
|
|
begin
|
|
if (Pos.StartPos < 0) or (Pos.EndPos >= SB.Length) or
|
|
(Pos.StartPos > Pos.EndPos) then
|
|
Continue;
|
|
|
|
var
|
|
Replacement := Format('<img src="%s" width="18" height="18">',
|
|
[Pos.ImageURL]);
|
|
|
|
SB.Remove(Pos.StartPos, Pos.EndPos - Pos.StartPos + 1);
|
|
SB.Insert(Pos.StartPos, Replacement);
|
|
end;
|
|
result := SB.ToString;
|
|
finally
|
|
SB.Free;
|
|
end;
|
|
finally
|
|
Parts.Free;
|
|
EmoteData.Free;
|
|
Ranges.Free;
|
|
Positions.Free;
|
|
end;
|
|
end;
|
|
|
|
function TfrOBS.GetBadgesHTML(Badges: string): string;
|
|
var
|
|
BadgeList: TArray<string>;
|
|
CodeParts: TArray<string>;
|
|
CurrentCode, SetId, VersionId: string;
|
|
Badge: TChatBadge;
|
|
Version: TBadgeVersion;
|
|
Found: boolean;
|
|
begin
|
|
// Ðàçáèâàåì ñòðîêó íà îòäåëüíûå áåéäæ-êîäû
|
|
BadgeList := Badges.Split([',']);
|
|
|
|
for CurrentCode in BadgeList do
|
|
begin
|
|
// Ðàçäåëÿåì SetId è VersionId
|
|
CodeParts := CurrentCode.Split(['/']);
|
|
if Length(CodeParts) <> 2 then
|
|
Continue;
|
|
|
|
SetId := CodeParts[0];
|
|
VersionId := CodeParts[1];
|
|
Found := false;
|
|
|
|
// Èùåì ñîîòâåòñòâóþùèé áåéäæ
|
|
for Badge in ChatBadges do
|
|
begin
|
|
if Badge.SetId = SetId then
|
|
begin
|
|
// Èùåì íóæíóþ âåðñèþ
|
|
for Version in Badge.Versions do
|
|
begin
|
|
if Version.ID = VersionId then
|
|
begin
|
|
// Ôîðìèðóåì HTML-òåã
|
|
result := result +
|
|
Format(' <img src="%s" width=18 height=18 alt="%s" title="%s">',
|
|
[Version.ImageUrl1x, Version.Title, Version.Description]);
|
|
Found := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
if Found then
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
// Åñëè íå íàøëè - äîáàâëÿåì çàãëóøêó
|
|
if not Found then
|
|
result := result + ' <img src="placeholder.png" width=18 height=18>';
|
|
end;
|
|
end;
|
|
|
|
procedure TfrOBS.MsgToWebServer(const aRecord: TTwitchChatMessage);
|
|
var
|
|
s: string;
|
|
ms: TStyleChat;
|
|
i: integer;
|
|
begin
|
|
s := checkBttv(aRecord.Message);
|
|
if aRecord.Emotes <> '' then
|
|
s := ReplaceEmotesInMessage(s, aRecord.Emotes);
|
|
|
|
ms.Nick := GetBadgesHTML(aRecord.Badges) + '<span class="nick" style="color:'
|
|
+ aRecord.Color + '">' + aRecord.DisplayName + '</span>';
|
|
ms.Context := '<span class="text">' + s + '</span>';
|
|
|
|
for i := 0 to ChatWebServers.Count - 1 do
|
|
begin
|
|
ms.FontColor := ChatWebServers[i].FontColor;
|
|
ms.FontSize := ChatWebServers[i].FontSize;
|
|
ms.FontFamily := '''' + ChatWebServers[i].FontStyleDefault + ''';';
|
|
ms.FontFamily := StringReplace(ms.FontFamily, '.ttf', '', [rfReplaceAll]);
|
|
ms.BlockColor := ChatWebServers[i].StyleBlockColor;
|
|
ms.BlockPadding := ChatWebServers[i].StyleBlockPadding;
|
|
ms.MaxMsgCount := ChatWebServers[i].MaxMsg;
|
|
ms.TimeMsg := ChatWebServers[i].TimeMsg;
|
|
ms.BorderSize := ChatWebServers[i].StyleBlockBorderSize;
|
|
ms.BorderColor := ChatWebServers[i].StyleBorderColor;
|
|
ms.BColor := ChatWebServers[i].BColor;
|
|
ChatWebServers[i].WebServerChat.AddMessage(ms);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrOBS.AddChat(newRecord: TOBSChat);
|
|
begin
|
|
SetLength(listChats, Length(listChats) + 1);
|
|
listChats[High(listChats)] := newRecord;
|
|
UpdateGridFromArray;
|
|
db.SaveRecordArray<TOBSChat>('listChats', listChats);
|
|
CreateWebChat(newRecord);
|
|
end;
|
|
|
|
procedure TfrOBS.AddKandinsky(newRecord: TOBSKandinsky);
|
|
begin
|
|
SetLength(listKandinsky, Length(listKandinsky) + 1);
|
|
listKandinsky[High(listKandinsky)] := newRecord;
|
|
UpdateGridFromArray;
|
|
db.SaveRecordArray<TOBSKandinsky>('listKandinsky', listKandinsky);
|
|
end;
|
|
|
|
procedure TfrOBS.AddNotify(newRecord: TOBSNotify);
|
|
begin
|
|
SetLength(listNotify, Length(listNotify) + 1);
|
|
listNotify[High(listNotify)] := newRecord;
|
|
UpdateGridFromArray;
|
|
db.SaveRecordArray<TOBSNotify>('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.CreateWebChat(chatSettings: TOBSChat);
|
|
var
|
|
ChatWebServer: TChatWebServers;
|
|
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;
|
|
|
|
begin
|
|
fonts := tstringlist.Create;
|
|
f := TfrColorSettings.Create(self);
|
|
t := TfrFontSettings.Create(self);
|
|
try
|
|
LoadFontList(fonts);
|
|
ChatWebServer.WebServerChat := TTTW_Chat.Create(fonts, chatSettings.port,
|
|
f.ccbBColor.Items[chatSettings.ColorBackground]);
|
|
ChatWebServer.port := chatSettings.port;
|
|
ChatWebServer.MaxMsg := chatSettings.MaxCountMess;
|
|
ChatWebServer.TimeMsg := chatSettings.TimeMess;
|
|
ChatWebServer.Freez := chatSettings.Freez = 1;
|
|
ChatWebServer.StyleBorderColor := f.ccbStyleBorderColor.Items
|
|
[chatSettings.ColorBorder];
|
|
ChatWebServer.StyleBlockColor := chatSettings.ColorBlock;
|
|
ChatWebServer.StyleBlockBorderSize := chatSettings.SolidBorder;
|
|
ChatWebServer.StyleBlockPadding := chatSettings.Paddings;
|
|
ChatWebServer.FontStyleDefault := t.cbFontStyleDefault.Items
|
|
[chatSettings.StyleFont];
|
|
ChatWebServer.FontColor := t.ccbFontColor.Items[chatSettings.ColorFont];
|
|
ChatWebServer.BColor := f.ccbBColor.Items[chatSettings.ColorBorder];;
|
|
ChatWebServer.FontSize := chatSettings.SizeFont;
|
|
ChatWebServers.Add(ChatWebServer);
|
|
|
|
ChatWebServers[ChatWebServers.Count - 1].WebServerChat.ActiveServer(True);
|
|
ChatWebServers[ChatWebServers.Count - 1].WebServerChat.SetDeleteMode
|
|
(not ChatWebServer.Freez, ChatWebServer.MaxMsg);
|
|
|
|
finally
|
|
fonts.Free;
|
|
f.Free;
|
|
t.Free;
|
|
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;
|
|
ChatWebServers[i].WebServerChat.ActiveServer(false);
|
|
ChatWebServers[i].WebServerChat.Destroy;
|
|
ChatWebServers.Delete(i);
|
|
db.SaveRecordArray<TOBSChat>('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<TOBSKandinsky>('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<TOBSNotify>('listNotify', listNotify);
|
|
end;
|
|
|
|
procedure TfrOBS.EdtChat(newRecord: TOBSChat; oldPort: integer);
|
|
var
|
|
i, j: integer;
|
|
chatWeb: TChatWebServers; // Âðåìåííàÿ ïåðåìåííàÿ äëÿ çàïèñè
|
|
f: TfrColorSettings;
|
|
t: TfrFontSettings;
|
|
begin
|
|
f := TfrColorSettings.Create(self);
|
|
t := TfrFontSettings.Create(self);
|
|
try
|
|
// Îáíîâëÿåì çàïèñü â listChats
|
|
for i := 0 to High(listChats) do
|
|
if listChats[i].port = oldPort then
|
|
begin
|
|
listChats[i] := newRecord;
|
|
Break;
|
|
end;
|
|
|
|
// Îáíîâëÿåì ñîîòâåòñòâóþùèé ñåðâåð â ChatWebServers
|
|
for j := 0 to ChatWebServers.Count - 1 do
|
|
begin
|
|
// 1. Èçâëåêàåì çàïèñü âî âðåìåííóþ ïåðåìåííóþ
|
|
chatWeb := ChatWebServers[j];
|
|
|
|
if chatWeb.port = oldPort then
|
|
begin
|
|
// 2. Ìîäèôèöèðóåì ïîëÿ çàïèñè
|
|
chatWeb.MaxMsg := newRecord.MaxCountMess;
|
|
chatWeb.TimeMsg := newRecord.TimeMess;
|
|
chatWeb.Freez := newRecord.Freez = 1;
|
|
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.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.SetDeleteMode(not chatWeb.Freez, chatWeb.MaxMsg);
|
|
|
|
// 4. Âîçâðàùàåì ìîäèôèöèðîâàííóþ çàïèñü â ñïèñîê
|
|
ChatWebServers[j] := chatWeb;
|
|
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
UpdateGridFromArray;
|
|
db.SaveRecordArray<TOBSChat>('listChats', listChats);
|
|
finally
|
|
f.Free;
|
|
t.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrOBS.EdtNotify(newRecord: TOBSNotify; oldPort: integer);
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to High(listNotify) do
|
|
if listNotify[i].port = oldPort then
|
|
begin
|
|
listNotify[i] := newRecord;
|
|
UpdateGridFromArray;
|
|
db.SaveRecordArray<TOBSNotify>('listNotify', listNotify);
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrOBS.sgWebChatsCellDblClick(const Column: TColumn;
|
|
const Row: integer);
|
|
var
|
|
myChatRec: TOBSChat;
|
|
myNotifyRec: TOBSNotify;
|
|
i: integer;
|
|
begin
|
|
if sgWebChats.Cells[1, Row] = 'Îïîâåùåíèå' then
|
|
begin
|
|
for i := 0 to High(listNotify) do
|
|
if listNotify[i].port = (strtoint(sgWebChats.Cells[0, Row])) then
|
|
begin
|
|
myNotifyRec := listNotify[i];
|
|
Break;
|
|
end;
|
|
|
|
fCreateNotify.isEdit := True;
|
|
fCreateNotify.setRecord(myNotifyRec);
|
|
fCreateNotify.Show;
|
|
end;
|
|
if sgWebChats.Cells[1, Row] = '×àò' then
|
|
begin
|
|
for i := 0 to High(listChats) do
|
|
if listChats[i].port = (strtoint(sgWebChats.Cells[0, Row])) then
|
|
begin
|
|
myChatRec := listChats[i];
|
|
Break;
|
|
end;
|
|
fCreateChat.isEdit := True;
|
|
fCreateChat.setRecord(myChatRec);
|
|
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.
|