Delphi控件源码

开发平台：

Delphi

FlashCanvasControl.pas：源码内容

							unit FlashCanvasControl;
interface
 Uses Windows, FlashPlayerControl, FlashObjects, Classes;
type
  TFlashCanvasControl = class(TFlashPlayerControl)
  private
    FFlashMovie: TFlashMovie;
    CurentDepth: word;
    FVersionMovie: byte;
    function GetFlashCanvas: TFlashCanvas;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property FlashMovie: TFlashMovie read FFlashMovie;
    property FlashCanvas: TFlashCanvas read GetFlashCanvas;
    procedure UpdateCanvas;
  published
    property VersionMovie: byte read FVersionMovie write FVersionMovie;
  end;
procedure Register;
implementation
Uses Forms, SWFConst, SWFObjects;
constructor TFlashCanvasControl.Create(AOwner: TComponent);
begin
 inherited;
  SAlign := 'LT';
  Scale := 'NoScale'; 
  FFlashMovie := TFlashMovie.Create(0, 0, twips * Screen.Width, twips * Screen.Height, 1);
  FFlashMovie.SystemCoord := scPix;
  FFlashMovie.Version := 6;
  CurentDepth := 1;
end;
destructor TFlashCanvasControl.Destroy;
begin
  FFlashMovie.Free;
  inherited;
end;
function TFlashCanvasControl.GetFlashCanvas: TFlashCanvas;
begin
  result := FFlashMovie.Canvas;
end;
procedure TFlashCanvasControl.UpdateCanvas;
 var MS: TMemoryStream;
begin
  MS := TMemoryStream.Create;
  if (FFlashMovie.ObjectList.Count > 0) and
    (FFlashMovie.ObjectList[FFlashMovie.ObjectList.Count - 1] is TSWFShowFrame) then
      FFlashMovie.ObjectList.Delete(FFlashMovie.ObjectList.Count - 1);
  FFlashMovie.Canvas.Place(CurentDepth, true);
  FFlashMovie.ShowFrame;
  FFlashMovie.MakeStream;
  FFlashMovie.SaveToStream(MS);
  LoadMovieFromStream(0, MS);
  MS.Free;
  inc(CurentDepth);
end;
procedure Register;
begin
  RegisterComponents('Flash', [TFlashCanvasControl]);
end;
end.

						