main.pas

刚从网上找到的连连看的源码

          {*************************************************}
          {***************      连连看1.0       ************}
          {***************    开发  孔祥吉      ************}
          {*************完成于 07.3.5 哈萨克斯坦************}
          {*********本软件为共享免费软件版权属于作者********}
          {***任何单位和个人不经作者同意禁止用于商业盈利****}
          {*******开发者引用本程序请保留开发者信息**********}
          {*************************************************}
unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DXPlay, DXInput, DXSounds, DXSprite, DXDraws, DIB,DXClass,DirectX,
  ExtCtrls, Menus, ToolWin, ComCtrls, MPlayer,Math,Regest;
type

  TMonoSprite = class;

  TSpriteImageID = Set of 1..100;

  TLanguageType = (ltChs,ltEng);

  TSpriteXY = record
    X,Y: integer;
    ID,ImageID: integer;
    XID,YID: integer;
    dead,throut,show: boolean;
    MonoSprite: TMonoSprite;
  end;

  TRandomEvent = record
    ID: integer;
    Add: integer;
  end;

  TGameState = (gtWait,gtRuning,gtPaused,gtGameOver);

  TForm1 = class(TForm)
    DXDraw: TDXDraw;
    ImageList: TDXImageList;
    DXSpriteEngine: TDXSpriteEngine;
    DXWaveList1: TDXWaveList;
    DXInput: TDXInput;
    DXPlay1: TDXPlay;
    DXSound1: TDXSound;
    DXTimer1: TDXTimer;
    DXImageList1: TDXImageList;
    SaveDialog1: TSaveDialog;
    MainMenu1: TMainMenu;
    game1: TMenuItem;
    NewGame1: TMenuItem;
    GameOver1: TMenuItem;
    Exit1: TMenuItem;
    about1: TMenuItem;
    about: TMenuItem;
    other1: TMenuItem;
    hint1: TMenuItem;
    wash1: TMenuItem;
    aa1: TMenuItem;
    Auto1: TMenuItem;
    Level1: TMenuItem;
    Normal1: TMenuItem;
    Easy1: TMenuItem;
    Hard1: TMenuItem;
    Level2: TMenuItem;
    Music1: TMenuItem;
    Sound1: TMenuItem;
    BackgroundMusic1: TMenuItem;
    Language1: TMenuItem;
    Chinese1: TMenuItem;
    English1: TMenuItem;
    N2: TMenuItem;
    MediaPlayer1: TMediaPlayer;
    ModesMenu: TMenuItem;
    BackImage: TDXImageList;
    EndGame1: TMenuItem;
    Regest1: TMenuItem;
    procedure FormShow(Sender: TObject);
    procedure DXTimer1Timer(Sender: TObject; LagCount: Integer);
    procedure DXDrawMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Exit1Click(Sender: TObject);
    procedure NewGame1Click(Sender: TObject);
    procedure aboutClick(Sender: TObject);
    procedure GameOver1Click(Sender: TObject);
    procedure wash1Click(Sender: TObject);
    procedure aa1Click(Sender: TObject);
    procedure hint1Click(Sender: TObject);
    procedure Auto1Click(Sender: TObject);
    procedure Easy1Click(Sender: TObject);
    procedure Normal1Click(Sender: TObject);
    procedure Hard1Click(Sender: TObject);
    procedure Level2Click(Sender: TObject);
    procedure Music1Click(Sender: TObject);
    procedure BackgroundMusic1Click(Sender: TObject);
    procedure Sound1Click(Sender: TObject);
    procedure MediaPlayer1Click(Sender: TObject; Button: TMPBtnType;
      var DoDefault: Boolean);
    procedure Chinese1Click(Sender: TObject);
    procedure English1Click(Sender: TObject);
    procedure Language1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure MediaPlayer1Notify(Sender: TObject);
    procedure DXDrawInitialize(Sender: TObject);
    procedure EndGame1Click(Sender: TObject);
    procedure game1Click(Sender: TObject);
    procedure other1Click(Sender: TObject);
    procedure about1Click(Sender: TObject);
    procedure Regest1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FAngle: Integer;

    FShowRegTime: integer;
    FShowReg: boolean;

    FRanEventID: TRandomEvent;

    FocusedSprite,FocusedSprite1: array[0..1] of TSpriteXY;
    FSurface: TDirectDrawSurface;

    FScore,FBaseScore,FTotleScore,FOneSpriteScore,FIniScore,CurLostIndex: integer;

    Language: TLanguageType;

    FImageW,FImageH,FBackImageW,FBackImageH,w,h,Ax,Ay: integer;

    FX,FY: integer;
    FLevel,FStep,FTime,FOneTime,FLostTime,incTime,incTime1,incTime2,incTime3: integer;

    FGameState: TGameState;

    {FPaused: boolean;
    FGameOver: boolean;
    FPassAll: boolean;
    Fstart: boolean; }

    SelfDo: boolean;
    IS800x600: boolean;

    Washing,FCLose,FStop: boolean;
    FBackMusic,FMusic: boolean;

    FHint,FWash: integer;

    FProgressW,FProgressH,FProgressT: integer;
    FProgressC: TColor;

    FSprites: array of array of TSpriteXY;

    FRoadPoint,FFirstRoadPoint: array[0..1] of TSpriteXY;

    NumStrs: array[1..10] of string;
    FStrs: array[1..100] of string;
    FRanEventName: array[1..5] of string;

    FSpritesCount,ImageCount,OneImageCount: integer;

    FSpritesCount2,OneImageCount2,ImageCount2: integer;

    procedure ChangeLanguge(AType: TLanguageType);

    procedure AssignPoint(SourPoint: TSpriteXY; var DesPoint: TSpriteXY);

    procedure Initialize(isStep: boolean = false);
    procedure FocusedSprites(AX,AY: integer);
    procedure UnFocusedSprite;

    procedure DeadSprite;
    procedure InitializeSprite;
    procedure Randomsprite;
    procedure RandomEvent;

    procedure WashSprite;
    procedure MoveSprite(AStep: integer);

    procedure InitializeID;
    procedure DrawLine(X1,Y1,X2,Y2: integer;ACanvas: TCanvas;PenColor: TColor);
    procedure getXY(Count: integer;var x: integer;var y: integer);

    procedure getRaodPoint(StPoint,EndPoint: TSpriteXY;var RoadPoint1,RoadPoint2: TSpriteXY);
    procedure getFirstRaodPoint(var RoadPoint1,RoadPoint2: TSpriteXY;ISF4: boolean = false);

    procedure NewGame(ALeavel: integer = 2);
    procedure PauseGame;
    procedure GameOver;
    procedure DoPassStep;
    procedure EndGame;

    procedure PlayBackMusic(Play: boolean=true);
  public
    constructor Create(AOwner: TComponent);override;
    procedure ModeItemClick(Sender: TObject);
    { Public declarations }
  end;

  TMonoSprite = class(TImageSprite)
  private
    FCounter: Double;
    FS: Integer;
    Focused,OldFocused: boolean;
    procedure Hit;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  protected
    //FDefaultGammaRamp: TDDGammaRamp;
    procedure Click;dynamic;
  public
    ID: integer;
    ImageID: integer;
    XID,YID: integer;
    ISDead: boolean;
    //FS: Integer;
    procedure DoMove(MoveCount: Integer); override;
    procedure DoDead;
  end;

  TMyBackGroubd = class(TBackgroundSprite)
  protected
    procedure DoCollision(Sprite: TSprite; var Done: Boolean); override;
    procedure DoMove(MoveCount: Integer); override;
    //procedure DoClick;override;
  end;

