Přetěžení metody v objektu – Pascal – Fórum – Programujte.com

Ahoj,

mám objekt, který má metody A a B. V metodě A vytvořím nový objekt. Šlo by v Pascalu udělat, aby ten nový objekt, přetěžil metodu B prvního (současného) objektu?

Myslíš přetížení jako overload? Čili víc metod se stejným názvem a jinými parametry v jedné třídě? V TP určitě ne, ve FP nevím, v Delphi určitě jo.

Teď ale co myslíš tím novým a současným objektem? Jestli to dobře chápu, tak máš třídu dejme tomu T a v ní definované metody A a B. Kdykoli vytvoříš objekt typu T (čili instanci třídy T), budou v něm metody A a B přístupné a budou to přesně ty, které jsou definované ve třídě T.
Když definuješ potomka z T, vytvoříš jeho instanci a pak se na ni odkážeš přes ukazatel na typ T, budeš v ní mít přístupné buď metody z T (pokud nebudou virtuální) nebo metody z toho potomka (pokud virtuální budou).

Jestli to nebylo to, co jsi chtěl, tak trochu upřesni otázku, abych ji pochopil :-).

Tak já to trochu rozepíšu. Přetížení myslim jako overload, ale nevim jestli se tomuhle tak říká, takže:

Mam třídu T, která má metody A a B.
Metoda A dejmetomu vrací postupně číslo zvětšené o 1
Metoda B vytváří novou instanci T - new(T), která by mi ale měla ovlivnit (přetěžit) metudu A v současné instanci T (tedy v té, která právě vytvořila instanci)

Příklad:

type
T = object
cislo : integer;
constructor Priprav;
function A : integer;
procedure B;
end;

constructor T.Priprav;
begin
cislo := 1;
end;

function T.A : integer;
begin
inc(cislo);
A := cislo;
end;

procedure T.B;
begin
new(T,Priprav);
{ nove T ted bude prebirat metodu "this.A" }
end;

begin
new(T,Priprav);
while T.cislo < 10 then begin
if cislo = 7 then
T.B;
wrte(T.A);
end;
end.

Jako výstup bych tedy očekával 1 2 3 4 5 6 7 1 2 3 4 5 6 7 1 2 3 4 ...

Takhle určitě ne. new(T,Priprav) nejde, protože T je typ, ne proměnná. To bys musel definovat ukazatel na T (např. type PT=^T) a potom napsat new(P,Priprav) (kde P je typu PT).
Potom si instancí třídy T můžeš vyrábět kolik chceš, můžeš je vyrábět i metodami třídy T a každá z těch instancí bude naprosto plnohodnotná, se všemi atributy a metodami, které jsou v třídě T definovány.

Takže:

type

PT=^T;

T = object
cislo : integer;
pomocna:PT;
constructor Priprav;
function A : integer;
procedure B;
end;

constructor T.Priprav;
begin
cislo := 1;
end;

function T.A : integer;
begin
inc(cislo);
A := cislo;
end;

procedure T.B;
begin
new(pomocna,Priprav);
{promenna pomocna^ je ted normalni objekt typu T}
end;

var obj:T; {jedna staticky deklarovana instance}

begin
obj.Priprav;
obj.B;
obj.pomocna^.A; {timhle zavolas metodu A z toho nove dynamicky vytvoreneho objektu}
end.

Takhle by to fungovalo.

Pozor, že používat New v cyklu je kravina, protože každé New vytvoří nový objekt, a protože ho ničím nerušíš, za chvíli ti dojde paměť! Nezapomínej na Dispose.

Microsoft má pravdu. Jinak technika, že si jedna instance objetku vytváří nové instance, se používá běžně. (Ale overloading se nenazývá - pod tím se rozumí něco jiného)
Typické použití je u spojových seznamů. Jestli chceš praktickou ukázku, tak si stáhni moji jednotku Wokna32 http://www.laaca.borec.cz/soubory/wokna32.rar a tam se mrkni na jednotku Vaznik. Konkrétně na metodu InitNext.

(v dalších verzích se ale Vazník bude chovat jinak a i InitNext bude pracovat na jiném principu)

Pravda, omlouvám se za tu chybu, že jsem nedeklaroval proměnnou... nicméňe problém (nebo spíš dotaz) neni ohledně deklarování, ale ohledně předání řízení (overload) metody. Mělo by to být zřejmé z toho očekávaného výstupu, ale asi jsem se špatně vyjádřil, tak se pokusím ještě uvést konkrétnější příklad :-)
BTW dispose je teď nepodstatné

type

  PT = ^T;



  T = object

    cislo : integer;

    constructor Priprav; 

    function A : integer; 

    procedure B; 

  end; 



