⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 charcls.pas

📁 千年源代码,只缺少控件,可以做二次开发用,好不容易得来的
💻 PAS
📖 第 1 页 / 共 5 页
字号:
unit CharCls;

interface

uses
  Windows, SysUtils, Classes, graphics,
  subutil, uanstick, deftype, A2Img, AtzCls, clType, maptype, clmap, backscrn,
  objcls, CTable;

const
   MAGICNEXTTIME = 7;           // 付过橇饭烙捞 函窍绰 矫埃
   DYNAMICOBJECTTIME = 15;      // DynamicObj啊 函拳窍绰 矫埃

   FRAME_BUFFER_SIZE = 30;

   MESSAGEARR_SIZE = 10;

   CharMaxSiez = 160;
   CHarMaxSiezHalf = 80;

   MovingMagicMaxSiez = 140;
   MovingMagicMaxSiezHalf = 70;

   DynamicObjectMaxSize = 200;
   DynamicObjectMaxSizeHalf = 100;

   BgEffectMaxSize = 140;
   BgEffectMaxSizeHalf = 70;

   CharImageBufferCount = 12;
const
   Color16Table : array [0..3*32-1] of word = (
                0,0,0,
                128,128,128,           // 焊烹
                84,191,127,            // 檬废
                153,108,71,            // 哎祸
                145,162,194,           // 颇鄂
                206,68,23,             // 弧埃
                71,150,153,            // 没废
                229,200,234,           // 焊扼
                225,230,157,           // 炔配祸
                109,0,32,              // 磊林
                63,187,239,            // 窍疵
                32,32,32,              // 盔濒厘
                255,0,0,               // 盔弧埃
                0,255,0,               // 盔踌祸
                0,0,255,               // 盔颇鄂
                255,255,255,           // 盔闰祸

                0,0,0,
                128,128,128,           // 焊烹
                84,191,127,            // 檬废
                153,108,71,            // 哎祸
                145,162,194,           // 颇鄂
                206,68,23,             // 弧埃
                71,150,153,            // 没废
                229,200,234,           // 焊扼
                225,230,157,           // 炔配祸
                109,0,32,              // 磊林
                63,187,239,            // 窍疵
                32,32,32,              // 盔濒厘
                255,0,0,               // 盔弧埃
                0,255,0,               // 盔踌祸
                0,0,255,               // 盔颇鄂
                255,255,255);          // 盔闰祸

type
  TRecordMessage = record
     rMsg, rdir, rx, ry: Integer;
     rfeature: TFeature;
     rmotion: integer
  end;

///////////// TBgEffect Class /////////// 010120 ankudo
  TBgEffect = class
  private
    DelayTick : integer;
    FUsed : Boolean;
    FAtzClass : TAtzClass;
    BgEffectShape : integer;
    LightEffectKind :TLightEffectKind;
    BgEffectIndex : integer;
    Realx, Realy : integer;
  public
    BgEffectTime : integer;           // BgEffect啊 函拳窍绰 矫埃
    BgOverValue : integer;

    FFileName : string;
    ID : integer;
    x, y: integer;
    EffectPositionData : TEffectPositionData;
    BgEffectImage : TA2Image;
    constructor Create (aAtzClass: TAtzClass);
    destructor  Destroy; override;
    procedure   Initialize (ax, ay: integer; aBgEffectShape: integer; aLightEffectKind: TLightEffectKind);
    procedure   Finalize;
    procedure   Paint(aRealx, aRealy : integer);
    procedure   SetFrame(CurTick : integer);
    function    Update ( CurTick: integer) : Integer;
    property    Used : Boolean read FUsed;
  end;

