Fórum Invalid Pointer Operation ao tentar liberar um objeto #423677

procedure TForm1.Button1Click(Sender: TObject);
var
lista:TStrings;
i:integer;
begin
for i:=0 to 10 do
  begin
  lista:=TStringList.Create;
  Lista.free;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
lista:TStrings;
i:integer;
begin
for i:=0 to 10 do
  begin
  lista:=TStringList.Create;
  FreeAndNil(lista);
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
lista:TStrings;
i:integer;
begin
for i:=0 to 10 do
  begin
  lista:=TStringList.Create;
end;
end;

var
lista:TStrings;
i:integer;
begin

if lista = nil then
 showmessage('Mas Eu não estou utilizando o FreeanNil ???'+sLineBreak+
             'Porque este Ponteiro Não foi Limpo ?????');
lista:=TStringList.Create;
FreeAndNil(lista);
end;

unit RCheckListBox;

interface

uses
  System.SysUtils, System.Classes, Vcl.Controls, Vcl.StdCtrls, Vcl.CheckLst, Generics.Collections, RTTI;

type
  TRCheckListBox = class(TCheckListBox)
  private
    FDescriptionName: String;
    FMandatoryField: boolean;
    FDataSource: TList;
    FPersistentField: boolean;
    FFieldName: String;
    FIDName: String;
    FListValue: TStrings;
    function GetValue: String;
    procedure SetDataSource(const Value: TList);
    procedure SetDescriptionName(const Value: String);
    procedure SetFieldName(const Value: String);
    procedure SetIDName(const Value: String);
    procedure SetMandatoryField(const Value: boolean);
    procedure SetPersistentField(const Value: boolean);
    procedure SetValue(const Value: String);
    procedure SetListValue(const Value: TStrings);
    { Private declarations }
  protected
    { Protected declarations }
  published
    property FieldName:String read FFieldName write SetFieldName;
    property MandatoryField: boolean read FMandatoryField write SetMandatoryField;
    property PersistentField: boolean read FPersistentField write SetPersistentField;
    property IDFieldName:String read FIDName write SetIDName;
    property DescriptionFieldName:String read FDescriptionName write SetDescriptionName;
    property ListValue: TStrings read FListValue write SetListValue;
  public

    property DataSource:TList read FDataSource write SetDataSource;
    property Value:String read GetValue write SetValue;
    procedure FindIndexByIDFieldName(idFieldNameValue: string);
    procedure DataBind;
    function GetObject<T: class>:T;
    function GetCheckedObjects: TList;

    constructor Create(AOwner: TComponent);override;
    destructor destroy;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('SIATD', [TRCheckListBox]);
end;

{ TRCheckListBox }

constructor TRCheckListBox.Create(AOwner: TComponent);
begin
  inherited;
  self.FListValue := TStringList.Create;
end;

procedure TRCheckListBox.DataBind;
var
  i:integer;
  context: TRttiContext;
  prop: TRttiProperty;
begin
  self.Clear;
  if (self.FDataSource <> nil)  or (self.FListValue <> nil) then
  begin
      if self.FDataSource <> nil then
      begin
        for i := 0 to self.FDataSource.Count-1 do
        begin
           prop := context.GetType(TObject(self.FDataSource[i]).ClassType).GetProperty(self.FDescriptionName);
           self.Items.Add(prop.GetValue(TObject(self.FDataSource[i])).ToString);
        end;
      end
      else
      if self.FListValue <> nil then
      begin
        for I := 0 to self.FListValue.Count-1 do
        begin
          self.Items.Add(self.FListValue.Names[I])
        end;
      end;

      if self.Items.Count > 0 then self.ItemIndex := 0;
  end;

end;

destructor TRCheckListBox.destroy;
var
  i:integer;
begin
  for I := 0 to FDataSource.Count-1 do   ////...>>>> aqui que dá o erro
     FreeAndNil(TObject(FDataSource[i]))

  FreeAndNil(FDataSource);

  inherited Destroy;
