Framerate modifié dynamiquement

Version imprimable

16/10/2012, 18h57
Archimède

Framerate modifié dynamiquement
Bonjour, est-il possible de modifier le nombre d'images par seconde en cours d'animation. De modifier dynamiquement le framerate...

faire un truc du style : stage.framerate:=....
En AS2, je ne pense pas que ce soit possible.

En revanche, j'ai essayé la fonction setinterval....(qui existe en AS2)

un truc comme ça :
Code:

1 2 IntervalId:=setInterval(_root,myprocedure, dt(en ms))
avec intervalId de type number.

ma procedure devrait être appelée toutes les dt (ms)

En fait, j'obtiens le message setInterval non reconnu...

Est -ce possible de l'utiliser avec flashpascal ?

ps: pas facile de trouver le temps de bricoler avec le boulot...

merci :lol:

AAAHHH ! ça fait plaisir d'avoir un post ici, moi non plus je n'ai pas bcp de temps pour FlashPascal :)

alors, non le Framerate est fixe, mais tu peux par exemple le doubler et n'effectuer un traitement que une fois sur deux pour le réduire de moitié.

sinon voici un exemple avec setInterval

EDIT: même chose avec le clearInterval
Code:

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 program Project1; {$FRAME_WIDTH 550} {$FRAME_HEIGHT 400} {$FRAME_RATE 12} {$BACKGROUND $FFFFFF} uses Flash8; function setInterval(target: TObject; method: string; interval: Number): Number external 'setInterval'; procedure clearInterval(intervalId: Number) external 'clearInterval'; type TMovie = class(MovieClip) time: Integer; text: TextField; timer: Number; constructor Create; procedure onTimer; end; constructor TMovie.Create; begin inherited Create(_root, 'test', 1); text := TextField.Create(Self, 'text', 1, 0, 0, 100, 100); text.text := 'test'; end; procedure TMovie.onTimer; begin Inc(time); text.text := IntToStr(time); if time = 100 then clearInterval(timer); end; var m: TMovie; begin m := TMovie.Create; m.timer := setInterval(m, 'onTimer', 10); end.
NB: attention, pour que le compilateur face le lien entre la méthode sous forme de texte et la méthode objet, il faut que son nom soit sous la forme "onX..." ("on" en minuscules suivi d'une lettre majuscule), en effet pour éviter les collisions entre noms de fonction le compilateur modifie le nom des fonctions...sauf celles qui commencent par "onX"...

17/10/2012, 08h54
Archimède

Ah, nickel....

C'est cette syntaxe là :

Code:

m.timer := setInterval(m, 'onTimer', 10);

que je n'arrivais pas obtenir....

Une chose de plus qui fait avancer le chmibilic :D...

Très bien...c'était important de soulever ce point pour avoir le contrôle total sur l'animation...

merci :ccool:

ps: oui... en effet avec le boulot, on ne peut pas faire ce que l'on veut... Dommage, c'est captivant et ce forum mérite d'évoluer.

à bientôt

J'ai l'impression qu'il y a un conflit entre le framerate et duration de setinterval...

J'ai fait un essai pour illustrer la persistance rétinienne (superposition d'images déjà vues) et le fait que si je mets duration à zéro alors l'animation ne s'arrête pas et le onTimer se comporte comme un onEnterframe !!! bizarre...

et puis sur la petite animation, le cyan et le jaune se superpose et ça doit donner par synthèse soustractive du vert... et on doit voir la croix...

Ici ce n'est pas très performant:

Code:

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
 
program Project6;
 
{$FRAME_WIDTH 550}
{$FRAME_HEIGHT 400}
{$FRAME_RATE 100}
{$BACKGROUND $000000}
 
uses
  Flash8,URealmovie,Utrack;
 
function setInterval(target: TObject; method: string; interval: Number): Number external 'setInterval';
procedure clearInterval(intervalId: Number) external 'clearInterval';
type
 
 animation=class(movieclip)
  timer:number;
  frame1,frame2:Realmovie;
  track:TTrackbar;
  constructor Create;
  procedure onTimer;
 end;
 
