Отправляет email-рассылки с помощью сервиса Sendsay

Все, что вы не знали, но хотели бы узнать о Delphi

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Сетевой адаптер: осваиваем Интернет" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

  Апрель 2006   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Автор
Petrify

Статистика

872 подписчиков
-1 за неделю
←   Все выпуски   →

Все, что вы не знали, но хотели бы узнать о Delphi. Язык программирования Delphi: ООП(часть 1)


Выпуск №4

Раздел: Язык Программирования Delphi

Подраздел: Объектно-ориентированное программирование(ООП)

Уважаемый подписчик,

О чем будет следующий раздел - решать вам.

Варианты:

VCL

Системные функции и Winapi

Базы данных

Работа с файловой системой

Репортинг, работа с принтером

Работа с сетью, Интернетом, протоколами

Работа с графикой, мультимедиа

Ваши предложения высылайте на

formyreferal@rambler.ru

В этом выпуске:

Как написать собственный класс?

Как можно работать с объектами, не заботясь об их разрушении?

Как преобразовать указатель на метод в указатель на функцию?

Как явно вызвать виртуальный метод дедушки?

Как написать собственный класс?

 


Вот пример написания класса. Этот класс вычисляет сумму квадратов введенных чисел. Этот класс написан мной только для примера, и я исходил из соображений наглядности, а не оптимальности. Большая часть реализации не только не оптимальна, но и бессмыслена, но показывает бОльшую часть простейших приемов создания класса.

unit Unit2;

interface

Uses classes, Sysutils;

{Нам нужен процедурный тип для создания собственного события. Собственно - это описание процедуры которая должна будет исполнятся при каких-нибудь обстоятельствах}

Type
  TError = procedure(Sender:TObject; Error: string) of object;

{Описание нашего класса, мы его наследуем от TObject, потому ?то нам практи?ески не нужна
никакия функциональность предков}
Type TStatistic=Class(TObject)

 

private {здесь описываются только внутренние переменные и процедуры - "для служебного пользования"}  

 

 

 

 

 

{Описание полей, т.е. переменных которые работают только внутри класса, "снаружи" они не  

 

 

доступны.}  

 

 

FList:TStringList;  

 

 

FPrecision: byte;  

 

 

{Тоже переменная - для определения события}  

 

 

FonError: TError;  

 

 

{функция - будет использоваться только внутри класса, "снаружи" напрямую не доступна}  

 

 

function GetCount: integer;  

 

 

 

 

 

public {Описанное здесь доступно для пользователя класса}  

 

 

 

 

 

{Конструктор - метод создания класса, имеет смысл его описывать только если он делает  

 

 

?то-то специфи?еское - например нам надо будет создать переменную FList. В противном слу?ае  

 

 

его описание можно опустить - будет работать конструктор родительского класса}  

 

 

Constructor Create;  

 

 

{Деструктор - метод разрушения класса}  

 

 

Destructor Destroy; override;  

 

 

{Описание методов - собственно методы мало ?ем отли?аются от процедур}  

 

 

Procedure AddValue(Value:String);  

 

 

Procedure Clear;  

 

 

Function Solve:real;  

 

 

{Описание свойств. Обратите внимание само свойство не способно хранить никакую информацию, это  

 

 

только указатель на внутренюю струкруру. Например для хранения свойства Precision используется  

 

 

переменная FPrecision. А для ?тение свойства Count используется функция GetCount}  

 

 

Property Precision:byte read FPrecision write FPrecision;  

 

 

Property Count:integer read GetCount;  

 

 

{Описание событий. ?то такое событие? - Это указатель на процедуру. Сам класс реализации этой процедуры  

 

 

не знает. Классу известно только заголовок процедуры, вы в коде программы будете писать реализацию  

 

 

процедуры, а класс только в нужный момент передаст ей управление, используя указатель onError}  

 

 

Property onError:TError read FonError write FonError;  

 

 

 

end;

implementation

{ TStatistic }

constructor TStatistic.Create;
begin

 

inherited; {Вна?але надо вызвать конструктор класса-родителя}  

 

 

FList:=TStringList.create;{создаем структуры нашего класса}  

 

 

 

end;

destructor TStatistic.Destroy;
begin

 

FList.Free;{Разрушаем структуры нашего класса}  

 

 

inherited;{в последнюю о?ередь вызываем деструктор клсса-родителя}  

 

 

 

end;

procedure TStatistic.AddValue(Value: String);
begin
  FList.add(Value); {Примерно так мы реализуем метод}
end;

procedure TStatistic.Clear;
begin
  FList.clear;
