Jak we własnej klasie zaimplementować możliwość wywołania metod innych klas?

Nie wiem jak dokładnie opisać mój problem więc w razie niejasności proszę pytać.

Mam dwie klasy które w uproszczeniu wyglądają tak:

TKlasa1 = class
  public
    procedure JakasProcedura
end;

TKlasa2 = class
  public
    FKlasa : TKlasa1;

    procedure JakasProcedura
    procedure RobCos;
end;

procedure TKlasa2.RobCos;
begin
  FKlasa.JakasProcedura
end;

Co muszę zrobić by pod prywatne pole klasy drugiej móc przypisać jednocześnie klasę pierwszą lub drugą?

coś na zasadzie

var
  MojaKlasa : TKlasa2;
  Klasa1 : TKlasa1;
  Klasa2 : TKlasa2

begin
  Klasa1 := TKlasa1.Create;
  Klasa2 := TKlasa2.Create;
  MojaKlasa := TKlasa2.Create;
  MojaKlasa.FKlasa := Klasa1;
  MojaKlasa.RobCos;
  MojaKlasa.FKlasa := Klasa2;
  MojaKlasa.RobCos;
end.

Próbowałem robić klasę matkę z wirtualną metodą JakasProcedura po której dziedziczą obie i typ pola FKlasa ustawiałem na klasę matkę ale wywalało niezgodność typów.

Wiem, że pytanie banalne i nawet próbowałem w źródłach lazarusa znaleźć jak oni zaimplementowali mechanizm owner/parent ale nie mogłem znaleźć.
A w google znajdywałem tylko jak takiego mechanizmu użyć a nie jak zaimplementować.

TKlasa1 = class
  public
    procedure JakasProcedura;virtual;
end;
 
TKlasa2 = class(TKlasa1)
  public
    FKlasa : TKlasa1;
 
    procedure JakasProcedura;override;
    procedure RobCos;
end;
 
procedure TKlasa2.RobCos;
begin
  FKlasa.JakasProcedura
end;

var
  MojaKlasa : TKlasa2;
  Klasa1 : TKlasa1;
  Klasa2 : TKlasa2
 
begin
  Klasa1 := TKlasa1.Create;
  Klasa2 := TKlasa2.Create;
  MojaKlasa := TKlasa2.Create;
  MojaKlasa.FKlasa := Klasa1;
  MojaKlasa.RobCos;
  MojaKlasa.FKlasa := Klasa2;
  MojaKlasa.RobCos;
end.

jesli już to

TKlasa1 = class
  public
    procedure JakasProcedura;virtual;
end;
 
TKlasa2 = class(TKlasa1)
  public
    procedure JakasProcedura;override;
end;

TKlasa3 = class(TKlasa1)
  public
    FKlasa : TKlasa1;

    procedure JakasProcedura;override;
    procedure RobCos;
end;
 
var
  MojaKlasa : TKlasa3;
  Klasa2 : TKlasa2;
  Klasa3 : TKlasa3
 
begin
  Klasa2 := TKlasa2.Create;
  Klasa3 := TKlasa3.Create;
  MojaKlasa := TKlasa3.Create;
  MojaKlasa.FKlasa := Klasa2;
  MojaKlasa.RobCos;
  MojaKlasa.FKlasa := Klasa3;
  MojaKlasa.RobCos;
end.

I nie bangla. Próbowałem w Klasa1 zrobić z metody JakasProcedura metodę abstrakcyjną ale też nie działało.

edit:
poprawka literówki

ma być:

FKlasa : TKlasa1;

@babubabu - napisz może dokładniej co chcesz osiągnąć, bo w pierwszym przykładzie podałeś deklaracje dwóch klas, a następnie podałeś kolejny przykład z trzema deklaracjami klas;

Nie wiem co chcesz osiągnąć, ale jeżeli nazywasz składową klasy FKlasa to sugerujesz, że jest to pole klasy, więc pole powinno być prywatne; Dostęp do niego powinien być realizowany za pomocą albo odpowiedniej właściwości, albo za pomocą metody, która w parametrze mogła by przyjmować instancję klasy;

