Delphi控件源码

开发平台：
Delphi

UMerg.pas：源码内容
							//*******************************************************//
//                                                       //
//                      DelphiFlash.com                  //
//              Copyright (c) 2004 FeatherySoft, Inc.    //
//                    info@delphiflash.com               //
//                                                       //
//*******************************************************//
//  Description: Demonstration of the existing swf file
//               merging with additional info
//  Last update: 31 oct 2004
unit UMerg;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, OleCtrls, ShockwaveFlashObjects_TLB, ShockwaveEx,
  StdCtrls, FlashPlayerControl, FlashCanvasControl, ExtDlgs;
type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Player: TShockwaveFlashEx;
    Bevel1: TBevel;
    CB1: TCheckBox;
    CB2: TCheckBox;
    Button2: TButton;
    OD: TOpenPictureDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CB1Click(Sender: TObject);
  private
    { Private declarations }
  public
    MTempl: boolean;
    nameImg1, nameImg2: string;
    Size1, Size2: TSize;
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
Uses FlashObjects, SWFConst, SWFStreams, SWFObjects, JPEG;
procedure TForm1.Button1Click(Sender: TObject);
 var Movie: TFlashMovie;
     stt: string;
begin
// Making of a swf file template 
  Movie := TFlashMovie.Create(0, 0, 300 * twips, 200 * twips, 10);
  Movie.SystemCoord := scPix;
  Movie.AddRectangle(0, 0, 300, 200).SetLinearGradient(cswfRed, cswfBlack, 90);
  Movie.PlaceObject(Movie.Shapes[0], 1);
  with Movie.AddFont(Font, false) do
   begin
     Name := 'Tahoma';
     AddChars(AllEnglishChars);
   end;
// Performing an area for the first image placing
  with Movie.AddRoundRect(0, 0, 100, 100, 5) do
    begin
      SetSolidColor(cswfWhite);
      SetLineStyle(1, cswfBlack);
    end;
  Movie.AddDynamicText('name1', 'name1', cswfWhite, Movie.Fonts[0], Rect(2, 102, 98, 120)).Align := taCenter;
  with Movie.AddSprite do
   begin
     PlaceObject(Movie.Shapes[1], 1).Name := 'img1';
     PlaceObject(Movie.Texts[0], 3);
     with PlaceObject(Movie.Texts[0], 2) do
       begin
         InitColorTransform(true, -$FF, -$FF, -$FF, -88, false, 0, 0, 0, 0, true);
         SetTranslate(1, 1);
       end;
   end;
// Performing an area for the second image placing   
  with Movie.AddRoundRect(0, 0, 100, 100, 5) do
    begin
      SetSolidColor(cswfWhite);
      SetLineStyle(1, cswfBlack);
    end;
  Movie.AddDynamicText('name2', 'name2', cswfWhite, Movie.Fonts[0], Rect(2, 102, 98, 120)).Align := taCenter;
  with Movie.AddSprite do
   begin
     PlaceObject(Movie.Shapes[2], 1).Name := 'img2';
     PlaceObject(Movie.Texts[1], 3);
     with PlaceObject(Movie.Texts[1], 2) do
       begin
         InitColorTransform(true, -$FF, -$FF, -$FF, -88, false, 0, 0, 0, 0, true);
         SetTranslate(1, 1);
       end;
   end;
  with Movie.PlaceObject(Movie.Sprites[0], 2) do
    begin
      SetTranslate(30, 50);
      Name := 'prew1';
    end;
  with Movie.PlaceObject(Movie.Sprites[1], 3) do
    begin
      SetTranslate(170, 50);
      Name := 'prew2';
    end;
  Movie.ShowFrame;
  Movie.MakeStream;
  stt := ExtractFilePath(ParamStr(0)) + 'template.swf';
  Movie.SaveToFile(stt);
  Movie.Free;
  Player.Movie := stt;
  MTempl := true;
end;
procedure TForm1.Button2Click(Sender: TObject);
 var stt: string;
     MR: TSWFStreamReader;
     il: integer;
     Movie: TFlashMovie;
     SO: TSWFObject;
     ID_Img1, ID_Img2, newID1, newID2: word;
     IsProcess: boolean;
     FS: TSWFImageFill;
