clfunc.pas

传奇源代码的delphi版本

unit ClFunc;

interface

uses
  svn, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DXDraws, DirectX, DXClass, Grobal2, ExtCtrls, HUtil32, EdCode;


const
   DR_0      = 0;
   DR_1      = 1;
   DR_2      = 2;
   DR_3      = 3;
   DR_4      = 4;
   DR_5      = 5;
   DR_6      = 6;
   DR_7      = 7;
   DR_8      = 8;
   DR_9      = 9;
   DR_10      = 10;
   DR_11      = 11;
   DR_12      = 12;
   DR_13      = 13;
   DR_14      = 14;
   DR_15      = 15;

type
   TDynamicObject = record
      X: integer;
      Y: integer;
      px: integer;  //shiftx ,y
      py: integer;
      DSurface: TDirectDrawSurface;
   end;
   PTDynamicObject = ^TDynamicObject;
var
   DropItems: TList;  //lsit of TClientItem

function  fmStr (str: string; len: integer): string;
function  GetGoldStr (gold: integer): string;
procedure SaveBags (flname: string; pbuf: Pbyte);
procedure Loadbags (flname: string; pbuf: Pbyte);
procedure SaveStores (flname: string; pbuf: Pbyte);
procedure LoadStores (flname: string; pbuf: Pbyte);
procedure ClearBag;
procedure ClearStore;
function  AddItemBag (cu: TClientItem): Boolean;
function AddItemStore (cu: TClientItem): Boolean;
function  AddItemBagst (cu: TClientItem): Boolean;
procedure Fillquickslots(sname: String;position: integer);
function  UpdateItemBag (cu: TClientItem): Boolean;
function  DelItemBag (iname: string; iindex: integer): Boolean;
procedure ArrangeItemBag;
procedure ArrangeItemStore;
procedure AddDropItem (ci: TClientItem);
function  GetDropItem (iname: string; MakeIndex: integer): PTClientItem;
procedure DelDropItem (iname: string; MakeIndex: integer);
procedure AddRefineItem (ci: TClientItem);
procedure DelRefineItem (ci: TClientItem);
procedure AddDealItem (ci: TClientItem);
procedure DelDealItem (ci: TClientItem);
procedure MoveDealItemToBag;
procedure MoveRefineItemToBag;
procedure AddDealRemoteItem (ci: TClientItem);
procedure DelDealRemoteItem (ci: TClientItem);
function  GetDistance (sx, sy, dx, dy: integer): integer;
procedure GetNextPosXY (dir: byte; var x, y:Integer);
procedure GetNextRunXY (dir: byte; var x, y:Integer);
procedure GetNextHorseRunXY (dir: byte; var x, y:Integer);
function  GetNextDirection (sx, sy, dx, dy: Integer): byte;
function  GetBack (dir: integer): integer;
procedure GetBackPosition (sx, sy, dir: integer; var newx, newy: integer);
procedure GetFrontPosition (sx, sy, dir: integer; var newx, newy: integer);
function  GetFlyDirection (sx, sy, ttx, tty: integer): Integer;
function  GetFlyDirection16 (sx, sy, ttx, tty: integer): Integer;
function  PrivDir (ndir: integer): integer;
function  NextDir (ndir: integer): integer;
procedure BoldTextOut (surface: TDirectDrawSurface; x, y, fcolor, bcolor: integer; str: string);
function  GetTakeOnPosition (smode: integer): integer;
function  IsKeyPressed (key: byte): Boolean;

procedure AddChangeFace (recogid: integer);
procedure DelChangeFace (recogid: integer);
function  IsChangingFace (recogid: integer): Boolean;

procedure LoadDecoList();
function  FindDecoration(Number:integer):pTDecoItem;

implementation

uses
   clMain, MShare, Share;


function fmStr (str: string; len: integer): string;
var i: integer;
begin
try
   Result := str + ' ';
   for i:=1 to len - Length(str)-1 do
      Result := Result + ' ';
except
	Result := str + ' ';
end;
end;

