Developing.ru

Код: Выделить всё

TFigure=Class(TObject)
  [B]Private[/B]
        Color:Boolean;              чёрная или белая
        TypeFigure:String;
        ImgFigure:TImage;
  [B]Protected[/B]
        DestroyFigure:Boolean;          срубление фигуры
        OcheredHodaFigure:Boolean;
  [B]Function[/B] Coord1:TPanel;
  [B]Procedure[/B] Coord2(Coord:Tpanel);
         [B]Property[/B] CoordFigure:TPanel         будет ходить по панелькам
                             [B]read[/B] Coord1
                             [B]write[/B] Coord2;

  [B]Public[/B]
  Procedure HodFigure(a:TPAnel);

  [B]Private[/B]
  constructor Fcreate (Coord:Tpanel);
  end;

Код: Выделить всё

TCellColor = (Black, White);
TFigure=Class
  Private
        FColor:TCellColor;
        FTypeFigure:String;  //Можно поступить, как с цветом.
        FImgFigure:TImage;
        DestroyFigure:Boolean;
        OcheredHodaFigure:Boolean; //???
        Function Coord1:TPanel;
        Procedure Coord2(Coord:Tpanel);
  Public
        Procedure HodFigure(a:TPAnel);
        Property [B]CoordFigure:TPanel read Coord1 write Coord2;[/B]
        constructor Сreate (Coord:Tpanel); 
  end;

Код: Выделить всё

TMyClass = class
private
  FMyField: Integer;
published
  property MyProperty: Integer read {откуда читаем в свойство} FMyField write {куда записываем свойство} FMyFiled;
end;

Код: Выделить всё

TObject = class
    constructor Create;
    procedure Free;
    class function InitInstance(Instance: Pointer): TObject;
    procedure CleanupInstance;
    function ClassType: TClass;
    class function ClassName: ShortString;
    class function ClassNameIs(const Name: string): Boolean;
    class function ClassParent: TClass;
    class function ClassInfo: Pointer;
    class function InstanceSize: Longint;
    class function InheritsFrom(AClass: TClass): Boolean;
    class function MethodAddress(const Name: ShortString): Pointer;
    class function MethodName(Address: Pointer): ShortString;
    function FieldAddress(const Name: ShortString): Pointer;
    function GetInterface(const IID: TGUID; out Obj): Boolean;
    class function GetInterfaceEntry(const IID: TGUID): PInterfaceEntry;
    class function GetInterfaceTable: PInterfaceTable;
    function SafeCallException(ExceptObject: TObject;
      ExceptAddr: Pointer): HResult; virtual;
    procedure AfterConstruction; virtual;
    procedure BeforeDestruction; virtual;
    procedure Dispatch(var Message); virtual;
    procedure DefaultHandler(var Message); virtual;
    class function NewInstance: TObject; virtual;
    procedure FreeInstance; virtual;
    destructor Destroy; virtual;
  end;
...
...
class function TObject.ClassParent: TClass;
{$IFDEF PUREPASCAL}
begin
  Pointer(Result) := PPointer(Integer(Self) + vmtParent)^;
  if Result <> nil then
    Pointer(Result) := PPointer(Result)^;
end;
{$ELSE}
asm
        MOV     EAX,[EAX].vmtParent
        TEST    EAX,EAX
        JE      @@exit
        MOV     EAX,[EAX]
@@exit:
end;
{$ENDIF}

class function TObject.NewInstance: TObject;
begin
  Result := InitInstance(_GetMem(InstanceSize));
end;

procedure TObject.FreeInstance;
begin
  CleanupInstance;
  _FreeMem(Self);
end;
...
...
...