www.pudn.com > 实景（图形）聊天室源代码（绝对高水 准，超酷）.zip > Sprite.pas

{ *********************************************************************** } 
{                                                                         } 
{ Copular Chat Client v3.0 Source Code                                    } 
{ Sprite Libary Unit                                                      } 
{                                                                         } 
{ Copyright (c) 1998-2002 SAF Studio                                      } 
{                                                                         } 
{ Author  : Niu Yu Ping                                                   } 
{ Nickname: DecimalOX                                                     } 
{ Address : Jilin City China                                              } 
{                                                                         } 
{ QICQ    : 103106262                                                     } 
{ Homepage: www.safree.com                                                } 
{ EMail   : decimalox@sohu.com                                            } 
{                                                                         } 
{ *********************************************************************** } 
 
unit Sprite; 
 
interface 
 
uses 
  DXSprite, DXPath, Tools, DXMap, Graphics, Classes, SysUtils; 
 
type 
  //Sprite's position 
  TPathPoint = record 
    X, Y: Double; 
  end; 
 
  //Sprite's talk structor 
  TTalk = record 
    Items,Send, Rece: array[0..9] of string; //sentence, sender, reseiver 
    Life, Face: array[0..9] of Integer; //display time, face index 
    OnlyOne: array [0..9] of Boolean; //is alone 
    Count: Integer; //counter of sentences 
  end; 
 
  //TPlayerSprite structor is designed for sprite on the map 
  TPlayerSprite = class(TImageSprite) 
  private 
    FNewY: Double; 
    FNewX: Double; 
    FMoved: Boolean; 
    FCaption: string; 
    FDegree: Integer; 
    FHeadID: Integer; 
    FAnchorY: Integer; 
    FAnchorX: Integer; 
    FIsMe: Boolean; 
    //obstacle map for every sprite is used to find path 
    OrgObstacle: array [-MapW div 2..MapW div 2, -MapH div 2..MapH div 2] of Boolean; 
 
    //check for obstacle on the appointed area 
    function HasObstacle(StartX, StartY: Integer): Boolean; 
 
    procedure SetNewX(const Value: Double); 
    procedure SetNewY(const Value: Double); 
    procedure SetMoved(const Value: Boolean); 
    procedure SetCaption(const Value: string); 
    procedure SetDegree(const Value: Integer); 
    procedure SetHeadID(const Value: Integer); 
    procedure SetAnchorX(const Value: Integer); 
    procedure SetAnchorY(const Value: Integer); 
    procedure SetIsMe(const Value: Boolean); 
  protected 
    //process collision event 
    procedure DoCollision(Sprite: TSprite; var Done: Boolean); override; 
    //process move event 
    procedure DoMove(MoveCount: Integer); override; 
  public 
    PathCala: Boolean; 
    PathInf: TDXPath; 
    PathIndex: Integer; 
    PathCount: Integer; 
    Path: array [0..100] of TPathPoint; 
    Talk: TTalk; 
    property AnchorX: Integer read FAnchorX write SetAnchorX; 
    property AnchorY: Integer read FAnchorY write SetAnchorY; 
    property NewX: Double read FNewX write SetNewX; 
    property NewY: Double read FNewY write SetNewY; 
    property Moved: Boolean read FMoved write SetMoved; 
    property Caption: string read FCaption write SetCaption; 
    property HeadID: Integer read FHeadID write SetHeadID; 
    property Degree: Integer read FDegree write SetDegree; 
    property IsMe: Boolean read FIsMe write SetIsMe; 
    constructor Create(Aparent: TSprite); override; 
    destructor Destroy; override; 
 
    //buile obstacle map 
    procedure MakeMap(MapEngine: TDXMap); 
 
    //move to appointed position 
    procedure Go(EndX, EndY:Double); 
 
    //fill the TTalk items for drawwing 
    procedure Speak(ASend, ARece, AText: string; AFace: Integer; AOnlyOne: Boolean); 
 
    //drop the TTalk item which was timeout 
    procedure RollTalk; 
  end; 
 
  //TPlayers structor is designed for Online List of Client 
  TPlayers = class(TComponent) 
  private 
    FCount: Integer; 
    procedure SetCount(const Value: Integer); 
  public 
    Items: array [0..200] of TPlayerSprite; 
    property Count: Integer read FCount write SetCount; 
    constructor Create(AOwner: TObject); reintroduce; 
 
    //Add a new sprite to the online list of client 
    function Add(ASprite: TSprite; ACaption: string;ADegree: Integer): Integer; 
 
    //drop a sprite from the online list of client 
    procedure Delete(Index: Integer); 
 
    //search sprite by caption from online list of client 
    function FindByCaption(ACaption: string): Integer; 
 
    //clear the online list of client 
    procedure Clear; 
 
    //get the caption of the sprite which at the appointed area 
    function GetSpriteAt(X, Y: Double): string; 
  end; 
 
