unit UBanner;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    SD: TSaveDialog;
    vclD: TImage;
    vclF: TImage;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
implementation
uses FlashObjects, SWFConst, SWFTools, ShellAPI, Math, SWFObjects;
 
{$R *.dfm}
const _FPS = 14;
 
Function CalcFrame(sec: single): word;
begin
  Result := Round(sec * _FPS);
  if Result = 0 then Result := 1;
end;
 
Function Ease(k, x: single; less: boolean): single;
begin
  if X = 0 then Result := 0
    else Result := Exp( (1 + k ) * Ln(Abs(x)));
  if less then Result := 1 - Result;
end;
 
//  =====================================================================
//                                                                      |
//                                 468 x 60                             |
//                                                                      |
//  =====================================================================
 
procedure TForm1.Button1Click(Sender: TObject);
 var
     il, FrCount: word;
     Movie: TFlashMovie;
     fntTahoma, fntCourier, fntDinCond: TFlashFont;
     Txt1, Txt2: TFLashText;
     SprButton1, SprButton2, SprStrel, TotalMC, ButEdg: TFlashSprite;
     ButSee, ButReply: TFlashButton;
     RR1, RR2, Strel, rImageD, rImageF, WhiteRect, Ballon: TFlashShape;
     imgD, imgF: TFlashImage;
     MTime: single;
     label1, label2: TSWFOffsetMarker;
 
Procedure FadeOut;
 var il: word;
begin
  For il := 0 to CalcFrame(0.6) do
   with Movie.PlaceObject(WhiteRect, 103) do
    begin
      SetScale(1, 10);
      ColorTransform.addA := Round((il - CalcFrame(0.6)) / CalcFrame(0.6) * $FF);
      if il > 0 then RemoveDepth := true;
     Movie.ShowFrame;
    end;
end;
 
Procedure FadeIn;
 var il: word;
begin
  For il := 0 to CalcFrame(0.6) do
   with Movie.PlaceObject(WhiteRect, 103) do
    begin
      SetScale(1, 10);
      ColorTransform.addA := - Round(il  / CalcFrame(0.6) * $FF);
      if il > 0 then RemoveDepth := true;
     Movie.ShowFrame;
    end;
end;
 