end;

procedure TRCheckListBox.FindIndexByIDFieldName(idFieldNameValue: string);
var
  I:integer;
  context: TRttiContext;
  prop: TRttiProperty;
begin
   if Assigned(FDataSource) then
   begin
       for i := 0 to FDataSource.Count-1 do
       begin
          prop := context.GetType(TObject(FDataSource[i]).ClassType).GetProperty(self.IDFieldName);
          if  Pos(prop.GetValue(TObject(FDataSource[i])).ToString, idFieldNameValue ) > 0 then
              Self.Checked[I] := true
          else
             Self.Checked[I] := false;
       end;
   end
   else
   begin
       for I := 0 to self.Items.Count-1 do
       begin
           if FListValue.Count > 0 then
           begin
               if  Pos(self.FListValue.ValueFromIndex[I], idFieldNameValue ) > 0 then
                    Self.Checked[I] := true
               else
                    Self.Checked[I] := false;

           end
           else
           begin
               if  Pos(self.Items[I], idFieldNameValue ) > 0 then
                    Self.Checked[I] := true
               else
                    Self.Checked[I] := false;

           end;
       end;
   end;
end;

function TRCheckListBox.GetCheckedObjects: TList;
var
 i:integer;
 list:Tlist;
begin
  if FDataSource <> nil then
  begin
      list := TList.Create;
      for i := 0 to FDataSource.Count-1 do
      begin
        if self.Checked[I] then
            list.Add(TObject(DataSource[i]));
      end;
      result := list;
  end else result := nil;
end;

function TRCheckListBox.GetObject<T>: T;
begin
    if (FDataSource <> nil) and (self.Checked[self.GetItemIndex]) then
        Result :=  T(TObject(FDataSource[self.GetItemIndex]));
end;

function TRCheckListBox.GetValue: String;
var
  ind:integer;
  context: TRttiContext;
  prop: TRttiProperty;
  val: string;
  I: Integer;
begin
    val := EmptyStr;
    if Self.FDataSource = nil then
    begin
       for I := 0 to self.Items.Count-1 do
       begin
           if self.Checked[I] then
           begin
               if self.FListValue.Count = 0 then
                 val := val + self.Items[i]+','
               else
                 val := val + self.FListValue.ValueFromIndex[I]+',';
           end;
       end;
       System.Delete(val,System.Length(val),1);
       result := val;
    end
    else
    begin
       for I := 0 to self.FDataSource.Count-1 do
       begin
           if self.Checked[I] then
           begin
               prop := context.GetType(TObject(Self.FDataSource[I]).ClassType).GetProperty(self.IDFieldName);
               val := val + prop.GetValue(TObject(Self.FDataSource[I])).ToString+',';
           end;
       end;
       System.Delete(val,System.Length(val),1);
       result := val;
    end;
end;

procedure TRCheckListBox.SetDataSource(const Value: TList);
begin
  FDataSource := Value;
end;

procedure TRCheckListBox.SetDescriptionName(const Value: String);
begin
  if FDescriptionName <> Value then
    FDescriptionName := Value;
end;

procedure TRCheckListBox.SetFieldName(const Value: String);
begin
  if FFieldName <> Value then
    FFieldName := Value;
end;

procedure TRCheckListBox.SetIDName(const Value: String);
begin
   if FIDName <> Value then
    FIDName := Value;
end;

procedure TRCheckListBox.SetListValue(const Value: TStrings);
begin
  if FListValue <> Value then
    FListValue.Assign(Value);
end;

procedure TRCheckListBox.SetMandatoryField(const Value: boolean);
begin
  if FMandatoryField <> Value then
    FMandatoryField := Value;
end;

procedure TRCheckListBox.SetPersistentField(const Value: boolean);
begin
  if FPersistentField <> Value then
    FPersistentField := Value;
end;

procedure TRCheckListBox.SetValue(const Value: String);
begin
    self.FindIndexByIDFieldName(Value);
end;

end.