implementation 
 
{ TPlayerSprite } 
 
procedure TPlayerSprite.Go(EndX, EndY:Double); 
var 
  I: Integer; 
 
  //transform the default coordinate format to custom coordinate format 
  //the map with new coordinate is most smaller than normal 
  //so can process the map more faster include all of it's operation 
  function WorldToMapX(WX: Double): Integer; 
  begin 
    Result:=(Trunc(WX) +(MapW div 2)) div DL; 
    if Result>MapW then 
      Result:=MapW; 
    if Result<0 then 
      Result:=0; 
  end; 
 
  function WorldToMapY(WY: Double): Integer; 
  begin 
    Result:=(Trunc(WY)+MapH div 2) div dl; 
    if Result>MapH then 
      Result:=MapH; 
    if Result<0 then 
      Result:=0; 
  end; 
 
  function MapToWorldX(MX: Integer): Integer; 
  begin 
    Result:=MX*DL-MapW div 2+DL div 2; 
    if Result>MapW div 2 then 
      Result:=MapW div 2; 
    if Result<-MapW div 2 then 
      Result:=-MapW div 2; 
  end; 
 
  function MapToWorldY(MY: Integer):Integer; 
  begin 
    Result:=MY*DL-MapH div 2 + DL div 2; 
    if Result>MapH div 2 then 
      Result:=MapH div 2; 
    if Result<-MapH div 2 then 
      Result:=-MapH div 2; 
  end; 
 
begin 
  //create new coordinate of start position and end position 
  PathInf.FStartPos.x:=WorldToMapX(X); 
  PathInf.FStartPos.y:=WorldToMapY(Y); 
  PathInf.FEndPos.x:=WorldToMapX(EndX); 
  PathInf.FEndPos.y:=WorldToMapY(EndY); 
 
  //find path 
  //DXPath is a third party unit,i have modified a few part in it 
  if not PathInf.FindPath then 
    Exit; 
 
  PathIndex:=0; 
  PathCount:=PathInf.DirChangedPointsCount-1; 
 
  //copy the path points to temp value 
  //and DoMove function will move the sprite to end position along the points 
  for I:=1 to PathCount do 
  begin 
    Path[I-1].X:=MapToWorldX(PathInf.DirChangedPointsArr[I].Point.X); 
    Path[I-1].Y:=MapToWorldY(PathInf.DirChangedPointsArr[I].Point.Y); 
  end; 
end; 
 
destructor TPlayerSprite.Destroy; 
begin 
  PathInf.Free; 
  PathInf:=nil; 
  inherited Destroy; 
end; 
 
procedure TPlayerSprite.DoCollision(Sprite: TSprite; var Done: Boolean); 
begin 
  inherited; 
end; 
 
procedure TPlayerSprite.DoMove(MoveCount: Integer); 
var 
  EngX, EngY: Double; 