Constructor animation.Create;
begin
 inherited Create(_root,'anim',0);
 
 frame1:=Realmovie.Create(self,'frame1',1);
 Frame2:=Realmovie.Create(self,'frame2',2);
 
 with Frame1 do
 begin
  Setsize(stage.height-50,stage.height-50,-10,-10,10,10);
  Linestyle(1,clyellow);
  BeginFill(clyellow);
  Rrectangle(-10,-10,10,10);
  endFill();
  Linestyle(5,clblack);
  BeginFill(clblack);
  RRoundrect(-9,1,18,2,15);
  _visible:=true;
 end;
 
 with Frame2 do
 begin
  Setsize(stage.height-50,stage.height-50,-10,-10,10,10);
  Linestyle(1,claqua);
  BeginFill(claqua);
  Rrectangle(-10,-10,10,10);
  endFill();
  Linestyle(5,clblack);
  BeginFill(clblack);
  RRoundrect(-1,9,2,18,15);
  _visible:=false;
 end;
 
 
 track:=TTrackbar.create(_root,stage.height-50,1,1000,1,'vertical'); //min:1 ; max:=1000 ;position=1
 track._x:=stage.width-40;
 track._y:=20;
 
 timer:=setinterval(self,'onTimer',1000/track.position); //duration de 1 à 1000 ms);
 
 _x:=(stage.width-(stage.height-50))/2;
 _y:=25;
end;
 
procedure animation.onTimer;
begin
  frame1._visible:=not Frame1._visible;
  frame2._visible:=not Frame2._visible;
  clearInterval(timer);
  timer:=setinterval(self,'onTimer',1000/track.position);
end;
 
 
begin
 animation.create;
end.

Code:

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
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
 
unit URealMovie;
 
interface
 
uses
 math,flash8;
 
const
  Pi   = 3.14159265359;
type
 Tpoint=record
  x,y:number;
 end;
 
 TArrayofPoint = array of TPoint;
 RealMovie = class(MovieClip)
   graph_width,graph_height:number;
   xmin, xmax, ymin ,ymax , xsize ,ysize , Gx, Gy ,xo ,yo: number;
   Procedure RMoveTo(x,y:number);
   Procedure RMoveTo2(pt:TPoint);
   Procedure RLineTo(x,y:number);
   Procedure RLineTo2(pt:TPoint);
   Procedure RLine(x1,y1,x2,y2:number);
   procedure RLine2(pt1,pt2:Tpoint);
   Procedure RPolyline(courbe:array of TPoint);
   Procedure Rrectangle(x1,y1,x2,y2:number);
   Procedure Rrectangle2(pt1,pt2:TPoint);
   procedure RRoundrect(x,y,w,h,radius:number);
   Procedure RCircle(Cx,Cy,Radius:number);
   Procedure RCurveTo(x1,y1,x2,y2:number);
   procedure RArrow(x1,y1,x2,y2:number;col,penw:integer); //flèche
   procedure RArrow2(Fx,Fy,norme,alpha:number;col,penw:integer);//en coords polaires /alpha en °
   procedure Rdisquegradue(xc,yc,R,L:number;n:integer);
   function  Rrotationarraypoint(xc,yc,theta:number;figure:array of Tpoint):TarrayofPoint;
   function  RPoint(x,y:number):TPoint;
   procedure RTextout(x,y,width,height,Depth:number;font:TextFormat;text:String);
   procedure Rdisquegradtextout(xc,yc,R:number;n:integer;font:TextFormat;text:array of String);
   procedure setSize(w, h,x1, y1, x2, y2: Number);
  end;
 
 function IntToStr2(i: Integer): string;
 function IntToStr3(i: Integer): string;
 function pt(x,y:number):TPoint;
 function FloattostrF(num:number;digit:integer):String;
 function sqr(n:number):number;
 
implementation
 
