是否有一个过程在单个过程中在运行时初始化可变数量的对象?

时间:2013-12-18 13:58:38

标签: freepascal delphi

我通常在程序开始时初始化一些变量,比如TStringList类型,然后将它们释放出来。单独初始化它会感觉很尴尬,比如

listOne := TStringList.Create;
listTwo := TStringList.Create;
listTree := TString.Create;
{ etc, etc}

我更喜欢一个类似的程序,另一个程序可以让他们自由地结束:

CreateStrings(listOne, listTwo, listThree);
CreateStrings([listOne, listTwo, listTree]); //using an array

对于可变数量的对象,是否有可以执行此类操作的过程?

如果无法对任意对象类型进行处理,至少对于具有相同创建签名的类似类型或类型?

2 个答案:

答案 0 :(得分:1)

我能想出的最好的是:

PROCEDURE CreateObjects(ClassType : TClass ; VAR O1); OVERLOAD;
  BEGIN
    TObject(O1):=NIL;
    TObject(O1):=ClassType.Create
  END;

PROCEDURE CreateObjects(ClassType : TClass ; VAR O1,O2); OVERLOAD;
  BEGIN
    TObject(O1):=NIL; TObject(O2):=NIL;
    TObject(O1):=ClassType.Create; TObject(O2):=ClassType.Create
  END;

PROCEDURE CreateObjects(ClassType : TClass ; VAR O1,O2,O3); OVERLOAD;
  BEGIN
    TObject(O1):=NIL; TObject(O2):=NIL; TObject(O3):=NIL;
    TObject(O1):=ClassType.Create; TObject(O2):=ClassType.Create; TObject(O3):=ClassType.Create
  END;

PROCEDURE FreeObjects(CONST Objects : ARRAY OF TObject);
  VAR
    O   : TObject;
    E   : Exception;
    ADR : POINTER;

  BEGIN
    E:=NIL;
    FOR O IN Objects DO TRY
      O.Free
    EXCEPT
      ON X:Exception DO BEGIN
        E:=X; ADR:=ExceptAddr
      END
    END;
    IF Assigned(E) THEN RAISE E AT ADR
  END;

PROCEDURE TMainForm.FormCreate(Sender : TObject);
  VAR
    SL1,SL2 : TStrings;

  BEGIN
    CreateObjects(TStringList,SL1,SL2);
    FreeObjects([SL1,SL2])
  END;

您需要为要同时创建的每个对象计数执行重载过程。同一个CreateObjects调用中的所有对象将被创建为相同的类型(您将作为第一个参数提供),并且只能使用该类型的无参数构造函数创建。

构造之前NIL赋值的原因是为了确保传入的变量始终具有有效值(NIL或指向所请求类型的类)。这也意味着与普通代码相反:

O:=TObject.Create;
TRY
  // Blah, Blah
FINALLY
  O.Free
END;

你应该使用

TRY
  CreateObjects(TObject,O1,O2);
  // Blah, Blah
FINALLY
  FreeObjects([O1,O2])
END;

即。在TRY / FINALLY块中移动对象的创建。

如果您是FreeAndNIL的支持者,那么您可以这样做:

PROCEDURE FreeAndNilObjects(VAR O1,O2); OVERLOAD;
  BEGIN
    TRY
      FreeAndNIL(O1)
    FINALLY
      FreeAndNIL(O2)
    END
  END;

PROCEDURE FreeAndNilObjects(VAR O1,O2,O3); OVERLOAD;
  BEGIN
    TRY
      FreeAndNIL(O1)
    FINALLY
      TRY
        FreeAndNIL(O2)
      FINALLY
        FreeAndNIL(O3)
      END
    END
  END;

这个有点奇怪的构造确保在所有传入的对象上调用FreeAndNIL,但也意味着如果发生任何异常,它将是您将收到的LAST异常,并且之前的任何异常都将是丢失。但是,它确实确保所有对象都被(尝试)释放。

编辑:更新了FreeObjects以正确处理任何对象的.Free调用中可能发生的任何异常。像FreeAndNilObjects程序一样,除了最后一个异常之外,它会吃掉任何异常,并且在确保每个传入对象至少尝试调用.Free之后重新引发它。

答案 1 :(得分:0)

procedure CreateObjects(Vars: array of Pointer; ClassType: TClass);
var
  I: Integer;
begin
  for I := Low(Vars) to High(Vars) do
    TObject(Vars[I]^) := ClassType.Create;
end;

procedure FreeObjects(Vars: array of TObject);
var
  I: Integer;
begin
  for I := Low(Vars) to High(Vars) do
    Vars[I].Free;
end;

procedure TForm2.Button1Click(Sender: TObject);
const
  TestString = 'A,B,C,"4th line","line 5","last line"';
var
  StringList1: TStringList;
  StringList2: TStringList;
  StringList3: TStringList;
begin
  CreateObjects([@StringList1, @StringList2, @StringList3], TStringList);
  try
    StringList1.CommaText := TestString;
    StringList2.CommaText := TestString;
    StringList3.CommaText := TestString;
    Memo1.Lines.Assign(StringList1);
    ListBox1.Items.Assign(StringList2);
    RichEdit1.Lines.Assign(StringList3);
  finally
    FreeObjects([StringList1, StringList2, StringList3]);
  end;
end;