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

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

Варианты:

VCL

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

Базы данных

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

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

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

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

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

formyreferal@rambler.ru

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

Что из себя представляет Self?

Как скрыть свойства объекта?

Как присвоить событие в run-time?

Как вызвать метод предка?

Можно ли динамически изменять свойство "owner" компонента во время выполнения программы?

Как создать компонент во время выполнения приложения?

Работа с Sender

В чем отличие между Create(Self) и Create(Application)?

Как создать копию произвольного компонента?

Перекрытие виртуальных методов

Вызов процедуры, имя которой содержится в переменной

Динамические и виртуальные методы

Override/Vitual/Dynamic - методы

Как заставить код компонента работать только в дизайне?

Работа метода Assign

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

Список handle всех окон моего приложения

Сгруппировать свойства наподобие Font

Self - это явное задание экземпляра класса в его методе.

Например для твоей формы это указание на саму форму:

procedure TForm1.Button1Click(Sender: TObject);
begin
  showmessage(self.classname+#13#10+self.name);
end;

Если, например это MDI форма то это будет указатель именно на тот экземпляр для которого выполняется этот код. На практике Self обычно применяется при написании своих классов, когда ты пишешь класс или компонент, то у тебя нет переменной с экземпляром этого компонента, следовательно, чтобы обратится к экземпляру (который появится только в коде конечного пользователя, который будет использовать компонент) класса нужна переменная - вот она и берётся за self.

В иерархии VCL в большинстве случаев существует уровень объектов-"предшественников" (TCustomXXXX), в которых многие свойства скрыты. Для унаследованных от таких "предшественников" объектов можно "открывать" на выбор те или иные свойства. А как можно скрыть свойства, которые объявлены в published-области от Object Inspector'а, но при этом оставить возможность доступа во время работы программы? Решение состоит в объявлении свойства "по новой" в public-области. В примере скрытым будет у объекта TMyControl свойство Height.

TMyControl = class(TWinControl)
protected
  procedure SetHeight(Value: Integer);
  function GetHeight: Integer;
public
  property Height: Integer read GetHeight write SetHeight;
end;

procedure TMyControl.SetHeight(Value: Integer);
begin
  inherited Height := Value;
end;

function TMyControl.GetHeight;
begin
  Result := inherited Height;
end;

Пример стандартного присвоения события в run-time:

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
  private
    procedure Click(Sender: TObject);
  end;

var  Form1: TForm1;

implementation

procedure TForm1.Click(Sender: TObject);
begin
  // do something
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  button1.OnClick:=Click;
end;

end.

Способ со статическим приведением годится только для
не виртуальных методов, имеющих одно имя.
Вызов же виртуальных методов от статического типа не зависит.
В твоём простейшем случае достаточно написать inherited Mtd;
(ты его можешь вызвать из любого метода TClass2, не только из Mtd).
Трудности возникнут, когда нужно вызвать метод "дедушки" или "прадедушки" и т.д.
Один из способов, описанных в литературе, - временная замена
VMT объекта на "дедушку" и обратно. Но если у дедушки такого метода не было - будет облом.
Я предпочитаю такой способ:

type
 TProc = procedure of object;
procedure TClassN.SomeMethod;
var
 Proc: TProc;
begin
 TMethod(Proc).Code := @TClass1.Mtd; // Статический адрес
 TMethod(Proc).Data := Self;
 Proc();
end;

Вы можете менять свойство "owner" и после создания компонента с помощью методов InsertComponent() и RemoveComponent().

При создании визуальных контролов в runtime, важным моментом является назначение родительских свойств и использование метода SetBounds, чтобы этот контрол стал видимы.


type 
  TForm1 = class(TForm) 
  protected 
    MyLabel: TLabel; 
    procedure LabelClick(Sender: TObject); 
    procedure CreateControl; 
  end; 


procedure TForm1.LabelClick(Sender: TObject); 
begin 
  (Sender as Label).Caption := ... 
end; 


procedure TForm1.CreateControl; 
var 
  ALeft, ATop, AWidth, AHeight: Integer; 
begin 
  ALeft := 10; 
  ATop := 10; 
  AWidth := 50; 
  AHeight := 13; 
  MyLabel := TLabel.Create(Self); 
  MyLabel.Parent := Self;       
  MyLabel.Name:='LabelName'; 
  MyLabel.SetBounds(ALeft, ATop, AWidth, AHeight); 
                                                 
  MyLabel.OnClick := LabelClick; 
end;

unit TestInputForm;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    DdhInputButton1: TDdhInputButton;
    DdhInputButton2: TDdhInputButton;
    DdhInputButton3: TDdhInputButton;
    procedure DdhInputButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.DdhInputButtonClick(Sender: TObject);
begin
  ShowMessage ('You have clicked the ' +
    (Sender as TButton).Name + ','#13 +
    'having the caption ' +
    (Sender as TButton).Caption);
end;

end.

Self может быть использовано только в методе класса, и ссылается на текущий экземпляр класса. Таким образом "Self" в методе класса TForm1 ссылается на текущий экземпляр TForm1. При создании компонента Вы передаете его владельца (owner) в конструктор. При уничтожении формы или компонента автоматически уничтожаются и все компоненты владельцем которого она является. Таким образом если при создании формы передать в качестве владельца Application эта форма будет автоматически уничтожена при уничтожении Application. Если же при создании формы передать в качестве владельца другую форму, вновь созданная форма будет автоматически уничтоженна при уничтожении формы-владельца.

{ 
 Здесь пpоцедypа CreateClone, которая кpеатит компоненту ОЧЕHЬ ПОХОЖУЮ на 
входнyю. С такими же значениями свойств. Присваивается все, кроме методов. 
} 
function CreateClone(Src: TComponent): TComponent; 
var 
  F: TStream; 
begin 
  F := nil; 
  try 
    F := TMemoryStream.Create; 
    F.WriteComponent(Src); 
    RegisterClass(TComponentClass(Src.ClassType)); 
    F.Position := 0; 
    Result := F.ReadComponent(nil); 
  finally 
    F.Free; 
  end; 
end; 

Допустим у вас есть класс:

TMyObject = class (TObject) 

и его наследник:

TOverrideObject = class (TMyObject) 

К примеру, TMyObject имеет метод Wiggle:

procedure Wiggle; virtual;  

а TOverrideObject перекрывает Wiggle:

procedure Wiggle; override;  

и, естественно, вы реализовали оба метода.

Теперь вы создаете TList, содержащий целую кучу MyObjects и OverrideObjects в свойстве TList.Items[n]. Свойство Items является указателем, поэтому для вызова метода Wiggle вам достаточно вызвать необходимый элемент списка. Например так:

if TObject(Items[1]) is TMyObject then 
  TMyObject(Items[1]).Wiggle
else 
  if TObject(Items[1]) is TOverrideObject then 
    TOverrideObject(Items[1]).Wiggle;

но возможности полиморфизма и директива override позволяют вам сделать так:

TMyObject(Items[1]).Wiggle; 

Ваше приложение посмотрит на экземпляр специфического объекта, ссылка на который содержится в Items[1] и скажет: "Да, это - TMyObject, но, точнее говоря, это TOverrideObject; но поскольку метод Wiggle является виртуальным методом и TOverrideObject переопределил метод Wiggle, я собираюсь выполнить метод TOverrideObject.Wiggle, а не метод TMyObject.Wiggle."

Теперь представьте себе, что при декларации метода вы пропустили директиву override, попробуйте это выполнить теперь:

TMyObject(Items[1]).Wiggle; 

Приложение и в этом случае должно "видеть" данный метод, даже если Items[1] - TOverrideObject; но у него отсутствует перекрытая версия метода Wiggle, поэтому приложение выполнит TMyObject.Wiggle, а не TOverrideObject.Wiggle (поведение, которое вы можете как хотеть, так и избегать).

Так, перекрытый метод функционально может отличаться от декларированного метода, содержащего директиву virtual (или dynamic) в базовом классе, и объявленный с директивой override в классе-наследнике. Для замены метода необходимо объявить его в классе-наследнике без директивы override. Перекрытые методы могут выполняться даже тогда, когда специфический экземпляр класса-предка является точной копией базового класса. "Замененные" методы могут выполняться только тогда, когда специфический экземпляр является "слепком" только этого класса.

Как я могу вызвать процедуру, чье имя хранится в таблице, списке, и т.п.? Другими словами, я хочу сохранить имя процедуры в переменной и для ее вызова обращаться к значению этой переменной.

unit ProcDict;

interface

type MyProc = procedure(s: string);

procedure RegisterProc(procName: string; proc: MyProc);
procedure ExecuteProc(procName: string; arg: string);

implementation

uses Classes;
var ProcDict: TStringList;

procedure RegisterProc(procName: string; proc: MyProc);
begin
  ProcDict.AddObject(procName, TObject(@proc));
end;

procedure ExecuteProc(procName: string; arg: string);
var
  index: Integer;
begin
  index := ProcDict.IndexOf(ProcName);
  if index >= 0 then
    MyProc(ProcDict.objects[index])(arg);
// Можно вставить обработку исключительной ситуации - сообщение об ошибке
end;

initialization
  ProcDict := TStringList.Create;
  ProcDict.Sorted := true;
finalization
  ProcDict.Free;
end.

HR
вы могли бы создать StringList как показано ниже:

StringList.Create; StringList.AddObject('Proc1',@Proc1);
StringList.AddObject('Proc2',@Proc2);  

и затем реализовать это в вашей программе:

var
  myFunc: procedure;
begin
  if Stringlist.indexof(S) = -1 then
    MessageDlg('Не понял процедуру ' + S, mtError, [mbOk], 0)
  else
    begin
      @myFunc := Stringlist.Objects[Stringlist.indexof(S)];
      myFunc;
    end;

Согласно онлайновой документации, динамические и виртуальные методы семантически идентичны, единственно различие заключается в их реализации, нижеследующий код генерирует указанную ошибку компиляции:

type t = class
    function a: integer; {статический}
    function b: integer; virtual;
    function c: integer; dynamic;
    property i: integer read a; { ok }
    property j: integer read b; { ok }
    property k: integer read c;{ ОШИБКА: type mismatch (не совпадение типа) }
  end;

Если метод в классе предка объявлен как виртуальный (virtual) или динамический (dynamic), вам необходимо перекрыть его во всех классах-наследниках. Если вы объявляете унаследованный метод виртуальным или динамическим, вы начинаете строить его новое виртуальное/динамическое дерево наследования. Допустим, у нас есть следующая иерархия: A (родитель) - B - C - D. Если вы объявляете метод как виртуальный (или динамический) в A, перекрываете в B, создаете виртуальным в C и перекрываете в D, вот что получается:


фактический класс, используемый класс, использующий
класс        для доступа к методу  метод
-----------+---------------------+--------------------
     D                D                     D
     D                C                     D
     D                B                     B
     D                A                     B

     C                C                     C
     C                B                     B
     C                A                     B
  
     B                B                     B
     B                A                     B

Вывод: работа виртуального/динамического наследования прекращается в момент создания одноименного виртуального/динамического метода наследниками класса.

if csDesigning in ComponentState then
begin
... код, работающий только в дизайне ...
end; 

В общем случае, утверждение "Destination := Source" не идентично утверждению "Destination.Assign(Source)".

Утверждение "Destination := Source" принуждает Destination ссылаться на тот же объект, что и Source, а "Destination.Assign(Source)" копирует содержание объектных ссылок Source в объектные ссылки Destination.

Если Destination является свойством некоторого объекта (тем не менее, и свойство не является ссылкой на другой объект, как, например, свойство формы ActiveControl, или свойство DataSource элементов управления для работы с базами данных), тогда утверждение "Destination := Source" идентично утверждению "Destination.Assign(Source)". Это объясняет, почему LB.Items := MemStr работает, когда MemStr := LB.Items нет.

type
  ISelfDestroy = interface;
  //forget about GUID, if you are not using COM

  TSelfDestroy = class(TInterfacedObject, ISelfDestroy)
  private
    FObject: TObject;
  public
    constructor Create(AObject: TObject);
    destructor Destroy; override;
  end;


implementation


constructor TSelfDestroy.Create(AObject: TObject);
begin
  FObject := AObject;
end;

destructor TSelfDestroy.Destroy;
begin
  FreeAndNil(FObject);
  inherited;
end;


// So when you use, just do like this...

procedure TForm1.Button1Click(Sender: TObject);
var
  MyObject: TMyObject;
  SelfDestroy: TSelfDestroy;
  begin
  MyObject    := TMyObject.Create;
  SelfDestroy := TSelfDestroy.Create(MyObject);
  // The MyObject will free automatically as soon as TSelfDestroy
  // goes out of scope.
  // Carry on your code here...
end;

function EnumProc(wnd: HWND; var count: DWORD): Bool; stdcall;
begin
  Inc(count);
  result := True;
  EnumChildWindows(wnd, @EnumProc, integer(@count));
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  count: DWORD;
begin
  count := 0;
  EnumThreadWindows(GetCurrentThreadID, @EnumProc, Integer(@count));
  Caption := Format('%d window handles in use', [count]);
end;

...чтобы сгруппировать свойства наподобие Font, вам необходимо создать наследника (подкласс) TPersistent. Например:


TBoolList = class(TPersistent)
  private
    FValue1: Boolean;
    FValue2: Boolean
  published
    property Value1: Boolean read FValue1 write FValue1;
    property Value2: Boolean read FValue2 write FValue2;
end;


Затем, в вашем новом компоненте, для этого подкласса необходимо создать ivar. Чтобы все работало правильно, вам необходимо перекрыть конструктор.

TMyPanel = class(TCustomPanel)
  private
    FBoolList: TBoolList;
  public
    constructor Create( AOwner: TComponent ); override;
  published
    property BoolList: TBoolList read FBoolList write FBoolLisr;
end;


Затем добавьте следующий код в ваш конструктор:

constructor TMyPanel.Create( AOwner: TComponent );
begin
  inherited Create( AOwner );
  FBoolList := TBoolList.Create;
end;