Delphi控件源码

开发平台：
Delphi

UShape.pas：源码内容
							//*******************************************************//
//                                                       //
//                      DelphiFlash.com                  //
//              Copyright (c) 2004 FeatherySoft, Inc.    //
//                    info@delphiflash.com               //
//                                                       //
//*******************************************************//
//  Description: Demonstrates kind of shape
//  Last update: 29 oct 2004
unit UShape;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, Menus, FlashPlayerControl;
type
  TFormShape = class(TForm)
    Panel1: TPanel;
    GB: TGroupBox;
    RB1: TRadioButton;
    RB2: TRadioButton;
    RB3: TRadioButton;
    RB4: TRadioButton;
    RB5: TRadioButton;
    RB6: TRadioButton;
    RB7: TRadioButton;
    Player: TFlashPlayerControl;
    RB8: TRadioButton;
    FontDialog: TFontDialog;
    RB9: TRadioButton;
    procedure GBClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    tmpName, demoName: string;
  end;
var
  FormShape: TFormShape;
implementation
 Uses SWFStreams, FlashObjects, SWFTools, SWFConst, FontReader;
{$R *.dfm}
const
  SelfLineStyle : array [0..3] of byte = (4, 3, 1, 3);
procedure TFormShape.GBClick(Sender: TObject);
 var SH: array [0..5] of TFlashShape;
     Movie: TFlashMovie;
     MS: TMemoryStream;
     il:integer;
     AColor: array [0..7] of recRGBA;
     Img: TFlashImage;
     DC: HDC;