var
  Form1: TForm1;
  FRegInfo: TRegInfo;
  FDecKey: TMemoEncKey ;
  FParentFile: TFileStream;
  ChsNum: array[1..10] of string = ('第一关','第二关','第三关','第四关',
                                  '第五关','第六关','第七关','第八关','第九关','第十关');
  ChsStr: array[1..48] of string = (  '无变化',
                                      '左移',
                                      '右移',
                                      '左右分离',
                                      '左右集中',
                                      '上移',
                                      '下移',
                                      '上下分离',
                                      '上下集中',
                                      '时间剩余 : ',
                                      '提示(F4)剩余 :',
                                      '重洗(F5)剩余 : ',
                                      ' 次',
                                      '共 ',
                                      ' 种图片',
                                      '每种 ',
                                      '剩余 ',
                                      ' 对',
                                      '游戏',
                                      '新游戏',
                                      '暂停',
                                      '退出',
                                      '设置',
                                      '等级',
                                      '容易',
                                      '一般',
                                      '困难',
                                      '声音',
                                      '音效',
                                      '背景音乐',
                                      '其他',
                                      '提示',
                                      '重洗',
                                      '语言',
                                      '中文',
                                      '英文',
                                      '自动',
                                      '帮助',
                                      '关于',
                                      '恭喜过关,继续下一难度',
                                      '恭喜通关,重新开始?',
                                      '见缝插针',
                                      '排名',
                                      '连连看 1.0',
                                      '结束游戏',
                                      '恢复',
                                      '未注册',
                                      '天'
                                      );

  RanEventName: array[1..5] of string =('提示增加',
                                        '重新洗牌增加',
                                        '分数增加',
                                        '时间增加',
                                        ''
                                        );

  EngNum: array[1..10] of string = ('First Step','Second Step','Third Step',
                                  'Fourth Step','Fifths Step','Sixth Step',
                                    'Seventh Step','Eighth Step','Ninth Step',
                                    'Tenth Step');
  EngStr: array[1..48] of string = (   'No Change',
                                      'Left',
                                      'Right',
                                      'Left And Right',
                                      'Left and Right To Center',
                                      'Up',
                                      'Down',
                                      'Up And Down',
                                      'Top and  Bottom To Center',
                                      'Remain Time : ',
                                      'Remain Hint(F4) : ',
                                      'Remain Shuffle(F5) : ',
                                      '',
                                      '',
                                      '  Type pictures',
                                      'Every Type  ',
                                      'Remain  ',
                                      '  Twain',
                                      'Game',
                                      'New Game',
                                      'Pause',
                                      'Exit',
                                      'Setting',
                                      'Level',
                                      'Easy',
                                      'Normal',
                                      'Hard',
                                      'Sound',
                                      'Music',
                                      'BackGround Music',
                                      'Other',
                                      'Hint',
                                      'Shuffle',
                                      'Language',
                                      'Chinese',
                                      'English',
                                      'Auto',
                                      'Help',
                                      'About',
                                      'Congratulation!Next Level?',
                                      'Congratulation! You Pass All Level,Again?',
                                      'Make use of every bit of time or space',
                                      'Sequence',
                                      'Look for Link 1.0',
                                      'End Game',
                                      'Resume',
                                      'Not Registered',
                                      'Days'
                                      );
  RanEventNameEn: array[1..5] of string =('Hint Add',
                                        'Shuffle Add',
                                        'Scores Add',
                                        'Time Add',
                                        ''
                                        );
  procedure CheckUseInfo(var ARegInfo: TRegInfo;ADecKey: TMemoEncKey);

