kota43a.pas

维修店名称 陕西申元电子有限公司 店面地址 西安市友谊东路242号西海大厦一层 维修咨询 8008105858(免费) 或 010-64751880

unit Kota43a;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Kota43b,  KeyObj,   ExtCtrls, StdCtrls, MPlayer, DSound,
  ddsd, Defs,KeyDefs, dddd,DDraw, math, Ddidex, AlphaLib, MMSystem, KBGM, demo;

type
  TForm1 = class(TForm)
    DDSD1: TDDSD;
    DDDD1: TDDDD;
    DDIDEX1: TDDIDEX;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure AppIdle(Sender:TObject; var Done : boolean);

  private
    { Private 愰尵 }
    Level1,Level2,Flag1 : Integer;
    title : TDDDDSurFace;
    Select2 : TDDDDSurFace;
    Select1 : TDDDDSurface;
    Frame1,Frame2 : Integer;
    FrameTime : LongInt;
    CCount : Integer;
    LastTime : LongInt;
    PPD : TPlayData;
    //Stage憖嶌梡
    StageNo : Integer;
    StageFile : string;
    StageSel : Boolean;
    //titile
    Diffcult,BGMsound,SlowWait,DrawSize,BLTMode,EditWait,ShotColor,BGMMode : Byte;
    cy,cx,aa1 : Integer;
    ans : array[0..24] of String;
    //BGM
    BGMPlay : Boolean;
    BGMWAVE : TDDSDWavedata;
    BGMPlayMode : Byte;
    Midihandle : HDATA;
    BGMName : String;
    //PlayOption
    PlayFrm : LongInt;
    PlayRec : Boolean;
    RecNo : Byte;
    NoHitMode : Boolean;
    SamplePlay : Boolean;
    //TempHiscore
    NameEnt : array[0..2] of String[1];
    //
    DemoLevel : Byte;
    TitleCount : Integer;
    DemoPlay : boolean;
    //塀偟婡懱弌尰僼儔僌
    SecCount,SecCount2 : Integer;
    //BOM巊梡帪抏徚偟梡僇僂儞僞
    DeleteShot : Byte;
    //MIDI
    midi_ok : byte;

  public
    { Public 愰尵 }
    procedure DataLoad;
    procedure FedeOut;
    procedure GamePlay;
    procedure GameStart;
    procedure PlayerSub;
    procedure ImageDraw;
    procedure GamePause;
    procedure TitleMenu;
    procedure continue;
    procedure GameOver;
    procedure StageLoad;
    procedure ScoreRanking;
    procedure HiScoreCheck;
    procedure BGMEnable(filename : string);
    procedure BGMDisable;
    procedure VerDisp;
    procedure Config;
    procedure Select;
    procedure AttackShot;
    procedure AttackENS;
    procedure AttackBom;
    procedure StageSelect;
    procedure AllClear;
    procedure EndingDemo;
    procedure OpeningDemo;
    procedure NameEntry;
    
    procedure TestPlay;
    procedure PlayDataWrite;
    procedure BGMPlayerMenu;

    procedure BackupSave;
    procedure PlayDataSelect;

    procedure playerivent;
    procedure startDemo; 

  end;

var
  Form1: TForm1;
  STG1 : TSTG;
  Key1 : TKey;
  Alph1: Talpha;
  demo1 : Tdemo;

implementation

{$R *.DFM}

procedure TForm1.AppIdle(Sender:TObject; var Done : boolean);
var
  SlowTime,waitTime,TempTime : LongInt;
  aaa : Byte;