///////////// TDynamicObject Class /////////// 010102 ankudo
  TDynamicGuard = record
     aCount : Byte;
     aGuardX : array [0..10 -1] of Shortint; // 扁霖 128;
     aGuardY : array [0..10 -1] of Shortint; // 扁霖 128;
  end;

  TDynamicObject = Class
  private
    DelayTick : integer;
    FUsed : Boolean;
    FAtzClass : TAtzClass;
    DynamicObjIndex : integer;
    DynamicObjShape : integer;
    RealX, RealY: integer;
    FDynamicGuard : TDynamicGuard;

    StructedTick : integer;
    StructedPercent : integer;
  public
    Id : integer;
    x, y: integer;
    FStartFrame, FEndFrame : Word;

    DynamicObjImage : TA2Image;
    DynamicObjName  : string;
    DynamicObjectState : byte;

    constructor Create (aAtzClass: TAtzClass);
    destructor  Destroy; override;

    procedure   Initialize (aItemName: string; aId, ax, ay, aItemShape: integer;aStartFrame, aEndFrame: Word; aState: byte; aDynamicGuard: TDynamicGuard);
    procedure   Finalize;

    procedure   ChangeProperty(pCP : PTSChangeProperty);

    procedure   ProcessMessage (aMsg, aMotion: integer);
    procedure   SetFrame(aDynamicObjectState: byte; CurTick : integer);
    function    IsArea ( ax, ay: integer): Boolean;
    procedure   Paint;
    function    Update ( CurTick: integer) : Integer;
    property    Used : Boolean read FUsed;
    property    DynamicGuard : TDynamicGuard read FDynamicGuard;
  end;

  TItemClass = Class
  private
    FUsed : Boolean;
    FAtzClass : TAtzClass;
    ItemShape : integer;
    ItemColor : integer;
    RealX, RealY: integer;
    Race : byte;
  public
    Id : integer;
    x, y: integer;
    ItemImage : TA2Image;
    ItemName : string;
    constructor Create (aAtzClass: TAtzClass);
    destructor  Destroy; override;
    procedure   Initialize (aItemName: string; aRace: byte; aId, ax, ay, aItemshape, aItemcolor: integer);
    procedure   Finalize;
    procedure   SetItemAndColor (aItemshape, aItemColor: integer);

    procedure   ChangeProperty(pCP : PTSChangeProperty);

    function    IsArea ( ax, ay: integer): Boolean;
    procedure   Paint;
    function    Update ( CurTick: integer) : Integer;
    property    Used : Boolean read FUsed;
  end;

  TCharImageBuffer = record
     aCharImage : TA2Image;
     aImageNumber : integer;
  end;

  TCharClass = Class
  private
    TurningTick : integer;
    StructedTick : integer;
    StructedPercent : integer;

    AniList : TList;
    FrameStartTime: Longint;          // 青悼 矫累茄 矫埃
    ImageNumber : Integer;
    CurFrame : integer;
    CurActionInfo: PTAniInfo;

    OverImage : TA2Image;
    BgEffect : TBgEffect;

    RealX, RealY:integer;
    FUsed : Boolean;
    FAtzClass : TAtzClass;

    CurAction : integer;
    OldMakeFrame : integer;

    BubbleList : TStringList;
    BubbleTick : integer;

    MessageArr : array [0..MESSAGEARR_SIZE-1] of TRecordMessage;

    CharImageBuffer : array [0..CharImageBufferCount-1] of TCharImageBuffer;
    CharImageBufferIndex : integer;

    procedure   SetCurrentFrame (aAniInfo : PTAniInfo; aFrame, CurTime: integer);
    function    FindAnimation ( aact, adir : Integer) : PTAniInfo;
  public
    Name : string;
    id, dir, x, y : integer;
    Feature : TFeature;

    procedure   MakeFrame (aindex, CurTick: integer);
    procedure   AddMessage (aRMsg: TRecordMessage);
    procedure   GetMessage (var aRMsg: TRecordMessage);
    procedure   ViewMessage (var aRMsg: TRecordMessage);
                // BgEffect Initialize何盒 内靛锭巩俊 眠啊茄巴
    procedure   AddBgEffect (aRealx, aRealy: integer; aShape: integer; aLightEffectKind: TLightEffectKind);

    constructor Create (aAtzClass: TAtzClass);
    destructor  Destroy; override;
    procedure   Initialize (aName: string; aId, adir, ax, ay: integer; afeature: TFeature);
    procedure   Finalize;

    function    IsArea ( ax, ay: integer): Boolean;
    function    GetArrImageLib (aindex, CurTick: integer): TA2ImageLib;
    procedure   Paint (CurTick: integer);

    function    AllowAddAction: Boolean;
    function    ProcessMessage (aMsg, adir, ax, ay: Integer; afeature: TFeature; amotion: integer): Integer;
    function    Update ( CurTick: integer) : Integer;
    procedure   Say (astr: string);

    procedure   ChangeProperty(pCP : PTSChangeProperty);

    property    Used : Boolean read FUsed;
//    property    Image : TA2Image read CharImage;
  end;

  TCharList = class
  private
    CharDataList : TList;
    ItemDataList : TList;
    MagicDataList : TList;

    DynamicObjDataList : TList;

    FAtzClass : TAtzClass;

