⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.~pas

📁 一般的数据库管理系统 uses Classes, SConnectEx, TltConst, ExtCtrls, MMSystem, Types, windows, TltLogic , Sy
💻 ~PAS
📖 第 1 页 / 共 3 页
字号:


  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.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -