Советы по Delphi. Версия 1.4.3 от 1.1.2001

Озеров Валентин

uses

 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls;

type

 TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

 private { Private declarations }

 public { Public declarations }

 end;

var

 Form1: TForm1;

 CurrProc : LongInt;

 MyVal : LongInt;

implementation

uses Unit2;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

var

 NewProc : LongInt;

 MyString : string;

begin

 CurrProc := 2; {

начальная точка в таблице методов }

 MyVal := 0; { вспомогательная переменная }

 NewProc := 0; { возвращаемое значение для следующего индекса в таблице методов }

 while CurrProc < 6 do begin

{ выполняем текущий индекс в таблице методов и получаем следующую процедуру }

NewProc := ProcTable[CurrProc](MyVal);

{ просто показываем значения NewProc и CurrProc }

FmtStr(MyString, 'NewProc [%d] CurrProc [%d]', [NewProc, CurrProc]);

MessageDlg(MyString, mtInformation, [mbOK], 0);

{ присваиваем текущую процедуру возвращаемой процедуре }

CurrProc := NewProc;

 end;

end;

end.

{ Это простой пример, определяющий массив указателей на функции }

interface

type

 { определяем Procs как функцию }

 Procs = function(var ProcNum : LongInt): LongInt;

var

 { объявляем массив указателей на функции }

 ProcTable : Array [1..5] of Procs;

 {

определения интерфейсов функций }

function Proc1(var MyVal : LongInt) : LongInt; far;

function Proc2(var MyVal : LongInt) : LongInt; far;

function Proc3(var MyVal : LongInt) : LongInt; far;

function Proc4(var MyVal : LongInt) : LongInt; far;

function Proc5(var MyVal : LongInt) : LongInt; far;

implementation

uses Dialogs;

function Proc1(var MyVal : LongInt) : LongInt;

begin

 MessageDlg('Процедура 1', mtInformation, [mbOK], 0);

 Proc1 := 6;

end;

function Proc2(var MyVal : LongInt) : LongInt;

begin

 MessageDlg('Процедура 2', mtInformation, [mbOK], 0);

 Proc2 := 3;

end;

function Proc3(var MyVal : LongInt) : LongInt;

begin

 MessageDlg('Процедура 3', mtInformation, [mbOK], 0);

 Proc3 := 4;

end;

function Proc4(var MyVal : LongInt) : LongInt;

begin

 MessageDlg('Процедура 4', mtInformation, [mbOK], 0);

 Proc4 := 5;

end;

function Proc5(var MyVal : LongInt) : LongInt;

begin

 MessageDlg('Процедура 5', mtInformation, [mbOK], 0);

 Proc5 := 1;

end;

initialization

 { инициализируем содержание массива указателей на функции }

 @ProcTable[1] := @Proc1;

 @ProcTable[2] := @Proc2;