atzcls.pas

来自「千年源代码,只缺少控件,可以做二次开发用,好不容易得来的」· PAS 代码 · 共 583 行 · 第 1/2 页

PAS
583
字号
unit AtzCls;

interface

uses
  Windows, SysUtils, Classes, A2Img, deftype, clType, StrDb, uAnsTick, AUtil32;

const
   UnUsedFreeTickDelay = 30000;
   UnUsedFreeTickAtzLibDelay = 20000;

   FreeCountMAXSIZE = 3;

type

  TAtzClass = Class
  private
    UnUsedFreeTick : integer;
    Directory : string;
    DataStringList : TStringList;
    ItemImageLib : TA2ImageLib;
    MagicImageLib : TA2ImageLib;

    FreeCountMAXCount : integer;
    FreeCount : integer;
    BufferFileList : TStringList;
    procedure   Initialize (aDirectory: string);
    procedure   Finalize;
  public
    constructor Create (aDirectory: string);
    destructor  Destroy; override;

    procedure   LoadFormBufferFile(aFileName : string);
    procedure   SaveToBufferFile(aFileName : string);

    procedure   UpDate (CurTick: integer);
    procedure   SetDontFreeLib (aLibNames: string);
    function    GetImageLib (afName: string; CurTick: integer): TA2ImageLib;
    function    GetItemImage (idx: integer): TA2Image;
    function    GetMagicImage (idx: integer): TA2Image;
  end;


   TAnimater = class
    private
      AniStringList : TStringList;
      procedure LoadFromFile (aFileName: string; List : TList);
    public
      constructor Create;
      destructor Destroy; override;
      function GetAnimationList (aindex: integer): TList;
   end;


   TEffectPositionData = record
      rArr : array [0..16-1 +2] of integer; // +2 绰 overValue, Speed
   end;
   PTEffectPositionData = ^TEffectPositionData;

   TEffectPositionClass = class
    private
      StringList : TStringList;
      procedure Clear;
    public
      constructor Create;
      destructor Destroy; override;
      procedure LoadFromFile (aFileName: string);
      function GetPosition (aFileName: string): TEffectPositionData;
   end;

   TEtcAtzClass = class
    private
      munetcAtzLib : TA2ImageLib;
    public
      constructor Create;
      destructor Destroy; override;
      function GetEtcAtz (value : integer): TA2Image;
   end;

var
   AtzClass : TAtzClass;
   Animater : TAnimater;
   EffectPositionClass : TEffectPositionClass;
   EtcAtzClass : TEtcAtzClass;

implementation

var
  SearchRec: TSearchRec;

constructor TEffectPositionClass.Create;
begin
   StringList := TStringList.Create;
   LoadFromFile ('.\AtzPosXY.sdb');
end;

destructor TEffectPositionClass.Destroy;
begin
   Clear;
   StringList.Free;
   inherited Destroy;
end;

procedure TEffectPositionClass.Clear;
var
   i: integer;
   p : PTEffectPositionData;
begin
   for i := 0 to StringList.Count -1 do begin
      p := PTEffectPositionData (StringList.Objects[i]);
      dispose (p);
   end;
   StringList.Clear;
end;

procedure TEffectPositionClass.LoadFromFile (aFileName: string);
var
   i, j :integer;
   iname : string;
   StringDb : TStringDb;
   p : PTEffectPositionData;
begin
   if not FileExists (aFileName) then exit;

   StringDb := TStringDb.Create;
   StringDb.LoadFromFile (aFileName);

   for j := 0 to StringDb.Count -1 do begin
      iname := StringDb.GetIndexName(j);
      new (p);
      P^.rArr[0] := StringDb.GetFieldValueInteger (iname, 'OverValue');
      P^.rArr[1] := StringDb.GetFieldValueInteger (iname, 'Speed');
      for i := 0 to 8-1 do begin
         p^.rArr[i*2 +2] := StringDb.GetFieldValueInteger (iname, 'Dir'+IntToStr (i) + 'X'); // overvalue, Speed 锭巩俊 +2
         p^.rArr[i*2+1 +2] := StringDb.GetFieldValueInteger (iname, 'Dir'+IntToStr (i) + 'Y');
      end;
      StringList.AddObject (iname, TObject (p));
   end;
   StringDb.Free;
end;

function  TEffectPositionClass.GetPosition (aFileName: string): TEffectPositionData;
var i:integer;
begin
   FillChar (Result, sizeof(Result), 0);
   for i := 0 to StringList.Count -1 do begin
      if StringList[i] = aFilename then begin
         Result := PTEffectPositionData (StringList.Objects[i])^;
         exit;
      end;
   end;
end;

////////////////////////////////////////////////////////////////////////////////
//                         TAtzClass                                          //
////////////////////////////////////////////////////////////////////////////////

