Keresés: - Delphi forráskód help! - Mobilarena Hozzászólások

Legfrissebb anyagok

Mobilarena témák

PROHARDVER! témák

IT café témák

GAMEPOD témák

LOGOUT témák

Keresés

Aktív témák

#22 khalox őstag rdi #21

2003-05-08 08:05:57 #22
Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
Privát üzenet küldése

khalox

őstag

válasz rdi #21 üzenetére

Khmm... ez sima Pascal...
#20 khalox őstag khalox #19

2003-05-06 15:45:43 #20
Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
Privát üzenet küldése

khalox

őstag

válasz khalox #19 üzenetére

...meg a mem.felszabadító parancs is mintha más lenne...
#19 khalox őstag gLes #17

2003-05-06 15:44:26 #19
Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
Privát üzenet küldése

khalox

őstag

válasz gLes #17 üzenetére

De Delphire is jó... pascal-pascal. Legfeljebb itt-ott be kell szúrni a beillesztéshez, de hát ne mindent én csináljak...
#16 khalox őstag khalox #15

2003-05-06 15:38:19 #16
Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
Privát üzenet küldése

khalox

őstag

válasz khalox #15 üzenetére

Ja meg persze így kapásból nem is működik, pusztán nevelő, tanító célzattal. Hogy én milyen rendes vagyok, ehh.
#15 khalox őstag khalox #14

2003-05-06 15:37:01 #15
Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
Privát üzenet küldése

khalox

őstag

válasz khalox #14 üzenetére

És mivel az utóbbi pár hozzászólásom OFF volt, ezért megbüntettem magam és nyomtam egy COPY-PASTE-et... hogy valami legyen a témához is (bár a szóközöket tudom lenyeli, valamit dolgozzon is vele...):

Unit Lista;

Interface
Type
Elemtip = ??? ; (* a lista elemtipusa *)
Tipus = Pointer;

{ A lista adattipus muveletei: }
Procedure Letesit(Var L : Tipus);
Procedure Uresit(Var L : Tipus);
Function Urese(L : Tipus) : Boolean;
Function Elejen(L : Tipus) : Boolean;
Function Vegen(L : Tipus) : Boolean;
Procedure Elejere(Var L : Tipus);
Procedure Vegere(Var L : Tipus);
Procedure Tovabb(Var L : Tipus);
Procedure Kiolvas( L : Tipus;
Var X : Elemtip);
Procedure Modosit(Var L : Tipus;
Y : Elemtip);
Procedure Bovit(Var L : Tipus;
Y : Elemtip);
Procedure Torol(Var L : Tipus);
Procedure Kapcsol(Var L1,L2 : Tipus);

Implementation
Type
Lanctip = ^Cella;
Cella = Record
adat : Elemtip;
csat : Lanctip
End;

Reptip = Record (* az adattipus reprezentalo tipusa *)
lab, kurzor : Lanctip
End;

Procedure Letesit(Var L : Tipus);
Var Lr: ^Reptip Absolute L;
Begin
New(Lr);
With Lr^ Do
Begin
New(lab);
lab^.csat := lab; kurzor := lab
End
End (* Letesit *) ;

Procedure Uresit(Var L : Tipus);
Var Lr: ^Reptip Absolute L;
Begin
With Lr^ Do
Begin
lab := lab^.csat;
kurzor:= lab^.csat;
While kurzor <> lab Do
Begin
lab^.csat:= kurzor^.csat;
Dispose(kurzor);
kurzor := lab^.csat;
End;
End;
End (* Uresit *) ;

Function Urese(L : Tipus) : Boolean;
Var Lr: ^Reptip Absolute L;
Begin
Urese := Lr^.lab = Lr^.lab^.csat
End (* Urese *) ;

Function Vegen(L : Tipus) : Boolean;
Var Lr: ^Reptip Absolute L;
Begin
Vegen := Lr^.kurzor = Lr^.lab
End (* Vegen *) ;