begin
 Movie := TFlashMovie.Create(0, 0, 400*twips, 300*twips, 10);
 Movie.SystemCoord := scPix;
 for il := 0 to 5 do SH[il] := nil;
 if RB1.Checked then
   begin
     // Line
    SH[0] := Movie.AddLine(10, 20, 200, 60);
    SH[0].SetLineStyle(3, SWFRGB(clRed));
    SH[1] := Movie.AddLine(150, 20, 150, 60);
    SH[1].SetLineStyle(5, SWFRGBA(clBlue, 150));
    SH[2] := Movie.AddLine(10, 50, 200, 20);
    SH[2].SetLineStyle(1, SWFRGB(clGreen));
    SH[2].ExtLineStyle.SetStyle([6,4,1,4]);
   end else
 if RB2.Checked then
   begin
    SH[0] := Movie.AddRectangle(10, 20, 200, 60);
    SH[0].SetLinearGradient(SWFRGBA(clred), SWFRGBA(clblack),0);
    SH[1] := Movie.AddSquare(100, 100, 100);
    SH[1].SetRadialGradient(SWFRGBA(clAqua), SWFRGBA(clblack),50, 50);
    SH[2] := Movie.AddDiamond(40, 40, 140, 240);
    SH[2].SetSolidColor(SWFRGBA(clBlue, 150));
    SH[3] := Movie.AddRoundRect(20, 150, 170, 240, 30);
    SH[3].SetSolidColor(SWFRGBA(clgreen, 150));
   end else
 if RB3.Checked then
   begin
    SH[0] := Movie.AddEllipse(10, 20, 200, 60);
    SH[0].SetLinearGradient(SWFRGBA(clred), SWFRGBA(clblack),0);
    SH[1] := Movie.AddCircle(100, 140, 80);
    SH[1].SetRadialGradient(SWFRGBA(clAqua), SWFRGBA(clblack),35, 35);
   end else
 if RB4.Checked then
   begin
    SH[0] := Movie.AddRing(150, 50, 70, 30);
    SH[0].SetLinearGradient(SWFRGBA(clred), SWFRGBA(clblack),0);
    SH[1] := Movie.AddPie(100, 100, 50, - 45, 225);
    SH[1].SetRadialGradient(SWFRGBA(clAqua), SWFRGBA(clblack),50, 50);
    SH[2] := Movie.AddArc(150, 150, 100, 225, 315);
    SH[2].SetSolidColor(SWFRGBA(clBlue, 150));
   end else
 if RB5.Checked then
   begin
    SH[0] := Movie.AddCurve(Point(50, 100),
                            Point(120, 30),
                            Point(300,100));
    SH[0].SetLineStyle(3, SWFRGB(clRed));
    SH[1] := Movie.AddCurve(Point(100, 20),
                            Point(200, 250),
                            Point(200, 50));
    SH[1].SetLineStyle(3, SWFRGBA(clblue, 180));
    SH[2] := Movie.AddCubicBezier(Point(10, 50),
                            Point(52, 226),
                            Point(375, 13),
                            Point(275, 210));
    SH[2].SetLineStyle(3, SWFRGB(clGreen));
   end else
 if RB6.Checked then
   begin
    SH[0] := Movie.AddLine(10, 20, 350, 250);
    SH[0].SetLineStyle(1, SWFRGB(clGreen));
    SH[1] := Movie.AddShape;
    SH[1].SetShapeBound(20, 20, 350, 220);
    SH[1].SetLineStyle(1, SWFRGB(clBlue));
    SH[1].SetLinearGradient(SWFRGBA(clred), SWFRGBA(clblack),-45);
    with SH[1].Edges do
      begin
       MoveTo(50, 20);
       MakeRectangle(250, 200);
       MoveTo(100, 70);
       MakeEllipse(40, 40);
       MoveTo(150, 60);
       MakeRectangle(30, 100);
       MakePolyline([Point(280, 200),
                        Point(20, 200),
                        Point(20, 170),
                        Point(200, 170),
                        Point(200, 40)]);
       MakeCubicBezier(Point(300, 80),
                          Point(200, 100),
                          Point(280, 200));
       MoveTo(315, 70);
       MakeRectangle(35, 150);
       EndEdges;
      end;
   end else
 if RB7.Checked then
   begin
    SH[0] := Movie.AddStar(50, 50, 50, 15, 20, false);
    SH[0].SetLinearGradient(SWFRGBA(clred), SWFRGBA(clblack),0);
    SH[1] := Movie.AddStar(150, 50, 50, 30, 8, true);
    SH[1].SetRadialGradient(SWFRGBA(clAqua), SWFRGBA(clblack),50, 50);
    SH[2] := Movie.AddStar(150, 150, -25, 50, 12, false);
    SH[2].SetSolidColor(SWFRGBA(clBlue, 150));
    SH[3] := Movie.AddStar(50, 150, 20, 70, 12, true);
    SH[3].SetRadialGradient(SWFRGBA(clOlive), SWFRGBA(clYellow),50, 50);
   end else
 if RB8.Checked then
   begin
    FontDialog.Execute;
    SH[0] := Movie.AddShape;
    SH[0].SetLineStyle(1, SWFRGBA(clSilver, $cc));
    DC := CreateCompatibleDC(0);
    DeleteObject(SelectObject(DC, FontDialog.Font.Handle));
    GetCharOutlines(DC, Ord('S'), SH[0].Edges);
    DeleteDC(DC);
    With SH[0] do
      begin
        CalcBounds;
        Edges.OffsetEdges(-XMin + 100, -YMin + 50);
        CalcBounds;
        SetLinearGradient(SWFRGBA(clred), SWFRGBA(clblack),0);
      end;
   end else
 if RB9.Checked then
   begin
     SH[0] := Movie.AddShape;
     With SH[0] do
      begin
       StyleChangeMode := scmLast;
       Edges.MoveTo(50, 50);
       Edges.MakeRoundRect(230, 130, 20);
       CalcBounds;
       SetLineStyle(8, SWFRGBA(clGreen, $80));
       SetSolidColor(cswfGray20);
       Edges.MoveTo(100, 100);
       Edges.MakeEllipse(30, 30);
       SetLineStyle(2, cswfYellow);
       SetLinearGradient(SWFRGBA(clred), SWFRGBA(clblack),0).ScaleTo(
           Rect(100* twips, 100*twips, 130* twips, 130*twips));
       Edges.MoveTo(200, 100);
       Edges.MakeEllipse(30, 30);
       SetLineStyle(2, cswfBlack);
       SetRadialGradient(SWFRGBA(clOlive), SWFRGBA(clYellow), 50, 50).ScaleTo(
           Rect(200* twips, 100*twips, 230* twips, 130*twips));
      end; 
   end;
 for il := 0 to 5 do
   if SH[il] = nil then break
     else Movie.PlaceObject(SH[il], il);
 Movie.ShowFrame;
 Movie.MakeStream;
 MS := TMemoryStream.Create;
 Movie.SaveToStream(MS);
 Movie.Free;
// uncomment next line for SWF file testing
// MS.SaveToFile('demo_exshape.swf');
 MS.Position := 0;
 Player.LoadMovieFromStream(0, MS);
 MS.Free;
end;
end.

						