📄 main.~pas
字号:
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 + -