реструктуризация файлов, добавление вебчатов
This commit is contained in:
PC1\PTyTb
+697
@@ -0,0 +1,697 @@
|
||||
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.
|
||||
Reference in New Issue
Block a user