// Méthodes de dessin de Realmovie
 
 
function sqr(n:number):number;
begin
 result:=n*n;
end;
 
function IntToStr2(i: Integer): string;
begin
  Result := IntToStr(i);
  if i < 10 then
    Result := '0' + Result;
end;
 
function pt(x,y:number):TPoint;
begin
 result.x:=x;
 result.y:=y;
end;
 
 
function FloattostrF(num:number;digit:integer):String;
var int:integer;
    frac,frac1,frac2,newnum:number;
begin
   int:=trunc(num);
   frac:=num-int;
   frac1:=trunc(pow(10,digit)*frac)/pow(10,digit);
   frac2:= trunc(pow(10,digit+1)*frac)/pow(10,digit+1);
   if (frac2-frac1)*pow(10,digit+1)>=5 then newnum:=int+frac1+pow(10,-digit) else newnum:=int+frac1;
   result:=floattostr(newnum);
end;
 
function IntToStr3(i: Integer): string;
begin
  Result := IntToStr(i);
  if (i<100) and (i<>0) and (i>=10) then Result:='0'+Result else if (i<10) and (i<>0) then Result:='00'+Result else if i =0 then Result :='000';
end;
 
 
procedure RealMovie.RRoundrect(x,y,w,h,radius:number);
var
 r,b,xe,ye,we,he:number;
begin
  xe:=xo+x*Gx;
  ye:=yo-y*Gy;
  we:=w*Gx;
  he:=h*Gy;
  r := xe + we;
  b := ye + he;
  moveTo(xe+radius, ye);
  lineTo(r-radius, ye);
  CurveTo(r, ye, r, ye+radius);
  lineTo(r, ye+he-radius);
  CurveTo(r, b, r-radius, b);
  lineTo(xe+radius, b);
  CurveTo(xe, b, xe, b-radius);
  lineTo(xe, ye+radius);
  CurveTo(xe, ye, xe+radius, ye);
end;
 
Procedure RealMovie.RMoveTo(x,y:number);
begin
 Moveto(xo+x*Gx,yo-y*Gy);
end;
 
Procedure RealMovie.RMoveTo2(pt:TPoint);
begin
 Moveto(xo+pt.x*Gx,yo-pt.y*Gy);
end;
 
Procedure RealMovie.RLineTo(x,y:number);
begin
 Lineto(xo+x*Gx,yo-y*Gy);
end;
 
Procedure RealMovie.RLineTo2(pt:TPoint);
begin
 Lineto(xo+pt.x*Gx,yo-pt.y*Gy);
end;
 
Procedure RealMovie.RLine(x1,y1,x2,y2:number);
begin
 RMoveto(x1,y1);
 RLineto(x2,y2);
end;
 
procedure RealMovie.RLine2(pt1,pt2:Tpoint);
begin
  RLine(pt1.x,pt1.y,pt2.x,pt2.y);
end;
 
 
Procedure RealMovie.RPolyline(courbe:array of TPoint);
var i:integer;
begin
  RMoveto2(courbe[0]);
  for i:=1 to high(courbe) do Rlineto2(courbe[i]);
end;
 
Procedure RealMovie.Rrectangle(x1,y1,x2,y2:number);
begin
 RMoveto(x1,y1);
 RLineTo(x2,y1);
 RLineto(x2,y2);
 RLineto(x1,y2);
 RLineto(x1,y1);
end;
 
Procedure RealMovie.Rrectangle2(pt1,pt2:TPoint);
begin
 RMoveto2(pt1);
 RLineTo(pt2.x,pt1.y);
 RLineto2(pt2);
 RLineto(pt1.x,pt2.y);
 RLineto2(pt1);
end;
 
