presentation_classes.pas
3.5 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
{
Free-mtrix - Free cultural selection and social behavior experiments.
Copyright (C) 2016-2017 Carlos Rafael Fernandes Picanço, Universidade Federal do Pará.
The present file is distributed under the terms of the GNU General Public License (GPL v3.0).
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
}
unit presentation_classes;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, ExtCtrls;
type
{ TAnnouncerStartEvent }
TAnnouncerStartEvent = procedure (AMessage : array of UTF8String) of object;
{ TAnnoucerMessages }
TAnnoucerMessages = array of array of UTF8String;
{ TIntervalarAnnouncer }
TIntervalarAnnouncer = class(TComponent)
private
FMessages: TAnnoucerMessages;
FTimer : TTimer;
FOnStart: TAnnouncerStartEvent;
function GetEnabled: Boolean;
function GetInterval: integer;
procedure NextMessage;
procedure SetEnabled(AValue: Boolean);
procedure SelfDestroy(Sender: TObject);
procedure SetInterval(AValue: integer);
procedure StartTimer(Sender:TObject);
public
constructor Create(AOwner : TComponent); override;
procedure Append(M : array of UTF8String);
procedure Reversed;
property Messages : TAnnoucerMessages read FMessages write FMessages;
property OnStart : TAnnouncerStartEvent read FOnStart write FOnStart;
property Interval : integer read GetInterval write SetInterval;
property Enabled : Boolean read GetEnabled write SetEnabled;
end;
implementation
{ TIntervalarAnnouncer }
procedure TIntervalarAnnouncer.SetEnabled(AValue: Boolean);
begin
if FTimer.Enabled=AValue then Exit;
FTimer.Enabled:= AValue;
end;
function TIntervalarAnnouncer.GetEnabled: Boolean;
begin
Result := FTimer.Enabled;
end;
function TIntervalarAnnouncer.GetInterval: integer;
begin
Result := FTimer.Interval;
end;
procedure TIntervalarAnnouncer.NextMessage;
begin
SetLength(FMessages,Length(FMessages)-1);
end;
procedure TIntervalarAnnouncer.SelfDestroy(Sender : TObject);
var LAnnouncer : TIntervalarAnnouncer;
begin
if Length(FMessages) > 0 then
begin
LAnnouncer := TIntervalarAnnouncer.Create(nil);
LAnnouncer.Messages := FMessages;
LAnnouncer.OnStart:= FOnStart;
LAnnouncer.Enabled:=True;
end;
Free;
end;
procedure TIntervalarAnnouncer.SetInterval(AValue: integer);
begin
if FTimer.Interval=AValue then Exit;
FTimer.Interval:= AValue;
end;
procedure TIntervalarAnnouncer.StartTimer(Sender: TObject);
var M : array of UTF8String;
begin
if Length(FMessages) > 0 then
begin
M := FMessages[High(FMessages)];
NextMessage;
if Assigned(FOnStart) then FOnStart(M);
end;
end;
constructor TIntervalarAnnouncer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FTimer := TTimer.Create(Self);
FTimer.Enabled := False;
FTimer.Interval := 5000;
FTimer.OnTimer:=@SelfDestroy;
//FTimer.OnStopTimer:=@SelfDestroy;
FTimer.OnStartTimer:=@StartTimer;
end;
procedure TIntervalarAnnouncer.Append(M: array of UTF8String);
var
H : TAnnoucerMessages;
i: Integer;
begin
SetLength(H,1,Length(M));
for i := Low(M) to High(M) do
H[0,i] := M[i];
SetLength(FMessages,Length(FMessages)+1);
FMessages[High(FMessages)] := H[0];
end;
procedure TIntervalarAnnouncer.Reversed;
var
i : integer;
M : TAnnoucerMessages;
begin
for i := High(FMessages) downto Low(FMessages) do
begin
SetLength(M,Length(M)+1);
M[High(M)] := FMessages[i]
end;
FMessages := M;
end;
end.