www.pudn.com > Roulette.rar > Main.pas
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, DXClass, DXDraws, DirectX, ScktComp,
SConnect, rltClient, rltgame, DXInput, mmsystem, DXSounds,DXWave, KBGM, ULoading;
type
TMainForm = class(TDXForm)
DXDraw: TDXDraw;
DXTimer: TDXTimer;
OpenDialog: TOpenDialog;
DXInput1: TDXInput;
DXSound: TDXSound;
procedure DXDrawInitialize(Sender: TObject);
procedure DXDrawFinalize(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure DXDrawClick(Sender: TObject);
procedure DXDrawInitializeSurface(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure DXDrawMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure DXDrawMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure DXSoundFinalize(Sender: TObject);
procedure DXSoundInitialize(Sender: TObject);
private
FileName: string;
Mesh, BallMesh: IDirect3DRMMesh;
Mesh0, Mesh1, Mesh2, Mesh3: IDirect3DRMMesh;
BallMeshFrame, MeshFrame, DyMeshFrame: IDirect3DRMFrame;
WrapType: TD3DRMWRAPTYPE;
wrap: IDirect3DRMWrap;
FMouseSurface : TDirectDrawSurface;
FPlayPanelFrame : TDirectDrawSurface;
FPlayPanelBK : TDirectDrawSurface;
FItemsSurface : TDirectDrawSurface;
FChipPanelSurface : TDirectDrawSurface;
FHistoryPanelSurface : TDirectDrawSurface;
FPausedSurface : TDirectDrawSurface;
FRollAudio, FBetChipAudio, FStartAudio, FStopAudio,
FSelChipAudio, FBounceAduio : TAudioFileStream;
FNumAudio : array[0..36] of TAudioFileStream;
procedure CreateWarp;
procedure ApplyWarp;
procedure AppIdle(Sender:TObject; var Done : boolean);
procedure DataLoad;
procedure OpeningDemo;
procedure Connect;
procedure GameStart;
procedure StartDemo;
procedure InitMidi;
public
Midihandle : THDATA;
midi_ok : integer;
KeyList : TList;
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
procedure DrawMouse;
procedure DrawFPS;
procedure DrawRoulette;
procedure DrawPlayerPanels;
procedure DrawChipPanel;
procedure DrawTimePanel;
procedure DrawHistoryPanel;
procedure DrawScore;
procedure DrawPaused;
procedure PlaySoundBeginBet();
procedure PlaySoundBetting();
procedure PlaySoundStopBet();
procedure PlaySoundSelChip();
procedure PlaySoundBounce();
procedure PlaySoundNum(Num : integer);
procedure PlayWheel();
procedure FInitMidi;
private
VertexCount, FaceCount, GroutCount,PausedCount :Integer;
end;
var
MainForm: TMainForm;
implementation
uses TltConst, ClientInterpreter;
{$R *.DFM}
procedure TMainForm.CreateWarp;
var
miny, maxy, height: TD3DVALUE;
box: TD3DRMBOX;
ov, sv: Double;
begin
Mesh.GetBox(box);
maxy := box.max.y;
miny := box.min.y;
height := maxy - miny;
if height=0 then height := 0.00001;
ov := D3DDivide(miny, height) ;
sv := D3DDivide(-1.0, height) /4;
if WrapType=D3DRMWRAP_SPHERE then
begin
DXDraw.D3DRM.CreateWrap(D3DRMWRAP_SPHERE, nil,
0, 0, 0,
0, 0, 1,
0, 1, 0,
0, 0,
1, 1,
Wrap
);
wrap.Apply(Mesh);
end else
if WrapType=D3DRMWRAP_CHROME then
begin
DXDraw.D3DRM.CreateWrap(D3DRMWRAP_CHROME, DXDraw.Camera,
0, 0, 0,
0, 0, 1,
0, 1, 0,
0, ov,
1, sv,
Wrap
);
wrap.ApplyRelative(MeshFrame, Mesh);
end else
begin
DXDraw.D3DRM.CreateWrap(WrapType, nil,
0, 0, 0,
0, 0, 1,
0, 1, 0,
0, ov,
1, sv,
Wrap
);
wrap.Apply(Mesh);
end;
end;
procedure TMainForm.ApplyWarp;
begin
if WrapType=D3DRMWRAP_CHROME then
wrap.ApplyRelative(MeshFrame, Mesh);
end;
procedure TMainForm.DXDrawFinalize(Sender: TObject);
begin
Wrap := nil;
Mesh := nil;
MeshFrame := nil;
BallMesh:= nil;
Mesh0 := nil;
Mesh1 := nil;
Mesh2 := nil;
Mesh3 := nil;
BallMeshFrame := nil;
DyMeshFrame :=nil;
FreeAndNil(FMouseSurface);
FreeAndNil(FPlayPanelFrame);
FreeAndNil(FPlayPanelBK);
FreeAndNil(FItemsSurface);
FreeAndNil(FChipPanelSurface);
FreeAndNil(FHistoryPanelSurface);
FreeAndNIl(FPausedSurface);
end;
procedure TMainForm.DXDrawInitializeSurface(Sender: TObject);
begin
if doHardware in DXDraw.NowOptions then
begin
{ Bi-linear filtering }
DXDraw.D3DRMDevice.SetTextureQuality(D3DRMTEXTURE_LINEAR);
end;
{ Alpha blending }
DXDraw.D3DRMDevice2.SetRenderMode(D3DRMRENDERMODE_BLENDEDTRANSPARENCY or
D3DRMRENDERMODE_SORTEDTRANSPARENCY);
end;
procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
const
WrapChangeList: array[D3DRMWRAP_FLAT..D3DRMWRAP_CHROME] of TD3DRMWRAPTYPE =
(D3DRMWRAP_CYLINDER, D3DRMWRAP_SPHERE, D3DRMWRAP_CHROME, D3DRMWRAP_FLAT);
begin
{ Wrap method change }
{ if Key=VK_SPACE then
begin
WrapType := WrapChangeList[WrapType];
CreateWarp;
end;}
{ Application end }
if Key=VK_ESCAPE then
Close;
{ Screen mode change }
if (ssAlt in Shift) and (Key=VK_RETURN) then
begin
DXDraw.Finalize;
if doFullScreen in DXDraw.Options then
begin
RestoreWindow;
//DXDraw.Cursor := crNone;
BorderStyle := bsSingle;
DXDraw.Options := DXDraw.Options - [doFullScreen];
end else
begin
StoreWindow;
//DXDraw.Cursor := crNone;
BorderStyle := bsNone;
DXDraw.Options := DXDraw.Options + [doFullScreen];
end;
DXDraw.Initialize;
end;
KeyList.Add(Pointer(Key));
end;
procedure TMainForm.DXDrawClick(Sender: TObject);
var
w: Word;
begin
{ w := VK_RETURN;
if doFullScreen in DXDraw.Options then
FormKeyDown(nil, w, [ssAlt]);
if OpenDialog.Execute then
begin
FileName := OpenDialog.FileName;
DXDraw.Initialize;
end;}
end;
procedure TMainForm.AfterConstruction;
begin
inherited;
Application.OnIdle := AppIdle;
init();
end;
procedure TMainForm.BeforeDestruction;
begin
inherited;
finit();
end;
procedure TMainForm.AppIdle(Sender: TObject; var Done: boolean);
var
waitTime,TempTime : LongInt;
begin
//计算帧数
if ((GetTickCount - FrameTime)>1000) then
begin
FrameRate := Frame1*1000 div (GetTickCount-FrameTime);
Frame1 := 0;
FrameTime := GetTickCount;
end;
Frame1 := Frame1 + 1;
//得到输入
DXInput1.Update;
//处理场景
case Level1 of
0:DataLoad;
1:GameStart;
5:Connect;
21:OpeningDemo;
255:Close;
end;
//Wait
WaitTime := 30;//50fps;
//if (EditWait <> 9)then
begin
TempTime := LastTime + WaitTime - TimeGetTime;
if (tempTime < 0) then TempTime := 0;
if (tempTime > 25)then TempTime := 25;
if TempTime > 10 then
sleep(TempTime); //33s at lest
while ((TimeGetTime-LastTime)<(WaitTime)) do;
end;
LastTime := TimeGetTime;
Done := False;
end;
procedure TMainForm.DataLoad;
begin
Level2 := 1;
Level1 := 21;
end;
procedure TMainForm.OpeningDemo;
begin
// BGMDisable;
// demo1.Present;
StartDemo;
// Key1.GetKey; //側偤偐昁梫丒丒丒
Level1 := 5;
Level2 := 1;
end;
procedure TMainForm.Connect;
var
ConnectBmp, Msgboxbmp : TDirectDrawSurface;
Count : integer;
lt : longint;
Trans : longint;
MSGBoxRect, YesRect, CancelRect : TRect;
Center, Cursor : TPoint;
SurfaceDesc: TDDSurfaceDesc;
begin
{ ConnectBmp := TDirectDrawSurface.Create(DXDraw.DDraw);
Msgboxbmp := TDirectDrawSurface.Create(DXDraw.DDraw);
// LogoBmp.GammaControl.SetGammaRamp(0, DDGammaRamp)
ConnectBmp.LoadFromFile('bmp\connecting.bmp');
//Msgboxbmp.LoadFromFile('bmp\msgbox.bmp');
FillChar(SurfaceDesc, sizeof(SurfaceDesc), $0);
with SurfaceDesc do
begin
dwSize := sizeof(SurfaceDesc);
dwFlags := DDSD_HEIGHT or DDSD_WIDTH or DDSD_CAPS or DDSCAPS_COMPLEX;
dwHeight := 600;
dwWidth := 800;
// dwAlphaBitDepth := 100;
ddsCaps.dwCaps := DDSCAPS_SYSTEMMEMORY;
end;
// SurfaceDesc/
Msgboxbmp.CreateSurface(SurfaceDesc);
DXInput1.Update;
Count := 0;
while ((not RltConnection.Connected) and (not Application.Terminated)) do
begin
inc(count);
lt := GetTickCount;
DXInput1.Update;
if DXDraw.CanDraw then
begin
DXDraw.Surface.FillRect(Rect(0,0,DXDraw.Width,DXDraw.Height) ,0);
if Count = 1 then RltConnection.Connected := true;
if (Count <500) then
begin
if RltConnection.GetLastError <> 0 then Count := 450;
//draw connecting
case (Count div 25)mod 2 of
0: Trans := 256;
1: Trans := 0;
end;
DXDraw.Surface.DrawAlpha(Rect(DXDraw.Width div 2 - 150,
DXDraw.Height div 2 - 45,
DXDraw.Width div 2 + 150,
DXDraw.Height div 2 + 45),
Rect(0,0,300,90), ConnectBmp, true, Trans);
end
else
begin
//提示对话框
Count := 500;
Center := Point(DXDraw.Width div 2,DXDraw.Height div 2);
YesRect := Rect(Center.X-45,Center.Y-10,Center.X+45, Center.Y + 10);
OffsetRect(YesRect, -60,20);
CancelRect := YesRect;
OffsetRect(CancelRect, 120,0);
MSGBoxRect := Rect(DXDraw.Width div 2 - 150,
DXDraw.Height div 2 - 45,
DXDraw.Width div 2 + 150,
DXDraw.Height div 2 + 45);
//DXDraw.Surface.Canvas.Release;
with Msgboxbmp.Canvas do
if DXDraw.CanDraw then
begin
Font.Charset := GB2312_CHARSET;
Pen.Color := $FD956c;
Pen.Style := psSolid;
Brush.Style := bsClear;
Font.Color := $FD956c;
Font.Name := '宋体';
Font.Size := 9;
DXInput1.Update;
GetCursorPos(Cursor);
Cursor := DXDraw.ScreenToClient(Cursor);
Brush.Style := bsSolid;
Brush.Color := $555555;
if PtInRect(YesRect, Cursor) then FillRect(YesRect);
if PtInRect(CancelRect, Cursor) then FillRect(CancelRect);
Brush.Style := bsClear;
with MSGBoxRect do Rectangle(Left, Top, Right, Bottom);
with YesRect do Rectangle(Left, Top, Right, Bottom);
with CancelRect do Rectangle(Left, Top, Right, Bottom);
if PtInRect(YesRect, Cursor) then Font.Color := clWhite else Font.Color := $FD956c;
TextOut(YesRect.Left+26, YesRect.Top+4, '重 试');
if PtInRect(CancelRect, Cursor) then Font.Color := clWhite else Font.Color := $FD956c;
TextOut(CancelRect.Left+26, CancelRect.Top+4, '取 消');
Font.Color := clWhite;
TextOut(MSGBoxRect.Left+26, MSGBoxRect.Top+20, '连接服务器失败!');
Release;
DXDraw.Surface.Draw(0,0,Rect(0,0,800, 600), Msgboxbmp, false);
DrawMouse;
//鼠标被按下
if isButton1 in DXInput1.Mouse.States then
begin
if PtInRect(YesRect, Cursor) then
begin
Count := 0;
Continue;
end;
if PtInRect(CancelRect, Cursor) then
begin
Break;
end;
end;
//Unlock;
end;
end;
DXDraw.Flip;
end
else
begin
Messagebox(Handle, '连接失败', '', MB_OK or MB_ICONERROR);
Application.Terminate;
Break;
end;
Application.ProcessMessages;
if (GetTickCount-lt)<25 then sleep(GetTickCount-lt);
while ((GetTickCount-lt)<30) do;
end;
ConnectBmp.Free;
Msgboxbmp.Free;
}
MainForm.Visible := false;;
Count := 0;
while ((not RltConnection.Connected) and (not Application.Terminated)) do
begin
inc(Count);
lt := GetTickCount;
DXInput1.Update;
if Count = 1 then RltConnection.Connected := true;
if (Count <500) then
begin
case (Count div 25)mod 2 of
0: begin
ShowLoading('连接服务中...');
end;
1: begin
ShowLoading('连接服务中 ');
end;
end;
if RltConnection.GetLastError <> 0 then Count := 450;
end
else
begin
if IDYes = MessageBox(Handle, '连接服务器失败,是否重试?','', MB_YESNO or MB_ICONQUESTION) then
begin
Count := 0;
Continue;
end else
Break;
end;
Application.ProcessMessages;
if (GetTickCount-lt)<25 then sleep(GetTickCount-lt);
while ((GetTickCount-lt)<30) do;
if RltConnection.Connected then
begin
TltInterpreter := TrltClientInterpreter(RltConnection.GetInterpreter);
if TltInterpreter.CallGetCurrentRound.State = rsStop then
begin
RltConnection.Connected := false;
end;
end;
end;
HideLoading;
if RltConnection.Connected then
begin
MainForm.Visible := True;
rlt.Round.State := rsBeting ;
TltInterpreter := TrltClientInterpreter(RltConnection.GetInterpreter);
rlt.TimeSetting :=TltInterpreter.CallGetTimeSetting;
Level1 := 1;
InitMidi;
end else
Level1 := 255;
end;
var
Counter : integer = 0;
procedure TMainForm.GameStart;
begin
rlt.Update;
rlt.Draw;
//draw
end;
procedure TMainForm.StartDemo;
var
LogoBmp : TDirectDrawSurface;
Count : integer;
lt : longint;
// DDGammaRamp : TDDGammaRamp;
DDColorControl : TDDColorControl;
Trans : longint;
begin
if not DXDraw.CanDraw then Exit;
LogoBmp := TDirectDrawSurface.Create(DXDraw.DDraw);
// LogoBmp.GammaControl.SetGammaRamp(0, DDGammaRamp)
LogoBmp.LoadFromFile(ExtractFilePath(Application.ExeName)+'bmp\logo.bmp');
DXInput1.Update;
Count := 0;
while (Count<100)and(DXInput1.States = []) do
begin
inc(count);
lt := GetTickCount;
DXInput1.Update;
DXDraw.Surface.FillRect(Rect(0,0,DXDraw.Width,DXDraw.Height) ,0);
case Count of
0..50: Trans := Count * 256 div 50;
51..99 : Trans := (100 - Count) * 256 div 50;
end;
DXDraw.Surface.DrawAlpha(Rect(DXDraw.Width div 2 - 150,
DXDraw.Height div 2 - 45,
DXDraw.Width div 2 + 150,
DXDraw.Height div 2 + 45),
Rect(0,0,300,90), LogoBmp, true, Trans);
DXDraw.Flip;
while ((GetTickCount-lt)<30) do;
end;
LogoBmp.Free;
end;
procedure TMainForm.DXDrawInitialize(Sender: TObject);
var
LightFrame: IDirect3DRMFrame;
Light, AmbientLight: IDirect3DRMLight;
MeshBuilder, MeshBuilder2: IDirect3DRMMeshBuilder;
image1,image2,image3,image4: IDirect3DRMTexture;
Result : HRESULT;
//Mesh, NewMesh : IDirect3DRMMesh;
FaceArray : IDirect3DRMFaceArray;
VertexArray : IDirect3DRMVisualArray;
Face : IDirect3DRMFace;
i : integer;
V : TD3DRMVertex;
vertices: TD3DVector;
ncount: DWORD;
normals: TD3DVector;
face_data_size: DWORD;
face_data: DWORD;
vCount ,
fCount, vPerFace,
fDataSize, fData : DWORD;
index : TD3DRMGroupIndex;
returnPtr: TD3DRMVertex;
IMaterial: IDirect3DRMMaterial;
type
TArrayVertex = array of TD3DRMVertex;
PArrayVertex = ^TArrayVertex;
var
ArrayVertex : array[0..500] of TD3DRMVertex;
NormalVertex : array[0..500] of TD3DRMVertex;
buf : array [0..5000] of DWORD;
groupid : TD3DRMGroupIndex;
begin
vCount := 0;
fCount := 0;
vPerFace:= 0;
{ Frame making }
DXDraw.D3DRM.CreateFrame(DXDraw.Scene, LightFrame);
DXDraw.D3DRM.CreateFrame(DXDraw.Scene, MeshFrame);
DXDraw.D3DRM.CreateFrame(DXDraw.Scene, DyMeshFrame);
DXDraw.D3DRM.CreateFrame(DXDraw.Scene, BallMeshFrame);
{ Light setting }
DXDraw.D3DRM.CreateLightRGB(D3DRMLIGHT_DIRECTIONAL, 5, 5, 5, Light);
LightFrame.AddLight(Light);
DXDraw.D3DRM.CreateLightRGB(D3DRMLIGHT_AMBIENT, 0.5, 0.5, 0.5, AmbientLight);
DXDraw.Scene.AddLight(AmbientLight);
{ Frame position and posture setting }
//方向光源
LightFrame.SetPosition(DXDraw.Scene, 0, 240, -300);
LightFrame.SetOrientation(DXDraw.Scene, -1, -1, 1, 0.0, 1.0, 0.0);
DXDraw.Camera.SetPosition(DXDraw.Scene, 0, 80, -80);
DXDraw.Camera.SetOrientation(DXDraw.Scene, 0,-1, 1, 0, 1, 0);
MeshFrame.SetPosition(DXDraw.Scene, 0, 0, 0);
MeshFrame.SetOrientation(DXDraw.Scene, 0.0, 1, 0, 0.0, 1.0, 0.0);
MeshFrame.SetRotation(DXDraw.Scene, 0,1 , 0, 0.05);
DyMeshFrame.SetPosition(DXDraw.Scene, 0, 0, 0);
DyMeshFrame.SetOrientation(DXDraw.Scene, 0.0, 1, 0, 0.0, 1.0, 0.0);
DyMeshFrame.SetRotation(DXDraw.Scene, 0,1 , 0, 0.05);
BallMeshFrame.SetPosition(DXDraw.Scene, 0, 0, 0);
BallMeshFrame.SetOrientation(DXDraw.Scene, 0.0, 1, 0, 0.0, 1.0, 0.0);
BallMeshFrame.SetRotation(DXDraw.Scene, 0,1 , 0, 0.05);
{ Mesh making }
DXDraw.D3DRM.CreateMeshBuilder(MeshBuilder);
DXDraw.D3DRM.CreateMeshBuilder(MeshBuilder2);
//if FileName='' then
FileName := ExtractFilePath(Application.ExeName)+'1.X';
ChDir(ExtractFilePath(FileName));
Result := MeshBuilder.Load(PChar(FileName), nil, D3DRMLOAD_FROMFILE, nil, nil);
MeshBuilder.Translate(15,0,2.5);
if (Result <> D3DRM_OK) then
begin
ShowMessage(IntToHex(Result,2));
end;
MeshBuilder.Scale(5,5 , 5);
MeshBuilder.SetColor(D3DRGB(1, 1, 1));
DXDraw.D3DRM.LoadTexture(PChar(ExtractFilePath(Application.ExeName)+'bmp\round512.bmp'), image1);
DXDraw.D3DRM.LoadTexture(PChar(ExtractFilePath(Application.ExeName)+'bmp\edge.BMP'), image2);
DXDraw.D3DRM.LoadTexture(PChar(ExtractFilePath(Application.ExeName)+'bmp\metal.bmp'), image3);
DXDraw.D3DRM.LoadTexture(PChar(ExtractFilePath(Application.ExeName)+'bmp\desktop.bmp'), image4);
// MeshBuilder.SetTexture(image);
// MeshBuilder.CreateMesh(Mesh);
VertexCount := MeshBuilder.GetVertexCount;
FaceCount := MeshBuilder.GetFaceCount;
MeshBuilder.GetFaces(FaceArray);
MeshBuilder.GetVertices(vcount, vertices, ncount, normals, face_data_size, face_data);
MeshBuilder.CreateMesh(Mesh);
GroutCount := mesh.GetGroupCount;
DXDraw.D3DRM2.CreateMesh(Mesh0);
DXDraw.D3DRM2.CreateMesh(Mesh1);
DXDraw.D3DRM2.CreateMesh(Mesh2);
DXDraw.D3DRM2.CreateMesh(Mesh3);
fDataSize := 5000;
fData := DWORD(@buf);
Mesh.GetGroupMaterial(0, IMaterial);
Result :=( Mesh.GetGroup(0,PDWord( vCount), PDWord(fCount), PDWord(vPerFace), fDataSize, PDWORD(fData)));
if (Result <> D3DRM_OK) then
begin
ShowMessage(IntToHex(Result,2));
end;
Result := Mesh.GetVertices(0, 0, vCount, PD3DRMVertex(@ArrayVertex)^);
if (Result <> D3DRM_OK) then
begin
ShowMessage(IntToHex(Result,2));
end;
Mesh0.AddGroup(vCount, fCount, vPerFace, PDWORD(@buf)^, groupid);
Mesh0.SetGroupQuality(groupid, D3DRMRENDER_FLAT);
Mesh0.SetVertices(0,0,vCount, PD3DRMVertex(@ArrayVertex)^);
Mesh0.SetGroupTexture(groupid, image2);
Mesh0.SetGroupQuality(0, Mesh.GetGroupQuality(0));
Mesh0.SetGroupMaterial(0, IMaterial);
// Mesh0.SetGroupQuality(0, Mesh.GetGroupQuality(0));
fDataSize := 5000;
vCount := 0;
fCount := 0;
vPerFace:= 0;
fData := DWORD(@buf);
Result := Mesh.GetGroup(1, @vCount, @fCount, @vPerFace, fDataSize, PDWORD(fData));
if (Result <> D3DRM_OK) then
begin
ShowMessage(IntToHex(Result,2));
end;
Result := Mesh.GetVertices(1, 0, vCount, PD3DRMVertex(@ArrayVertex)^);
if (Result <> D3DRM_OK) then
begin
ShowMessage(IntToHex(Result,2));
end;
Mesh1.AddGroup(vCount, fCount, vPerFace, PDWORD(@buf)^, groupid);
Mesh1.SetGroupQuality(groupid, D3DRMRENDER_FLAT);
Mesh1.SetVertices(0,0,vCount, PD3DRMVertex(@ArrayVertex)^);
Mesh1.SetGroupTexture(groupid, image4);
Mesh1.SetGroupMaterial(0, IMaterial);
Mesh1.SetGroupQuality(0, Mesh.GetGroupQuality(0));
fDataSize := 5000;
Mesh.GetGroup(2, @vCount, @fCount, @vPerFace, fDataSize, PDWORD(fData));
Mesh.GetVertices(2, 0, vCount, PD3DRMVertex(@ArrayVertex)^);
Mesh2.AddGroup(vCount, fCount, vPerFace, PDWORD(@buf)^, groupid);
Mesh2.SetGroupQuality(groupid, D3DRMRENDER_FLAT);
Mesh2.SetVertices(0,0,vCount, PD3DRMVertex(@ArrayVertex)^);
Mesh2.SetGroupTexture(groupid, image3);
Mesh2.SetGroupMaterial(0, IMaterial);
Mesh2.SetGroupQuality(0, Mesh.GetGroupQuality(0));
fDataSize := 5000;
Mesh.GetGroup(3, @vCount, @fCount, @vPerFace, fDataSize, PDWORD(fData));
Mesh.GetVertices(3, 0, vCount, PD3DRMVertex(@ArrayVertex)^);
Mesh3.AddGroup(vCount, fCount, vPerFace, PDWORD(@buf)^, groupid);
Mesh3.SetGroupQuality(groupid, D3DRMRENDER_FLAT);
Mesh3.SetVertices(0,0,vCount, PD3DRMVertex(@ArrayVertex)^);
Mesh3.SetGroupTexture(groupid, image1);
Mesh3.SetGroupMaterial(0, IMaterial);
Mesh3.SetGroupQuality(0, Mesh.GetGroupQuality(0));
Mesh.SetGroupTexture(0, image2);
Mesh.SetGroupTexture(1, image4);
Mesh.SetGroupTexture(2, image3);
Mesh.SetGroupTexture(3, image1);
// Result := Mesh.GetVertices(3, 10, 10, returnPtr);
if (Result <> D3DRM_OK) then
begin
ShowMessage(IntToHex(Result,2));
end;
//load ball
FileName := 'ball.x';
Result := MeshBuilder2.Load(PChar(FileName), nil, D3DRMLOAD_FROMFILE, nil, nil);
if (Result <> D3DRM_OK) then
begin
ShowMessage(IntToHex(Result,2));
end;
MeshBuilder2.Scale(1.4,1.4,1.4);
MeshBuilder2.SetColor(D3DRGB(1, 1, 1));
MeshBuilder2.CreateMesh(BallMesh);
// MeshBuilder2.SetTexture(image1);
BallMesh.SetGroupTexture(0, image3);
Result := BallMesh.Translate(-2,4.5,24);
if (Result <> D3DRM_OK) then
begin
ShowMessage(IntToHex(Result,2));
end;
if (Result <> D3DRM_OK) then
begin
ShowMessage(IntToHex(Result,2));
end;
if (Result <> D3DRM_OK) then
begin
ShowMessage(IntToHex(Result,2));
end;
// NewMesh.Scale(5,5 , 5);
// NewMesh.setSetColor(D3DRGB(1, 1, 1));
// DXDraw.D3DRM.CreateMesh(myMesh);
// myMesh.SetVertices(0, 0, 300, vertices);
// MeshBuilder.AddFaces()
// end;
{ DXDraw.D3DRM.LoadTexture(PChar(ExtractFilePath(Application.ExeName)+'bmp\edge.BMP'), image);
MeshBuilder.SetTexture(image);
DXDraw.D3DRM.LoadTexture(PChar(ExtractFilePath(Application.ExeName)+'bmp\metal.bmp'), image);
MeshBuilder.SetTexture(image);
DXDraw.D3DRM.LoadTexture(PChar(ExtractFilePath(Application.ExeName)+'bmp\desktop.bmp'), image);
MeshBuilder.SetTexture(image);}
// image.SetDecalOrigin(256,256);
// image.SetDecalScale(5);
// image.SetDecalOrigin(256,256);
MeshBuilder.SetColor(D3DRGBA(1, 1, 1, 1)); {!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
MeshFrame.AddVisual(Mesh0);
MeshFrame.AddVisual(Mesh1);
DyMeshFrame.AddVisual(Mesh3);
DyMeshFrame.AddVisual(Mesh2);
//MeshFrame.AddVisual(NewMesh);
// MeshFrame.AddVisual(Mesh);
BallMeshFrame.AddVisual(BallMesh)
// DyMeshFrame.AddVisual(BallMesh);
// CreateWarp;
end;
procedure TMainForm.DrawMouse;
var
P : TPoint;
begin
Exit;
if not DXDraw.CanDraw then Exit;
GetCursorPos(P);
P := DXDraw.ScreenToClient(P);
if P.X<0 then P.X := 0;
if P.X> DXDraw.Width-8 then P.X := DXDraw.Width -8;
if P.Y<0 then P.Y := 0;
if P.Y> DXDraw.Height-8 then P.Y := DXDraw.Height -8;
if FMouseSurface = nil then
begin
FMouseSurface := TDirectDrawSurface.Create(DXDraw.DDraw);
FMouseSurface.LoadFromFile(ExtractFilePath(Application.ExeName)+'bmp\mouse.bmp');
end;
DXDraw.Surface.TransparentColor := 0;
DXDraw.Surface.DrawAlpha(Rect(p.X, P.Y, P.X+32, P.Y+32),Rect(0,0,32,32),FMouseSurface,true,200); ;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
//KGBFree
KBGMFree(Midihandle);
KBGMClose;
if FMouseSurface<>nil then FMouseSurface := nil;
if FPlayPanelFrame<>nil then FPlayPanelFrame := nil;
if FPlayPanelBK<>nil then FPlayPanelBK := nil;
KeyList.Free;
end;
procedure TMainForm.DrawRoulette;
begin
if not DXDraw.CanDraw then exit;
if (rlt.Round.State = rsWheeling ) and ((rlt.CurrentWheelParam.BallR>5) or (rlt.CurrentWheelParam.BallR<-1) ) and
(abs(rlt.CurrentWheelParam.BallV)>1) then begin
if FRollAudio <> nil then
if not FRollAudio.Playing then FRollAudio.Play;
end else begin
if FRollAudio<>nil then
if FRollAudio.Playing then FRollAudio.Stop;
end;
BallMeshFrame.AddRotation(D3DRMCOMBINE_REPLACE, 0,1,0,rlt.CurrentWheelParam.BallTheta);
BallMeshFrame.AddTranslation(D3DRMCOMBINE_BEFORE, 0, rlt.CurrentWheelParam.BallHeight,
rlt.CurrentWheelParam.BallR);
DyMeshFrame.AddRotation(D3DRMCOMBINE_REPLACE, 0,1,0,rlt.CurrentWheelParam.WheelTheta);
DXDraw.Viewport.ForceUpdate(0, 0, DXDraw.SurfaceWidth, DXDraw.SurfaceHeight);
DXDraw.Render;
end;
procedure TMainForm.DrawPlayerPanels;
var
ddColor : TDDColorKey;
Key : Word;
I : integer;
begin
if not DXDraw.CanDraw then Exit;
if FItemsSurface = nil then begin
FItemsSurface := TDirectDrawSurface.Create(DXDraw.DDraw);
FItemsSurface.LoadFromFile(ExtractFilePath(Application.ExeName)+'bmp\items.bmp');;
end;
if FPlayPanelFrame = nil then begin
FPlayPanelFrame := TDirectDrawSurface.Create(DXDraw.DDraw);
FPlayPanelBK := TDirectDrawSurface.Create(DXDraw.DDraw);
FPlayPanelFrame.LoadFromFile(ExtractFilePath(Application.ExeName)+'bmp\playerpanel.bmp');
// FPlayPanelBK.LoadFromFile('bmp\playerpanelbk.bmp');
with ddColor do begin
dwColorSpaceLowValue := 0;
dwColorSpaceHighValue := 0;
end;
FPlayPanelFrame.ISurface4.SetColorKey(DDCKEY_SRCBLT, @ddColor);
//FPlayPanelBK.ISurface4.SetColorKey(DDCKEY_SRCBLT, ddColor);
end;
DXDraw.Surface.TransparentColor := 0;
for I := 0 to 3 do
PlayerPanel[I].Draw(DXDraw.Surface ,FPlayPanelFrame, FItemsSurface);
end;
procedure TMainForm.DrawFPS;
const
DeviceText: array[Boolean] of string =
('Software', 'Hardware');
WrapText: array[D3DRMWRAP_FLAT..D3DRMWRAP_CHROME] of string =
('Wrap is flat', 'Wrap is cylindrical', 'Wrap is spherical', 'Wrap is chrome');
var
s: string;
r: TRect;
begin
if not DXDraw.CanDraw then Exit;
s := Format('FPS: %d', [FrameRate])+#13+
Format('State:%d - %d',[Integer(rlt.Round.State), rlt.Round.CountDown])+#13+
#13+
Format('%s', [WrapText[WrapType]]);
r := DXDraw.Surface.ClientRect;
with DXDraw.Surface.Canvas do begin
Brush.Style := bsClear;
Font.Color := clWhite;
Font.Size := 12;
DrawText(Handle, PChar(s), Length(s), r, DT_LEFT or DT_NOCLIP);
Release; { Indispensability }
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
KeyList := TList.Create;
if doFullScreen in DXDraw.Options then begin
BorderStyle := bsNone;
end else begin
Width := 804;
Height := 630;
BorderStyle := bsSingle;
end;
//KBGM Create
if (KBGMOpen(10,MIDI_MAPPER) <> KBGM_NOERROR)then midi_ok := 1;
end;
procedure TMainForm.DXDrawMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then MouseState := 1
else if Button = mbRight then MouseState := 2
else MouseState := 0;
end;
procedure TMainForm.DXDrawMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MouseState := 0;
end;
procedure TMainForm.DrawChipPanel;
var
I, J : integer;
ddColor : TDDColorKey;
P : TPoint;
Key : Word;
begin
if not DXDraw.CanDraw then Exit;
GetCursorPos(P);
if FChipPanelSurface = nil then begin
FChipPanelSurface := TDirectDrawSurface.Create(DXDraw.DDraw);
FChipPanelSurface.LoadFromFile(ExtractFilePath(Application.ExeName)+'bmp\chippanel.bmp');
end;
ChipPanel.Draw(DXDraw.Surface, FChipPanelSurface, FItemsSurface);
end;
procedure TMainForm.DrawHistoryPanel;
var
P : TPoint;
Key : Word;
begin
if not DXDraw.CanDraw then Exit;
GetCursorPos(P);
if FHistoryPanelSurface = nil then begin
FHistoryPanelSurface := TDirectDrawSurface.Create(DXDraw.DDraw);
FHistoryPanelSurface.LoadFromFile(ExtractFilePath(Application.ExeName)+'bmp\historypanel.bmp');
end;
HistoryPanel.Draw(DXDraw.Surface, FHistoryPanelSurface, FItemsSurface);
end;
procedure TMainForm.DrawTimePanel;
begin
if not DXDraw.CanDraw then Exit;
TimePanel.Draw(DXDraw.Surface, FChipPanelSurface, FItemsSurface);
end;
procedure TMainForm.DrawScore;
begin
//
end;
procedure TMainForm.DrawPaused;
begin
if not DXDraw.CanDraw then Exit;
if FPausedSurface = nil then
begin
FPausedSurface := TDirectDrawSurface.Create(DXDraw.DDraw);
FPausedSurface.LoadFromFile(ExtractFilePath(Application.ExeName)+'bmp\paused.bmp');
end;
Inc(PausedCount, 5);
if PausedCount>512 then PausedCount :=0;
if PausedCount<0 then PausedCount := 0;
DXDraw.Surface.DrawAlpha(Rect(250,255,550, 345), Rect(0,0,300,90), FPausedSurface, true, abs(256 - PausedCount));
end;
procedure TMainForm.DXSoundFinalize(Sender: TObject);
var
I : integer;
begin
FRollAudio.Free; FRollAudio := nil;
FBetChipAudio.Free; FBetChipAudio := nil;
FStartAudio.Free; FStartAudio := nil;
FStopAudio.Free; FStopAudio := nil;
FSelChipAudio.Free; FSelChipAudio := nil;
FBounceAduio.Free; FBounceAduio := nil;
for i := 0 to 36 do begin
FNumAudio[i].Free;
FNumAudio[i] := nil;
end;
end;
procedure TMainForm.InitMidi;
var
aaa : String;
begin
aaa := ExtractFilePath(Application.ExeName)+'wav\Music1.mid';
if (FileExists(aaa) = True)then
begin
KBGMLoadFile((@MidiHandle),Pchar(aaa));
KBGMInit(MidiHandle);
KBGMPlay(MidiHandle,REPEATPlay);
//KBGMStop;
{ KBGMFree(Midihandle);
if (KBGMLoadFile(lphData(MidiHandle^),PChar(aaa)) <> KBGM_NOERROR)then STG1.ErrorCode := 255;
//sleep(500);
KBGMSendSysx(GS_RESET);
if (KBGMLoadFile(MidiHandle,PChar(aaa)) <> KBGM_NOERROR)then STG1.ErrorCode := 255;
KBGMInit(MidiHandle);
if (KBGMPlay(MidiHandle,REP) <> KBGM_NOERROR)then STG1.ErrorCode := 255;
}
end;
end;
procedure TMainForm.PlaySoundBeginBet;
begin
if DXSound.Initialized and (FStartAudio <> nil) then
begin
FStartAudio.Position := 0;
FStartAudio.Play;
end;
end;
procedure TMainForm.PlayWheel;
begin
end;
procedure TMainForm.PlaySoundBetting;
begin
if DXSound.Initialized and (FBetChipAudio <> nil) then
begin
FBetChipAudio.Position := 0;
FBetChipAudio.Play;
end;
end;
procedure TMainForm.DXSoundInitialize(Sender: TObject);
var
WaveFormat : TWaveFormatEx;
I : integer;
begin
FRollAudio := TAudioFileStream.Create(DXSound.DSound);
FRollAudio.AutoUpdate := True;
FRollAudio.BufferLength := 1000;
FRollAudio.FileName := ExtractFilePath(Application.ExeName)+'wav\roll.wav';
FRollAudio.Looped := true;
FBetChipAudio := TAudioFileStream.Create(DXSound.DSound);
FBetChipAudio.AutoUpdate := True;
FBetChipAudio.BufferLength := 1000;
FBetChipAudio.FileName := ExtractFilePath(Application.ExeName)+'wav\sounds\chip.wav';
FBetChipAudio.Looped := false;
FStartAudio := TAudioFileStream.Create(DXSound.DSound);
FStartAudio.AutoUpdate := True;
FStartAudio.BufferLength := 1000;
FStartAudio.FileName :=ExtractFilePath(Application.ExeName)+ 'wav\sounds\ks.wav';
FStartAudio.Looped := false;
FStopAudio := TAudioFileStream.Create(DXSound.DSound);
FStopAudio.AutoUpdate := True;
FStopAudio.BufferLength := 1000;
FStopAudio.FileName :=ExtractFilePath(Application.ExeName)+ 'wav\sounds\stop.wav';
FStopAudio.Looped := false;
FSelChipAudio := TAudioFileStream.Create(DXSound.DSound);
FSelChipAudio.AutoUpdate := True;
FSelChipAudio.BufferLength := 1000;
FSelChipAudio.FileName :=ExtractFilePath(Application.ExeName)+ 'wav\sounds\SelCoin.wav';
FSelChipAudio.Looped := false;
FBounceAduio := TAudioFileStream.Create(DXSound.DSound);
FBounceAduio.AutoUpdate := True;
FBounceAduio.BufferLength := 1000;
FBounceAduio.FileName := ExtractFilePath(Application.ExeName)+'wav\sounds\Bounce.wav';
FBounceAduio.Looped := false;
for I := 0 to 36 do begin
FNumAudio[i] := TAudioFileStream.Create(DXSound.DSound);
FNumAudio[i].AutoUpdate := True;
FNumAudio[i].BufferLength := 1000;
FNumAudio[i].FileName :=Format(ExtractFilePath(Application.ExeName)+'wav\sounds\%2.2d.wav',[I]);
FNumAudio[i].Looped := false;
end;
MakePCMWaveFormatEx(WaveFormat, 44100, FRollAudio.Format.wBitsPerSample, 2);
DXSound.Primary.SetFormat(WaveFormat);
end;
procedure TMainForm.PlaySoundStopBet;
begin
if DXSound.Initialized and (FStopAudio <> nil) then
begin
FStopAudio.Position := 0;
FStopAudio.Play;
end;
end;
procedure TMainForm.PlaySoundSelChip;
begin
if DXSound.Initialized and (FSelChipAudio <> nil) then begin
FSelChipAudio.Position := 0;
FSelChipAudio.Play;
end;
end;
procedure TMainForm.PlaySoundBounce;
begin
if DXSound.Initialized and (FBounceAduio <> nil) then begin
FBounceAduio.Position := 0;
FBounceAduio.Play;
end;
end;
procedure TMainForm.PlaySoundNum(Num: integer);
begin
if DXSound.Initialized and (FNumAudio[Num] <> nil) then begin
FNumAudio[Num].Position := 0;
FNumAudio[Num].Play;
end;
end;
procedure TMainForm.FInitMidi;
begin
if Midihandle <> 0 then begin
KBGMStop;
KBGMClose;
Midihandle := 0;
end;
end;
end.