LorenJo : unité LRJ_ClassesPlus, ajoute des fonctionnalités aux TList et TStringList de DELPHI

Code source

Présentation

Unités exemple gratuites

Unités commercialisées

Conditions d'utilisation

Comment acheter

Vendez vos codes

Unités exemple

LRJ_ClassesPlus

LRJ_GridsPlus

LRJ_MenusPlus

LRJ_WindowsPlus

Code source : unité exemple LRJ_ClassesPlus

Description : contient des objets dérivés de l'unité classes avec des fonctionnalités complémentaires. TList et TStringList sont complétées par une fonction dénommée Tot_Idx0 qui équivaut à count-1 et est pratique pour faire tourner des boucles qui varient de 0 à Tot_Idx0 ou de Tot_Idx0 à 0. TList et TstringList sont complétées par des procédures permettant de détruire les objets ou pointeurs stockés en même temps qu'est réalisé le nettoyage de la liste. Enfin, LRJ_TBoucleList est un objet qui intègre les boucles 0 to Tot_Idx0 et Tot_Idx0 downto 0 permettant une utilisation plus compacte des listes (voir exemple plus bas).

Utilise les unités : Windows et Classes.

Télécharger LRJ_ClassesPlus version 1.1

//*********************************************************
//            LRJ_ClassesPlus                             *
//            Version : 1.1                               *
//            Date dernière modif : 02.05.2009            *
//            Auteur : Laurent Hède                       *
//            Société LorenJo                             *
//            contact@lorenjo.com                         *
//            copyright LorenJo                           *
//            Réalisé en DELPHI 6                         *
//*********************************************************
unit LRJ_ClassesPlus;

interface
                              uses
                              Windows,
                              classes;

type

  //------------OBJET----------------------------
LRJ_TList = class(TList)
  public//-----------PUBLIC--------------------------
  function Tot_Idx0: integer; // = count-1
  procedure ClearForObjetList;
  procedure ClearForPointerList;
  procedure DeleteForPointeur(const AIndex: integer);
  procedure DeleteForObject(const AIndex: integer);
  end;//-----------FIN--------------------------

  //------------OBJET----------------------------
LRJ_TThreadList = class
  private //-----------PRIVATE--------------------------
  FList: LRJ_TList;
  FLock: TRTLCriticalSection;
  public  //-----------PUBLIC--------------------------
  constructor Create;
  destructor Destroy; override;
  function  LockList: LRJ_TList;
  procedure UnlockList;
  function  UnprotectList: LRJ_TList;
  end; //-----------FIN--------------------------

  //------------OBJET----------------------------
LRJ_TStringList = class(TStringList)
  public//-----------PUBLIC--------------------------
  function Tot_Idx0: integer; // = count-1
  procedure DeleteWithObject(const AIndex: integer);
  procedure ClearWidthObject;
  end;//-----------FIN--------------------------

  //------------OBJET----------------------------
LRJ_TBoucleList = class(LRJ_TList)
  protected //-----------PROTEGE--------------------------
  procedure OnBoucleItem(const AItem: pointer; const AIndex : integer; const AIDBoucle: integer; var IfBreak: boolean);  virtual;
  public//-----------PUBLIC--------------------------
  procedure BoucleToProc(const AIDBoucle: integer);
  procedure BoucleDownToProc(const AIDBoucle: integer);
  end;//-----------FIN--------------------------


implementation
{--------------------------------------------------------------}
{--------------------------------------------------------------}
{--------------------  LRJ_TBoucleList  ------------------------------------------}
{--------------------------------------------------------------}
{--------------------------------------------------------------}
procedure LRJ_TBoucleList.BoucleToProc(const AIDBoucle: integer);
var
  i: integer;
  zIfBreak: boolean;
begin
zIfBreak := false;
for i:=0 to Tot_Idx0 do
  begin
  OnBoucleItem(items[i], i,  AIDBoucle, zIfBreak);
  if zIfBreak then break;
  end;
end;
{--------------------------------------------------------------}
procedure LRJ_TBoucleList.BoucleDownToProc(const AIDBoucle: integer);
var
  i: integer;
  zIfBreak: boolean;
