Скриптинг Форум посвещенный созданию скриптов для L2PacketHack
27.01.2009, 20:31
#11
Пользователь
Регистрация: 01.01.2008
Сообщений: 34
Сказал Спасибо: 26
Имеет 2 спасибок в 2 сообщенях
Цитата:
Сообщение от
NLObP
А если просто в два раза больше места занимать?
на обработку масса лишнего проц времени уйдёт
или проще говоря труднее оперировать
__________________
смотрю и учусь я тут
27.01.2009, 20:32
#12
Пользователь
Регистрация: 09.08.2008
Сообщений: 29
Сказал Спасибо: 14
Имеет 2 спасибок в 2 сообщенях
Цитата:
Сообщение от
vovanchik
Цитата:
Сообщение от ERASE
Почему? И будет ли пахать когда-нить?
ЗЫ. а статический?..
Видать человеку поговорить нескем
Нет, просто сейчас пишу скрипт, в нем в будущем надо будет кое-что прикрутить. Так вот это "кое-что" будет основано на динамическом двумерном массиве. Поэтому и спрашиваю.
Цитата:
Сообщение от
vovanchik
Цитата:
Сообщение от ERASE
Может, ты имел что-то другое ввиду? Я мог не понять...
именно так создаётся динамический двумерный массив в паскале , ну по крайней мере в Delphi
kuchka_hlama: array of array of string;
setlength(kuchka_hlama,length(kuchka_hlama)+1); //увеличение масива на 1
теперь у массива есть kuchka_hlama[0,0]
Ну я ж говорю, про динамический не знаю, статический точно -
Код:
mas:array [1..n,1..n] of string;
29.01.2009, 09:19
#13
Пользователь
Регистрация: 22.04.2008
Сообщений: 51
Сказал Спасибо: 14
Имеет 36 спасибок в 11 сообщенях
может поможет тебе,
только что наваял плагинчик:
delphi Код:
// *****************************************************************************
// plugin для работы с БД
// alexsl / 29.01.09
// *****************************************************************************
library dbhelper;
// --- закоментить если компилируется под Delphi 2007 +
{$define ShareMM}
{$define AttemptToUseSharedMM}
// -----------------------------
{.$define RELEASE} // для совместимости с релизом пакетхака, при дебуге можно закоментировать
{$define DBDebug} //
uses
FastMM4,
SysUtils,
Windows,
Variants,
Dialogs,
Coding,
classes;
type
TL2Obj = class
private
FX: integer ;
FID: integer ;
FZ: integer ;
FY: integer ;
procedure SetID( const Value: integer ) ;
procedure SetX( const Value: integer ) ;
procedure SetY( const Value: integer ) ;
procedure SetZ( const Value: integer ) ;
public
property ID: integer read FID write SetID;
property X: integer read FX write SetX;
property Y: integer read FY write SetY;
property Z: integer read FZ write SetZ;
end ;
TL2World = class
private
function GetCount: integer ;
protected
FLIst: TLIst ;
function GetOrCreate( AObjID: integer ) : TL2Obj;
function Get( AObjID: integer ) : TL2Obj;
public
constructor Create;
destructor Destroy; override;
property Count: integer read GetCount;
procedure Clear;
procedure Add( AObjID,AX,AY,AZ: integer ) ;
procedure Move ( AObjID,AX,AY,AZ: integer ) ;
procedure Delete ( AObjID: integer ) ;
function Dist( FromObjID,ToObjID: integer ) : integer ;
function DistEx( FromObjID,AX,AY,AZ: integer ) : integer ;
// возвр. ближ. объект
function GetMinDistObj( AX,AY,AZ: integer ) : integer ;
// возвр. ближ. объект в указанном Радиусе
function GetMinDistObjEx( AX,AY,AZ,Radius: integer ) : integer ;
end ;
var {version} {revision}
min_ver_a: array[0 ..3 ] of Byte = ( 3 ,4 ,1 , 0 ) ;
min_ver: Integer absolute min_ver_a; // минимальная поддерживаемая версия программы
ps: TPluginStruct;
// ppck: PPacket;
db: TL2World;
function GetPluginInfo( const ver: Integer ) : PChar ; stdcall;
begin
if ver<min_ver then
Result:='Plugin к программе l2phx' +sLineBreak+
'Для версий 3.4.1+' +sLineBreak+
'У вас старая версия программы! Плагин не сможет корректно с ней работать!'
else
Result:='Plugin к программе l2phx' +sLineBreak+
'Для версий 3.4.1+' +sLineBreak+
'DB Helper (alexsl)' ;
end ;
function SetStruct( const struct: TPluginStruct) : Boolean ; stdcall;
begin
ps:=struct;
Result:=True ;
end ;
// Необязательно вызываемая функция. (может отсутствовать в плагине)
// Вызывается при выгрузке плагине
procedure OnFree; stdcall;
begin
if assigned ( db) then
try
db.Free ;
except
{$IFDEF DBDebug}
raise ;
{$ENDIF}
end ;
end ;
// Необязательно вызываемая функция. (может отсутствовать в плагине)
// Вызывается при загрузке плагине
procedure OnLoad; stdcall;
begin
db := TL2World.Create ;
end ;
// Необязательно вызываемая функция. (может отсутствовать в плагине)
// Вызывается при вызове скриптовой функции обьявленной в RefreshPrecompile
function OnCallMethod( const MethodName: String ; // имя функции в верхнем регистре
var Params, // параметры функции
FuncResult: Variant // результат функции
) : Boolean ; stdcall; // если вернёт True то дальнейшая
// обработка функции прекратиться
begin
Result:=False ; // передаём обработку функции программе
if MethodName='DB_COUNT' then begin
Result:=True ; // запрещаем дальнейшую обработку функции в программе
FuncResult:=db.Count ;
end
else
if MethodName='DB_CLEAR' then begin
Result:=True ; // запрещаем дальнейшую обработку функции в программе
db.Clear ;
end
else
// добавить объект в базу
if MethodName='DB_ADD' then begin
Result:=True ; // запрещаем дальнейшую обработку функции в программе
try
// ObjID, X, Y,Z
db.Add ( Params[0 ],Params[1 ],params[2 ],params[3 ]) ;
except
{$IFDEF DBDebug}
raise ;
{$ENDIF}
end ;
end
else
// объект удален
if MethodName='DB_DELETE' then begin
Result:=True ; // запрещаем дальнейшую обработку функции в программе
try
db.Delete ( Params[0 ]) ;
except
{$IFDEF DBDebug}
raise ;
{$ENDIF}
end ;
end
else
// объект двигается, если нету в БД то создается автоматически
if MethodName='DB_MOVE' then begin
Result:=True ; // запрещаем дальнейшую обработку функции в программе
try
db.Move ( Params[0 ],Params[1 ],params[2 ],params[3 ]) ;
except
{$IFDEF DBDebug}
raise ;
{$ENDIF}
end ;
end
else
// растояние между объектами, если нет объекта/ов возвр. -1
if MethodName='DB_DIST' then begin
Result:=True ; // запрещаем дальнейшую обработку функции в программе
try
// FromObjID, ToObjID
FuncResult:=db.Dist ( Params[0 ],Params[1 ]) ;
except
{$IFDEF DBDebug}
raise ;
{$ENDIF}
end ;
end
else
// растояние между объектом и координатами
if MethodName='DB_DISTEX' then begin
Result:=True ; // запрещаем дальнейшую обработку функции в программе
try
// ObjID, X,Y,Z
FuncResult:=db.DistEx ( Params[0 ],Params[1 ],Params[2 ],Params[3 ]) ;
except
{$IFDEF DBDebug}
raise ;
{$ENDIF}
end ;
end
else
// возвр. ИД ближайщего объекта от заданных координат
// или -1 если нету
if MethodName='DB_MINDIST' then begin
Result:=True ;
try
// X,Y,Z
FuncResult:=db.GetMinDistObj ( Params[0 ],Params[1 ],Params[2 ]) ;
except
{$IFDEF DBDebug}
raise ;
{$ENDIF}
end ;
end
else
// возвр. ИД ближайщего объекта от заданных координат с учетом Радиуса
// или -1 если нету
if MethodName='DB_MINDISTEX' then begin
Result:=True ;
try
// X,Y,Z, Radius
FuncResult:=db.GetMinDistObjEx ( Params[0 ],Params[1 ],Params[2 ],Params[3 ]) ;
except
{$IFDEF DBDebug}
raise ;
{$ENDIF}
end ;
end ;
end ;
{ TL2World }
procedure TL2World.Add ( AObjID, AX, AY, AZ: integer ) ;
var
obj: TL2Obj;
begin
obj := TL2Obj.Create ;
FLIst.Add ( obj) ;
obj.ID :=AObjID;
obj.X :=AX;
obj.Y :=AY;
obj.Z :=AZ;
end ;
procedure TL2World.Clear ;
var
i: integer ;
begin
for i:= FLIst.Count -1 downto 0 do
try
TL2Obj( FList[i]) .Free ;
FList.Delete ( i) ;
except
{$IFDEF DBDebug}
raise ;
{$ENDIF}
end ;
end ;
constructor TL2World.Create ;
begin
FList:=TList .Create ;
end ;
procedure TL2World.Delete ( AObjID: integer ) ;
var
i: integer ;
begin
for i:= FLIst.Count -1 downto 0 do
if TL2Obj( FList[i]) .ID = AObjID then
try
TL2Obj( FList[i]) .Free ;
FList.Delete ( i) ;
except
{$IFDEF DBDebug}
raise ;
{$ENDIF}
end ;
end ;
destructor TL2World.Destroy ;
begin
FList.free ;
inherited ;
end ;
function TL2World.Dist ( FromObjID, ToObjID: integer ) : integer ;
begin
result := -1 ;
if assigned ( Get( FromObjID) ) and assigned ( Get( ToObjID) ) then
try
result := round ( sqrt ( Get( FromObjID) .X -Get( ToObjID) .X ) +sqrt ( Get( FromObjID) .Y -Get( ToObjID) .Y ) ) ;
except
{$IFDEF DBDebug}
raise ;
{$ENDIF}
end ;
end ;
function TL2World.DistEx ( FromObjID, AX, AY, AZ: integer ) : integer ;
begin
result := -1 ;
if assigned ( Get( FromObjID) ) then
try
result := round ( sqrt ( Get( FromObjID) .X -AX) +sqrt ( Get( FromObjID) .Y -AY) ) ;
except
{$IFDEF DBDebug}
raise ;
{$ENDIF}
end ;
end ;
function TL2World.Get ( AObjID: integer ) : TL2Obj;
var
i: integer ;
begin
result := nil ;
for i:= FList.Count -1 downto 0 do
if TL2Obj( FList[i]) .ID =AObjID then
begin
result := TL2Obj( FList[i]) ;
exit ;
end ;
end ;
function TL2World.GetCount : integer ;
begin
result := FList.Count ;
end ;
function TL2World.GetOrCreate ( AObjID: integer ) : TL2Obj;
var
i: integer ;
begin
for i:= FList.Count -1 downto 0 do
if TL2Obj( FList[i]) .ID =AObjID then
begin
result := TL2Obj( FList[i]) ;
exit ;
end ;
result := TL2Obj.Create ;
result.ID :=AObjID;
end ;
function TL2World.GetMinDistObj ( AX, AY, AZ: integer ) : integer ;
var
i,dst: integer ;
begin
result:=-1 ;
if count<=0 then
exit ;
dst:=DistEx( 0 ,AX,AY,AZ) ;
result:=TL2Obj( FList[0 ]) .ID ;
for i:=FList.Count -1 downto 0 do
begin
if DistEx( i,AX,AY,AZ) <=dst then
begin
result:=TL2Obj( FList[i]) .ID ;
dst:=DistEx( 0 ,AX,AY,AZ) ;
end ;
end ;
end ;
procedure TL2World.Move ( AObjID, AX, AY, AZ: integer ) ;
var
obj: TL2Obj;
begin
obj := GetOrCreate( AObjID) ;
obj.X :=AX;
obj.Y :=AY;
obj.Z :=AZ;
end ;
function TL2World.GetMinDistObjEx ( AX, AY, AZ, Radius: integer ) : integer ;
var
id: integer ;
begin
result := -1 ;
id:=GetMinDistObj( AX,AY,AZ) ;
if id=-1 then
exit ;
if DistEx( id,AX,AY,AZ) >Radius then
result := -1 ;
end ;
{ TL2Obj }
procedure TL2Obj.SetID ( const Value: integer ) ;
begin
FID := Value;
end ;
procedure TL2Obj.SetX ( const Value: integer ) ;
begin
FX := Value;
end ;
procedure TL2Obj.SetY ( const Value: integer ) ;
begin
FY := Value;
end ;
procedure TL2Obj.SetZ ( const Value: integer ) ;
begin
FZ := Value;
end ;
exports
GetPluginInfo,
SetStruct,
OnCallMethod,
onLoad,
onFree;
begin
end .
зы: еще не тестил
но думаю будет работать
зыы: компилировал под D7
За это сообщение alexsl нажился спасибкой от:
Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
HTML код Выкл.
Часовой пояс GMT +4, время: 04:32 .
vBulletin style designed by
MSC Team .
Powered by vBulletin® Version 3.6.11
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd. Перевод:
zCarot
Вы хотите чувствовать себя в безопасности? чоп Белган обеспечит её!