function  GetGoldStr (gold: integer): string;
var
   i, n: integer;
   str: string;
begin
   str := IntToStr (gold);
   n := 0;
   Result := '';
   for i:=Length(str) downto 1 do begin
      if n = 3 then begin
         Result := str[i] + ',' + Result;
         n := 1;
      end else begin
         Result := str[i] + Result;
         Inc(n);
      end;
   end;
end;

procedure SaveBags (flname: string; pbuf: Pbyte);
var
   fhandle: integer;
begin
   if FileExists (flname) then
      fhandle := FileOpen (flname, fmOpenWrite or fmShareDenyNone)
   else fhandle := FileCreate (flname);
   if fhandle > 0 then begin
      FileWrite (fhandle, pbuf^, sizeof(TClientItem) * MAXBAGITEMCL);
      FileClose (fhandle);
   end;
end;

procedure Loadbags (flname: string; pbuf: Pbyte);
var
   fhandle: integer;
begin
   if FileExists (flname) then begin
      fhandle := FileOpen (flname, fmOpenRead or fmShareDenyNone);
      if fhandle > 0 then begin
         FileRead (fhandle, pbuf^, sizeof(TClientItem) * MAXBAGITEMCL);
         FileClose (fhandle);
      end;
   end;
end;

procedure SaveStores (flname: string; pbuf: Pbyte);
var
   fhandle: integer;
begin
   if FileExists (flname) then
      fhandle := FileOpen (flname, fmOpenWrite or fmShareDenyNone)
   else fhandle := FileCreate (flname);
   if fhandle > 0 then begin
      FileWrite (fhandle, pbuf^, sizeof(TClientItem) * MAXSTORAGEITEMCL);
      FileClose (fhandle);
   end;
end;

procedure LoadStores (flname: string; pbuf: Pbyte);
var
   fhandle: integer;
begin
   if FileExists (flname) then begin
      fhandle := FileOpen (flname, fmOpenRead or fmShareDenyNone);
      if fhandle > 0 then begin
         FileRead (fhandle, pbuf^, sizeof(TClientItem) * MAXSTORAGEITEMCL);
         FileClose (fhandle);
      end;
   end;
end;

procedure ClearBag;
var
   i: integer;
begin
   for i:=0 to MAXBAGITEMCL-1 do
      g_ItemArr[i].S.Name := '';
end;

procedure ClearStore;
var
   i: integer;
begin
   for i:=0 to MAXSTORAGEITEMCL-1 do
      g_StoreItem[i].S.Name := '';
end;

function  AddItemBag (cu: TClientItem): Boolean;
var
   i: integer;
begin
   Result := FALSE;
   for i:=0 to MAXBAGITEMCL-1 do begin
      if (g_ItemArr[i].MakeIndex = cu.MakeIndex) and (g_ItemArr[i].S.Name = cu.S.Name) then begin
         //exit;
        if cu.S.StdMode = 45 then begin
          Result := TRUE;
          inc(g_ItemArr[i].Amount);
          exit;
        end;
      end;
   end;

   if cu.S.Name = '' then exit;
   if cu.S.StdMode <= 3 then begin
      for i:=0 to 5 do
         if g_ItemArr[i].S.Name = '' then begin
            g_ItemArr[i] := cu;
            Result := TRUE;
            exit;
         end;
   end;
   for i:=6 to MAXBAGITEMCL-1 do begin
      if g_ItemArr[i].S.Name = '' then begin
         g_ItemArr[i] := cu;
         Result := TRUE;
         break;
      end;
   end;
   ArrangeItembag;
end;

function AddItemStore (cu: TClientItem): Boolean;
var
   i: integer;
begin
   Result := FALSE;
   for i:=0 to MAXSTORAGEITEMCL-1 do begin
      if (g_StoreItem[i].MakeIndex = cu.MakeIndex) and (g_StoreItem[i].S.Name = cu.S.Name) then begin
         //exit;
        if cu.S.StdMode = 45 then begin
          Result := TRUE;
          inc(g_StoreItem[i].Amount);
          exit;
        end;
      end;
   end;

   if cu.S.Name = '' then exit;
   for i:=0 to MAXSTORAGEITEMCL-1 do begin
      if g_StoreItem[i].S.Name = '' then begin
         g_StoreItem[i] := cu;
         Result := TRUE;
         break;
      end;
   end;
   ArrangeItemStore;
end;

function  AddItemBagst (cu: TClientItem): Boolean;
var
  i:integer;
begin
  Result := FALSE;

  if cu.Amount > 1 then begin
    for i:=0 to MAXBAGITEMCL-1 do begin
      if (g_ItemArr[i].MakeIndex = cu.MakeIndex) and (g_ItemArr[i].S.Name = cu.S.Name) then begin
        inc(g_ItemArr[i].Amount,cu.Amount);
        Result := TRUE;
        exit;
      end;
    end;
    Result := AddItemBag(cu);
  end else
    Result := AddItemBag (cu);
end;

procedure Fillquickslots(sname: String;position: integer);
var
  i: integer;