Function Elejen(L : Tipus) : Boolean;
Var Lr: ^Reptip Absolute L;
Begin
Elejen := Lr^.kurzor = Lr^.lab^.csat
End (* Elejen *) ;

Procedure Elejere(Var L : Tipus);
Var Lr: ^Reptip Absolute L;
Begin
Lr^.kurzor := Lr^.lab^.csat
End (* Elejere *) ;

Procedure Vegere(Var L : Tipus);
Var Lr: ^Reptip Absolute L;
Begin
Lr^.kurzor := Lr^.lab
End (* Vegere *) ;

Procedure Tovabb(Var L : Tipus);
Var Lr: ^Reptip Absolute L;
Begin
If Lr^.kurzor <> Lr^.lab
Then Lr^.kurzor := Lr^.kurzor^.csat
End (* Tovabb *) ;

Procedure Kiolvas(L : Tipus; Var X : Elemtip);
Var Lr: ^Reptip Absolute L;
Begin
If Lr^.kurzor <> Lr^.lab Then
X := Lr^.kurzor^.csat^.adat
End (* Kiolvas *) ;

Procedure Modosit(Var L : Tipus; Y : Elemtip);
Var Lr: ^Reptip Absolute L;
Begin
If Lr^.kurzor <> Lr^.lab Then
Lr^.kurzor^.csat^.adat := Y
End (* Modosit *) ;

Procedure Bovit(Var L : Tipus; Y : Elemtip);
Var Lr: ^Reptip Absolute L;
ujcella : Lanctip;
Begin
New(ujcella);
With Lr^ Do
Begin
ujcella^.adat := Y; ujcella^.csat := kurzor^.csat;
kurzor^.csat := ujcella;
If kurzor = lab Then
lab := ujcella;
End
End (* Bovit *) ;

Procedure Torol(Var L : Tipus);
Var Lr: ^Reptip Absolute L;
Var P : Lanctip;
Begin
With Lr^ Do
If kurzor <> lab Then
Begin
If kurzor^.csat = lab Then
lab := kurzor;
P := kurzor^.csat;
kurzor^.csat := P^.csat;
Dispose(P);
End
End (* Torol *) ;

Procedure Kapcsol(Var L1, L2 : Tipus);
Var L1r: ^Reptip Absolute L1; L2r: ^Reptip Absolute L2;
Var P,Fej2 : Lanctip;
Begin
If (L1r^.lab <> L2r^.lab) And (L2r^.kurzor <> L2r^.lab^.csat) Then
Begin
P := L1r^.kurzor^.csat;
Fej2:= L2r^.lab^.csat;
L1r^.kurzor^.csat := Fej2^.csat;
Fej2^.csat:= L2r^.kurzor^.csat;
L2r^.kurzor^.csat := P;
If L1r^.kurzor = L1r^.lab Then
L1r^.lab := L2r^.kurzor;
If Fej2 = Fej2^.csat Then
L2r^.lab := Fej2;
L2r^.kurzor :=Fej2 ;
End
End (* Kapcsol *) ;

End (* Lista *) .
#14 khalox őstag rdi #13

2003-05-06 15:33:14 #14
Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
Privát üzenet küldése

khalox

őstag

válasz rdi #13 üzenetére

Nem, valóban nem... és hiába az összes előregyártott megoldása, amikor TÉNYLEG kell valami, akkor magad uram... - éppen a minap kerültem szembe vele.

Néha az az érzésem, hogy a paletta nagyrésze arra lett kitalálva, hogy elvakítsa az egyszerijúzert.
#12 khalox őstag khalox #11

2003-05-06 15:24:39 #12
Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
Privát üzenet küldése

khalox

őstag

válasz khalox #11 üzenetére

amúgy meg megnézem, hogy mondjuk Turbo Pascalban milyen Formokra dobálod a milyen komponenseket...
#11 khalox őstag gLes #10

2003-05-06 15:23:00 #11
Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
Privát üzenet küldése

khalox

őstag

válasz gLes #10 üzenetére

ez MÉG most lehet, hogy működik...