begin
  if not (CB1.Checked or CB2.Checked) then
    begin
      ShowMessage('Please check any option.');
      Exit;
    end;
  if not MTempl then
    begin
      ShowMessage('Please make a template.');
      Exit;
    end;
  stt := ExtractFilePath(ParamStr(0)) + 'template.swf';
  MR := TSWFStreamReader.Create(stt);
  MR.ReadBody;
  Movie := TFlashMovie.Create(MR.MovieRect.Left, MR.MovieRect.Top,
                              MR.MovieRect.Right, MR.MovieRect.bottom, MR.FPS);
  Movie.Version := MR.Version;
  Movie.CurentObjID := 1000;
// Searching an object ID for placing the image into the one
  if CB1.Checked then
    ID_Img1 := TSWFDefineShape(MR.FindObjectFromName('img1')).ShapeId
    else ID_Img1 := $FFFF;
  if CB2.Checked then
    ID_Img2 := TSWFDefineShape(MR.FindObjectFromName('img2')).ShapeId
    else ID_Img2 := $FFFF;
  for il := 0 to MR.TagList.Count - 1 do
   begin
     IsProcess := true;
     Case MR.TagInfo[il].TagID of
       tagShowFrame:
         begin
           IsProcess := false;
           Movie.ShowFrame;
         end;
       tagPlaceObject2:
        with TSWFPlaceObject2(MR.TagInfo[il].SWFObject) do
         begin
           if not CB1.Checked then
             IsProcess := not ((Name = 'prew1') or (Name = 'img1') or (Name = 'name1'));
           if not CB2.Checked then
             IsProcess := not ((Name = 'prew2') or (Name = 'img2')  or (Name = 'name2'));
         end;
       tagDefineShape2, tagDefineShape3:
        with TSWFDefineShape(MR.TagInfo[il].SWFObject) do
         begin
           if (ShapeId = ID_Img1) then
              newID1 := Movie.AddImage(nameImg1).CharacterId;
           if (ShapeId = ID_Img2) then
              newID2 := Movie.AddImage(nameImg2).CharacterId;
         end;
     end;
     if IsProcess then
       begin
        SO := GenerateSWFObject(MR.TagInfo[il].TagID);
        SO.Assign(MR.TagInfo[il].SWFObject);
        Movie.ObjectList.Add(SO);
        case MR.TagInfo[il].TagID of
         tagDefineEditText:   // Changing of a text template to an image file name
          with TSWFDefineEditText(SO) do
            if (VariableName = 'name1') and CB1.Checked then InitialText := ExtractFileName(nameImg1) else
            if (VariableName = 'name2') and CB2.Checked then InitialText := ExtractFileName(nameImg2);
         tagDefineShape2, tagDefineShape3:
          with TSWFDefineShape(SO) do
           begin
             if (ShapeId = ID_Img1) or (ShapeId = ID_Img2) then
              begin           // Adding of an image filling
                FillStyles.Clear;
                FS := TSWFImageFill.Create;
                FS.SWFFillType := SWFFillClipBitmap;
                if ShapeId = ID_Img1 then
                  begin
                    FS.ImageID := newID1;
                    FS.ScaleTo(Rect(0, 0, 100*twips, 100*twips), Size1.cx, Size1.cy);
                  end else
                  begin
                    FS.ImageID := newID2;
                    FS.ScaleTo(Rect(0, 0, 100*twips, 100*twips), Size2.cx, Size2.cy);
                  end;
                FillStyles.Add(FS);
                TSWFStyleChangeRecord(Edges[0]).Fill1Id := FillStyles.Count;
              end;
           end;
        end;
       end;
   end;
  Movie.MakeStream;
  stt := ExtractFilePath(ParamStr(0)) + IntToStr(Random(999999))+'.swf';
  Player.Movie := stt;
  DeleteFile(stt);
  stt := ExtractFilePath(ParamStr(0)) + 'merge.swf';
  Movie.SaveToFile(stt);
  MR.Free;
  Movie.Free;
  Player.Movie := stt;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
  Player.CreateWnd;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  nameImg1 := '';
  nameImg2 := '';
  MTempl := false;
end;
procedure TForm1.CB1Click(Sender: TObject);
 var P: TPicture;
begin
  if TCheckBox(Sender).Checked then
   begin
    if OD.Execute then
    begin
     P := TPicture.Create;
     P.LoadFromFile(OD.FileName);
     if sender = CB1 then
       begin
         nameImg1 := OD.FileName;
         Size1.cx := P.Width;
         Size1.cy := P.Height;
       end else
       begin
         nameImg2 := OD.FileName;
         Size2.cx := P.Width;
         Size2.cy := P.Height;
       end;
     P.Free;
    end else TCheckBox(Sender).Checked := false;
   end;
end;
end.

						