Możesz sobie zrobić właściwość, za pomocą której wpiszesz do prywatnego pola referencję do obiektu, np. tak:

public
  property Klasa: TKlasa read FKlasa write FKlasa;

Tyle że w ostatnim Twoim poście używasz typu TKlasa, którego nie zadeklarowałeś nigdzie; Domyślam się, że to po prostu przeoczenie.

Dobra.
Piszę sobie tekstowe UI na linuxa.
I zrobiłem sobie przy pomocy unitu Video (Lazarus) klasę obsługującą ekran.
Napisałem również klasę okienek (tytuł obramowanie i takie pierdoły) i obie klasy mają swój bufor. Chodzi mi o to, że jak wywołam metodę Draw klasy okna to ma ona wpisywać dane do buforu, z tym, że czyjej klasy to jest bufor (bufor okna nadrzednego, czy bufor ekranu) określam w konstruktorze. I właśnie takie cudo chce napisać a to co powyżej to moje próby.

unit ScreenClass;

{==============================================================================}

{$mode objfpc}{$H+}

interface

{==============================================================================}

uses
  Video;

{==============================================================================}

type
  TScreen = class
    private
      FVideoMode     : TVideoMode;
      FCursorX,
      FCursorY       : Word;
    protected
      procedure SetCursorX(AX : Word);
      procedure SetCursorY(AY : Word);
      function GetCursorX : Word;
      function GetCursorY : Word;
    public
      constructor Create(AWidth, AHeight : Word);
      destructor Destroy; override;
    public
      procedure Clear;
      procedure Update;
      procedure WriteXY(AX, AY : Word; const Text : String);
    public
      property CursorX : Word read GetCursorX write SetCursorX;
      property CursorY : Word read GetCursorY write SetCursorY;
  end;

{==============================================================================}

implementation

{==============================================================================}
{-- private -------------------------------------------------------------------}
{-- protected -----------------------------------------------------------------}

procedure TScreen.SetCursorX(AX : Word);
begin
  FCursorX := AX;
  CursorX := AX;
  SetCursorPos(FCursorX, FCursorY);
end;

{------------------------------------------------------------------------------}

procedure TScreen.SetCursorY(AY : Word);
begin
  FCursorY := AY;
  CursorY := AY;
  SetCursorPos(FCursorX, FCursorY);
end;

{------------------------------------------------------------------------------}

function TScreen.GetCursorX : Word;
begin
  result := FCursorX;
end;

{------------------------------------------------------------------------------}

function TScreen.GetCursorY : Word;
begin
  result := FCursorY;
end;

{-- public --------------------------------------------------------------------}

constructor TScreen.Create(AWidth, AHeight : Word);
begin
  inherited Create;
  InitVideo;

  FVideoMode.Col := AWidth;
  FVideoMode.Row := AHeight;
  FVideoMode.Color := True;
  SetVideoMode(FVideoMode);

  FCursorX := CursorX;
  FCursorY := CursorY;
end;

{------------------------------------------------------------------------------}

destructor TScreen.Destroy;
begin
  DoneVideo;
  inherited Destroy;
end;

{------------------------------------------------------------------------------}

procedure TScreen.Clear;
begin
  ClearScreen;
end;

{------------------------------------------------------------------------------}

procedure TScreen.Update;
begin
  UpdateScreen(false);
end;

{------------------------------------------------------------------------------}

procedure TScreen.WriteXY(AX, AY : Word; const Text : String);
var
  P,I,M : Word;
begin
  LockScreenUpdate;
  P := ((AX - 1) + (AY - 1) * ScreenWidth);
  M := Length(Text);
  If P + M > ScreenWidth * ScreenHeight then
    M := ScreenWidth * ScreenHeight - P;
  For I := 1 to M do
    VideoBuf^[P+I-1]:=Ord(Text[I])+($07 shl 8);
  UnlockScreenUpdate;
end;

{==============================================================================}

end.

unit WindowClass;

{==============================================================================}

{$mode objfpc}{$H+}

