?? clfunc.pas
字號:
unit ClFunc;
//輔助函數庫
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DXDraws, DirectX, DXClass, Grobal2, ScktComp, 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; //shift x ,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 ClearBag;
function AddItemBag (cu: TClientItem): Boolean;
function UpdateItemBag (cu: TClientItem): Boolean;
function DelItemBag (iname: string; iindex: integer): Boolean;
procedure ArrangeItemBag;
procedure AddDropItem (ci: TClientItem);
function GetDropItem (iname: string; MakeIndex: integer): PTClientItem;
procedure DelDropItem (iname: string; MakeIndex: integer);
procedure AddDealItem (ci: TClientItem);
procedure DelDealItem (ci: TClientItem);
procedure MoveDealItemToBag;
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);
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;
implementation
uses
clMain;
//格式化字符串為指定長度（后面添空格）
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;
//整數轉換為千位帶逗號的字符串，例如1234567轉換為“1,234,567”
//這里用于顯示金錢數量
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 ClearBag;
var
i: integer;
begin
for i:=0 to MAXBAGITEMCL-1 do
ItemArr[i].S.Name := '';
end;
//添加物品
function AddItemBag (cu: TClientItem): Boolean;
var
i: integer;
begin
Result := FALSE;
//檢查要添加的物品是否已經存在
for i:=0 to MAXBAGITEMCL-1 do begin
if (ItemArr[i].MakeIndex = cu.MakeIndex) and (ItemArr[i].S.Name = cu.S.Name) then begin
exit;
end;
end;
if cu.S.Name = '' then exit;
if cu.S.StdMode <= 3 then begin //可以使用的物品,首先放在快捷物品欄
for i:=0 to 5 do //前面6格顯示在快捷物品欄上
if ItemArr[i].S.Name = '' then begin //找一個空檔放下
ItemArr[i] := cu;
Result := TRUE;
exit;
end;
end;
for i:=6 to MAXBAGITEMCL-1 do begin
if ItemArr[i].S.Name = '' then begin
ItemArr[i] := cu;
Result := TRUE;
break;
end;
end;
ArrangeItembag;
end;
//用當前的物品屬性替代已經存在的該物品屬性
function UpdateItemBag (cu: TClientItem): Boolean;
var
i: integer;
begin
Result := FALSE;
for i:=MAXBAGITEMCL-1 downto 0 do begin
if (ItemArr[i].S.Name = cu.S.Name) and (ItemArr[i].MakeIndex = cu.MakeIndex) then begin
ItemArr[i] := cu;
Result := TRUE;
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 (ItemArr[i].S.Name = iname) and (ItemArr[i].MakeIndex = iindex) then begin
FillChar (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 ItemArr[i].S.Name <> '' then begin
for k:=i+1 to MAXBAGITEMCL-1 do begin //清除相同的物品
if (ItemArr[i].S.Name = ItemArr[k].S.Name) and (ItemArr[i].MakeIndex = ItemArr[k].MakeIndex) then begin
FillChar (ItemArr[k], sizeof(TClientItem), #0);
end;
end;
//若有移動的物品
if (ItemArr[i].S.Name = MovingItem.Item.S.Name) and (ItemArr[i].MakeIndex = MovingItem.Item.MakeIndex) then begin
MovingItem.Index := 0;
MovingItem.Item.S.Name := '';
end;
end;
end;
//6樣特殊物品欄
//啊規狼 救焊撈綽 何盒俊 樂欄擱 纏絹 棵赴促.
for i:=46 to MAXBAGITEMCL-1 do begin
if ItemArr[i].S.Name <> '' then begin
for k:=6 to 45 do begin
if ItemArr[k].S.Name = '' then begin
ItemArr[k] := ItemArr[i];
ItemArr[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 AddDealItem (ci: TClientItem);
var
i: integer;
begin
for i:=0 to 10-1 do begin
if DealItems[i].S.Name = '' then begin
DealItems[i] := ci;
break;
end;
end;
end;
procedure DelDealItem (ci: TClientItem);
var
i: integer;
begin
for i:=0 to 10-1 do begin
if (DealItems[i].S.Name = ci.S.Name) and (DealItems[i].MakeIndex = ci.MakeIndex) then begin
FillChar (DealItems[i], sizeof(TClientItem), #0);
break;
end;
end;
end;
procedure MoveDealItemToBag;
var
i: integer;
begin
for i:=0 to 10-1 do begin
if DealItems[i].S.Name <> '' then
AddItemBag (DealItems[i]);
end;
FillChar (DealItems, sizeof(TClientItem)*10, #0);
end;
procedure AddDealRemoteItem (ci: TClientItem);
var
i: integer;
begin
for i:=0 to 20-1 do begin
if DealRemoteItems[i].S.Name = '' then begin
DealRemoteItems[i] := ci;
break;
end;
end;
end;
procedure DelDealRemoteItem (ci: TClientItem);
var
i: integer;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -