paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-31 08:32:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl+lazutils: moved TMethodList to lazutils

Browse Source 
git-svn-id: trunk@33551 -
This commit is contained in:
mattias 2011-11-16 05:51:31 +00:00
parent 3d59e27e15
commit 8ee87295fc
5 changed files with 176 additions and 156 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -1767,6 +1767,7 @@ components/lazutils/laz_xmlwrite.pas svneol=native#text/pascal
components/lazutils/lazdbglog.pas svneol=native#text/plain
components/lazutils/lazfilecache.pas svneol=native#text/plain
components/lazutils/lazfileutils.pas svneol=native#text/plain
components/lazutils/lazmethodlist.pas svneol=native#text/plain
components/lazutils/lazutf16.pas svneol=native#text/pascal
components/lazutils/lazutf8.pas svneol=native#text/plain
components/lazutils/lazutf8classes.pas svneol=native#text/pascal

167
components/lazutils/lazmethodlist.pas Normal file
View File

@ -0,0 +1,167 @@
unit LazMethodList;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
{ TMethodList - array of TMethod }
TMethodList = class
private
FItems: ^TMethod;
FCount: integer;
function GetItems(Index: integer): TMethod;
procedure SetItems(Index: integer; const AValue: TMethod);
public
destructor Destroy; override;
function Count: integer;
function NextDownIndex(var Index: integer): boolean;
function IndexOf(const AMethod: TMethod): integer;
procedure Delete(Index: integer);
procedure Remove(const AMethod: TMethod);
procedure Add(const AMethod: TMethod);
procedure Add(const AMethod: TMethod; AsLast: boolean);
procedure Insert(Index: integer; const AMethod: TMethod);
procedure Move(OldIndex, NewIndex: integer);
procedure RemoveAllMethodsOfObject(const AnObject: TObject);
procedure CallNotifyEvents(Sender: TObject);
public
property Items[Index: integer]: TMethod read GetItems write SetItems; default;
end;
implementation
{ TMethodList }
function TMethodList.GetItems(Index: integer): TMethod;
begin
Result:=FItems[Index];
end;
procedure TMethodList.SetItems(Index: integer; const AValue: TMethod);
begin
FItems[Index]:=AValue;
end;
destructor TMethodList.Destroy;
begin
ReAllocMem(FItems,0);
inherited Destroy;
end;
function TMethodList.Count: integer;
begin
if Self<>nil then
Result:=FCount
else
Result:=0;
end;
function TMethodList.NextDownIndex(var Index: integer): boolean;
begin
if Self<>nil then begin
dec(Index);
if (Index>=FCount) then
Index:=FCount-1;
end else
Index:=-1;
Result:=(Index>=0);
end;
function TMethodList.IndexOf(const AMethod: TMethod): integer;
begin
if Self<>nil then begin
Result:=FCount-1;
while Result>=0 do begin
if (FItems[Result].Code=AMethod.Code)
and (FItems[Result].Data=AMethod.Data) then exit;
dec(Result);
end;
end else
Result:=-1;
end;
procedure TMethodList.Delete(Index: integer);
begin
dec(FCount);
if FCount>Index then
System.Move(FItems[Index+1],FItems[Index],(FCount-Index)*SizeOf(TMethod));
ReAllocMem(FItems,FCount*SizeOf(TMethod));
end;
procedure TMethodList.Remove(const AMethod: TMethod);
var
i: integer;
begin
if Self<>nil then begin
i:=IndexOf(AMethod);
if i>=0 then Delete(i);
end;
end;
procedure TMethodList.Add(const AMethod: TMethod);
begin
inc(FCount);
ReAllocMem(FItems,FCount*SizeOf(TMethod));
FItems[FCount-1]:=AMethod;
end;
procedure TMethodList.Add(const AMethod: TMethod; AsLast: boolean);
begin
if AsLast then
Add(AMethod)
else
Insert(0,AMethod);
end;
procedure TMethodList.Insert(Index: integer; const AMethod: TMethod);
begin
inc(FCount);
ReAllocMem(FItems,FCount*SizeOf(TMethod));
if Index<FCount then
System.Move(FItems[Index],FItems[Index+1],(FCount-Index-1)*SizeOf(TMethod));
FItems[Index]:=AMethod;
end;
procedure TMethodList.Move(OldIndex, NewIndex: integer);
var
MovingMethod: TMethod;
begin
if OldIndex=NewIndex then exit;
MovingMethod:=FItems[OldIndex];
if OldIndex>NewIndex then
System.Move(FItems[NewIndex],FItems[NewIndex+1],
SizeOf(TMethod)*(OldIndex-NewIndex))
else
System.Move(FItems[NewIndex+1],FItems[NewIndex],
SizeOf(TMethod)*(NewIndex-OldIndex));
FItems[NewIndex]:=MovingMethod;
end;
procedure TMethodList.RemoveAllMethodsOfObject(const AnObject: TObject);
var
i: Integer;
begin
if Self=nil then exit;
i:=FCount-1;
while i>=0 do begin
if TObject(FItems[i].Data)=AnObject then Delete(i);
dec(i);
end;
end;
procedure TMethodList.CallNotifyEvents(Sender: TObject);
var
i: LongInt;
begin
i:=Count;
while NextDownIndex(i) do
TNotifyEvent(Items[i])(Sender);
end;
end.