constructor T.Priprav; 

begin 

    cislo := 1; 

end; 



function T.A : integer; 

begin 

    inc(cislo); 

    A := cislo; 

end; 



procedure T.B; 

var

  PODRADNA : PT;

begin 

    new(PODRADNA,Priprav); 

    { DOTAZ> jak udelat, aby nova instance T "PODRADNA" obsadila (přebrala řízení pro) metodu "HLAVNI.A" }

end; 



var

  HLAVNI : PT;



begin 

  new(HLAVNI,Priprav); 

  while HLAVNI^.cislo < 10 then begin 

    if cislo = 7 then 

      HLAVNI^.B; 

    wrte(HLAVNI^.A); 

  end; 

end. 

ahoj světe

INCLUDE druhy_soubor.txt

já jsem první soubor

nazdar lidi

1. ahoj

2. světe

3. nazdar

4. lidi

5. já

6. jsem

7. první

8. soubor

Máš jako namysli tohle?

Procedure T.B;

var podradna:T; {je lepsi udelat ji statickou, at se nemusis manualne starat o alokaci a dealokaci}

begin                            {tady zopakuj hlavni rutinu hlavniho programu, ale nebudeš volat HLAVNI, ale PODRADNOU}

podradna.Priprav;

while podradna.cislo < 10 then begin 

    if podradna.cislo = 7 then podradna.B; 

    write(podradna.A); 

  end; 

{pri vychodu z procedury se podradna zrusi sama}

end;

No, už je to blíž, ale ještě pořád to není ono :-)

Hlavní rutina hlavního programu je trochu komplikovanější než sem tu uvedl - jde mi o princip nikoliv naprogramování... řekněme, že to while < 10 by mohlo nahradit while POZICE <> length(SOUBOR) a to if cislo = 7 nahradí if PARSUJ = "INCLUDE", ale metoda PARSUJ nezkouší jenom jestli se to rovná INCLUDE :-)
Zkouší toho mnoho a opisovat to znovu mi nepřijde jako dobrý nápad. Navíc potřebuju volat pouze metody instance HLAVNI v hlavní části programu.

Krokování předchozího:

01. new(HLAVNI,Priprav); - vytvoření instance třídy T; POZICE = 1

02. je POZICE různá od length(SOUBOR) ? - ano, skoč do cyklu while

03. je HLAVNI.PARSUJ rovno INCLUDE ? ne, parsuj vrátilo "ahoj"

04. zvyš POZICI o jedna

05. je POZICE různá od length(SOUBOR) ? - ano, pokračuj v cyklu

06. je HLAVNI.PARSUJ rovno INCLUDE ? ne, parsuj vrátilo "svete"

07. zvyš POZICI o jedna

08. je POZICE různá od length(SOUBOR) ? - ano, pokračuj v cyklu

09. je HLAVNI.PARSUJ rovno INCLUDE ? ano, parsuj vrátilo "INCLUDE"

10. vytvoř novou instanci třídy T (PODRADNA) a do PODRADNA.SOUBOR nacti data ze "druhy_soubor.txt"

11. zvyš POZICI o jedna - tady koukám, že mam chybu mělo by tam u té podmínky být ELSE :-) ale to nevadí. Podstatné je,

  aby ta POZICE byla z instance PODRADNA (tedy rovna jedné a ne tři), nikoliv HLAVNÍ, ale vylezla po volání HLAVNÍ (overload!!!)

12. je HLAVNI.PARSUJ rovno INCLUDE ? NE - HLAVNI.PARSUJ vrátilo PODRADNA.PARSUJ!!!!!! tedy "nazdar"!!!!

13. ... atd.

zaloha := this;

this := podradna;

...

this := zaloha;

Mám dojem, že to začínám chápat :-).

Máš jeden objekt. Vytvoříš druhý. A chceš to zařídit tak, aby se při volání metody z prvního objektu zavolala metoda z druhého objektu?

To ale není ani přetěžování ani cokoli jiného z OOP. Běžně se na to používají procedurální proměnné:

var proc:procedure;

type o=object
p:proc;
end;

procedure skutecna; far; {far zarucuje vzdalene volani, bez ktereho by to neslo}
begin
...
end;

var objekt:o;
...

o.p:=skutecna;
o.p; {zavola proceduru Skutecna}


Procedurální typ musí mít stejné parametry jako skutečné procedury, na které se přes něj budeš odkazovat. Řekl bych ale, že metody objektů se tímhle způsobem referencovat nedají (vyzkoušej to, možná se pletu).

Super :-)

