Delphi控件源码

开发平台：
Delphi

UTestXML.pas：源码内容
							//*******************************************************//
//                                                       //
//                      DelphiFlash.com                  //
//         Copyright (c) 2004-2006 FeatherySoft, Inc.    //
//                    info@delphiflash.com               //
//                                                       //
//*******************************************************//
//  Description:  Sample of making XML from SWF and conversely
//  Last update:  27 jun 2006
unit UTestXML;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SWFStreams, SWFObjects, FlashObjects, ShellApi, ComCtrls;
type
  TdlgName = class(TForm)
    OD: TOpenDialog;
    Label1: TLabel;
    ProgressBar: TProgressBar;
    GroupBox1: TGroupBox;
    CBExt: TCheckBox;
    CBSubFolder: TCheckBox;
    CBSomeFolder: TCheckBox;
    CBFontExt: TCheckBox;
    CBFBytecode: TCheckBox;
    CBActionExt: TCheckBox;
    CBABytecode: TCheckBox;
    bMakeXML: TButton;
    GroupBox2: TGroupBox;
    bMakeSWF: TButton;
    RB1: TRadioButton;
    RB2: TRadioButton;
    procedure bMakeXMLClick(Sender: TObject);
    procedure bMakeSWFClick(Sender: TObject);
    procedure CBSubFolderClick(Sender: TObject);
    procedure CBFontExtClick(Sender: TObject);
  private
    procedure onProcess(sender: TBasedSWFStream; Percent: byte; WT: TProgressWorkType);
  public
    SWF: TSWFStreamReader;
    Movie: TFlashMovie;
  end;
var
  dlgName: TdlgName;
implementation
{$R *.dfm}
procedure TdlgName.bMakeXMLClick(Sender: TObject);
 var Stt: string;
begin
  OD.Filter := 'SWF|*.swf';
  if OD.Execute then
    begin
      Screen.Cursor := crHourGlass;
      SWF := TSWFStreamReader.Create('');
      With SWF.XMLReadWriteSettings do
       begin
         BasePath := ExtractFilePath(OD.FileName);
         if CBExt.Checked then
            AsExternal := [lpImage, lpSound, lpVideo]
           else
            AsExternal := [];
         if CBFontExt.Checked then
           AsExternal := AsExternal + [lpFont];
         if CBActionExt.Checked then
           AsExternal := AsExternal + [lpActions];
         FontAsByteCode := CBFBytecode.Checked;
         ActionsAsByteCode := CBABytecode.Checked;
         if CBSubFolder.Checked then
           begin
             Stt := BasePath + ChangeFileExt(ExtractFileName(OD.FileName), '.files');
//             uncoment for testing releative path
//             stt := 'c:temp' + ChangeFileExt(ExtractFileName(OD.FileName), '.files');
             SomePath := CBSomeFolder.Checked;
             if CBSomeFolder.Checked then
               begin
                Path := Stt;
                CreateDir(Path);
               end else
               begin
                 PathImage := Stt + '_I';
                 CreateDir(PathImage);
                 PathSound := Stt + '_S';
                 CreateDir(PathSound);
                 PathVideo := Stt + '_V';
                 CreateDir(PathVideo);
                 PathFont := Stt + '_F';
                 CreateDir(PathFont);
                 PathActions := Stt + '_A';
                 CreateDir(PathActions);
               end;
           end else
            FilePrefix := ChangeFileExt(ExtractFileName(OD.FileName), '_');
       end;
      SWF.OnProgress := onProcess;
      SWF.LoadFromFile(OD.FileName);
      SWF.SaveToXMLFile(ChangeFileExt(OD.FileName, '.xml'));
      SWF.Free;
      label1.Caption := '';
      ProgressBar.Position := 0;
      Screen.Cursor := crDefault;
    end;
end;
procedure TdlgName.bMakeSWFClick(Sender: TObject);
 var BaseSWF: TBasedSWFStream;
begin
  OD.Filter := 'XML|*.xml';
  if OD.Execute then
    begin
      Screen.Cursor := crHourGlass;
      if RB1.Checked
        then
          BaseSWF := TSWFStreamReader.Create('')
        else
          BaseSWF := TFlashMovie.Create(0, 0, 1, 1, 1);
          
      BaseSWF.OnProgress := onProcess;
      BaseSWF.LoadFromXMLFile(OD.FileName, true);
      BaseSWF.MakeStream;
      BaseSWF.SaveToFile(ChangeFileExt(OD.FileName, '_new.swf'));
      BaseSWF.Free;
      label1.Caption := '';
      ProgressBar.Position := 0;
      ShellExecute(0, 'open', pchar(ChangeFileExt(OD.FileName, '_new.swf')), nil, nil, SW_NORMAL);
      Screen.Cursor := crDefault;
    end;
end;
procedure TdlgName.onProcess(sender: TBasedSWFStream; Percent: byte; WT: TProgressWorkType);
 var Lbl: string;
begin
  case WT of
   pwtReadStream: Lbl := 'Loading file';
   pwtMakeStream: Lbl := 'Making SWF stream';
   pwtLoadXML: Lbl := 'Loading XML';
   pwtParseXML: Lbl := 'Parsing XML';
   pwtSaveXML: Lbl := 'Saving XML';
   pwtCompressStream: Lbl := 'Compressing stream';
  end;
  if Lbl <> Label1.Caption then
    begin
      label1.Caption := Lbl;
      label1.Update;
    end;
  ProgressBar.Position := Percent;
end;
procedure TdlgName.CBSubFolderClick(Sender: TObject);
begin
  CBSomeFolder.Enabled := CBSubFolder.Checked;
end;
procedure TdlgName.CBFontExtClick(Sender: TObject);
begin
  CBFBytecode.Enabled := CBFontExt.Checked;
end;
end.

						