[Flash Pascal] Le type record ne passe pas

Le type record ne passe pas

Je viens de faire un test sur record, ci-joint:

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
 
program record;
{$BACKGROUND $FFFFFF}
{$FRAME_WIDTH  100}
{$FRAME_HEIGHT 100}
 
uses Flash8;
 
type
  TPoint=record
   x,y:number;
  end;
 
  myclip=class(Movieclip)
   procedure line(pt1,pt2:TPoint);
   constructor create;
  end;
 
 
function pt(x,y:number):Tpoint;
begin
 result.x:=x;
 result.y:=y;
end;
 
constructor myclip.Create;
begin
 inherited create(nil,'essai record',1);
 linestyle(3,$ff0000);
 line(pt(10,50),pt(90,50));
end;
 
procedure myclip.line(pt1,pt2:TPoint);
begin
 moveto(pt1.x,pt1.y);
 lineto(pt2.x,pt2.y);
end;
 
begin
  myclip.create;
end;

A moins que je sois très fatigué mais le type record n' est pas encore opérationnel non ?

pas dans ce cas là en effet...je corrigerais, mais pas ce soir :D

Bonne nuit !

si, si tout de suite :D
Bonne nuit

@+

bon ce n'était pas grand chose et c'est modifié :)

Disponible dans la version 12.06.14

cette version ajoute également un fenêtre "Préférences" permettant d'indiquer, entre autres, l'emplacement du Player Flash externe à utiliser.

Nickel :ccool:. Je regarde ça ...
a+

Le record est maintenant opérationnel :ccool::ccool:
Jolie présentation en français en plus. L'édition copier-coller est très appréciable.
Le fichier nouveau projet, nouvelle unité...super.
J'ai fait un test en créant une unité URealmovie.
Dans program après inclusion de URealmovie dans uses, j'ai déclaré une instance de Realmovie, ça compile.

Je n'ai pas été plus loin mais c'est très prometteur!
Je vais bientôt avoir l'impression de faire du delphi...(c'est un super compliment ...!)

un vrai chef !

bravo:bravo:

Test concluant....:ccool:

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
 
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:integer;
   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;
   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: Integer; x1, y1, x2, y2: Number);
  end;
 
 
 
function sqr(n:Double):Double;
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:Double;digit:integer):String;
var int:integer;
    frac,frac1,frac2,newnum:Double;
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;
 
implementation
 
// Méthodes de dessin de Realmovie
 
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;
 
procedure RealMovie.setSize(w, h: Integer; 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.

le program d'essai :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
program Project1;
{$FRAME_WIDTH  500}
{$FRAME_HEIGHT 500}
 
uses
  URealmovie,Flash8;
 
var mc:Realmovie;
    police:TextFormat;
 
begin
 police:=TextFormat.Create( 'Arial',24,$000000,True,False,False,'center');
 mc:=Realmovie.Create(nil,'essai unit',1);
 mc.setSize(500,500,-10,-10,10,10);
 mc.beginfill($ff0000);
 mc.RRectangle(-5,-5,5,5);
 mc.Rtextout(-3,7,200,30,1,police, 'impeccable !');
end.

:ccool: je n'ai pas essayé le with do ...

Mais là franchement, ça mérite le détour... Il commence à sérieusement bien tenir le route. :ccool:

le with do demande encore d'être finalisé...

Code:

1
2
3
4
5
6
7
8
9
10
11
 
begin
 police:=TextFormat.Create( 'Arial',24,$000000,True,False,False,'center');
 mc:=Realmovie.Create(nil,'essai unit',1);
 with mc do
  setSize(500,500,-10,-10,10,10);
  beginfill($ff0000);
  RRectangle(-5,-5,5,5);
  Rtextout(-3,7,200,30,1,police, "impeccable !");
 end;
end.

ça bloque sur le beginFill()...

deux choses

1) le "do" attend une seule instruction, donc si tu veux en mettre plusieurs il faut ajouter un "begin...end", ce n'est pas un "do...end".

2) il y a effectivement un bug, il ne trouve pas la méthode héritée beginFill :D

je corrige cela dès que possible.

oui excuse le begin, c'est un oubli..., c'est évident...je n'ai pas fait attention en le mettant en ligne.

Ok

ps: En fait, il ne trouve pas toutes les méthodes héritées de movieclip...
Sur ta dernière version, tu as un bouton marqué "rétablier" au lieu de rétablir
un partout :ccool::)