implementation

uses about,Scores, Reg;

{$R *.dfm}
{$R MIDI.RES}

procedure CheckUseInfo(var ARegInfo: TRegInfo;ADecKey: TMemoEncKey);
var
  Reginfo: TRegInfo;
  DecKey: TMemoEncKey;
  function ISSameSn(Sn1,Sn2: FSn) :boolean;
  var
    i: integer;
  begin
    result := true;
    for i := low(Sn1) to high(Sn1) do
    begin
      if Sn1[i] <> Sn2[i] then
      begin
        result := false;
        break;
      end;
    end;
  end;
  procedure AssignSn(var Sn1: TRegInfo;Sn2: FSn);
  var
    i: integer;
  begin
    for i := low(Sn2) to high(Sn2) do
    begin
      Sn1.Sn[i] := Sn2[i];
    end;
  end;
  procedure getOldUserInfo;
  var
    File1,File2: TFileStream;
  begin
    if not(Fileexists(RegFileName)) then
    begin
      File1 := TFileStream.Create(RegFileName,fmCreate);
      WriteUserInfo(ARegInfo,ADecKey,TStream(File1));
      File1.Free;
    end;

    if FileExists(RegFileName) then
    try
      FileSetAttr(RegFileName,faSysFile or faHidden);
    except
    end;

    File1 := TFileStream.Create(RegFileName,fmOpenReadWrite);
    GetRegInfo(RegInfo,DecKey,File1);


    ARegInfo.RunData := Max(ARegInfo.RunData,RegInfo.RunData);
    ARegInfo.InstallDate := Min(ARegInfo.InstallDate,RegInfo.InstallDate);
    if round(Date - ARegInfo.InstallDate)+2 > ARegInfo.RunData then
    begin
      ARegInfo.RunData := round(Date - ARegInfo.InstallDate)+2;
    end
    else if round(Date - ARegInfo.InstallDate)+2 < ARegInfo.RunData then
    begin
      ARegInfo.RunData := FMaxRunData;

    end;
    if ARegInfo.RunData = 0 then
      ARegInfo.RunData := 1;