main.pas

一般的数据库管理系统 uses Classes, SConnectEx, TltConst, ExtCtrls, MMSystem, Types, windows, TltLogic , Sy

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DXClass, DXDraws, DirectX, ScktComp,
  SConnect, rltClient, rltgame, DXInput, mmsystem, DXSounds, 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
        //提示对话框