Процедура как параметр

[Prof]

Коллеги, подскажите!
Как организовать на FPC (v.1 для Linux)
передачу имени процедуры Pa через
список формальных параметров
функции Fb. Причем
Fb - определяется в нек. unit-e
Pa - определяется в нек.программе, которая, естественно,
подключает unit через uses.
Не могу добиться проку от документации.
Похоже, что дело в режимах/псевдокомментариях.

[Иван Шихалев]

Объявляем процедурный тип, да и всё… В чём проблема-то?

[Prof]

Объявляем процедурный тип, да и всё… В чём проблема-то?

Дело в том, что процедурный тип приходится описывать в unit-e.
А в программе (на месте вызова Fa) компилятор отказывается
признавать имя фактческой процедуры, соответствующей
процедурному типу.
Сразу скажу, что с точки зрения синтаксиса все корректно,
и на TP это работает.

[Иван Шихалев]

Пример, плиз. В разных режимах передача и вызов процедурных типов действительно работает по разному.

[Prof]

Пример, плиз. В разных режимах передача и вызов процедурных типов действительно работает по разному.

Вот "чистый" случай:
----------------------------------------файл un.pp ----------------------------
{$SMARTLINK ON}
unit un;
interface
type TPr = procedure(N : integer);
function Ask(M : integer; Pr : TPr) : boolean;
implementation
function Ask(M : integer; Pr : TPr) : boolean;
begin Pr(M); Ask:=true end;
end.
----------------------------------------файл tt.pp -----------------------------
program tt;
uses un;
procedure One(N : integer);
begin writeln(N) end;
procedure Fis;
begin if Ask(4,One) then; end;
begin Fis
end.
------------------------------------------------------------------------------------
При компиляции tt.pp выдается:
Error: Wrong amount of parameters specified

[Alexander]

А для режима Delphi нужно поступать иначе.

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

{$SMARTLINK ON}
{$MODE FPC}
unit un;

interface

type TPr = procedure(N : integer); stdcall;

function Ask(M : integer; Pr : TPr) : boolean;

implementation

function Ask(M : integer; Pr : TPr) : boolean;
begin
Pr(M);
Ask:=true;
end;
end.

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

{$MODE FPC}
program tt;

uses un;

procedure One(N : integer); stdcall;
begin
writeln(N);
end;

procedure Fis;
begin
if Ask(4, @One) then;
end;

begin
Fis;
end.

[STAKANOV]

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

program tt;
uses un;
procedure One(N : integer);
begin writeln(N) end;
procedure Fis;
begin if Ask(4,@One) then; end;
begin Fis
end.


См. [url]http://freepascal.ru/wiki/index.php/Процедурные_типы[/url]

[Prof]

СПАСИБО КОЛЛЕГИ!
ТЕПЕРЬ РАБОТАЕТ!

[VirtUX]

Не стал создавать новую тему, т.к. заголовок темы, в принципе, подходит.
Ситуация следующая:
В модуле не используются никакие объекты заранее объявленные. Но создаются по мере необходимости. Нужно созданному объекту в событие OnClick передать процедуру невидимую из других модулей. Я пытаюсь сделать это так:

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

unit uDialogs;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, StdCtrls, Controls;

  procedure DiagDubleFiltr(const Capt, Mess: UTF8String; var Res1, Res2: UTF8String);

implementation

var FormDialogs: TForm;

procedure ClearForm;
var i: integer;
begin
  if FormDialogs.ControlCount > 0 then
    for i := 0 to pred(FormDialogs.ControlCount) do FormDialogs.Controls[i].Free;
end;

procedure DiagDubleFiltr(const Capt, Mess: UTF8String; var Res1, Res2: UTF8String);
var LabelMess: TLabel;
    EditFiltr1, EditFiltr2: TEdit;
    ButtOK: TButton;

    procedure ButtOKDubleFiltr(Sender: TObject);
    begin
      Res1 := EditFiltr1.Text;
      Res2 := EditFiltr2.Text;
      FormDialogs.Hide;
      ClearForm;
    end;

begin
  FormDialogs := TForm.Create(Application);
  FormDialogs.Caption:= Capt;
  LabelMess := TLabel.Create(FormDialogs);
  LabelMess.Parent := FormDialogs;
  LabelMess.Caption:= Mess;
  LabelMess.Align:= alTop;
  LabelMess.WordWrap:= true;
  LabelMess.BorderSpacing.Around:= 5;
  LabelMess.Show;
  EditFiltr1 := TEdit.Create(FormDialogs);
  EditFiltr1.Parent := FormDialogs;
  EditFiltr1.Align:= alTop;
  EditFiltr1.BorderSpacing.Around:= 5;
  EditFiltr1.Show;
  EditFiltr2 := TEdit.Create(FormDialogs);
  EditFiltr2.Parent := FormDialogs;
  EditFiltr2.Align:= alTop;
  EditFiltr2.BorderSpacing.Around:= 5;
  EditFiltr2.Show;
  ButtOK := TButton.Create(FormDialogs);
  ButtOK.Parent := FormDialogs;
  ButtOK.Align:= alTop;
  ButtOK.BorderSpacing.Around:= 5;
  ButtOK.Caption:= 'OK';
  ButtOK.OnClick:= @ButtOKDubleFiltr;      //Здесь возникает ошибка об несоответствии типов, что мол нельзя передавать локальную процедуру
  ButtOK.Show;
  FormDialogs.AutoSize:= true;
  FormDialogs.ShowModal;
end;

end.


Как обойти этот запрет?
Lazarus 0.9.29

[v-t-l]

Обработчик события не может быть вложенной процедурой. Более того - он должен быть методом какого-нибудь класса.

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

{ Standard events }

  TNotifyEvent = procedure(Sender: TObject) of object;


[Mr.Smart]

Механиз присваивания событию объекта обычной процедуры следующий:

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

procedure TestClick(Sender: TObject);
begin
  ShowMessage('OK!');
end;

...
var
  m: TMethod;
...
  m.Code:=@TestClick;
  m.Data:=nil;
  Button1.OnClick:=TNotifyEvent(m);
...


Структура TMethod имеет следующие поля:

• Code - адрес процедуры/функции;
• Data - значение первого "скрытого" параметра т.н. Self

[Max Rusov]

Mr.Smart

Так делать нельзя. Аргументы будут передаваться неправильно.

[Mr.Smart]

Max Rusov
Да действительно ошибся
Процедура или функция должна содержать на один параметр больше

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

procedure TestClick(Self, Sender: TObject);


[VirtUX]

Max Rusov
Да действительно ошибся
Процедура или функция должна содержать на один параметр больше

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

procedure TestClick(Self, Sender: TObject);


Я обошелся одним параметром:

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

procedure TestClick(Self: TObject);

Так тоже работает. Спасибо за помощь.

[Mr.Smart]

Я обошелся одним параметром:
...
Так тоже работает. Спасибо за помощь.

Работать то оно будет, но в стек передаются именно 2 параметра Self и Sender!
Так что для того чтобы ненарушить целосность стека нужно использовать прицедуры/функции с правельным числом параметров.