begin
  if not SD.Execute then Exit;
  Movie := TFlashMovie.Create(0, 0, 468 * twips, 60 * twips, _FPS);
  Movie.Compressed := true;
  Movie.Protect := true;
  // set coordinate system
  Movie.SystemCoord := scPix;
 
  // set movie background
  Movie.BackgroundColor.RGB := SWFRGB(clWhite);
 
  // add font objects to use
  fntTahoma := Movie.AddFont(Font);
  fntTahoma.AntiAlias := true;
 
  fntCourier := Movie.AddFont(Font);
  fntCourier.Name := 'Courier New';
  fntCourier.Bold := true;
  fntCourier.Size := 20 * twips;
 
  fntDinCond := Movie.AddFont(Font);
  fntDinCond.Name := 'DinCond';
  fntDinCond.Size := twips * 40;
 
  //============================= SCENE  1  ============================================
  Movie.AddRectangle(0, 0, 468, 60).SetSolidColor(cswfTransparent);
  With Movie.AddButton(false, false) do
   begin
    AddRecord(Movie.Shapes[0], SWFButtonStateAll);
    OnClickActions.GetUrl('http://www.torry.net/cgi-bin/banners.fpl?region=34&campaign=266&banner=245&mode=CLICK', '_blank');
   end;
  Movie.PlaceObject(Movie.Buttons[0], 200);
 
  Txt1 := Movie.AddText('This banner is created by', SWFRGBA(clBlack), fntCourier, Point(83, 8));
  Movie.PlaceObject(Txt1, 100);
 
  // make the edit caret
  WhiteRect := Movie.AddRectangle(0, 0, 468, 22);
  WhiteRect.SetSolidColor(cswfWhite);
  Strel := Movie.AddLine(0, 0, 0, 22);
  Strel.SetLineStyle(2, cswfBlack);
  SprStrel := movie.AddSprite;
  SprStrel.PlaceObject(WhiteRect, 1);
  SprStrel.PlaceObject(Strel, 2);
  SprStrel.ShowFrame(CalcFrame(0.4));
  SprStrel.RemoveObject(2);
  SprStrel.ShowFrame(CalcFrame(0.4));
 
  // move the caret alike entering the first line text
  for il := 0 to length(Txt1.Text) do
   with Movie.PlaceObject(SprStrel, 103) do
    begin
     SetTranslate(83 + il*12, 8);
     Movie.ShowFrame(CalcFrame(0.15));
     if il = 0 then Movie.ShowFrame(CalcFrame(1.45))
       else RemoveDepth := true;
    end;
 
  Movie.ShowFrame(CalcFrame(1));
 
  Txt1 := Movie.AddText('Delphi SWF SDK', SWFRGBA(clRed), fntCourier, Point(150, 30));
  Movie.PlaceObject(Txt1, 101);
 
  // move the caret alike entering the second line text
  for il := 0 to length(Txt1.Text) do
   with Movie.PlaceObject(SprStrel, 103) do
    begin
     SetTranslate(150 + il*12, 30);
     Movie.ShowFrame(CalcFrame(0.15));
     if il = 0 then Movie.ShowFrame(CalcFrame(1.45));
     RemoveDepth := true;
    end;
 
  Movie.ShowFrame(CalcFrame(0.5));
  Movie.RemoveObject(103);
  Movie.ShowFrame(CalcFrame(0.5));
 
  FadeOut;
 
  Movie.RemoveObject(100);
  Movie.RemoveObject(101);
 
  // ========================= Scene 2  ======================================
 
  // create image data from bitmap
  imgD := Movie.AddImage;
  imgD.LoadDataFromHandle(vclD.Picture.Bitmap.Handle);
 
  rImageD :=Movie.AddShapeImage(imgD);
  Movie.PlaceObject(rImageD, 1).SetTranslate(150, 0);
  Txt1 := Movie.AddText('Delphi', SWFRGBA(51, 51, 153, 255), fntDinCond, Point(220, 5));
  Movie.PlaceObject(Txt1, 10);
 
  FadeIn;
  Movie.ShowFrame(CalcFrame(0.5));
  FadeOut;
 
  Movie.RemoveObject(1);
  Movie.RemoveObject(10);
  // ========================= Scene 3  ======================================
 
  Txt1 := Movie.AddText('+', SWFRGBA(51, 51, 153, 255), fntDinCond, Point(230, 5));
  Movie.PlaceObject(Txt1, 10);
  FadeIn;
  Movie.ShowFrame(CalcFrame(0.2));
  FadeOut;
  Movie.RemoveObject(10);
  // ========================= Scene 4  ======================================
 
  imgF := Movie.AddImage;
  imgF.LoadDataFromHandle(vclF.Picture.Bitmap.Handle);
 
  rImageF :=Movie.AddShapeImage(imgF);
  Movie.PlaceObject(rImageF, 1).SetTranslate(150, 6);
  Txt1 := Movie.AddText('Flash', SWFRGBA(51, 51, 153, 255), fntDinCond, Point(220, 5));
  Movie.PlaceObject(Txt1, 10);
 
  FadeIn;
  Movie.ShowFrame(CalcFrame(0.5));
  FadeOut;
 
  Movie.RemoveObject(1);
  Movie.RemoveObject(10);
 
  // ========================= Scene 5  ======================================
 
  Txt1 := Movie.AddText('et crossroad two technologies', SWFRGBA(51, 51, 153, 255), fntDinCond, Point(30, 5));
  Movie.PlaceObject(Txt1, 10);
  FadeIn;
  Movie.ShowFrame(CalcFrame(2));
  FadeOut;
  Movie.RemoveObject(10);
 
  // ========================= TotalMC ======================================
 
  TotalMC := Movie.AddSprite;
 
  // balls
  Ballon := Movie.AddCircle(0, 0, 5);
  Ballon.SetRadialGradient(SWFRGBA($FF, $FF, $DD, $FF), SWFRGBA(clNavy), 35, 35);
  TotalMC.PlaceObject(Ballon, 30).SetTranslate(170, 11);
  TotalMC.PlaceObject(Ballon, 31).SetTranslate(315, 11);
  TotalMC.PlaceObject(Ballon, 9).SetTranslate(242, 53);
 
  // images
  TotalMC.PlaceObject(rImageD, 1).SetTranslate(85, 0);
  TotalMC.PlaceObject(rImageF, 2).SetTranslate(350, 6);
 
  // text
  Txt1 := Movie.AddText('Delphi  +  Flash', SWFRGBA(51, 51, 153, 255), fntDinCond, Point(0, 0));
  With TotalMC.PlaceObject(Txt1, 20) do
    begin
      SetPosition(185, -2);
      SetScale(0.55, 0.55);
    end;
  // white background
  With TotalMC.PlaceObject(Txt1, 19) do
    begin
      SetPosition(187, -1);
      SetScale(0.55, 0.55);
      ColorTransform.addR := $FF;
      ColorTransform.addG := $FF;
      ColorTransform.addB := $FF;
    end;
  With TotalMC.PlaceObject(Txt1, 18) do
    begin
      SetPosition(184, -1);
      SetScale(0.55, 0.55);
      ColorTransform.addR := $FF;
      ColorTransform.addG := $FF;
      ColorTransform.addB := $FF;
    end;
 
  Txt1 := Movie.AddText('Delphi SWF SDK', cswfRed, fntDinCond, Point(0, 0));
  With TotalMC.PlaceObject(Txt1, 17) do
    begin
      SetPosition(182, 25);
      SetScale(0.55, 0.55);
    end;
  // white background
  With TotalMC.PlaceObject(Txt1, 16) do
    begin
      SetPosition(184, 25);
      SetScale(0.55, 0.55);
      ColorTransform.addR := $FF;
      ColorTransform.addG := $FF;
      ColorTransform.addB := $FF;
    end;
  With TotalMC.PlaceObject(Txt1, 15) do
    begin
      SetPosition(181, 25);
      SetScale(0.55, 0.55);
      ColorTransform.addR := $FF;
      ColorTransform.addG := $FF;
      ColorTransform.addB := $FF;
    end;
 
 
  TotalMC.FrameActions.Stop;
  TotalMC.ShowFrame;
 
  // drawing oval
  SprStrel := Movie.AddSprite;
  For il := 1 to CalcFrame(1) do
   begin
    RR1 := Movie.AddArc(0, 0, 61, - 45, il / CalcFrame(1) *  360 - 45, false);
    RR1.SetLineStyle(1, SWFRGBA(clNavy));
    with SprStrel.PlaceObject(RR1, 1) do
     begin
       SetScale(1, 0.2);
       SetSkew(0, - 0.34);
       if il > 1 then RemoveDepth := true;
     end;
 
    if il = CalcFrame(1) then
      With SprStrel.FrameActions do
       begin
         Stop;
         SetTarget('_parent');
         Play;
       end;
    SprStrel.ShowFrame;
   end;
  TotalMC.PlaceObject(SprStrel, 3).SetTranslate(275, 33);
  With TotalMC.PlaceObject(SprStrel, 4) do
    begin
      SetTranslate(210, 33);
      SetScale(-1, 1);
    end;
  // sprite is stoped and will be playing at the next scene of the movie
  TotalMC.FrameActions.Stop;
  TotalMC.ShowFrame;
 
  // star and ball at the ovals crossing
  RR2 := Movie.AddStar(0, 0 , 25, -15, 10);
  RR2.SetRadialGradient(SWFRGBA($FF, $80, $00, $FF), SWFRGBA($FA, $FA, $FA, $FA), 50, 50);
  with TotalMC.PlaceObject(RR2, 10) do
    begin
      SetTranslate(242, 53);
      SetScale(0.5, 0.7);
    end;
  TotalMC.ShowFrame;
 
  with TotalMC.PlaceObject(RR2, 10) do
    begin
      SetTranslate(242, 53);
      SetScale(1.1, 0.8);
      RemoveDepth := true;
    end;
  TotalMC.ShowFrame;
 
  with TotalMC.PlaceObject(RR2, 10) do
    begin
      SetTranslate(242, 53);
      SetScale(1.1, 1.2);
      ColorTransform.addA := - 60;
      RemoveDepth := true;
    end;
 
  TotalMC.ShowFrame;
 
    with TotalMC.PlaceObject(RR2, 10) do
    begin
      SetTranslate(242, 53);
      SetScale(1.1, 1.2);
      ColorTransform.addA := - 180;
      RemoveDepth := true;
    end;
 
  TotalMC.RemoveObject(10);
 
  TotalMC.ShowFrame(CalcFrame(0.5));
  with TotalMC.FrameActions do
    begin
     Stop;
     SetTarget('_root');
     Play;
     SetTarget('');
    end;
  TotalMC.ShowFrame;
 
  // light is running over the oval
  SprStrel := Movie.AddSprite;
  For il := 1 to CalcFrame(1) do
   begin
    RR1 := Movie.AddArc(0, 0, 61, il/ CalcFrame(1) *  360, (il + 0.5) / CalcFrame(1) *  360, false);
    RR1.SetLineStyle(3, SWFRGBA(255, 196, 69, $EE));
    with SprStrel.PlaceObject(RR1, 1) do
     begin
       SetScale(1, 0.2);
       SetSkew(0, - 0.34);
       if il > 1 then RemoveDepth := true;
     end;
    SprStrel.ShowFrame;
   end;
  TotalMC.PlaceObject(SprStrel, 5).SetTranslate(275, 33);
 
  With TotalMC.PlaceObject(SprStrel, 7) do
    begin
      SetTranslate(210, 33);
      SetScale(-1, 1);
      Name := 'd1';
    end;
  // the second oval lightening begins to play from the second part to get lights 
  // to run in different phases
  With TotalMC.FrameActions do
    begin
     Stop;
     SetTarget('d1');
     GotoAndPlay(CalcFrame(0.5));
    end;
  TotalMC.ShowFrame;
 
  // place TotalMC at the scene
  Movie.PlaceObject(TotalMC, 1).Name := 'total';
 
  FadeIn;
  Movie.ShowFrame(CalcFrame(0.5));
 
  with Movie.FrameActions do
    begin
     Stop;
     SetTarget('total');
     Play;
    end;
  Movie.ShowFrame;
 
 
  // ====================================  Button 'See source' ==================================
  RR1 := Movie.AddRoundRect(Rect(0, 0, 80, 20), 4);
  RR1.SetLineStyle(1, cswfGray70);
  RR1.SetSolidColor(cswfWhite);
 
  RR2 := Movie.AddRoundRect(Rect(2, 2, 78, 18), 2);
  RR2.SetLineStyle(1, cswfGray30);
  RR2.SetSolidColor(SWFRGBA(240, 240, 240, 255));
 
  Strel := Movie.AddShape;
  Strel.SetShapeBound(-4, -2, 4, 4);
  Strel.SetLineStyle(1, cswfGray80);
  With Strel.Edges do
   begin
    MoveTo(-3, -4);
    LineTo(0, 0);
    LineTo(-3, 4);
    MoveTo(0, -4);
    LineTo(3, 0);
    LineTo(0, 4)
   end;
 
  SprStrel := Movie.AddSprite;
  for il := 1 to CalcFrame(0.5) do
   with SprStrel.PlaceObject(Strel, 1) do
     begin
       SetTranslate(70, 11);
       ColorTransform.addA := - il * 25;
       if il > 1 then RemoveDepth := true;
       SprStrel.ShowFrame;
     end;
  for il := CalcFrame(0.5) downto 1 do
   with SprStrel.PlaceObject(Strel, 1) do
     begin
       SetTranslate(70, 11);
       ColorTransform.addA := - il * 25;
       RemoveDepth := true;
       SprStrel.ShowFrame;
     end;
 
  Txt1 := Movie.AddText('See source', cswfGray80, fntTahoma, Point(7, 3));
 
  ButEdg := Movie.AddSprite;
  ButEdg.PlaceObject(RR1, 1);
  ButEdg.PlaceObject(RR2, 2);
 
  SprButton1 := Movie.AddSprite;
  SprButton1.PlaceObject(ButEdg, 1);
  SprButton1.PlaceObject(Txt1, 3);
  SprButton1.PlaceObject(SprStrel, 4);
  SprButton1.ShowFrame;
 
  SprButton2 := Movie.AddSprite;
  SprButton2.PlaceObject(ButEdg, 1);
  SprButton2.PlaceObject(Txt1, 3).SetTranslate(1, 1);
  SprButton2.PlaceObject(SprStrel, 4).SetTranslate(1, 1);
  SprButton2.ShowFrame;
 
  ButSee := Movie.AddButton;
  ButSee.AddRecord(RR1, [bsHitTest]);
  with ButSee.AddRecord(SprButton1, [bsUp]).ColorTransform do
   begin
     addB := 70;
     addA := -50;
   end;
  with ButSee.AddRecord(SprButton1, [bsOver]).ColorTransform do
   begin
     addR := 90;
     addG := 30;
     addB := -20;
   end;
  ButSee.AddRecord(SprButton2, [bsDown]).ColorTransform.addB := 70;
 
  ButSee.OnClickActions.GetUrl('http://www.delphiflash.com/demo-banner-maker', '_blank');
 
 // ====================================  Button 'Repeat' ==================================
  Txt1 := Movie.AddText('Play again', cswfGray80, fntTahoma, Point(7, 3));
 
  SprButton1 := Movie.AddSprite;
  SprButton1.PlaceObject(ButEdg, 1);
  SprButton1.PlaceObject(Txt1, 3);
  RR2 := Movie.AddShape;
