Program Project1;
Uses
Windows, Messages, SysUtils,
Direct3D8, D3dX8;
{$R Swf.res}
Const
DEF_MAIN_WND_CLASS_NAME = '{E6AA4E57-62BE-4bf3-AF8C-7EE68FA9D2A4}';
DEF_MAIN_WND_WIDTH = 480;
DEF_MAIN_WND_HEIGHT = 480;
DEF_WIDTH = 128;
DEF_HEIGHT = 128;
D3DFVF_MYVERTEX = D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_TEX1;
FLASHDLL = 'FlashPlayerControl.DLL';
WC_FLASH = 'FlashPlayerControl';
FPCS_TRANSPARENT = $00000001;
Function RegisterFlashWindowClass(): BOOL; Stdcall; External FLASHDLL;
Procedure UnregisterFlashWindowClass(); Stdcall; External FLASHDLL;
Function FPCPutMovieFromResourceA(hwndFlashPlayerControl: HWND; INSTANCE: HINST; lpName, lpType: LPCSTR): BOOL; Stdcall; External FLASHDLL;
Function FPC_Play(hwndFlashPlayerControl: HWND): HRESULT; Stdcall; External FLASHDLL;
Type
TMYVERTEX = Record
X, Y, Z: Single;
Color: D3DCOLOR;
Tu, Tv: Single;
End;
Var
MainHwnd, FlashHwnd: THandle;
IsClose: Boolean = False;
CurrentFilter: D3DTEXTUREFILTERTYPE;
D3D: IDirect3D8 = Nil;
D3DD: IDirect3DDevice8 = Nil;
D3DVB: IDirect3DVertexBuffer8 = Nil;
Function CreateTextureFromFlash: IDirect3DTexture8;
Var
pTexture: IDirect3DTexture8;
D3DSD: D3DSURFACE_DESC;
RcLockedRect: D3DLOCKED_RECT;
FPCGetFrameBitmap: SFPCGetFrameBitmap;
BmpInfo: BITMAP;
pTextureBits, pLineTextureBits: PBYTE;
pBitmapBits, pPixels: PDWORD;
i, j: Integer;
Begin
pTexture := Nil;
D3DXCreateTexture(D3DD, DEF_WIDTH, DEF_HEIGHT, 1, 0, D3DFMT_A8R8G8B8, D3DPOOL_MANAGED, pTexture);
If pTexture = Nil Then Result := pTexture;
pTexture.GetLevelDesc(0, D3DSD);
MoveWindow(FlashHwnd, 0, 0, D3DSD.Width, D3DSD.Height, TRUE);
FillChar(RcLockedRect, SizeOf(RcLockedRect), 0);
pTexture.LockRect(0, RcLockedRect, Nil, D3DLOCK_DISCARD);
FillChar(FPCGetFrameBitmap, SizeOf(FPCGetFrameBitmap), 0);
SendMessage(FlashHwnd, FPCM_GET_FRAME_BITMAP, 0, Cardinal(@FPCGetFrameBitmap));
GetObject(FPCGetFrameBitmap.BITMAP, SizeOf(BmpInfo), @BmpInfo);
pTextureBits := PBYTE(RcLockedRect.pBits);
pBitmapBits := PDWORD(BmpInfo.bmBits);
pLineTextureBits := pTextureBits;
For j := 0 To D3DSD.Height - 1 Do
Begin
pPixels := PDWORD(pLineTextureBits);
For i := 0 To D3DSD.Width - 1 Do
Begin
pPixels^ := pBitmapBits^;
Inc(Integer(pPixels), 4);
Inc(Integer(pBitmapBits), 4);
End;
Inc(Integer(pLineTextureBits), RcLockedRect.Pitch);
End;
DeleteObject(FPCGetFrameBitmap.BITMAP);
pTexture.UnlockRect(0);
Result := pTexture;
End;
Procedure FlashRenderScene;
Var
pTexture: IDirect3DTexture8;
WorldM, ViewM, ProjectionM: TD3DXMatrix;
Begin
D3DD.Clear(0, Nil, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, D3DCOLOR_RGBA(100, 100, 100, 50), 1.0, 0);
D3DD.BeginScene;
D3DXMatrixIdentity(WorldM);
D3DXMatrixRotationZ(WorldM, GetTickCount / 1024.0); D3DD.SetTransform(D3DTS_WORLD, WorldM);
D3DXMatrixLookAtLH(ViewM, D3DXVECTOR3(5.0, 5.0, 6.5), D3DXVECTOR3(0.0, 0.0, 1.0), D3DXVECTOR3(0.0, 0.0, 1.0));
D3DD.SetTransform(D3DTS_VIEW, ViewM);
D3DXMatrixPerspectiveFovLH(ProjectionM, D3DX_PI / 3, 1.0, 1.0, 100.0);
D3DD.SetTransform(D3DTS_PROJECTION, ProjectionM);
pTexture := CreateTextureFromFlash();
D3DD.SetTexture(0, pTexture);
D3DD.SetTextureStageState(0, D3DTSS_MAGFILTER, CurrentFilter);
D3DD.SetTextureStageState(0, D3DTSS_MINFILTER, CurrentFilter);
D3DD.SetTextureStageState(0, D3DTSS_MIPFILTER, CurrentFilter);
D3DD.SetStreamSource(0, D3DVB, SizeOf(TMYVERTEX));
D3DD.SetVertexShader(D3DFVF_MYVERTEX);
D3DD.DrawPrimitive(D3DPT_TRIANGLELIST, 0, 4);
D3DD.EndScene();
D3DD.Present(Nil, Nil, 0, Nil);
If pTexture <> Nil Then pTexture._Release;
End;
Function InitFlashDirectX3D(Hwd: HWND): Boolean;
Procedure AssignMyVertex(Var Vertex: TMYVERTEX; X, Y, Z, Tu, Tv: Single);
Begin
Vertex.X := X; Vertex.Y := Y; Vertex.Z := Z;
Vertex.Color := $00FFFFFF;
Vertex.Tu := Tu; Vertex.Tv := Tv;
End;
Const
AA = 5;
Var
Present_Parameters: D3DPRESENT_PARAMETERS;
pVertices: Pointer;
A, B, C, D, E: TMYVERTEX;
Vertices: Array[0..11] Of TMYVERTEX;
Begin
Result := False;
CurrentFilter := D3DTEXF_NONE;
D3D := Direct3DCreate8(D3D_SDK_VERSION);
If D3D = Nil Then Exit;
FillChar(Present_Parameters, SizeOf(Present_Parameters), 0);
Present_Parameters.Windowed := TRUE;
Present_Parameters.hDeviceWindow := Hwd;
Present_Parameters.BackBufferFormat := D3DFMT_A8R8G8B8;
Present_Parameters.SwapEffect := D3DSWAPEFFECT_DISCARD;
Present_Parameters.AutoDepthStencilFormat := D3DFMT_D16;
Present_Parameters.EnableAutoDepthStencil := TRUE;
If FAILED(D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Hwd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, Present_Parameters, D3DD)) Then
If FAILED(D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_REF, Hwd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, Present_Parameters, D3DD)) Then
Exit;
D3DD.SetRenderState(D3DRS_ZENABLE, D3DZB_TRUE);
D3DD.SetRenderState(D3DRS_CULLMODE, D3DCULL_CW);
D3DD.SetRenderState(D3DRS_LIGHTING, D3DZB_FALSE);
AssignMyVertex(A, -AA / 2, AA / 2, 0, 0, 1);
AssignMyVertex(B, -AA / 2, -AA / 2, 0, 0, 0);
AssignMyVertex(C, AA / 2, -AA / 2, 0, 1, 0);
AssignMyVertex(D, AA / 2, AA / 2, 0, 1, 1);
AssignMyVertex(E, 0, 0, AA / Sqrt(2.0), 0.5, 0.5);
Vertices[0] := E; Vertices[1] := A; Vertices[2] := D;
Vertices[3] := E; Vertices[4] := B; Vertices[5] := A;
Vertices[6] := E; Vertices[7] := C; Vertices[8] := B;
Vertices[9] := E; Vertices[10] := D; Vertices[11] := C;
If FAILED(D3DD.CreateVertexBuffer(SizeOf(Vertices), 0, D3DFVF_MYVERTEX, D3DPOOL_DEFAULT, D3DVB)) Then
Exit;
If FAILED(D3DVB.Lock(0, SizeOf(Vertices), PBYTE(pVertices), 0)) Then
Exit;
CopyMemory(pVertices, @Vertices, SizeOf(Vertices));
D3DVB.Unlock();
D3DVertexBuffer8SetData();
Result := TRUE;
End;
Procedure UnInitFlashDirectX3D;
Begin
If D3DVB <> Nil Then D3DVB := Nil;
If D3DD <> Nil Then D3DD := Nil;
If D3D <> Nil Then D3D := Nil;
End;
Function WndProc(HWND: THandle; Msg: Integer; wParam: wParam; LPARAM: LPARAM): HRESULT; Stdcall;
Begin
Result := HRESULT(0);
Case Msg Of
WM_DESTROY:
Begin
PostQuitMessage(WM_QUIT);
IsClose := TRUE;
End;
End;
Result := DefWindowProc(HWND, Msg, wParam, LPARAM);
End;
Function WinMain(Hinst: Hinst; hPrevInst: Hinst; lpCmdLine: PChar; nCmdShow: Integer): Integer; Stdcall;
Label
End_;
Var
WndCls: TWndClass;
Msg: TMsg;
Begin
Result := 0;
WndCls.Style := CS_DBLCLKS;
WndCls.lpfnWndProc := @WndProc;
WndCls.cbClsExtra := 0;
WndCls.cbWndExtra := 0;
WndCls.HINSTANCE := Hinst;
WndCls.hIcon := 0;
WndCls.hCursor := LoadCursor(0, IDC_ARROW);
WndCls.hbrBackground := GetSysColorBrush(COLOR_APPWORKSPACE);
WndCls.lpszClassName := DEF_MAIN_WND_CLASS_NAME;
If RegisterClass(WndCls) = 0 Then Goto End_;
MainHwnd := CreateWindow(WndCls.lpszClassName, PChar('FlashPlayerControl Example - FlashTexture'),
WS_SYSMENU Or WS_OVERLAPPED Or WS_MINIMIZEBOX,
GetSystemMetrics(SM_CXSCREEN) Div 2 - DEF_MAIN_WND_WIDTH Div 2,
GetSystemMetrics(SM_CYSCREEN) Div 2 - DEF_MAIN_WND_HEIGHT Div 2,
DEF_MAIN_WND_WIDTH, DEF_MAIN_WND_HEIGHT,
0, 0, Hinst, Nil);
If MainHwnd = 0 Then Goto End_;
If Not RegisterFlashWindowClass Then Goto End_;
FlashHwnd := CreateWindow(WC_FLASH, Nil, WS_CHILD Or FPCS_TRANSPARENT, 0, 0, DEF_WIDTH, DEF_HEIGHT, MainHwnd, 0, 0, Nil);
If FlashHwnd = 0 Then Goto End_;
FPCPutMovieFromResourceA(FlashHwnd, Hinst, 'MOVIE', 'FLASH');
FPC_Play(FlashHwnd);
If Not InitFlashDirectX3D(MainHwnd) Then Goto End_;
ShowWindow(MainHwnd, nCmdShow);
UpdateWindow(MainHwnd);
While (Msg.message <> WM_QUIT) Do
Begin
If PeekMessage(Msg, 0, 0, 0, PM_REMOVE) Then
Begin
TranslateMessage(Msg);
DispatchMessage(Msg);
End Else FlashRenderScene;
If IsClose Then Break;
End;
End_:
UnInitFlashDirectX3D;
UnregisterFlashWindowClass();
UnregisterClass(WndCls.lpszClassName, Hinst);
Result := Msg.wParam;
End;
Begin
WinMain(HINSTANCE, 0, Nil, SW_NORMAL);
End.
It's great!