{==============================================================================}

interface

{==============================================================================}

uses
  ScreenClass;

{==============================================================================}

type
  TBorderEnum   = (LeftTop, RightTop, RightBottom, LeftBottom, Horizontal, Vertical);
  TBorderType   = (NoBorder, SingleBorder, DoubleBorder);
  TWindowBuffer = array of Char;

{------------------------------------------------------------------------------}
type
  TWindow = class
    private
      FLeft,
      FTop,
      FWidth,
      FHeight       : Byte;
      FBorderType   : TBorderType;
      FTitle        : string;
      FOwner        : TScreen;
      FWindowBuffer : TWindowBuffer;
    protected
      procedure SetTitle(ATitle : string);
      procedure SetWidth(AWidth : Byte);
      procedure SetHeight(AHeight : Byte);
      procedure SetBorderType(ABorderType : TBorderType);
      procedure DrawBorder;
    public
      constructor Create(ALeft, ATop, AWidth, AHeight : Byte; ABorderType : TBorderType; ATitle : String; var AOwner : TScreen);
      destructor Destroy; override;
    public
      procedure WriteXY(AX, AY : Byte; const AString : String);
      procedure Draw;
    public
      property Title : String read FTitle write SetTitle;
      property Top : Byte read FTop write FTop;
      property Left : Byte read FLeft write FLeft;
      property Width : Byte read FWidth write SetWidth;
      property Height : Byte read FHeight write SetHeight;
      property BorderType : TBorderType read FBorderType write SetBorderType;
  end;

{==============================================================================}