//  RR2.SetShapeBound(-7, -4, 1, 0);
  RR2.SetLineStyle(1, cswfGray80);
  With RR2.Edges do
    begin
     MakeArc(0, 0, 5, 190, 160, false);
     MoveTo( -6, -3);
     LineTo( -5, 0);
     LineTo( -3, -2);
     RR2.Bounds.Rect := GetBoundsRect;
    end;
 
 
  with SprButton1.PlaceObject(RR2, 4) do
   begin
     SetTranslate(68, 10);
   end;
  SprButton1.ShowFrame;
 
  SprButton2 := Movie.AddSprite;
  SprButton2.PlaceObject(ButEdg, 1);
  SprButton2.PlaceObject(Txt1, 3).SetTranslate(1, 1);
  with SprButton2.PlaceObject(RR2, 4) do
   begin
     SetTranslate(69, 11);
   end;
 
  SprButton2.ShowFrame;
 
  ButReply := Movie.AddButton;
  ButReply.AddRecord(RR1, [bsHitTest]);
  with ButReply.AddRecord(SprButton1, [bsUp]).ColorTransform do
   begin
     addB := 70;
     addA := -50;
   end;
 
  with ButReply.AddRecord(SprButton1, [bsOver]).ColorTransform do
   begin
     addR := 90;
     addG := 30;
     addB := -20;
   end;
  ButReply.AddRecord(SprButton2, [bsDown]).ColorTransform.addB := 70;
 
  with ButReply.OnClickActions do
    begin
     SetTarget('_root');
     Play;
    end;
 
 //================================ Rolled text =======================================
  RR2 := Movie.AddRectangle(200, 0, 468, 10);
  RR2.SetLinearGradient(SWFRGBA(255,255,255,0), cswfWhite, 90);
 
  txt2 := Movie.AddText('- visual objects creating (shape, button, text);
'+
                        '- advanced objects (morphing shape, sprite);
'+
                        '- all types of filling (solid, gradient, image);
'+
                        '- device and embedding fonts;
'+
                        '- sound (events, streaming);
'+
                        '- video;
'+
                        '- action commands;
'+
                        '- any transition and transformation;
'+
                        'etc.', SWFRGBA(clNavy), fntTahoma, Rect(220, 60, 468, 200));
  txt2.NoSelect := true;                       
  txt2.HTML := true;
  txt2.UseOutlines := true;
  txt2.AutoSize := true;
 
  SprStrel := Movie.AddSprite;
  With SprStrel.PlaceObject(WhiteRect, 1) do
    begin
     SetScale(1, 4);
     SetTranslate(200, 0);
    end;
 
  SprStrel.PlaceObject(txt2, 5).Name := 'roll';
  SprStrel.PlaceObject(RR2, 10);
  With SprStrel.PlaceObject(RR2, 11) do
   begin
     SetScale(1, -1);
     SetTranslate(0, 50);
   end;
  SprStrel.PlaceObject(WhiteRect, 12).SetTranslate(200, 50);
 
  SprStrel.ShowFrame;
 
 // ====================================  Last scene  ==================================
  Movie.RemoveObject(200);
  MTime := 0.7;
  FrCount := CalcFrame(MTime);
 
   With Movie.PlaceObject(WhiteRect, 45) do
    begin
     SetScale(1, 4);
     SetTranslate(200, 0);
    end;
 
  for il := 0 to FrCount do
   begin
    with Movie.PlaceObject(45) do
      begin
       ColorTransform.addA := - Round( $FF * (FrCount - il)/ FrCount);
       RemoveDepth := true;
      end;
 
    with Movie.PlaceObject(TotalMC, 1) do
      begin
        SetTranslate( - Round( 145 * (Ease(3, (FrCount - il)/ FrCount, true))), 0);
        RemoveDepth := true;
      end;
 
    With Movie.PlaceObject(ButReply, 51) do
      begin
        SetTranslate(300, 60 - Round(23 * (il)/ FrCount));
        if il > 0 then RemoveDepth := true;
      end;
 
    With Movie.PlaceObject(ButSee, 50) do
      begin
        SetTranslate(383, 60 - Round(23 * (il)/ FrCount));
        if il > 0 then RemoveDepth := true;
      end;
 
    Movie.PlaceObject(1).SetTranslate(il * 10, 0);
    Movie.ShowFrame;
   end;
 
  With Movie.PlaceObject(SprStrel, 46).OnEnterFrame do
   begin
    ConstantPool(['roll', 'il']);
    Push([0, fpPosY, 0, fpPosY], [vtConstant8, vtInteger, vtConstant8, vtInteger]);
    GetProperty;
    Push([0, fpHeight], [vtConstant8, vtInteger]);
    GetProperty;
    Add2;        // roll._y + roll._height
    Push(0);
    Less;
    label1 := _If.BranchOffsetMarker;
    Push([0, fpPosY], [vtConstant8, vtInteger]);
    GetProperty;
    Push(-0.5);
    Add;
    SetProperty;
    label2 := Jump.BranchOffsetMarker;
    SetMarker(label1);
    Push(60);
    SetProperty;
    PushConstant([1, 1, 1]);
    GetVariable;
    Increment;
    SetVariable;
    GetVariable;
    Push(3);
    Equals2;
    _Not;
    label1 := _If.BranchOffsetMarker;
    Stop;
    SetTarget('_root');
    Play;
    SetMarker(label1);
    SetMarker(label2);
   end;
 
  with Movie.FrameActions do
   begin
     Stop;
     SetTarget('total');
     Play;
   end;
  Movie.ShowFrame;
  FadeOut;
 
  Movie.MakeStream;
  Movie.SaveToFile(SD.FileName);
  Movie.Free;
 
  ShellExecute(handle, PChar('open'), PChar(SD.FileName), nil, nil, sw_Normal);
end;