6
components/lazutils/lazutils.lpk
View File

@ -19,7 +19,7 @@
<Description Value="Useful units for Lazarus packages."/>
<License Value="Modified LGPL-2"/>
<Version Major="1"/>
<Files Count="29">
<Files Count="30">
<Item1>
<Filename Value="laz2_dom.pas"/>
<UnitName Value="laz2_DOM"/>
@ -136,6 +136,10 @@
<Filename Value="lazutf8sysutils.pas"/>
<UnitName Value="lazutf8sysutils"/>
</Item29>
<Item30>
<Filename Value="lazmethodlist.pas"/>
<UnitName Value="lazmethodlist"/>
</Item30>
</Files>
<LazDoc Paths="docs"/>
<i18n>

2
components/lazutils/lazutils.pas
View File

@ -11,7 +11,7 @@ uses
Laz_XMLCfg, Laz_XMLRead, Laz_XMLStreaming, Laz_XMLWrite, LazFileUtils,
LazFileCache, LUResStrings, LazUTF8, LazDbgLog, paswstring, FileUtil,
lazutf8classes, Masks, LazUtilsStrConsts, LConvEncoding, lazutf16,
lazutf8sysutils, LazarusPackageIntf;
lazutf8sysutils, LazMethodList, LazarusPackageIntf;
implementation

156
lcl/lclproc.pas
View File