end;

function TStatistic.GetCount: integer;
begin
  Result:=FList.count+1;
end;

function TStatistic.Solve: real;
  var i:integer;
begin

 

result:=0;  

 

 

for i:=0 to FList.count-1 do  

 

 

 

 

 

begin  

 

 

 

 

 

try  

 

 

  result:=result+(Sqr(strtofloat(FList[i])));  

 

 

except  

 

 

 

 

 

{интересная конструкция. "on e:exception do" - мы "отлавливаем" ошибку как переменную "e".  

 

 

Эта переменная имеет о?ень полезное свойство e.message - оно содержит описание ошибки. Далее  

 

 

следует вызов события. Вна?але мы проверяем использует ли пользователь событие:  

 

 

"if Assigned(FOnError) then", если использует то вызываем его процедуру: FOnError, с параметрами:  

 

 

self - зарезервированная переменная - указатель на экземпляр нашего класса, e.message - описание  

 

 

ошибки}  

 

 

on e:exception do   

 

 

 

 

 

if Assigned(FOnError) then FOnError(Self, e.message);  

 

 

 

 

 

end;  

 

 

 

 

 

end;  

 

 

 

end;

end.

Вот пример использования этого класса:

unit Unit1;

interface

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

type

 

TForm1 = class(TForm)  

 

 

Button1: TButton;  

 

 

procedure Button1Click(Sender: TObject);  

 

 

 

private

 

procedure OnError(Sender:TObject; Error: string);  

 

 

 

public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses Unit2;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
  var Statistic:TStatistic;
begin

 

Statistic:=TStatistic.create;  

 

 

Statistic.onError:=onError;  

 

 

Statistic.AddValue('123423');  

 

 

Statistic.AddValue('123423');  

 

 

showmessage(floattostr(Statistic.solve));  

 

 

Statistic.Clear;  

 

 

Statistic.AddValue('123423');  

 

 

Statistic.AddValue('12ssss3');  

 

 

showmessage(floattostr(Statistic.solve));  

 

 

Statistic.Free;  

 

 

 

end;

procedure TForm1.OnError(Sender: TObject; Error: string);
begin

 