To je přesně ono :-) Já sem se jenom špatně vyžvejkl... Myslel sem si, že je to něco s typem PROCEDURE, ale ten sem ještě v praxi nikdo neviděl a nevim jak se s ním pracuje. Snad to tedy půjde i v objektech.

Díky Vám všem za pomoc :-)

BTW co přesně znamená to FAR? Jak to pak vypadá ve skutečnosti (po kompilaci) a je taky něco jako NEAR? Je rozdíl mezi FAR v 16-bitovém programu a FAR v 32-bitovém?

Near je blízký model volání, far vzdálený. Near se defaultně používá u procedur definovaných v programu a u procedur pouze v implementační části jednotky; far u těch, které mají hlavičku uvedenou v části interface.
Nucené volání všeho jako far se dá zařídit direktivou {$F+}. Místní procedury, u kterých by bylo daleké volání zbytečné, pak můžeš na blízké změnit slovem Near.

Rozdíl mezi near a far je takový, že při blízkém volání je segment stejný jako segment volajícího boku, tj. změní se jenom registr IP, ne CS. Při dalekém volání se volá z jiných segmentů, takže se mění i CS (a je to o pár taktů procesoru pomalejší). To platí pro 16bitový real mód. Ve 32bitovém režimu se všechno volá 32bitově, žádné segmenty se tam nevyskytují, takže není co řešit.

Jo, a možná by se ti mohl hodit tenhle text: http://mircosoft.ic.cz/texty/UKAZ.TXT.

Dík za objasnění :-)

Jenom když teda udělám ve freepascalu (FP)

type

  proc = function : char of object; { "of object" značí ve FP, že je typ součástí třídy }



  o = obejct

    p : proc;

  end;

if o.p = 'A'

Ne, Wimby, takhle doopravdy ne!
Tímhle se dostáváš na hodně tenký led všelijakých divokých hacků v situaci, kdy se tyto úlohy dají řešit úplně normálně. Zítra, až příjdu z práce, ti to zkusím napsat nějakým pěkným srozumitelným kódem.
Celá algoritmus by se výrazně zjednodušil, kdybys akceptoval, že by byl dvojprůchodový. V prvním průchodu by se vyřešily všechny INCLUDE a ve druhém by proběhl samotný rozbor textu.

Dvojprůchodový algoritmus by byl jistě jednodušší, ale přinesl by řadu nevýhod, jako třeba to, že nevim jak bych to udělal, abych nemusel mít zdroj načtený celý, abych ho nemusel přeukládat.

Jde to udělat, možná stejně jednoduše, i s jedním průchodem, ale hledám způsob, který by byl lepší... abych nemusel použít tolik struktur, aby stačil pouze jeden objekt (do objektů sem to přepsal, protože mi přišlo, že tam mam hodně globálních proměnných), a aby to bylo co možná nejrychlejší... hlavně to programuju proto, abych se něco naučil a to se mi těžko povede datlováním pořád stejnýho kódu :-)

Nevim jestli je to chyba, ale Freepascal nějak zpřístupní celý objekt po tom přiřazení fuknce k proměnné a sice to ještě nepracuje tak jak by mělo, ale vrací to

AHOJ NAZDAR LIDI     E.

type

  PT = ^T;

  T = object

    SOUBOR : string;

    POZICE : byte;

    function VRATZNAK : char;

    PARSOVANI : function : string of object;

    PARSOVANI_ZALOHA : function : string of object;

    constructor PRIPRAV(VETA : string);

    function ZNAK : char;

    function PARSUJ : string;

  end;





constructor T.PRIPRAV(VETA : string);

begin

  SOUBOR := VETA;

  POZICE := 1;

  PARSOVANI := @PARSUJ;

end;



function T.VRATZNAK : char;

begin

  VRATZNAK := SOUBOR[POZICE];

end;



function T.ZNAK : char;

begin

  if POZICE = length(SOUBOR) then

  begin

    PARSOVANI := PARSOVANI_ZALOHA;

  end;

  inc(POZICE);

  ZNAK := VRATZNAK;

end;



function T.PARSUJ : string;

var

  PODRADNY : PT;

begin

  PARSUJ := '';

  while VRATZNAK = ' ' do

    ZNAK;

  while VRATZNAK in ['A'..'Z'] do

  begin

    PARSUJ := PARSUJ + VRATZNAK;

    if PARSUJ = 'INCLUDE' then

    begin

      new(PODRADNY,PRIPRAV('NAZDAR LIDI'));

      PARSOVANI_ZALOHA := PARSOVANI;

      PARSOVANI := @PODRADNY^.PARSUJ;

      PARSUJ := PODRADNY^.PARSUJ;

      exit;

    end;

    ZNAK;

  end;

end;



var

  HLAVNI : PT;