begin
  if (STG1.ErrorCode = 255)then begin Close; exit; end;   //File偑側偄偧
  //FrmeCount
  if ((GetTickCount - FrameTime)>1000) then
  begin
    Frame2 := Frame1*1000 div (GetTickCount-FrameTime);
    Frame1 := 0;
    FrameTime := GetTickCount;
  end;

  Frame1 := Frame1 + 1;

  Key1.GetKey;
  if (Level1 = 2)and(SamplePlay = True)then
  begin
    if (Key1.PTrig1 = True)then Key1.Esc := True;
    if (Key1.PTrig2 = True)then Key1.Esc := True;
    if (Key1.PTrig3 = True)then Key1.Esc := True;
    if (Key1.PTrig4 = True)then Key1.Esc := True;
  end;
  //嵞惗
  if ((Level1 = 2)and(SamplePlay = True))then
  begin
    aaa := PPD.PlayData[PlayFrm];
    if ((aaa and 2)  > 0)then Key1.Up := True     else Key1.Up := False;
    if ((aaa and 4)  > 0)then Key1.Right := True  else Key1.Right := False;
    if ((aaa and 8)  > 0)then Key1.Left := True   else Key1.Left := False;
    if ((aaa and 16) > 0)then Key1.Down := True   else Key1.Down := False;
    if ((aaa and 32) > 0)then Key1.Trig1 := True  else Key1.Trig1 := False;
    if ((aaa and 64) > 0)then Key1.PTrig2 := True else Key1.PTrig2 := False;
    if ((aaa and 128)> 0)then Key1.PTrig3 := True else Key1.PTrig3 := False;
    if ((PlayFrm = 5740)and(demoplay = true))then
    begin
      Level2 := 1;
      Level1 := 21;
      StageNo := 1;
      StageFile := 'stage1.stg';
      FedeOut;
      Key1.GetKey;
      demoPlay := False;
      SamplePlay := False;
    end;
    if (aaa = 255)then       //廔椆両
    begin
      Level2 := 1;
      Level1 := 5;
      StageNo := 1;
      StageFile := 'stage1.stg';
      FedeOut;
      Key1.GetKey;
      SamplePlay := False;
    end;
  end;
  //榐夋
  if ((Level1 = 2)and(PlayRec = True))then
  begin
    aaa := 0;
    if (PlayFrm > 59990)then PlayFrm := 59990;
    if (Key1.Up = True)then aaa := aaa or 2;
    if (Key1.Right = True)then aaa := aaa or 4;
    if (Key1.Left = True)then aaa := aaa or 8;
    if (Key1.Down = True)then aaa := aaa or 16;
    if (Key1.Trig1 = True)then aaa := aaa or 32;
    if (Key1.PTrig2 = True)then aaa := aaa or 64;
    if (Key1.PTrig3 = True)then aaa := aaa or 128;
    PPD.PlayData[PlayFrm] := aaa;
  end;

  case Level1 of
    0: DataLoad;
    1: GameStart;
    2: GamePlay;
    4: GamePause;
    5: TitleMenu;
    6: Continue;
    7: StageLoad;
    8: GameOver;
    9: ScoreRanking;
    11:Config;
    12:Select;
    13:NameEntry;
    14:BgmPlayerMenu;
    15:PlayDataSelect;
    20:StageSelect;
    21:OpeningDemo;
    22:EndingDemo;
    30:AllClear;
  end;

  //SE
  STG1.PlaySE;
  //fps
  if (Level1 = 2)then inc(PlayFrm,1);

  WaitTime := 25 + (EditWait-5);                         //Wait偩偤
  SlowTime := 0;

  if ((SlowWait = 0)and(Level1 = 2))then
    case STG1.Dif of
     -1 :begin        //Easy
          SlowTime := 20;
          if (STG1.DES < 60)then SlowTime := STG1.DES div 3;
         end;
     0,1 : begin        //Normal & Hard
          SlowTime := 0;
          if (STG1.DES > 30)and(STG1.DES < 110)then SlowTime := (STG1.DES-20) div 4;
          if (STG1.DES > 109)then SlowTime := 20;
         end;
    end;

  //ESC
  if (Key1.ESC = True)then
  begin
    FedeOut;
    BGMDisable;
    Level2 := 1;
    if (Level1 = 5)then close
                   else Level1 := 5;
  end;

  //Wait
  if (EditWait <> 9)then
  begin
    TempTime := (LastTime+(SlowTime-5))-TimeGetTime;
    if (tempTime < 0)then TempTime := 0;
    if (tempTime > 50)then TempTime := 50;
    sleep(TempTime);

    while ((TimeGetTime-LastTime)<(WaitTime+SLowTime)) do;
  end;
  LastTime := TimeGetTime;

  Done := False;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  midi_ok := 0;
  ShowCursor(False);
  //巊梡僼儗亅僘
  ans[0] := 'ON';
  ans[1] := 'OFF';
  ans[2] := 'EASY';
  ans[3] := 'NORMAL';
  ans[4] := 'HARD';
  ans[5] := 'NORMAL';
  ans[6] := 'BIG';
  ans[7] := 'SYSTEM';
  ans[8] := 'VIDEO';
  ans[9] := 'DIRECT';
  ans[10]:= 'WAIT';
  ans[11]:= 'RED';
  ans[12]:= 'BLUE';
  ans[13]:= 'GREEN';
  ans[14]:= 'MIDI';
  ans[15]:= 'WAVE';
  ans[16]:= 'CD';
  //僌儘亅僶儖曄悢偺愝掕
  Key1 := TKey.Create;
  DDDD1.ReadPalette('bmp\Title.bmp');
  DDDD1.UpdatePalette;
  DDDD1.Clear;
  DDDD1.Flip;
  DDDD1.Clear;
  //AlphLibCreate
  Alph1 := Talpha.Create;
  Alph1.LoadRandomTable('Random.rtd');
  Alph1.ReadPalette('bmp\Load.bmp',0);
  Alph1.NormalBlendAlpha := 128;
  if (fileExists('BlendDat.btd'))then Alph1.LoadBlendTable('BlendDat.btd')
                                 else Alph1.ReadPalette('bmp\Load.bmp',BM_SCREEN or BM_DEC or BM_NORMAL);
  //Class
  DD := DDDD1;
  DS := DDSD1;
  AL := Alph1;
  DI := DDIDex1;
  KY := Key1;

  //DemoCreate
  demo1 := Tdemo.create;
  VerDisp;
  DemoLevel := 0;

  LastTime := GetTickCount;
  stagefile := 'stage1.stg';
  stageNo := 1;
  Application.OnIdle := AppIdle;
  Randomize;
  Level1 := 0;
  Level2 := 0;
  STG1 := TSTG.Create;
  STG1.DataClear;

  //僼儗亅儉昞帵
  FrameTime := 0;
  Frame1 := 0;Frame2 := 0;
  //僒僀僘曄峏儊僯儏亅偺愝掕
  //ShowCursor(False);
  Form1.Left := 0;
  Form1.Top  := 0;
  //menu
  cy := 0;
  STG1.DDFLG := 1;
  //PlayData
  PlayRec := False;
  //ConfigLoad
  if (STG1.ConfigRead = False)then
  begin
    diffcult := 1;
    BGMsound := 0;
    SlowWait := 0;
    DrawSize := 0;
    BltMode := 0;
    STG1.BackCut := 0;
    EditWait := 5;
    shotColor := 0;
    STG1.WaveVolume := 5;
    BGMMode := 0;
  end
  else
  with STG1.Configdata do
  begin
    diffcult := Flag[0];
    BGMsound := Flag[1];
    SlowWait := Flag[2];
    DrawSize := Flag[3];
    BltMode := Flag[4];
    STG1.BackCut := Flag[5];
    STG1.WaveVolume := Flag[6];
    EditWait := Flag[7];
    shotColor := Flag[8];
    BGMMode := Flag[9];
  end;
  //BGM
  BGMPlay := False;
  BGMPlayMode := BGMMode;
  //KBGM Create
  if (KBGMOpen(10,MIDI_MAPPER) <> KBGM_NOERROR)then midi_ok := 1;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BGMDisable;
  //KGBFree
  KBGMFree(Midihandle);
  KBGMClose;

  with STG1.Configdata do
  begin
    Flag[0] := diffcult;
    Flag[1] := BGMsound;
    Flag[2] := SlowWait;
    Flag[3] := DrawSize;
    Flag[4] := BltMode;
    Flag[5] := STG1.BackCut;
    Flag[6] := STG1.WaveVolume;
    Flag[7] := EditWait;
    Flag[8] := shotColor;
    Flag[9] := BGMMode;
  end;
  STG1.ConfigWrite;
  title.free;
  select2.free;
  Alph1.free;
  demo1.free;
  STG1.Destroy;
  ShowCursor(True);
end;


//BGM憖嶌----------------------------------------------------
procedure TForm1.BGMEnable(filename : string);
var
  aaa : string;
begin
  if (BGMName = filename)then Exit;
  if (midi_ok = 1)then Exit;
  BGMName := filename;
  if (BGMPlay = True)then BGMDisable;;
  if (BGMsound = 0)then
  begin
    AL.BlendRect(STG1.BackBuf,rect(150,200,300,220),20,BM_DEC);
    STG1.DrawFont(225,210,'NOW BGM LOADING',3);
    ImageDraw;
    case BGMMode of
     0 : begin
          aaa := filename + '.mid';
          if (FileExists(aaa) = True)then
          begin
           //KBGMLoadFile(lphData(MidiHandle),'bgm\none.mid');
           //KBGMInit(MidiHandle);
           //KBGMPlay(MidiHandle,REP);
           //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;
           BGMPlay := True;
           BGMPlayMode := 0;
           //sleep(500);
          end;
         end;
     1 : begin
           //wave
           aaa := filename + '.wav';