showmessage('Error inside class:'+Sender.ClassName+#13#10+Error);  

 

 

 

end;

end.
 

Как можно работать с объектами не заботясь об их разрушении?

 


Вначале сделаем интерфейс для нашего объекта:

type
  IAutoClean = interface
    ['{61D9CBA6-B1CE-4297-9319-66CC86CE6922}']
  end;

  TAutoClean = class(TInterfacedObject, IAutoClean)
  private
    FObj: TObject;
  public
    constructor Create(AObj: TObject);
    destructor Destroy; override;
  end;

implementation

constructor TAutoClean.Create(AObj: TObject);
begin
  FObj := AObj;
end;

destructor TAutoClean.Destroy;
begin
  FreeAndNil(FObj);
  inherited;
end;

А теперь будем использовать его вместо объекта:

procedure TForm1.Button1Click(Sender: TObject);
var
  a: IAutoClean;
    //must declare as local variable, so when this procedure finished, it's out of scope
  o: TOpenDialog; //any component
begin
  o := TOpenDialog.Create(self);
  a := TAutoClean.Create(o);
  if o.Execute then
    ShowMessage(o.FileName);
end;

Как преобразовать указатель на метод в указатель на функцию?

 



// Converting method pointers into function pointers 

// Often you need a function pointer for a callback function. But what, if you want to specify a method as 
// an callback? Converting a method pointer to a function pointer is not a trivial task; both types are 
// incompatible with each other. Although you have the possibility to convert like this "@TClass.SomeMethod", 
// this is more a hack than a solution, because it restricts the use of this method to some kind of a class 
// function, where you cannot access instance variables. If you fail to do so, you'll get a wonderful gpf. 
// But there is a better solution: run time code generation! Just allocate an executable memory block, and 
// write 4 machine code instructions into it: 2 instructions loads the two pointers of the method pointer 
// (code & data) into the registers, one calls the method via the code pointer, and the last is just a return 
// Now you can use this pointer to the allocated memory as a plain function pointer, but in fact you are 
// calling a method for a specific instance of a Class. 



type TMyMethod = procedure of object; 


function MakeProcInstance(M: TMethod): Pointer; 
begin 
  // allocate memory 
  GetMem(Result, 15); 
  asm 
    // MOV ECX,  
    MOV BYTE PTR [EAX], $B9 
    MOV ECX, M.Data 
    MOV DWORD PTR [EAX+$1], ECX 
    // POP EDX 
    MOV BYTE PTR [EAX+$5], $5A 
    // PUSH ECX 
    MOV BYTE PTR [EAX+$6], $51 
    // PUSH EDX 
    MOV BYTE PTR [EAX+$7], $52 
    // MOV ECX,  
    MOV BYTE PTR [EAX+$8], $B9 
    MOV ECX, M.Code 
    MOV DWORD PTR [EAX+$9], ECX 
    // JMP ECX 
    MOV BYTE PTR [EAX+$D], $FF 
    MOV BYTE PTR [EAX+$E], $E1 
  end; 
end; 


procedure FreeProcInstance(ProcInstance: Pointer); 
begin 
  // free memory 
  FreeMem(ProcInstance, 15); 
end; 

Как явно вызвать виртуальный метод дедушки?

 


Проблема в следующем. Допустим, есть иерархия классов, у которых перекрывается один и тот же виртуальный (или динамический - не важно) метод и в одной из реализаций этого метода вы хотите вызвать виртуальный метод предка своего предка. Новая объектная модель Delphi допускает только вызов методов предка (с помощью ключевого слова inherited) либо вызов методов класса с префиксом - типом класса (например, TLevel1.ClassName).

Эта проблема стандартными средствами не решается. Но сделать требуемый вызов можно. Причем способом, показанным ниже, можно вызвать любой метод для любого класса, однако, в этом случае вся ответственность за правильность работы с методами и полями ложится на программиста. Ниже в методе VirtualFunction класса TLevel3 вызывается метод класса TLevel1, а в функции Level1Always всегда вызывается метод класса TLevel1 для любого его наследника.

TLevel1 = class(TComponent)
   public
     function VirtualFunction: string; virtual;
   end;

   TLevel2 = class(TLevel1)
   public
     function VirtualFunction: string; override;
   end;

   TLevel3 = class(TLevel2)
   public
     function VirtualFunction: string; override;
   end;

   function Level1Always(MyLevel: TLevel1): string;

implementation

   type
     PClass = ^TClass;

   function TLevel1.VirtualFunction: string;
   begin
     Result := 'Level1';
   end;

   function TLevel2.VirtualFunction: string;
   begin
     Result := inherited VirtualFunction+' Level2';
   end;

   function TLevel3.VirtualFunction: string;
   var
     ClassOld: TClass;
   begin
         ClassOld := PClass(Self)^;
     PClass(Self)^ := TLevel1;
     Result := VirtualFunction + ' Level3';
     PClass(Self)^ := ClassOld;
   end;

   function Level1Always(MyObject: TObject): string;
   var
     ClassOld: TClass;
   begin
     ClassOld := PClass(MyObject)^;
     PClass(MyObject)^ := TLevel1;
     Result := (MyObject as TLevel1).VirtualFunction;
     PClass(MyObject)^ := ClassOld;
   end;


Как же это работает? Стандартные так называемые объектные типы (object types - class of ...) на самом деле представляют из себя указатель на VMT (Virtual Method Table) - таблицу виртуальных методов, который (указатель) лежит по смещению 0 в экземпляре класса. Воспользовавшись этим, мы сначала сохраняем 'старый тип класса' - указатель на VMT, присваиваем ему указатель на VMT нужного класса, делаем вызов и восстанавливаем все как было. Причем нигде не требуется, чтобы один из этих классов был бы порожден от другого, т.е. функция Level1Always вызовет требуемый метод вообще для любого экземпляра любого класса.

Если в функции Level1Always сделать попробовать вызов


  Result := MyObject.VirtualFunction;


то будет ошибка на стации компиляции, так как у класса TObject нет метода VirtualFunction. Другой вызов


  Result := (MyObject as TLevel3).VirtualFunction;


будет пропущен компилятором, но вызовет Run-time ошибку, даже если передается экземпляр класса TLevel3 или один из его потомком, так как информация о типе объекта меняется. Динамически распределяемые (dynamic) методы можно вызывать точно таким же образом, т.к. информация о них тоже хранится в VMT. Статические методы объектов вызываются гораздо более простым способом, например


var
     MyLevel3: TLevel3;
   ...
     (MyLevel3 as TLevel1).SomeMethode;


вызовет метод класса TLevel1 даже если у MyLevel3 есть свой такой же метод.

 

 

Сайт рассылки в процессе создания.

Заходите на мой сайт: http://www.petrify.boom.ru (не посвящен ни рассылке, ни дельфи)

Так же можете посетить несколько сайтов для заработка в Интернете:

Hit&Host

 

Raskrutim.ru

 

WmSearch

 
В избранное