constructor TAtzClass.Create (aDirectory: string);
begin
   UnUsedFreeTick := mmAnsTick;
   Directory := aDirectory;
   DataStringList := TStringList.Create;
   ItemImageLib := TA2ImageLib.Create;
   ItemImageLib.LoadFromFile ('item.atz');
   MagicImageLib := TA2ImageLib.Create;
   MagicImageLib.LoadFromFile ('magic.atz');
   BufferFileList := TStringList.Create;
   FreeCount := 0;
   FreeCountMAXCount := FreeCountMAXSIZE;
   Initialize (Directory);  // 弃歹俊 '\' 器窃等颇扼固磐
end;

destructor  TAtzClass.Destroy;
var
   i : integer;
   Lib : TA2ImageLib;
begin
   for i := DataStringList.Count - 1  downto 0 do begin
      Lib := TA2ImageLib(DataStringList.Objects[i]);
      if mmAnsTick > Lib.Tag + UnUsedFreeTickAtzLibDelay then begin
         Lib.Free;
         DataStringList.Delete (i);
      end;
   end;
   SaveToBufferFile(Directory + 'Atz.b');
   BufferFileList.Free;
   MagicImageLib.Free;
   ItemImageLib.Free;
   Finalize;
   DataStringList.Free;
   inherited Destroy;
end;

function    TAtzClass.GetItemImage (idx:integer): TA2Image;
begin
   Result := nil;
   if (idx < 0) or (idx >= ItemImageLib.Count) then exit;
   Result := ItemImageLib[idx];
end;

function    TAtzClass.GetMagicImage (idx:integer): TA2Image;
begin
   Result := nil;
   if (idx < 0) or (idx >= MagicImageLib.Count) then exit;
   Result := MagicImageLib[idx];
end;

function    TAtzClass.GetImageLib (afName: string; CurTick : integer): TA2ImageLib;
var
   i : integer;
   ImageLib : TA2ImageLib;
begin
   Result := nil;
   for i := 0 to DataStringList.Count -1 do begin //刚历 DataStringList俊辑 serch
      if afname = DataStringList[i] then begin
         TA2ImageLib (DataStringList.Objects[i]).Tag := CurTick;
         Result := TA2ImageLib (DataStringList.Objects[i]);
         exit;
      end;
   end;

   if FileExists (Directory + afname) then begin //绝栏搁 File Load
      Imagelib := TA2ImageLib.Create;
      ImageLib.LoadFromFile (Directory + afname);
      DataStringList.AddObject (afname, TObject(ImageLib));
      ImageLib.Tag := CurTick;
      Result := ImageLib;
   end;
end;

procedure   TAtzClass.SetDontFreeLib (aLibNames: string); //
var
   i : integer;
   str, rdstr : string;
   ImageLib : TA2ImageLib;
begin
   str := aLibNames;

   for i := 0 to DataStringList.Count -1 do begin
      ImageLib := TA2ImageLib (DataStringList.Objects[i]);
      if ImageLib.Tag = 2 then ImageLib.Tag := 1;
   end;

   while TRUE do begin
      str := GetValidStr3 (str, rdstr, ',');
      if rdstr = '' then break;
      for i := 0 to DataStringList.Count -1 do begin
         if rdstr = DataStringList[i] then TA2ImageLib (DataStringList.Objects[i]).Tag := 2;
      end;
   end;
end;

procedure   TAtzClass.Initialize (aDirectory: string);  // 弃歹俊 '\' 器窃等颇扼固磐
var
   n, i : integer;
   str : string;
   ImageLib : TA2ImageLib;
   memStatus : TMemoryStatus;
begin
//   exit;
   memStatus.dwLength := SizeOf(memStatus) ;
   Directory := aDirectory;

   if FileExists(Directory + 'Atz.b') then begin
      LoadFormBufferFile(Directory + 'Atz.b');
      for i := 0 to BufferFileList.Count -1 do begin
         GlobalMemoryStatus(memStatus);
         if memStatus.dwAvailPhys < 15000000 then break; // 15M 捞窍搁 load救窃
         str := LowerCase(BufferFileList[i]);
         Imagelib := TA2ImageLib.Create;
         ImageLib.LoadFromFile (Directory + str);
         DataStringList.AddObject (str, TObject(ImageLib));
      end;
   end else begin
      n := FindFirst(Directory + '*.atz', faAnyFile, SearchRec);
      if n = 0 then begin
         str := LowerCase(SearchRec.Name);
         Imagelib := TA2ImageLib.Create;
         ImageLib.LoadFromFile (Directory + str);
         DataStringList.AddObject (str, TObject(ImageLib));
      end;

      while TRUE do begin
         n := FindNext(SearchRec);
         GlobalMemoryStatus(memStatus);
         if memStatus.dwAvailPhys < 15000000 then break; // 15M 捞窍搁 load救窃
         if n = 0 then begin
            str := LowerCase(SearchRec.Name);
            if Pos ('z',str) <> 1 then begin
               Imagelib := TA2ImageLib.Create;
               ImageLib.LoadFromFile (Directory + str);
               DataStringList.AddObject (str, TObject(ImageLib));

⌨️ 快捷键说明

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