Procedure RealMovie.Rcircle(Cx,Cy,Radius:number); //si orthonormé
var a,b,R: number;
begin
  R:=radius*Gx;
  Cx:=xo+Cx*Gx;
  Cy:=yo-Cy*Gy;
  a:= R * 0.414213562;
  b:= R * 0.707106781;
  moveTo(Cx+R,Cy);
  CurveTo(Cx+ R, Cy+-a, Cx+b,Cy -b);
  CurveTo(Cx+ a,Cy-R,Cx,Cy -r);
  CurveTo(Cx-a,Cy -R,Cx-b,Cy -b);
  CurveTo(Cx-R, Cy-a,Cx-R,Cy);
  CurveTo(Cx-R,Cy+a,Cx-b,Cy+b);
  CurveTo(Cx-a,Cy +R,Cx,Cy+r);
  CurveTo(Cx+a,Cy +R,Cx+b,Cy+b);
  CurveTo(Cx+R,Cy+a,Cx+R,Cy);
end;
 
Procedure RealMovie.RArrow(x1,y1,x2,y2:number;col,penw:integer);//flèche
var i:integer;
    Norme,cX,cY: number;
    ALength,AWidth:number;  //longueur et largeur de la pointe
    Arrow:array of TPoint;
begin
  ALength:=10;
  AWidth:=7;
  x1:=xo+x1*Gx;
  x2:=xo+x2*Gx;
  y1:=yo-y1*Gy;
  y2:=yo-y2*Gy;
  Norme:=SQRT((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1));
  if Norme=0 then Exit;
  cX:=(x2-x1)/Norme;
  cY:=(y2-y1)/Norme;
  Arrow[0]:=pt(x2,y2);
  Arrow[1]:=pt(x2-cX*ALength+cY*AWidth,y2-cY*ALength-cX*AWidth);
  Arrow[2]:=pt(x2-cX*ALength-cY*AWidth,y2-cY*ALength+cX*AWidth);
  Arrow[3]:=pt(x2,y2);
 
  Linestyle(penw,col);
  BeginFill(col);
  Moveto(x1,y1);
  Lineto(x2,y2);
  Moveto(arrow[0].x,arrow[0].y);
  for i:=1 to 3 do lineto(arrow[i].x,arrow[i].y);
  Endfill();
end;
 
procedure RealMovie.RArrow2(Fx,Fy,norme,alpha:number;col,penw:integer);//Flèche en coords polaires
var theta: number;
    L,L1: number;
    xf1,yf1 :number;
    xf2,yf2 :number;
    x,y : number;
begin
 alpha:=pi*alpha/180;
 
 x:=norme*cos(alpha);
 y:=norme*sin(alpha);
 if x<>0.0 then theta:=atan2(y,x) else theta:=0;
 L:=sqrt((x*x)+(y*y))/10;
 L1:=L/2;
 
 xf1:=-L*cos(theta)-L1*sin(theta);
 xf2:=-L*cos(theta)+L1*sin(theta);
 yf1:=-L*sin(theta)+L1*cos(theta);
 yf2:=-L*sin(theta)-L1*cos(theta);
 
 linestyle(penw,col);
 RLine(Fx,Fy,Fx+x,Fy+y);
 RLine(x+Fx,y+Fy,x+Fx+xf1,y+Fy+yf1);
 RLine(x+Fx,y+Fy,x+Fx+xf2,y+Fy+yf2);
end;
 
procedure RealMovie.RCurveto(x1,y1,x2,y2:number);
begin
 curveto(xo+x1*Gx,yo-y1*Gy,xo+x2*Gx,yo-y2*Gy);
end;
 
procedure RealMovie.Rdisquegradue(xc,yc,R,L:number;n:integer);
var phi:number;
    i:integer;
    pt1,pt2:Tpoint;
begin
 phi:=2*pi/n;
 for i:=0 to n do
 begin
  pt1:=pt(xc+(R-L)*cos(i*phi),yc+(R-L)*sin(i*phi));
  pt2:=pt(xc+R*cos(i*phi),yc+R*sin(i*phi));
  RLine2(pt1,pt2);
 end;