begin

  if position = -1 then begin
    for i := 0 to 6 do begin
      if g_ItemArr[i].S.Name = sName then begin
        position := 1;
        break
      end;
    end;
  end;
  if g_ItemArr[position].S.Name <> '' then exit;
  for i:=6 to MAXBAGITEMCL-1 do begin
    if (g_ItemArr[i].S.Name = sName) and (g_ItemArr[i].S.StdMode <= 3) then begin
      g_ItemArr[position] := g_ItemArr[i];
      FillChar (g_ItemArr[i], sizeof(TClientItem), #0);
      exit;
    end;
  end;
end;


function  UpdateItemBag (cu: TClientItem): Boolean;
var
   i: integer;
   ItemEffect:pTItemEffect;
begin
   Result := FALSE;
   for i:=MAXBAGITEMCL-1 downto 0 do begin
      if (g_ItemArr[i].S.Name = cu.S.Name) and (g_ItemArr[i].MakeIndex = cu.MakeIndex) then begin
         g_ItemArr[i] := cu;
         Result := TRUE;
         //add playsound
         //startup the item effect (sparkling)
         new(ItemEffect);
         ItemEffect.Idx := i;
         ItemEffect.n_CurrentFrame := 0;
         ItemEffect.n_StartFrame := 410;
         ItemEffect.n_EndFrame := 9;
         ItemEffect.n_NextFrame := 150;
         ItemEffect.n_LastFrame := GetTickCount;
         g_ItemEffects.Add(ItemEffect);
         break;
      end;
   end;
end;

function  DelItemBag (iname: string; iindex: integer): Boolean;
var
   i: integer;
begin
   Result := FALSE;
   for i:=MAXBAGITEMCL-1 downto 0 do begin
      if (g_ItemArr[i].S.Name = iname) and (g_ItemArr[i].MakeIndex = iindex) then begin
         FillChar (g_ItemArr[i], sizeof(TClientItem), #0);
         Result := TRUE;
         break;
      end;
   end;
   ArrangeItembag;
end;

procedure ArrangeItemBag;
var
   i, k: integer;
begin
   for i:=0 to MAXBAGITEMCL-1 do begin
      if g_ItemArr[i].S.Name <> '' then begin
         for k:=i+1 to MAXBAGITEMCL-1 do begin
            if (g_ItemArr[i].S.Name = g_ItemArr[k].S.Name) and (g_ItemArr[i].MakeIndex = g_ItemArr[k].MakeIndex) then begin
              if g_ItemArr[k].S.StdMode = 45 then FillChar (g_ItemArr[k], sizeof(TClientItem), #0);
            end;
         end;
         {for k:=0 to 9 do begin
            if (ItemArr[i].S.Name = DealItems[k].S.Name) and (ItemArr[i].MakeIndex = DealItems[k].MakeIndex) then begin
               FillChar (ItemArr[i], sizeof(TClientItem), #0);
               //FillChar (DealItems[k], sizeof(TClientItem), #0);
            end;
         end; }
         if (g_ItemArr[i].S.Name = g_MovingItem.Item.S.Name) and (g_ItemArr[i].MakeIndex = g_MovingItem.Item.MakeIndex) then begin
            g_MovingItem.Index := 0;
            g_MovingItem.Item.S.Name := '';
         end;
      end;
   end;

   for i:=46 to MAXBAGITEMCL-1 do begin
      if g_ItemArr[i].S.Name <> '' then begin
         for k:=6 to 45 do begin
            if g_ItemArr[k].S.Name = '' then begin
               g_ItemArr[k] := g_ItemArr[i];
               g_ItemArr[i].S.Name := '';
               break;
            end;
         end;
      end;
   end;
end;

procedure ArrangeItemStore;
var
   i, k: integer;
begin
   for i:=0 to MAXSTORAGEITEMCL-1 do begin
      if g_StoreItem[i].S.Name <> '' then begin
         for k:=i+1 to MAXSTORAGEITEMCL-1 do begin
            if (g_StoreItem[i].S.Name = g_StoreItem[k].S.Name) and (g_StoreItem[i].MakeIndex = g_StoreItem[k].MakeIndex) then begin
              if g_StoreItem[k].S.StdMode = 45 then FillChar (g_StoreItem[k], sizeof(TClientItem), #0);
            end;
         end;

         if (g_StoreItem[i].S.Name = g_MovingItem.Item.S.Name) and (g_StoreItem[i].MakeIndex = g_MovingItem.Item.MakeIndex) then begin
            g_MovingItem.Index := 0;
            g_MovingItem.Item.S.Name := '';
         end;
      end;
   end;

   for i:=80 to MAXSTORAGEITEMCL-1 do begin
      if g_StoreItem[i].S.Name <> '' then begin
         for k:=0 to 79 do begin
            if g_StoreItem[k].S.Name = '' then begin
               g_StoreItem[k] := g_StoreItem[i];
               g_StoreItem[i].S.Name := '';
               break;
            end;
         end;
      end;
   end;
end;
{----------------------------------------------------------}

procedure AddDropItem (ci: TClientItem);
var
   pc: PTClientItem;
begin
   new (pc);
   pc^ := ci;
   DropItems.Add (pc);
end;

function  GetDropItem (iname: string; MakeIndex: integer): PTClientItem;
var
   i: integer;
begin
   Result := nil;
   for i:=0 to DropItems.Count-1 do begin
      if (PTClientItem(DropItems[i]).S.Name = iname) and (PTClientItem(DropItems[i]).MakeIndex = MakeIndex) then begin
         Result := PTClientItem(DropItems[i]);
         break;
      end;
   end;
end;

procedure DelDropItem (iname: string; MakeIndex: integer);
var
   i: integer;
begin
   for i:=0 to DropItems.Count-1 do begin
      if (PTClientItem(DropItems[i]).S.Name = iname) and (PTClientItem(DropItems[i]).MakeIndex = MakeIndex) then begin
         Dispose (PTClientItem(DropItems[i]));
         DropItems.Delete (i);
         break;
      end;
   end;
end;

procedure AddRefineItem (ci: TClientItem);
var
   i: integer;
begin
   for i:=0 to 15-1 do begin
      if g_RefineItems[i].S.Name = '' then begin
         g_RefineItems[i] := ci;
         break;
      end;
   end;
end;

procedure DelRefineItem (ci: TClientItem);
var
   i: integer;
begin
   for i:=0 to 16-1 do begin
      if (g_RefineItems[i].S.Name = ci.S.Name) and (g_RefineItems[i].MakeIndex = ci.MakeIndex) then begin
         FillChar (g_RefineItems[i], sizeof(TClientItem), #0);
         break;
      end;
   end;
end;
{----------------------------------------------------------}

procedure AddDealItem (ci: TClientItem);
var
   i: integer;
begin
   for i:=0 to 10-1 do begin
      if g_DealItems[i].S.Name = '' then begin