Getting started with classes (7): traverse all parent classes of a form

Unit unit1; interfaceuses windows, messages, sysutils, variants, classes, graphics, controls, forms, dialogs, stdctrls; Type tform1 = Class (tform) button1: tbutton; button2: tbutton; button3: tbutton; button4: tbutton; Procedure submit (Sender: tobject ); end; var form1: tform1; implementation {$ R *. DFM} // procedure tform1.button1click (Sender: tobject); begin showmessage (self. classname); {tform1-form1 class name} showmessage (self. classparent. classname); {parent class name of tform-form1} showmessage (self. classparent. classparent. classname); {tcustomform-form1 Grandpa class name} end; // procedure tform1.button2click (Sender: tobject); var myclass: tclass; {tclass is a class reference of tobject; it has the same functions as tobject, but in short it is not a type} begin {object's classtype method returns the object's tclass} showmessage (self. classtype. classname); {tform1-form1 class name} myclass: = self. classtype; showmessage (myclass. classname); {tform1-form1 class name} end; // procedure tform1.button3click (Sender: tobject); var myclass: tclass; begin {the object's classparent method returns tclass, you can assign the object classparent to the tclass variable} myclass: = self. classtype; showmessage (myclass. classname); {tform1-form1 class name} myclass: = myclass. classparent; showmessage (myclass. classname); {parent class name of tform-form1} myclass: = myclass. classparent; showmessage (myclass. classname); {tcustomform-form1 Grandpa class name} end; // traverses all parent classes of the form procedure tform1.button4click (Sender: tobject); var myclass: tclass; begin myclass: = self. classtype; while myclass nil do begin showmessage (myclass. classname); myclass: = myclass. classparent; end; {displayed in sequence: tform1 tform tcustomform tscrollingwincontrol twincontrol tcontrol tcomponent tpersistent tobject} end; end.