begin
zIfBreak := false;
for i:=Tot_Idx0 downto 0 do
  begin
  OnBoucleItem(items[i], i, AIDBoucle, zIfBreak);
  if zIfBreak then break;
  end;
end;
{--------------------------------------------------------------}
procedure LRJ_TBoucleList.OnBoucleItem(const AItem: pointer; const AIndex : integer; const AIDBoucle: integer; var IfBreak: boolean);
begin   end;
{--------------------------------------------------------------}
{--------------------------------------------------------------}
{--------------------  LRJ_TStringList  ------------------------------------------}
{--------------------------------------------------------------}
{--------------------------------------------------------------}
function LRJ_TStringList.Tot_Idx0: integer;
begin
result := count - 1;
end;
{--------------------------------------------------------------}
procedure LRJ_TStringList.DeleteWithObject(const AIndex: integer);
var
  zItem: TObject;
begin
if (AIndex >= 0) and (AIndex < count) then
  begin
  zItem := Objects[AIndex];
  delete(AIndex);
  if assigned(zItem) then zItem.free;
  end;
end;
{--------------------------------------------------------------}
procedure LRJ_TStringList.ClearWidthObject;
var
  i: integer;
  zItem: TObject;
begin
for i:=Tot_Idx0 downto 0 do
  begin
  zItem := Objects[i];
  delete(i);
  if assigned(zItem) then zItem.free;
  end;
end;
{--------------------------------------------------------------}
{--------------------------------------------------------------}
{--------------------  LRJ_TThreadList  ------------------------------------------}
{--------------------------------------------------------------}
{--------------------------------------------------------------}
constructor LRJ_TThreadList.Create;
begin
inherited Create;
InitializeCriticalSection(FLock);
FList := LRJ_TList.Create;
end;
{--------------------------------------------------------------}
destructor LRJ_TThreadList.Destroy;
begin
LockList;
try
FList.Free;
FList := nil;
inherited Destroy;
finally
UnlockList;
DeleteCriticalSection(FLock);
end;
end;
{--------------------------------------------------------------}
function  LRJ_TThreadList.UnprotectList: LRJ_TList;
begin
Result := FList;
end;
{--------------------------------------------------------------}
function  LRJ_TThreadList.LockList: LRJ_TList;
begin
EnterCriticalSection(FLock);
Result := FList;
end;
{--------------------------------------------------------------}
procedure LRJ_TThreadList.UnlockList;
begin
LeaveCriticalSection(FLock);
end;
{--------------------------------------------------------------}
{--------------------------------------------------------------}
{--------------------  LRJ_TList  ------------------------------------------}
{--------------------------------------------------------------}
{--------------------------------------------------------------}
procedure LRJ_TList.DeleteForPointeur(const AIndex: integer);
var
  zItem: pointer;
begin
if (AIndex >= 0) and (AIndex > count) then
  begin
  zItem := Items[AIndex];
  delete(AIndex);
  if assigned(zItem) then Dispose(zItem);
  end;
end;
{--------------------------------------------------------------}
procedure LRJ_TList.DeleteForObject(const AIndex: integer);
var
  zItem: TObject;
begin
if (AIndex >= 0) and (AIndex < count) then
  begin
  zItem := Items[AIndex];
  delete(AIndex);
  if assigned(zItem) then zItem.free;
  end;
end;
{--------------------------------------------------------------}
procedure LRJ_TList.ClearForPointerList;
var
  i: integer;
  zItem: pointer;
begin
for i:=Tot_Idx0 downto 0 do
  begin
  zItem := Items[i];
  delete(i);
  if assigned(zItem) then Dispose(zItem);
  end;
end;
{--------------------------------------------------------------}
procedure LRJ_TList.ClearForObjetList;
var
  i: integer;
  zItem: TObject;
begin
for i:=Tot_Idx0 downto 0 do
  begin
  zItem := Items[i];
  delete(i);
  if assigned(zItem) then zItem.free;
  end;
end;
{--------------------------------------------------------------}
function LRJ_TList.Tot_Idx0: integer;
begin
result := count - 1;
end;
{--------------------------------------------------------------}
{--------------------------------------------------------------}
{--------------------  fin  ------------------------------------------}
{--------------------------------------------------------------}
{--------------------------------------------------------------}
end.