begin

  new(HLAVNI,PRIPRAV('AHOJ INCLUDE SVETE'));

  repeat

    writeln(HLAVNI^.PARSOVANI);

  until HLAVNI^.VRATZNAK = #0;

end.

A co takhle použít úplně obyčejnou rekurzi? Procedura, otevře soubor, prochází ho a parsuje a když narazí na include, zavolá sama sebe na ten další soubor.

Wimby, nevim, jestli jsi chtěl přesně tohle, ale minimálně inspirovat by tě to mohlo.

Napsal jsem program, který otevře textový soubor a čte z něho slova. Ta vypisuje pod sebe na obrazovku. Pokud ale narazí na slovo INCLUDE tak následující slovo pochopí jako název souboru, který otevře a pokračuje ve čtení z něj. Když dorazí na konec souboru, tak ho zavře a dál se pokračuje z původního, "nadřazeného", souboru.
Chování je tedy dosti složité, ale navenek se to chová úplně jednoduše (koukni se na hlavní program). Zvnějšku se pořád se přistupuje k původnímu objektu, i když ten si podle potřeby deklaruje další.

Pod tímto textem vidíš zdroják. Jestli si ho chceš prakticky odzkoušet na připraveném textu, tak stáhni tento archív: http://www.laaca.borec.cz/ctecka.zip (Vypíše se úryvek z básně Protokol na milici od Vladimíra Vysockého)

{$I-}        {chybove stavy pri operacich se soubory si osetrim sam}

type



PCtecka = ^TCtecka;

TCtecka = object

  public

    konec:boolean;

    Procedure OtevriSoubor(s:string);

    Procedure ZavriSoubor;

    Function CtiSlovo:string;

  private

    ff:text;

    chyba:integer;

    potomek:PCtecka;

    buffer:string;

    Procedure ZalozPotomka(s:string);

    Procedure ZrusPotomka;

end;





Function NaVelka(s:string):string;

var i:integer;

begin

for i:=1 to Length(s) do s[i]:=UpCase(s[i]);

NaVelka:=s;

end;



Function VytahniSlovo(var s:string):string;

{Krome toho, ze vrati slovo z retezce, toto slovo z retezce odmaze}

var i,j,k:integer;

begin

k:=0;

for j:=1 to Length(s) do {zjisti, nejsou-li uvodno mezery ci tabulatory}

   if s[j] in [' ',#9{tabulator}] then inc(k) else Break;

delete(s,1,k); {casove efektivnejsi je odmazat mezery takto najednou, a ne po jedne}

if s='' then begin VytahniSlovo:='';Exit;end;

k:=0;

for j:=1 to Length(s) do

   if not (s[j] in [' ',#9]) then inc(k) else Break;

VytahniSlovo:=Copy(s,1,k);

delete(s,1,k);

end;



Procedure TCtecka.OtevriSoubor(s:string);

begin

Assign(ff,s);

konec:=false;

Reset(ff);

chyba:=IOresult; {Neco spatne? Treba soubor neexistuje?}

buffer:='';

potomek:=nil;    {na zadne INCLUDE jsme jeste nenarazili}

end;



Procedure TCtecka.ZavriSoubor;

begin

if potomek<>nil then ZrusPotomka;

Close(ff);

end;



Procedure TCtecka.ZalozPotomka(s:string);

begin

New(potomek);

potomek^.OtevriSoubor(s);

end;



Procedure TCtecka.ZrusPotomka;

begin

potomek^.ZavriSoubor;

Dispose(potomek);

potomek:=nil;

end;



Function TCtecka.CtiSlovo:string;

var s:string;

begin

if potomek<>nil then

   begin

   s:=potomek^.CtiSlovo;

   if potomek^.konec then ZrusPotomka;

   end else s:='';



if (chyba<>0) or (konec=true) then

   begin CtiSlovo:='';konec:=true;Exit;end;



while s='' do

begin

{takhle slozite je to proto, aby se spravne osetrily prazdne radky}

if buffer='' then

   if Eof(ff)

      then begin konec:=true;CtiSlovo:='';Exit;end

      else readln(ff,buffer);

s:=VytahniSlovo(buffer);



if NaVelka(s)='INCLUDE' then

   begin

   s:=VytahniSlovo(buffer);

   ZalozPotomka(s);

   if potomek^.chyba<>0

      then begin ZrusPotomka;s:='';end

      else begin

      s:=potomek^.CtiSlovo;

      end;

   end;

end;



CtiSlovo:=s;

end;



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

var c:TCtecka;

begin

c.OtevriSoubor('basen1.txt');

while not c.Konec do writeln(c.CtiSlovo);

c.ZavriSoubor;

readln;

end.