end;
 
 
function RealMovie.Rrotationarraypoint(xc,yc,theta:number;figure:array of Tpoint):TarrayofPoint;
var i:integer;
    Rayon,phi:array of number;
    O:TPoint;
    ptarray:array of Tpoint;
begin
 O:=pt(xo+Gx*xc,yo-Gy*yc);
 i := 4;
 for i:=low(figure) to high(figure) do
 begin
  ptarray[i]:=pt(xo+Gx*figure[i].x,yo-Gy*figure[i].y);
  if ptarray[i].x-O.x<>0 then phi[i]:=atan2(ptarray[i].y-O.y,ptarray[i].x-O.x) else phi[i]:=-pi/2;
  Rayon[i]:=round(sqrt(sqr(ptarray[i].x-O.x)+sqr(ptarray[i].y-O.y)));
  ptarray[i].x:=O.x+Rayon[i]*cos(theta+phi[i]);
  ptarray[i].y:=O.y+Rayon[i]*sin(theta+phi[i]);
  result[i]:=pt(ptarray[i].x,ptarray[i].y);
 end;
end;
 
procedure RealMovie.RTextout(x,y,width,height,Depth:number;font:TextFormat;text:String);
var Field:TextField;
begin
 Field:=TextField.Create(self,'',Depth,xo+Gx*(x),yo-Gy*(y),width,height);
 Field.setNewTextFormat(font);
 Field.text:=text;
end;
 
procedure RealMovie.Rdisquegradtextout(xc,yc,R:number;n:integer;font:TextFormat;text:array of String);
var i:integer;
    x,y,phi:number;
begin
 phi:=2*Pi/n;
 for i:=1 to n do
 begin
  x:=xc+R*cos(pi/2-i*phi);
  y:=yc+R*sin(pi/2-i*phi);
  RTextout(x,y,25,20,i,font,text[i]);
 end;
end;
 
Function  RealMovie.RPoint(x,y:number):TPoint;
begin
 result.x:=xo+x*Gx;
 result.y:=yo-y*Gy;
End;
 
procedure RealMovie.setSize(w, h, x1, y1, x2, y2: Number);
begin
  graph_width:=w;
  graph_height:=h;
  xmin := x1;
  xmax := x2;
  ymin := y1;
  ymax := y2;
  xsize:= xmax - xmin;
  ysize:= ymax - ymin;
  Gx   := graph_width / xsize;
  Gy   := graph_height/ ysize;
  xo   :=-xmin * Gx;
  yo   := ymax * Gy;
end;
//fin méthodes realmovie
 
 
end.

Code:

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
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
 
unit UTrack;
 
interface
uses Flash8;
 
 
type
 
   TTrackcur=class(MovieClip)
    orientation:string;
    xmouse,ymouse,trackmin,trackmax:number;
    xcur,ycur:Integer;
    downcur:Boolean;
    Procedure circle(Cx,Cy,Radius:number);
    constructor Create(AOWNER:Movieclip;trmin,trmax:number);
    procedure onPress;override;
    procedure onEnterFrame;override;
    procedure onMouseUp;override;
   end;
 
   TTrackbar=class(MovieClip)
   private
    w,h:number;
    state:string;
    procedure Roundrect(x,y,w,h,radius:number);
    procedure DrawTrackbar(Width,Height:number);
   public
    position:number;
    cur: TTrackcur;
    procedure onChange;virtual;
    constructor Create(AOWNER:Movieclip;FTaille,trmin,trmax,posi:number;Kind:string);
   end;
 
implementation
 
 
constructor TTrackcur.create(AOWNER:Movieclip;trmin,trmax:number);
 var matrix: Flash8.Matrix;
begin
  inherited Create(AOWNER,'cur',AOWNER.getNextHighestDepth);
  matrix := Flash8.Matrix.Create();
  matrix.createBox(1,1,0,10,14);
  linestyle(1,$87B6B7);
  beginGradientFill('radial',[$008080,clwhite],[100,100],[0,14],matrix);
  Circle(6,6,15);
  downcur:=false;
  xmouse:=0;
  ymouse:=0;
  trackmin:=trmin;
  trackmax:=trmax;
end;
 
constructor TTrackbar.Create(AOWNER:Movieclip;FTaille,trmin,trmax,posi:number;Kind:string);
begin
 inherited Create(AOWNER,'trackbar',AOWNER.getNextHighestDepth);
 w:=FTaille;
 state:=Kind;
 DrawTrackBar(w,12);
 cur:=TTrackcur.Create(self,trmin,trmax);
 cur.orientation:=Kind;
 position:=posi;
 if kind='horizontal' then
 begin
  cur._x:=(posi-trmin)*w/(trmax-trmin);
  cur._y:=0;
 end else
 if kind='vertical' then
 begin
  cur._y:=(trmax-posi)*w/(trmax-trmin);
  cur._x:=0;
 end;
end;
 
procedure TTrackbar.DrawTrackbar(Width, Height: number);
var matrix: Flash8.Matrix;
begin
 matrix := Flash8.Matrix.Create();
 if state='horizontal' then
 begin
  matrix.createGradientBox(width, height, Math.PI/2, 0, 0);
  beginGradientFill('linear',[$deedf6,$c4e5f6,$98d1ef,$66afd7],[100,100,100,100],[8,64,127,255],matrix);
  linestyle(2,$98d1ef);
  RoundRect(0,0,width,height,height/2);
 end else if state='vertical' then
 begin
  matrix.createGradientBox(height,width,0, 0, 0);
  beginGradientFill('linear',[$deedf6,$c4e5f6,$98d1ef,$66afd7],[100,100,100,100],[8,64,127,255],matrix);
  RoundRect(0,0,height,width,height/2);
  linestyle(2,$98d1ef);
 end;
end;
 
procedure  TTrackcur.onPress;
begin
 downcur:=true;
 xmouse:=_xmouse;
 ymouse:=_ymouse;
end;
 
procedure  TTrackcur.onEnterFrame;
var tr:TTrackbar;
begin
     tr:= TTrackbar(_parent);
 
     if downcur then
     if orientation='horizontal' then
     begin
      _x:= _x + _xmouse -xmouse;
      if _x<0 then _x:=0;
      if _x>tr.w then _x:=tr.w;
      tr.position:=_x*(trackmax-trackmin)/tr.w+trackmin;
     end
     else if orientation='vertical' then
     begin
      _y:= _y +_ymouse -ymouse;
      if _y<0 then _y:=0;
      if _y>tr.w then _y:=tr.w;
      tr.position:=trackmax-(_y*(trackmax-trackmin)/tr.w);
     end;
     tr.onChange;
end;
 
 
 
procedure  TTrackcur.onMouseUp;
begin
 downcur:=false;
end;
 
procedure TTrackbar.Roundrect(x,y,w,h,radius:number);
var
 ra,b:number;
begin
  ra := x + w;
  b := y + h;
  moveTo(x+radius, y);
  lineTo(ra-radius, y);
  CurveTo(ra,y, ra, y+radius);
  lineTo(ra, y+h-radius);
  CurveTo(ra, b, ra-radius, b);
  lineTo(x+radius, b);
  CurveTo(x, b,x, b-radius);
  lineTo(x, y+radius);
  CurveTo(x, y, x+radius,y);
end;
 
Procedure TTrackcur.circle(Cx,Cy,Radius:number);
var a,b,R: number;
begin
  R:=Radius;
  a:= R * 0.414213562;
  b:= R * 0.707106781;
  moveTo(Cx+R,Cy);
  CurveTo(Cx+ R, Cy+-a, Cx+b,Cy -b);
  CurveTo(Cx+ a,Cy-R,Cx,Cy -r);
  CurveTo(Cx-a,Cy -R,Cx-b,Cy -b);
  CurveTo(Cx-R, Cy-a,Cx-R,Cy);
  CurveTo(Cx-R,Cy+a,Cx-b,Cy+b);
  CurveTo(Cx-a,Cy +R,Cx,Cy+r);
  CurveTo(Cx+a,Cy +R,Cx+b,Cy+b);
  CurveTo(Cx+R,Cy+a,Cx+R,Cy);