//    function isStaticItemID(aid : LongInt) : Boolean; //010127 ankudo isStaticitem阑 荤侩救窍备 race蔼栏肺 魄窜窃
    function isDynamicObjectStaticItemID(aid : LongInt) : Boolean;
  public
    constructor Create (aAtzClass: TAtzClass);
    destructor  Destroy; override;
    procedure   Clear;

    procedure   AddChar (aName: Widestring; aId, adir, ax, ay: integer; afeature: TFeature);
    function    GetChar (aId: integer): TCharClass;
    procedure   DeleteChar (aId: integer);
                // item
    procedure   AddItem (aItemName: string; aRace: byte;aId, ax, ay, aItemShape, aItemColor: integer);
    function    GetItem (aId: integer): TItemClass;
    procedure   DeleteItem (aId: integer);
                // DynamicObject Item 010105 ankudo
    procedure   AddDynamicObjItem (aItemName: string; aId, ax, ay, aItemShape: integer; aStartFrame, aEndFrame: Word; aState: byte; aDynamicGuard: TDynamicGuard);
    procedure   SetDynamicObjItem (aId : integer; aState: byte; aStartFrame, aEndFrame: Word);
    function    GeTDynamicObjItem (aId: integer): TDynamicObject;
    procedure   DeleteDynamicObjItem (aId: integer);

    procedure   AddMagic (sid, eid, adeg, aspeed, ax, ay, atx, aty, aMagicShape, CurTick: integer; aType: byte);
    procedure   GetVarRealPos (var aid, ax, ay: integer);
    function    isMovable (xx, yy: integer): Boolean;

    procedure   PaintText (aCanvas: TCanvas);
    procedure   Paint(CurTick: integer);
    function    UpDate (CurTick: integer): Integer;
    function    UpDataBgEffect (CurTick: integer): integer;
    procedure   MouseMove (x, y: integer);
  end;

   TMagicActionType = (MAT_SHOW, MAT_MOVE, MAT_HIDE, MAT_DESTROY);

   ToldMovingMagic = record
      asid, aeid : LongInt;
      aDeg : integer;
      atx, aty : word;
      aMagicShape : integer;
      amf : byte;
      aspeed : byte;
      aType : byte;
      ax, ay : integer;
    end;

  TMovingMagicClass = Class
  private
   StartId, EndId : longInt;
   speed : word;
   tx, ty, drawX, drawY : integer;
   ActionStartTime : DWORD;
   LifeCycle : integer;
   curframe : Integer;
   ArriveFlag : Boolean;
   Deg, Direction : word;

   MagicCount : integer;
   MagicType : byte;
   OldMovingMagicR : ToldMovingMagic;

    FUsed : Boolean;
    FAtzClass : TAtzClass;
    MagicShape : integer;
    RealX, RealY: integer;
    MsImageLib, MmImageLib, MeImageLib : TA2ImageLib;
    procedure SetAction (aAction : TMagicActionType; CurTime: integer);
  public
    MagicCurAction : TMagicActionType;
    x, y: integer;
//    MagicImage : TA2Image;
    MagicName : string;
    constructor Create (aAtzClass: TAtzClass);
    destructor  Destroy; override;
    procedure   Initialize (sid, eid, adeg, aspeed, ax, ay, atx, aty, aMagicShape, CurTick: integer; aType: byte);
    procedure   Finalize;

    procedure   Paint;
    function    Update ( CurTick: integer) : Integer;
    property    Used : Boolean read FUsed;
  end;


  procedure GetGreenColorAndAdd (acolor: integer; var GreenColor, GreenAdd: integer);

var
   CharList : TCharList;

   CharCenterId : integer = 0;
   CharCenterName : string = '';
   CharPosX : integer = 0;
   CharPosY : integer = 0;

   SelectedChar : integer = 0;
   Selecteditem : integer = 0;
   SelectedDynamicItem : integer = 0;

   CharMoveFrontdieFlag : Boolean = FALSE;

//   ColorIndex : array [0..32-1] of word;

implementation

{$O+}

//////////////////////////////////
//         Moving Magic Class
//////////////////////////////////
// 滚弊肺 牢秦辑 积变 酒捞袍祸阑 抛捞喉肺 贸府窃.
procedure GetGreenColorAndAdd (acolor: integer; var GreenColor, GreenAdd: integer);
begin
   if (acolor >= 256) or (acolor < 0) then acolor := 0;
   GreenColor := ColorDataTable[acolor*2];
   GreenAdd := ColorDataTable[acolor*2+1];

//   GreenColor := ColorIndex[acolor mod 32];
//   GreenAdd := acolor div 16;

//   GreenColor := WINRGB (ColorTable[acolor * 3 + 0],ColorTable[acolor * 3 + 1],ColorTable[acolor * 3 + 2] );
//   GreenAdd := acolor div 64;
end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -