Charger un SWF depuis un TStream

Version imprimable

Je reprend ce fil ici car ça peut vous intéresser.

Le code ci-dessous montre comment charger un SWF depuis un TStream (resource, file, memory...)

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
 
unit Main;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;
 
type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
    procedure LoadSWF(const AFileName: string);
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses
  ShockwaveFlashObjects_TLB, ActiveX;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  if OpenDialog1.Execute then
    LoadSWF(OpenDialog1.FileName);
end;
 
procedure TForm1.LoadSWF(const AFileName: string);
var
  SWF       : TShockWaveFlash;
  FileStream: TFileStream;
  MemStream : TMemoryStream;
  Len       : Integer;
  Ptr       : ^Integer;
  PStream   : IPersistStreamInit;
  AStream   : IStream;
begin
// Creation de l'ActiveX
  SWF := TShockWaveFlash.Create(Self);
  SWF.Parent := Self;
  SWF.SetBounds(0, 0, ClientWidth, ClientHeight);
 
// Ouverture du fichier, mais ça pourrait être une ressource
  FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
  try
  // on va le copier en mémoire
    MemStream := TMemoryStream.Create;
    try
      Len := FileStream.Size;
    // il nous faut 8 octets de plus...
      MemStream.SetSize(Len + 8);
      Ptr := MemStream.Memory;
   // 4 pour stocker la valeur "magique"
      Ptr^ := $55665566; // Magic tag !
      Inc(Ptr);
   // 4 pour stocker la taille du fichier
      Ptr^ := Len;
      Inc(Ptr);
   // et on place le fichier à la suite
      FileStream.ReadBuffer(Ptr^, Len);
 
    // maintenant on demande un PersistStream à l'ActiveX
      IUnknown(SWF.OleObject).QueryInterface(IPersistStreamInit, PStream);
    // on créer un wrapper pour notre stream (pas la peine de le libérer c'est un TInterfacedObject)
      AStream := TStreamAdapter.Create(MemStream);
    // et on le charge, c'est tout !
      PStream.Load(AStream);
 
    finally
      MemStream.Free;
    end;
  finally
    FileStream.Free;
  end;
end;
 
end.

22/12/2012, 09h23
Roland Chastain

Effectivement, c'est intéressant mais pour ma part je n'ai pas réussi à m'en servir. :(

Pour commencer je ne sais même pas si j'ai la bonne unité. En tapant le nom dans un moteur de recherche, on tombe sur plusieurs versions différentes. Pourrais-tu donner un lien, et préciser aussi la version de Delphi que tu utilises ?
22/12/2012, 12h47
Paul TOTH

Delphi 6

mais en fait point n'est besoin de rechercher l'unité :)

tu lances Delphi, prenons XE2 par exemple.

menu Composants/Importer un composant
- Importer un contrôle ActiveX
- choisir "Shockwave Flash" dans la liste
- suivant
- suivant
- terminé

et voilà ! par la magie de l'automation COM tu as une unité qui décrit la classe Shockwave (voir à ce sujet mon livre "Delphi 7 Studio" page 518)
22/12/2012, 14h19
Roland Chastain

Merci pour la réponse.

Cette fois, ça marche. :ccool:

Hello,

Delphi 7 Studio, c'est toujours la bonne vieille bible ! :lol:
Bonne année à tout le monde...
mon sapin perso en reprenant l'étoile des exemples...

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
 
program Pfete;
 
{$FRAME_WIDTH 425}
{$FRAME_HEIGHT 400}
{$FRAME_RATE 5}
{$BACKGROUND $F5F5FF}
 
 
uses
  Flash8;
 
type
 
 TBoule=class(movieclip)
  boul1,boul2:movieclip;
  procedure change(bool:boolean);
  constructor Create(parent:movieclip;numero:integer;);
 end;
 
 TEtoile = class(MovieClip)
    etoil1,etoil2:movieclip;
    procedure change(bool:boolean);
    constructor create(parent:movieclip);
  end;
 
 
 sapin=class(movieclip)
  clignote:boolean;
  etoile:TEtoile;
  e:TextField;
  boule:array[1..11] of TBoule;
  procedure onEnterFrame;override;
  constructor create;
 end;
 
const  couleurboule:array[1..11,1..2] of number=(($ff0000,$0000ff),($ffff00,$00ffff),($ff00ff,$00ffff),($ff00e2,$ff0000),($00ff00,$0000ff),($FFD700,$FF4500),($800080,$FF7F50),($DC1436,$E9967A),($008080,$FF69B4),($D2691E,$BDB76B),($CD5C5C,$00008B));
 
Procedure circle(Cx,Cy,Radius,col:number;mc:movieclip);
var a,b,R: number;
begin
    R:=Radius;
    a:= R * 0.414213562;
    b:= R * 0.707106781;
  with mc do
  begin
   beginfill(col);
   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);
   endFill();
  end;
end;
 
procedure tracerUneEtoile(r1, r2, n, c1, c2: Integer;mc:movieclip);
var
  da : Double;
   i : Integer;
   a : Double;
   r : Integer;
 x,y : Double;
begin
  da := Math.PI / n;
  with mc do
  begin
   lineStyle(0, c1);
   moveTo(r2, 0);
   beginFill(c2);
   for i := 1 to 2 * n do
   begin
     a := da * i;
     if (i mod 2) = 0 then
     r := r2
   else
    r := r1;
    x := r * cos(a);
    y := r * sin(a);
    lineTo(x, y);
  end;
 end;
 end;
 