begin 
  inherited DoMove(MoveCount); 
 
  //animate speed 
  AnimSpeed := 8/1000; 
 
  if PathIndex>=PathCount then 
    Exit; 
 
  NewX:=Path[PathIndex].X; 
  NewY:=Path[PathIndex].Y; 
 
  Moved:=False; 
 
  if (X >NewX) then 
  begin 
    //calculate the length 
    X := X - (120/1000)*MoveCount; 
 
    //if length less then zero then don't move 
    if XAVAILABLE_AREA then 
    begin 
      AnimStart := 6; 
      AnimCount := 2; 
    end; 
 
    Moved:=True; 
  end; 
 
  if (XNewX then 
      X:=NewX; 
    if NewX-X>AVAILABLE_AREA then 
    begin 
      AnimStart := 2; 
      AnimCount := 2; 
    end; 
    Moved:=True; 
  end; 
 
  if Y > NewY then 
  begin 
    Y := Y - (120/1000)*MoveCount; 
 
    if YAVAILABLE_AREA then 
    begin 
      AnimStart := 0; 
      AnimCount := 2; 
    end; 
    Moved:=True; 
  end; 
 
  if Y < NewY then 
  begin 
    Y := Y + (120/1000)*MoveCount; 
 
    if Y>NewY then 
      Y:=NewY; 
    if NewY-Y>AVAILABLE_AREA then 
    begin 
      AnimStart := 4; 
      AnimCount := 2; 
    end; 
    Moved:=True; 
  end; 
 
  //if sprite has moved then animate can be played 
  AnimLooped:=Moved; 
 
  //if sprite has already move to new position then go to next postion 
  if not Moved then 
    Inc(PathIndex); 
 
  //process collision 
  Collision; 
 
  if not FIsMe then 
    Exit; 
 
  //scroll the window and insure self sprite is in the window 
  EngX := -X+Engine.Width div 2-Width div 2; 
  EngY := -Y+Engine.Height div 2-Height div 2; 
 
  if EngX>MapW div 2 then 
    Engine.X:=MapW div 2 
  else 
    if EngX<-MapW div 2 +Engine.Width then 
      Engine.X:=-MapW div 2+Engine.Width 
    else 
      Engine.X:=EngX; 
 
  if EngY>MapH div 2 then 
    Engine.Y:=MapH div 2 
  else 
    if EngY<-MapH div 2 + Engine.Height then 
      Engine.Y:=-MapH div 2+Engine.Height 
    else 
      Engine.Y:=EngY; 
end; 
 
procedure TPlayerSprite.SetCaption(const Value: string); 
begin 
  FCaption := Value; 
end; 
 
procedure TPlayerSprite.SetMoved(const Value: Boolean); 
begin 
  FMoved := Value; 
end; 
 
procedure TPlayerSprite.SetNewX(const Value: Double); 
begin 
  FNewX := Value; 
end; 
 
procedure TPlayerSprite.SetNewY(const Value: Double); 
begin 
  FNewY := Value; 
end; 
 
constructor TPlayerSprite.Create(Aparent: TSprite); 
begin 
  inherited Create(AParent); 
 
  //create PathInf and create digital map with new custom coordinate 
  PathInf:=TDXPath.Create(MapW div DL, MapH div DL); 
 
  Talk.Count:=0; 
  PathCala:=False; 
  PathIndex:=-1; 
  PathCount:=0; 
  AnchorX:=0; 
  AnchorY:=0; 
  x:=0; 
  y:=0; 
  Z := 8; 
end; 
 
function TPlayerSprite.HasObstacle(StartX, StartY: Integer): Boolean; 
var 
  AX, AY: Integer; 
begin 
  Result:=False; 
  for AX:=1 to DL do 
    for AY:=1 to DL do 
      Result:=Result or OrgObstacle[StartX-MapW div 2+AX-1, StartY-MapH div 2+AY-1]; 
end; 
 
procedure TPlayerSprite.MakeMap(MapEngine: TDXMap); 
var 
  I, J, K: Integer; 
begin 
  if PathCala then 
    Exit; 
 
  for I:=-MapW div 2 to MapW div 2 do 
    for J:=-MapH div 2 to MapH div 2 do 
      OrgObstacle[I, J]:=False; 
 
  with MapEngine.Engine.Engine do 
    for I:=0 to Count-1 do 
      if (not (Items[I] is TPlayerSprite)) and (not (Items[I] is TDecAcces)) then 
        for J:=0 to Items[I].Width-1 do 
          for K:=0 to Items[I].Height-1 do 
            OrgObstacle[Trunc(Items[I].X+J), Trunc(Items[I].Y+K)]:=True; 
 
  for I:=0 to MapH div DL-1 do 
    for J:=0 to MapW div DL-1 do 
      PathInf.FObstacle[I, J]:=HasObstacle(J*DL, I*DL); 
  PathCala:=True; 
end; 
 
procedure TPlayerSprite.Speak(ASend, ARece, AText: string; AFace: Integer; AOnlyOne: Boolean); 
begin 
  if Talk.Count>=1 then 
    RollTalk; 
 
  with Talk do 
  begin 
    Items[Count]:=AText; 
    Send[Count]:=Asend; 
    Rece[Count]:=ARece; 
    Face[Count]:=AFace; 
    OnlyOne[Count]:=AOnlyOne; 
    Life[Count]:=0; 
    Inc(Count); 
  end; 
end; 
 
procedure TPlayerSprite.RollTalk; 
var 
  I: Integer; 
begin 
  with Talk do 
  begin 
    Dec(Count); 
    for I:=0 to Count-1 do 
    begin 
      Items[I]:=Items[I+1]; 
      Send[I]:=Send[I+1]; 
      Rece[I]:=Rece[I+1]; 
      Face[I]:=Face[I+1]; 
      OnlyOne[I]:=OnlyOne[I+1]; 
      Life[I]:=Life[I+1]; 
    end; 
  end; 
end; 
 
procedure TPlayerSprite.SetDegree(const Value: Integer); 
begin 
  FDegree := Value; 
end; 
 
procedure TPlayerSprite.SetHeadID(const Value: Integer); 
begin 
  FHeadID := Value; 
end; 
 
procedure TPlayerSprite.SetAnchorX(const Value: Integer); 
begin 
  FAnchorX := Value; 
end; 
 
procedure TPlayerSprite.SetAnchorY(const Value: Integer); 
begin 
  FAnchorY := Value; 
end; 
 
procedure TPlayerSprite.SetIsMe(const Value: Boolean); 
begin 
  FIsMe := Value; 
end; 
 
{ TPlayers } 
 
function TPlayers.Add(ASprite: TSprite; ACaption: string; ADegree: Integer): Integer; 
begin 
  Items[FCount]:=TPlayerSprite.Create(ASprite); 
  with Items[FCount] do 
  begin 
    FCaption:=ACaption; 
    FDegree:=ADegree; 
  end; 
  Result:=FCount; 
  Inc(FCount); 
end; 
 
constructor TPlayers.Create(AOwner: TObject); 
begin 
  FCount:=0; 
end; 
 
procedure TPlayers.Delete(Index: Integer); 
var 
  I: Integer; 
begin 
  Items[Index].Free; 
  for I:=Index to FCount-2 do 
    Items[Index]:=Items[Index+1]; 
  Items[FCount-1]:=nil; 
  Dec(FCount); 
end; 
 
function TPlayers.FindByCaption(ACaption: string): Integer; 
var 
  I: Integer; 
begin 
  Result:=-1; 
  for I:=0 to FCount-1 do 
    if LowerCase(Items[I].Caption)=LowerCase(ACaption) then 
    begin 
      Result:=I; 
      Exit; 
    end; 
end; 
 
procedure TPlayers.SetCount(const Value: Integer); 
begin 
  FCount := Value; 
end; 
 
procedure TPlayers.Clear; 
var 
  I: Integer; 
begin 
  for I:=0 to FCount-1 do 
  begin 
    Items[I].Free; 
    Items[I]:=nil; 
  end; 
  FCount:=0; 
end; 
function TPlayers.GetSpriteAt(X, Y: Double): string; 
var 
  I: Integer; 
begin 
  Result:=''; 
  for I:=0 to FCount-1 do 
    if ((Items[I].X-Items[I].Image.Width div 2)X) and ((Items[I].Y+Items[I].Image.Height div 2)>Y) 
    then 
    begin 
      Result:=Items[I].Caption; 
      Exit; 
    end; 
end; 
 
end.