end;
 
procedure TTrackbar.onChange;
begin
end;
 
end.

Désolé, je voulais faire rapide et j'ai utilisé des outils (donc les unités associées que je rappelle)

suite....

je dois dire que le fait de détruire timer à chaque fois ne me satisfait pas...mais j'ai tenté ça :

Code:

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
 
program Project6;
 
{$FRAME_WIDTH 550}
{$FRAME_HEIGHT 400}
{$FRAME_RATE 100}
{$BACKGROUND $000000}
 
uses
  Flash8,URealmovie,Utrack;
 
function setInterval(target: TObject; method: string; interval: Number): Number external 'setInterval';
procedure clearInterval(intervalId: Number) external 'clearInterval';
type
 
 TTrackbar1=class(TTrackbar)
  procedure onChange;override;
 end;
 
 animation=class(movieclip)
  timer:number;
  frame1,frame2:Realmovie;
  track:TTrackbar1;
  constructor Create;
  procedure onTimer;
 end;
 
Constructor animation.Create;
begin
 inherited Create(_root,'anim',0);
 
 frame1:=Realmovie.Create(self,'frame1',1);
 Frame2:=Realmovie.Create(self,'frame2',2);
 
 with Frame1 do
 begin
  Setsize(stage.height-50,stage.height-50,-10,-10,10,10);
  Linestyle(1,clyellow);
  BeginFill(clyellow);
  Rrectangle(-10,-10,10,10);
  endFill();
  Linestyle(5,clblack);
  BeginFill(clblack);
  RRoundrect(-9,1,18,2,15);
  _visible:=true;
 end;
 
 with Frame2 do
 begin
  Setsize(stage.height-50,stage.height-50,-10,-10,10,10);
  Linestyle(1,claqua);
  BeginFill(claqua);
  Rrectangle(-10,-10,10,10);
  endFill();
  Linestyle(5,clblack);
  BeginFill(clblack);
  RRoundrect(-1,9,2,18,15);
  _visible:=false;
 end;
 
 
 track:=TTrackbar1.create(_root,stage.height-50,1,1000,1,'vertical'); //min:1 ; max:=1000 ;position=1
 track._x:=stage.width-40;
 track._y:=20;
 
 timer:=setinterval(self,'onTimer',1000/track.position); //duration de 1 à 1000 ms);
 
 _x:=(stage.width-(stage.height-50))/2;
 _y:=25;
end;
 
procedure animation.onTimer;
begin
  frame1._visible:=not Frame1._visible;
  frame2._visible:=not Frame2._visible;
end;
 
procedure TTrackbar1.onChange;
begin
 clearInterval(animation(_parent).timer);
 animation(_parent).timer:=setinterval(animation(_parent),'onTimer',1000/position);
end;
 
 
begin
 animation.create;
end.

et, ça ne marche pas...

en effet il faut recréer le timer uniquement quand le trackbar change

autre solution (avec tpos : Number initialisé dans le constructor)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 procedure animation.onTimer; begin frame1._visible:=not Frame1._visible; frame2._visible:=not Frame2._visible; if tpos <> track.position then begin tpos := track.position; clearInterval(timer); timer:=setinterval(self,'onTimer',1000/tpos); end; end;
mais je pense que cela ne change pas le framerate d'affichage...ton timer va pouvoir changer la valeur _visible plusieurs fois avant que l'écran ne soit redessiné.

Je pense que tu peux au mieux changer la valeur de visible à chaque frame, 1 frame sur 2, 1 sur 3, 1 sur 4 etc... mais tu ne peux pas forcer l'affichage de tes éléments visuels à un frame rate paramétrable.

en fait si l'écran ne change pas, il n'est pas redessiné, mais c'est le framerate qui détermine la fréquence d'actualisation de l'écran.