const
  BorderArr : array[TBorderType, TBorderEnum] of Char = ((' ', ' ', ' ', ' ', ' ', ' '),
                                                         (#218, #191, #217, #192, #196, #179),
                                                         (#201, #187, #188, #200, #205, #186));

{==============================================================================}

implementation

{==============================================================================}
{-- private -------------------------------------------------------------------}
{-- protected -----------------------------------------------------------------}

procedure TWindow.SetTitle(ATitle : String);
begin
  FTitle := ' ' + ATitle + ' ';
end;

{------------------------------------------------------------------------------}

procedure TWindow.SetWidth(AWidth : Byte);
begin
  FWidth := AWidth;
  SetLength(FWindowBuffer, FWidth * FHeight);
  DrawBorder;
end;

{------------------------------------------------------------------------------}

procedure TWindow.SetHeight(AHeight : Byte);
begin
  FHeight := AHeight;
  SetLength(FWindowBuffer, FWidth * FHeight);
  DrawBorder;
end;

{------------------------------------------------------------------------------}

procedure TWindow.SetBorderType(ABorderType : TBorderType);
begin
  FBorderType := ABorderType;
end;

{------------------------------------------------------------------------------}

procedure TWindow.DrawBorder;
var
  i : byte;
begin
  //Rysowanie obramowania

  // Lewy gówny róg.
  FWindowBuffer[0] := BorderArr[FBorderType, LeftTop];
  // Prawy górny róg.
  FWindowBuffer[FWidth - 1] := BorderArr[FBorderType, RightTop];
  // Lewy dolny róg.
  FWindowBuffer[(FHeight - 1) * FWidth] := BorderArr[FBorderType, LeftBottom];
  // Prawy dolny róg.
  FWindowBuffer[(FHeight - 1) * FWidth + FWidth - 1] := BorderArr[FBorderType, RightBottom];

  // Poziome obramowanie
  for i := 1 to FWidth - 2 do
  begin
    // Górna krawędź.
    FWindowBuffer[i] := BorderArr[FBorderType, Horizontal];
    // Dolna krawędź.
    FWindowBuffer[(FHeight - 1) * FWidth + i] := BorderArr[FBorderType, Horizontal];
  end;

  // Pionowe obramowanie
  for i := 1 to FHeight - 2 do
  begin
    // Lewa krawędź
    FWindowBuffer[i * FWidth] := BorderArr[FBorderType, Vertical];
    // Prawa krawędź.
    FWindowBuffer[i * FWidth + FWidth - 1] := BorderArr[FBorderType, Vertical];
  end;

  // Wstawianie tytułu.
  for i := 1 to Length(FTitle) do
    FWindowBuffer[FWidth div 2 - 2 - Length(FTitle) div 2 + i] := FTitle[i];
end;

{-- public --------------------------------------------------------------------}

constructor TWindow.Create(ALeft, ATop, AWidth, AHeight : Byte; ABorderType : TBorderType; ATitle : String; var AOwner : TScreen);
begin
  // Przypisanie wartości początkowych polom klasy
  FLeft := ALeft;
  FTop := ATop;
  FWidth := AWidth;
  FHeight := AHeight;
  FBorderType := ABorderType;
  FTitle := ' ' + ATitle + ' ';
  FOwner := AOwner;

  // Ustawienie wielkości bufora okna
  SetLength(FWindowBuffer, FWidth * FHeight);

  DrawBorder;
end;

{------------------------------------------------------------------------------}

destructor TWindow.Destroy;
begin
  SetLength(FWindowBuffer, 0);
  FOwner := nil;
  inherited Destroy;
end;

{------------------------------------------------------------------------------}

procedure TWindow.WriteXY(AX, AY : Byte; const AString : String);
var
  i, j           : Byte;
  BorderPosition : Word;
begin
  if AY = 0 then
    Inc(AY);
  if AX = 0 then
    Inc(AX);
  j := AY * FWidth + AX;
  BorderPosition := FWidth - 1;
  for i := 1 to Length(AString) do
  begin
    if i = BorderPosition then
    begin
      Inc(j, 2);
      BorderPosition := BorderPosition + (FWidth - 2);
    end;
    FWindowBuffer[j] := AString[i];
    Inc(j);
  end;
end;

{------------------------------------------------------------------------------}

procedure TWindow.Draw;
var
  i : Word;
begin
  for i := 0 to Length(FWindowBuffer) - 1 do
    FOwner.WriteXY(i mod FWidth + FLeft, i div FWidth + FTop, FWindowBuffer[i]);
end;

{==============================================================================}
end.

Kod jest dopiero w fazie pisania jest to alfa alfy alfy alfy alfy. Więc może być tam sporo mindfucków.

A dokładnie chodzi mi o metodę TWindow.Draw gdzie FOwner ma być albo oknem nadrzędnym albo ekranem.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TWindow = class
  private
    fOwner: TClass;
    procedure WriteXY();
    procedure Draw;
  public
    constructor Create(const owner: TClass);
  end;

  TScreen = class
  private
    procedure WriteXY();
  public
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TWindow.WriteXY;
begin
  showmessage('TWindow');
end;

constructor TWindow.Create(const owner: TClass);
begin
  fOwner := owner;
  Draw
end;

procedure TWindow.Draw;
var
  screen: TScreen;
begin
  if fOwner = TScreen then screen.WriteXY
  else WriteXY
end;

procedure TScreen.WriteXY;
begin
  showmessage('TScreen');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  TWindow.Create(TScreen);
  // TWindow.Create(nil);
end;

end.

@babubabu, może obejrzyj sobie kody TurboVision - bo na pierwszy rzut oka właśnie to próbujesz powtórzyć.

w ogole nie rozumiem po co ci te 2 klasy? W czym to ci ulatwi?

unit WindowClass;
...
uses
  ScreenClass;

mi sie wydaje to bez sensu. JAki jest sens rozbijania tego?

@babubabu - a co było nie tak z metodą abstrakcyjną, którą wcześniej próbowałeś zastosować?

Jeśli potrzebujesz wywołać daną metodę z przechowywanego w polu obiektu, ale bez konieczności znajomości dokładnej klasy, to spróbuj zapisać sobie klasę bazową okna, która będzie implementować podstawową i uniwersalną funkcjonalność okna; Następnie TScreen niech z niej dziedziczy i przedefiniowywuje metody abstrakcyjne, aby mogł robić coś swojego, ale korzystając z mechanizmów klasy bazowej; To samo w przypadku okien, czyli klasy np. TWindow;

Nie wiem czy dobrze trafiłem, ale może poniższy kod Ci pomoże:

type
  TCustomWindow = class(TObject)
  public
    procedure DoSomething(); virtual; abstract;
  end;

type
  TScreen = class(TCustomWindow)
  public
    procedure DoSomething(); override;
  end;

  procedure TScreen.DoSomething();
  begin
    WriteLn('TScreen.DoSomething');
  end;

type
  TWindow = class(TCustomWindow)
  public
    procedure DoSomething(); override;
  end;

  procedure TWindow.DoSomething();
  begin
    WriteLn('TWindow.DoSomething');
  end;

type
  TParentWindow = class(TCustomWindow)
  private
    FWindow: TCustomWindow;
  public
    procedure DoSomething(); override;
    procedure DoSomethingOther();
  public
    property Window: TCustomWindow read FWindow write FWindow;
  end;

  procedure TParentWindow.DoSomething();
  begin
    WriteLn('TParentWindow.DoSomething');
  end;

  procedure TParentWindow.DoSomethingOther();
  begin
    if Assigned(FWindow) then
      FWindow.DoSomething();
  end;

var
  wndScreen: TScreen;
  wndWindow: TWindow;
  wndParent: TParentWindow;
begin
  wndScreen := TScreen.Create();
  wndWindow := TWindow.Create();
  wndParent := TParentWindow.Create();
  try
    wndParent.Window := wndScreen;
    wndParent.DoSomethingOther();
    wndParent.Window := wndWindow;
    wndParent.DoSomethingOther();
    wndParent.DoSomething();
  finally
    wndScreen.Free();
    wndWindow.Free();
    wndParent.Free();
  end;
end.

Wyjście:

TScreen.DoSomething
TWindow.DoSomething
TParentWindow.DoSomething

@furious programming

U mnie był ten problem, że jak TScreen dziedziczył po TCustom to wszystko działało. Ale jak TWindow dziedziczył po TCustom to wywalało błędy, że nie ma metody żeby ją override (nie pamiętam dokładnego komunikatu). Kombinowałem na wszystkie strony nawet nie robiąc tej metody abstrakcyjną tylko pustą, ale wtedy wywalało niezgodność typów w miejscu próby przypisania TWindow lub TScreen do pola typu TCustom. Być może popełniłem jakiś błąd w kodzie i dlatego błędy wyskakiwały. Próbowałem poszukać w google ale jak pisałem na początku były tam przykłady jak użyć parent/window a nie jak to zaimplementować.

No nic wracam do kombinowania.

U mnie był ten problem, że jak TScreen dziedziczył po TCustom to wszystko działało. Ale jak TWindow dziedziczył po TCustom to wywalało błędy, że nie ma metody żeby ją override (nie pamiętam dokładnego komunikatu).

A mogłeś zapomnieć dodać Virtual do deklaracji metody abstrakcyjnej? W sumie mogłeś i kompilator powinien zgłosić błąd, nie tylko że nie masz co Override'ować, ale także że metoda abstrakcyjna musi być wirtualna lub dynamiczna;

Kombinowałem na wszystkie strony nawet nie robiąc tej metody abstrakcyjną tylko pustą, ale wtedy wywalało niezgodność typów w miejscu próby przypisania TWindow lub TScreen do pola typu TCustom.

Coś było nie tak z dziedziczeniem i ze znajomością klas, z których próbowałeś wywołać metody - pewnie typy się nie zgadzały.

@furious programming Mój kod zmieniony według twojego:

unit TCustomTextObjectClass;

{==============================================================================}

{$mode objfpc}{$H+}

{==============================================================================}

interface

{==============================================================================}

uses
  Classes, SysUtils;

{==============================================================================}

type
  TCustomTextObject = class
    public
      procedure WriteXY(AX, AY : Word; const Text : String); virtual; abstract;
  end;

{==============================================================================}

implementation

{==============================================================================}

end.  

type
  TScreen = class(TCustomTextObject)
    private
      FVideoMode     : TVideoMode;
      FCursorX,
      FCursorY       : Word;
    protected
      procedure SetCursorX(AX : Word);
      procedure SetCursorY(AY : Word);
      function GetCursorX : Word;
      function GetCursorY : Word;
    public
      constructor Create(AWidth, AHeight : Word);
      destructor Destroy; override;
    public
      procedure Clear;
      procedure Update;
      procedure WriteXY(AX, AY : Word; const Text : String); override;
    public
      property CursorX : Word read GetCursorX write SetCursorX;
      property CursorY : Word read GetCursorY write SetCursorY;
  end; 

type
  TWindow = class(TCustomTextObject)
    private
      FLeft,
      FTop,
      FWidth,
      FHeight       : Byte;
      FBorderType   : TBorderType;
      FTitle        : string;
      FOwner        : TCustomTextObject;
      FWindowBuffer : TWindowBuffer;
    protected
      procedure SetTitle(ATitle : string);
      procedure SetWidth(AWidth : Byte);
      procedure SetHeight(AHeight : Byte);
      procedure SetBorderType(ABorderType : TBorderType);
      procedure DrawBorder;
    public
      constructor Create(ALeft, ATop, AWidth, AHeight : Byte; ABorderType : TBorderType; ATitle : String; var AOwner : TCustomTextObject);
      destructor Destroy; override;
    public
      procedure WriteXY(AX, AY : Byte; const AString : String); override; // <- O tutaj
      procedure Draw;
    public
      property Title : String read FTitle write SetTitle;
      property Top : Byte read FTop write FTop;
      property Left : Byte read FLeft write FLeft;
      property Width : Byte read FWidth write SetWidth;
      property Height : Byte read FHeight write SetHeight;
      property BorderType : TBorderType read FBorderType write SetBorderType;
  end;

Linijka zaznaczona komentarzem: Error: There is no method in an ancestor class to be overridden: "TWindow.WriteXY(Byte,Byte,const AnsiString);"

klasa TScreen działa. A klasa' 'TWindow'' nie. I nie mam pojęcia czemu...

@babubabu - jednak nazewnictwo parametrów może się różnić; Całkiem zapomniałem, że przecież sam w swoim komponencie przedefiniowywuję metodę SetBounds, która w klasie bazowej ma parametry Left, Top, Width i Height, a w mojej klasie ma ALeft, ATop, AWidth i AHeight; Jednak typy parametrów i ich kolejność musi być zachowana, bo inaczej kompilator zgłosi błąd;

W tym błędzie który podałeś wyżej widać, że chodzi o typy parametrów, bo masz je wypisane w linii błędu; Natomiast nazewnictwo jest pominane - błąd zawiera podane jedynie typy parametrów;

A tak poza tym, to jeśli tworzysz nową klasę, która ma posiadać jakąkolwiek przedefiniowaną metodę klasy bazowej, to wystarczy przejść do odpowiedniej sekcji klasy, napisać słówko kluczowe procedure lub function, a następnie skorzystać Code Completion (Ctrl+Space) i wybrać z listy odpowiednią metodę, a IDE automatycznie wstawi jej deklarację i na końcu dopisze słówko Override;

Jeśli chodzi o bazową klasę TCustomTextObject to raczej nie ma ona uzasadnionego sensu, dlatego że zbyt mało łączy klasy TScreen i TWindow; Coś mi to nie pasuje i nie wiem czy nie lepiej było by przerzucić wspólną funkcjonalność obu klas do klasy bazowej i ewentualnie metody obsługujące bufor zadeklarować jako wirtualne lub dynamiczne i je przedefiniowywać; Ale tutaj musisz sam określić, czy dziedziczenie z klasy TCustomTextObject ma w ogóle sens;

Co do małych wskazówek - możesz skorzystać z typów z modułu Types, dlatego że współrzędne możesz przechowywać jako TPoint lub TSmallPoint, a rozmiary okna możesz trzymać w polu typu TRect; Zaoszczędzisz nieco kodu i opakujesz powiązane ze sobą informacje w rekordy; A do ich uzupełniania możesz skorzystać z funkcji Rect i Point.