Помомощь в игре

Тема в разделе "Delphi - Multimedia, Графика, Игры", создана пользователем 8922215, 26 сен 2007.

Наш партнер Genesis Hackspace
Статус темы:
Закрыта.
  1. 8922215

    8922215 Гость

    Люди ай ниид хэлп! Плиииз...Очень прошу!
    Вот имеетца текст:

    Код (Text):
    unit Kar1;

    interface

    uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    ExtCtrls, Menus, StdCtrls;

    type
    TForm1 = class(TForm)
    Image1: TImage;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N3: TMenuItem;
    N2: TMenuItem;
    Image2: TImage;
    Procedure LoadQuestion;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
    Y: Integer);
    private
    { Private declarations }
    public
    { Public declarations }
    end;

    Type
    PQues = ^TQues;

    TQues = Record
    Num: Byte;
    NameQ, NameA, Title: String[80];
    Next, Prev: PQues;
    End;

    TChips = Record
    X, Y: Integer;
    Pic: TBitmap;
    End;

    var
    Form1: TForm1;
    FQues, CurQues: PQues;
    Ques, Ans, Fld, Back: TBitmap;
    Chips: Array[0..5] of TChips;
    UnderChips: Array[0..5] of TBitmap;
    Pnts: Array[0..13{15}] of Integer;
    kHW: Real;
    NumQues, Step, MayMove, MayUp, NumChip, ChipH, ChipW,
    XDn, YDn, CurX, CurY, CurDx, CurDy, Defl: Integer;


    implementation

    {$R *.DFM}

    Function Min(A, B: Real): Real;
    Begin
    If A<B Then Min:=A Else Min:=B;
    End;

    Function Max(A, B: Real): Real;
    Begin
    If A>B Then Max:=A Else Max:=B;
    End;

    procedure TForm1.FormCreate(Sender: TObject);
    Var
    F: TextFile;
    Pr, Cur: PQues;
    St: String;
    a: Integer;
    Rect: TRect;
    Label End_;
    begin
    kHW:=Screen.Height/536;
    Height:=Screen.Height;
    Width:=Round(Width*kHW);
    AssignFile(F,'Karapuz.ini');
    ReSet(F);
    ReadLn(F,St);
    ReadLn(F,NumQues);
    If NumQues<1 Then Goto End_;
    Pr:=Nil;
    For a:=1 to NumQues do
    Begin
    New(Cur);
    If Cur=NIL Then
    Begin
    NumQues:=0;
    Goto End_;
    End;
    ReadLn(F,St);
    Cur^.Num:=1;
    Cur^.Title:=St;
    Cur^.Prev:=Pr;
    ReadLn(F,St);
    Cur^.NameQ:=St;
    ReadLn(F,St);
    Cur^.NameA:=St;
    If Pr<>Nil Then Pr^.Next:=Cur;
    If a=1 Then FQues:=Cur;
    Pr:=Cur;
    End;
    Cur^.Next:=FQues;
    FQues^.Prev:=Cur;
    Ques:=TBitmap.Create;
    Ans:=TBitmap.Create;
    Fld:=TBitmap.Create;
    Back:=TBitmap.Create;
    ReadLn(F,St);
    ReadLn(F,St);
    Image2.Visible:=False;
    Image2.Picture.LoadFromFile(St);
    Fld.Height:=ClientHeight;
    Fld.Width:=ClientWidth;
    Image1.Height:=Fld.Height;
    Image1.Width:=Fld.Width;
    Rect:=Bounds(0,0,Fld.Width,Fld.Height);
    Fld.Canvas.StretchDraw(Rect,Image2.Picture.Graphic);
    Ques.Palette:=Fld.Palette;
    Ans.Palette:=Fld.Palette;
    Back.Palette:=Fld.Palette;
    Back.Width:=Fld.Width;
    Back.Height:=Fld.Height;
    For a:=0 to 5{14} do
    Begin
    Read(F,Pnts[a]);
    Pnts[a]:=Round(Pnts[a]*kHW);
    End;
    ReadLn(F,Pnts[6]);
    Pnts[6]:=Round(Pnts[6]*kHW);
    ReadLn(F,St);
    Image2.Transparent:=True;
    Image2.Picture.Bitmap.Palette:=Fld.Palette;
    Rect:=Bounds(0,0,Round(46*kHW),Round(37*kHW));
    For a:=0 to 5 do
    Begin
    ReadLn(F,St);
    Chips[a].Pic:=TBitmap.Create;
    UnderChips[a]:=TBitmap.Create;
    Chips[a].Pic.Palette:=Fld.Palette;
    UnderChips[a].Palette:=Fld.Palette;
    Image2.Picture.LoadFromFile(St);
    Image2.Picture.Bitmap.TransparentColor:=Image2.Picture.Bitmap.Canvas.Pixels[0,0];
    Chips[a].Pic.Height:=Round(37*kHW);
    Chips[a].Pic.Width:=Round(46*kHW);
    Chips[a].Pic.Canvas.StretchDraw(Rect,Image2.Picture.Graphic);
    UnderChips[a].Width:=Chips[a].Pic.Width;
    UnderChips[a].Height:=Chips[a].Pic.Height;
    Chips[a].Pic.Transparent:=True;
    Chips[a].Pic.TransparentColor:=Chips[a].Pic.Canvas.Pixels[0,0];
    End;
    ChipH:=Chips[0].Pic.Height;
    ChipW:=Chips[0].Pic.Width;
    Image2.Transparent:=False;
    For a:=7 to 12 do
    Begin
    Read(F,Pnts[a]);
    Pnts[a]:=Round(Pnts[a]*kHW);
    End;
    ReadLn(F,Pnts[13]);
    Pnts[13]:=Round(Pnts[13]*kHW);
    ReadLn(F,St);
    ReadLn(F,Defl);
    Defl:=Round(Defl*kHW);

    End_:
    CloseFile(F);

    If NumQues<1 Then
    Begin
    N1.Enabled:=False;
    End;

    Step:=0;
    MayMove:=-1;
    MayUp:=0;
    NumChip:=-1;
    end;

    procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
    Var
    Cur, Nx: PQues;
    a: Integer;
    begin
    Nx:=FQues;
    For a:=1 to NumQues do
    Begin
    Cur:=Nx;
    Nx:=Cur^.Next;
    Dispose(Cur);
    End;
    Ques.Free;
    Ans.Free;
    Fld.Free;
    Back.Free;
    For a:=0 to 5 do
    Begin
    Chips[a].Pic.Free;
    UnderChips[a].Free;
    End;
    end;

    Procedure TForm1.LoadQuestion;
    Var
    a: Integer;
    RectD, RectS: TRect;
    Begin
    If Step=1 Then
    Begin
    CurQues:=FQues^.Prev;
    Image1.Visible:=True;
    End;
    {Image1}Back.Canvas.Draw(0,0,Fld);
    If Step mod 2 = 1 Then
    Begin
    CurQues:=CurQues^.Next;
    Caption:='Карапуз - '+CurQues^.Title;     
    MayMove:=0;
    Image2.Picture.LoadFromFile(CurQues^.NameQ);
    RectD:=Bounds(0,0,Round(300*kHW),Round(390*kHW));
    {Ques}Back.Canvas.StretchDraw(RectD,Image2.Picture.Graphic);
    {Image1Back.Canvas.Draw(0,0,Ques);}
    End Else
    Begin
    MayMove:=-1;
    Image2.Picture.LoadFromFile(CurQues^.NameA);
    RectD:=Bounds(0,0,Round(300*kHW),Round(390*kHW));
    {Ans}Back.Canvas.StretchDraw(RectD,Image2.Picture.Graphic);
    {Image1Back.Canvas.Draw(0,0,Ans);}
    End;
    Image1.Canvas.Draw(0,0,Back);
    For a:=0 to 5 do
    Begin
    If Step mod 2=1 Then
    Begin
    Chips[a].X:=Pnts[a+1+7];
    Chips[a].Y:=Pnts[7];
    End;
    RectS:=Bounds(Chips[a].X - ChipW div 2,
    Chips[a].Y - ChipH div 2, ChipW, ChipH);
    RectD:=Bounds(0,0,ChipW,ChipH);
    UnderChips[a].Canvas.CopyRect(RectD,{Fld}Back.Canvas,RectS);
    Image1.Canvas.Draw(RectS.Left,RectS.Top,Chips[a].Pic);
    End;
    End;

    procedure TForm1.N1Click(Sender: TObject);
    begin
    N2.Enabled:=True;
    N1.Enabled:=False;
    Step:=1;
    LoadQuestion;
    end;

    procedure TForm1.N3Click(Sender: TObject);
    begin
    Close;
    end;

    procedure TForm1.N2Click(Sender: TObject);
    begin
    If Step<2*NumQues Then
    Begin
    Inc(Step);
    LoadQuestion;
    End Else
    Begin
    Step:=-1;
    NumChip:=-1;
    MayMove:=-1;
    N1.Enabled:=True;
    N2.Enabled:=False;
    Image1.Visible:=False;
    Caption:='Карапуз';
    End;
    end;

    procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
    Var
    a: Integer;
    XY: TPoint;
    begin
    If (MayMove=0) and (Button=mbLeft) Then
    Begin
    For a:=0 to 5 do
    Begin
    If (X>=Chips[a].X - ChipW div 2) and
    (X<=Chips[a].X + ChipW div 2) and
    (Y>=Chips[a].Y - ChipH div 2) and
    (Y<=Chips[a].Y + ChipH div 2) Then
    Begin
    NumChip:=a;
    XDn:=X;
    YDn:=Y;
    CurX:=Chips[a].X;
    CurY:=Chips[a].Y;
    MayMove:=1;
    MayUp:=1;
    Screen.Cursor:=crNone;
    GetCursorPos(XY);
    CurDx:=XY.X-(X+Left);
    CurDy:=XY.Y-(Y+Top);
    Break;
    End;
    End;
    End;
    end;

    procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
    begin
    If (MayMove<>0) and (Button=mbLeft) and (MayMove<>-1) and
    (MayUp=0) Then
    Begin
    Chips[NumChip].X:=CurX;
    Chips[NumChip].Y:=CurY;
    NumChip:=-1;
    MayMove:=0;
    Screen.Cursor:=crDefault;
    End;
    If MayUp=1 Then MayUp:=0;
    end;

    procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
    Y: Integer);
    Var
    a, b, c, n, Chck, Xold, Yold, Dx, Dy: Integer;
    RectS, RectD: TRect;
    begin
    If (MayMove=1) Then
    Begin
    Image1.Canvas.Draw(CurX-ChipW div 2,CurY-ChipH div 2,UnderChips[NumChip]);
    Xold:=CurX;
    Yold:=CurY;
    Dx:=X-XDn;
    Dy:=Y-YDn;
    b:=Round(Max(Abs(Dx),Abs(Dy)));

    Chck:=0;
    For c:=1 to b do
    If (Chck<>1) and (b<>0) Then
    Begin
    Chck:=0;
    n:=c;
    CurX:=Round(Xold+Dx*c/b);
    CurY:=Round(Yold+Dy*c/b);
    {        For a:=1 to 6 do
    Begin
    If Not ((CurX>=Pnts[a]-Defl) and (CurX<=Pnts[a]+Defl) and
    (CurY>=Pnts[7]-Defl) and (CurY<=Pnts[0]+Defl)) Then
    Begin
    Inc(Chck);
    End Else Break;
    End;

    If Chck=6 Then
    Begin
    If Not ((CurX>=Pnts[1]-Defl) and (CurX<=Pnts[8]+Defl) and
    (CurY>=Pnts[7]-Defl) and (CurY<=Pnts[7]+Defl)) Then
    Begin
    Inc(Chck);
    End;
    End;

    If Chck=7 Then
    Begin
    If Not ((CurX>=Pnts[8]-Defl) and (CurX<=Pnts[8]+Defl) and
    (CurY>=Pnts[10]-Defl) and (CurY<=Pnts[7]+Defl)) Then
    Begin
    Inc(Chck);
    End;
    End;

    If Chck=8 Then
    For a:=10 to 15 do
    Begin
    If Not ((CurX>=Pnts[9]-Defl) and (CurX<=Pnts[8]+Defl) and
    (CurY>=Pnts[a]-Defl) and (CurY<=Pnts[a]+Defl)) Then
    Begin
    Inc(Chck);
    End Else Break;
    End;}
    If Chck<>1 Then
    For a:=0 to 5 do
    Begin
    If (a<>NumChip) and (Chck<>1) Then
    If
    (( ((CurX-ChipW div 2>=Chips[a].X-ChipW div 2) and
    (CurX-ChipW div 2<=Chips[a].X+ChipW div 2) and
    (CurY-ChipH div 2>=Chips[a].Y-ChipH div 2) and
    (CurY-ChipH div 2<=Chips[a].Y+ChipH div 2)) or

    ((CurX-ChipW div 2>=Chips[a].X-ChipW div 2) and
    (CurX-ChipW div 2<=Chips[a].X+ChipW div 2) and
    (CurY+ChipH div 2>=Chips[a].Y-ChipH div 2) and
    (CurY+ChipH div 2<=Chips[a].Y+ChipH div 2)) or

    ((CurX+ChipW div 2>=Chips[a].X-ChipW div 2) and
    (CurX+ChipW div 2<=Chips[a].X+ChipW div 2) and
    (CurY-ChipH div 2>=Chips[a].Y-ChipH div 2) and
    (CurY-ChipH div 2<=Chips[a].Y+ChipH div 2)) or

    ((CurX+ChipW div 2>=Chips[a].X-ChipW div 2) and
    (CurX+ChipW div 2<=Chips[a].X+ChipW div 2) and
    (CurY+ChipH div 2>=Chips[a].Y-ChipH div 2) and
    (CurY+ChipH div 2<=Chips[a].Y+ChipH div 2)) or
    (CurX+ChipW div 2>=Image1.Width) or
    (CurX-ChipW div 2<=0) or
    (CurY+ChipH div 2>=Image1.Height) or
    (CurY-ChipH div 2<=0) )) Then
    Begin
    Chck:=1;
    End;
    End;
    End;
    If b<>0 Then
    Begin
    CurX:=Round(Xold+Dx*(n-1)/b);
    CurY:=Round(Yold+Dy*(n-1)/b);
    End Else
    Begin
    CurX:=Xold;
    CurY:=Yold;
    End;
    XDn:=XDn+CurX-Xold;
    YDn:=YDn+CurY-Yold;
    If (XDn<>X) or (YDn<>Y) Then MayMove:=2;
    RectS:=Bounds(CurX-ChipW div 2,CurY-ChipH div 2,ChipW,ChipH);
    RectD:=Bounds(0,0,ChipW,ChipH);
    UnderChips[NumChip].Canvas.CopyRect(RectD,{Fld}Back.Canvas,RectS);
    Image1.Canvas.Draw(CurX-ChipW div 2,CurY-ChipH div 2,Chips[NumChip].Pic);
    If MayMove=2 Then SetCursorPos(XDn+Left+CurDx,YDn+Top+CurDy);
    End Else If MayMove=2 Then
    Begin
    MayMove:=1;
    End;
    end;

    end.
    Надо сделать чтобы в конце игры писались результаты. Где это нужно вписывать? И что там нужно писать?
     
Загрузка...
Похожие Темы - Помомощь игре
  1. rhino101
    Ответов:
    1
    Просмотров:
    1.973
  2. Gamlet
    Ответов:
    4
    Просмотров:
    2.696
Статус темы:
Закрыта.

Поделиться этой страницей