constructor TEtoile.create(parent:movieclip);
begin
 inherited create(parent,'etoile',parent.getNextHighestDepth());
 etoil1:=movieclip.create(self,'1',0);
 etoil2:=movieclip.create(self,'1',1);
 tracerUneEtoile(10,30, 8, 0, $FFFF00,etoil1);
 etoil1._visible:=true;
 tracerUneEtoile(10,30, 8, 0, $FFD700,etoil2);
 etoil2. _visible:=false;
end;
 
procedure TEtoile.change(bool:boolean);
begin
 if bool then
 begin
  etoil1._visible:=false;
  etoil2._visible:=true;
  _xscale:=100;
  _yscale:=100;
 end
 else
 begin
  etoil1._visible:=true;
  etoil2._visible:=false;
  _xscale:=110;
  _yscale:=110;
 end;
end;
 
constructor Sapin.Create;
begin
 inherited Create(_Root,'sapin',0);
 
 etoile:=TEtoile.Create(self);
 with etoile do
 begin
  _x := stage.width/2;
  _y :=35;
 end;
 
 beginFill(clgreen);
 moveto(stage.width/2,50);
 lineto(stage.width/2-50,100);
 lineto(stage.width/2+50,100);
 lineto(stage.width/2,50);
 
 moveto(stage.width/2,100);
 lineto(stage.width/2-100,160);
 lineto(stage.width/2+100,160);
 lineto(stage.width/2,100);
 
 moveto(stage.width/2,160);
 lineto(stage.width/2-150,240);
 lineto(stage.width/2+150,240);
 lineto(stage.width/2,160);
 
 moveto(stage.width/2,240);
 lineto(stage.width/2-200,320);
 lineto(stage.width/2+200,320);
 lineto(stage.width/2,240);
 
 beginFill(800000);
 moveto(stage.width/2-10,320);
 lineto(stage.width/2+10,320);
 lineto(stage.width/2+10,stage.height);
 lineto(stage.width/2-10,stage.height);
 lineto(stage.width/2-10,320);
 
 boule[1]:=TBoule.create(self,1);
 boule[1]._x:=stage.width/2-100;
 boule[1]._y:=170;
 
 boule[2]:=TBoule.create(self,2);
 boule[2]._x:=stage.width/2+100;
 boule[2]._y:=170;
 
 boule[3]:=TBoule.create(self,3);
 boule[3]._x:=stage.width/2-150;
 boule[3]._y:=250;
 
 boule[4]:=TBoule.create(self,4);
 boule[4]._x:=stage.width/2+150;
 boule[4]._y:=250;
 
 boule[5]:=TBoule.create(self,5);
 boule[5]._x:=stage.width/2-200;
 boule[5]._y:=330;
 
 boule[6]:=TBoule.create(self,6);
 boule[6]._x:=stage.width/2+200;
 boule[6]._y:=330;
 
 boule[7]:=TBoule.create(self,7);
 boule[7]._x:=stage.width/2-50;
 boule[7]._y:=110;
 
 boule[8]:=TBoule.create(self,8);
 boule[8]._x:=stage.width/2+50;
 boule[8]._y:=110;
 
 boule[9]:=TBoule.create(self,9);
 boule[9]._x:=stage.width/2;
 boule[9]._y:=220;
 
 boule[10]:=TBoule.create(self,10);
 boule[10]._x:=stage.width/2;
 boule[10]._y:=140;
 
 boule[11]:=TBoule.create(self,11);
 boule[11]._x:=stage.width/2;
 boule[11]._y:=300;
 
 e:=TextField.Create(self,'fete',self.getNextHighestDepth(),stage.width/2-45,stage.height-140,105,30);
 e.setNewTextFormat(TextFormat.Create('papirus',17,$FFFBF0, True, True,False,'','','center'));
 e.text:="Bonnes fêtes !";
 clignote:=false;
end;
 
procedure Sapin.onEnterFrame;
var i:integer;
begin
  clignote:=not clignote;
  for i:=1 to 11 do boule[i].change(clignote);
  etoile.change(clignote);
end;
 
procedure TBoule.change(bool:boolean);
begin
 if bool then
 begin
  boul1._visible:=false;
  boul2._visible:=true;
  _xscale:=100;
  _yscale:=100;
 end
 else
 begin
  boul1._visible:=true;
  boul2._visible:=false;
  _xscale:=120;
  _yscale:=120;
 end;
end;
 
constructor TBoule.Create(parent:movieclip;numero:integer);
begin
 inherited create(parent,'boule',parent.getNextHighestDepth());
 
 
 boul1:=movieclip.create(self,'boul1',1);
 with boul1 do
 begin
   circle(0,0,10,couleurboule[numero,1],boul1);
   circle(-3,3.5,1.5,$ffffff,boul1);
   _visible:=true;
 end;
 
 boul2:=movieclip.create(self,'boul2',2);
 with boul2 do
 begin
   circle(0,0,10,couleurboule[numero,2],boul2);
   circle(-3,3.5,1.5,$ffffff,boul2);
   _visible:=false;
 end;
end;
 
begin
 Sapin.create;
end.

03/01/2013, 19h15
Roland Chastain

Bonne année Anthony !

J'aime bien ton sapin. J'étais tenté de vous lancer un défi à Paul et à toi sur ce sujet mais j'ai eu l'idée un peu trop tard. Rendez-vous en décembre prochain ! ;)
03/01/2013, 19h35
Archimède

Bonne année à toi Roland :lol:
Le rendez-vous est pris bien qu'il soit prétentieux de vouloir rivaliser avec Paul :lol: vu combien il balade...

a+