17/10/2012, 21h29
Archimède
En effet, bien vu ! :
Code:

1 2 3 4 5 6 7 if tpos <> track.position then begin tpos := track.position; clearInterval(timer); timer:=setinterval(self,'onTimer',1000/tpos); end;
au niveau de l'écriture, c'est déjà au moins plus satisfaisant...(ça limite les destructions inutiles de timer)

merci pour ton regard éclairé.
17/10/2012, 21h42
Archimède

Je viens de tester, en effet le problème reste entier pour la synchronisation...

Citation:

en fait si l'écran ne change pas, il n'est pas redessiné, mais c'est le framerate qui détermine la fréquence d'actualisation de l'écran.

tout à fait...

je clos la discussion..., je pense être arrivé à ce que je voulais...

Ci-joint la rectif

Code:

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
 
program Ppersistance;
 
{$FRAME_WIDTH 550}
{$FRAME_HEIGHT 400}
{$FRAME_RATE 100}
{$BACKGROUND $000000}
 
uses
  Flash8,URealmovie,Utrack,math;
 
 
 
function setInterval(target: TObject; method: string; interval: Number): Number external 'setInterval';
procedure clearInterval(intervalId: Number) external 'clearInterval';
 
type
 
 
 animation=class(movieclip)
  tpos:number;
  frame1,frame2:Realmovie;
  track:TTrackbar;
  Font:TextFormat;
  frequence:TextField;
  constructor Create;
  procedure onTimer;
 end;
 
  var timer:number;
 
Constructor animation.Create;
begin
 inherited Create(_root,'anim',0);
 
 frame1:=Realmovie.Create(self,'frame1',1);
 Frame2:=Realmovie.Create(self,'frame2',2);
 
 with Frame1 do
 begin
  Setsize(stage.height-50,stage.height-50,-10,-10,10,10);
  Linestyle(1,clyellow);
  BeginFill(clyellow);
  Rrectangle(-10,-10,10,10);
  endFill();
  Linestyle(5,clblack);
  BeginFill(clblack);
  RRoundrect(-9,1,18,2,15);
  _visible:=true;
 end;
 
 with Frame2 do
 begin
  Setsize(stage.height-50,stage.height-50,-10,-10,10,10);
  Linestyle(1,claqua);
  BeginFill(claqua);
  Rrectangle(-10,-10,10,10);
  endFill();
  Linestyle(5,clblack);
  BeginFill(clblack);
  RRoundrect(-1,9,2,18,15);
  _visible:=false;
 end;
 
 
 track:=TTrackbar.create(_root,stage.height-50,1,30,1,'vertical'); //min:1 ; max:=30 ;position=1
 track._x:=stage.width-40;
 track._y:=20;
 
 timer:=setinterval(self,'onTimer',1000/track.position); 
 
 _x:=(stage.width-(stage.height-50))/2;
 _y:=25;
 tpos:=track.position;
 
 font := TextFormat.Create('arial', 12);
 with font do
 begin
  bold:=true;
  color := clwhite;
 end;
 
 Frequence:=TextField.Create(_root,'caption',2,10,0,400,20);
 Frequence.setNewTextFormat(font);
 Frequence.text:="fréquence( en images/s) ="+FloattostrF(tpos,1)+"       durée entre 2 images :  "+FloattostrF(1000/tpos,1)+'  ms';
end;
 
procedure animation.onTimer;
begin
  frame1._visible:=not Frame1._visible;
  frame2._visible:=not Frame2._visible;
  if tpos<>track.position then
  begin
   tpos:=track.position;
   clearInterval(timer);
   timer:=setinterval(self,'onTimer',1000/tpos);
   Frequence.setNewTextFormat(font);
   Frequence.text:="fréquence( en images/s) ="+FloattostrF(tpos,1)+"        durée entre 2 images :  "+FloattostrF(1000/tpos,1)+'  ms';
  end;
end;
 
begin
 animation.create;
end.