Jak uprościć kilka takich samych procedur w jedną?

Witam, mam 10 podobnych procedur które różnią się tylko jedną zmienną która wskazuje na inną klasę. Aż się prosi aby to jakoś połączyć w jedną procedurę ale nie wiem jak do zmiennej przypisać różne klasy.

Oto 2 przykładowe procedury

procedure GetVatToComboBox(ComboBox: TComboBox);
var
  I: Integer;
  Save: Integer;
  List: TListTax;
begin
  Save := ComboBox.ItemIndex;
  List := TListTax.Create;
  try
    List.Read;
    for I := 0 to List.Count - 1 do
      if ComboBox.Items.Count > I then
        ComboBox.Items[I] := List[I].ValueName
      else
        ComboBox.Items.Add(List[I].ValueName);
    // Jeżeli drugi raz ładuje i okazuje się że w combo jest więcej pozycji to trzeba je usunąć
    if List.Count < ComboBox.Items.Count then
      for I := List.Count to ComboBox.Items.Count - 1 do
        ComboBox.Items.Delete(List.Count);
  finally
    List.Free;
  end;
  if Save = -1 then
    Save := 0;
  if ComboBox.Items.Count > Save then
    ComboBox.ItemIndex := Save;
end;

procedure GetUnitToComboBox(ComboBox: TComboBox);
var
  I: Integer;
  Save: Integer;
  List: TListUnit;
begin
  Save := ComboBox.ItemIndex;
  List := TListUnit.Create;
  try
    List.Read;
    for I := 0 to List.Count - 1 do
      if ComboBox.Items.Count > I then
        ComboBox.Items[I] := List[I].ValueName
      else
        ComboBox.Items.Add(List[I].ValueName);
    // Jeżeli drugi raz ładuje i okazuje się że w combo jest więcej pozycji to trzeba je usunąć
    if List.Count < ComboBox.Items.Count then
      for I := List.Count to ComboBox.Items.Count - 1 do
        ComboBox.Items.Delete(List.Count);
  finally
    List.Free;
  end;
  if Save = -1 then
    Save := 0;
  if ComboBox.Items.Count > Save then
    ComboBox.ItemIndex := Save;
end;

//a można by tak tylko jak :)

type TClassType = (Vat,Unit);
procedure GetToComboBox(ComboBox: TComboBox; AType: TClassType);

Czy te klasy TListTax i TListUnit mają wspólnego rodzica? Jeśli tak, to można to rozwiązać za pomocą konstrukcji class of i przekazania w parametrze Twojej metody typu zamiast referencji. Pod warunkiem, że ta metoda Read znajduje się w klasie bazowej.

Krótki przykład do zademonstrowania tej funkcjonalności. Mamy klasę bazową:

type
  TListBase = class(TObject)
  public
    procedure Hello();
  end;

  procedure TListBase.Hello();
  begin
    WriteLn(Self.ClassName);
  end;

Teraz deklarujemy klasy z niej dziedziczące:

type
  TListTax = class(TListBase);
  TListUnit = class(TListBase);

Obie mają tego samego rodzica, więc dziedziczą taką samą funkcjonalność, czyli w tym przypadku metodę Hello. Teraz magia – deklarujemy typ danych, którego zmienna zamiast referencji będzie przechowywała klasę – bazową lub jakąkolwiek z niej dziedziczącą:

type
  TListClass = class of TListBase;

Ten typ można wykorzystać do deklaracji argumentu metody – będzie on dostarczał klasę, której instancja będzie tworzona, coś tam będzie wykonywane (u nas pokazanie nazwy klasy za pomocą metody Hello) i na koniec zwalnianie referencji:

procedure ShowClassName(AListClass: TListClass);
var
  List: TListBase;
begin
  List := AListClass.Create();
  List.Hello();
  List.Free();
end;

Ważne jest tutaj to, aby lokalna zmienna została zadeklarowana jako klasa bazowa – inaczej poleci błąd kompilacji. No i to wszystko – teraz możemy wywoływać naszą metodę ShowClassName, której w parametrze podać wystarczy klasę:

begin
  ShowClassName(TListTax);
  ShowClassName(TListUnit);
  ShowClassName(TListBase);
end.

Po uruchomieniu, w konsoli zostanie wyświetlony poniższy tekst:

TListTax
TListUnit
TListBase

Cały kod tego konsolowego testera wszucam na pastebin. Kod testowany w Lazarusie jakby co.

A tak nawiasem mówiąc, te listy to jakaś dziwna sprawa. Tworzysz instancję jednej z powyższych klas, następnie wołasz na niej metodę Read, która nie wiadomo co robi – ani nie podajesz jej nic w parametrach, ani nawet nazwa nie sugeruje co jest ”odczytywane”. Jakiś potworek z tego wyszedł. ;)

Poza tym BeginUpdate i EndUpdate się kłaniają.

Tak mają poniżej fragment tego typu:

  TRecordList<T: class> = class(TObjectList<T>)
  private
    fDataIndex: integer;
  public
    procedure Read; virtual; abstract;
    property DataIndex: integer read fDataIndex;
    function Data(SQLId: integer): T; inline;
  end;

Niestety kompilator nie chce mi puścić czegoś takiego:

type
TClassRecordList = class(TRecordList<TClassRecord>);
TClassOf = class of TClassRecordList;

Co to znaczy "nie chce puścić" jaki komunikat błędu?

Dziwnie dużo tych klas. Składnia generyków w Delphi jest inna niż we Free Pascalu (lepsza), ale chodziło o to, aby zadeklarować typ, który będzie class of TKlasaBazowa, czyli coś w tym stylu:

TClassOf = class of TRecordList;

Ale że Delphi nie używam to nie wiem co za błąd kompilator wyrzuca. Zresztą nie wiadomo czym u Ciebie jest ten typ TClassRecord – nie podałaś jego deklaracji.