@ -33,38 +33,14 @@ interface
uses
{$IFDEF Darwin}MacOSAll, {$ENDIF}
Classes, SysUtils, Math, TypInfo, Types, FPCAdds, AvgLvlTree, FileUtil,
LCLStrConsts, LCLType, WSReferences, LazUTF8
LCLStrConsts, LCLType, WSReferences, LazMethodList, LazUTF8
{$IFDEF EnablePasWString}, paswstring{$ENDIF}
{$IFNDEF DisableCWString}{$ifdef unix}{$ifndef DisableIconv}, cwstring{$endif}{$endif}{$ENDIF}
;
type
{ TMethodList - array of TMethod }
TMethodList = LazMethodList.TMethodList;
TMethodList = class
private
FItems: ^TMethod;
FCount: integer;
function GetItems(Index: integer): TMethod;
procedure SetItems(Index: integer; const AValue: TMethod);
public
destructor Destroy; override;
function Count: integer;
function NextDownIndex(var Index: integer): boolean;
function IndexOf(const AMethod: TMethod): integer;
procedure Delete(Index: integer);
procedure Remove(const AMethod: TMethod);
procedure Add(const AMethod: TMethod);
procedure Add(const AMethod: TMethod; AsLast: boolean);
procedure Insert(Index: integer; const AMethod: TMethod);
procedure Move(OldIndex, NewIndex: integer);
procedure RemoveAllMethodsOfObject(const AnObject: TObject);
procedure CallNotifyEvents(Sender: TObject);
public
property Items[Index: integer]: TMethod read GetItems write SetItems; default;
end;
type
TStackTracePointers = array of Pointer;
{ TDebugLCLItemInfo }
@ -814,134 +790,6 @@ begin
TProcedure(InterfaceFinalizationHandlers[i])();
end;
{ TMethodList }
function TMethodList.GetItems(Index: integer): TMethod;
begin
Result:=FItems[Index];
end;
procedure TMethodList.SetItems(Index: integer; const AValue: TMethod);
begin
FItems[Index]:=AValue;
end;
destructor TMethodList.Destroy;
begin
ReAllocMem(FItems,0);
inherited Destroy;
end;
function TMethodList.Count: integer;
begin
if Self<>nil then
Result:=FCount
else
Result:=0;
end;
function TMethodList.NextDownIndex(var Index: integer): boolean;
begin
if Self<>nil then begin
dec(Index);
if (Index>=FCount) then
Index:=FCount-1;
end else
Index:=-1;
Result:=(Index>=0);
end;
function TMethodList.IndexOf(const AMethod: TMethod): integer;
begin
if Self<>nil then begin
Result:=FCount-1;
while Result>=0 do begin
if (FItems[Result].Code=AMethod.Code)
and (FItems[Result].Data=AMethod.Data) then exit;
dec(Result);
end;
end else
Result:=-1;
end;
procedure TMethodList.Delete(Index: integer);
begin
dec(FCount);
if FCount>Index then
System.Move(FItems[Index+1],FItems[Index],(FCount-Index)*SizeOf(TMethod));
ReAllocMem(FItems,FCount*SizeOf(TMethod));
end;
procedure TMethodList.Remove(const AMethod: TMethod);
var
i: integer;
begin
if Self<>nil then begin
i:=IndexOf(AMethod);
if i>=0 then Delete(i);
end;
end;
procedure TMethodList.Add(const AMethod: TMethod);
begin
inc(FCount);
ReAllocMem(FItems,FCount*SizeOf(TMethod));
FItems[FCount-1]:=AMethod;
end;
procedure TMethodList.Add(const AMethod: TMethod; AsLast: boolean);
begin
if AsLast then
Add(AMethod)
else
Insert(0,AMethod);
end;
procedure TMethodList.Insert(Index: integer; const AMethod: TMethod);
begin
inc(FCount);
ReAllocMem(FItems,FCount*SizeOf(TMethod));
if Index<FCount then
System.Move(FItems[Index],FItems[Index+1],(FCount-Index-1)*SizeOf(TMethod));
FItems[Index]:=AMethod;
end;
procedure TMethodList.Move(OldIndex, NewIndex: integer);
var
MovingMethod: TMethod;
begin
if OldIndex=NewIndex then exit;
MovingMethod:=FItems[OldIndex];
if OldIndex>NewIndex then
System.Move(FItems[NewIndex],FItems[NewIndex+1],
SizeOf(TMethod)*(OldIndex-NewIndex))
else
System.Move(FItems[NewIndex+1],FItems[NewIndex],
SizeOf(TMethod)*(NewIndex-OldIndex));
FItems[NewIndex]:=MovingMethod;
end;
procedure TMethodList.RemoveAllMethodsOfObject(const AnObject: TObject);
var
i: Integer;
begin
if Self=nil then exit;
i:=FCount-1;
while i>=0 do begin
if TObject(FItems[i].Data)=AnObject then Delete(i);
dec(i);
end;
end;
procedure TMethodList.CallNotifyEvents(Sender: TObject);
var
i: LongInt;
begin
i:=Count;
while NextDownIndex(i) do
TNotifyEvent(Items[i])(Sender);
end;
{------------------------------------------------------------------------------
procedure RaiseGDBException(const Msg: string);