добавил навыки и привязал к ним донаты и баллы канала

This commit is contained in:
PC1\PTyTb
2025-08-15 15:13:19 +03:00
parent 2335bf1656
commit 7a6934c825
15 changed files with 1120 additions and 78 deletions
+4 -2
View File
@@ -45,7 +45,9 @@ uses
uPlayerThread in 'utils\uPlayerThread.pas', uPlayerThread in 'utils\uPlayerThread.pas',
uWebServerChat in 'utils\uWebServerChat.pas', uWebServerChat in 'utils\uWebServerChat.pas',
uWebServerKandinsky in 'utils\uWebServerKandinsky.pas', uWebServerKandinsky in 'utils\uWebServerKandinsky.pas',
uWebServerEvents in 'utils\uWebServerEvents.pas'; uWebServerEvents in 'utils\uWebServerEvents.pas',
fEvents in 'frames\fEvents.pas' {frEvents: TFrame},
uKeyEvent in 'utils\uKeyEvent.pas';
{$R *.res} {$R *.res}
@@ -59,12 +61,12 @@ begin
Application.Initialize; Application.Initialize;
Application.CreateForm(TTTW_Bot, TTW_Bot); Application.CreateForm(TTTW_Bot, TTW_Bot);
Application.OnException := TTW_Bot.GlobalExceptionHandler;
Application.CreateForm(TfCreateChat, fCreateChat); Application.CreateForm(TfCreateChat, fCreateChat);
Application.CreateForm(TfCreateNotify, fCreateNotify); Application.CreateForm(TfCreateNotify, fCreateNotify);
Application.CreateForm(TfrmQ, frmQ); Application.CreateForm(TfrmQ, frmQ);
Application.CreateForm(TfShowText, fShowText); Application.CreateForm(TfShowText, fShowText);
Application.CreateForm(TOBS_Doc_Player, OBS_Doc_Player); Application.CreateForm(TOBS_Doc_Player, OBS_Doc_Player);
Application.OnException := TTW_Bot.GlobalExceptionHandler;
Application.CreateForm(TfCreateChat, fCreateChat); Application.CreateForm(TfCreateChat, fCreateChat);
Application.CreateForm(TfCreateNotify, fCreateNotify); Application.CreateForm(TfCreateNotify, fCreateNotify);
Application.CreateForm(TfShowText, fShowText); Application.CreateForm(TfShowText, fShowText);
+6
View File
@@ -432,6 +432,12 @@
<DCCReference Include="utils\uWebServerChat.pas"/> <DCCReference Include="utils\uWebServerChat.pas"/>
<DCCReference Include="utils\uWebServerKandinsky.pas"/> <DCCReference Include="utils\uWebServerKandinsky.pas"/>
<DCCReference Include="utils\uWebServerEvents.pas"/> <DCCReference Include="utils\uWebServerEvents.pas"/>
<DCCReference Include="frames\fEvents.pas">
<Form>frEvents</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="utils\uKeyEvent.pas"/>
<None Include=".gitignore"/> <None Include=".gitignore"/>
<BuildConfiguration Include="Base"> <BuildConfiguration Include="Base">
<Key>Base</Key> <Key>Base</Key>
+4 -1
View File
@@ -25,7 +25,7 @@ object fCreateChat: TfCreateChat
Size.Height = 251.000000000000000000 Size.Height = 251.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
inherited ccbStyleBorderColor: TColorComboBox inherited ccbStyleBorderColor: TColorComboBox
TabOrder = 30 TabOrder = 29
end end
inherited Label40: TLabel inherited Label40: TLabel
TabOrder = 8 TabOrder = 8
@@ -70,6 +70,9 @@ object fCreateChat: TfCreateChat
Size.Width = 240.000000000000000000 Size.Width = 240.000000000000000000
Size.Height = 125.000000000000000000 Size.Height = 125.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
inherited Label41: TLabel
TabOrder = 5
end
inherited ccbFontColor: TColorComboBox inherited ccbFontColor: TColorComboBox
TabOrder = 36 TabOrder = 36
end end
-3
View File
@@ -137,12 +137,10 @@ procedure TfCreateChat.FormCreate(Sender: TObject);
procedure LoadFontList; procedure LoadFontList;
var var
SearchRec: TSearchRec; SearchRec: TSearchRec;
n: integer;
begin begin
if not DirectoryExists(myConst.fontsPath) then if not DirectoryExists(myConst.fontsPath) then
CreateDir(myConst.fontsPath); CreateDir(myConst.fontsPath);
n := 1;
if FindFirst(IncludeTrailingPathDelimiter(myConst.fontsPath) + '*.*', if FindFirst(IncludeTrailingPathDelimiter(myConst.fontsPath) + '*.*',
faArchive, SearchRec) = 0 then faArchive, SearchRec) = 0 then
try try
@@ -151,7 +149,6 @@ procedure TfCreateChat.FormCreate(Sender: TObject);
begin begin
fCreateChat.frFontSettings1.cbFontStyleDefault.Items.Add fCreateChat.frFontSettings1.cbFontStyleDefault.Items.Add
(SearchRec.Name); (SearchRec.Name);
Inc(n);
end; end;
until FindNext(SearchRec) <> 0; until FindNext(SearchRec) <> 0;
finally finally
+80 -55
View File
@@ -18,7 +18,7 @@ object TTW_Bot: TTTW_Bot
Size.Width = 970.000000000000000000 Size.Width = 970.000000000000000000
Size.Height = 744.000000000000000000 Size.Height = 744.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
TabIndex = 0 TabIndex = 5
TabOrder = 0 TabOrder = 0
TabPosition = PlatformDefault TabPosition = PlatformDefault
Sizes = ( Sizes = (
@@ -45,7 +45,7 @@ object TTW_Bot: TTTW_Bot
item item
end> end>
TextSettings.Trimming = None TextSettings.Trimming = None
IsSelected = True IsSelected = False
ImageIndex = 21 ImageIndex = 21
Size.Width = 96.000000000000000000 Size.Width = 96.000000000000000000
Size.Height = 26.000000000000000000 Size.Height = 26.000000000000000000
@@ -76,6 +76,7 @@ object TTW_Bot: TTTW_Bot
inherited btnGetTokenStreamer: TButton inherited btnGetTokenStreamer: TButton
Images = ImageList1 Images = ImageList1
ImageIndex = 10 ImageIndex = 10
TabOrder = 30
end end
inherited edtBotTokenStreamer: TEdit inherited edtBotTokenStreamer: TEdit
TabOrder = 33 TabOrder = 33
@@ -88,34 +89,38 @@ object TTW_Bot: TTTW_Bot
inherited btnDAGetCode: TButton inherited btnDAGetCode: TButton
Images = ImageList1 Images = ImageList1
ImageIndex = 10 ImageIndex = 10
TabOrder = 38 TabOrder = 34
end
inherited Label63: TLabel
TabOrder = 30
end end
inherited edtDAClientID: TEdit inherited edtDAClientID: TEdit
TabOrder = 33 TabOrder = 32
end end
inherited Label64: TLabel inherited Label64: TLabel
TabOrder = 31 TabOrder = 31
end end
inherited edtDAClientSecret: TEdit inherited edtDAClientSecret: TEdit
TabOrder = 34 TabOrder = 33
end
inherited Label65: TLabel
TabOrder = 35
end end
inherited edtDARedirectURL: TEdit inherited edtDARedirectURL: TEdit
TabOrder = 43 TabOrder = 40
end end
inherited edtDACode: TEdit inherited edtDACode: TEdit
TabOrder = 36 TabOrder = 36
end end
inherited Label66: TLabel
TabOrder = 37
end
inherited btnDAStart: TButton inherited btnDAStart: TButton
Images = ImageList1 Images = ImageList1
ImageIndex = 18 ImageIndex = 18
TabOrder = 39
OnClick = frSettings1btnDAStartClick OnClick = frSettings1btnDAStartClick
end end
inherited btnGetDADef: TButton inherited btnGetDADef: TButton
Images = ImageList1 Images = ImageList1
TabOrder = 44 TabOrder = 43
end end
end end
inherited btnOpenRomaning: TButton inherited btnOpenRomaning: TButton
@@ -276,10 +281,18 @@ object TTW_Bot: TTTW_Bot
Viewport.Width = 207.000000000000000000 Viewport.Width = 207.000000000000000000
Viewport.Height = 116.000000000000000000 Viewport.Height = 116.000000000000000000
end end
inherited btnRandomAdd: TButton
Images = ImageList1
ImageIndex = 0
end
inherited btnRandomDel: TButton inherited btnRandomDel: TButton
Images = ImageList1
ImageIndex = 12
TabOrder = 31 TabOrder = 31
end end
inherited btnRmGroup: TButton inherited btnRmGroup: TButton
Images = ImageList1
ImageIndex = 4
TabOrder = 33 TabOrder = 33
end end
inherited Label4: TLabel inherited Label4: TLabel
@@ -437,11 +450,65 @@ object TTW_Bot: TTTW_Bot
Size.Width = 308.000000000000000000 Size.Width = 308.000000000000000000
Size.Height = 203.000000000000000000 Size.Height = 203.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
inherited btnUpdateVoices: TButton
Images = ImageList1
ImageIndex = 10
end
inherited btnSend: TButton inherited btnSend: TButton
Images = ImageList1
ImageIndex = 6
OnClick = frTTS1btnSendClick OnClick = frTTS1btnSendClick
end end
end end
end end
object GroupBox2: TGroupBox
Padding.Left = 10.000000000000000000
Padding.Top = 20.000000000000000000
Padding.Right = 10.000000000000000000
Padding.Bottom = 10.000000000000000000
Position.Y = 249.000000000000000000
Size.Width = 841.000000000000000000
Size.Height = 368.000000000000000000
Size.PlatformDefault = False
Text = #1057#1086#1073#1099#1090#1080#1103
TabOrder = 1
inline frEvents1: TfrEvents
Align = Client
Size.Width = 821.000000000000000000
Size.Height = 338.000000000000000000
Size.PlatformDefault = False
inherited sgEvents: TStringGrid
Size.Width = 721.000000000000000000
Viewport.Width = 721.000000000000000000
Viewport.Height = 211.000000000000000000
inherited StringColumn1: TStringColumn
Size.Width = 150.000000000000000000
end
inherited StringColumn2: TStringColumn
Size.Width = 150.000000000000000000
end
inherited StringColumn3: TStringColumn
Size.Width = 150.000000000000000000
end
inherited StringColumn4: TStringColumn
Size.Width = 150.000000000000000000
end
end
inherited btnAdd: TButton
Images = ImageList1
ImageIndex = 0
Position.X = 737.000000000000000000
end
inherited btnDelete: TButton
Images = ImageList1
ImageIndex = 12
Position.X = 737.000000000000000000
end
inherited pVKGenerate: TPanel
Visible = True
end
end
end
end end
object TabItem4: TTabItem object TabItem4: TTabItem
CustomIcon = < CustomIcon = <
@@ -464,84 +531,42 @@ object TTW_Bot: TTTW_Bot
Size.Height = 345.000000000000000000 Size.Height = 345.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
inherited sgWebChats: TStringGrid inherited sgWebChats: TStringGrid
Align = Bottom
CanFocus = True
ClipChildren = True
Position.Y = 63.000000000000000000
Size.Width = 970.000000000000000000 Size.Width = 970.000000000000000000
Size.Height = 282.000000000000000000 Size.Height = 282.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
RowCount = 0
Options = [ColumnResize, ColumnMove, ColLines, RowLines, Tabs, Header, HeaderClick, AutoDisplacement]
Viewport.Width = 970.000000000000000000 Viewport.Width = 970.000000000000000000
Viewport.Height = 282.000000000000000000 Viewport.Height = 282.000000000000000000
inherited IntegerColumn1: TIntegerColumn
Header = #1055#1086#1088#1090
HeaderSettings.TextSettings.WordWrap = False
end
inherited StringColumn1: TStringColumn
Header = #1058#1080#1087
HeaderSettings.TextSettings.WordWrap = False
end
inherited StringColumn2: TStringColumn inherited StringColumn2: TStringColumn
Header = #1057#1089#1099#1083#1082#1072' '#1076#1083#1103' OBS'
HeaderSettings.TextSettings.WordWrap = False
Size.Width = 200.000000000000000000 Size.Width = 200.000000000000000000
end end
end end
inherited btnCreateOBSChat: TButton inherited btnCreateOBSChat: TButton
Images = ImageList1 Images = ImageList1
ImageIndex = 13 ImageIndex = 13
Position.X = 8.000000000000000000
Position.Y = 8.000000000000000000
Size.Width = 94.000000000000000000 Size.Width = 94.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
TabOrder = 2 TabOrder = 2
Text = #1057#1086#1079#1076#1072#1090#1100' '#1095#1072#1090
TextSettings.Trimming = None
end end
inherited btnDeleteeChat: TButton inherited btnDeleteeChat: TButton
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
Images = ImageList1 Images = ImageList1
ImageIndex = 4 ImageIndex = 4
Position.X = 882.000000000000000000 Position.X = 882.000000000000000000
Position.Y = 8.000000000000000000
TabOrder = 3 TabOrder = 3
Text = #1059#1076#1072#1083#1080#1090#1100
TextSettings.Trimming = None
OnClick = frOBS1btnDeleteeChatClick OnClick = frOBS1btnDeleteeChatClick
end end
inherited Label1: TLabel inherited Label1: TLabel
Position.X = 8.000000000000000000 TabOrder = 12
Position.Y = 38.000000000000000000
Text = #1057#1086#1079#1076#1072#1085#1085#1099#1077' '#1095#1072#1090#1099':'
TabOrder = 13
end end
inherited btnCreateOBSNotify: TButton inherited btnCreateOBSNotify: TButton
Images = ImageList1 Images = ImageList1
ImageIndex = 24 ImageIndex = 24
Position.X = 110.000000000000000000 Position.X = 110.000000000000000000
Position.Y = 8.000000000000000000
Size.Width = 146.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 4
Text = #1057#1086#1079#1076#1072#1090#1100' '#1086#1087#1086#1074#1077#1097#1077#1085#1080#1077
TextSettings.Trimming = None
end end
inherited btnCreateOBSKandinsky: TButton inherited btnCreateOBSKandinsky: TButton
Images = ImageList1 Images = ImageList1
ImageIndex = 5 ImageIndex = 5
Position.X = 264.000000000000000000 Position.X = 264.000000000000000000
Position.Y = 8.000000000000000000 TabOrder = 8
Size.Width = 147.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 5
Text = #1057#1086#1079#1076#1072#1090#1100' '#1050#1072#1085#1076#1080#1085#1089#1082#1080#1081
TextSettings.Trimming = None
end end
object btnCreateChat: TButton object btnCreateChat: TButton
Images = ImageList1 Images = ImageList1
@@ -578,7 +603,7 @@ object TTW_Bot: TTTW_Bot
item item
end> end>
TextSettings.Trimming = None TextSettings.Trimming = None
IsSelected = False IsSelected = True
ImageIndex = 24 ImageIndex = 24
Size.Width = 110.000000000000000000 Size.Width = 110.000000000000000000
Size.Height = 26.000000000000000000 Size.Height = 26.000000000000000000
+45 -10
View File
@@ -1,15 +1,29 @@
unit uGeneral; {
получение доната
procedure TfrSettings.HandleWSDonate(aNick, aMessage, aSum: string);
получение сообщения
procedure TTTW_Bot.ttwIRCOnMessageRecord(aRecord: TTwitchChatMessage);
получение событий
ttw_ES.OnFollow := frOBS1.toEventWebServer;
ttw_ES.OnSub := frOBS1.toEventWebServer;
ttw_ES.OnGift := frOBS1.toEventWebServer;
ttw_ES.OnRaid := frOBS1.toEventWebServer;
}
unit uGeneral;
interface interface
uses uses
System.SysUtils, System.Types, System.UITypes, System.Classes, DateUtils, System.SysUtils, System.Types, System.UITypes, System.Classes, DateUtils,
System.Variants, uTTWIRC, uTTWEventSub, uTTWAPI, uSoundManager, System.Variants, uTTWIRC, uTTWEventSub, uTTWAPI, uSoundManager, uKeyEvent,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.TabControl, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.TabControl,
FMX.Controls.Presentation, FMX.StdCtrls, System.ImageList, FMX.ImgList, FMX.Controls.Presentation, FMX.StdCtrls, System.ImageList, FMX.ImgList,
FMX.Styles, ShellAPI, StrUtils, IdComponent, uRegExpr, uCustomEmoties, FMX.Styles, ShellAPI, StrUtils, IdComponent, uRegExpr, uCustomEmoties,
fSettings, fAI, fNotify, fAutoActions, FMX.ListBox, fLog, uMyTimer, uRecords, fSettings, fAI, fNotify, fAutoActions, FMX.ListBox, fLog, fEvents,
System.Generics.Collections, utts, uGigaChat, uChatAPI, System.Generics.Collections, utts, uGigaChat, uChatAPI, uMyTimer, uRecords,
System.IOUtils, fCommands, uDataBase, FMX.Edit, FMX.Colors, FMX.SpinBox, System.IOUtils, fCommands, uDataBase, FMX.Edit, FMX.Colors, FMX.SpinBox,
windows, System.Skia, FMX.Skia, uCreateChat, uCreateNotify, fOBS, fTTS, windows, System.Skia, FMX.Skia, uCreateChat, uCreateNotify, fOBS, fTTS,
fPlayerWeb, uWebServerKandinsky, FMX.Memo.Types, FMX.ScrollBox, FMX.Memo; fPlayerWeb, uWebServerKandinsky, FMX.Memo.Types, FMX.ScrollBox, FMX.Memo;
@@ -57,6 +71,8 @@ type
frTTS1: TfrTTS; frTTS1: TfrTTS;
GroupBox1: TGroupBox; GroupBox1: TGroupBox;
frPlayerWeb1: TfrPlayerWeb; frPlayerWeb1: TfrPlayerWeb;
frEvents1: TfrEvents;
GroupBox2: TGroupBox;
procedure cbThemeChange(Sender: TObject); procedure cbThemeChange(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton1Click(Sender: TObject);
@@ -118,6 +134,7 @@ var
ttw_API: TTTW_API; ttw_API: TTTW_API;
userlist: TList<TUser>; userlist: TList<TUser>;
Kandinsky: TKandinsky_Web; Kandinsky: TKandinsky_Web;
kePoints:TKE;
implementation implementation
@@ -245,7 +262,7 @@ begin
// Назначение обработчиков событий // Назначение обработчиков событий
// ttw_ES.OnMessage := fRewards.ESOnMessage; // ttw_ES.OnMessage := fRewards.ESOnMessage;
ttw_ES.OnError := ESError; ttw_ES.OnError := ESError;
// ttw_ES.OnGetCustomReward := fRewards.ESOnGetCustomReward; ttw_ES.OnGetCustomReward := frEvents1.ESOnGetCustomReward;
ttw_ES.OnStatus := ESStatus; ttw_ES.OnStatus := ESStatus;
// ttw_ES.OnRAW := fRewards.ESOnRAW; // ttw_ES.OnRAW := fRewards.ESOnRAW;
// ttw_ES.OnSubOk := fRewards.ESOnSubOk; // ttw_ES.OnSubOk := fRewards.ESOnSubOk;
@@ -493,11 +510,12 @@ end;
procedure TTTW_Bot.FormDestroy(Sender: TObject); procedure TTTW_Bot.FormDestroy(Sender: TObject);
begin begin
frOBS1.ChatBadges.Free; frOBS1.ChatBadges.Free;
frOBS1.ChatEmotes.Free; frOBS1.ChatEmotes.Free;
frOBS1.ChatWebServers.Free; frOBS1.ChatWebServers.Free;
frOBS1.EventWebServers.Free; frOBS1.EventWebServers.Free;
frEvents1.CustomRewards.Free;
kePoints.Free;
DisconnectProcedure; DisconnectProcedure;
if Assigned(ttw_IRS) then if Assigned(ttw_IRS) then
ttw_IRS.Free; ttw_IRS.Free;
@@ -1072,7 +1090,24 @@ procedure TTTW_Bot.ReadDB;
frOBS1.UpdateGridFromArray; frOBS1.UpdateGridFromArray;
end; end;
// Загрузка навыков
procedure LoadSkills;
begin
db.LoadRecordArray<TEventGlobal>('ListEvents', frEvents1.ListEvents);
frEvents1.UpdateGrid;
frEvents1.CustomRewards := Tlist<TCustomRevards>.Create;
// frEvents1.LoadCustomRevards();
frEvents1.CustomRewardEvents := Tlist<TCustomRewardEvent>.Create;
kePoints:=TKE.Create(frEvents1.edtParams, frEvents1.cbKey1,frEvents1.cbKey2,frEvents1.cbKey3);
frTTS1.btnUpdateVoicesClick(Self);
frTTS1.cbVoices.ItemIndex := strtoint(db.ReadSetting('cbVoices', '0'));
frTTS1.cbOutput.ItemIndex := strtoint(db.ReadSetting('cbOutput', '0'));
end;
begin begin
LoadSkills;
LoadSettingsComponents; LoadSettingsComponents;
LoadGridsData; LoadGridsData;
LoadGroupNames; LoadGroupNames;
+197
View File
@@ -0,0 +1,197 @@
object frEvents: TfrEvents
Size.Width = 737.000000000000000000
Size.Height = 338.000000000000000000
Size.PlatformDefault = False
object Label1: TLabel
Position.X = 8.000000000000000000
Position.Y = 8.000000000000000000
Text = #1057#1086#1073#1099#1090#1080#1077
TabOrder = 0
end
object cbEventList: TComboBox
Items.Strings = (
#1044#1086#1085#1072#1090
#1055#1086#1082#1091#1087#1082#1072' '#1085#1072#1075#1088#1072#1076#1099
#1055#1083#1072#1090#1085#1072#1103' '#1087#1086#1076#1087#1080#1089#1082#1072
#1054#1090#1089#1083#1077#1078#1080#1074#1072#1085#1080#1077
#1055#1086#1076#1072#1088#1086#1095#1085#1072#1103' '#1087#1086#1076#1087#1080#1089#1082#1072
#1056#1077#1081#1076)
Position.X = 8.000000000000000000
Position.Y = 33.000000000000000000
Size.Width = 193.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 1
OnChange = cbEventListChange
end
object edtIF: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
TabOrder = 2
Position.X = 8.000000000000000000
Position.Y = 88.000000000000000000
PopupMenu = PopupMenu1
Size.Width = 193.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
Visible = False
end
object Label2: TLabel
Position.X = 8.000000000000000000
Position.Y = 63.000000000000000000
Text = #1059#1089#1083#1086#1074#1080#1077
Visible = False
TabOrder = 3
end
object Label3: TLabel
Position.X = 209.000000000000000000
Position.Y = 8.000000000000000000
Text = #1044#1077#1081#1089#1090#1074#1080#1077
TabOrder = 4
end
object cbActions: TComboBox
Items.Strings = (
#1053#1072#1078#1072#1090#1100' '#1085#1082#1086#1087#1082#1091' '#1085#1072' '#1082#1083#1072#1074#1080#1072#1090#1091#1088#1077
#1055#1088#1086#1080#1075#1088#1072#1090#1100' '#1079#1074#1091#1082
'Kandinsky'
#1047#1072#1087#1091#1089#1090#1080#1090#1100' Web Event'
#1053#1072#1087#1080#1089#1072#1090#1100' '#1074' '#1095#1072#1090
#1047#1072#1087#1091#1089#1090#1080#1090#1100' '#1087#1088#1086#1075#1088#1072#1084#1084#1091)
Position.X = 209.000000000000000000
Position.Y = 33.000000000000000000
Size.Width = 193.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 5
OnChange = cbActionsChange
end
object cbRevards: TComboBox
Position.X = 8.000000000000000000
Position.Y = 88.000000000000000000
Size.Width = 193.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 6
Visible = False
end
object sgEvents: TStringGrid
CanFocus = True
ClipChildren = True
Position.X = 8.000000000000000000
Position.Y = 118.000000000000000000
Size.Width = 633.000000000000000000
Size.Height = 211.000000000000000000
Size.PlatformDefault = False
TabOrder = 7
RowCount = 0
Options = [ColumnResize, ColumnMove, ColLines, RowLines, Tabs, Header, HeaderClick, AutoDisplacement]
Viewport.Width = 629.000000000000000000
Viewport.Height = 186.000000000000000000
object StringColumn1: TStringColumn
Header = #1057#1086#1073#1099#1090#1080#1077
HeaderSettings.TextSettings.WordWrap = False
Size.Width = 150.000000000000000000
end
object StringColumn2: TStringColumn
Header = #1059#1089#1083#1086#1074#1080#1077
HeaderSettings.TextSettings.WordWrap = False
Size.Width = 150.000000000000000000
end
object StringColumn3: TStringColumn
Header = #1044#1077#1081#1089#1090#1074#1080#1077
HeaderSettings.TextSettings.WordWrap = False
Size.Width = 150.000000000000000000
end
object StringColumn4: TStringColumn
Header = #1055#1072#1088#1072#1084#1077#1090#1088#1099
HeaderSettings.TextSettings.WordWrap = False
Size.Width = 150.000000000000000000
end
end
object Label4: TLabel
Position.X = 209.000000000000000000
Position.Y = 63.000000000000000000
Text = #1055#1072#1088#1072#1084#1077#1090#1088#1099
TabOrder = 8
end
object edtParams: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
TabOrder = 9
Position.X = 209.000000000000000000
Position.Y = 88.000000000000000000
PopupMenu = PopupMenu1
Size.Width = 193.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
end
object btnAdd: TButton
Position.X = 649.000000000000000000
Position.Y = 118.000000000000000000
TabOrder = 10
Text = #1044#1086#1073#1072#1074#1080#1090#1100
TextSettings.Trimming = None
OnClick = btnAddClick
end
object btnDelete: TButton
Position.X = 649.000000000000000000
Position.Y = 148.000000000000000000
TabOrder = 11
Text = #1059#1076#1072#1083#1080#1090#1100
TextSettings.Trimming = None
OnClick = btnDeleteClick
end
object PopupMenu1: TPopupMenu
Left = 544
Top = 16
object MenuItem1: TMenuItem
Text = #1054#1090#1082#1088#1099#1090#1100' '#1092#1072#1081#1083
OnClick = MenuItem1Click
end
end
object OpenDialog1: TOpenDialog
Left = 496
Top = 16
end
object pVKGenerate: TPanel
Position.X = 410.000000000000000000
Position.Y = 88.000000000000000000
Size.Width = 319.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
Visible = False
TabOrder = 21
object cbKey1: TComboBox
Align = Left
TabOrder = 3
end
object Label54: TLabel
Align = Left
Position.X = 207.000000000000000000
Size.Width = 7.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TextSettings.Trimming = None
Text = '+'
TabOrder = 4
end
object cbKey3: TComboBox
Align = Left
Position.X = 214.000000000000000000
TabOrder = 2
end
object cbKey2: TComboBox
Align = Left
Position.X = 107.000000000000000000
TabOrder = 0
end
object Label56: TLabel
Align = Left
Position.X = 100.000000000000000000
Size.Width = 7.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TextSettings.Trimming = None
Text = '+'
TabOrder = 1
end
end
end
+390
View File
@@ -0,0 +1,390 @@
unit fEvents;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes,
System.Variants, System.Generics.Collections, ShellAPI, uSoundManager,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
FMX.Edit, FMX.ListBox, FMX.Controls.Presentation, System.Rtti, FMX.Grid.Style,
FMX.ScrollBox, FMX.Grid, uRecords, uDataBase, FMX.Menus, uKeyEvent;
type
TfrEvents = class(TFrame)
Label1: TLabel;
cbEventList: TComboBox;
edtIF: TEdit;
Label2: TLabel;
Label3: TLabel;
cbActions: TComboBox;
cbRevards: TComboBox;
sgEvents: TStringGrid;
Label4: TLabel;
edtParams: TEdit;
StringColumn1: TStringColumn;
StringColumn2: TStringColumn;
StringColumn3: TStringColumn;
StringColumn4: TStringColumn;
btnAdd: TButton;
btnDelete: TButton;
PopupMenu1: TPopupMenu;
MenuItem1: TMenuItem;
OpenDialog1: TOpenDialog;
pVKGenerate: TPanel;
cbKey1: TComboBox;
Label54: TLabel;
cbKey3: TComboBox;
cbKey2: TComboBox;
Label56: TLabel;
procedure cbEventListChange(Sender: TObject);
procedure btnAddClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure MenuItem1Click(Sender: TObject);
procedure cbActionsChange(Sender: TObject);
private
{ Private declarations }
procedure toLog(aCode: integer; aMethod: string; aMess: string);
public
{ Public declarations }
ListEvents: TArray<TEventGlobal>;
CustomRewards: Tlist<TCustomRevards>;
CustomRewardEvents: Tlist<TCustomRewardEvent>;
procedure UpdateGrid;
procedure LoadCustomRevards();
procedure ESOnGetCustomReward(CustomReward: TCustomRewardEvent);
procedure OnDonate(aNick, aMessage, aSum: string);
end;
implementation
{$R *.fmx}
uses uGeneral;
procedure TfrEvents.btnAddClick(Sender: TObject);
var
NewRec: TEventGlobal;
begin
if (cbEventList.Text = '') or (cbActions.Text = '') then
exit;
NewRec.Event := cbEventList.ItemIndex;
NewRec.Action := cbActions.ItemIndex;
NewRec.Param := edtParams.Text;
if edtIF.Visible then
NewRec.Condition := edtIF.Text;
if cbRevards.Visible then
NewRec.Condition := cbRevards.Text;
SetLength(ListEvents, Length(ListEvents) + 1);
ListEvents[High(ListEvents)] := NewRec;
DB.SaveRecordArray<TEventGlobal>('ListEvents', ListEvents);
UpdateGrid;
end;
procedure TfrEvents.btnDeleteClick(Sender: TObject);
var
i, RowIndex: integer;
begin
RowIndex := sgEvents.Row;
if (RowIndex < 0) or (RowIndex > High(ListEvents)) then
exit;
for i := RowIndex to High(ListEvents) - 1 do
ListEvents[i] := ListEvents[i + 1];
SetLength(ListEvents, Length(ListEvents) - 1);
DB.SaveRecordArray<TEventGlobal>('ListEvents', ListEvents);
UpdateGrid;
end;
procedure TfrEvents.cbActionsChange(Sender: TObject);
begin
pVKGenerate.Visible := cbActions.ItemIndex = 0;
end;
procedure TfrEvents.cbEventListChange(Sender: TObject);
begin
edtIF.Visible := cbEventList.ItemIndex = 0;
cbRevards.Visible := cbEventList.ItemIndex = 1;
Label2.Visible := cbEventList.ItemIndex <= 1;
end;
procedure TfrEvents.ESOnGetCustomReward(CustomReward: TCustomRewardEvent);
var
i, i2: integer;
req, s: string;
hr: TCustomRewardEvent;
sm: TSongMachine;
myAction: integer;
begin
sm := TSongMachine.Create;
try
toLog(3, 'ESOnGetCustomReward', 'Íà÷àëî îáðàáîòêè íàãðàäû: ' +
CustomReward.Event.revard.Title);
s := '[' + CustomReward.Event.user_name +
'] êóïèë çà áàëëû êàíàëà íàãðàäó "' +
CustomReward.Event.revard.Title + '" ';
if CustomReward.Event.user_input <> '' then
begin
toLog(0, 'ESOnGetCustomReward', 'Ïîëüçîâàòåëüñêèé ââîä: ' +
CustomReward.Event.user_input);
s := s + ' è ïåðåäàë ñòðîêó ' + CustomReward.Event.user_input
end;
for i := 0 to high(ListEvents) do
begin
if ListEvents[i].Event <> 1 then
continue;
if ListEvents[i].Condition = CustomReward.Event.revard.Title then
begin
myAction := ListEvents[i].Action;
{
0 Íàæàòü íêîïêó íà êëàâèàòóðå
1 Ïðîèãðàòü çâóê
2 Kandinsky
3 Çàïóñòèòü Web Event
4 Íàïèñàòü â ÷àò
5 Çàïóñòèòü ïðîãðàììó
}
case myAction of
0:
begin // íàæàòü êíîïêó
toLog(0, 'ESOnGetCustomReward', 'Ñèìóëÿöèÿ íàæàòèÿ: ' +
ListEvents[i].Param);
kePoints.SimulateKeyPress(ListEvents[i].Param, 500);
end;
1:
begin // âîñïðîèçâåäåíèå çâóêà
toLog(0, 'ESOnGetCustomReward', 'Âîñïðîèçâåäåíèå çâóêà: ' +
ListEvents[i].Param);
sm.PlayPublic(ListEvents[i].Param, '100');
end;
2:
begin // Kandinsky
toLog(0, 'ESOnGetCustomReward', 'Ãåíåðàöèÿ Kandinsky äëÿ: ' +
CustomReward.Event.user_input);
Kandinsky.generate(CustomReward.Event.user_input,
CustomReward.Event.user_login);
end;
4:
begin // Íàïèñàòü â ÷àò
toLog(0, 'ESOnGetCustomReward', 'Íàïèñàòü â ÷àò: ' +
CustomReward.Event.user_input);
end;
5:
begin // çàïóñê ôàéëà
toLog(0, 'ESOnGetCustomReward', 'Çàïóñê ôàéëà: ' + ListEvents
[i].Param);
ShellExecute(0, 'open', pwidechar(ListEvents[i].Param),
nil, nil, 0);
end;
end;
end;
end;
finally
sm.Free;
end;
end;
procedure TfrEvents.LoadCustomRevards();
var
cr: TCustomRevards;
begin
CustomRewards.Clear;
cbRevards.Items.Clear;
TTW_Bot.toLog('fEvents', 'LoadCustomRevards', 'Çàïðîñ íàãðàä ñ ñåðâåðà', 3);
ttw_API.getCustomReward(CustomRewards);
for cr in CustomRewards do
begin
cbRevards.Items.Add(cr.Title);
end;
end;
procedure TfrEvents.MenuItem1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
TEdit(PopupMenu1.PopupComponent).Text := OpenDialog1.FileName;
end;
procedure TfrEvents.OnDonate(aNick, aMessage, aSum: string);
var
i, i2: integer;
req, s: string;
hr: TCustomRewardEvent;
sm: TSongMachine;
myAction: integer;
j: integer;
aSumInt: integer;
BestRow: integer;
BestPriority: integer;
BestValue: integer;
Condition: string;
CurrentPriority: integer;
CurrentValue: integer;
MinVal, MaxVal: integer;
Parts: tstringlist;
se: TStyleEvent;
notify: TEventGlobal;
begin
aSumInt := StrToIntDef(aSum, 0);
BestRow := -1;
BestPriority := -1;
BestValue := 0;
for i := 0 to high(ListEvents) do
begin
if ListEvents[i].Event = 0 then
begin
Condition := ListEvents[i].Condition;
CurrentPriority := -1;
CurrentValue := 0;
// Ïðîâåðêà íà òî÷íîå çíà÷åíèå
if Pos('-', Condition) = 0 then
begin
if Pos('>', Condition) = 0 then
begin
if Pos('<', Condition) = 0 then
begin
// Òî÷íîå çíà÷åíèå
CurrentValue := StrToIntDef(Condition, -1);
if aSumInt = CurrentValue then
CurrentPriority := 4;
end;
end;
end;
if CurrentPriority = -1 then
begin
if Pos('-', Condition) > 0 then
begin
// Äèàïàçîí
Parts := tstringlist.Create;
try
Parts.Delimiter := '-';
Parts.StrictDelimiter := True;
Parts.DelimitedText := Condition;
if Parts.Count = 2 then
begin
MinVal := StrToIntDef(Trim(Parts[0]), 0);
MaxVal := StrToIntDef(Trim(Parts[1]), 0);
if (aSumInt >= MinVal) and (aSumInt <= MaxVal) then
begin
CurrentPriority := 3;
CurrentValue := MinVal; // Ïðèîðèòåò ïî MinVal
end;
end;
finally
Parts.Free;
end;
end
else if Pos('>', Condition) > 0 then
begin
// Óñëîâèå ">X"
CurrentValue :=
StrToIntDef(Trim(StringReplace(Condition, '>', '',
[rfReplaceAll])), 0);
if aSumInt >= CurrentValue then
CurrentPriority := 2;
end
else if Pos('<', Condition) > 0 then
begin
// Óñëîâèå "<X"
CurrentValue :=
StrToIntDef(Trim(StringReplace(Condition, '<', '',
[rfReplaceAll])), 0);
if aSumInt <= CurrentValue then
CurrentPriority := 1;
end;
end;
if CurrentPriority <> -1 then
begin
// Îïðåäåëåíèå íàèëó÷øåãî óñëîâèÿ
if (CurrentPriority > BestPriority) or (CurrentPriority = BestPriority)
and ((CurrentPriority = 3) and (CurrentValue > BestValue) or
(CurrentPriority = 2) and (CurrentValue > BestValue) or
(CurrentPriority = 1) and (CurrentValue < BestValue)) then
begin
BestPriority := CurrentPriority;
BestValue := CurrentValue;
BestRow := i;
notify := ListEvents[i];
end;
end;
if BestRow = -1 then
Break;
end;
end;
if BestRow = -1 then
exit;
sm := TSongMachine.Create;
try
myAction := ListEvents[i].Action;
case myAction of
0:
begin // íàæàòü êíîïêó
toLog(0, 'OnDonate', 'Ñèìóëÿöèÿ íàæàòèÿ: ' + ListEvents[i].Param);
kePoints.SimulateKeyPress(ListEvents[i].Param, 500);
end;
1:
begin // âîñïðîèçâåäåíèå çâóêà
toLog(0, 'OnDonate', 'Âîñïðîèçâåäåíèå çâóêà: ' + ListEvents[i].Param);
sm.PlayPublic(ListEvents[i].Param, '100');
end;
2:
begin // Kandinsky
toLog(0, 'OnDonate', 'Ãåíåðàöèÿ Kandinsky äëÿ: ' + aNick);
Kandinsky.generate(aMessage, aNick);
end;
4:
begin // Íàïèñàòü â ÷àò
toLog(0, 'OnDonate', 'Íàïèñàòü â ÷àò: ' + aNick);
end;
5:
begin // çàïóñê ôàéëà
toLog(0, 'OnDonate', 'Çàïóñê ôàéëà: ' + ListEvents[i].Param);
ShellExecute(0, 'open', pwidechar(ListEvents[i].Param), nil, nil, 0);
end;
end;
finally
sm.Free;
end;
end;
procedure TfrEvents.toLog(aCode: integer; aMethod, aMess: string);
begin
TTW_Bot.toLog('fEvents', aMethod, aMess, aCode);
end;
procedure TfrEvents.UpdateGrid;
var
i: integer;
begin
sgEvents.BeginUpdate;
try
sgEvents.RowCount := 0; // Ñáðàñûâàåì ñòðîêè (îñòàâëÿåì òîëüêî çàãîëîâêè)
for i := 0 to High(ListEvents) do
begin
sgEvents.RowCount := i + 1;
sgEvents.Cells[0, i] := cbEventList.Items[ListEvents[i].Event];
sgEvents.Cells[1, i] := ListEvents[i].Condition;
sgEvents.Cells[2, i] := cbActions.Items[ListEvents[i].Action];
sgEvents.Cells[3, i] := ListEvents[i].Param;
end;
finally
sgEvents.EndUpdate;
end;
end;
end.
+8
View File
@@ -47,6 +47,7 @@ object frNotify: TfrNotify
TabOrder = 7 TabOrder = 7
Text = '...' Text = '...'
TextSettings.Trimming = None TextSettings.Trimming = None
OnClick = btnNotifyOpenClick
end end
object btnNotifyCheck: TButton object btnNotifyCheck: TButton
Position.X = 624.000000000000000000 Position.X = 624.000000000000000000
@@ -57,6 +58,7 @@ object frNotify: TfrNotify
TabOrder = 8 TabOrder = 8
Text = '>' Text = '>'
TextSettings.Trimming = None TextSettings.Trimming = None
OnClick = btnNotifyCheckClick
end end
object cbNotifyFileAgain1: TCheckBox object cbNotifyFileAgain1: TCheckBox
Position.X = 656.000000000000000000 Position.X = 656.000000000000000000
@@ -76,6 +78,7 @@ object frNotify: TfrNotify
TabOrder = 26 TabOrder = 26
Text = '>' Text = '>'
TextSettings.Trimming = None TextSettings.Trimming = None
OnClick = btnNotifyCheckClick
end end
object btnNotifyOpenMod: TButton object btnNotifyOpenMod: TButton
Position.X = 592.000000000000000000 Position.X = 592.000000000000000000
@@ -86,6 +89,7 @@ object frNotify: TfrNotify
TabOrder = 24 TabOrder = 24
Text = '...' Text = '...'
TextSettings.Trimming = None TextSettings.Trimming = None
OnClick = btnNotifyOpenClick
end end
object edtNotifyFileNameMod: TEdit object edtNotifyFileNameMod: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap] Touch.InteractiveGestures = [LongTap, DoubleTap]
@@ -168,6 +172,7 @@ object frNotify: TfrNotify
TabOrder = 21 TabOrder = 21
Text = '...' Text = '...'
TextSettings.Trimming = None TextSettings.Trimming = None
OnClick = btnNotifyOpenClick
end end
object btnNotifyCheckVip: TButton object btnNotifyCheckVip: TButton
Position.X = 624.000000000000000000 Position.X = 624.000000000000000000
@@ -178,6 +183,7 @@ object frNotify: TfrNotify
TabOrder = 25 TabOrder = 25
Text = '>' Text = '>'
TextSettings.Trimming = None TextSettings.Trimming = None
OnClick = btnNotifyCheckClick
end end
object cbNotifyFileAgain2: TCheckBox object cbNotifyFileAgain2: TCheckBox
Position.X = 656.000000000000000000 Position.X = 656.000000000000000000
@@ -206,6 +212,7 @@ object frNotify: TfrNotify
TabOrder = 23 TabOrder = 23
Text = '>' Text = '>'
TextSettings.Trimming = None TextSettings.Trimming = None
OnClick = btnNotifyCheckClick
end end
object btnNotifyOpenSub: TButton object btnNotifyOpenSub: TButton
Position.X = 592.000000000000000000 Position.X = 592.000000000000000000
@@ -216,6 +223,7 @@ object frNotify: TfrNotify
TabOrder = 19 TabOrder = 19
Text = '...' Text = '...'
TextSettings.Trimming = None TextSettings.Trimming = None
OnClick = btnNotifyOpenClick
end end
object edtNotifyFileNameSub: TEdit object edtNotifyFileNameSub: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap] Touch.InteractiveGestures = [LongTap, DoubleTap]
+39 -1
View File
@@ -3,7 +3,8 @@ unit fNotify;
interface interface
uses uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, System.SysUtils, System.Types, System.UITypes, System.Classes,
System.Variants, uSoundManager,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls, FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
FMX.Edit, FMX.Controls.Presentation; FMX.Edit, FMX.Controls.Presentation;
@@ -37,6 +38,8 @@ type
Label52: TLabel; Label52: TLabel;
chEnNotifySub: TSwitch; chEnNotifySub: TSwitch;
OpenDialog1: TOpenDialog; OpenDialog1: TOpenDialog;
procedure btnNotifyOpenClick(Sender: TObject);
procedure btnNotifyCheckClick(Sender: TObject);
private private
{ Private declarations } { Private declarations }
public public
@@ -47,4 +50,39 @@ implementation
{$R *.fmx} {$R *.fmx}
procedure TfrNotify.btnNotifyCheckClick(Sender: TObject);
var sm:TSongMachine;
begin
sm:=TSongMachine.Create;
try
if TButton(Sender).Name = 'btnNotifyCheck' then
sm.PlayPublic(edtNotifyFileName.Text, tbNotifyVolume.Value.ToString);
if TButton(Sender).Name = 'btnNotifyCheckMod' then
sm.PlayPublic(edtNotifyFileNameMod.Text, tbNotifyVolumeMod.Value.ToString);
if TButton(Sender).Name = 'btnNotifyCheckVip' then
sm.PlayPublic(edtNotifyFileNameVip.Text, tbNotifyVolumeVip.Value.ToString);
if TButton(Sender).Name = 'btnNotifyCheckSub' then
sm.PlayPublic(edtNotifyFileNameSub.Text, tbNotifyVolumeSub.Value.ToString);
finally
sm.Free;
end;
end;
procedure TfrNotify.btnNotifyOpenClick(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
if TButton(Sender).Name = 'btnNotify' then
edtNotifyFileName.Text := OpenDialog1.FileName;
if TButton(Sender).Name = 'btnNotifyMod' then
edtNotifyFileNameMod.Text := OpenDialog1.FileName;
if TButton(Sender).Name = 'btnNotifyVip' then
edtNotifyFileNameVip.Text := OpenDialog1.FileName;
if TButton(Sender).Name = 'btnNotifySub' then
edtNotifyFileNameSub.Text := OpenDialog1.FileName;
end;
end;
end. end.
+3
View File
@@ -369,6 +369,9 @@ end;
procedure TfrSettings.HandleWSDonate(aNick, aMessage, aSum: string); procedure TfrSettings.HandleWSDonate(aNick, aMessage, aSum: string);
begin begin
// fDonats.OnDADonate(aNick, aMessage, aSum); // fDonats.OnDADonate(aNick, aMessage, aSum);
TTW_Bot.frOBS1.toEventWebServer(aNick,aSum,aMessage);
TTW_Bot.frEvents1.OnDonate(aNick, aMessage, aSum);
end; end;
procedure TfrSettings.HandleWSStatus(AStatusText: string; AStatusCode: integer); procedure TfrSettings.HandleWSStatus(AStatusText: string; AStatusCode: integer);
+2
View File
@@ -15,6 +15,7 @@ object frTTS: TfrTTS
Size.Height = 22.000000000000000000 Size.Height = 22.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
TabOrder = 1 TabOrder = 1
OnChange = cbVoicesChange
end end
object btnUpdateVoices: TButton object btnUpdateVoices: TButton
Position.X = 177.000000000000000000 Position.X = 177.000000000000000000
@@ -59,6 +60,7 @@ object frTTS: TfrTTS
Size.Height = 22.000000000000000000 Size.Height = 22.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
TabOrder = 6 TabOrder = 6
OnChange = cbOutputChange
end end
object btnSend: TButton object btnSend: TButton
Position.X = 8.000000000000000000 Position.X = 8.000000000000000000
+12
View File
@@ -20,6 +20,8 @@ type
cbOutput: TComboBox; cbOutput: TComboBox;
procedure btnUpdateVoicesClick(Sender: TObject); procedure btnUpdateVoicesClick(Sender: TObject);
procedure btnSendClick(Sender: TObject); procedure btnSendClick(Sender: TObject);
procedure cbVoicesChange(Sender: TObject);
procedure cbOutputChange(Sender: TObject);
private private
{ Private declarations } { Private declarations }
tts: TTTS; tts: TTTS;
@@ -83,4 +85,14 @@ begin
end; end;
end; end;
procedure TfrTTS.cbOutputChange(Sender: TObject);
begin
db.WriteSetting('cbOutput',inttostr(cbOutput.ItemIndex));
end;
procedure TfrTTS.cbVoicesChange(Sender: TObject);
begin
db.WriteSetting('cbVoices',inttostr(cbVoices.ItemIndex));
end;
end. end.
+318
View File
@@ -0,0 +1,318 @@
unit uKeyEvent;
interface
uses
System.SysUtils, System.Types, Windows, System.Classes, System.UITypes,
FMX.Types, FMX.Edit, FMX.Controls, FMX.Forms, FMX.Platform, FMX.ListBox;
type
TKE = class(TObject)
private
fEdit: TEdit;
Fcombo1: TComboBox;
Fcombo2: TComboBox;
Fcombo3: TComboBox;
procedure UpdateCombination;
function GetKeyPriority(const Key: string): Integer;
procedure ComboBoxChange(Sender: TObject);
function FindLastDuplicate(List: TStringList; StartIndex: Integer): Integer;
function StrToVirtualKey(const KeyStr: string): Word;
procedure InitializeComboBox(cb: TComboBox);
function CompareKeys(List: TStringList; Index1, Index2: Integer): Integer;
public
constructor Create( edt: TEdit; c1, c2, c3: TComboBox);
procedure SimulateKeyPress(const KeyCombo: string; Delay: Integer);
end;
const
KeyOrder: array[0..82] of string = (
// Ìîäèôèêàòîðû
'Control', 'Ctrl', 'Alt', 'Shift', 'Win',
// Ôóíêöèîíàëüíûå êëàâèøè
'F1', 'F2', 'F3', 'F4', 'F5', 'F6', 'F7', 'F8', 'F9', 'F10', 'F11', 'F12',
// Ñïåöèàëüíûå êëàâèøè
'Esc', 'Tab', 'CapsLock', 'Enter', 'Space', 'Backspace', 'Delete', 'Insert',
'Home', 'End', 'PageUp', 'PageDown', 'PrintScreen', 'ScrollLock', 'Pause',
// Íàâèãàöèÿ
'Up', 'Down', 'Left', 'Right',
// Öèôðû
'0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
// Áóêâû
'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
// Ñèìâîëû
'`', '-', '=', '[', ']', '\', ';', '''', ',', '.', '/'
);
implementation
var
SortingInstance: TKE;
function GlobalCompare(List: TStringList; Index1, Index2: Integer): Integer;
begin
if Assigned(SortingInstance) then
Result := SortingInstance.CompareKeys(List, Index1, Index2)
else
Result := 0;
end;
constructor TKE.Create( edt: TEdit; c1, c2, c3: TComboBox);
begin
inherited Create;
// Ïðîâåðêà íà âàëèäíîñòü êîìïîíåíòîâ
if not Assigned(edt) then
raise Exception.Create('TEdit is nil');
if not Assigned(c1) or not Assigned(c2) or not Assigned(c3) then
raise Exception.Create('ComboBox is nil');
fEdit := edt;
Fcombo1 := c1;
Fcombo2 := c2;
Fcombo3 := c3;
InitializeComboBox(Fcombo1);
InitializeComboBox(Fcombo2);
InitializeComboBox(Fcombo3);
Fcombo1.OnChange := ComboBoxChange;
Fcombo2.OnChange := ComboBoxChange;
Fcombo3.OnChange := ComboBoxChange;
end;
procedure TKE.InitializeComboBox(cb: TComboBox);
var
i: Integer;
begin
cb.Items.BeginUpdate;
try
cb.Items.Clear;
cb.Items.Add(''); // Ïóñòîé ýëåìåíò
for i := 0 to High(KeyOrder) do
cb.Items.Add(KeyOrder[i]);
finally
cb.Items.EndUpdate;
end;
cb.ItemIndex := 0;
end;
procedure TKE.ComboBoxChange(Sender: TObject);
begin
UpdateCombination;
end;
function TKE.GetKeyPriority(const Key: string): Integer;
var
I: Integer;
begin
for I := 0 to High(KeyOrder) do
if SameText(KeyOrder[I], Key) then
begin
Result := I;
Exit;
end;
Result := High(KeyOrder) + 1; // Äëÿ íåèçâåñòíûõ êëàâèø
end;
function TKE.FindLastDuplicate(List: TStringList; StartIndex: Integer): Integer;
var
I: Integer;
begin
Result := -1;
for I := List.Count-1 downto StartIndex+1 do
if SameText(List[StartIndex], List[I]) then
begin
Result := I;
Break;
end;
end;
function TKE.CompareKeys(List: TStringList; Index1, Index2: Integer): Integer;
begin
Result := GetKeyPriority(List[Index1]) - GetKeyPriority(List[Index2]);
end;
procedure TKE.UpdateCombination;
var
List: TStringList;
I: Integer;
TempStr: string;
begin
List := TStringList.Create;
try
// Ñîáèðàåì âûáðàííûå êëàâèøè
if Fcombo1.Text <> '' then List.Add(Fcombo1.Text);
if Fcombo2.Text <> '' then List.Add(Fcombo2.Text);
if Fcombo3.Text <> '' then List.Add(Fcombo3.Text);
// Óäàëåíèå äóáëèêàòîâ
I := 0;
while I < List.Count do
begin
if FindLastDuplicate(List, I) > I then
List.Delete(I)
else
Inc(I);
end;
// Ñîðòèðîâêà ñ èñïîëüçîâàíèåì ãëîáàëüíîé ïåðåìåííîé
SortingInstance := Self;
try
List.CustomSort(GlobalCompare);
finally
SortingInstance := nil;
end;
// Ôîðìèðîâàíèå ñòðîêè
TempStr := '';
for I := 0 to List.Count-1 do
begin
if TempStr <> '' then TempStr := TempStr + '+';
TempStr := TempStr + List[I];
end;
fEdit.Text := TempStr;
finally
List.Free;
end;
end;
function TKE.StrToVirtualKey(const KeyStr: string): Word;
begin
// Ìîäèôèêàòîðû
if SameText(KeyStr, 'Control') or SameText(KeyStr, 'Ctrl') then Exit(VK_CONTROL);
if SameText(KeyStr, 'Alt') then Exit(VK_MENU);
if SameText(KeyStr, 'Shift') then Exit(VK_SHIFT);
if SameText(KeyStr, 'Win') then Exit(VK_LWIN);
// Ôóíêöèîíàëüíûå êëàâèøè
if SameText(KeyStr, 'F1') then Exit(VK_F1);
if SameText(KeyStr, 'F2') then Exit(VK_F2);
if SameText(KeyStr, 'F3') then Exit(VK_F3);
if SameText(KeyStr, 'F4') then Exit(VK_F4);
if SameText(KeyStr, 'F5') then Exit(VK_F5);
if SameText(KeyStr, 'F6') then Exit(VK_F6);
if SameText(KeyStr, 'F7') then Exit(VK_F7);
if SameText(KeyStr, 'F8') then Exit(VK_F8);
if SameText(KeyStr, 'F9') then Exit(VK_F9);
if SameText(KeyStr, 'F10') then Exit(VK_F10);
if SameText(KeyStr, 'F11') then Exit(VK_F11);
if SameText(KeyStr, 'F12') then Exit(VK_F12);
// Ñïåöèàëüíûå êëàâèøè
if SameText(KeyStr, 'Esc') then Exit(VK_ESCAPE);
if SameText(KeyStr, 'Tab') then Exit(VK_TAB);
if SameText(KeyStr, 'CapsLock') then Exit(VK_CAPITAL);
if SameText(KeyStr, 'Enter') then Exit(VK_RETURN);
if SameText(KeyStr, 'Space') then Exit(VK_SPACE);
if SameText(KeyStr, 'Backspace') then Exit(VK_BACK);
if SameText(KeyStr, 'Delete') then Exit(VK_DELETE);
if SameText(KeyStr, 'Insert') then Exit(VK_INSERT);
if SameText(KeyStr, 'Home') then Exit(VK_HOME);
if SameText(KeyStr, 'End') then Exit(VK_END);
if SameText(KeyStr, 'PageUp') then Exit(VK_PRIOR);
if SameText(KeyStr, 'PageDown') then Exit(VK_NEXT);
if SameText(KeyStr, 'PrintScreen') then Exit(VK_SNAPSHOT);
if SameText(KeyStr, 'ScrollLock') then Exit(VK_SCROLL);
if SameText(KeyStr, 'Pause') then Exit(VK_PAUSE);
// Íàâèãàöèÿ
if SameText(KeyStr, 'Up') then Exit(VK_UP);
if SameText(KeyStr, 'Down') then Exit(VK_DOWN);
if SameText(KeyStr, 'Left') then Exit(VK_LEFT);
if SameText(KeyStr, 'Right') then Exit(VK_RIGHT);
// Áóêâû è öèôðû
if Length(KeyStr) = 1 then
begin
case KeyStr[1] of
'A'..'Z': Exit(Ord(UpCase(KeyStr[1])));
'0'..'9': Exit(Ord(KeyStr[1]));
'`': Exit(VK_OEM_3);
'-': Exit(VK_OEM_MINUS);
'=': Exit(VK_OEM_PLUS);
'[': Exit(VK_OEM_4);
']': Exit(VK_OEM_6);
'\': Exit(VK_OEM_5);
';': Exit(VK_OEM_1);
'''': Exit(VK_OEM_7);
',': Exit(VK_OEM_COMMA);
'.': Exit(VK_OEM_PERIOD);
'/': Exit(VK_OEM_2);
end;
end;
Result := 0; // Åñëè êëàâèøà íå ðàñïîçíàíà
end;
procedure TKE.SimulateKeyPress(const KeyCombo: string; Delay: Integer);
var
Parts: TArray<string>;
Inputs: array of TInput;
i, Index: Integer;
Key: Word;
KeyState: TKeyboardState;
begin
Parts := KeyCombo.Split(['+'], TStringSplitOptions.ExcludeEmpty);
SetLength(Inputs, Length(Parts) * 2); // Êàæäàÿ êëàâèøà: íàæàòèå è îòïóñêàíèå
Index := 0;
// Ñíà÷àëà ñîáèðàåì âñå ñîáûòèÿ íàæàòèÿ
for i := 0 to High(Parts) do
begin
Key := StrToVirtualKey(Parts[i].Trim);
if Key = 0 then Continue;
// Íàæàòèå êëàâèøè
Inputs[Index].Itype := INPUT_KEYBOARD;
Inputs[Index].ki.wVk := Key;
Inputs[Index].ki.dwFlags := 0;
Inputs[Index].ki.time := 0;
Inputs[Index].ki.wScan := 0;
Inputs[Index].ki.dwExtraInfo := 0;
Inc(Index);
end;
// Îòïðàâëÿåì íàæàòèÿ
if Index > 0 then
SendInput(Index, Inputs[0], SizeOf(TInput));
// Çàäåðæêà
Sleep(Delay);
// Òåïåðü ñîáèðàåì ñîáûòèÿ îòïóñêàíèÿ â îáðàòíîì ïîðÿäêå
for i := High(Parts) downto 0 do
begin
Key := StrToVirtualKey(Parts[i].Trim);
if Key = 0 then Continue;
// Îòïóñêàíèå êëàâèøè
Inputs[Index].Itype := INPUT_KEYBOARD;
Inputs[Index].ki.wVk := Key;
Inputs[Index].ki.dwFlags := KEYEVENTF_KEYUP;
Inputs[Index].ki.time := 0;
Inputs[Index].ki.wScan := 0;
Inputs[Index].ki.dwExtraInfo := 0;
Inc(Index);
end;
// Îòïðàâëÿåì îòïóñêàíèÿ
if Index > Length(Parts) then
SendInput(Index - Length(Parts), Inputs[Length(Parts)], SizeOf(TInput));
// Ïðèíóäèòåëüíî îáíîâëÿåì ñîñòîÿíèå êëàâèàòóðû
GetKeyboardState(KeyState);
SetKeyboardState(KeyState);
end;
end.
+7 -1
View File
@@ -2,7 +2,13 @@ unit uRecords;
interface interface
type
TEventGlobal = record
Event:integer;
Condition:string;
Action:integer;
Param:string;
end;
type type